94 2 MS ,WA ,ELBUF_TAB ,BUFMAT ,PARTSAV ,TF ,
95 3 VAL2 ,VEUL ,FV ,STIFN ,FSKY ,EANI ,
96 4 PHI ,FILL ,DFILL ,ALPH ,SKEW ,W ,
97 5 D ,DSAVE ,ASAVE ,DT2T ,DT2SAVE ,XCELL ,
98 6 IPARG ,NPC ,IXS ,IXQ ,IXTG ,IADS ,
99 7 IFILL ,ICODT ,ISKEW ,IMS ,IADQ ,
100 8 NELTST ,ITYPTST ,IPARTS ,IPARTQ ,ITASK ,
101 A NODFT ,NODLT ,NBRCVOIS ,TEMP ,FSAVSURF ,
102 B NBSDVOIS ,LNRCVOIS ,LNSDVOIS ,NERCVOIS ,NESDVOIS ,LERCVOIS ,
103 C LESDVOIS ,ISIZXV ,IAD_ELEM ,FR_ELEM ,FSKYM ,MSNF ,
104 D IPARI ,SEGVAR ,ITAB ,ISKWN ,DIFFUSION ,IRESP ,
105 E VOLMON ,FSAV ,IGRSURF ,NELTSA ,
106 F ITYPTSA ,WEIGHT ,NPSEGCOM ,LSEGCOM ,IPM ,IGEO ,
107 G ITABM1 ,LENQMV ,NV46 ,AGLOB ,GRESAV ,
108 H GRTH ,IGRTH ,LGAUGE ,GAUGE ,MSSA ,
109 I DMELS ,IGAUP ,NGAUP ,TABLE ,MS0 ,
110 J XDP ,IGRNOD ,SFEM_NODVAR ,FSKYI ,ISKY ,S_SFEM_NODVAR,
111 K INTBUF_TAB ,IXT ,IGRV ,AGRAV ,SENSORS ,
112 L LGRAV ,CONDNSKY ,CONDN ,MS_2D ,MULTI_FVM ,IGRTRUSS ,
113 M IGRBRIC ,NLOC_DMG ,ID_GLOBAL_VOIS ,FACE_VOIS ,EBCS_TAB ,ALE_CONNECTIVITY,
114 N MAT_ELEM ,H3D_DATA ,DT ,OUTPUT ,NEED_COMM_INTER18 ,IDTMINS ,
115 O IDTMIN ,MAXFUNC ,IMON_MAT ,USERL_AVAIL,
116 P impl_s ,idyna ,PYTHON ,MATPARAM ,GLOB_THERM )
132 USE bcs_mod ,
only : bcs
142 USE multimat_param_mod ,
ONLY : m51_iflg6_size
143 USE matparam_def_mod,
ONLY : matparam_struct_
144 use bcs_wall_trigger_mod
146 use element_mod ,
only : nixs,nixq,nixtg,nixt
150#include "implicit_f.inc"
151#include "comlock.inc"
155#include "mvsiz_p.inc"
159#include "com01_c.inc"
160#include "com04_c.inc"
161#include "com06_c.inc"
162#include "com08_c.inc"
163#include "param_c.inc"
164#include "vect01_c.inc"
165#include "scr06_c.inc"
166#include "scr17_c.inc"
167#include "parit_c.inc"
170#include "inter18.inc"
171#include "inter22.inc"
172#include "scr07_c.inc"
173#include "stati_c.inc"
175#include "tabsiz_c.inc"
179 TYPE(timer_) :: TIMERS
180 INTEGER,
INTENT(IN) :: S_SFEM_NODVAR
181 TYPE(MATPARAM_STRUCT_),
DIMENSION(NUMMAT),
INTENT(IN) :: MATPARAM
182 INTEGER,
INTENT(IN):: IRESP
183 integer,
dimension(102) :: IDTMIN
184 INTEGER ,
INTENT(IN) :: MAXFUNC
185 INTEGER,
INTENT(IN) :: IMON_MAT
186 INTEGER,
INTENT(IN) :: USERL_AVAIL
187 INTEGER,
INTENT(IN) :: IMPL_S
188 INTEGER,
INTENT(IN) :: IDYNA
189 my_real,
INTENT(INOUT) :: FSAVSURF(TH_SURF_NUM_CHANNEL,NSURF)
190 INTEGER IXS(NIXS,NUMELS),IXQ(NIXQ,NUMELQ),IXTG(NIXTG,NUMELTG), ISKY(*),
191 . IFILL(NUMNOD,*), NPC(*), IPARG(NPARG,NGROUP),
192 . IADS(8,*),IADQ(4,*),ICODT(*),ISKEW(*), IMS(*),
193 . IGEO(NPROPGI,NUMGEO),
194 . IPARTS(*) ,IPARTQ(*),IPM(NPROPMI,*),NODFT,
195 . NELTST ,ITYPTST, ITASK,
196 . NBRCVOIS(*),NBSDVOIS(*), LNRCVOIS(*), LNSDVOIS(*),
197 . NERCVOIS(*),NESDVOIS(*),LERCVOIS(*),LESDVOIS(*),
198 . NELTSA, ITYPTSA,NPSEGCOM(*),LSEGCOM(*),
199 . IAD_ELEM(*),FR_ELEM(*), IPARI(SIPARI),ITAB(NUMNOD),ISKWN(*),
200 . WEIGHT(*), ITABM1(*),
201 . ISIZXV, LENQMV,NV46,GRTH(*),IGRTH(*),LGAUGE(3,NBGAUGE),
202 . IGAUP(*),NGAUP(*),NODLT, IXT(NIXT,*),
204 INTEGER,
INTENT(IN) :: IDTMINS
206 INTEGER,
DIMENSION(*),
INTENT(in) :: ID_GLOBAL_VOIS,FACE_VOIS
207 LOGICAL,
INTENT(inout) :: NEED_COMM_INTER18
208 DOUBLE PRECISION XDP(3,*)
210 my_real x(3,numnod),v(3,numnod),ms(*),pm(npropm,nummat),skew(lskew,*),
211 . geo(npropg,ngroup),bufmat(*) ,w(3,numnod),veul(*),fill(numnod,*),
212 . dfill(numnod,*),alph(*),tf(*),
213 . fv(*),a(3,numnod),val2(*),phi(*),
214 . partsav(*) ,stifn(*) ,d(3,numnod),dsave(3,*),asave(3,*),wa(*),
215 . fsky(*),eani(*), fskym(*),
217 . aglob(3,*),gauge(llgauge,*),ms0(*),
218 . msnf(*),volmon(*),fsav(nthvki,*),gresav(*),
219 . mssa(*), dmels(*),sfem_nodvar(s_sfem_nodvar),fskyi(lskyi,nfskyi),
220 . agrav(*),condn(*),condnsky(*),ms_2d(*),temp(*)
223 TYPE(TTABLE) TABLE(*)
224 TYPE(ELBUF_STRUCT_),
TARGET,
DIMENSION(NGROUP) :: ELBUF_TAB
226 TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
227 TYPE(MULTI_FVM_STRUCT) :: MULTI_FVM
228 TYPE (NLOCAL_STR_) :: NLOC_DMG
230 TYPE (GROUP_) ,
DIMENSION(NGRNOD) :: IGRNOD
231 TYPE (GROUP_) ,
DIMENSION(NGRBRIC) :: IGRBRIC
232 TYPE (GROUP_) ,
DIMENSION(NGRTRUS) :: IGRTRUSS
233 TYPE (SURF_) ,
DIMENSION(NSURF) :: IGRSURF
234 TYPE(t_ebcs_tab),
INTENT(INOUT) :: EBCS_TAB
235 TYPE(t_ale_connectivity),
INTENT(INOUT) :: ALE_CONNECTIVITY
236 TYPE(T_DIFFUSION),
INTENT(INOUT) :: DIFFUSION
237 TYPE (MAT_ELEM_) ,
INTENT(INOUT) :: MAT_ELEM
238 TYPE (H3D_DATABASE) ::
239 TYPE (SENSORS_) ,
INTENT(INOUT) :: SENSORS
240 my_real,
INTENT(INOUT) :: XCELL(3,SXCELL)
241 TYPE (DT_) ,
INTENT(INOUT) :: DT
242 TYPE(OUTPUT_),
INTENT(INOUT) :: OUTPUT
243 TYPE(PYTHON_) :: PYTHON
244 type (glob_therm_) ,
intent(inout) :: glob_therm
248 my_real,
DIMENSION(MVSIZ,6) :: svis
249 INTEGER N, M, NG, NVC, NF1,OFFSET,ISOLNOD,NSG,NEL,I,LENCOM,ISTRA,IBID,IOUTPRT
251 INTEGER IADBH, IAD22, NIN, NBRIC_L
252 INTEGER SBUFVOIS,SZ_BUFVOIS
254 my_real fx(mvsiz,10),fy(mvsiz,10),fz(mvsiz,10),voln(mvsiz)
255 my_real,
TARGET :: bid
256 my_real,
DIMENSION(:,:),
ALLOCATABLE,
TARGET :: qmv
257 my_real,
POINTER :: pqmv
259 my_real,
DIMENSION(:,:),
ALLOCATABLE ::bufvois
276 IF(mod(ncycle,iabs(ncpri)) == 0 .OR. tt >= output%TH%THIS .OR. mdess /= 0
277 . .OR. (
ale%SUB%IALESUB /= 0 .AND. t1s+dt2s >= output%TH%THIS)
278 . .OR. tt >= output%TH%THIS1(1) .OR. tt >= output%TH%THIS1(2)
279 . .OR. tt >= output%TH%THIS1(3) .OR. tt >= output%TH%THIS1(4) .OR. tt >= output%TH%THIS1(5)
280 . .OR. tt >= output%TH%THIS1(6) .OR. tt >= output%TH%THIS1(7) .OR. tt
281 . .OR. tt >= output%TH%THIS1(9) .OR. nth /= 0 .OR. nanim /= 0
282 . .OR. tt >= tabfis(1) .OR. tt >= tabfis(2)
283 . .OR. tt >= tabfis(3) .OR. tt >= tabfis(4) .OR. tt >= tabfis(5)
284 . .OR. tt >= tabfis(6) .OR. tt >= tabfis(7) .OR. tt >= tabfis(8)
285 . .OR. tt >= tabfis(9) .OR. tt >= tabfis(10)
286 . .OR. (
ale%SUB%IALESUB /= 0 .AND. t1s+dt2s >= output%TH%THIS1(1))
287 . .OR. (
ale%SUB%IALESUB /= 0 .AND. t1s+dt2s >= output%TH%THIS1(2))
288 . .OR. (
ale%SUB%IALESUB /= 0 .AND. t1s+dt2s >= output%TH%THIS1(3))
289 . .OR. (
ale%SUB%IALESUB /= 0 .AND. t1s+dt2s >= output%TH%THIS1(4))
290 . .OR. (
ale%SUB%IALESUB /= 0 .AND. t1s+dt2s >= output%TH%THIS1(5))
291 . .OR. (
ale%SUB%IALESUB /= 0 .AND. t1s+dt2s >= output%TH%THIS1(6))
292 . .OR. (
ale%SUB%IALESUB /= 0 .AND. t1s+dt2s >= output%TH%THIS1(7))
293 . .OR. (
ale%SUB%IALESUB /= 0 .AND. t1s+dt2s >= output%TH%THIS1(8))
294 . .OR. (
ale%SUB%IALESUB /= 0 .AND. t1s+dt2s >= output%TH%THIS1(9)) .OR. istat==3) ioutprt=1
296 ALLOCATE(qmv(2*nv46,lenqmv))
297 IF(m51_iflg6 == 1)sbufvois = m51_iflg6_size
299 IF(itask==0)
ALLOCATE(bufvois(sbufvois ,nsvois+nqvois))
300 IF(itask==0)sz_bufvois=sbufvois*(nsvois+nqvois)
302 IF(n2d /= 0 .AND. nmult /= 0)
THEN
305 iadbh=
max(1,nmult)*4*numelq+1
312 IF(iale+ieuler /= 0)
THEN
314 IF(ale_connectivity%NALE(n) /= 0) ms0(n) = ms(n)
318 IF(ale_connectivity%NALE(n) /= 0) v(1:3,n) = zero
326 IF(inter18_is_variable_gap_defined)
THEN
327 need_comm_inter18 = .true.
328 DO ng=itask+1,ngroup,nthread
329 IF (tt > zero .AND. iparg(76, ng) == 1) cycle
330 IF(iparg(8,ng) == 1) cycle
334 2 mtn ,nel ,nft ,iad ,ity ,
335 3 npt ,jale ,ismstr ,jeul ,jtur ,
336 4 jthe ,jlag ,jmult ,jhbe ,jivf ,
337 5 nvaux ,jpor ,jcvt ,jclose ,ipla ,
338 6 irep ,iint ,igtyp ,israt ,isrot ,
339 7 icsen ,isorth ,isorthg ,ifailure ,jsms )
340 IF (ity == 1 .AND. isolnod /= 4)
THEN
342 xcell(1,i+nft)=exp(log(elbuf_tab(ng)%GBUF%VOL(i))/three)
351 lencom = nercvois(nspmd + 1) + nesdvois(nspmd + 1)
352 CALL startime(timers, timer_spmdcfd)
353 CALL spmd_envois(3, xcell, nercvois, nesdvois, lercvois, lesdvois, lencom)
354 CALL stoptime(timers, timer_spmdcfd)
367 IF(
ale%SUB%IALESUB == 2)
THEN
369 IF(tt == zero .OR. tt+dt1 > t1s+dt2s)
THEN
381 IF(
ale%SUB%IFSUB == 0)
THEN
387 CALL alesub1(ale_connectivity%NALE,v,w,dsave,icodt,iskew,skew,d,itask,nodft,nodlt,fsky,fsky)
389 IF(
ale%SUB%IALESUB == 0 .AND. itask == 0)
THEN
395 IF (glob_therm%ITHERM == 1 .AND. iale+ieuler == 0)
ale%SUB%IFSUBM=0
403 IF (iparit == 0 .AND. nspmd > 1 .AND.
ale%SUB%IFSUBM == 1 .AND. n2d == 0 .AND.
ale%GLOBAL%INCOMP == 0)
THEN
405 ms(n) = ms(n)*weight(n)
413 IF (n2d > 0 .AND.
ale%SUB%IFSUBM == 1)
THEN
420 IF(
ale%SUB%IFSUB == 0)
THEN
421 IF(itask==0)
CALL startime(timers,macro_timer_ifsub0)
422 IF(iale+ieuler+glob_therm%ITHERM /= 0)
THEN
423 IF(
ale%GLOBAL%INCOMP == 0)
THEN
424 IF(nsegflu > 0 .AND. n2d == 0)
THEN
425 CALL seggetv(iparg,elbuf_tab,ale_connectivity,itask,segvar)
429 CALL startime(timers, timer_spmdcfd)
430 CALL spmd_segcom(segvar,npsegcom,lsegcom,npsegcom(nspmd+1),0)
431 CALL stoptime(timers, timer_spmdcfd)
441 IF (itask == 0 .AND. ispmd == 0)
442 .
CALL intti0(ipari ,x ,v ,wa ,itab ,iparg ,ixs ,segvar ,skew ,iskwn ,intbuf_tab)
450 i=1+ninter+nrwall+nrbody+nsect+njoint+nrbag
452 . a,v,w,x,fsav(1,i),fv,
454 . elbuf_tab,ebcs_tab,multi_fvm,ixq
455 . fsky,fsavsurf,tt,dt1,
456 . sensors%NSENSOR,sensors%SENSOR_TAB,python,
457 . npc, tf ,snpc, stf, output, matparam, pm,
467 CALL startime(timers, timer_spmdcfd)
468 CALL spmd_segcom(segvar,npsegcom,lsegcom,npsegcom(nspmd+1),1)
469 CALL stoptime(timers, timer_spmdcfd)
484 iad22 = ipari(npari*(nin-1)+39)
485 nbric_l = igrbric(ipari(npari*(nin-1)+45))%NENTITY
490 1 ixs , elbuf_tab, iparg, itab , itask ,
491 2 ibid , nbric_l , x , ale_connectivity
492 3 nv46 , veul , igrnod, ipari, igrtruss ,
498 IF (multi_fvm%IS_USED)
THEN
500 IF(itask==0)
CALL startime(timers,macro_timer_multifvm)
507 . partsav, iparts, gresav, igrth, grth)
508 IF (multi_fvm%NS_DIFF)
THEN
509 DO ng = itask + 1, ngroup, nthread
510 IF (iparg(1, ng) == 151)
THEN
515 . elbuf_tab, ixs, ixq, ixtg, multi_fvm%VOL(1 + nft : nel + nft),x)
524 . pm, ipm, multi_fvm, tt, bufmat,npc,tf,nummat,matparam)
534 IF(bcs%NUM_WALL > 0)
THEN
535 CALL bcs_wall_trigger(tt,ale_connectivity,sensors%NSENSOR,sensors%SENSOR_TAB)
543 IF (nspmd > 1 .AND. ((multi_fvm%MUSCL > 0) .OR. multi_fvm%NS_DIFF
THEN
545 lencom = nercvois(nspmd + 1) + nesdvois(nspmd
546 CALL startime(timers, timer_spmdcfd)
547 CALL spmd_envois(3, multi_fvm%ELEM_DATA%CENTROID,nercvois, nesdvois, lercvois, lesdvois, lencom)
548 IF (
ALLOCATED(multi_fvm%VOL))
THEN
549 CALL spmd_envois(1, multi_fvm%VOL, nercvois, nesdvois, lercvois, lesdvois, lencom)
551 CALL stoptime(timers, timer_spmdcfd)
559 . pm, ipm, multi_fvm, w, x,
573 . ixs, ixq, iparg, x, a, v, w, ms, msnf, veul,
574 . stifn, fsky, iads, fskym,
575 . condn, condnsky, multi_fvm,glob_therm%NODADT_THERM)
579 multi_fvm%IS_RESTART = .false.
582 IF (multi_fvm%IS_RESTART)
THEN
593 . pm, ipm, multi_fvm, tt, bufmat,npc,tf,nummat,matparam)
602 IF (nspmd > 1 .AND. multi_fvm%MUSCL > 0)
THEN
604 lencom = nercvois(nspmd + 1) + nesdvois(nspmd + 1)
607 . nercvois, nesdvois, lercvois, lesdvois, lencom)
613 multi_fvm%IS_RESTART = .false.
620 1 agrav, igrv , lgrav, sensors%NSENSOR,sensors%SENSOR_TAB,
621 2 itask, npc , tf , skew )
627 IF(bcs%NUM_WALL > 0)
THEN
628 CALL bcs_wall_trigger(tt,ale_connectivity,sensors%NSENSOR,sensors%SENSOR_TAB)
634 IF (multi_fvm%MUSCL == 1)
THEN
642 . pm, ipm, multi_fvm, ale_connectivity, v, a, w, x, d, ale_connectivity%NALE,
643 . partsav, iparts, gresav, igrth, grth,
644 . nercvois, nesdvois, lercvois, lesdvois,
645 . itab, itabm1, tt - dt1,
646 . stifn, fsky, iads, fskym,
647 . condn, condnsky, bufmat, fv, pred,id_global_vois,face_vois,ebcs_tab
648 . output%TH%WFEXT, output)
655 . pm, ipm, multi_fvm, tt - dt1, bufmat,npc,tf,nummat,matparam)
664 . pm, ipm, multi_fvm, ale_connectivity, v, a, w, x, d, ale_connectivity%NALE,
665 . partsav, iparts, gresav, igrth, grth,
666 . nercvois, nesdvois, lercvois, lesdvois,
667 . itab, itabm1, tt - dt1,
668 . stifn, fsky, iads, fskym,
669 . condn, condnsky, bufmat, fv, pred,id_global_vois,face_vois,ebcs_tab,npc,tf,fsavsurf,matparam,
670 . output%TH%WFEXT, output)
677 . pm, ipm, multi_fvm, tt, bufmat,npc,tf,nummat,matparam)
684 . pm, ipm, multi_fvm, ale_connectivity, v, a, w, x, d, ale_connectivity%NALE,
685 . partsav, iparts, gresav, igrth, grth,
686 . nercvois, nesdvois, lercvois, lesdvois,
687 . itab, itabm1, tt - dt1,
688 . stifn, fsky, iads, fskym,
689 . condn, condnsky, bufmat, fv, .false.,id_global_vois,face_vois
690 . output%TH%WFEXT, output)
693 IF (multi_fvm%NS_DIFF)
THEN
695 CALL ns_fvm_diffusion(ale_connectivity, multi_fvm, dt1, ebcs_tab, diffusion,
696 . ipm, pm, iparg, elbuf_tab, nercvois, nesdvois, lercvois, lesdvois,
704 . pm, ipm, multi_fvm, tt, bufmat,npc,tf,nummat,matparam)
725 . ixs, ixq, iparg, x, a, v, w, ms, msnf, veul,
726 . stifn, fsky, iads, fskym,
727 . condn, condnsky, multi_fvm,glob_therm%NODADT_THERM)
733 CALL multi_compute_dt(dt2t, elbuf_tab, iparg, itask, ixs, ixq, ixtg, pm, ipm, multi_fvm
736 IF(itask==0)
CALL stoptime(timers,macro_timer_multifvm)
744 1 iparg, elbuf_tab, wa, val2,
745 2 phi, ale_connectivity,ixs, ixq,
747 4 ms, veul, fill, dfill,
748 5 alph, fv, bufmat, tf,
749 6 npc, itask, nbrcvois, nbsdvois,
750 7 lnrcvois, lnsdvois, nercvois, nesdvois,
751 8 lercvois, lesdvois, segvar,
752 9 msnf, nodft, nodlt, wa(iadbh),
753 a ipm, qmv, itab, itabm1,
755 c iad_elem, glob_therm,
780 IF(alefvm_param%IEnabled > 0)
THEN
784 1 agrav, igrv , lgrav, sensors%NSENSOR,sensors%SENSOR_TAB,
785 2 itask , npc , tf , skew
796 CALL s4alesfem(iparg,ixs,x,elbuf_tab,sfem_nodvar,s_sfem_nodvar,pm,iad_elem,fr_elem)
803 IF(ale%GRID%NWALE == 7)
THEN
805 ale%GRID%flow_tracking_data%EP(1:9)=zero
806 ale%GRID%flow_tracking_data%SUM_M = zero
807 ale%GRID%flow_tracking_data%SUM_VOL = zero
808 ale%GRID%flow_tracking_data%NUM_ELEM_ALE = 0
815 DO ng=itask+1,ngroup,nthread
817 sensors%NGR_SENSOR(itask+1) = ng
818 IF (tt > zero .AND. iparg(76, ng) == 1) cycle
819 IF(iparg(8,ng) /= 1)
THEN
822 2 mtn ,nel ,nft ,iad ,ity ,
823 3 npt ,jale ,ismstr ,jeul
824 4 jthe ,jlag ,jmult ,jhbe
826 6 irep ,iint ,igtyp ,israt ,isrot ,
827 7 icsen ,isorth ,isorthg ,ifailure,jsms )
829 IF (mtn == 151) cycle
830 IF(jlag /= 1 .AND. ity <= 2)
THEN
831 IF(iparg(64,ng)==1) ilaw11=1
832 IF (mtn /= 0 .AND. iparg(64,ng)==0)
THEN
840 ipartsph = iparg(69,ng)
845 IF (ity == 1 .AND. isolnod == 4)
THEN
847 1 elbuf_tab, ng, pm, geo
850 4 veul, fv, ale_connectivity,iparg,
851 5 tf, npc, bufmat, partsav,
852 6 nloc_dmg, dt2t, neltst, ityptst,
853 7 stifn, fsky, iads, offset,
854 8 eani, iparts(nf1), fx(1,1), fy(1,1),
855 9 fz(1,1), fx(1,2), fy(1,2), fz(1,2),
856 a fx(1,3), fy(1,3), fz(1,3), fx(1,4),
857 b fy(1,4), fz(1,4), nel, fskym,
858 c msnf, ipm, igeo, bufvois,
859 d istra, itask, bid, bid,
860 e bid, ibid, gresav, grth,
861 f igrth, mssa, dmels, table,
862 g xdp, sfem_nodvar, voln, bid,
863 h bid, d, sensors, ioutprt,
864 i mat_elem, ibid, dt, idel7nok,
865 j nsvois, sz_bufvois, snpc, stf,
866 k sbufmat, svis, idtmins, iresp,
867 * idel7ng, maxfunc, userl_avail, glob_therm,
868 v impl_s, idyna, s_sfem_nodvar)
870 ELSEIF (ity == 1 .AND. isolnod /= 4)
THEN
877 CALL sforc3(timers,output,
878 1 elbuf_tab, ng, pm, geo,
881 4 val2, veul, fv, ale_connectivity,
882 5 iparg, tf, npc, bufmat
883 6 partsav, itab, dt2t, neltst,
884 7 ityptst, stifn, fsky, iads,
885 8 offset, eani, iparts(1+nft), fx(1,1),
886 9 fy(1,1), fz(1,1), fx(1,2), fy(1,2),
887 a fz(1,2), fx(1,3), fy(1,3), fz(1,3),
888 b fx(1,4), fy(1,4), fz(1,4), fx(1,5),
889 c fy(1,5), fz(1,5), fx(1,6), fy(1,6),
890 d fz(1,6), fx(1,7), fy(1,7), fz(1,7),
891 e fx(1,8), fy(1,8), fz(1,8), nel,
892 f fskym, msnf, isky, fskyi,
893 g nvc, ipm, igeo, bid,
894 h bid, bid, bid, bid,
895 i bufvois, itask, pqmv, istra,
896 j temp, bid, bid, ibid,
897 k gresav, grth, igrth, mssa,
898 l dmels, table, bid, bid,
899 m bid, bid, bid, bid,
900 n bid, bid, bid, iparg(1,ng),
901 o xdp, bid, ibid, ibid,
902 p voln, condn, condnsky, agrav,
903 q igrv, lgrav, sensors, skew,
904 r ale_connectivity%NALE, d, ioutprt, nloc_dmg,
905 s mat_elem, ibid, dt, idel7nok,nsvois,
906 t sz_bufvois, snpc, stf, sbufmat,svis,idtmins,iresp,
907 u idel7ng, maxfunc, userl_avail, glob_therm,
908 v impl_s, idyna, output%TH%WFEXT)
910 ELSEIF (ity == 2 .AND. jmult == 0)
THEN
917 CALL qforc2(timers, output,
919 1 pm ,geo ,ixq ,x ,a ,
920 2 v ,ms ,w ,wa ,val2 ,
921 3 veul ,ale_connectivity ,iparg ,nloc_dmg ,
922 4 tf ,npc ,bufmat ,partsav ,
923 5 dt2t ,neltst ,ityptst ,stifn ,offset ,
924 6 eani ,ipartq(1+nft) ,nel ,iadq ,fsky ,
925 9 ipm ,bufvois ,pqmv ,
926 a gresav ,grth ,igrth ,table ,igeo ,
927 b voln ,itask ,ms_2d ,fskym ,ioutprt ,
928 c mat_elem ,h3d_data%STRAIN ,sz_bufvois ,snpc ,stf ,sbufmat ,
929 d svis ,nsvois ,iresp ,tt ,dt1 ,
930 . idel7nok ,idtmin ,maxfunc ,
931 . imon_mat ,userl_avail ,impl_s ,idyna ,
932 . dt ,glob_therm ,sensors)
934 ELSEIF (ity == 2 .AND. jmult /= 0)
THEN
937 1 pm , geo ,ixq , x ,
938 2 a , v ,ms , w , wa ,
939 3 val2 , veul ,ale_connectivity, iparg ,
940 4 iparg(1,ng) , fill ,dfill , ims , nloc_dmg ,
941 5 tf , npc ,bufmat , partsav ,
942 6 dt2t , neltst ,ityptst , stifn , offset ,
943 7 eani , ipartq(1+nft) ,nel , iadq , fsky ,
945 9 gresav , grth ,igrth , table , igeo ,
946 o voln , itask ,ms_2d , fskym , mat_elem ,
947 b ibid , output ,sz_bufvois , snpc , stf ,sbufmat, svis,
948 c nsvois , iresp ,idel7nok ,
949 d idtmin , maxfunc ,imon_mat ,
950 e userl_avail , impl_s , idyna ,dt ,
951 f glob_therm , sensors)
962 IF (ilaw11 /= 0)
THEN
971 lencom=nbrcvois(nspmd+1)+nbsdvois(nspmd+1)
972 IF(m51_iflg6 == 0)
THEN
976 1 v ,nbrcvois,nbsdvois,lnrcvois,lnsdvois,
979 IF(ale%GLOBAL%INCOMP == 1 .OR. iturb + glob_therm%ITHERM == 0)
980 .
CALL spmd_xvois(x,nbrcvois,nbsdvois,lnrcvois,lnsdvois,lencom )
983 1 bufvois ,iparg ,elbuf_tab,pm ,ixs ,
984 2 ixq ,nercvois,nesdvois,lercvois,lesdvois,
989 1 bufvois ,iparg ,elbuf_tab,pm ,ixs ,
990 2 ixq ,nercvois,nesdvois,lercvois,lesdvois,
991 3 lencom ,ipm ,bufmat)
997 DO ng=itask+1,ngroup,nthread
999 sensors%NGR_SENSOR(itask+1) = ng
1000 IF (tt > zero .AND. iparg(76, ng) == 1) cycle
1002 2 mtn ,nel ,nft ,iad ,ity ,
1003 3 npt ,jale ,ismstr ,jeul ,jtur ,
1004 4 jthe ,jlag ,jmult ,jhbe ,jivf ,
1005 5 nvaux ,jpor ,jcvt ,jclose ,ipla ,
1006 6 irep ,iint ,igtyp ,israt ,isrot ,
1007 7 icsen ,isorth ,isorthg ,ifailure,jsms )
1008 IF (mtn == 151) cycle
1009 IF (iparg(8,ng) /= 1)
THEN
1010 IF (jlag /= 1 .AND. ity <= 2)
THEN
1011 IF (mtn == 11 .OR. iparg(64,ng) == 1)
THEN
1014 isolnod=iparg(28,ng)
1015 istra = iparg(44,ng)
1018 ipartsph = iparg(69,ng)
1024 IF(ity == 1 .AND. isolnod == 4)
THEN
1026 1 elbuf_tab, ng, pm, geo,
1030 5 tf, npc, bufmat, partsav,
1031 6 nloc_dmg, dt2t, neltst, ityptst,
1032 7 stifn, fsky, iads, offset,
1033 8 eani, iparts(nf1), fx(1,1), fy(1,1),
1034 9 fz(1,1), fx(1,2), fy(1,2), fz(1,2),
1035 a fx(1,3), fy(1,3), fz(1,3), fx(1,4),
1036 b fy(1,4), fz(1,4), nel, fskym,
1037 c msnf, ipm, igeo, bufvois,
1038 d istra, itask, bid, bid,
1039 e bid, ibid, gresav, grth,
1040 f igrth, mssa, dmels, table,
1041 g xdp, sfem_nodvar, voln, bid,
1042 h bid, d, sensors, ioutprt,
1043 i mat_elem, ibid, dt, idel7nok,
1044 j nsvois, sz_bufvois, snpc, stf,
1045 k sbufmat, svis, idtmins, iresp,
1046 * idel7ng, maxfunc, userl_avail, glob_therm,
1047 v impl_s, idyna, s_sfem_nodvar)
1049 ELSEIF(ity == 1 .AND. isolnod /= 4)
THEN
1052 pqmv => qmv(1,1+nft)
1056 CALL sforc3(timers, output,
1057 1 elbuf_tab, ng, pm, geo,
1060 4 val2, veul, fv, ale_connectivity
1061 5 iparg, tf, npc, bufmat,
1062 6 partsav, itab, dt2t, neltst,
1063 7 ityptst, stifn, fsky, iads,
1064 8 offset, eani, iparts(1+nft), fx(1,1),
1065 9 fy(1,1), fz(1,1), fx(1,2), fy(1,2),
1066 a fz(1,2), fx(1,3), fy(1,3), fz(1,3),
1067 b fx(1,4), fy(1,4), fz(1,4), fx(1,5),
1068 c fy(1,5), fz(1,5), fx(1,6), fy(1,6),
1069 d fz(1,6), fx(1,7), fy(1,7), fz(1,7),
1070 e fx(1,8), fy(1,8), fz(1,8), nel,
1071 f fskym, msnf, isky, fskyi,
1072 g nvc, ipm, igeo, bid,
1073 h bid, bid, bid, bid,
1074 i bufvois, itask, pqmv, istra,
1075 j temp, bid, bid, ibid,
1076 k gresav, grth, igrth, mssa,
1077 l dmels, table, bid, bid,
1078 m bid, bid, bid, bid,
1079 n bid, bid, bid, iparg(1,ng),
1080 o xdp, bid, ibid, ibid,
1081 p voln, condn, condnsky, agrav,
1082 q igrv, lgrav, sensors, skew,
1083 r ale_connectivity%NALE,d, ioutprt, nloc_dmg,
1084 s mat_elem, ibid, dt, idel7nok,nsvois,
1085 t sz_bufvois, snpc, stf,sbufmat,svis,idtmins,iresp,
1086 u idel7ng, maxfunc, userl_avail ,glob_therm,
1087 v impl_s, idyna, output%TH%WFEXT)
1089 ELSEIF (ity == 2 .AND. jmult == 0)
THEN
1092 pqmv => qmv(1,1+nft)
1096 CALL qforc2(timers, output,
1098 1 pm ,geo ,ixq ,x ,a ,
1099 2 v ,ms ,w ,wa ,val2 ,
1100 3 veul ,ale_connectivity ,iparg ,nloc_dmg ,
1101 4 tf ,npc ,bufmat ,partsav ,
1102 5 dt2t ,neltst ,ityptst ,stifn ,offset ,
1103 6 eani ,ipartq(1+nft) ,nel ,iadq ,fsky ,
1104 9 ipm ,bufvois ,pqmv ,
1105 a gresav ,grth ,igrth ,table ,igeo ,
1106 b voln ,itask ,ms_2d ,fskym ,ioutprt ,
1107 c mat_elem ,h3d_data%STRAIN ,sz_bufvois ,snpc ,stf ,sbufmat,
1108 d svis ,nsvois ,iresp ,tt ,dt1 ,
1109 . idel7nok ,idtmin ,maxfunc ,
1110 . imon_mat ,userl_avail ,impl_s ,idyna ,
1111 . dt ,glob_therm ,sensors)
1113 ELSEIF(ity == 2 .AND. jmult /= 0)
THEN
1114 CALL bforc2(timers, elbuf_tab ,ng ,
1117 3 val2 ,veul ,ale_connectivity ,iparg ,
1118 4 iparg(1,ng),fill ,dfill ,ims ,nloc_dmg ,
1119 5 tf ,npc ,bufmat ,partsav ,
1120 5 dt2t ,neltst ,ityptst ,stifn ,offset ,
1121 6 eani ,ipartq(1+nft),nel ,iadq ,fsky ,
1123 8 gresav ,grth ,igrth ,table ,igeo ,
1124 9 voln ,itask ,ms_2d ,fskym ,mat_elem,
1125 a ibid ,output ,sz_bufvois ,snpc ,stf ,sbufmat ,svis,
1126 b nsvois ,iresp ,idel7nok ,
1127 c idtmin ,maxfunc ,imon_mat ,
1128 e userl_avail,impl_s ,idyna ,dt ,
1129 f glob_therm ,sensors)
1140 IF(itask==0)
CALL stoptime(timers,macro_timer_ifsub0)
1153 IF (nbgauge > 0)
THEN
1155 lencom =nercvois(nspmd+1)+nesdvois(nspmd+1)
1158 1 iparg ,elbuf_tab ,phi ,ixs ,ixq ,
1159 2 x ,ale_connectivity,itask ,nercvois,nesdvois,
1160 3 lercvois,lesdvois ,lencom ,lgauge ,
1161 4 gauge ,v ,igaup ,ngaup ,ixtg)
1167 IF(ale%SUB%IALESUB == 2)
THEN
1172 IF(ale%SUB%IFSUB == 0)
THEN
1177 IF(ale%SUB%IFSUB == 1)
THEN
1181 aglob(1,n)=asave(1,n)
1182 aglob(2,n)=asave(2,n)
1183 aglob(3,n)=asave(3,n)
1193 IF(itask==0)
DEALLOCATE(bufvois)