53 1 IPARI ,X ,V ,INTBUF_TAB,
54 2 MS ,NIN ,ITASK ,MWAG ,WEIGHT ,
55 3 ISENDTO ,IRCVFROM,RETRI ,IAD_ELEM,FR_ELEM ,
56 4 ITAB ,KINET ,TEMP ,NRTM_T ,RENUM ,
57 5 NSNFIOLD,ESHIFT ,NUM_IMP ,IND_IMP ,NODNX_SMS,
58 6 H3D_DATA,T2MAIN_SMS,FORNEQS,T2FAC_SMS,PARAMETERS,
59 7 INTHEAT,IDT_THERM,NODADT_THERM)
70 use check_sorting_criteria_mod ,
only : check_sorting_criteria
75#include "implicit_f.inc"
85#include "timeri_c.inc"
88 COMMON /i7mainc/bminma,curv_max_max,result,nsnr,nsnrold,i_memg,nmn_g
89 INTEGER RESULT,NSNR,NSNROLD,I_MEMG,NMN_G
95 TYPE(timer_) :: TIMERS
96 INTEGER NIN ,ITASK, RETRI, NRTM_T,ESHIFT,
97 . num_imp ,ind_imp(*),
99 . ipari(npari,ninter), mwag(*),
100 . isendto(ninter+1,*),ircvfrom(ninter+1,*),
101 . weight(*), iad_elem(2,*) ,fr_elem(*),
102 . renum(numnod), nsnfiold(nspmd), nodnx_sms(*), t2main_sms(6,*)
103 INTEGER,
INTENT(IN) :: INTHEAT
104 INTEGER,
INTENT(IN) :: IDT_THERM
105 INTEGER ,
INTENT(IN) ::
108 . X(3,*), V(*), MS(*),TEMP(*),T2FAC_SMS(*)
111 TYPE (PARAMETERS_) ,
INTENT(IN):: PARAMETERS
115 INTEGER LOC_PROC,IEDGE,IGSTI,
116 . i, ip0, ip1, ip2, ip21, k11_t, i_sk_old, i_stok1,
117 . add1, nb_n_b, noint, inacti, multimp, igap, ifq ,
118 . intnitsche,ifsub_carea
120 . ILD, NCONT, NCONTACT, INACTII, INACIMP, INTTH,
121 . I_MEM,,,FLAGREMN, NRTSE ,NMN_L
124 . gap,maxbox,minbox,dgapload,
125 . xmaxl, ymaxl, zmaxl, xminl, yminl, zminl, gapmin, gapmax,
126 . c_maxl,pmax_gap,vmaxdt,marge,tzinf,sx,sy
127 . curv_max(nrtm_t),bminma_old(6),forneqs(*)
129 INTEGER,
DIMENSION(:),
ALLOCATABLE :: CAND_A
130 INTEGER :: NMN, NSN,NRTM,NTY,NSNE
132 logical :: need_computation
136 call check_sorting_criteria( need_computation,nin,npari,nspmd,
137 . itask,ipari(1,nin),tt,intbuf_tab )
138 if( .not.need_computation )
return
151 noint = ipari(15,nin)
152 ncont = ipari(18,nin)
154 inacti = ipari(22,nin)
155 multimp = ipari(23,nin)
156 ncontact= multimp*ncont
158 intth = ipari(47,nin)
159 iedge = ipari(58,nin)
160 flagremn= ipari(63,nin)
161 igsti = ipari(34,nin)
162 nrtse = ipari(52,nin)
164 intnitsche = ipari(86,nin)
166 IF(parameters%INTCAREA > 0) ifsub_carea = 1
168 nsnrold = ipari(24,nin)
170 gap =intbuf_tab%VARIABLES(gap_index)
171 gapmin=intbuf_tab%VARIABLES(gapmin_index)
172 gapmax=intbuf_tab%VARIABLES(gapmax_index)
173 pmax_gap=intbuf_tab%VARIABLES(pmax_index)
174 vmaxdt =intbuf_tab%VARIABLES(vmaxdt_index)
184 maxbox = intbuf_tab%VARIABLES(maxbox_index)
185 minbox = intbuf_tab%VARIABLES(minbox_index)
186 marge = intbuf_tab%VARIABLES(marge_index)
187 dgapload = intbuf_tab%VARIABLES
203 ALLOCATE (cand_a(nsn+nsnrold+3))
204 cand_a(1:nsn+nsnrold+3)=0
205 i_sk_old = intbuf_tab%I_STOK(1)
207 1 nsn+nsnrold ,i_sk_old ,intbuf_tab%CAND_N,intbuf_tab%CAND_E,cand_a,
208 2 nin, nsn,intbuf_tab%IRTLM,intbuf_tab%NSV,itab,
209 2 intbuf_tab%MSEGLO,intbuf_tab%MSEGTYP24)
210 intbuf_tab%I_STOK(1)=i_sk_old
222 1 x ,intbuf_tab%NSV,intbuf_tab%MSR,nsn ,nmn ,
223 2 itask ,intbuf_tab%XSAV,xminl ,yminl ,zminl ,
224 3 xmaxl ,ymaxl ,zmaxl ,c_maxl,curv_max,
225 4 ipari(39,nin),intbuf_tab%IRECTM(1+4*eshift),nrtm_t ,sx ,sy ,
226 5 sz ,sx2 ,sy2 ,sz2 ,nmn_l)
228 bminma(1) =
max(bminma(1),xmaxl)
229 bminma(2) =
max(bminma(2),ymaxl)
230 bminma(3) =
max(bminma(3),zmaxl)
231 bminma(4) =
min(bminma(4),xminl)
232 bminma(5) =
min(bminma(5),yminl)
233 bminma(6) =
min(bminma(6),zminl)
234 curv_max_max =
max(curv_max_max,c_maxl)
235 nmn_g = nmn_g + nmn_l
236#include "lockoff.inc"
243 IF(abs(bminma(6)-bminma(3))>2*ep30.OR.
244 + abs(bminma(5)-bminma(2))>2*ep30.OR.
245 + abs(bminma(4)-bminma(1))>2*ep30)
THEN
246 CALL ancmsg(msgid=87,anmode=aninfo,
247 . i1=noint,c1=
'(I24BUCE)')
251 tzinf = marge+
max(gap+dgapload,pmax_gap)+curv_max_max
253 bminma(1)=bminma(1)+tzinf
254 bminma(2)=bminma(2)+tzinf
255 bminma(3)=bminma(3)+tzinf
256 bminma(4)=bminma(4)-tzinf
257 bminma(5)=bminma(5)-tzinf
258 bminma(6)=bminma(6)-tzinf
261 CALL ancmsg(msgid=36,anmode=aninfo,
267 IF (impl_s >0 .AND. ncycle>0 .AND. inconv==1)
THEN
268 bminma_old(1)=intbuf_tab%BMINMA_IMP(1)
269 bminma_old(2)=intbuf_tab%BMINMA_IMP(2)
270 bminma_old(3)=intbuf_tab%BMINMA_IMP(3)
271 bminma_old(4)=intbuf_tab%BMINMA_IMP(4)
272 bminma_old(5)=intbuf_tab%BMINMA_IMP(5)
273 bminma_old(6)=intbuf_tab%BMINMA_IMP(6)
275 intbuf_tab%BMINMA_IMP(1)=bminma(1)
276 intbuf_tab%BMINMA_IMP(2)=bminma(2)
277 intbuf_tab%BMINMA_IMP(3)=bminma(3)
278 intbuf_tab%BMINMA_IMP(4)=bminma(4)
279 intbuf_tab%BMINMA_IMP(5)=bminma(5)
280 intbuf_tab%BMINMA_IMP(6)=bminma(6)
282 bminma(1)=
max(bminma(1),bminma_old(1))
283 bminma(2)=
max(bminma(2),bminma_old(2))
284 bminma(3)=
max(bminma(3),bminma_old(3))
285 bminma(4)=
min(bminma(4),bminma_old(4))
286 bminma(5)=
min(bminma(5),bminma_old(5))
287 bminma(6)=
min(bminma(6),bminma_old(6))
297 IF (imonm > 0 .AND. itask == 0)
CALL startime(timers,26)
300 1 x ,bminma ,nrtm_t,intbuf_tab%STFM(1+eshift),marge ,
301 2 curv_max,intbuf_tab%GAP_M(1+eshift),intbuf_tab%IRECTM
302 + intbuf_tab%VARIABLES
303 3 pmax_gap,vmaxdt ,dgapload )
306 IF (imonm > 0 .AND. itask == 0)
CALL stoptime(timers,26)
314 IF (imonm > 0 .AND. itask == 0)
CALL startime(timers,25)
317 1 intbuf_tab%NSV,nsn ,x ,v
318 2 bminma ,weight ,intbuf_tab%STFNS,nin ,isendto,
319 3 ircvfrom ,iad_elem,fr_elem ,nsnr ,ipari(21,nin),
320 4 intbuf_tab%GAP_S,itab ,kinet ,ifq ,inacti ,
321 5 nsnfiold,ipari(47,nin),intbuf_tab%IELEC,intbuf_tab%AREAS,temp,
322 6 num_imp ,nodnx_sms,intbuf_tab%STIF_OLD,nty ,
323 7 intbuf_tab%IRTLM,intbuf_tab%TIME_S,intbuf_tab%SECND_FR,intbuf_tab%PENE_OLD,
324 8 intbuf_tab%STIF_OLD , intbuf_tab%NBINFLG,ilev ,intbuf_tab%ICONT_I ,
325 9 intbuf_tab%XFIC ,intbuf_tab%VFIC ,ipari(59,nin),nsne,intbuf_tab%IS2SE,
326 a intbuf_tab%IRTSE, intbuf_tab%IS2PT,intbuf_tab%ISEGPT,intbuf_tab%MSFIC,nrtse,
327 b intbuf_tab%IS2ID,intbuf_tab%ISPT2,ipari(72,nin),intbuf_tab%IPARTFRICS,t2main_sms,
328 c intnitsche ,forneqs ,t2fac_sms ,ipari(97,nin) ,intbuf_tab%STIFMSDT_S,
329 d ifsub_carea ,parameters%INTAREAN)
330 IF (imonm > 0 .AND. itask == 0)
CALL stoptime
337 1 intbuf_tab%CAND_N,renum ,intbuf_tab%I_STOK
343 cand_n_old = intbuf_tab%I_STOK(1)
353 IF (imonm > 0)
CALL startime(timers,30)
356 1 x ,v ,intbuf_tab%IRECTM(1+4*eshift),intbuf_tab%NSV,
358 2 nmn ,nrtm_t ,nsn ,intbuf_tab%CAND_E,intbuf_tab%CAND_N,
359 3 gap ,noint ,intbuf_tab%I_STOK(1) ,ncontact ,bminma ,
360 4 marge ,curv_max ,pmax_gap ,vmaxdt ,nb_n_b ,
361 5 eshift ,ild ,nin ,intbuf_tab%STFM(1+eshift) ,intbuf_tab%GAP_S,
362 6 nsnr ,ncont ,intbuf_tab%GAP_M(1+eshift) ,itask ,intbuf_tab%VARIABLES(bgapsmx_index),
363 7 i_mem ,intbuf_tab%PENE_OLD,itab ,intbuf_tab%NBINFLG,intbuf_tab%MBINFLG,
364 8 ilev ,intbuf_tab%MSEGTYP24,intbuf_tab%EDGE8L2 ,iedge ,intbuf_tab%ISEADD,
365 9 intbuf_tab%ISEDGE,intbuf_tab%CAND_T,flagremn,intbuf_tab%KREMNODE(1+2*eshift),intbuf_tab%REMNODE ,
366 a cand_a,renum,nsnrold,intbuf_tab%IRTSE,intbuf_tab%IS2SE,nsne ,dgapload,
367 b intheat,idt_therm,nodadt_therm)
373#include "lockoff.inc"
383 multimp = ipari(23,nin) * 1.3
388 intbuf_tab%I_STOK(1)=cand_n_old
389 multimp=ipari(23,nin)
390 ncontact=multimp*ncont
394 IF (imonm > 0)
CALL stoptime(timers,30)
397 result = result + ild
398#include "lockoff.inc"
406 intbuf_tab%I_STOK(1) = i_sk_old
417 IF (imonm > 0)
CALL startime(timers,26)
418 intbuf_tab%VARIABLES(distance_index) = - one
421 1 result ,nsn ,intbuf_tab%CAND_N,intbuf_tab%I_STOK(1),nin,
422 2 ipari(21,nin),nsnr,multimp ,nty,ipari(47,nin),
423 3 ilev ,ipari(59,nin) ,h3d_data ,ipari(72,nin) ,intnitsche,
424 4 ipari(97,nin) ,ifsub_carea,nodadt_therm)
427 IF (nty==24.AND.result==0.AND.impl_s>0.AND.igsti==6)
THEN
431 IF (imonm > 0)
CALL stoptime(timers,26)
434 IF(itask==0)
DEALLOCATE(cand_a)
subroutine i24buce(x, v, irect, nsv, stfn, nmn, nrtm, nsn, cand_e, cand_n, gap, noint, ii_stok, ncontact, bminma, marge, curv_max, pmax_gap, vmaxdt, nb_n_b, eshift, ild, nin, stf, gap_s, nsnr, ncont, gap_m, itask, bgapsmx, i_mem, pene_old, itab, nbinflg, mbinflg, ilev, msegtyp, edge_l2, iedge, iseadd, isedge, cand_t, flagremnode, kremnod, remnod, cand_a, renum, nsnrold, irtse, is2se, nsne, dgapload, intheat, idt_therm, nodadt_therm)
subroutine i24main_tri(timers, ipari, x, v, intbuf_tab, ms, nin, itask, mwag, weight, isendto, ircvfrom, retri, iad_elem, fr_elem, itab, kinet, temp, nrtm_t, renum, nsnfiold, eshift, num_imp, ind_imp, nodnx_sms, h3d_data, t2main_sms, forneqs, t2fac_sms, parameters, intheat, idt_therm, nodadt_therm)
subroutine spmd_tri24vox(nsv, nsn, x, v, ms, bminmal, weight, stifn, nin, isendto, ircvfrom, iad_elem, fr_elem, nsnr, igap, gap_s, itab, kinet, ifq, inacti, nsnfiold, intth, ielec, areas, temp, num_imp, nodnx_sms, gap_s_l, ityp, i24_irtlm, i24_time_s, i24_frfi, i24_pene_old, i24_stif_old, nbinflg, ilev, i24_icont_i, xfic, vfic, iedge4, nsne, is2se, irtse, is2pt, isegpt, msfic, nrtse, is2id, ispt2, intfric, ipartfrics, t2main_sms, intnitsche, forneqs, t2fac_sms, istif_msdt, stifmsdt_s, ifsub_carea, intarean)