109 1 IPARI ,X ,W , ERRORS,
110 2 V ,MS ,IN ,IAD_ELEM ,
111 3 FR_ELEM ,VR ,ISENDTO ,IRECVFROM,
112 4 NEWFRONT ,ITASK ,WAG ,DT2T ,
113 5 ITAB ,NELTST ,ITYPTST ,WEIGHT ,
114 6 INTLIST ,NBINTC ,KINET ,DRETRI ,
115 7 ISLEN7 ,IRLEN7 ,ISLEN11 ,IRLEN11 ,
116 8 TEMP ,IGRBRIC ,IGRSH3N ,EMINX ,
117 9 IXS ,IXS16 ,IXS20 ,ISLEN17 ,
118 A IRLEN17 ,IRLEN7T ,ISLEN7T ,NUM_IMP ,
119 B IND_IMP ,INTSTAMP,THKNOD ,IRLEN20 ,
120 C ISLEN20 ,IRLEN20T,ISLEN20T,IRLEN20E ,
121 D ISLEN20E ,RENUM ,NSNFIOLD,XSLV ,
122 E XMSR ,VSLV ,VMSR ,SIZE_T ,
123 F NODNX_SMS,DXANCG ,IKINE ,DIAG_SMS ,
124 G COUNT_REMSLV, COUNT_REMSLVE,ALE_CONNECTIVITY,
125 H IXTG ,SENSORS ,DELTA_PMAX_GAP ,
126 I INTBUF_TAB ,DELTA_PMAX_GAP_NODE,
128 J NB25_CANDT,NB25_IMPCT,NB25_DST1,NB25_DST2,INTLIST25,
129 K IAD_FREDG,FR_EDG,MAIN_PROC,NATIV_SMS,I_OPT_STOK ,
130 L MULTI_FVM,IPARG ,ELBUF_TAB, H3D_DATA ,T2MAIN_SMS,
131 M LSKYI_SMS_NEW,FORNEQS,INT7ITIED,IDEL7NOK_SAV,MAXDGAP,
132 N T2FAC_SMS,ICODT,ISKEW,FSKYN25,ADDCSRECT,PROCNOR,
133 O INTER_STRUCT,SORT_COMM,RENUM_SIZ,NODNX_SMS_SIZ,TEMP_SIZ,
134 P INTERFACES,GLOB_THERM,component)
138 USE spmd_mod,
ONLY : spmd_barrier
158 use element_mod ,
only : nixtg
163#include "implicit_f.inc"
164#include "comlock.inc"
169#include "com01_c.inc"
170#include "com04_c.inc"
171#include "com08_c.inc"
172#include "impl1_c.inc"
173#include "intstamp_c.inc"
174#include "param_c.inc"
176#include "timeri_c.inc"
178#include "units_c.inc"
179#include "inter22.inc"
183 TYPE (OUTPUT_) :: OUTPUT
184 TYPE(timer_),
INTENT(inout) :: TIMERS
185 INTEGER,
INTENT(INOUT) :: ERRORS
186 INTEGER,
INTENT(in) :: NODNX_SMS_SIZ
187 INTEGER IPARI(NPARI,*), IXS(*), IXS16(*), IXS20(*),
189 . NEWFRONT(*),NBINTC,INTLIST(*),
190 . ISENDTO(NSPMD+1,*),IRECVFROM(NSPMD+1,*),
191 . ITASK,NELTST ,ITYPTST,WEIGHT(*),
192 . IAD_ELEM(2,*) ,FR_ELEM(*),
193 . ISLEN7, IRLEN7, ISLEN11, IRLEN11, ISLEN17 ,IRLEN17,
194 . IRLEN7T ,ISLEN7T,IRLEN20,ISLEN20,IRLEN20T,ISLEN20T,
195 . IRLEN20E, ISLEN20E,
196 . IND_IMP(*),NUM_IMP(*),RENUM(*), NSNFIOLD(NSPMD),
197 . NODNX_SMS(NODNX_SMS_SIZ),IKINE(NUMNOD),I_MEM,COUNT_REMSLV(*),
198 . COUNT_REMSLVE(*), IXTG(NIXTG,*),DELTA_PMAX_GAP_NODE(*),
199 . IAD_FRNOR(NINTER25,*), FR_NOR(*), IAD_FREDG(NINTER25,*), FR_EDG(*),
200 . NB25_CANDT(PARASIZ), NB25_IMPCT(PARASIZ),
201 . NB25_DST1(PARASIZ), NB25_DST2(PARASIZ), IPARG(NPARG,*),
202 . INTLIST25(*), MAIN_PROC(*), NATIV_SMS(*), I_OPT_STOK(NINTER)
205INTEGER,
INTENT(IN) :: ICODT(*), ISKEW(*)
210 INTEGER,
INTENT(IN) :: INT7ITIED
211 INTEGER,
DIMENSION(*),
TARGET ::
212 INTEGER,
INTENT(in) :: TEMP_SIZ
216 . VR(3,*),IN(*),DT2T,DIST, DRETRI(*), TEMP(TEMP_SIZ), EMINX(*),
217 . THKNOD(*),DELTA_PMAX_GAP(NINTER),
218 . XSLV(18,NINTER),XMSR(12,NINTER),X21MSR(3,NINTSTAMP),
219 . VSLV(6,NINTER),VMSR(6,NINTER),V21MSR(3,NINTSTAMP),
220 . SIZE_T(NINTER),DXANCG(3,*), DIAG_SMS(*),
221 . FORNEQS(*), MAXDGAP(NINTER), T2FAC_SMS(*)
222 my_real,
TARGET :: X(3*NUMNOD),V(3*NUMNOD),W(3,NUMNOD)
223 my_real,
DIMENSION(*),
TARGET :: MS
226 TYPE(INTBUF_STRUCT_),
DIMENSION(NINTER) :: INTBUF_TAB
227 TYPE(MULTI_FVM_STRUCT),
INTENT(INOUT),
TARGET :: MULTI_FVM
228 TYPE(ELBUF_STRUCT_) ,
DIMENSION(NGROUP) :: ELBUF_TAB
229 TYPE(H3D_DATABASE) :: H3D_DATA
230 TYPE(t_ale_connectivity),
INTENT(IN) :: ALE_CONNECTIVITY
231 INTEGER,
INTENT(in) :: RENUM_SIZ
232 TYPE(inter_struct_type),
DIMENSION(NINTER),
INTENT(inout) :: INTER_STRUCT
233 TYPE(sorting_comm_type),
DIMENSION(NINTER),
INTENT(inout) :: SORT_COMM
234 TYPE (INTERFACES_) ,
INTENT(IN) :: INTERFACES
235 TYPE (SENSORS_) ,
INTENT(IN) :: SENSORS
237 TYPE () ,
DIMENSION(NGRBRIC) :: IGRBRIC
238 TYPE (GROUP_) ,
DIMENSION(NGRSH3N) :: IGRSH3N
239 TYPE (glob_therm_) ,
INTENT(IN) :: GLOB_THERM
240 type(
component_),
dimension(ninter),
intent(inout) :: component
244 INTEGER N, KK,LL, RETRI, NBLIST,NSENSOR,
245 . , IGN, IGE, NME, NMES,I,J,K,
246 . IDUM, IADI, ISTAMP, NRTM_T, NME_T, NEDGE_T, ESHIFT, SSHIFT, MULTIMP,
247 . ISENS,NBF,NBL,IB, NIN,NSNE_MAX,NFIC,L_FIC,NNOD3,NSNE3,
248 . nbintc21,
SIZE, nrtm_fe_t, nrtm_ige_t, ithk
249 my_real pct1, ts,delta_pmax_dgap(ninter),len
250 INTEGER NB_STOK_N(PARASIZ),NB_JLT(PARASIZ),RETRI21(NINTER),NBCUT,
251 . INTLIST21(NINTSTAMP)
252 SAVE nb_stok_n,nb_jlt
253 my_real,
DIMENSION(:),
ALLOCATABLE,
TARGET :: xe,ve
254 my_real,
DIMENSION(:),
ALLOCATABLE,
TARGET :: x_ige,v_ige
255 my_real,
DIMENSION(:),
POINTER :: ptr_x,ptr_v,ptr_ms
256 INTEGER,
DIMENSION(:),
POINTER :: PTR_KINET
258 INTEGER :: IBRIC, NBRIC, II, INOD, NODEID, ISU1, IAD, INACTI
259 LOGICAL :: M151_ALLOC, TYPE18
260 SAVE xe,ve,m151_alloc
261 SAVE x_ige,v_ige,max_ige,size_x_ige
262 INTEGER :: MAX_IGE,SIZE_X_IGE
263 INTEGER :: NB_INTER_SORTED
264 INTEGER,
DIMENSION(NBINTC) :: LIST_INTER_SORTED
267 nsensor = sensors%NSENSOR
271 delta_pmax_gap_node(1:ninter)=0
274 IF(imonm == 2 .AND. nspmd > 1)
THEN
285 delta_pmax_gap(n)=zero
332 delta_pmax_dgap(n)=zero
336 n = intstamp(kk)%NOINTER
371 IF(nty == 7.OR.nty == 11.OR.nty == 24.OR.nty == 25)
372 . isens = ipari(64,n)
374 ts = sensors%SENSOR_TAB(isens)%TSTART
378 IF(nty == 24.AND.tt>=ts)
THEN
379 nsne_max =
max(nsne_max,ipari(55,n))
385 IF(intbuf_tab(n)%S_NIGE/=0)
THEN
386 max_ige =
max(max_ige,intbuf_tab(n)%S_NIGE)
389 IF (nsne_max>0 )
THEN
390 l_fic=3*(nsne_max+numnod)
392 ALLOCATE(xe(l_fic),ve(l_fic))
393 xe(1:nnod3) = x(1:nnod3)
394 ve(1:nnod3) = v(1:nnod3)
398 ALLOCATE( x_ige(3*(numnod+max_ige)) )
399 ALLOCATE( v_ige(3*(numnod+max_ige)) )
400 x_ige(1:3*numnod) = x(1:3*numnod)
401 v_ige(1:3*numnod) = v(1:3*numnod)
402 size_x_ige = 3*(numnod+max_ige)
413 IF( multi_fvm%IS_INT18_LAW151 )
THEN
422 n = intstamp(kk)%NOINTER
423 IF (ipari(47,n)==2)
THEN
424 nbintc21 = nbintc21 + 1
425 intlist21(nbintc21) = kk
431 IF(ncycle == 1 )
THEN
435 IF (nty == 24 .OR. nty == 25 )
THEN
436 IF(ipari(97,n) > 0.AND.ipari(98,n)==2)
THEN
445 IF(itask==0)
CALL startime(timers,120)
451 IF(nty == 7 .AND. inacti ==7)type18=.true.
461 IF(nty == 7.OR.nty == 11.OR.nty == 24.OR.nty == 25) isens
463 ts = sensors%SENSOR_TAB(isens)%TSTART
468 IF((nty == 7.AND.tt>=ts).OR.nty == 10.OR.nty == 18)
THEN
472 IF(intbuf_tab(n)%S_NIGE/=0)
THEN
473 x_ige(3*numnod+1:3*(numnod+intbuf_tab(n)%S_NIGE)) = intbuf_tab(n)%XIGE(1:3*intbuf_tab(n)%S_NIGE)
475 v_ige(3*numnod+1:3*(numnod+intbuf_tab(n)%S_NIGE)) = intbuf_tab(n)%VIGE(1:3*intbuf_tab(n
477 ELSEIF (multi_fvm%IS_USED .AND. type18)
THEN
478 ptr_x => multi_fvm%X_APPEND
479 ptr_v => multi_fvm%V_APPEND
486 2 itask ,ptr_v ,xslv(1,n) ,xmsr(1,n),vslv(1,n),
487 3 vmsr(1,n),intbuf_tab(n))
489 ELSEIF(nty == 24.AND.tt>=ts)
THEN
507 1 ipari ,intbuf_tab(n),x ,n ,
508 2 itask ,v ,xslv(1,n) ,xmsr(1,n),vslv(1,n),
509 3 vmsr(1,n),delta_pmax_gap(n),delta_pmax_dgap(n),
510 4 delta_pmax_gap_node(n),itab)
514 ELSEIF(nty == 25.AND.tt>=ts)
THEN
521 1 ipari ,intbuf_tab(n),x ,n ,
522 2 itask ,v ,xslv(1,n) ,xmsr(1,n),vslv(1,n),
523 3 vmsr(1,n),delta_pmax_gap(n),delta_pmax_dgap(n),
524 4 delta_pmax_gap_node(n),itab)
530 1 ipari ,intbuf_tab(n) ,n ,itask ,
531 2 thknod, maxdgap(n))
539 ELSEIF(nty == 11.AND.tt>=ts)
THEN
545 3 vmsr(1,n) ,intbuf_tab(n))
547 ELSEIF(nty == 17)
THEN
549 IF(ipari(33,n) == 0)
THEN
554 IF(ipari(7,k) == 17.AND.ipari(33
THEN
557 nmes =igrbric(ign)%NENTITY
558 nme =igrbric(ige)%NENTITY
559 iad17 = iad17+6*(nme+nmes)
566 nmes =igrbric(ign)%NENTITY
567 nme =igrbric(ige)%NENTITY
569 1 ipari,intbuf_tab(n),x ,n ,
570 2 itask,igrbric ,eminx(iad17),nme,
571 3 nmes ,xslv(1,n) ,xmsr(1,n) , size_t ,ixs,
575 ELSEIF(nty == 20)
THEN
581 2 itask ,v ,xslv(1,n) ,xmsr(1,n),vslv(1,n),
582 3 vmsr(1,n),ms ,dxancg ,ikine ,diag_sms ,
583 4 intbuf_tab(n) ,h3d_data)
585 ELSEIF(nty == 22)
THEN
589 ELSEIF(nty == 23)
THEN
595 2 itask ,v ,xslv(1,n) ,xmsr(1,n),vslv(1,n),
596 3 vmsr(1,n),intbuf_tab(n))
606 n = intstamp(kk)%NOINTER
609 ts = sensors%SENSOR_TAB(isens)%TSTART
613 x21msr(1:3,kk) = zero
614 v21msr(1:3,kk) = zero
620 1 ipari ,intbuf_tab(n),n ,itask ,
625 1 ipari ,intbuf_tab(n),n ,itask )
628 1 ipari ,intbuf_tab(n),x ,n ,
629 2 itask ,v ,xslv(1,n) ,xmsr
630 3 vmsr(1,n),intstamp(kk) ,x21msr(1,kk) ,v21msr(1,kk))
642 IF(imonm == 2 .AND. nspmd > 1)
THEN
653 1 errors, ipari ,newfront ,isendto ,nsensor ,
654 2 irecvfrom ,dt2t ,neltst ,ityptst ,itab ,
655 3 xslv ,xmsr ,vslv ,vmsr ,intlist ,
656 4 nbintc ,size_t ,sensors%SENSOR_TAB,delta_pmax_gap,
657 5 intbuf_tab,delta_pmax_gap_node,idel7nok_sav,maxdgap,v)
664 1 intbuf_tab ,ipari ,dt2t ,neltst ,nsensor ,
665 2 ityptst ,xslv ,xmsr ,vslv ,vmsr ,
666 3 intstamp ,x21msr ,v21msr,sensors%SENSOR_TAB,nbintc21 ,
675 IF(tt>zero.AND.int7itied/=0)
THEN
685 IF((nspmd>1.AND.itask==0).AND.(h3d_data%N_SCAL_CSE_FRIC > 0.OR.output%DATA%NINEFRIC > 0).AND.tt > zero)
THEN
687 1 ipari ,intlist ,nbintc ,islen7 ,irlen7 ,
688 2 irlen7t ,islen7t ,irlen20 ,islen20,irlen20t,
689 3 islen20t,intbuf_tab,h3d_data )
693 IF(itask==0)
CALL stoptime(timers,120)
701 . intbuf_tab,sensors%SENSOR_TAB,nb_inter_sorted,list_inter_sorted,inter_struct)
714 1 intbuf_tab,nb_inter_sorted,list_inter_sorted,inter_struct)
723 DO kk=1,nb_inter_sorted
724 n = list_inter_sorted(kk)
725 ipari(22,n) = inter_struct(n)%INACTI
734 . ipari,iad_elem,fr_elem,x,v,
735 . ms,temp,kinet,nodnx_sms,itab,
736 . weight,intbuf_tab,inter_struct,sort_comm,nodnx_sms_siz,
737 . temp_siz,component )
740 CALL inter_sort(timers, itask,nb_inter_sorted,list_inter_sorted,retri,ipari,
741 1 nsensor,isendto,irecvfrom,intbuf_tab,x,itab,
742 2 renum,nsnfiold,multi_fvm,h3d_data,sensors%SENSOR_TAB,
743 3 inter_struct,sort_comm ,renum_siz,glob_therm)
765 IF(nty==7 .AND. inacti==7)type18=.true.
767 IF( imonm > 0 .AND. itask ==0 )
THEN
768 intbuf_tab(n)%METRIC%NOINT = ipari(15,n)
769 intbuf_tab(n)%METRIC%NCONT = ipari(18,n)
770 intbuf_tab(n)%METRIC%MULTIMP = ipari(23,n)
771 intbuf_tab(n)%METRIC%NSNR =
max(intbuf_tab(n)%METRIC%NSNR , ipari(24,n))
772 intbuf_tab(n)%METRIC%NSN = ipari(5,n)
777 IF(nty == 7.OR.nty == 11.OR.nty == 24.OR.nty == 25) isens = ipari(64,n)
779 ts = sensors%SENSOR_TAB(isens)%TSTART
784 IF(type18.OR.(nty==18))
THEN
786 nrtm_t = ipari(4,n)/nthread
787 eshift = itask*nrtm_t
788 IF(itask==nthread-1)nrtm_t=ipari(4,n)-(nthread-1)*nrtm_t
789 IF(intbuf_tab(n)%S_NIGE/=0)
THEN
790 x_ige(3*numnod+1:3*(numnod+intbuf_tab(n)%S_NIGE)) = intbuf_tab(n)%XIGE(1:3*intbuf_tab(n)%S_NIGE)
792 v_ige(3*numnod+1:3*(numnod+intbuf_tab(n)%S_NIGE)) = intbuf_tab(n)%VIGE(1:3*intbuf_tab(n)%S_NIGE)
794 ptr_ms => ms(1:numnod)
795 ptr_kinet => kinet(1:numnod)
796 ELSEIF (multi_fvm%IS_USED .AND. type18)
THEN
797 ptr_x => multi_fvm%X_APPEND
798 ptr_v => multi_fvm%V_APPEND
799 ptr_ms => multi_fvm%MASS_APPEND
800 ptr_kinet => multi_fvm%KINET_APPEND(1:numnod+numels)
804 ptr_ms => ms(1:numnod)
805 ptr_kinet => kinet(1:numnod)
808 1 ipari ,ptr_x ,ptr_v ,
809 2 ptr_ms ,n ,itask ,weight ,
810 3 isendto ,irecvfrom ,retri ,iad_elem,fr_elem ,
811 4 itab ,ptr_kinet ,temp ,nrtm_t ,renum ,
812 5 nsnfiold,eshift ,idum ,idum ,nodnx_sms ,
813 6 intbuf_tab(n),h3d_data,ixs,multi_fvm,glob_therm)
815 ELSEIF(nty == 10)
THEN
817 nrtm_t = ipari(4,n)/nthread
818 eshift = itask*nrtm_t
819 IF(itask==nthread-1)nrtm_t=ipari(4,n)-(nthread-1)*nrtm_t
821 1 npari ,ipari(1,n),x ,v ,
822 2 ms ,n ,itask ,wag ,weight ,
823 3 isendto ,irecvfrom ,retri ,iad_elem,fr_elem ,
824 4 nrtm_t ,renum ,nsnfiold ,eshift ,idum ,
825 5 idum ,nodnx_sms ,itab ,intbuf_tab(n) ,
826 6 h3d_data ,glob_therm)
828 ELSEIF(nty == 11.AND.tt>=ts)
THEN
830 nrtm_t = ipari(4,n)/nthread
831 eshift = itask*nrtm_t
832 IF(itask==nthread-1)nrtm_t=ipari(4,n)-(nthread-1)*nrtm_t
835 2 ms ,n ,itask ,weight ,isendto ,
836 3 irecvfrom ,retri ,iad_elem ,fr_elem ,itab ,
837 4 nrtm_t ,eshift ,nodnx_sms ,renum ,nsnfiold ,
838 5 intbuf_tab(n),temp ,glob_therm%NODADT_THERM)
840 ELSEIF(nty == 17)
THEN
842 IF(ipari(33,n) == 0)
THEN
847 IF(ipari(7,k) == 17.AND.ipari(33,k) == 0)
THEN
850 nmes =igrbric(ign)%NENTITY
851 nme =igrbric(ige)%NENTITY
852 iad17 = iad17+6*(nme+nmes)
858 nmes =igrbric(ign)%NENTITY
859 nme =igrbric(ige)%NENTITY
862 IF(itask==nthread-1)nme_t=nme-(nthread-1)*(nme/nthread)
864 1 ipari ,intbuf_tab(n),x ,n ,
865 2 itask ,igrbric ,nme ,nmes ,
866 3 eminx(iad17),ixs ,ixs16 ,ixs20 ,weight ,
867 3 isendto ,irecvfrom ,retri ,iad_elem,fr_elem ,
868 4 itab ,v ,nme_t ,eshift )
871 ELSEIF(nty == 20)
THEN
873 nrtm_t = ipari(4,n)/nthread
874 eshift = itask*nrtm_t
875 IF(itask==nthread-1)nrtm_t=ipari(4,n)-(nthread-1)*nrtm_t
879 3 isendto ,irecvfrom ,retri ,iad_elem,fr_elem ,
880 4 itab ,kinet ,temp ,nrtm_t ,renum ,
881 5 nsnfiold,eshift ,idum ,idum ,diag_sms,
882 6 nodnx_sms,intbuf_tab(n),h3d_data,glob_therm )
884 ELSEIF(nty == 22)
THEN
886 nrtm_t = ipari(4,n)/nthread
887 eshift = itask*nrtm_t
888 IF(itask==nthread-1)nrtm_t=ipari(4,n)-(nthread-1)*nrtm_t
891 2 ms ,n ,itask ,wag ,weight ,
892 3 isendto ,irecvfrom ,retri ,iad_elem ,fr_elem ,
893 4 itab ,kinet ,temp ,nrtm_t ,renum ,
894 5 nsnfiold ,eshift ,idum ,idum ,nodnx_sms
895 6 ixs ,igrbric ,ale_connectivity ,intbuf_tab(n),
896 7 count_remslv,h3d_data ,multi_fvm,glob_therm%NODADT_THERM)
899 1 x ,n ,itask ,ipari(48:50,n) ,itab ,
900 2 ixs ,ixtg ,v ,iparg ,elbuf_tab ,
910 nbf = 1+itask*
nb/nthread
911 nbl = (itask+1)*
nb/nthread
912 dx22min_l(itask) = ep30
923 dx22min_l(itask) =
min(dx22min_l(itask), len)
930 dx22_min =
min(dx22_min,dx22min_l(itask))
931#include "lockoff.inc"
934 ELSEIF(nty == 23)
THEN
936 nrtm_t = ipari(4,n)/nthread
937 eshift = itask*nrtm_t
938 IF(itask==nthread-1)nrtm_t=ipari(4,n)-(nthread-1)*nrtm_t
940 1 ipari ,x ,intbuf_tab(n),v ,
941 2 ms ,n ,itask ,wag ,weight ,
942 3 isendto ,irecvfrom ,retri ,iad_elem,fr_elem ,
943 4 itab ,kinet ,nrtm_t ,renum ,
944 5 nsnfiold,eshift ,idum ,idum ,nodnx_sms
945 6 h3d_data,multi_fvm,glob_therm%INTHEAT,glob_therm%IDT_THERM,glob_therm%NODADT_THERM
947 ELSEIF(nty == 24.AND.tt>=ts)
THEN
952 nrtm_t = (ipari(4,n)-ipari(42,n))/nthread
953 eshift = itask*nrtm_t
955 + -(nthread-1)*nrtm_t
956 nsne3 = 3*ipari(55,n)
961 ve(nnod3+1:(nnod3+nsne3)) = intbuf_tab(n)%VFIC(1:nsne3)
964 1 ipari ,xe ,ve ,intbuf_tab(n),
965 2 ms ,n ,itask ,wag ,weight ,
966 3 isendto ,irecvfrom ,retri ,iad_elem,fr_elem ,
967 4 itab ,kinet ,temp ,nrtm_t
968 5 nsnfiold,eshift ,idum ,idum ,nodnx_sms ,
969 6 h3d_data,t2main_sms ,forneqs ,t2fac_sms,interfaces%PARAMETERS,
970 7 glob_therm%INTHEAT,glob_therm%IDT_THERM,glob_therm%NODADT_THERM)
973 1 ipari ,x ,v ,intbuf_tab(n),
974 2 ms ,n ,itask ,wag ,weight ,
975 3 isendto ,irecvfrom ,retri ,iad_elem,fr_elem ,
976 4 itab ,kinet ,temp ,nrtm_t ,renum ,
977 5 nsnfiold,eshift ,idum ,idum ,nodnx_sms ,
978 6 h3d_data,t2main_sms ,forneqs ,t2fac_sms ,interfaces%PARAMETERS,
979 7 glob_therm%INTHEAT,glob_therm%IDT_THERM,glob_therm%NODADT_THERM)
982 ELSEIF(nty == 25.AND.tt>=ts)
THEN
984 nedge_t = ipari(68,n)/nthread
985 eshift = itask*nedge_t
986 IF(itask==nthread-1)nedge_t=ipari(68,n)
987 + -(nthread-1)*nedge_t
988 nrtm_t = (ipari(4,n)-ipari(42,n))/nthread
989 sshift = itask*nrtm_t
990 IF(itask==nthread-1)nrtm_t=(ipari(4,n)-ipari(42,n))
991 + -(nthread-1)*nrtm_t
993 1 ipari ,x ,v ,intbuf_tab(n),
994 2 ms ,n ,itask ,weight ,
995 3 isendto ,irecvfrom ,retri ,iad_elem,fr_elem ,
996 4 itab ,kinet ,temp ,renum ,
997 5 nsnfiold,idum ,idum ,nodnx_sms ,
998 6 h3d_data,eshift ,nedge_t ,sshift ,nrtm_t ,
1010 n = intstamp(kk)%NOINTER
1013 ts = sensors%SENSOR_TAB(isens)%TSTART
1021 2 itask ,weight ,retri21(n) ,idum ,idum ,
1022 3 intstamp(kk) ,wag,intbuf_tab(n),nspmd)
1023 IF(retri21(n)==1) retri = 1
1036 IF(nty == 7.OR.nty == 11.OR.nty == 24.OR.nty
1038 ts = sensors%SENSOR_TAB(isens)%TSTART
1044 inacti = ipari(22,n)
1045 IF(nty == 7 .AND. inacti ==7)type18=.true.
1047 IF((nty == 7.AND.tt>=ts).OR.nty == 18)
THEN
1049 nrtm_t = ipari(4,n)/nthread
1050 eshift = itask*nrtm_t
1051 IF(itask==nthread-1)nrtm_t=ipari(4,n)-(nthread-1)*nrtm_t
1052 IF(intbuf_tab(n)%S_NIGE/=0)
THEN
1053 x_ige(3*numnod+1:3*(numnod+intbuf_tab(n)%S_NIGE)) = intbuf_tab(n)%XIGE(1:3*intbuf_tab(n)%S_NIGE)
1055 v_ige(3*numnod+1:3*(numnod+intbuf_tab(n)%S_NIGE)) = intbuf_tab(n)%VIGE(1:3*intbuf_tab(n)%S_NIGE)
1057 ptr_ms => ms(1:numnod)
1058 ptr_kinet => kinet(1:numnod)
1059 ELSEIF (multi_fvm%IS_USED .AND. type18)
THEN
1060 ptr_x => multi_fvm%X_APPEND
1061 ptr_v => multi_fvm%V_APPEND
1062 ptr_ms => multi_fvm%MASS_APPEND
1067 ptr_ms => ms(1:numnod)
1068 ptr_kinet => kinet(1:numnod)
1071 1 ipari ,ptr_x ,ptr_v ,
1072 2 ptr_ms ,n ,itask ,weight ,
1073 3 isendto ,irecvfrom ,retri ,iad_elem,fr_elem ,
1074 4 itab ,ptr_kinet ,temp ,nrtm_t ,renum ,
1075 5 nsnfiold,eshift ,num_imp(n) ,ind_imp(iadi) ,nodnx_sms ,
1076 6 intbuf_tab(n),h3d_data,ixs,multi_fvm,glob_therm)
1077 iadi = iadi+num_imp(n)
1079 ELSEIF(nty == 24.AND.tt>=ts)
THEN
1084 nrtm_t = (ipari(4,n)-ipari(42,n))/nthread
1085 eshift = itask*nrtm_t
1086 IF(itask==nthread-1)nrtm_t=(ipari(4,n)-ipari(42,n))
1087 + -(nthread-1)*nrtm_t
1089 nsne3 = 3*ipari(55,n
1093 xe(nnod3+1:(nnod3+nsne3)) = intbuf_tab(n)%XFIC(1:nsne3)
1094 ve(nnod3+1:(nnod3+nsne3)) =
1097 1 ipari ,xe ,ve ,intbuf_tab(n),
1099 3 isendto ,irecvfrom ,retri ,iad_elem,fr_elem ,
1100 4 itab ,kinet ,temp ,nrtm_t ,renum ,
1101 5 nsnfiold,eshift ,num_imp(n) ,ind_imp(iadi),nodnx_sms ,
1102 6 h3d_data,t2main_sms ,forneqs ,t2fac_sms,interfaces%PARAMETERS,
1103 7 glob_therm%INTHEAT,glob_therm%IDT_THERM,glob_therm%NODADT_THERM)
1104 iadi = iadi+num_imp(n)
1108 2 ms ,n ,itask ,wag ,weight ,
1109 3 isendto ,irecvfrom ,retri ,iad_elem,fr_elem ,
1110 4 itab ,kinet ,temp ,nrtm_t ,renum ,
1111 5 nsnfiold,eshift ,num_imp(n
1112 6 h3d_data,t2main_sms ,forneqs ,t2fac_sms,interfaces%PARAMETERS,
1113 7 glob_therm%INTHEAT,glob_therm%IDT_THERM,glob_therm%NODADT_THERM)
1114 iadi = iadi+num_imp(n
1117 ELSEIF(nty == 25.AND.tt>=ts)
THEN
1120 eshift = itask*nedge_t
1121 IF(itask==nthread-1)nedge_t=ipari(68,n)
1122 + -(nthread-1)*nedge_t
1123 nrtm_t = (ipari(4,n)-ipari(42,n))/nthread
1124 sshift = itask*nrtm_t
1125 IF(itask==nthread-1)nrtm_t=(ipari(4,n)-ipari(42,n))
1126 + -(nthread-1)*nrtm_t
1129 1 ipari ,x ,v ,intbuf_tab(n),
1130 2 ms ,n ,itask ,weight ,
1131 3 isendto ,irecvfrom ,retri ,iad_elem,fr_elem ,
1132 4 itab ,kinet ,temp ,renum ,
1133 5 nsnfiold,num_imp(n) ,ind_imp(iadi),nodnx_sms ,
1134 6 h3d_data,eshift,nedge_t ,sshift ,nrtm_t ,
1135 7 icodt ,iskew ,interfaces%PARAMETERS,glob_therm%NODADT_THERM)
1136 iadi = iadi+num_imp(n)
1138 ELSEIF(nty == 10)
THEN
1140 nrtm_t = ipari(4,n)/nthread
1141 eshift = itask*nrtm_t
1142 IF(itask==nthread-1)nrtm_t=ipari(4,n)-(nthread-1)*nrtm_t
1144 1 npari ,ipari(1,n),x ,v ,
1145 2 ms ,n ,itask ,wag ,weight ,
1146 3 isendto ,irecvfrom ,retri ,iad_elem,fr_elem ,
1147 4 nrtm_t ,renum ,nsnfiold ,eshift ,num_imp(n),
1148 5 ind_imp(iadi) ,nodnx_sms,itab ,intbuf_tab(n) ,
1149 6 h3d_data, glob_therm)
1150 iadi = iadi+num_imp(n)
1152 ELSEIF(nty == 11.AND.tt>=ts)
THEN
1154 nrtm_t = ipari(4,n)/nthread
1155 eshift = itask*nrtm_t
1156 IF(itask==nthread-1)nrtm_t=ipari(4,n)-(nthread-1)*nrtm_t
1160 3 irecvfrom ,retri ,iad_elem ,fr_elem ,itab ,
1161 4 nrtm_t ,eshift ,nodnx_sms ,renum ,nsnfiold ,
1162 5 intbuf_tab(n),temp , glob_therm%NODADT_THERM)
1164 ELSEIF(nty == 17)
THEN
1166 IF(ipari(33,n) == 0)
THEN
1169 nmes =igrbric(ign)%NENTITY
1170 nme =igrbric(ige)%NENTITY
1172 eshift = itask*nme_t
1173 IF(itask==nthread-1)nme_t=nme-(nthread-1)*(nme/nthread
1175 1 ipari ,intbuf_tab(n),x ,n ,
1176 2 itask ,igrbric ,nme ,nmes ,
1177 3 eminx(iad17),ixs ,ixs16 ,ixs20 ,weight
1178 3 isendto ,irecvfrom ,retri ,iad_elem,fr_elem ,
1179 4 itab ,v ,nme_t ,eshift )
1180 iad17 = iad17+6*(nme+nmes)
1183 ELSEIF(nty == 20)
THEN
1185 nrtm_t = ipari(4,n)/nthread
1186 eshift = itask*nrtm_t
1187 IF(itask==nthread-1)nrtm_t=ipari(4,n)-(nthread-1)*nrtm_t
1190 2 ms ,n ,itask ,wag ,weight ,
1191 3 isendto ,irecvfrom ,retri ,iad_elem,fr_elem ,
1192 4 itab ,kinet ,temp ,nrtm_t ,renum ,
1193 5 nsnfiold,eshift ,num_imp(n) ,ind_imp(iadi),diag_sms,
1194 6 nodnx_sms,intbuf_tab(n),h3d_data,glob_therm)
1196 iadi = iadi+num_imp(n)
1209 IF(ninter25 /= 0)
THEN
1210 IF(itask == 0)
CALL stoptime(timers,17)
1212 IF(idel7nok_sav/=0)
THEN
1213 IF(itask == 0)
CALL stoptime(timers,2)
1214 IF(itask == 0)
CALL startime(timers,8)
1215 CALL i25main_free(timers,itask, ipari ,intbuf_tab ,intlist25, isendto,
1220 IF(itask == 0)
CALL startime(timers,2)
1221 IF(itask == 0)
CALL stoptime(timers,8)
1236 ts = sensors%SENSOR_TAB(isens)%TSTART
1244 1 n ,ipari ,intbuf_tab(n)
1245 2 itask ,itab ,kinet ,count_remslv,
1246 3 count_remslve, nb25_candt(itask+1), i_opt_stok(n))
1263 IF (imon>0 .AND. itask==0)
THEN
1266 CALL startime(timers,macro_timer_t25norm)
1270 1 intlist25,ipari ,intbuf_tab ,itask+1 ,x ,
1271 2 itab ,nsensor,sensors%SENSOR_TAB,iad_frnor,fr_nor
1272 3 iad_fredg,fr_edg,iad_elem ,fr_elem ,fskyn25 ,
1273 4 addcsrect,procnor)
1276 IF (imon>0 .AND. itask==0)
THEN
1277 CALL stoptime(timers,macro_timer_t25norm)
1278 CALL startime(timers,macro_timer_t25stfe)
1282 IF(idel7nok_sav > 0)
THEN
1286 IF(ipari(macro_iedge,nin) > 0)
THEN
1290 . intbuf_tab(nin)%STFE, ipari(macro_nedge,nin), intbuf_tab(nin)%LEDGE,
1291 . nin , isendto, irecvfrom, intbuf_tab(nin)%MPI_COMM, intbuf_tab(nin)%RANK,
1292 . intbuf_tab(nin)%NSPMD)
1299 IF (imon>0 .AND. itask==0)
THEN
1300 CALL stoptime(timers,macro_timer_t25stfe)
1308 IF (imon>0 .AND. itask==0)
THEN
1311 CALL startime(timers,macro_timer_t25sliding)
1315 IF (debug(3)>=1.AND.ncycle==0)
THEN
1316 nb25_candt(itask+1) = 0
1317 nb25_impct(itask+1) = 0
1318 nb25_dst1(itask+1) = 0
1319 nb25_dst2(itask+1) = 0
1323 1 ipari ,iad_elem ,fr_elem ,itab ,sensors%SENSOR_TAB,
1324 2 nsensor ,intlist25,intbuf_tab ,iad_frnor,fr_nor ,
1325 3 x ,v ,ms ,temp ,kinet ,
1326 4 nativ_sms,itask+1 ,nb25_dst2, main_proc,
1327 5 newfront ,isendto ,irecvfrom ,nbintc,
1328 6 intlist ,islen7 ,irlen7 ,irlen7t ,islen7t,
1329 7 nb25_dst1,h3d_data, icodt,iskew,interfaces%PARAMETERS,glob_therm%NODADT_THERM)
1333 IF (imon>0 .AND. itask==0)
THEN
1334 CALL stoptime(timers,macro_timer_t25sliding)
1339 IF(itask == 0)
CALL startime(timers,17)
1353 1 nsensor,irecvfrom,sensors%SENSOR_TAB,inter_struct,sort_comm )
1364 IF(imonm == 2 .AND. nspmd > 1)
THEN
1370 IF (nspmd > 1 .AND. (retri == 1 .OR. ninter25 > 0 ) )
THEN
1374 IF (imonm > 0)
CALL startime(timers,18)
1376 1 ipari ,newfront,isendto ,irecvfrom,
1377 2 nsensor ,nbintc ,intlist ,islen7 ,irlen7 ,
1378 3 islen11 ,irlen11 ,islen17 ,irlen17 ,irlen7t ,
1379 4 islen7t ,irlen20 ,islen20 ,irlen20t,islen20t ,
1380 5 irlen20e,islen20e,sensors%SENSOR_TAB,intbuf_tab, 1 )
1382 IF(nintstamp /= 0.AND.ftempvar21==1)
THEN
1384 1 ipari ,nsensor ,intbuf_tab, retri21,temp ,sensors%SENSOR_TAB,
1385 2 nbintc21,intlist21)
1389 IF (imonm > 0)
CALL stoptime(timers,18)
1392 IF (imonm > 0)
CALL startime(timers,19)
1411 IF(nty == 7.OR.nty == 11.OR.nty == 24.OR.nty == 25) isens = ipari(64,n)
1413 ts = sensors%SENSOR_TAB(isens)%TSTART
1419 inacti = ipari(22,n)
1420 IF(nty == 7 .AND. inacti ==7)type18
1423 IF(nty == 7.AND.tt>=ts)
THEN
1426 IF(intbuf_tab(n)%S_NIGE/=0)
THEN
1427 x_ige(3*numnod+1:3*(numnod+intbuf_tab(n)%S_NIGE)) = intbuf_tab(n)%XIGE(1:3*intbuf_tab(n)%S_NIGE)
1429 v_ige(3*numnod+1:3*(numnod+intbuf_tab(n)%S_NIGE)) = intbuf_tab(n)%VIGE(1:3*intbuf_tab(n)%S_NIGE)
1431 ELSEIF (multi_fvm%IS_USED .AND. type18)
THEN
1432 ptr_x => multi_fvm%X_APPEND
1433 ptr_v => multi_fvm%V_APPEND
1440 1 ipari ,ptr_x ,ptr_v,
1441 2 n ,itask ,count_remslv ,intbuf_tab(n),
1445 ELSEIF(nty == 10)
THEN
1449 2 n ,itask ,count_remslv ,intbuf_tab(n
1451 ELSEIF(nty == 11.AND.tt>=ts)
THEN
1454 1 ipari ,intbuf_tab(n),x ,v ,
1455 2 n ,itask ,count_remslv,
1458 ELSEIF(nty == 20)
THEN
1462 2 n ,itask ,count_remslv,count_remslve,
1465 ELSEIF(nty == 22)
THEN
1469 ELSEIF(nty == 23)
THEN
1472 1 ipari ,intbuf_tab(n),n ,itask ,
1475 ELSEIF(nty == 24.AND.tt>=ts)
THEN
1477 nsne3 = 3*ipari(55,n)
1481 xe(nnod3+1:(nnod3+nsne3)) = intbuf_tab(n)%XFIC(1:nsne3)
1482 ve(nnod3+1:(nnod3+nsne3)) = intbuf_tab(n)%VFIC(1:nsne3)
1485 1 ipari ,intbuf_tab(n),xe ,ve ,
1486 2 n ,itask ,count_remslv, t2main_sms,lskyi_sms_new)
1489 1 ipari ,intbuf_tab(n),x ,v ,
1490 2 n ,itask ,count_remslv, t2main_sms,lskyi_sms_new)
1493 ELSEIF(nty == 25.AND.tt>=ts)
THEN
1510 IF (nintstamp/=0)
THEN
1511 IF (debug(3)>=1.AND.ncycle==0)
THEN
1512 nb_stok_n(itask+1)=0
1518 n = intstamp(kk)%NOINTER
1522 ts = sensors%SENSOR_TAB(isens)%TSTART
1529 1 ipari ,intbuf_tab(n),n ,itask ,
1530 2 intstamp(kk),nb_stok_n,nb_jlt)
1535 IF (nintstamp/=0)
THEN
1536 IF (debug(3)>=1)
THEN
1537 IF(mod(ncycle+1,debug(3))==0)
THEN
1538 IF (nb_jlt(itask+1)==0)
THEN
1541 pct1 = hundred - hundred*nb_stok_n(itask+1)/nb_jlt
1543#include "lockon.inc"
1544 WRITE(istdo,
'(A,I6,A,I4,A,I4,A,I10,A,I10,2X,F5.2,A)')
1545 .
' NCYCLE = ',ncycle,
1546 .
' NSPMD = ',ispmd+1,
1547 .
' ITASK = ',itask+1,
1548 .
' CANDIDATS = ',nb_jlt(itask+1),
1549 .
' OPT CAND = ',nb_stok_n(itask+1),pct1,
'%'
1550#include "lockoff.inc"
1551 nb_stok_n(itask+1)=0
1562 IF (imonm > 0)
CALL stoptime(timers,19)
1563 IF (nsne_max>0 )
DEALLOCATE(xe,ve)
1567 IF( multi_fvm%IS_INT18_LAW151 )
THEN
1574 IF(ninter25 /= 0)
THEN
1579 IF (imon>0 .AND. itask==0)
THEN
1585 1 ipari ,itab ,sensors%SENSOR_TAB,intlist25,intbuf_tab ,
1586 2 x ,v ,kinet ,itask+1 ,nb25_dst2,
1587 3 icodt ,iskew ,nsensor )
1591 IF (imon>0 .AND. itask==0)
THEN
1601 IF ((nspmd > 1 .AND. (retri == 1 .OR. ninter25 > 0 )))
THEN
1608 IF (imonm > 0)
CALL startime(timers,18)
1611 1 ipari ,newfront,isendto ,irecvfrom,
1612 2 nsensor ,nbintc ,intlist ,islen7 ,irlen7 ,
1613 3 islen11 ,irlen11 ,islen17 ,irlen17 ,irlen7t ,
1614 4 islen7t ,irlen20 ,islen20 ,irlen20t,islen20t ,
1615 5 irlen20e,islen20e,sensors%SENSOR_TAB,intbuf_tab, 2)
1617 IF(ninter25e > 0)
THEN
1626 IF (imonm > 0)
CALL stoptime(timers,18)
1630 DEALLOCATE(x_ige,v_ige)