93 2 MS ,WA ,ELBUF_TAB ,BUFMAT ,PARTSAV ,TF ,
94 3 VAL2 ,VEUL ,FV ,STIFN ,FSKY ,EANI ,
95 4 PHI ,FILL ,DFILL ,ALPH ,SKEW ,W ,
96 5 D ,DSAVE ,ASAVE ,DT2T ,DT2SAVE ,XCELL ,
97 6 IPARG ,NPC ,IXS ,IXQ ,IXTG ,IADS ,
98 7 IFILL ,ICODT ,ISKEW ,IMS ,IADQ ,
99 8 NELTST ,ITYPTST ,IPARTS ,IPARTQ ,ITASK ,
100 A NODFT ,NODLT ,NBRCVOIS ,TEMP ,FSAVSURF ,
101 B NBSDVOIS ,LNRCVOIS ,LNSDVOIS ,NERCVOIS ,NESDVOIS ,LERCVOIS ,
102 C LESDVOIS ,ISIZXV ,IAD_ELEM ,FR_ELEM ,FSKYM ,MSNF ,
103 D IPARI ,SEGVAR ,ITAB ,ISKWN ,DIFFUSION ,IRESP ,
104 E VOLMON ,FSAV ,IGRSURF ,NELTSA ,
105 F ITYPTSA ,WEIGHT ,NPSEGCOM ,LSEGCOM ,IPM ,IGEO ,
106 G ITABM1 ,LENQMV ,NV46 ,AGLOB ,GRESAV ,
107 H GRTH ,IGRTH ,LGAUGE ,GAUGE ,MSSA ,
108 I DMELS ,IGAUP ,NGAUP ,TABLE ,MS0 ,
109 J XDP ,IGRNOD ,SFEM_NODVAR ,FSKYI ,ISKY ,S_SFEM_NODVAR,
110 K INTBUF_TAB ,IXT ,IGRV ,AGRAV ,SENSORS ,
111 L LGRAV ,CONDNSKY ,CONDN ,MS_2D ,MULTI_FVM ,IGRTRUSS ,
112 M IGRBRIC ,NLOC_DMG ,ID_GLOBAL_VOIS ,FACE_VOIS ,EBCS_TAB ,ALE_CONNECTIVITY,
113 N MAT_ELEM ,H3D_DATA ,DT ,OUTPUT ,NEED_COMM_INTER18 ,IDTMINS ,
114 O IDTMIN ,MAXFUNC ,IMON_MAT ,USERL_AVAIL,
115 P impl_s ,idyna ,PYTHON ,MATPARAM ,GLOB_THERM )
131 USE bcs_mod ,
only : bcs
141 USE multimat_param_mod ,
ONLY : m51_iflg6_size
142 USE matparam_def_mod,
ONLY : matparam_struct_
143 use bcs_wall_trigger_mod
148#include "implicit_f.inc"
149#include "comlock.inc"
153#include "mvsiz_p.inc"
157#include "com01_c.inc"
158#include "com04_c.inc"
159#include "com06_c.inc"
160#include "com08_c.inc"
161#include "param_c.inc"
162#include "vect01_c.inc"
163#include "scr06_c.inc"
164#include "scr17_c.inc"
165#include "parit_c.inc"
168#include "inter18.inc"
169#include "inter22.inc"
170#include "scr07_c.inc"
171#include "stati_c.inc"
173#include "tabsiz_c.inc"
177 TYPE(timer_) :: TIMERS
178 INTEGER,
INTENT(IN) :: S_SFEM_NODVAR
179 TYPE(MATPARAM_STRUCT_),
DIMENSION(NUMMAT),
INTENT(IN) :: MATPARAM
180 INTEGER,
INTENT(IN):: IRESP
181 integer,
dimension(102) :: IDTMIN
182 INTEGER ,
INTENT(IN) :: MAXFUNC
183 INTEGER,
INTENT(IN) :: IMON_MAT
184 INTEGER,
INTENT(IN) :: USERL_AVAIL
185 INTEGER,
INTENT(IN) :: IMPL_S
186 INTEGER,
INTENT(IN) :: IDYNA
187 my_real,
INTENT(INOUT) :: FSAVSURF(TH_SURF_NUM_CHANNEL,NSURF)
188 INTEGER IXS(NIXS,NUMELS),IXQ(NIXQ,NUMELQ),IXTG(NIXTG,NUMELTG), ISKY(*),
189 . IFILL(NUMNOD,*), NPC(*), IPARG(NPARG,NGROUP),
190 . IADS(8,*),IADQ(4,*),ICODT(*),ISKEW(*), IMS(*),
191 . IGEO(NPROPGI,NUMGEO),
192 . IPARTS(*) ,IPARTQ(*),IPM(NPROPMI,*),NODFT,
193 . NELTST ,ITYPTST, ITASK,
194 . NBRCVOIS(*),NBSDVOIS(*), LNRCVOIS(*), LNSDVOIS(*),
195 . NERCVOIS(*),NESDVOIS(*),LERCVOIS(*),LESDVOIS(*),
196 . NELTSA, ITYPTSA,NPSEGCOM(*),LSEGCOM(*),
197 . IAD_ELEM(*),FR_ELEM(*), IPARI(SIPARI),ITAB(NUMNOD),ISKWN(*),
198 . WEIGHT(*), ITABM1(*),
199 . ISIZXV, LENQMV,NV46,GRTH(*),IGRTH(*),LGAUGE(3,NBGAUGE),
200 . IGAUP(*),NGAUP(*),NODLT, IXT(NIXT,*),
202 INTEGER,
INTENT(IN) :: IDTMINS
204 INTEGER,
DIMENSION(*),
INTENT(in) :: ID_GLOBAL_VOIS,FACE_VOIS
205 LOGICAL,
INTENT(inout) :: NEED_COMM_INTER18
206 DOUBLE PRECISION XDP(3,*)
208 my_real x(3,numnod),v(3,numnod),ms(*),pm(npropm,nummat),skew(lskew,*),
209 . geo(npropg,ngroup),bufmat(*) ,w(3,numnod),veul(*),fill(numnod,*),
210 . dfill(numnod,*),alph(*),tf(*),
211 . fv(*),a(3,numnod),val2(*),phi(*),
212 . partsav(*) ,stifn(*) ,d(3,numnod),dsave(3,*),asave(3,*),wa(*),
213 . fsky(*),eani(*), fskym(*),
215 . aglob(3,*),gauge(llgauge,*),ms0(*),
216 . msnf(*),volmon(*),fsav(nthvki,*),gresav(*),
217 . mssa(*), dmels(*),sfem_nodvar(s_sfem_nodvar),fskyi(lskyi,nfskyi),
218 . agrav(*),condn(*),condnsky(*),ms_2d
221 TYPE(TTABLE) TABLE(*)
222 TYPE(ELBUF_STRUCT_),
TARGET,
DIMENSION(NGROUP) :: ELBUF_TAB
224 TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
225 TYPE(MULTI_FVM_STRUCT) :: MULTI_FVM
226 TYPE (NLOCAL_STR_) :: NLOC_DMG
228 TYPE (GROUP_) ,
DIMENSION(NGRNOD) :: IGRNOD
229 TYPE (GROUP_) ,
DIMENSION(NGRBRIC) :: IGRBRIC
230 TYPE (GROUP_) ,
DIMENSION(NGRTRUS) :: IGRTRUSS
231 TYPE (SURF_) ,
DIMENSION(NSURF) :: IGRSURF
232 TYPE(t_ebcs_tab),
INTENT(INOUT)
233TYPE(t_ale_connectivity),
INTENT(INOUT) :: ALE_CONNECTIVITY
234 TYPE(T_DIFFUSION),
INTENT(INOUT) :: DIFFUSION
235 TYPE (MAT_ELEM_) ,
INTENT(INOUT) :: MAT_ELEM
236 TYPE (H3D_DATABASE) :: H3D_DATA
237 TYPE (SENSORS_) ,
INTENT(INOUT) :: SENSORS
238 my_real,
INTENT(INOUT) :: XCELL(3,SXCELL)
239 TYPE (DT_) ,
INTENT(INOUT) :: DT
240 TYPE(OUTPUT_),
INTENT(INOUT) :: OUTPUT
241 TYPE(PYTHON_) :: PYTHON
242 type (glob_therm_) ,
intent(inout) :: glob_therm
246 my_real,
DIMENSION(MVSIZ,6) :: svis
247 INTEGER N, M, NG, NVC, NF1,OFFSET,ISOLNOD,NSG,NEL,I,LENCOM,ISTRA,IBID,IOUTPRT
249 INTEGER IADBH, IAD22, NIN, NBRIC_L
250 INTEGER SBUFVOIS,SZ_BUFVOIS
252 my_real fx(mvsiz,10),fy(mvsiz,10),fz(mvsiz,10),voln(mvsiz)
253 my_real,
TARGET :: bid
254 my_real,
DIMENSION(:,:),
ALLOCATABLE,
TARGET :: qmv
255 my_real,
POINTER :: pqmv
257 my_real,
DIMENSION(:,:),
ALLOCATABLE ::bufvois
274 IF(mod(ncycle,iabs(ncpri)) == 0 .OR. tt >= output%TH%THIS .OR. mdess /= 0
275 . .OR. (
ale%SUB%IALESUB /= 0 .AND. t1s+dt2s >= output%TH%THIS)
276 . .OR. tt >= output%TH%THIS1(1) .OR. tt >= output%TH%THIS1(2)
277 . .OR. tt >= output%TH%THIS1(3) .OR. tt >= output%TH%THIS1(4) .OR. tt >= output%TH%THIS1(5)
278 . .OR. tt >= output%TH%THIS1(6) .OR. tt >= output%TH%THIS1(7) .OR. tt >= output%TH%THIS1(8)
279 . .OR. tt >= output%TH%THIS1(9) .OR. nth /= 0 .OR. nanim /= 0
280 . .OR. tt >= tabfis(1) .OR. tt >= tabfis(2)
281 . .OR. tt >= tabfis(3) .OR. tt >= tabfis
282 . .OR. tt >= tabfis(6) .OR. tt >= tabfis(7) .OR. tt >= tabfis(8)
283 . .OR. tt >= tabfis(9) .OR. tt >= tabfis(10)
284 . .OR. (
ale%SUB%IALESUB /= 0 .AND. t1s+dt2s >= output%TH%THIS1(1))
285 . .OR. (
ale%SUB%IALESUB /= 0 .AND. t1s+dt2s >= output%TH%THIS1(2))
286 . .OR. (
ale%SUB%IALESUB /= 0 .AND.
287 . .OR. (
ale%SUB%IALESUB /= 0 .AND. t1s+dt2s >= output%TH%THIS1
288 . .OR. (
ale%SUB%IALESUB /= 0 .AND. t1s+dt2s >= output%TH%THIS1(5))
289 . .OR. (
ale%SUB%IALESUB /= 0 .AND. t1s+dt2s >= output%TH%THIS1
290 . .OR. (
ale%SUB%IALESUB /= 0 .AND. t1s+dt2s >= output%TH%THIS1(7))
291 . .OR. (
ale%SUB%IALESUB /= 0 .AND. t1s
292 . .OR. (
ale%SUB%IALESUB /= 0 .AND. t1s+dt2s >= output%TH%THIS1(9)) .OR. istat==3) ioutprt=1
294 ALLOCATE(qmv(2*nv46,lenqmv))
295 IF(m51_iflg6 == 1)sbufvois = m51_iflg6_size
297 IF(itask==0)
ALLOCATE(bufvois(sbufvois ,nsvois+nqvois))
298 IF(itask==0)sz_bufvois=sbufvois*(nsvois+nqvois)
300 IF(n2d /= 0 .AND. nmult /= 0)
THEN
303 iadbh=
max(1,nmult)*4*numelq+1
310 IF(iale+ieuler /= 0)
THEN
312 IF(ale_connectivity%NALE(n) /= 0) ms0(n) = ms(n)
316 IF(ale_connectivity%NALE(n) /= 0) v(1:3,n) = zero
324 IF(inter18_is_variable_gap_defined)
THEN
325 need_comm_inter18 = .true.
326 DO ng=itask+1,ngroup,nthread
327 IF (tt > zero .AND. iparg(76, ng) == 1) cycle
328 IF(iparg(8,ng) == 1) cycle
332 2 mtn ,nel ,nft ,iad ,ity ,
333 3 npt ,jale ,ismstr ,jeul ,jtur ,
334 4 jthe ,jlag ,jmult ,jhbe ,jivf
335 5 nvaux ,jpor ,jcvt ,jclose ,ipla ,
336 6 irep ,iint ,igtyp ,israt ,isrot ,
337 7 icsen ,isorth ,isorthg ,ifailure
338 IF (ity == 1 .AND. isolnod /= 4)
THEN
340 xcell(1,i+nft)=exp(log(elbuf_tab(ng)%GBUF%VOL(i))/three)
349 lencom = nercvois(nspmd + 1) + nesdvois(nspmd + 1)
350 CALL startime(timers, timer_spmdcfd)
351 CALL spmd_envois(3, xcell, nercvois, nesdvois, lercvois, lesdvois, lencom)
352 CALL stoptime(timers, timer_spmdcfd)
365 IF(
ale%SUB%IALESUB == 2)
THEN
367 IF(tt == zero .OR. tt+dt1 > t1s+dt2s)
THEN
379 IF(
ale%SUB%IFSUB == 0)
THEN
385 CALL alesub1(ale_connectivity%NALE,v,w,dsave,icodt,iskew,skew,d,itask,nodft,nodlt,fsky,fsky)
387 IF(
ale%SUB%IALESUB == 0 .AND. itask == 0)
THEN
393 IF (glob_therm%ITHERM == 1 .AND. iale+ieuler == 0)
ale%SUB%IFSUBM=0
401 IF (iparit == 0 .AND. nspmd > 1 .AND.
ale%SUB%IFSUBM == 1 .AND. n2d == 0 .AND.
ale%GLOBAL%INCOMP == 0)
THEN
411 IF (n2d > 0 .AND.
ale%SUB%IFSUBM == 1)
THEN
418 IF(
ale%SUB%IFSUB == 0)
THEN
419 IF(itask==0)
CALL startime(timers,macro_timer_ifsub0)
420 IF(iale+ieuler+glob_therm%ITHERM /= 0)
THEN
421 IF(
ale%GLOBAL%INCOMP == 0)
THEN
422 IF(nsegflu > 0 .AND. n2d == 0)
THEN
423 CALL seggetv(iparg,elbuf_tab,ale_connectivity,itask,segvar)
427 CALL startime(timers, timer_spmdcfd)
428 CALL spmd_segcom(segvar,npsegcom,lsegcom,npsegcom(nspmd+1),0)
429 CALL stoptime(timers, timer_spmdcfd)
439 IF (itask == 0 .AND. ispmd == 0)
440 .
CALL intti0(ipari ,x ,v ,wa ,itab ,iparg ,ixs ,segvar ,skew
448 i=1+ninter+nrwall+nrbody+nsect+njoint+nrbag
452 . elbuf_tab,ebcs_tab,multi_fvm
453 . fsky,fsavsurf,tt,dt1,
454 . sensors%NSENSOR,sensors%SENSOR_TAB
481 iad22 = ipari(npari*(nin-1)+39)
482 nbric_l = igrbric(ipari(npari*(nin-1)+45))%NENTITY
487 1 ixs , elbuf_tab, iparg, itab , itask ,
488 2 ibid , nbric_l , x , ale_connectivity , v ,
489 3 nv46 , veul , igrnod, ipari, igrtruss ,
495 IF (multi_fvm%IS_USED)
THEN
497 IF(itask==0)
CALL startime(timers,macro_timer_multifvm)
504 . partsav, iparts, gresav
505 IF (multi_fvm%NS_DIFF)
THEN
506 DO ng = itask + 1, ngroup, nthread
507 IF (iparg(1, ng) == 151)
THEN
521 . pm, ipm, multi_fvm, tt
531 IF(bcs%NUM_WALL > 0)
THEN
532 CALL bcs_wall_trigger(tt,ale_connectivity,sensors%NSENSOR,sensors%SENSOR_TAB)
540 IF (nspmd > 1 .AND. ((multi_fvm%MUSCL > 0) .OR. multi_fvm%NS_DIFF))
THEN
542 lencom = nercvois(nspmd + 1) + nesdvois(nspmd + 1)
543 CALL startime(timers, timer_spmdcfd)
544 CALL spmd_envois(3, multi_fvm%ELEM_DATA%CENTROID,nercvois, nesdvois, lercvois, lesdvois, lencom)
545 IF (
ALLOCATED(multi_fvm%VOL))
THEN
556 . pm, ipm, multi_fvm, w, x,
570 . ixs, ixq, iparg, x, a, v, w, ms, msnf, veul,
571 . stifn, fsky, iads, fskym,
572 . condn, condnsky, multi_fvm,glob_therm%NODADT_THERM)
576 multi_fvm%IS_RESTART = .false.
579 IF (multi_fvm%IS_RESTART)
THEN
590 . pm, ipm, multi_fvm, tt, bufmat,npc,tf
599 IF (nspmd > 1 .AND. multi_fvm%MUSCL > 0)
THEN
601 lencom = nercvois(nspmd + 1) + nesdvois(nspmd + 1)
604 . nercvois, nesdvois, lercvois, lesdvois, lencom)
610 multi_fvm%IS_RESTART = .false.
617 1 agrav, igrv , lgrav, sensors%NSENSOR,sensors%SENSOR_TAB,
618 2 itask, npc , tf , skew )
624 IF(bcs%NUM_WALL > 0)
THEN
625 CALL bcs_wall_trigger(tt,ale_connectivity,sensors%NSENSOR,sensors%SENSOR_TAB)
631 IF (multi_fvm%MUSCL == 1)
THEN
639 . pm, ipm, multi_fvm, ale_connectivity, v, a, w, x, d, ale_connectivity%NALE,
640 . partsav, iparts, gresav, igrth, grth,
641 . nercvois, nesdvois, lercvois, lesdvois,
642 . itab, itabm1, tt - dt1,
643 . stifn, fsky, iads, fskym,
644 . condn, condnsky, bufmat, fv, pred,id_global_vois,face_vois,ebcs_tab,npc,tf,fsavsurf,matparam,
652 . pm, ipm, multi_fvm, tt - dt1, bufmat
661 . pm, ipm, multi_fvm, ale_connectivity, v, a, w, x, d, ale_connectivity%NALE,
662 . partsav, iparts, gresav, igrth, grth,
663 . nercvois, nesdvois, lercvois, lesdvois,
664 . itab, itabm1, tt - dt1,
665 . stifn, fsky, iads, fskym,
666 . condn, condnsky, bufmat, fv, pred,id_global_vois,face_vois,ebcs_tab,npc,tf,fsavsurf,matparam,
674 . pm, ipm, multi_fvm, tt, bufmat,npc,tf,nummat,matparam)
681 . pm, ipm, multi_fvm, ale_connectivity, v, a, w, x, d, ale_connectivity%NALE,
682 . partsav, iparts, gresav, igrth, grth,
683 . nercvois, nesdvois, lercvois, lesdvois,
684 . itab, itabm1, tt - dt1,
685 . stifn, fsky, iads, fskym,
686 . condn, condnsky, bufmat, fv
690 IF (multi_fvm%NS_DIFF)
THEN
692 CALL ns_fvm_diffusion(ale_connectivity, multi_fvm, dt1, ebcs_tab, diffusion,
693 . ipm, pm, iparg, elbuf_tab, nercvois, nesdvois, lercvois, lesdvois,
701 . pm, ipm, multi_fvm, tt
722 . ixs, ixq, iparg, x, a, v, w, ms, msnf, veul,
723 . stifn, fsky, iads, fskym,
724 . condn, condnsky, multi_fvm,glob_therm%NODADT_THERM)
730 CALL multi_compute_dt(dt2t, elbuf_tab, iparg, itask, ixs, ixq, ixtg, pm, ipm, multi_fvm, w, x, neltst, ityptst)
733 IF(itask==0)
CALL stoptime(timers,macro_timer_multifvm)
741 1 iparg, elbuf_tab, wa, val2,
742 2 phi, ale_connectivity,ixs, ixq,
744 4 ms, veul, fill, dfill,
745 5 alph, fv, bufmat, tf,
746 6 npc, itask, nbrcvois, nbsdvois,
747 7 lnrcvois, lnsdvois, nercvois, nesdvois,
748 8 lercvois, lesdvois, segvar,
749 9 msnf, nodft, nodlt, wa(iadbh),
750 a ipm, qmv, itab, itabm1,
752 c iad_elem, glob_therm,
781 1 agrav, igrv , lgrav, sensors%NSENSOR,sensors%SENSOR_TAB,
782 2 itask , npc , tf , skew )
793 CALL s4alesfem(iparg,ixs,x,elbuf_tab,sfem_nodvar,s_sfem_nodvar,pm,iad_elem,fr_elem)
800 IF(
ale%GRID%NWALE == 7)
THEN
802 ale%GRID%flow_tracking_data%EP(1:9)=zero
803 ale%GRID%flow_tracking_data%SUM_M = zero
804 ale%GRID%flow_tracking_data%NUM_ELEM_ALE = 0
811 DO ng=itask+1,ngroup,nthread
813 sensors%NGR_SENSOR(itask+1) =
814 IF (tt > zero .AND. iparg(76, ng) == 1) cycle
815 IF(iparg(8,ng) /= 1)
THEN
818 2 mtn ,nel ,nft ,iad ,ity ,
819 3 npt ,jale ,ismstr ,jeul ,jtur ,
820 4 jthe ,jlag ,jmult ,jhbe ,jivf ,
821 5 nvaux ,jpor ,jcvt ,jclose ,ipla ,
822 6 irep ,iint ,igtyp ,israt ,isrot ,
823 7 icsen ,isorth ,isorthg ,ifailure,jsms )
825 IF (mtn == 151) cycle
826 IF(jlag /= 1 .AND. ity <= 2)
THEN
827 IF(iparg(64,ng)==1) ilaw11=1
828 IF (mtn /= 0 .AND. iparg(64,ng)==0)
THEN
836 ipartsph = iparg(69,ng)
841 IF (ity == 1 .AND. isolnod == 4)
THEN
843 1 elbuf_tab, ng, pm, geo,
846 4 veul, fv, ale_connectivity,iparg,
847 5 tf, npc, bufmat, partsav,
848 6 nloc_dmg, dt2t, neltst, ityptst,
849 7 stifn, fsky, iads, offset,
850 8 eani, iparts(nf1), fx(1,1), fy(1,1),
851 9 fz(1,1), fx(1,2), fy(1,2), fz(1,2),
852 a fx(1,3), fy(1,3), fz(1,3), fx(1,4),
853 b fy(1,4), fz(1,4), nel, fskym,
854 c msnf, ipm, igeo, bufvois,
855 d istra, itask, bid, bid,
856 e bid, ibid, gresav, grth,
857 f igrth, mssa, dmels, table,
858 g xdp, sfem_nodvar, voln, bid,
859 h bid, d, sensors, ioutprt,
860 i mat_elem, ibid, dt, idel7nok,
861 j nsvois, sz_bufvois, snpc, stf,
862 k sbufmat, svis, idtmins, iresp,
863 * idel7ng, maxfunc, userl_avail, glob_therm,
866 ELSEIF (ity == 1 .AND. isolnod /= 4)
THEN
873 CALL sforc3(timers,output,
877 4 val2, veul, fv, ale_connectivity,
878 5 iparg, tf, npc, bufmat,
879 6 partsav, itab, dt2t, neltst,
880 7 ityptst, stifn, fsky, iads,
881 8 offset, eani, iparts(1+nft), fx(1,1),
882 9 fy(1,1), fz(1,1), fx(1,2), fy(1,2),
883 a fz(1,2), fx(1,3), fy(1,3), fz(1,3),
884 b fx(1,4), fy(1,4), fz(1,4), fx(1,5),
885 c fy(1,5), fz(1,5), fx(1,6), fy(1,6),
886 d fz(1,6), fx(1,7), fy(1,7), fz(1,7),
887 e fx(1,8), fy(1,8), fz(1,8), nel,
888 f fskym, msnf, isky, fskyi,
889 g nvc, ipm, igeo, bid,
890 h bid, bid, bid, bid,
891 i bufvois, itask, pqmv, istra,
892 j temp, bid, bid, ibid,
893 k gresav, grth, igrth, mssa,
894 l dmels, table, bid, bid,
895 m bid, bid, bid, bid,
896 n bid, bid, bid, iparg(1,ng),
897 o xdp, bid, ibid, ibid,
898 p voln, condn, condnsky, agrav,
899 q igrv, lgrav, sensors, skew,
900 r ale_connectivity%NALE, d, ioutprt, nloc_dmg,
901 s mat_elem, ibid, dt, idel7nok,nsvois,
902 t sz_bufvois, snpc, stf, sbufmat
903 u idel7ng, maxfunc, userl_avail, glob_therm,
904 v impl_s, idyna, output%TH%WFEXT)
906 ELSEIF (ity == 2 .AND. jmult == 0)
THEN
913 CALL qforc2(timers, output,
915 1 pm ,geo ,ixq ,x ,a ,
916 2 v ,ms ,w ,wa ,val2 ,
917 3 veul ,ale_connectivity ,iparg ,nloc_dmg ,
918 4 tf ,npc ,bufmat ,partsav ,
919 5 dt2t ,neltst ,ityptst ,stifn ,offset ,
920 6 eani ,ipartq(1+nft) ,nel ,iadq ,fsky ,
921 9 ipm ,bufvois ,pqmv ,
922 a gresav ,grth ,igrth ,table ,igeo ,
923 b voln ,itask ,ms_2d ,fskym ,ioutprt ,
924 c mat_elem ,h3d_data%STRAIN ,sz_bufvois ,snpc ,stf ,sbufmat ,
925 d svis ,nsvois ,iresp ,tt ,dt1 ,
926 . idel7nok ,idtmin ,maxfunc ,
927 . imon_mat ,userl_avail ,impl_s ,idyna ,
928 . dt ,glob_therm ,sensors)
930 ELSEIF (ity == 2 .AND. jmult /= 0)
THEN
934 2 a , v ,ms , w , wa ,
935 3 val2 , veul ,ale_connectivity, iparg ,
936 4 iparg(1,ng) , fill ,dfill , ims , nloc_dmg ,
937 5 tf , npc ,bufmat , partsav ,
938 6 dt2t , neltst ,ityptst , stifn , offset ,
939 7 eani , ipartq(1+nft) ,nel , iadq , fsky ,
941 9 gresav , grth ,igrth
942 o voln , itask ,ms_2d , fskym , mat_elem ,
943 b ibid , output ,sz_bufvois , snpc , stf ,sbufmat, svis,
944 c nsvois , iresp ,idel7nok ,
945 d idtmin , maxfunc ,imon_mat ,
946 e userl_avail , impl_s , idyna ,dt ,
947 f glob_therm , sensors)
958 IF (ilaw11 /= 0)
THEN
967 lencom=nbrcvois(nspmd+1)+nbsdvois(nspmd
968 IF(m51_iflg6 == 0)
THEN
972 1 v ,nbrcvois,nbsdvois,lnrcvois,lnsdvois,
975 IF(
ale%GLOBAL%INCOMP == 1 .OR. iturb + glob_therm%ITHERM == 0)
976 .
CALL spmd_xvois(x,nbrcvois,nbsdvois,lnrcvois,lnsdvois,lencom )
979 1 bufvois ,iparg ,elbuf_tab,pm ,ixs ,
980 2 ixq ,nercvois,nesdvois,lercvois,lesdvois,
985 1 bufvois ,iparg ,elbuf_tab,pm ,ixs ,
986 2 ixq ,nercvois,nesdvois,lercvois,lesdvois,
987 3 lencom ,ipm ,bufmat)
993 DO ng=itask+1,ngroup,nthread
995 sensors%NGR_SENSOR(itask+1) = ng
996 IF (tt > zero .AND. iparg(76, ng) == 1) cycle
998 2 mtn ,nel ,nft ,iad ,ity ,
999 3 npt ,jale ,ismstr ,jeul ,jtur ,
1000 4 jthe ,jlag ,jmult ,jhbe ,jivf ,
1001 5 nvaux ,jpor ,jcvt ,jclose ,ipla ,
1002 6 irep ,iint ,igtyp ,israt ,isrot ,
1003 7 icsen ,isorth ,isorthg ,ifailure,jsms )
1004 IF (mtn == 151) cycle
1005 IF (iparg(8,ng) /= 1)
THEN
1006 IF (jlag /= 1 .AND. ity <= 2)
THEN
1007 IF (mtn == 11 .OR. iparg(64,ng) == 1)
THEN
1010 isolnod=iparg(28,ng)
1011 istra = iparg(44,ng)
1014 ipartsph = iparg(69,ng)
1020 IF(ity == 1 .AND. isolnod == 4)
THEN
1022 1 elbuf_tab, ng, pm, geo,
1025 4 veul, fv, ale_connectivity,iparg,
1026 5 tf, npc, bufmat, partsav,
1027 6 nloc_dmg, dt2t, neltst, ityptst,
1028 7 stifn, fsky, iads, offset,
1029 8 eani, iparts(nf1), fx(1,1), fy(1,1),
1030 9 fz(1,1), fx(1,2), fy(1,2), fz(1,2),
1031 a fx(1,3), fy(1,3), fz(1,3), fx(1,4),
1032 b fy(1,4), fz(1,4), nel, fskym,
1033 c msnf, ipm, igeo, bufvois,
1034 d istra, itask, bid, bid,
1035 e bid, ibid, gresav, grth,
1036 f igrth, mssa, dmels, table,
1038 h bid, d, sensors, ioutprt,
1039 i mat_elem, ibid, dt, idel7nok,
1041 k sbufmat, svis, idtmins, iresp,
1042 * idel7ng, maxfunc, userl_avail, glob_therm,
1043 v impl_s, idyna, s_sfem_nodvar)
1045 ELSEIF(ity == 1 .AND. isolnod /= 4)
THEN
1048 pqmv => qmv(1,1+nft)
1052 CALL sforc3(timers, output,
1053 1 elbuf_tab, ng, pm, geo,
1056 4 val2, veul, fv, ale_connectivity,
1057 5 iparg, tf, npc, bufmat,
1058 6 partsav, itab, dt2t, neltst,
1059 7 ityptst, stifn, fsky, iads,
1060 8 offset, eani, iparts(1+nft), fx(1,1),
1061 9 fy(1,1), fz(1,1), fx(1,2), fy(1,2),
1062 a fz(1,2), fx(1,3), fy(1,3), fz(1,3),
1063 b fx(1,4), fy(1,4), fz(1,4), fx(1,5),
1064 c fy(1,5), fz(1,5), fx(1,6), fy(1,6),
1065 d fz(1,6), fx(1,7), fy(1,7), fz(1,7),
1066 e fx(1,8), fy(1,8), fz(1,8), nel,
1067 f fskym, msnf, isky, fskyi,
1068 g nvc, ipm, igeo, bid,
1069 h bid, bid, bid, bid,
1070 i bufvois, itask, pqmv, istra,
1071 j temp, bid, bid, ibid,
1072 k gresav, grth, igrth, mssa,
1073 l dmels, table, bid, bid,
1074 m bid, bid, bid, bid,
1075 n bid, bid, bid, iparg(1,ng),
1076 o xdp, bid, ibid, ibid,
1077 p voln, condn, condnsky, agrav,
1078 q igrv, lgrav, sensors, skew,
1079 r ale_connectivity%NALE,d, ioutprt, nloc_dmg
1080 s mat_elem, ibid, dt, idel7nok,nsvois,
1081 t sz_bufvois, snpc, stf,sbufmat,svis,idtmins,iresp,
1082 u idel7ng, maxfunc, userl_avail ,glob_therm,
1083 v impl_s, idyna, output%TH%WFEXT)
1085 ELSEIF (ity == 2 .AND. jmult == 0)
THEN
1088 pqmv => qmv(1,1+nft)
1092 CALL qforc2(timers, output,
1094 1 pm ,geo ,ixq ,x ,a ,
1095 2 v ,ms ,w ,wa ,val2 ,
1096 3 veul ,ale_connectivity ,iparg ,nloc_dmg ,
1097 4 tf ,npc ,bufmat ,partsav ,
1098 5 dt2t ,neltst ,ityptst ,stifn ,offset ,
1099 6 eani ,ipartq(1+nft) ,nel
1100 9 ipm ,bufvois ,pqmv
1101 a gresav ,grth ,igrth ,table ,igeo ,
1102 b voln ,itask ,ms_2d ,fskym ,ioutprt ,
1103 c mat_elem ,h3d_data%STRAIN ,sz_bufvois ,snpc ,stf ,sbufmat,
1104 d svis ,nsvois ,iresp ,tt ,dt1 ,
1105 . idel7nok ,idtmin ,maxfunc ,
1106 . imon_mat ,userl_avail ,impl_s ,idyna ,
1107 . dt ,glob_therm ,sensors)
1109 ELSEIF(ity == 2 .AND. jmult /= 0)
THEN
1110 CALL bforc2(timers, elbuf_tab ,ng ,
1113 3 val2 ,veul ,ale_connectivity ,iparg ,
1115 5 tf ,npc ,bufmat ,partsav ,
1116 5 dt2t ,neltst ,ityptst
1117 6 eani ,ipartq(1+nft),nel ,iadq ,fsky ,
1119 8 gresav ,grth ,igrth ,table ,igeo ,
1120 9 voln ,itask ,ms_2d ,fskym ,mat_elem,
1121 a ibid ,output ,sz_bufvois ,snpc ,stf ,sbufmat ,svis,
1122 b nsvois ,iresp ,idel7nok ,
1123 c idtmin ,maxfunc ,imon_mat ,
1124 e userl_avail,impl_s ,idyna ,dt ,
1125 f glob_therm ,sensors)
1136 IF(itask==0)
CALL stoptime(timers,macro_timer_ifsub0)
1149 IF (nbgauge > 0)
THEN
1151 lencom =nercvois(nspmd+1)+nesdvois(nspmd+1)
1154 1 iparg ,elbuf_tab ,phi ,ixs ,ixq ,
1155 2 x ,ale_connectivity,itask ,nercvois,nesdvois,
1156 3 lercvois,lesdvois ,lencom ,lgauge ,
1157 4 gauge ,v ,igaup ,ngaup ,ixtg)
1163 IF(
ale%SUB%IALESUB == 2)
THEN
1168 IF(
ale%SUB%IFSUB == 0)
THEN
1173 IF(
ale%SUB%IFSUB == 1)
THEN
1177 aglob(1,n)=asave(1,n)
1178 aglob(2,n)=asave(2,n)
1179 aglob(3,n)=asave(3,n)
1189 IF(itask==0)
DEALLOCATE(bufvois)