53 2 MS ,NIN ,ITASK ,WEIGHT ,ISENDTO ,
54 3 IRCVFROM,RETRI ,IAD_ELEM,FR_ELEM ,ITAB ,
55 4 NRTM_T ,ESHIFT,NODNX_SMS,RENUM,NSNFIOLD ,
56 5 INTBUF_TAB,TEMP,NODADT_THERM)
65 use check_sorting_criteria_mod ,
only : check_sorting_criteria
69#include "implicit_f.inc"
79#include "timeri_c.inc"
80 COMMON /i11mainc/bminma,result,nrtsr,i_memg,nsnrold
81 INTEGER RESULT,NRTSR,I_MEMG,NSNROLD
87 TYPE(timer_),
INTENT(INOUT) :: TIMERS
88 INTEGER,
INTENT(IN) :: ITASK
89 INTEGER NIN , RETRI, NRTM_T, ESHIFT
90 INTEGER IPARI(NPARI,NINTER), ITAB(*),
91 . WEIGHT(*), IAD_ELEM(2,*) ,FR_ELEM(*),
92 . isendto(ninter+1,*),ircvfrom(ninter+1,*),nodnx_sms(*),
93 . renum(*),nsnfiold(nspmd)
94 INTEGER ,
INTENT(IN) :: NODADT_THERM
97 . x(*), v(3,*), ms(*),temp(*)
99 TYPE(intbuf_struct_) INTBUF_TAB
106 . ncont, ncontact,i_mem,cand_n_old,
107 . loc_proc,i_sk_new,nft,jlt,i_stok,iform
108 INTEGER,
DIMENSION(:),
ALLOCATABLE :: , OLDINBUF2
111 . GAP, MAXBOX, MINBOX, TZINF,
112 . XMAXL, YMAXL, ZMAXL, XMINL, YMINL, ZMINL, INACTI,DRAD,DGAPLOAD
113 INTEGER :: NMN, NSN,NTY,NRTS,NRTM
114 logical :: need_computation
119 call check_sorting_criteria( need_computation,nin,npari,nspmd,
120 . itask,ipari(1,nin),tt,intbuf_tab )
121 if( .not.need_computation )
return
134 multimp =ipari(23,nin)
137 ncontact=multimp*ncont
140 nsnrold = ipari(24,nin)
145 gap = intbuf_tab%VARIABLES(2)
146 drad =intbuf_tab%VARIABLES(24)
147 dgapload =intbuf_tab%VARIABLES(46)
151 maxbox = intbuf_tab%VARIABLES(9)
152 minbox = intbuf_tab%VARIABLES(12)
153 tzinf = intbuf_tab%VARIABLES(8)
165 IF(
SIZE(intbuf_tab%ADCCM) < nrtm)
THEN
166 DEALLOCATE(intbuf_tab%ADCCM)
167 ALLOCATE (intbuf_tab%ADCCM(nrtm))
170 intbuf_tab%ADCCM(i) = 0
173 intbuf_tab%CHAIN(i) = 0
180 i_stok = intbuf_tab%I_STOK(1)
183 intbuf_tab%I_STOK(1)=0
186 DO nft=0, i_sk_old - 1 , nvsiz
187 jlt =
min( nvsiz, i_sk_old - nft )
190 1 i_sk_new ,intbuf_tab%CAND_N, intbuf_tab%CAND_E, intbuf_tab%FTSAVX, intbuf_tab%FTSAVY,
191 2 intbuf_tab%FTSAVZ,iform , intbuf_tab%ADCCM , intbuf_tab%CHAIN , ncontact,
192 . itab,jlt, nft,intbuf_tab%IFPEN,intbuf_tab%STFS,nin,nrts)
195 intbuf_tab%I_STOK(1) = i_sk_new
207 1 x ,intbuf_tab%NSV ,intbuf_tab%MSR,nsn ,nmn ,
208 2 itask ,intbuf_tab%XSAV,xminl ,yminl ,zminl ,
209 3 xmaxl ,ymaxl ,zmaxl )
211 bminma(1) =
max(bminma(1),xmaxl)
212 bminma(2) =
max(bminma(2),ymaxl)
213 bminma(3) =
max(bminma(3),zmaxl)
214 bminma(4) =
min(bminma(4),xminl)
215 bminma(5) =
min(bminma(5),yminl)
216 bminma(6) =
min(bminma(6),zminl)
217#include "lockoff.inc"
225 IF(abs(bminma(6)-bminma(3))>2*ep30.OR.
226 + abs(bminma(5)-bminma(2))>2*ep30.OR.
227 + abs(bminma(4)-bminma(1))>2*ep30)
THEN
228 CALL ancmsg(msgid=87,anmode=aninfo,
229 . i1=noint,c1=
'(I7BUCE)')
233 bminma(1)=bminma(1)+tzinf
234 bminma(2)=bminma(2)+tzinf
235 bminma(3)=bminma(3)+tzinf
236 bminma(4)=bminma(4)-tzinf
237 bminma(5)=bminma(5)-tzinf
238 bminma(6)=bminma(6)-tzinf
241 CALL ancmsg(msgid=36,anmode=aninfo,
256 IF (imonm > 0 .AND. itask == 0)
CALL startime(timers,26)
258 1 x ,bminma ,ipari(21,nin),nrtm_t , intbuf_tab%STFM(1+eshift),
259 2 tzinf ,intbuf_tab%IRECTM(1+2*eshift),gap,intbuf_tab%GAP_M(1+eshift),
260 3 intbuf_tab%VARIABLES(13) ,intbuf_tab%VARIABLES(7),drad,dgapload)
263 IF (imonm > 0 .AND. itask == 0)
CALL stoptime(timers,26)
268 IF (imonm > 0 .AND. itask == 0)
CALL startime(timers,25)
270 1 intbuf_tab%IRECTS,nrts ,x ,v ,ms ,
271 2 bminma ,weight ,intbuf_tab%STFS,nin ,isendto ,
272 3 ircvfrom ,iad_elem ,fr_elem ,nrtsr ,ipari(22,nin),
273 4 intbuf_tab%GAP_S ,intbuf_tab%PENIS , itab ,ipari(21,nin),tzinf ,
274 5 nodnx_sms ,intbuf_tab%GAP_SL,nsnfiold,iform ,ipari(47,nin),
275 6 intbuf_tab%IELEC,intbuf_tab%AREAS ,temp ,ipari(36,nin),intbuf_tab%ADDSUBS,
276 7 intbuf_tab%LISUBS,ipari(72,nin),intbuf_tab%IPARTFRICS,intbuf_tab%INFLG_SUBS)
277 IF (imonm > 0 .AND. itask == 0)
CALL stoptime(timers,25)
286 1 intbuf_tab%CAND_N,renum ,intbuf_tab%I_STOK(1), nin, nrts,
287 2 nsnfiold ,nsnrold ,intbuf_tab%ADCCM,intbuf_tab%CHAIN,
288 3 intbuf_tab%CAND_E,ncontact,nrtm)
296 cand_n_old = intbuf_tab%I_STOK(1)
301 IF (
ALLOCATED(oldinbuf1))
DEALLOCATE(oldinbuf1)
302 IF (
ALLOCATED(oldinbuf2))
DEALLOCATE(oldinbuf2)
304 ALLOCATE(oldinbuf1(nrtm), oldinbuf2(2*ncontact))
306 oldinbuf1(1:nrtm) = 0
307 oldinbuf2(1:2*ncontact) = 0
310 oldinbuf1(i) = intbuf_tab%ADCCM(i)
313 oldinbuf2(i) = intbuf_tab%CHAIN(i)
334 1 x ,intbuf_tab%IRECTS ,intbuf_tab%IRECTM(1+2*eshift) ,nrts ,nmn ,
335 2 nrtm_t,nsn ,intbuf_tab%CAND_E,intbuf_tab%CAND_N,gap ,
336 3 noint ,intbuf_tab%I_STOK(1),tzinf ,maxbox ,minbox ,
337 4 nb_n_b,eshift ,ild ,bminma ,ncontact ,
338 6 intbuf_tab%ADCCM(1+eshift) ,intbuf_tab%CHAIN,nin ,itab ,nrtsr ,
339 7 ncont ,intbuf_tab%GAP_S ,intbuf_tab%STFS,intbuf_tab%PENIS
340 8 intbuf_tab%STFM(1+eshift),ipari(42,nin),i_mem , itask ,iform ,
341 9 intbuf_tab%IFPEN ,drad, intbuf_tab%GAP_M(1+eshift), intbuf_tab%GAP_SL
342 1 intbuf_tab%GAP_ML(1+eshift),intbuf_tab%VARIABLES(13),intbuf_tab%VARIABLES(7), gap,
343 2 ipari(63,nin),intbuf_tab%KREMNODE(1+2*eshift),intbuf_tab%REMNODE,dgapload)
349#include "lockoff.inc"
359 intbuf_tab%ADCCM(i)= oldinbuf1(i)
362 intbuf_tab%CHAIN(i)= oldinbuf2(i)
364 DEALLOCATE(oldinbuf1,oldinbuf2)
374 multimp =
max(ipari(23,nin) +4,ipari(23,nin)+
min(20,(250000/ncont)))
387 intbuf_tab%I_STOK(1)=cand_n_old
388 multimp=ipari(23,nin)
389 ncontact=multimp*ncont
394 intbuf_tab%VARIABLES(9) =
min(maxbox,intbuf_tab%VARIABLES(9))
395 intbuf_tab%VARIABLES(12) =
min(minbox,intbuf_tab%VARIABLES(12))
396 intbuf_tab%VARIABLES(8) =
min(tzinf,intbuf_tab%VARIABLES(8))
397 intbuf_tab%VARIABLES(5) = intbuf_tab%VARIABLES(8)-gap
398 result = result + ild
399#include "lockoff.inc"
406 intbuf_tab%I_STOK(1) = i_sk_old
411 maxbox = intbuf_tab%VARIABLES(9)
412 minbox = intbuf_tab%VARIABLES(12)
413 tzinf = intbuf_tab%VARIABLES(8)
419 IF (imonm > 0)
CALL startime(timers,26)
421 intbuf_tab%VARIABLES(5) = -intbuf_tab%VARIABLES(5)
423 1 result ,nrts ,intbuf_tab%CAND_N,intbuf_tab%I_STOK(1),nin,
424 2 ipari(22,nin),nrtsr,multimp ,ipari(21,nin),ipari(47,nin),
425 2 ipari(36,nin),ipari(72,nin),nodadt_therm)
428 ipari(24,nin) = nrtsr
430 IF (imonm > 0)
CALL stoptime(timers,26)
434 IF (
ALLOCATED(oldinbuf1))
DEALLOCATE(oldinbuf1)
435 IF (
ALLOCATED(oldinbuf2))
DEALLOCATE(oldinbuf2)
subroutine i11buce_vox(x, irects, irectm, nrts, nmn, nrtm, nsn, cand_m, cand_s, maxgap, noint, ii_stok, tzinf, maxbox, minbox, nb_n_b, eshift, ild, bminma, ncontact, addcm, chaine, nin, itab, nrtsr, ncont, gap_s, stifs, penis, igap, stifm, iauto, i_mem, itask, iform, ifpen, drad, gap_m, gap_s_l, gap_m_l, gapmin, bgapsmx, gap, flagremnode, kremnode, remnode, dgapload)
subroutine i11main_tri(timers, ipari, x, v, ms, nin, itask, weight, isendto, ircvfrom, retri, iad_elem, fr_elem, itab, nrtm_t, eshift, nodnx_sms, renum, nsnfiold, intbuf_tab, temp, nodadt_therm)