107 1 IPARI ,X ,W , ERRORS,
108 2 V ,MS ,IN ,IAD_ELEM ,
109 3 FR_ELEM ,VR ,ISENDTO ,IRECVFROM,
110 4 NEWFRONT ,ITASK ,WAG ,DT2T ,
111 5 ITAB ,NELTST ,ITYPTST ,WEIGHT ,
112 6 INTLIST ,NBINTC ,KINET ,DRETRI ,
113 7 ISLEN7 ,IRLEN7 ,ISLEN11 ,IRLEN11 ,
114 8 TEMP ,IGRBRIC ,IGRSH3N ,EMINX ,
115 9 IXS ,IXS16 ,IXS20 ,ISLEN17 ,
116 A IRLEN17 ,IRLEN7T ,ISLEN7T ,NUM_IMP ,
117 B IND_IMP ,INTSTAMP,THKNOD ,IRLEN20 ,
118 C ISLEN20 ,IRLEN20T,ISLEN20T,IRLEN20E ,
119 D ISLEN20E ,RENUM ,NSNFIOLD,XSLV ,
120 E XMSR ,VSLV ,VMSR ,SIZE_T ,
121 F NODNX_SMS,DXANCG ,IKINE ,DIAG_SMS ,
122 G COUNT_REMSLV, COUNT_REMSLVE,ALE_CONNECTIVITY,
123 H IXTG ,SENSORS ,DELTA_PMAX_GAP ,
124 I INTBUF_TAB ,DELTA_PMAX_GAP_NODE,
126 J NB25_CANDT,NB25_IMPCT,NB25_DST1,NB25_DST2,INTLIST25,
127 K IAD_FREDG,FR_EDG,MAIN_PROC,NATIV_SMS,I_OPT_STOK ,
128 L MULTI_FVM,IPARG ,ELBUF_TAB, H3D_DATA ,T2MAIN_SMS,
129 M LSKYI_SMS_NEW,FORNEQS,INT7ITIED,IDEL7NOK_SAV,MAXDGAP,
130 N T2FAC_SMS,ICODT,ISKEW,FSKYN25,ADDCSRECT,PROCNOR,
131 O INTER_STRUCT,SORT_COMM,RENUM_SIZ,NODNX_SMS_SIZ,TEMP_SIZ,
132 P INTERFACES,GLOB_THERM,component)
136 USE spmd_mod,
ONLY : spmd_barrier
159#include "implicit_f.inc"
160#include "comlock.inc"
165#include "com01_c.inc"
166#include "com04_c.inc"
167#include "com08_c.inc"
168#include "impl1_c.inc"
169#include "intstamp_c.inc"
170#include "param_c.inc"
172#include "timeri_c.inc"
174#include "units_c.inc"
175#include "inter22.inc"
179 TYPE(timer_),
INTENT(inout) :: TIMERS
180 INTEGER,
INTENT(INOUT) :: ERRORS
181 INTEGER,
INTENT(in) :: NODNX_SMS_SIZ
182 INTEGER IPARI(NPARI,*), IXS(*), IXS16(*), IXS20(*),
184 . NEWFRONT(*),NBINTC,INTLIST(*),
185 . ISENDTO(NSPMD+1,*),IRECVFROM(NSPMD+1,*),
186 . ITASK,NELTST ,ITYPTST,WEIGHT(*),
187 . IAD_ELEM(2,*) ,FR_ELEM(*),
188 . ISLEN7, IRLEN7, ISLEN11, IRLEN11, ISLEN17 ,IRLEN17,
189 . IRLEN7T ,ISLEN7T,IRLEN20,ISLEN20,IRLEN20T,ISLEN20T,
191 . IND_IMP(*),NUM_IMP(*),RENUM(*), NSNFIOLD(NSPMD),
192 . NODNX_SMS(NODNX_SMS_SIZ),IKINE(NUMNOD),I_MEM,COUNT_REMSLV(*),
193 . COUNT_REMSLVE(*), IXTG(NIXTG,*),DELTA_PMAX_GAP_NODE(*),
194 . IAD_FRNOR(NINTER25,*), FR_NOR(*), IAD_FREDG(NINTER25,*), FR_EDG(*),
195 . NB25_CANDT(PARASIZ), NB25_IMPCT(PARASIZ),
196 . NB25_DST1(PARASIZ), NB25_DST2(PARASIZ), IPARG(NPARG,*),
197 . INTLIST25(*), MAIN_PROC(*), NATIV_SMS(*), I_OPT_STOK(NINTER),
198 . T2MAIN_SMS(6,*), LSKYI_SMS_NEW, IDEL7NOK_SAV,
199 . ADDCSRECT(*), PROCNOR(*)
200 INTEGER,
INTENT(IN) :: ICODT(*), ISKEW(*)
205 INTEGER,
INTENT(IN) :: INT7ITIED
206 INTEGER,
DIMENSION(*),
TARGET :: KINET
207 INTEGER,
INTENT(in) :: TEMP_SIZ
211 . VR(3,*),IN(*),DT2T,, DRETRI(*), TEMP(TEMP_SIZ), EMINX(*),
212 . (*),DELTA_PMAX_GAP(NINTER),
213 . XSLV(18,NINTER),XMSR(12,NINTER),X21MSR(3,NINTSTAMP),
214 . VSLV(6,NINTER),VMSR(6,NINTER),V21MSR(3,NINTSTAMP),
215 . SIZE_T(NINTER),DXANCG(3,*), DIAG_SMS(*),
216 . FORNEQS(*), MAXDGAP(NINTER), T2FAC_SMS(*)
217 my_real,
TARGET :: X(3*NUMNOD),V(3*NUMNOD),W(3,NUMNOD)
218 my_real,
DIMENSION(*),
TARGET :: MS
221 TYPE(INTBUF_STRUCT_),
DIMENSION(NINTER) :: INTBUF_TAB
222 TYPE(MULTI_FVM_STRUCT),
INTENT(INOUT),
TARGET :: MULTI_FVM
223 TYPE(ELBUF_STRUCT_) ,
DIMENSION(NGROUP) :: ELBUF_TAB
224 TYPE(H3D_DATABASE) :: H3D_DATA
225 TYPE(t_ale_connectivity),
INTENT(IN) :: ALE_CONNECTIVITY
226 INTEGER,
INTENT(in) :: RENUM_SIZ
227 TYPE(inter_struct_type),
DIMENSION(NINTER),
INTENT(inout) :: INTER_STRUCT
228 TYPE(sorting_comm_type),
DIMENSION(NINTER),
INTENT(inout) :: SORT_COMM
229 TYPE (INTERFACES_) ,
INTENT(IN) :: INTERFACES
230 TYPE (SENSORS_) ,
INTENT(IN) :: SENSORS
232 TYPE () ,
DIMENSION(NGRBRIC) :: IGRBRIC
233 TYPE (GROUP_) ,
DIMENSION(NGRSH3N) :: IGRSH3N
234 TYPE (glob_therm_) ,
INTENT(IN) :: GLOB_THERM
235 type(
component_),
dimension(ninter),
intent(inout) :: component
239 INTEGER N, KK,LL, RETRI, NBLIST,NSENSOR,
240 . IAD17, IGN, IGE, NME, NMES,I,J,K,
241 . IDUM, IADI, ISTAMP, NRTM_T, NME_T, NEDGE_T, ESHIFT, SSHIFT, MULTIMP,
242 . ISENS,NBF,,IB, NIN,NSNE_MAX,NFIC,L_FIC,NNOD3,NSNE3,
243 . nbintc21,
SIZE, nrtm_fe_t, nrtm_ige_t, ithk
244 my_real pct1, ts,delta_pmax_dgap(ninter),len
245 INTEGER NB_STOK_N(PARASIZ),NB_JLT(PARASIZ),RETRI21(NINTER),NBCUT,
246 . INTLIST21(NINTSTAMP)
247 SAVE nb_stok_n,nb_jlt,nsne_max,nnod3
248 my_real,
DIMENSION(:),
ALLOCATABLE,
TARGET :: xe,ve
249 my_real,
DIMENSION(:),
ALLOCATABLE,
TARGET
250 my_real,
DIMENSION(:),
POINTER :: ptr_x,ptr_v,ptr_ms
251 INTEGER,
DIMENSION(:),
POINTER :: PTR_KINET
253 INTEGER :: IBRIC, NBRIC, II, INOD, NODEID, ISU1, IAD, INACTI
254 LOGICAL :: M151_ALLOC, TYPE18
255 SAVE xe,ve,m151_alloc
256 SAVE x_ige,v_ige,max_ige,size_x_ige
257 INTEGER :: MAX_IGE,SIZE_X_IGE
258 INTEGER :: NB_INTER_SORTED
259 INTEGER,
DIMENSION(NBINTC) :: LIST_INTER_SORTED
262 nsensor = sensors%NSENSOR
266 delta_pmax_gap_node(1:ninter)=0
269 IF(imonm == 2 .AND. nspmd > 1)
THEN
280 delta_pmax_gap(n)=zero
327 delta_pmax_dgap(n)=zero
331 n = intstamp(kk)%NOINTER
366 IF(nty == 7.OR.nty == 11.OR.nty == 24.OR.nty == 25)
367 . isens = ipari(64,n)
369 ts = sensors%SENSOR_TAB(isens)%TSTART
373 IF(nty == 24.AND.tt>=ts)
THEN
374 nsne_max =
max(nsne_max,ipari(55,n))
380 IF(intbuf_tab(n)%S_NIGE/=0)
THEN
381 max_ige =
max(max_ige,intbuf_tab(n)%S_NIGE)
384 IF (nsne_max>0 )
THEN
385 l_fic=3*(nsne_max+numnod)
387 ALLOCATE(xe(l_fic),ve(l_fic))
388 xe(1:nnod3) = x(1:nnod3)
389 ve(1:nnod3) = v(1:nnod3)
393 ALLOCATE( x_ige(3*(numnod+max_ige)) )
394 ALLOCATE( v_ige(3*(numnod+max_ige)) )
395 x_ige(1:3*numnod) = x(1:3*numnod)
396 v_ige(1:3*numnod) = v(1:3*numnod)
397 size_x_ige = 3*(numnod+max_ige)
408 IF( multi_fvm%IS_INT18_LAW151 )
THEN
417 n = intstamp(kk)%NOINTER
418 IF (ipari(47,n)==2)
THEN
419 nbintc21 = nbintc21 + 1
420 intlist21(nbintc21) = kk
426 IF(ncycle == 1 )
THEN
430 IF (nty == 24 .OR. nty == 25 )
THEN
431 IF(ipari(97,n) > 0.AND.ipari(98,n)==2)
THEN
440 IF(itask==0)
CALL startime(timers,120)
446 IF(nty == 7 .AND. inacti ==7)type18=.true
456 IF(nty == 7.OR.nty == 11.OR.nty == 24.OR.nty == 25) isens = ipari(64,n)
458 ts = sensors%SENSOR_TAB(isens)%TSTART
463 IF((nty == 7.AND.tt>=ts).OR.nty == 10.OR.nty == 18)
THEN
467 IF(intbuf_tab(n)%S_NIGE/=0)
THEN
468 x_ige(3*numnod+1:3*(numnod+intbuf_tab(n)%S_NIGE)) = intbuf_tab(n)%XIGE(1:3*intbuf_tab(n)%S_NIGE)
470 v_ige(3*numnod+1:3*(numnod+intbuf_tab(n)%S_NIGE)) = intbuf_tab(n)%VIGE(1:3*intbuf_tab(n)%S_NIGE)
472 ELSEIF (multi_fvm%IS_USED .AND. type18)
THEN
473 ptr_x => multi_fvm%X_APPEND
474 ptr_v => multi_fvm%V_APPEND
481 2 itask ,ptr_v ,xslv(1,n) ,xmsr(1,n),vslv(1,n),
482 3 vmsr(1,n),intbuf_tab(n))
484 ELSEIF(nty == 24.AND.tt>=ts)
THEN
502 1 ipari ,intbuf_tab(n),x ,n ,
503 2 itask ,v ,xslv(1,n) ,xmsr(1,n),vslv(1,n),
504 3 vmsr(1,n),delta_pmax_gap(n),delta_pmax_dgap(n),
505 4 delta_pmax_gap_node(n),itab)
509 ELSEIF(nty == 25.AND.tt>=ts)
THEN
516 1 ipari ,intbuf_tab(n),x ,n ,
517 2 itask ,v ,xslv(1,n) ,xmsr(1,n),vslv(1,n),
518 3 vmsr(1,n),delta_pmax_gap(n),delta_pmax_dgap(n),
519 4 delta_pmax_gap_node(n),itab)
525 1 ipari ,intbuf_tab(n) ,n ,itask ,
534 ELSEIF(nty == 11.AND.tt>=ts)
THEN
539 2 itask ,v ,xslv(1,n) ,xmsr(1,n),vslv(1,n),
540 3 vmsr(1,n) ,intbuf_tab(n))
542 ELSEIF(nty == 17)
THEN
544 IF(ipari(33,n) == 0)
THEN
549 IF(ipari(7,k) == 17.AND.ipari(33,k) == 0)
THEN
552 nmes =igrbric(ign)%NENTITY
553 nme =igrbric(ige)%NENTITY
554 iad17 = iad17+6*(nme+nmes)
561 nmes =igrbric(ign)%NENTITY
562 nme =igrbric(ige)%NENTITY
564 1 ipari,intbuf_tab(n),x ,n ,
565 2 itask,igrbric ,eminx(iad17),nme,
566 3 nmes ,xslv(1,n) ,xmsr(1,n) , size_t ,ixs,
570 ELSEIF(nty == 20)
THEN
576 2 itask ,v ,xslv(1,n) ,xmsr(1,n),vslv(1,n),
577 3 vmsr(1,n),ms ,dxancg ,ikine ,diag_sms ,
578 4 intbuf_tab(n) ,h3d_data)
580 ELSEIF(nty == 22)
THEN
584 ELSEIF(nty == 23)
THEN
590 2 itask ,v ,xslv(1,n) ,xmsr(1,n),vslv(1,n),
591 3 vmsr(1,n),intbuf_tab(n))
601 n = intstamp(kk)%NOINTER
604 ts = sensors%SENSOR_TAB(isens)%TSTART
608 x21msr(1:3,kk) = zero
609 v21msr(1:3,kk) = zero
615 1 ipari ,intbuf_tab(n),n ,itask ,
620 1 ipari ,intbuf_tab(n),n ,itask )
623 1 ipari ,intbuf_tab(n),x ,n ,
624 2 itask ,v ,xslv(1,n) ,xmsr(1,n),vslv(1,n),
625 3 vmsr(1,n),intstamp(kk) ,x21msr(1,kk) ,v21msr(1,kk))
637 IF(imonm == 2 .AND. nspmd > 1)
THEN
648 1 errors, ipari ,newfront ,isendto ,nsensor ,
649 2 irecvfrom ,dt2t ,neltst ,ityptst ,itab ,
650 3 xslv ,xmsr ,vslv ,vmsr ,intlist ,
651 4 nbintc ,size_t ,sensors%SENSOR_TAB,delta_pmax_gap,
652 5 intbuf_tab,delta_pmax_gap_node,idel7nok_sav,maxdgap,v)
659 1 intbuf_tab ,ipari ,dt2t ,neltst ,nsensor ,
660 2 ityptst ,xslv ,xmsr ,vslv ,vmsr ,
661 3 intstamp ,x21msr ,v21msr,sensors%SENSOR_TAB,nbintc21 ,
670 IF(tt>zero.AND.int7itied/=0)
THEN
680 IF((nspmd>1.AND.itask==0).AND.(h3d_data%N_SCAL_CSE_FRIC > 0.OR.
ninefric > 0).AND.tt > zero)
THEN
682 1 ipari ,intlist ,nbintc ,islen7 ,irlen7 ,
683 2 irlen7t ,islen7t ,irlen20 ,islen20,irlen20t,
684 3 islen20t,intbuf_tab,h3d_data )
688 IF(itask==0)
CALL stoptime(timers,120)
696 . intbuf_tab,sensors%SENSOR_TAB,nb_inter_sorted,list_inter_sorted,inter_struct)
709 1 intbuf_tab,nb_inter_sorted,list_inter_sorted
718 DO kk=1,nb_inter_sorted
719 n = list_inter_sorted(kk)
720 ipari(22,n) = inter_struct(n)%INACTI
729 . ipari,iad_elem,fr_elem,x,v,
730 . ms,temp,kinet,nodnx_sms,itab,
731 . weight,intbuf_tab,inter_struct,sort_comm,nodnx_sms_siz,
732 . temp_siz,component )
735 CALL inter_sort(timers, itask,nb_inter_sorted,list_inter_sorted,retri,ipari,
736 1 nsensor,isendto,irecvfrom,intbuf_tab,x,itab,
737 2 renum,nsnfiold,multi_fvm,h3d_data,sensors%SENSOR_TAB,
738 3 inter_struct,sort_comm ,renum_siz,glob_therm)
760 IF(nty==7 .AND. inacti==7)type18=.true.
763 intbuf_tab(n)%METRIC%NOINT = ipari(15,n)
764 intbuf_tab(n)%METRIC%NCONT = ipari(18,n)
765 intbuf_tab(n)%METRIC%MULTIMP = ipari(23,n)
766 intbuf_tab(n)%METRIC%NSNR =
max(intbuf_tab(n)%METRIC%NSNR , ipari(24,n))
767 intbuf_tab(n)%METRIC%NSN = ipari(5,n)
772 IF(nty == 7.OR.nty == 11.OR.nty == 24.OR.nty == 25) isens = ipari(64,n)
774 ts = sensors%SENSOR_TAB(isens)%TSTART
779 IF(type18.OR.(nty==18))
THEN
781 nrtm_t = ipari(4,n)/nthread
782 eshift = itask*nrtm_t
783 IF(itask==nthread-1)nrtm_t=ipari(4,n)-(nthread-1)*nrtm_t
784 IF(intbuf_tab(n)%S_NIGE/=0)
THEN
785 x_ige(3*numnod+1:3*(numnod+intbuf_tab(n)%S_NIGE)) = intbuf_tab(n)%XIGE(1:3*intbuf_tab(n)%S_NIGE)
787 v_ige(3*numnod+1:3*(numnod+intbuf_tab(n)%S_NIGE)) = intbuf_tab(n)%VIGE(1:3*intbuf_tab(n)%S_NIGE)
789 ptr_ms => ms(1:numnod)
790 ptr_kinet => kinet(1:numnod)
791 ELSEIF (multi_fvm%IS_USED .AND. type18)
THEN
793 ptr_v => multi_fvm%V_APPEND
794 ptr_ms => multi_fvm%MASS_APPEND
795 ptr_kinet => multi_fvm%KINET_APPEND(1:numnod+numels)
799 ptr_ms => ms(1:numnod)
800 ptr_kinet => kinet(1:numnod)
803 1 ipari ,ptr_x ,ptr_v ,
804 2 ptr_ms ,n ,itask ,wag ,weight ,
805 3 isendto ,irecvfrom ,retri ,iad_elem,fr_elem ,
806 4 itab ,ptr_kinet ,temp ,nrtm_t ,renum ,
807 5 nsnfiold,eshift ,idum ,idum ,nodnx_sms ,
808 6 intbuf_tab(n),h3d_data,ixs,multi_fvm,glob_therm)
810 ELSEIF(nty == 10)
THEN
812 nrtm_t = ipari(4,n)/nthread
813 eshift = itask*nrtm_t
814 IF(itask==nthread-1)nrtm_t=ipari(4,n)-(nthread-1)*nrtm_t
816 1 npari ,ipari(1,n),x ,v ,
817 2 ms ,n ,itask ,wag ,weight
818 3 isendto ,irecvfrom ,retri ,iad_elem,fr_elem ,
819 4 nrtm_t ,renum ,nsnfiold ,eshift ,idum ,
820 5 idum ,nodnx_sms ,itab ,intbuf_tab(n) ,
821 6 h3d_data ,glob_therm)
823 ELSEIF(nty == 11.AND.tt>=ts)
THEN
825 nrtm_t = ipari(4,n)/nthread
826 eshift = itask*nrtm_t
827 IF(itask==nthread-1)nrtm_t=ipari(4,n)-(nthread-1)*nrtm_t
830 2 ms ,n ,itask ,weight
831 3 irecvfrom ,retri ,iad_elem ,fr_elem ,itab ,
832 4 nrtm_t ,eshift ,nodnx_sms ,renum ,nsnfiold ,
833 5 intbuf_tab(n),temp ,glob_therm%NODADT_THERM)
835 ELSEIF(nty == 17)
THEN
837 IF(ipari(33,n) == 0)
THEN
842 IF(ipari(7,k) == 17.AND.ipari(33,k) == 0)
THEN
845 nmes =igrbric(ign)%NENTITY
846 nme =igrbric(ige)%NENTITY
847 iad17 = iad17+6*(nme+nmes)
853 nmes =igrbric(ign)%NENTITY
854 nme =igrbric(ige)%NENTITY
857 IF(itask==nthread-1)nme_t=nme-(nthread-1)*(nme/nthread)
859 1 ipari ,intbuf_tab(n),x ,n ,
860 2 itask ,igrbric ,nme ,nmes ,
861 3 eminx(iad17),ixs ,ixs16 ,ixs20 ,weight ,
862 3 isendto ,irecvfrom ,retri ,iad_elem,fr_elem ,
863 4 itab ,v ,nme_t ,eshift )
866 ELSEIF(nty == 20)
THEN
868 nrtm_t = ipari(4,n)/nthread
869 eshift = itask*nrtm_t
870 IF(itask==nthread-1)nrtm_t=ipari(4,n)-(nthread-1)*nrtm_t
873 2 ms ,n ,itask ,wag ,weight ,
874 3 isendto ,irecvfrom ,retri ,iad_elem,fr_elem ,
875 4 itab ,kinet ,temp ,nrtm_t ,renum ,
876 5 nsnfiold,eshift ,idum ,idum ,diag_sms,
877 6 nodnx_sms,intbuf_tab(n),h3d_data,glob_therm )
879 ELSEIF(nty == 22)
THEN
881 nrtm_t = ipari(4,n)/nthread
882 eshift = itask*nrtm_t
883 IF(itask==nthread-1)nrtm_t=ipari(4,n)-(nthread-1)*nrtm_t
886 2 ms ,n ,itask ,wag ,weight ,
887 3 isendto ,irecvfrom ,retri ,iad_elem ,fr_elem ,
888 4 itab ,kinet ,temp ,nrtm_t ,renum ,
889 5 nsnfiold ,eshift ,idum ,idum ,nodnx_sms ,
890 6 ixs ,igrbric ,ale_connectivity ,intbuf_tab(n),
891 7 count_remslv,h3d_data ,multi_fvm,glob_therm%NODADT_THERM)
894 1 x ,n ,itask ,ipari(48:50,n) ,itab ,
895 2 ixs ,ixtg ,v ,iparg ,elbuf_tab ,
905 nbf = 1+itask*
nb/nthread
906 nbl = (itask+1)*
nb/nthread
907 dx22min_l(itask) = ep30
918 dx22min_l(itask) =
min(dx22min_l(itask), len)
925 dx22_min =
min(dx22_min,dx22min_l(itask))
926#include
"lockoff.inc"
929 ELSEIF(nty == 23)
THEN
931 nrtm_t = ipari(4,n)/nthread
932 eshift = itask*nrtm_t
933 IF(itask==nthread-1)nrtm_t=ipari(4,n)-(nthread-1)*nrtm_t
935 1 ipari ,x ,intbuf_tab(n),v ,
936 2 ms ,n ,itask ,wag ,weight ,
937 3 isendto ,irecvfrom ,retri ,iad_elem,fr_elem ,
938 4 itab ,kinet ,nrtm_t ,renum ,
939 5 nsnfiold,eshift ,idum ,idum ,nodnx_sms ,
940 6 h3d_data,multi_fvm,glob_therm%INTHEAT,glob_therm%IDT_THERM,glob_therm%NODADT_THERM)
942 ELSEIF(nty == 24.AND.tt>=ts)
THEN
947 nrtm_t = (ipari(4,n)-ipari(42,n))/nthread
948 eshift = itask*nrtm_t
949 IF(itask==nthread-1)nrtm_t=(ipari(4,n)-ipari(42,n))
950 + -(nthread-1)*nrtm_t
951 nsne3 = 3*ipari(55,n)
955 xe(nnod3+1:(nnod3+nsne3)) = intbuf_tab(n)%XFIC(1:nsne3)
956 ve(nnod3+1:(nnod3+nsne3)) = intbuf_tab(n)%VFIC(1:nsne3)
959 1 ipari ,xe ,ve ,intbuf_tab(n),
960 2 ms ,n ,itask ,wag ,weight ,
961 3 isendto ,irecvfrom ,retri ,iad_elem,fr_elem ,
962 4 itab ,kinet ,temp ,nrtm_t ,renum ,
963 5 nsnfiold,eshift ,idum ,idum ,nodnx_sms ,
964 6 h3d_data,t2main_sms ,forneqs ,t2fac_sms,interfaces%PARAMETERS,
965 7 glob_therm%INTHEAT,glob_therm%IDT_THERM,glob_therm%NODADT_THERM)
968 1 ipari ,x ,v ,intbuf_tab(n),
969 2 ms ,n ,itask ,wag ,weight ,
970 3 isendto ,irecvfrom ,retri ,iad_elem,fr_elem ,
971 4 itab ,kinet ,temp ,nrtm_t
972 5 nsnfiold,eshift ,idum ,idum ,nodnx_sms ,
973 6 h3d_data,t2main_sms ,forneqs ,t2fac_sms ,interfaces%PARAMETERS,
974 7 glob_therm%INTHEAT,glob_therm%IDT_THERM,glob_therm%NODADT_THERM)
977 ELSEIF(nty == 25.AND.tt>=ts)
THEN
979 nedge_t = ipari(68,n)/nthread
980 eshift = itask*nedge_t
981 IF(itask==nthread-1)nedge_t=ipari(68,n)
982 + -(nthread-1)*nedge_t
983 nrtm_t = (ipari(4,n)-ipari(42,n))/nthread
984 sshift = itask*nrtm_t
985 IF(itask==nthread-1)nrtm_t=(ipari(4,n)-ipari(42,n))
986 + -(nthread-1)*nrtm_t
988 1 ipari ,x ,v ,intbuf_tab(n),
989 2 ms ,n ,itask ,weight ,
990 3 isendto ,irecvfrom ,retri ,iad_elem,fr_elem ,
991 4 itab ,kinet ,temp ,renum ,
992 5 nsnfiold,idum ,idum ,nodnx_sms ,
993 6 h3d_data,eshift ,nedge_t ,sshift ,nrtm_t ,
994 7 icodt ,iskew ,interfaces%PARAMETERS,glob_therm%NODADT_THERM)
1005 n = intstamp(kk)%NOINTER
1008 ts = sensors%SENSOR_TAB(isens)%TSTART
1016 2 itask ,weight ,retri21(n) ,idum ,idum ,
1017 3 intstamp(kk) ,wag,intbuf_tab(n),nspmd)
1018 IF(retri21(n)==1) retri = 1
1031 IF(nty == 7.OR.nty == 11.OR.nty == 24.OR.nty == 25) isens = ipari(64,n)
1033 ts = sensors%SENSOR_TAB(isens)%TSTART
1039 inacti = ipari(22,n)
1040 IF(nty == 7 .AND. inacti ==7)type18=.true.
1042 IF((nty == 7.AND.tt>=ts).OR.nty == 18)
THEN
1044 nrtm_t = ipari(4,n)/nthread
1045 eshift = itask*nrtm_t
1046 IF(itask==nthread-1)nrtm_t=ipari(4,n)-(nthread-1)*nrtm_t
1047 IF(intbuf_tab(n)%S_NIGE/=0)
THEN
1048 x_ige(3*numnod+1:3*(numnod+intbuf_tab(n)%S_NIGE)) = intbuf_tab(n)%XIGE(1:3*intbuf_tab(n)%S_NIGE)
1050 v_ige(3*numnod+1:3*(numnod+intbuf_tab(n)%S_NIGE)) = intbuf_tab(n)%VIGE(1:3*intbuf_tab(n)%S_NIGE)
1052 ptr_ms => ms(1:numnod)
1053 ptr_kinet => kinet(1:numnod)
1054 ELSEIF (multi_fvm%IS_USED .AND. type18)
THEN
1055 ptr_x => multi_fvm%X_APPEND
1056 ptr_v => multi_fvm%V_APPEND
1057 ptr_ms => multi_fvm%MASS_APPEND
1058 ptr_kinet => multi_fvm%KINET_APPEND(1:numnod+numels)
1062 ptr_ms => ms(1:numnod)
1063 ptr_kinet => kinet(1:numnod)
1066 1 ipari ,ptr_x ,ptr_v ,
1067 2 ptr_ms ,n ,itask ,wag ,weight ,
1068 3 isendto ,irecvfrom ,retri ,iad_elem,fr_elem ,
1069 4 itab ,ptr_kinet ,temp ,nrtm_t ,renum ,
1070 5 nsnfiold,eshift ,num_imp(n) ,ind_imp(iadi) ,nodnx_sms ,
1071 6 intbuf_tab(n),h3d_data,ixs,multi_fvm,glob_therm)
1072 iadi = iadi+num_imp(n)
1074 ELSEIF(nty == 24.AND.tt>=ts)
THEN
1079 nrtm_t = (ipari(4,n)-ipari(42,n))/nthread
1080 eshift = itask*nrtm_t
1081 IF(itask==nthread-1)nrtm_t=(ipari(4,n)-ipari(42,n))
1082 + -(nthread-1)*nrtm_t
1084 nsne3 = 3*ipari(55,n)
1088 xe(nnod3+1:(nnod3+nsne3)) = intbuf_tab(n)%XFIC(1:nsne3)
1089 ve(nnod3+1:(nnod3+nsne3)) = intbuf_tab(n)%VFIC(1:nsne3)
1092 1 ipari ,xe ,ve ,intbuf_tab(n),
1093 2 ms ,n ,itask ,wag ,weight ,
1094 3 isendto ,irecvfrom ,retri ,iad_elem,fr_elem ,
1095 4 itab ,kinet ,temp ,nrtm_t ,renum ,
1096 5 nsnfiold,eshift ,num_imp(n) ,ind_imp(iadi),nodnx_sms ,
1097 6 h3d_data,t2main_sms ,forneqs ,t2fac_sms,interfaces%PARAMETERS,
1098 7 glob_therm%INTHEAT,glob_therm%IDT_THERM,glob_therm%NODADT_THERM)
1099 iadi = iadi+num_imp(n)
1102 1 ipari ,x ,v ,intbuf_tab(n),
1103 2 ms ,n ,itask ,wag ,weight ,
1104 3 isendto ,irecvfrom ,retri ,iad_elem,fr_elem ,
1105 4 itab ,kinet ,temp ,nrtm_t ,renum ,
1106 5 nsnfiold,eshift ,num_imp(n
1107 6 h3d_data,t2main_sms ,forneqs ,t2fac_sms,interfaces%PARAMETERS,
1108 7 glob_therm%INTHEAT,glob_therm%IDT_THERM,glob_therm%NODADT_THERM)
1109 iadi = iadi+num_imp(n)
1112 ELSEIF(nty == 25.AND.tt>=ts)
THEN
1114 nedge_t = ipari(68,n)/nthread
1115 eshift = itask*nedge_t
1116 IF(itask==nthread-1)nedge_t=ipari(68,n)
1117 + -(nthread-1)*nedge_t
1118 nrtm_t = (ipari(4,n)-ipari(42,n))/nthread
1119 sshift = itask*nrtm_t
1120 IF(itask==nthread-1)nrtm_t=(ipari(4,n)-ipari(42,n))
1121 + -(nthread-1)*nrtm_t
1124 1 ipari ,x ,v ,intbuf_tab(n),
1125 2 ms ,n ,itask ,weight ,
1126 3 isendto ,irecvfrom ,retri ,iad_elem,fr_elem
1127 4 itab ,kinet ,temp ,renum ,
1128 5 nsnfiold,num_imp(n) ,ind_imp(iadi),nodnx_sms ,
1129 6 h3d_data,eshift,nedge_t ,sshift ,nrtm_t ,
1130 7 icodt ,iskew ,interfaces%PARAMETERS,glob_therm%NODADT_THERM)
1131 iadi = iadi+num_imp(n)
1133 ELSEIF(nty == 10)
THEN
1135 nrtm_t = ipari(4,n)/nthread
1136 eshift = itask*nrtm_t
1137 IF(itask==nthread-1)nrtm_t=ipari(4,n)-(nthread-1)*nrtm_t
1139 1 npari ,ipari(1,n),x ,v ,
1141 3 isendto ,irecvfrom ,retri ,iad_elem,fr_elem ,
1142 4 nrtm_t ,renum ,nsnfiold ,eshift ,num_imp(n),
1143 5 ind_imp(iadi) ,nodnx_sms,itab ,intbuf_tab(n) ,
1144 6 h3d_data, glob_therm)
1145 iadi = iadi+num_imp(n)
1147 ELSEIF(nty == 11.AND.tt>=ts)
THEN
1149 nrtm_t = ipari(4,n)/nthread
1150 eshift = itask*nrtm_t
1151 IF(itask==nthread-1)nrtm_t=ipari(4,n)-(nthread-1)*nrtm_t
1154 2 ms ,n ,itask ,weight ,isendto ,
1155 3 irecvfrom ,retri ,iad_elem ,fr_elem ,itab ,
1156 4 nrtm_t ,eshift ,nodnx_sms ,renum ,nsnfiold ,
1157 5 intbuf_tab(n),temp , glob_therm%NODADT_THERM)
1159 ELSEIF(nty == 17)
THEN
1161 IF(ipari(33,n) == 0)
THEN
1164 nmes =igrbric(ign)%NENTITY
1165 nme =igrbric(ige)%NENTITY
1167 eshift = itask*nme_t
1168 IF(itask==nthread-1)nme_t=nme-(nthread-1)*(nme/nthread)
1170 1 ipari ,intbuf_tab(n),x ,n ,
1171 2 itask ,igrbric ,nme
1172 3 eminx(iad17),ixs ,ixs16 ,ixs20 ,weight ,
1173 3 isendto ,irecvfrom ,retri ,iad_elem,fr_elem ,
1174 4 itab ,v ,nme_t ,eshift )
1175 iad17 = iad17+6*(nme+nmes)
1178 ELSEIF(nty == 20)
THEN
1180 nrtm_t = ipari(4,n)/nthread
1181 eshift = itask*nrtm_t
1182 IF(itask==nthread-1)nrtm_t=ipari(4,n)-(nthread-1)*nrtm_t
1185 2 ms ,n ,itask ,wag ,weight ,
1186 3 isendto ,irecvfrom ,retri ,iad_elem,fr_elem ,
1187 4 itab ,kinet ,temp ,nrtm_t ,renum ,
1188 5 nsnfiold,eshift ,num_imp(n) ,ind_imp(iadi),diag_sms,
1189 6 nodnx_sms,intbuf_tab(n),h3d_data,glob_therm)
1204 IF(ninter25 /= 0)
THEN
1205 IF(itask == 0)
CALL stoptime(timers,17)
1207 IF(idel7nok_sav/=0)
THEN
1208 IF(itask == 0)
CALL stoptime(timers,2)
1209 IF(itask == 0)
CALL startime(timers
1210 CALL i25main_free(timers,itask, ipari ,intbuf_tab ,intlist25, isendto,
1215 IF(itask == 0)
CALL startime(timers,2)
1216 IF(itask == 0)
CALL stoptime(timers,8)
1231 ts = sensors%SENSOR_TAB(isens)%TSTART
1239 1 n ,ipari ,intbuf_tab(n),x ,v ,
1240 2 itask ,itab ,kinet ,count_remslv,
1241 3 count_remslve, nb25_candt(itask+1), i_opt_stok(n))
1258 IF (imon>0 .AND. itask==0)
THEN
1261 CALL startime(timers,macro_timer_t25norm)
1265 1 intlist25,ipari ,intbuf_tab ,itask+1 ,x ,
1266 2 itab ,nsensor,sensors%SENSOR_TAB,iad_frnor,fr_nor
1267 3 iad_fredg,fr_edg,iad_elem ,fr_elem ,fskyn25 ,
1268 4 addcsrect,procnor)
1271 IF (imon>0 .AND. itask==0)
THEN
1272 CALL stoptime(timers,macro_timer_t25norm)
1273 CALL startime(timers,macro_timer_t25stfe)
1277 IF(idel7nok_sav > 0)
THEN
1280 IF(ipari(macro_iedge,nin) > 0)
THEN
1284 . intbuf_tab(nin)%STFE, ipari(macro_nedge,nin), intbuf_tab(nin)%LEDGE,
1285 . nin , isendto, irecvfrom, intbuf_tab(nin)%MPI_COMM, intbuf_tab(nin)%RANK,
1286 . intbuf_tab(nin)%NSPMD)
1293 IF (imon>0 .AND. itask==0)
THEN
1294 CALL stoptime(timers,macro_timer_t25stfe)
1302 IF (imon>0 .AND. itask==0)
THEN
1305 CALL startime(timers,macro_timer_t25sliding)
1309 IF (debug(3)>=1.AND.ncycle==0)
THEN
1310 nb25_candt(itask+1) = 0
1311 nb25_impct(itask+1) = 0
1312 nb25_dst1(itask+1) = 0
1313 nb25_dst2(itask+1) = 0
1317 1 ipari ,iad_elem ,fr_elem ,itab
1318 2 nsensor ,intlist25,intbuf_tab ,iad_frnor,fr_nor ,
1319 3 x ,v ,ms ,temp ,kinet ,
1320 4 nativ_sms,itask+1 ,nb25_dst2, main_proc,
1321 5 newfront ,isendto ,irecvfrom ,nbintc,
1322 6 intlist ,islen7 ,irlen7 ,irlen7t ,islen7t
1323 7 nb25_dst1,h3d_data, icodt,iskew,interfaces%PARAMETERS,glob_therm%NODADT_THERM)
1327 IF (imon>0 .AND. itask==0)
THEN
1328 CALL stoptime(timers,macro_timer_t25sliding
1333 IF(itask == 0)
CALL startime(timers,17)
1347 1 nsensor,irecvfrom,sensors%SENSOR_TAB,inter_struct,sort_comm )
1358 IF(imonm == 2 .AND. nspmd > 1)
THEN
1364 IF (nspmd > 1 .AND. (retri == 1 .OR. ninter25 > 0 ) )
THEN
1368 IF (imonm > 0)
CALL startime(timers,18)
1370 1 ipari ,newfront,isendto ,irecvfrom,
1371 2 nsensor ,nbintc ,intlist ,islen7 ,irlen7 ,
1372 3 islen11 ,irlen11 ,islen17 ,irlen17 ,irlen7t ,
1373 4 islen7t ,irlen20 ,islen20 ,irlen20t,islen20t ,
1374 5 irlen20e,islen20e,sensors%SENSOR_TAB,intbuf_tab, 1 )
1376 IF(nintstamp /= 0.AND.ftempvar21==1)
THEN
1378 1 ipari ,nsensor ,intbuf_tab, retri21,temp ,sensors%SENSOR_TAB,
1379 2 nbintc21,intlist21)
1383 IF (imonm > 0)
CALL stoptime(timers,18)
1386 IF (imonm > 0)
CALL startime(timers,19)
1405 IF(nty == 7.OR.nty == 11.OR.nty == 24.OR.nty == 25) isens = ipari(64,n)
1407 ts = sensors%SENSOR_TAB(isens)%TSTART
1413 inacti = ipari(22,n)
1414 IF(nty == 7 .AND. inacti ==7)type18=.true.
1417 IF(nty == 7.AND.tt>=ts)
THEN
1420 IF(intbuf_tab(n)%S_NIGE/=0)
THEN
1421 x_ige(3*numnod+1:3*(numnod+intbuf_tab(n)%S_NIGE)) = intbuf_tab(n)%XIGE(1:3*intbuf_tab(n)%S_NIGE)
1423 v_ige(3*numnod+1:3*(numnod+intbuf_tab(n)%S_NIGE)) = intbuf_tab(n)%VIGE(1:3*intbuf_tab(n)%S_NIGE)
1425 ELSEIF (multi_fvm%IS_USED .AND. type18)
THEN
1426 ptr_x => multi_fvm%X_APPEND
1427 ptr_v => multi_fvm%V_APPEND
1434 1 ipari ,ptr_x ,ptr_v,
1435 2 n ,itask ,count_remslv ,intbuf_tab(n),
1439 ELSEIF(nty == 10)
THEN
1443 2 n ,itask ,count_remslv ,intbuf_tab(n),lskyi_sms_new)
1445 ELSEIF(nty == 11.AND.tt>=ts)
THEN
1448 1 ipari ,intbuf_tab(n),x ,v ,
1449 2 n ,itask ,count_remslv,
1452 ELSEIF(nty == 20)
THEN
1456 2 n ,itask ,count_remslv,count_remslve,
1459 ELSEIF(nty == 22)
THEN
1463 ELSEIF(nty == 23)
THEN
1466 1 ipari ,intbuf_tab(n),n
1469 ELSEIF(nty == 24.AND.tt>=ts)
THEN
1471 nsne3 = 3*ipari(55,n)
1475 xe(nnod3+1:(nnod3+nsne3)) = intbuf_tab(n)%XFIC(1:nsne3)
1476 ve(nnod3+1:(nnod3+nsne3)) = intbuf_tab(n)%VFIC(1:nsne3)
1479 1 ipari ,intbuf_tab(n),xe ,ve ,
1480 2 n ,itask ,count_remslv, t2main_sms,lskyi_sms_new)
1483 1 ipari ,intbuf_tab(n),x ,v ,
1484 2 n ,itask ,count_remslv, t2main_sms,lskyi_sms_new)
1487 ELSEIF(nty == 25.AND.tt>=ts)
THEN
1504 IF (nintstamp/=0)
THEN
1505 IF (debug(3)>=1.AND.ncycle==0)
THEN
1506 nb_stok_n(itask+1)=0
1512 n = intstamp(kk)%NOINTER
1516 ts = sensors%SENSOR_TAB(isens)%TSTART
1523 1 ipari ,intbuf_tab(n),n ,itask ,
1524 2 intstamp(kk),nb_stok_n,nb_jlt)
1529 IF (nintstamp/=0)
THEN
1530 IF (debug(3)>=1)
THEN
1531 IF(mod(ncycle+1,debug(3))==0)
THEN
1532 IF (nb_jlt(itask+1)==0)
THEN
1535 pct1 = hundred - hundred*nb_stok_n(itask+1)/nb_jlt(itask+1)
1537#include "lockon.inc"
1538 WRITE(istdo,
'(A,I6,A,I4,A,I4,A,I10,A,I10,2X,F5.2,A)')
1539 .
' NCYCLE = ',ncycle,
1540 .
' NSPMD = ',ispmd+1,
1541 .
' ITASK = ',itask+1,
1542 .
' CANDIDATS = ',nb_jlt(itask+1),
1543 .
' OPT CAND = ',nb_stok_n(itask+1),pct1,
'%'
1544#include "lockoff.inc"
1545 nb_stok_n(itask+1)=0
1556 IF (imonm > 0)
CALL stoptime(timers,19)
1557 IF (nsne_max>0 )
DEALLOCATE(xe,ve)
1561 IF( multi_fvm%IS_INT18_LAW151 )
THEN
1568 IF(ninter25 /= 0)
THEN
1573 IF (imon>0 .AND. itask==0)
THEN
1579 1 ipari ,itab ,sensors%SENSOR_TAB,intlist25,intbuf_tab ,
1580 2 x ,v ,kinet ,itask+1 ,nb25_dst2,
1581 3 icodt ,iskew ,nsensor )
1585 IF (imon>0 .AND. itask==0)
THEN
1595 IF ((nspmd > 1 .AND. (retri == 1 .OR. ninter25 > 0 )))
THEN
1602 IF (imonm > 0)
CALL startime(timers,18)
1605 1 ipari ,newfront,isendto ,irecvfrom,
1606 2 nsensor ,nbintc ,intlist ,islen7 ,irlen7 ,
1607 3 islen11 ,irlen11 ,islen17 ,irlen17 ,irlen7t ,
1608 4 islen7t ,irlen20 ,islen20 ,irlen20t,islen20t ,
1609 5 irlen20e,islen20e,sensors%SENSOR_TAB,intbuf_tab, 2)
1611 IF(ninter25e > 0)
THEN
1620 IF (imonm > 0)
CALL stoptime(timers,18)
1624 DEALLOCATE(x_ige,v_ige)