OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i20main_tri.F
Go to the documentation of this file.
1Copyright> OpenRadioss
2Copyright> Copyright (C) 1986-2025 Altair Engineering Inc.
3Copyright>
4Copyright> This program is free software: you can redistribute it and/or modify
5Copyright> it under the terms of the GNU Affero General Public License as published by
6Copyright> the Free Software Foundation, either version 3 of the License, or
7Copyright> (at your option) any later version.
8Copyright>
9Copyright> This program is distributed in the hope that it will be useful,
10Copyright> but WITHOUT ANY WARRANTY; without even the implied warranty of
11Copyright> MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12Copyright> GNU Affero General Public License for more details.
13Copyright>
14Copyright> You should have received a copy of the GNU Affero General Public License
15Copyright> along with this program. If not, see <https://www.gnu.org/licenses/>.
16Copyright>
17Copyright>
18Copyright> Commercial Alternative: Altair Radioss Software
19Copyright>
20Copyright> As an alternative to this open-source version, Altair also offers Altair Radioss
21Copyright> software under a commercial license. Contact Altair to discuss further if the
22Copyright> commercial version may interest you: https://www.altair.com/radioss/.
23!||====================================================================
24!|| i20main_tri ../engine/source/interfaces/intsort/i20main_tri.F
25!||--- called by ------------------------------------------------------
26!|| imp_tripi ../engine/source/implicit/imp_int_k.F
27!|| inttri ../engine/source/interfaces/intsort/inttri.F
28!||--- calls -----------------------------------------------------
29!|| ancmsg ../engine/source/output/message/message.F
30!|| arret ../engine/source/system/arret.F
31!|| check_sorting_criteria ../engine/source/interfaces/intsort/check_sorting_criteria.F90
32!|| i20buc_edge ../engine/source/interfaces/intsort/i20buce.F
33!|| i20buce ../engine/source/interfaces/intsort/i20buce.F
34!|| i20xsave ../engine/source/interfaces/intsort/i20xsave.F
35!|| i7trc ../engine/source/interfaces/intsort/i7trc.F
36!|| imp_rnumcd ../engine/source/implicit/imp_int_k.F
37!|| my_barrier ../engine/source/system/machine.F
38!|| spmd_get_inacti7 ../engine/source/mpi/interfaces/send_cand.F
39!|| spmd_rnumcd20 ../engine/source/mpi/interfaces/spmd_i7tool.F
40!|| spmd_tri20box ../engine/source/mpi/interfaces/spmd_tri20box.F
41!|| spmd_tri20boxe ../engine/source/mpi/interfaces/spmd_tri20boxe.F
42!|| spmd_tri20gat ../engine/source/mpi/interfaces/spmd_i7crit.F
43!|| spmd_tri20gate ../engine/source/mpi/interfaces/spmd_i7crit.f
44!|| startime ../engine/source/system/timer_mod.F90
45!|| stoptime ../engine/source/system/timer_mod.F90
46!|| upgrade_multimp ../common_source/interf/upgrade_multimp.F
47!||--- uses -----------------------------------------------------
48!|| check_sorting_criteria_mod ../engine/source/interfaces/intsort/check_sorting_criteria.F90
49!|| glob_therm_mod ../common_source/modules/mat_elem/glob_therm_mod.F90
50!|| h3d_mod ../engine/share/modules/h3d_mod.F
51!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
52!|| message_mod ../engine/share/message_module/message_mod.F
53!|| timer_mod ../engine/source/system/timer_mod.F90
54!||====================================================================
55 SUBROUTINE i20main_tri(TIMERS,
56 1 IPARI ,X ,V ,
57 2 MS ,NIN ,ITASK ,MWAG ,WEIGHT ,
58 3 ISENDTO ,IRCVFROM,RETRI ,IAD_ELEM,FR_ELEM ,
59 4 ITAB ,KINET ,TEMP ,NRTM_T ,RENUM ,
60 5 NSNFIOLD,ESHIFT ,NUM_IMP ,IND_IMP ,DIAG_SMS,
61 6 NODNX_SMS,INTBUF_TAB,H3D_DATA,GLOB_THERM)
62C============================================================================
63C-----------------------------------------------
64C M o d u l e s
65C-----------------------------------------------
66 USE timer_mod
67 USE message_mod
68 USE intbufdef_mod
69 USE h3d_mod
70 use check_sorting_criteria_mod , only : check_sorting_criteria
71 use glob_therm_mod
72C-----------------------------------------------
73C I m p l i c i t T y p e s
74C-----------------------------------------------
75#include "implicit_f.inc"
76#include "comlock.inc"
77C-----------------------------------------------
78C C o m m o n B l o c k s
79C-----------------------------------------------
80#include "com01_c.inc"
81#include "com04_c.inc"
82#include "com08_c.inc"
83#include "param_c.inc"
84#include "task_c.inc"
85#include "timeri_c.inc"
86C-----------------------------------------------
87 COMMON /i20mainc/bminma,bminmae,curv_max_max,
88 . result,nsnr,nsnrold,nlinsr,i_memg
89 INTEGER RESULT,NSNR,NSNROLD,NLINSR,I_MEMG
90 my_real
91 . BMINMA(6),BMINMAE(6),CURV_MAX_MAX
92C-----------------------------------------------
93C D u m m y A r g u m e n t s
94C-----------------------------------------------
95 TYPE(timer_) :: TIMERS
96 INTEGER NIN ,ITASK, RETRI,NRTM_T,ESHIFT,
97 . NUM_IMP ,IND_IMP(*),
98 . ITAB(*), KINET(*),
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(*)
103C REAL
104 my_real
105 . x(*), v(*), ms(*),temp(*),diag_sms(*)
106
107 TYPE(INTBUF_STRUCT_) INTBUF_TAB
108 TYPE(H3D_DATABASE) :: H3D_DATA
109 type (glob_therm_) ,INTENT(IN) :: GLOB_THERM
110C-----------------------------------------------
111C L o c a l V a r i a b l e s
112C-----------------------------------------------
113 INTEGER ISYM,I, IP0, IP1, IP2, IP21, K11_T, I_SK_OLD, I_STOK1,IEDGE,
114 . add1, nb_n_b, noint, inacti, multimp, igap, ifq, itied
115 INTEGER
116 . ILD, NCONT, NCONTACT,NCONTE,NCONTACTE,
117 . INACTII,INACIMP,NSNF,NSNL,NLN,CAND_N_OLD,
118 . I_MEM
119C REAL
120 my_real
121 . gap,maxbox,minbox,tzinf,
122 . xmaxl, ymaxl, zmaxl, xminl, yminl, zminl, gapmin, gapmax,
123 . xmaxel, ymaxel, zmaxel, xminel, yminel, zminel, c_maxl,
124 . curv_max(nrtm_t),gap_shift,rbid
125
126 INTEGER :: NRTM,NSN,NMN,NTY
127 INTEGER :: NSNE,NMNE
128 INTEGER :: NLINSA,NLINMA,NLINM,NLINS
129 logical :: need_computation
130C-----------------------------------------------
131
132 ! --------------
133 ! check if the current interface needs to be sorted
134 call check_sorting_criteria( need_computation,nin,npari,nspmd,
135 . itask,ipari(1,nin),tt,intbuf_tab )
136 if( .not.need_computation ) return
137 ! --------------
138
139 i_mem = 0
140 i_memg = 0
141C
142 nrtm =ipari(4,nin)
143 nsn =ipari(5,nin)
144 nmn =ipari(6,nin)
145 nty =ipari(7,nin)
146 noint =ipari(15,nin)
147 nln =ipari(35,nin)
148
149 isym = ipari(43,nin)
150 nlins =ipari(51,nin)
151 nlinm =ipari(52,nin)
152 nlinsa =ipari(53,nin)
153 nlinma =ipari(54,nin)
154 nsne =ipari(55,nin)
155 nmne =ipari(56,nin)
156 igap =ipari(21,nin)
157 iedge =ipari(58,nin)
158 ncont =ipari(18,nin)
159 nconte = ncont
160
161 inacti =ipari(22,nin)
162 multimp=ipari(23,nin)
163 ifq=ipari(31,nin)
164
165 ncontact=multimp*ncont
166 ncontacte=multimp*nconte
167C
168C Specific TYPE7 :
169 itied = 0
170C
171 IF(inacti==5.OR.inacti==6.OR.inacti==7.OR.ifq>0.OR.
172 . num_imp>0)THEN
173 nsnrold = ipari(24,nin)
174 ELSE
175 nsnrold = 0
176 ENDIF
177C
178 gap =intbuf_tab%VARIABLES(2)
179
180 gapmin=intbuf_tab%VARIABLES(13)
181 gapmax=intbuf_tab%VARIABLES(16)
182C
183C -------------------------------------------------------------
184C
185 retri=1
186C -------------------------------------------------------------
187C
188 maxbox = intbuf_tab%VARIABLES(9)
189 minbox = intbuf_tab%VARIABLES(12)
190 tzinf = intbuf_tab%VARIABLES(8)
191 bminma(1)=-ep30
192 bminma(2)=-ep30
193 bminma(3)=-ep30
194 bminma(4)=ep30
195 bminma(5)=ep30
196 bminma(6)=ep30
197 curv_max_max = zero
198 bminmae(1)=-ep30
199 bminmae(2)=-ep30
200 bminmae(3)=-ep30
201 bminmae(4)=ep30
202 bminmae(5)=ep30
203 bminmae(6)=ep30
204C -------------------------------------------------------------
205C STOCKAGE DES ANCIENS CANDIDATS AVEC PENE INITIALE
206C OU AVEC DU FILTRAGE DE FROTTEMENT
207C -------------------------------------------------------------
208C
209C Barriere dans tous les cas pour bminma [et cur_max_max]
210C
211 CALL my_barrier
212
213 IF(inacti==5.OR.inacti==6.OR.ifq>0.OR.num_imp>0.OR.
214 . num_imp>0)THEN
215 IF(itask==0)THEN
216 inactii=inacti
217 IF (num_imp>0.AND.
218 . (inacti/=5.AND.inacti/=6.AND.ifq<=0)) THEN
219 inacimp = 0
220 ELSE
221 inacimp = 1
222 ENDIF
223 ip0 = 1
224
225 ip1 = ip0 + nsn + nsnrold + 3
226 i_sk_old = intbuf_tab%I_STOK(1)
227 CALL i7trc(
228 1 nsn+nsnrold ,i_sk_old ,intbuf_tab%CAND_N ,intbuf_tab%CAND_E ,
229 2 intbuf_tab%CAND_P,intbuf_tab%CAND_FX,intbuf_tab%CAND_FY,intbuf_tab%CAND_FZ,
230 3 mwag(ip0) ,intbuf_tab%IFPEN ,inacti ,ifq ,
231 4 num_imp ,ind_imp ,intbuf_tab%STFA ,nin ,
232 5 nsn ,itied ,rbid)
233
234ctmp IF(I_SK_OLD==0)INACTI=0
235 intbuf_tab%I_STOK(1)=i_sk_old
236 IF(inacimp>0)THEN
237 IF (nspmd>1) THEN
238 CALL spmd_get_inacti7(inacti,ipari(22,nin),nin,isendto,
239 . ircvfrom,inactii)
240 ELSE
241 ipari(22,nin) = inacti
242 ENDIF
243 ENDIF
244 ENDIF
245 ELSE
246 i_sk_old=0
247 intbuf_tab%I_STOK(1)=zero
248 ENDIF
249C -------------------------------------------------------------
250C CALCUL BORNE DOMAINE REMONTE DANS I7XSAVE
251C -------------------------------------------------------------
252C eshift : decalage sur cand_e
253C sauvegarde de XSAV (tableau BUFIN(JD(19)))
254 CALL i20xsave(
255 1 itask ,intbuf_tab%XA,nty ,nsn ,
256 2 nmn ,nsne ,nmne ,nln ,
257 3 intbuf_tab%NSV,intbuf_tab%MSR,intbuf_tab%XSAV,
258 4 intbuf_tab%NSVL,intbuf_tab%MSRL,intbuf_tab%CRITX,
259 5 xminl ,yminl ,zminl ,xmaxl ,
260 6 ymaxl ,zmaxl ,c_maxl ,curv_max ,
261 7 ipari(39,nin),intbuf_tab%IRECTM(1+4*eshift) ,nrtm_t,xminel ,
262 8 yminel ,zminel ,xmaxel , ymaxel ,
263 9 zmaxel )
264#include "lockon.inc"
265 bminma(1) = max(bminma(1),xmaxl)
266 bminma(2) = max(bminma(2),ymaxl)
267 bminma(3) = max(bminma(3),zmaxl)
268 bminma(4) = min(bminma(4),xminl)
269 bminma(5) = min(bminma(5),yminl)
270 bminma(6) = min(bminma(6),zminl)
271 curv_max_max = max(curv_max_max,c_maxl)
272#include "lockoff.inc"
273
274C ----------------------------------------------------------
275C NOEUDS SURFACE
276C ----------------------------------------------------------
277 result = 0
278C BARRIER II_STOK et RESULT
279 CALL my_barrier
280 inacti = ipari(22,nin)
281 IF(itask==0)THEN
282 IF(abs(bminma(6)-bminma(3))>2*ep30.OR.
283 + abs(bminma(5)-bminma(2))>2*ep30.OR.
284 + abs(bminma(4)-bminma(1))>2*ep30)THEN
285 CALL ancmsg(msgid=87,anmode=aninfo,
286 . i1=noint,c1='(I20BUCE)')
287 CALL arret(2)
288 END IF
289
290 bminma(1)=bminma(1)+tzinf+curv_max_max
291 bminma(2)=bminma(2)+tzinf+curv_max_max
292 bminma(3)=bminma(3)+tzinf+curv_max_max
293 bminma(4)=bminma(4)-tzinf-curv_max_max
294 bminma(5)=bminma(5)-tzinf-curv_max_max
295 bminma(6)=bminma(6)-tzinf-curv_max_max
296
297 nsnr = 0
298 IF(nspmd>1) THEN
299C
300C recuperation des noeuds remote NSNR stockes dans XREM
301C
302 IF(imonm > 0) CALL startime(timers,25)
303 CALL spmd_tri20box(
304 1 intbuf_tab%NSV,nsn ,intbuf_tab%XA,intbuf_tab%VA,ms ,
305 2 bminma ,weight ,intbuf_tab%STFA,nin ,isendto,
306 3 ircvfrom ,iad_elem,fr_elem ,nsnr ,igap ,
307 4 intbuf_tab%GAP_S,itab ,kinet ,ifq ,ipari(22,nin) ,
308 5 nsnfiold,ipari(47,nin),intbuf_tab%IELEC,intbuf_tab%AREAS,temp ,
309 6 num_imp ,intbuf_tab%NLG,intbuf_tab%PENIS,intbuf_tab%PENIA ,
310 + diag_sms ,
311 7 nodnx_sms ,intbuf_tab%NBINFLG,intbuf_tab%AVX_ANCR(1),intbuf_tab%AVX_ANCR(1+3*nln) )
312 IF(imonm > 0) CALL stoptime(timers,25)
313C
314C renumerotation locale des anciens candidats
315C
316
317 IF(inacti==5.OR.inacti==6.OR.inacti==7.OR.ifq>0
318 . .OR.num_imp>0)THEN
319
320 CALL spmd_rnumcd20(intbuf_tab%CAND_N,renum ,intbuf_tab%I_STOK(1),
321 1 nin, nsn ,nsnfiold,nsnrold )
322 END IF
323 END IF
324 END IF
325
326 cand_n_old = intbuf_tab%I_STOK(1)
327 40 Continue
328C il faut conserver K11 global
329 ild = 0
330 nb_n_b = 1
331C
332C Barrier comm spmd_tri20box + BMINMA + Retour I20BUCE
333C
334 50 CALL my_barrier
335
336C
337 IF (imonm > 0) CALL startime(timers,30)
338 IF(nrtm_t/=0)THEN
339 CALL i20buce(
340 1 intbuf_tab%XA,intbuf_tab%IRECTM(1+4*eshift),intbuf_tab%NSV,ipari(22,nin),
341 1 intbuf_tab%CAND_P,
342 2 nmn ,nrtm_t ,nsn ,intbuf_tab%CAND_E,intbuf_tab%CAND_N,
343 3 gap ,noint ,intbuf_tab%I_STOK(1) ,tzinf ,maxbox ,
344 4 minbox,mwag ,curv_max ,ncontact ,bminma ,
345 5 nb_n_b,eshift ,ild ,ifq ,intbuf_tab%IFPEN,
346 6 intbuf_tab%STFA,nin ,intbuf_tab%STFM(1+eshift) ,igap ,intbuf_tab%GAP_S,
347 7 nsnr ,ncont ,renum ,nsnrold ,intbuf_tab%GAP_M(1+eshift),
348 8 gapmin,gapmax ,num_imp ,nln ,intbuf_tab%NLG,
349 9 intbuf_tab%GAP_SH,intbuf_tab%NBINFLG,intbuf_tab%MBINFLG,isym ,i_mem ,
350 . glob_therm%INTHEAT, glob_therm%IDT_THERM, glob_therm%NODADT_THERM)
351
352 ENDIF
353
354C Upgrade MultiMP
355 IF (i_mem == 2 )THEN
356#include "lockon.inc"
357 i_memg = i_mem
358#include "lockoff.inc"
359 ENDIF
360C New barrier needed for Dynamic MultiMP
361 CALL my_barrier
362
363 IF(i_memg /=0)THEN
364C CARE : JINBUF & JBUFIN array are reallocated in
365C UPGRADE_MULTIMP routine !!!!
366!$OMP SINGLE
367 multimp = ipari(23,nin) + 4
368 CALL upgrade_multimp(nin,multimp,intbuf_tab)
369!$OMP END SINGLE
370 i_mem = 0
371 i_memg = 0
372 intbuf_tab%I_STOK(1)=cand_n_old
373 multimp=ipari(23,nin)
374 ncontact=multimp*ncont
375 ncontacte=multimp*nconte
376 GOTO 40
377 ENDIF
378
379
380 IF (imonm > 0) CALL stoptime(timers,30)
381C
382#include "lockon.inc"
383 intbuf_tab%VARIABLES(9) = min(maxbox,intbuf_tab%VARIABLES(9))
384 intbuf_tab%VARIABLES(12) = min(minbox,intbuf_tab%VARIABLES(12))
385 intbuf_tab%VARIABLES(8) = min(tzinf,intbuf_tab%VARIABLES(8))
386 intbuf_tab%VARIABLES(5) = intbuf_tab%VARIABLES(8)-gap
387 result = result + ild
388#include "lockoff.inc"
389C--------------------------------------------------------------
390C--------------------------------------------------------------
391 CALL my_barrier
392 IF (result/=0) THEN
393 CALL my_barrier
394 IF (itask==0) THEN
395 intbuf_tab%I_STOK(1) = i_sk_old
396 result = 0
397 ENDIF
398 CALL my_barrier
399 ild = 0
400 maxbox = intbuf_tab%VARIABLES(9)
401 minbox = intbuf_tab%VARIABLES(12)
402 tzinf = intbuf_tab%VARIABLES(8)
403 GOTO 50
404 ENDIF
405C mise a - de dist temporairement pour reperage dans partie frontiere
406 IF(nspmd>1)THEN
407C mono tache
408!$OMP SINGLE
409 IF (imonm > 0) CALL startime(timers,26)
410 intbuf_tab%VARIABLES(5) = -intbuf_tab%VARIABLES(5)
411
412 CALL spmd_tri20gat(
413 1 result ,nsn ,intbuf_tab%CAND_N,intbuf_tab%I_STOK(1),nin,
414 2 igap ,nsnr,multimp ,nty ,ipari(47,nin),
415 3 ipari(22,nin),h3d_data )
416 ipari(24,nin) = nsnr
417
418 IF (num_imp>0)
419 . CALL imp_rnumcd(intbuf_tab%CAND_N,nin,nsn,num_imp,ind_imp )
420
421 IF (imonm > 0) CALL stoptime(timers,26)
422
423!$OMP END SINGLE
424 ENDIF
425
426C-----------------------------------------------------------
427C EDGES
428C-----------------------------------------------------------
429
430 i_sk_old=0
431 IF(nlinma /= 0.OR.nspmd>1)THEN
432 intbuf_tab%I_STOK_E(1) = 0
433C
434C Fin CALCUL BORNE DOMAINE Edge
435C
436#include "lockon.inc"
437 bminmae(1) = max(bminmae(1),xmaxel)
438 bminmae(2) = max(bminmae(2),ymaxel)
439 bminmae(3) = max(bminmae(3),zmaxel)
440 bminmae(4) = min(bminmae(4),xminel)
441 bminmae(5) = min(bminmae(5),yminel)
442 bminmae(6) = min(bminmae(6),zminel)
443#include "lockoff.inc"
444 result = 0
445C BARRIER II_STOK et RESULT
446 CALL my_barrier
447 IF(itask==0)THEN
448 IF(abs(bminmae(6)-bminmae(3))>2*ep30.OR.
449 + abs(bminmae(5)-bminmae(2))>2*ep30.OR.
450 + abs(bminmae(4)-bminmae(1))>2*ep30)THEN
451#include "lockon.inc"
452 CALL ancmsg(msgid=87,anmode=aninfo,
453 . i1=noint,c1='(I20BUCE)')
454#include "lockoff.inc"
455 CALL arret(2)
456 END IF
457 bminmae(1)=bminmae(1)+tzinf
458 bminmae(2)=bminmae(2)+tzinf
459 bminmae(3)=bminmae(3)+tzinf
460 bminmae(4)=bminmae(4)-tzinf
461 bminmae(5)=bminmae(5)-tzinf
462 bminmae(6)=bminmae(6)-tzinf
463C
464C recuperation des noeuds remote NLINSR stockes dans XREM
465C
466 nlinsr = 0
467 IF(nspmd>1) THEN
468 IF(imonm >0) CALL startime(timers,25)
469 CALL spmd_tri20boxe(
470 1 intbuf_tab%IXLINS,nlinsa ,intbuf_tab%XA,intbuf_tab%VA,ms ,
471 2 bminmae ,weight ,intbuf_tab%STFS,nin ,isendto,
472 3 ircvfrom ,iad_elem,fr_elem ,nlinsr ,ipari(22,nin),
473 4 intbuf_tab%GAP_SE,intbuf_tab%PENISE,itab ,igap ,tzinf ,
474 5 intbuf_tab%NLG,intbuf_tab%PENIA,diag_sms,nodnx_sms)
475 IF(imonm >0) CALL stoptime(timers,25)
476 END IF
477 END IF
478C -------------------------------------------------------------
479 cand_n_old = intbuf_tab%I_STOK_E(1)
480 140 CONTINUE
481 nrtm_t = nlinma/nthread
482 eshift = itask*nrtm_t
483 IF(itask==nthread-1)nrtm_t=nlinma-(nthread-1)*(nlinma/nthread)
484 ild = 0
485C
486C Barrier comm spmd_tri7box + BMINMA + Retour I7BUCE
487C
488150 CALL my_barrier
489 gap_shift=zero
490 IF(igap/=0)THEN
491 gap_shift= gap
492 gap = gap + gap_shift
493c fait dans le starter TZINF = TZINF + GAP_SH
494 ENDIF
495 IF(nrtm_t/=0)THEN
496 CALL i20buc_edge(
497 1 intbuf_tab%XA,intbuf_tab%IXLINS,intbuf_tab%IXLINM(1+2*itask*nrtm_t),intbuf_tab%NLG,
498 2 nlinsa ,nmne ,nrtm_t ,intbuf_tab%LCAND_N,intbuf_tab%LCAND_S,
499 3 gap ,noint ,intbuf_tab%I_STOK_E(1),bminmae ,tzinf ,
500 4 maxbox ,minbox ,nb_n_b , eshift ,ild ,
501 6 ncontacte,intbuf_tab%ADCCM20(1+itask*nrtm_t) ,intbuf_tab%CHAIN20,nin ,itab ,
502 7 nlinsr ,ncont ,intbuf_tab%GAP_SE,intbuf_tab%STFS,intbuf_tab%PENISE ,
503 8 igap ,intbuf_tab%STF(1+itask*nrtm_t),ipari(42,nin) , i_mem )
504 ENDIF
505
506C Upgrade MultiMP
507 IF (i_mem == 1 .OR. i_mem == 2)THEN
508#include "lockon.inc"
509 i_memg = i_mem
510#include "lockoff.inc"
511 ENDIF
512
513C New barrier needed for Dynamic MultiMP
514 CALL my_barrier
515
516 IF(i_memg /=0)THEN
517C CARE : JINBUF & JBUFIN array are reallocated in
518C UPGRADE_MULTIMP routine !!!!
519!$OMP SINGLE
520 multimp = ipari(23,nin) + 4
521 CALL upgrade_multimp(nin,multimp,intbuf_tab)
522!$OMP END SINGLE
523 i_memg = 0
524 i_mem = 0
525 intbuf_tab%I_STOK_E(1)=cand_n_old
526 multimp=ipari(23,nin)
527 ncontact=multimp*ncont
528 ncontacte=multimp*nconte
529 GOTO 140
530 ENDIF
531
532#include "lockon.inc"
533 intbuf_tab%VARIABLES(9) = min(maxbox,intbuf_tab%VARIABLES(9))
534 intbuf_tab%VARIABLES(12) = min(minbox,intbuf_tab%VARIABLES(12))
535 intbuf_tab%VARIABLES(8) = min(tzinf,intbuf_tab%VARIABLES(8))
536 intbuf_tab%VARIABLES(5) = intbuf_tab%VARIABLES(8)-gap
537 result = result + ild
538#include "lockoff.inc"
539C--------------------------------------------------------------
540C--------------------------------------------------------------
541 CALL my_barrier
542 IF (result/=0) THEN
543 CALL my_barrier
544 IF (itask==0) THEN
545 intbuf_tab%I_STOK_E(1) = i_sk_old
546 result = 0
547 ENDIF
548 CALL my_barrier
549 ild = 0
550 maxbox = intbuf_tab%VARIABLES(9)
551 minbox = intbuf_tab%VARIABLES(12)
552 tzinf = intbuf_tab%VARIABLES(8)
553 GOTO 150
554 ENDIF
555 IF (nspmd>1) THEN
556C mise a - de dist temporairement pour reperage dans partie frontiere
557C mono tache
558!$OMP SINGLE
559 IF (imonm > 0) CALL startime(timers,26)
560
561 IF(intbuf_tab%VARIABLES(5)>=zero) intbuf_tab%VARIABLES(5)= -intbuf_tab%VARIABLES(5)
562 CALL spmd_tri20gate(
563 1 result ,nlinsa,intbuf_tab%LCAND_S,intbuf_tab%I_STOK_E(1),nin,
564 2 ipari(22,nin),nlinsr,multimp ,igap )
565 ipari(57,nin) = nlinsr
566
567 IF (imonm > 0) CALL stoptime(timers,26)
568
569!$OMP END SINGLE
570 ENDIF
571 ENDIF
572C
573 RETURN
574 END
575!||====================================================================
576!|| i20xsinir ../engine/source/interfaces/intsort/i20main_tri.F
577!||--- called by ------------------------------------------------------
578!|| check_sorting_criteria ../engine/source/interfaces/intsort/check_sorting_criteria.F90
579!||--- uses -----------------------------------------------------
580!|| tri7box ../engine/share/modules/tri7box.F
581!||====================================================================
582 SUBROUTINE i20xsinir(NSNR,NLINSR,ITASK,NIN,STFAC )
583C-----------------------------------------------
584C M o d u l e s
585C-----------------------------------------------
586 USE tri7box
587C-----------------------------------------------
588C I m p l i c i t T y p e s
589C-----------------------------------------------
590#include "implicit_f.inc"
591C-----------------------------------------------
592C D u m m y A r g u m e n t s
593C-----------------------------------------------
594 INTEGER NSNR, NLINSR, ITASK, NIN
595 my_real
596 . STFAC
597C-----------------------------------------------
598C C o m m o n B l o c k s
599C-----------------------------------------------
600#include "com08_c.inc"
601#include "task_c.inc"
602#include "sms_c.inc"
603C-----------------------------------------------
604C L o c a l V a r i a b l e s
605C-----------------------------------------------
606 INTEGER I, I1, I2, NF, NL
607 my_real
608 . AAA, DA(3),AMASS
609C-----------------------------------------------
610C S o u r c e L i n e s
611C-----------------------------------------------
612
613 IF(stfac > zero)THEN
614 amass = max(two,stfac+sqrt(two*stfac))
615 ELSE
616 amass = two
617 ENDIF
618
619 IF(idtmins==0.AND.idtmins_int==0)THEN
620
621 nf = 1 + itask*nsnr / nthread
622 nl = (itask+1)*nsnr/ nthread
623
624 DO i=nf,nl
625 IF(msfi(nin)%P(i) > zero)THEN
626 aaa = dt12/(amass*msfi(nin)%P(i))
627c delta A parith on
628 da(1) = daancfi(nin)%P(1,i)
629 da(2) = daancfi(nin)%P(2,i)
630 da(3) = daancfi(nin)%P(3,i)
631
632 IF(alphakfi(nin)%P(i)<zero)THEN
633 da(1) = daanc6fi(nin)%P(1,1,i) + daanc6fi(nin)%P(1,2,i)
634 . + daanc6fi(nin)%P(1,3,i) + daanc6fi(nin)%P(1,4,i)
635 . + daanc6fi(nin)%P(1,5,i) + daanc6fi(nin)%P(1,6,i)
636 . + da(1)
637 da(2) = daanc6fi(nin)%P(2,1,i) + daanc6fi(nin)%P(2,2,i)
638 . + daanc6fi(nin)%P(2,3,i) + daanc6fi(nin)%P(2,4,i)
639 . + daanc6fi(nin)%P(2,5,i) + daanc6fi(nin)%P(2,6,i)
640 . + da(2)
641 da(3) = daanc6fi(nin)%P(3,1,i) + daanc6fi(nin)%P(3,2,i)
642 . + daanc6fi(nin)%P(3,3,i) + daanc6fi(nin)%P(3,4,i)
643 . + daanc6fi(nin)%P(3,5,i) + daanc6fi(nin)%P(3,6,i)
644 . + da(3)
645C
646
647
648 daanc6fi(nin)%P(1,1,i) = zero
649 daanc6fi(nin)%P(1,2,i) = zero
650 daanc6fi(nin)%P(1,3,i) = zero
651 daanc6fi(nin)%P(1,4,i) = zero
652 daanc6fi(nin)%P(1,5,i) = zero
653 daanc6fi(nin)%P(1,6,i) = zero
654
655 daanc6fi(nin)%P(2,1,i) = zero
656 daanc6fi(nin)%P(2,2,i) = zero
657 daanc6fi(nin)%P(2,3,i) = zero
658 daanc6fi(nin)%P(2,4,i) = zero
659 daanc6fi(nin)%P(2,5,i) = zero
660 daanc6fi(nin)%P(2,6,i) = zero
661
662 daanc6fi(nin)%P(3,1,i) = zero
663 daanc6fi(nin)%P(3,2,i) = zero
664 daanc6fi(nin)%P(3,3,i) = zero
665 daanc6fi(nin)%P(3,4,i) = zero
666 daanc6fi(nin)%P(3,5,i) = zero
667 daanc6fi(nin)%P(3,6,i) = zero
668 ENDIF
669
670 dvancfi(nin)%P(1,i) = dvancfi(nin)%P(1,i) + da(1)*aaa
671 dvancfi(nin)%P(2,i) = dvancfi(nin)%P(2,i) + da(2)*aaa
672 dvancfi(nin)%P(3,i) = dvancfi(nin)%P(3,i) + da(3)*aaa
673 dxancfi(nin)%P(1,i) = dxancfi(nin)%P(1,i)
674 . + dvancfi(nin)%P(1,i)*dt1
675 dxancfi(nin)%P(2,i) = dxancfi(nin)%P(2,i)
676 . + dvancfi(nin)%P(2,i)*dt1
677 dxancfi(nin)%P(3,i) = dxancfi(nin)%P(3,i)
678 . + dvancfi(nin)%P(3,i)*dt1
679
680 ELSE
681 dvancfi(nin)%P(1,i) = zero
682 dvancfi(nin)%P(2,i) = zero
683 dvancfi(nin)%P(3,i) = zero
684 dxancfi(nin)%P(1,i) = zero
685 dxancfi(nin)%P(2,i) = zero
686 dxancfi(nin)%P(3,i) = zero
687 ENDIF
688
689 xfi(nin)%P(1,i) = xfi(nin)%P(1,i)+dxancfi(nin)%P(1,i)
690 xfi(nin)%P(2,i) = xfi(nin)%P(2,i)+dxancfi(nin)%P(2,i)
691 xfi(nin)%P(3,i) = xfi(nin)%P(3,i)+dxancfi(nin)%P(3,i)
692 vfi(nin)%P(1,i) = vfi(nin)%P(1,i)+dvancfi(nin)%P(1,i)
693 vfi(nin)%P(2,i) = vfi(nin)%P(2,i)+dvancfi(nin)%P(2,i)
694 vfi(nin)%P(3,i) = vfi(nin)%P(3,i)+dvancfi(nin)%P(3,i)
695
696C ALPHAK(2) remote
697 alphakfi(nin)%P(i) = one
698
699 END DO
700C
701 nf = 1 + itask*nlinsr / nthread
702 nl = (itask+1)*nlinsr/ nthread
703
704 DO i=nf,nl
705C traiter les 2 noeuds autant de fois qu'ils apparaissent
706 i1 = 2*i-1
707 i2 = 2*i
708C
709 IF(msfie(nin)%P(i1) > zero)THEN
710 aaa = dt12/(amass*msfie(nin)%P(i1))
711 da(1) = daancfie(nin)%P(1,i1)
712 da(2) = daancfie(nin)%P(2,i1)
713 da(3) = daancfie(nin)%P(3,i1)
714
715 IF(alphakfie(nin)%P(i1)<zero)THEN
716 da(1) = daanc6fie(nin)%P(1,1,i1) + daanc6fie(nin)%P(1,2,i1)
717 . + daanc6fie(nin)%P(1,3,i1) + daanc6fie(nin)%P(1,4,i1)
718 . + daanc6fie(nin)%P(1,5,i1) + daanc6fie(nin)%P(1,6,i1)
719 . + da(1)
720 da(2) = daanc6fie(nin)%P(2,1,i1) + daanc6fie(nin)%P(2,2,i1)
721 . + daanc6fie(nin)%P(2,3,i1) + daanc6fie(nin)%P(2,4,i1)
722 . + daanc6fie(nin)%P(2,5,i1) + daanc6fie(nin)%P(2,6,i1)
723 . + da(2)
724 da(3) = daanc6fie(nin)%P(3,1,i1) + daanc6fie(nin)%P(3,2,i1)
725 . + daanc6fie(nin)%P(3,3,i1) + daanc6fie(nin)%P(3,4,i1)
726 . + daanc6fie(nin)%P(3,5,i1) + daanc6fie(nin)%P(3,6,i1)
727 . + da(3)
728 daanc6fie(nin)%P(1,1,i1) = zero
729 daanc6fie(nin)%P(1,2,i1) = zero
730 daanc6fie(nin)%P(1,3,i1) = zero
731 daanc6fie(nin)%P(1,4,i1) = zero
732 daanc6fie(nin)%P(1,5,i1) = zero
733 daanc6fie(nin)%P(1,6,i1) = zero
734
735 daanc6fie(nin)%P(2,1,i1) = zero
736 daanc6fie(nin)%P(2,2,i1) = zero
737 daanc6fie(nin)%P(2,3,i1) = zero
738 daanc6fie(nin)%P(2,4,i1) = zero
739 daanc6fie(nin)%P(2,5,i1) = zero
740 daanc6fie(nin)%P(2,6,i1) = zero
741
742 daanc6fie(nin)%P(3,1,i1) = zero
743 daanc6fie(nin)%P(3,2,i1) = zero
744 daanc6fie(nin)%P(3,3,i1) = zero
745 daanc6fie(nin)%P(3,4,i1) = zero
746 daanc6fie(nin)%P(3,5,i1) = zero
747 daanc6fie(nin)%P(3,6,i1) = zero
748 ENDIF
749
750 dvancfie(nin)%P(1,i1) = dvancfie(nin)%P(1,i1) + da(1)*aaa
751 dvancfie(nin)%P(2,i1) = dvancfie(nin)%P(2,i1) + da(2)*aaa
752 dvancfie(nin)%P(3,i1) = dvancfie(nin)%P(3,i1) + da(3)*aaa
753 dxancfie(nin)%P(1,i1) = dxancfie(nin)%P(1,i1)
754 . + dvancfie(nin)%P(1,i1)*dt1
755 dxancfie(nin)%P(2,i1) = dxancfie(nin)%P(2,i1)
756 . + dvancfie(nin)%P(2,i1)*dt1
757 dxancfie(nin)%P(3,i1) = dxancfie(nin)%P(3,i1)
758 . + dvancfie(nin)%P(3,i1)*dt1
759
760 ELSE
761 dvancfie(nin)%P(1,i1) = zero
762 dvancfie(nin)%P(2,i1) = zero
763 dvancfie(nin)%P(3,i1) = zero
764 dxancfie(nin)%P(1,i1) = zero
765 dxancfie(nin)%P(2,i1) = zero
766 dxancfie(nin)%P(3,i1) = zero
767 ENDIF
768
769 xfie(nin)%P(1,i1) = xfie(nin)%P(1,i1)+dxancfie(nin)%P(1,i1)
770 xfie(nin)%P(2,i1) = xfie(nin)%P(2,i1)+dxancfie(nin)%P(2,i1)
771 xfie(nin)%P(3,i1) = xfie(nin)%P(3,i1)+dxancfie(nin)%P(3,i1)
772 vfie(nin)%P(1,i1) = vfie(nin)%P(1,i1)+dvancfie(nin)%P(1,i1)
773 vfie(nin)%P(2,i1) = vfie(nin)%P(2,i1)+dvancfie(nin)%P(2,i1)
774 vfie(nin)%P(3,i1) = vfie(nin)%P(3,i1)+dvancfie(nin)%P(3,i1)
775
776C ALPHAK(2) remote
777 alphakfie(nin)%P(i1) = one
778
779
780 IF(msfie(nin)%P(i2) > zero)THEN
781 aaa = dt12/(amass*msfie(nin)%P(i2))
782 da(1) = daancfie(nin)%P(1,i2)
783 da(2) = daancfie(nin)%P(2,i2)
784 da(3) = daancfie(nin)%P(3,i2)
785
786 IF(alphakfie(nin)%P(i2)<zero)THEN
787 da(1) = daanc6fie(nin)%P(1,1,i2) + daanc6fie(nin)%P(1,2,i2)
788 . + daanc6fie(nin)%P(1,3,i2) + daanc6fie(nin)%P(1,4,i2)
789 . + daanc6fie(nin)%P(1,5,i2) + daanc6fie(nin)%P(1,6,i2)
790 . + da(1)
791 da(2) = daanc6fie(nin)%P(2,1,i2) + daanc6fie(nin)%P(2,2,i2)
792 . + daanc6fie(nin)%P(2,3,i2) + daanc6fie(nin)%P(2,4,i2)
793 . + daanc6fie(nin)%P(2,5,i2) + daanc6fie(nin)%P(2,6,i2)
794 . + da(2)
795 da(3) = daanc6fie(nin)%P(3,1,i2) + daanc6fie(nin)%P(3,2,i2)
796 . + daanc6fie(nin)%P(3,3,i2) + daanc6fie(nin)%P(3,4,i2)
797 . + daanc6fie(nin)%P(3,5,i2) + daanc6fie(nin)%P(3,6,i2)
798 . + da(3)
799 daanc6fie(nin)%P(1,1,i2) = zero
800 daanc6fie(nin)%P(1,2,i2) = zero
801 daanc6fie(nin)%P(1,3,i2) = zero
802 daanc6fie(nin)%P(1,4,i2) = zero
803 daanc6fie(nin)%P(1,5,i2) = zero
804 daanc6fie(nin)%P(1,6,i2) = zero
805
806 daanc6fie(nin)%P(2,1,i2) = zero
807 daanc6fie(nin)%P(2,2,i2) = zero
808 daanc6fie(nin)%P(2,3,i2) = zero
809 daanc6fie(nin)%P(2,4,i2) = zero
810 daanc6fie(nin)%P(2,5,i2) = zero
811 daanc6fie(nin)%P(2,6,i2) = zero
812
813 daanc6fie(nin)%P(3,1,i2) = zero
814 daanc6fie(nin)%P(3,2,i2) = zero
815 daanc6fie(nin)%P(3,3,i2) = zero
816 daanc6fie(nin)%P(3,4,i2) = zero
817 daanc6fie(nin)%P(3,5,i2) = zero
818 daanc6fie(nin)%P(3,6,i2) = zero
819 ENDIF
820
821 dvancfie(nin)%P(1,i2) = dvancfie(nin)%P(1,i2) + da(1)*aaa
822 dvancfie(nin)%P(2,i2) = dvancfie(nin)%P(2,i2) + da(2)*aaa
823 dvancfie(nin)%P(3,i2) = dvancfie(nin)%P(3,i2) + da(3)*aaa
824 dxancfie(nin)%P(1,i2) = dxancfie(nin)%P(1,i2)
825 . + dvancfie(nin)%P(1,i2)*dt1
826 dxancfie(nin)%P(2,i2) = dxancfie(nin)%P(2,i2)
827 . + dvancfie(nin)%P(2,i2)*dt1
828 dxancfie(nin)%P(3,i2) = dxancfie(nin)%P(3,i2)
829 . + dvancfie(nin)%P(3,i2)*dt1
830 ELSE
831 dvancfie(nin)%P(1,i2) = zero
832 dvancfie(nin)%P(2,i2) = zero
833 dvancfie(nin)%P(3,i2) = zero
834 dxancfie(nin)%P(1,i2) = zero
835 dxancfie(nin)%P(2,i2) = zero
836 dxancfie(nin)%P(3,i2) = zero
837 ENDIF
838
839 xfie(nin)%P(1,i2) = xfie(nin)%P(1,i2)+dxancfie(nin)%P(1,i2)
840 xfie(nin)%P(2,i2) = xfie(nin)%P(2,i2)+dxancfie(nin)%P(2,i2)
841 xfie(nin)%P(3,i2) = xfie(nin)%P(3,i2)+dxancfie(nin)%P(3,i2)
842 vfie(nin)%P(1,i2) = vfie(nin)%P(1,i2)+dvancfie(nin)%P(1,i2)
843 vfie(nin)%P(2,i2) = vfie(nin)%P(2,i2)+dvancfie(nin)%P(2,i2)
844 vfie(nin)%P(3,i2) = vfie(nin)%P(3,i2)+dvancfie(nin)%P(3,i2)
845
846
847C ALPHAK(2) remote
848 alphakfie(nin)%P(i2) = one
849
850 END DO
851
852 ELSE
853
854C AMS
855
856 nf = 1 + itask*nsnr / nthread
857 nl = (itask+1)*nsnr/ nthread
858
859 DO i=nf,nl
860 IF(diag_smsfi(nin)%P(i) > zero)THEN
861 aaa = dt12/(amass*diag_smsfi(nin)%P(i))
862
863 da(1) = daancfi(nin)%P(1,i)
864 da(2) = daancfi(nin)%P(2,i)
865 da(3) = daancfi(nin)%P(3,i)
866
867 IF(alphakfi(nin)%P(i)<zero)THEN
868 da(1) = daanc6fi(nin)%P(1,1,i) + daanc6fi(nin)%P(1,2,i)
869 . + daanc6fi(nin)%P(1,3,i) + daanc6fi(nin)%P(1,4,i)
870 . + daanc6fi(nin)%P(1,5,i) + daanc6fi(nin)%P(1,6,i)
871 . + da(1)
872 da(2) = daanc6fi(nin)%P(2,1,i) + daanc6fi(nin)%P(2,2,i)
873 . + daanc6fi(nin)%P(2,3,i) + daanc6fi(nin)%P(2,4,i)
874 . + daanc6fi(nin)%P(2,5,i) + daanc6fi(nin)%P(2,6,i)
875 . + da(2)
876 da(3) = daanc6fi(nin)%P(3,1,i) + daanc6fi(nin)%P(3,2,i)
877 . + daanc6fi(nin)%P(3,3,i) + daanc6fi(nin)%P(3,4,i)
878 . + daanc6fi(nin)%P(3,5,i) + daanc6fi(nin)%P(3,6,i)
879 . + da(3)
880C
881
882 daanc6fi(nin)%P(1,1,i) = zero
883 daanc6fi(nin)%P(1,2,i) = zero
884 daanc6fi(nin)%P(1,3,i) = zero
885 daanc6fi(nin)%P(1,4,i) = zero
886 daanc6fi(nin)%P(1,5,i) = zero
887 daanc6fi(nin)%P(1,6,i) = zero
888
889 daanc6fi(nin)%P(2,1,i) = zero
890 daanc6fi(nin)%P(2,2,i) = zero
891 daanc6fi(nin)%P(2,3,i) = zero
892 daanc6fi(nin)%P(2,4,i) = zero
893 daanc6fi(nin)%P(2,5,i) = zero
894 daanc6fi(nin)%P(2,6,i) = zero
895
896 daanc6fi(nin)%P(3,1,i) = zero
897 daanc6fi(nin)%P(3,2,i) = zero
898 daanc6fi(nin)%P(3,3,i) = zero
899 daanc6fi(nin)%P(3,4,i) = zero
900 daanc6fi(nin)%P(3,5,i) = zero
901 daanc6fi(nin)%P(3,6,i) = zero
902 ENDIF
903
904 dvancfi(nin)%P(1,i) = dvancfi(nin)%P(1,i) + da(1)*aaa
905 dvancfi(nin)%P(2,i) = dvancfi(nin)%P(2,i) + da(2)*aaa
906 dvancfi(nin)%P(3,i) = dvancfi(nin)%P(3,i) + da(3)*aaa
907 dxancfi(nin)%P(1,i) = dxancfi(nin)%P(1,i)
908 . + dvancfi(nin)%P(1,i)*dt1
909 dxancfi(nin)%P(2,i) = dxancfi(nin)%P(2,i)
910 . + dvancfi(nin)%P(2,i)*dt1
911 dxancfi(nin)%P(3,i) = dxancfi(nin)%P(3,i)
912 . + dvancfi(nin)%P(3,i)*dt1
913 ELSE
914 dvancfi(nin)%P(1,i) = zero
915 dvancfi(nin)%P(2,i) = zero
916 dvancfi(nin)%P(3,i) = zero
917 dxancfi(nin)%P(1,i) = zero
918 dxancfi(nin)%P(2,i) = zero
919 dxancfi(nin)%P(3,i) = zero
920 ENDIF
921
922 xfi(nin)%P(1,i) = xfi(nin)%P(1,i)+dxancfi(nin)%P(1,i)
923 xfi(nin)%P(2,i) = xfi(nin)%P(2,i)+dxancfi(nin)%P(2,i)
924 xfi(nin)%P(3,i) = xfi(nin)%P(3,i)+dxancfi(nin)%P(3,i)
925 vfi(nin)%P(1,i) = vfi(nin)%P(1,i)+dvancfi(nin)%P(1,i)
926 vfi(nin)%P(2,i) = vfi(nin)%P(2,i)+dvancfi(nin)%P(2,i)
927 vfi(nin)%P(3,i) = vfi(nin)%P(3,i)+dvancfi(nin)%P(3,i)
928
929
930C ALPHAK(2) remote
931 alphakfi(nin)%P(i) = one
932
933 END DO
934C
935 nf = 1 + itask*nlinsr / nthread
936 nl = (itask+1)*nlinsr/ nthread
937
938 DO i=nf,nl
939C traiter les 2 noeuds autant de fois qu'ils apparaissent
940 i1 = 2*i-1
941 i2 = 2*i
942C
943 IF(diag_smsfie(nin)%P(i1) > zero)THEN
944 aaa = dt12/(amass*diag_smsfie(nin)%P(i1))
945 da(1) = daancfie(nin)%P(1,i1)
946 da(2) = daancfie(nin)%P(2,i1)
947 da(3) = daancfie(nin)%P(3,i1)
948
949 IF(alphakfie(nin)%P(i1)<zero)THEN
950
951 da(1) = daanc6fie(nin)%P(1,1,i1) + daanc6fie(nin)%P(1,2,i1)
952 . + daanc6fie(nin)%P(1,3,i1) + daanc6fie(nin)%P(1,4,i1)
953 . + daanc6fie(nin)%P(1,5,i1) + daanc6fie(nin)%P(1,6,i1)
954 . + da(1)
955 da(2) = daanc6fie(nin)%P(2,1,i1) + daanc6fie(nin)%P(2,2,i1)
956 . + daanc6fie(nin)%P(2,3,i1) + daanc6fie(nin)%P(2,4,i1)
957 . + daanc6fie(nin)%P(2,5,i1) + daanc6fie(nin)%P(2,6,i1)
958 . + da(2)
959 da(3) = daanc6fie(nin)%P(3,1,i1) + daanc6fie(nin)%P(3,2,i1)
960 . + daanc6fie(nin)%P(3,3,i1) + daanc6fie(nin)%P(3,4,i1)
961 . + daanc6fie(nin)%P(3,5,i1) + daanc6fie(nin)%P(3,6,i1)
962 . + da(3)
963
964 daanc6fie(nin)%P(1,1,i1) = zero
965 daanc6fie(nin)%P(1,2,i1) = zero
966 daanc6fie(nin)%P(1,3,i1) = zero
967 daanc6fie(nin)%P(1,4,i1) = zero
968 daanc6fie(nin)%P(1,5,i1) = zero
969 daanc6fie(nin)%P(1,6,i1) = zero
970
971 daanc6fie(nin)%P(2,1,i1) = zero
972 daanc6fie(nin)%P(2,2,i1) = zero
973 daanc6fie(nin)%P(2,3,i1) = zero
974 daanc6fie(nin)%P(2,4,i1) = zero
975 daanc6fie(nin)%P(2,5,i1) = zero
976 daanc6fie(nin)%P(2,6,i1) = zero
977
978 daanc6fie(nin)%P(3,1,i1) = zero
979 daanc6fie(nin)%P(3,2,i1) = zero
980 daanc6fie(nin)%P(3,3,i1) = zero
981 daanc6fie(nin)%P(3,4,i1) = zero
982 daanc6fie(nin)%P(3,5,i1) = zero
983 daanc6fie(nin)%P(3,6,i1) = zero
984 ENDIF
985 dvancfie(nin)%P(1,i1) = dvancfie(nin)%P(1,i1) + da(1)*aaa
986 dvancfie(nin)%P(2,i1) = dvancfie(nin)%P(2,i1) + da(2)*aaa
987 dvancfie(nin)%P(3,i1) = dvancfie(nin)%P(3,i1) + da(3)*aaa
988 dxancfie(nin)%P(1,i1) = dxancfie(nin)%P(1,i1)
989 . + dvancfie(nin)%P(1,i1)*dt1
990 dxancfie(nin)%P(2,i1) = dxancfie(nin)%P(2,i1)
991 . + dvancfie(nin)%P(2,i1)*dt1
992 dxancfie(nin)%P(3,i1) = dxancfie(nin)%P(3,i1)
993 . + dvancfie(nin)%P(3,i1)*dt1
994
995 ELSE
996 dvancfie(nin)%P(1,i1) = zero
997 dvancfie(nin)%P(2,i1) = zero
998 dvancfie(nin)%P(3,i1) = zero
999 dxancfie(nin)%P(1,i1) = zero
1000 dxancfie(nin)%P(2,i1) = zero
1001 dxancfie(nin)%P(3,i1) = zero
1002 ENDIF
1003
1004 xfie(nin)%P(1,i1) = xfie(nin)%P(1,i1)+dxancfie(nin)%P(1,i1)
1005 xfie(nin)%P(2,i1) = xfie(nin)%P(2,i1)+dxancfie(nin)%P(2,i1)
1006 xfie(nin)%P(3,i1) = xfie(nin)%P(3,i1)+dxancfie(nin)%P(3,i1)
1007 vfie(nin)%P(1,i1) = vfie(nin)%P(1,i1)+dvancfie(nin)%P(1,i1)
1008 vfie(nin)%P(2,i1) = vfie(nin)%P(2,i1)+dvancfie(nin)%P(2,i1)
1009 vfie(nin)%P(3,i1) = vfie(nin)%P(3,i1)+dvancfie(nin)%P(3,i1)
1010
1011
1012C ALPHAK(2) remote
1013 alphakfie(nin)%P(i1) = one
1014
1015
1016 IF(diag_smsfie(nin)%P(i2) > zero)THEN
1017 aaa = dt12/(amass*diag_smsfie(nin)%P(i2))
1018 da(1) = daancfie(nin)%P(1,i2)
1019 da(2) = daancfie(nin)%P(2,i2)
1020 da(3) = daancfie(nin)%P(3,i2)
1021
1022 IF(alphakfie(nin)%P(i2)<zero)THEN
1023 da(1) = daanc6fie(nin)%P(1,1,i2) + daanc6fie(nin)%P(1,2,i2)
1024 . + daanc6fie(nin)%P(1,3,i2) + daanc6fie(nin)%P(1,4,i2)
1025 . + daanc6fie(nin)%P(1,5,i2) + daanc6fie(nin)%P(1,6,i2)
1026 . + da(1)
1027 da(2) = daanc6fie(nin)%P(2,1,i2) + daanc6fie(nin)%P(2,2,i2)
1028 . + daanc6fie(nin)%P(2,3,i2) + daanc6fie(nin)%P(2,4,i2)
1029 . + daanc6fie(nin)%P(2,5,i2) + daanc6fie(nin)%P(2,6,i2)
1030 . + da(2)
1031 da(3) = daanc6fie(nin)%P(3,1,i2) + daanc6fie(nin)%P(3,2,i2)
1032 . + daanc6fie(nin)%P(3,3,i2) + daanc6fie(nin)%P(3,4,i2)
1033 . + daanc6fie(nin)%P(3,5,i2) + daanc6fie(nin)%P(3,6,i2)
1034 . + da(3)
1035 daanc6fie(nin)%P(1,1,i2) = zero
1036 daanc6fie(nin)%P(1,2,i2) = zero
1037 daanc6fie(nin)%P(1,3,i2) = zero
1038 daanc6fie(nin)%P(1,4,i2) = zero
1039 daanc6fie(nin)%P(1,5,i2) = zero
1040 daanc6fie(nin)%P(1,6,i2) = zero
1041
1042 daanc6fie(nin)%P(2,1,i2) = zero
1043 daanc6fie(nin)%P(2,2,i2) = zero
1044 daanc6fie(nin)%P(2,3,i2) = zero
1045 daanc6fie(nin)%P(2,4,i2) = zero
1046 daanc6fie(nin)%P(2,5,i2) = zero
1047 daanc6fie(nin)%P(2,6,i2) = zero
1048
1049 daanc6fie(nin)%P(3,1,i2) = zero
1050 daanc6fie(nin)%P(3,2,i2) = zero
1051 daanc6fie(nin)%P(3,3,i2) = zero
1052 daanc6fie(nin)%P(3,4,i2) = zero
1053 daanc6fie(nin)%P(3,5,i2) = zero
1054 daanc6fie(nin)%P(3,6,i2) = zero
1055 ENDIF
1056
1057 dvancfie(nin)%P(1,i2) = dvancfie(nin)%P(1,i2) + da(1)*aaa
1058 dvancfie(nin)%P(2,i2) = dvancfie(nin)%P(2,i2) + da(2)*aaa
1059 dvancfie(nin)%P(3,i2) = dvancfie(nin)%P(3,i2) + da(3)*aaa
1060 dxancfie(nin)%P(1,i2) = dxancfie(nin)%P(1,i2)
1061 . + dvancfie(nin)%P(1,i2)*dt1
1062 dxancfie(nin)%P(2,i2) = dxancfie(nin)%P(2,i2)
1063 . + dvancfie(nin)%P(2,i2)*dt1
1064 dxancfie(nin)%P(3,i2) = dxancfie(nin)%P(3,i2)
1065 . + dvancfie(nin)%P(3,i2)*dt1
1066 ELSE
1067 dvancfie(nin)%P(1,i2) = zero
1068 dvancfie(nin)%P(2,i2) = zero
1069 dvancfie(nin)%P(3,i2) = zero
1070 dxancfie(nin)%P(1,i2) = zero
1071 dxancfie(nin)%P(2,i2) = zero
1072 dxancfie(nin)%P(3,i2) = zero
1073 ENDIF
1074
1075 xfie(nin)%P(1,i2) = xfie(nin)%P(1,i2)+dxancfie(nin)%P(1,i2)
1076 xfie(nin)%P(2,i2) = xfie(nin)%P(2,i2)+dxancfie(nin)%P(2,i2)
1077 xfie(nin)%P(3,i2) = xfie(nin)%P(3,i2)+dxancfie(nin)%P(3,i2)
1078 vfie(nin)%P(1,i2) = vfie(nin)%P(1,i2)+dvancfie(nin)%P(1,i2)
1079 vfie(nin)%P(2,i2) = vfie(nin)%P(2,i2)+dvancfie(nin)%P(2,i2)
1080 vfie(nin)%P(3,i2) = vfie(nin)%P(3,i2)+dvancfie(nin)%P(3,i2)
1081
1082
1083C ALPHAK(2) remote
1084 alphakfie(nin)%P(i2) = one
1085
1086 END DO
1087 END IF
1088C
1089 RETURN
1090 END
i20buc_edge
subroutine i20buc_edge(xa, ixlins, ixlinm, nlg, nlinsa, nmne, nlinma, cand_m, cand_s, gap, noint, ii_stoke, bminma, tzinf, maxbox, minbox, nb_n_b, eshift, ild, ncontact, addcm, chaine, nin, itab, nlinsr, ncont, gap_s, stifs, penis, igap, stifm, iauto, i_mem)
Definition i20buce.F:224
i20buce
subroutine i20buce(xa, irect, nsv, inacti, cand_p, nmn, nrtm, nsn, cand_e, cand_n, gap, noint, ii_stok, tzinf, maxbox, minbox, mwag, curv_max, ncontact, bminma, nb_n_b, eshift, ild, ifq, ifpen, stfa, nin, stf, igap, gap_s, nsnr, ncont, renum, nsnrold, gap_m, gapmin, gapmax, num_imp, nln, nlg, gap_sh, nbinflg, mbinflg, isym, i_mem, intheat, idt_therm, nodadt_therm)
Definition i20buce.F:45
i20main_tri
subroutine i20main_tri(timers, ipari, x, v, ms, nin, itask, mwag, weight, isendto, ircvfrom, retri, iad_elem, fr_elem, itab, kinet, temp, nrtm_t, renum, nsnfiold, eshift, num_imp, ind_imp, diag_sms, nodnx_sms, intbuf_tab, h3d_data, glob_therm)
Definition i20main_tri.F:62
i20xsinir
subroutine i20xsinir(nsnr, nlinsr, itask, nin, stfac)
Definition i20main_tri.F:583
i20xsave
subroutine i20xsave(itask, xa, nty, nsn, nmn, nsne, nmne, nln, nsv, msr, xsav, nsve, msre, xsave, xmin, ymin, zmin, xmax, ymax, zmax, c_max, curv_max, icurv, irect, nrtm_t, xmine, ymine, zmine, xmaxe, ymaxe, zmaxe)
Definition i20xsave.F:38
i7trc
subroutine i7trc(nsn, i_stok, cand_n, cand_e, cand_p, cand_fx, cand_fy, cand_fz, cand_a, ifpen, inacti, ifq, num_imp, ind_imp, stfns, nin, nsnl, itied, cand_f)
Definition i7trc.F:38
imp_rnumcd
subroutine imp_rnumcd(cand_n, nin, nsn, num_imp, index)
Definition imp_int_k.F:1542
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
h3d_mod
Definition h3d_mod.F:308
message_mod
Definition message_mod.F:1249
tri7box::dxancfi
type(real_pointer2), dimension(:), allocatable dxancfi
Definition tri7box.F:473
tri7box::vfie
type(real_pointer2), dimension(:), allocatable vfie
Definition tri7box.F:459
tri7box::daancfi
type(real_pointer2), dimension(:), allocatable daancfi
Definition tri7box.F:459
tri7box::vfi
type(real_pointer2), dimension(:), allocatable vfi
Definition tri7box.F:459
tri7box::dvancfi
type(real_pointer2), dimension(:), allocatable dvancfi
Definition tri7box.F:473
tri7box::xfie
type(real_pointer2), dimension(:), allocatable xfie
Definition tri7box.F:459
tri7box::dvancfie
type(real_pointer2), dimension(:), allocatable dvancfie
Definition tri7box.F:473
tri7box::daanc6fi
type(r8_pointer3), dimension(:), allocatable daanc6fi
Definition tri7box.F:476
tri7box::alphakfi
type(real_pointer), dimension(:), allocatable alphakfi
Definition tri7box.F:449
tri7box::msfi
type(real_pointer), dimension(:), allocatable msfi
Definition tri7box.F:449
tri7box::diag_smsfi
type(real_pointer), dimension(:), allocatable diag_smsfi
Definition tri7box.F:449
tri7box::daanc6fie
type(r8_pointer3), dimension(:), allocatable daanc6fie
Definition tri7box.F:476
tri7box::xfi
type(real_pointer2), dimension(:), allocatable xfi
Definition tri7box.F:459
tri7box::diag_smsfie
type(real_pointer), dimension(:), allocatable diag_smsfie
Definition tri7box.F:449
tri7box::alphakfie
type(real_pointer), dimension(:), allocatable alphakfie
Definition tri7box.F:449
tri7box::dxancfie
type(real_pointer2), dimension(:), allocatable dxancfie
Definition tri7box.F:473
tri7box::daancfie
type(real_pointer2), dimension(:), allocatable daancfie
Definition tri7box.F:459
tri7box::msfie
type(real_pointer), dimension(:), allocatable msfie
Definition tri7box.F:449
spmd_get_inacti7
subroutine spmd_get_inacti7(inacti, ipari22, nin, isendto, ircvfrom, inactii)
Definition send_cand.F:58
spmd_tri20gate
subroutine spmd_tri20gate(result, nrts, cand_s, i_stok, nin, inacti, nrtsr, multimp, igap)
Definition spmd_i7crit.F:1662
spmd_tri20gat
subroutine spmd_tri20gat(result, nsn, cand_n, i_stok, nin, igap, nsnr, multimp, ity, intth, inacti, h3d_data)
Definition spmd_i7crit.F:38
spmd_rnumcd20
subroutine spmd_rnumcd20(cand_n, renum, ii_stok, nin, nsn, nsnfiold, nsnrold)
Definition spmd_i7tool.F:85
spmd_tri20box
subroutine spmd_tri20box(nsv, nsn, xa, va, ms, bminmal, weight, stfa, nin, isendto, ircvfrom, iad_elem, fr_elem, nsnr, igap, gap_s, itab, kinet, ifq, inacti, nsnfiold, intth, ielec, areas, temp, num_imp, nlg, penis, penia, diag_sms, nodnx_sms, nbinflg, dxanc, dvanc)
Definition spmd_tri20box.F:44
spmd_tri20boxe
subroutine spmd_tri20boxe(ixlins, nrts, xa, va, ms, bminmal, weight, stifs, nin, isendto, ircvfrom, iad_elem, fr_elem, nrtsr, inacti, gap_s, penis, itab, igap, tzinf, nlg, penia, diag_sms, nodnx_sms)
Definition spmd_tri20boxe.F:42
ancmsg
subroutine ancmsg(msgid, msgtype, anmode, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, r1, r2, r3, r4, r5, r6, r7, r8, r9, c1, c2, c3, c4, c5, c6, c7, c8, c9, prmode)
Definition message.F:889
arret
subroutine arret(nn)
Definition arret.F:87
my_barrier
subroutine my_barrier
Definition machine.F:31
startime
subroutine startime(event, itask)
Definition timer.F:93
stoptime
subroutine stoptime(event, itask)
Definition timer.F:135
upgrade_multimp
subroutine upgrade_multimp(ni, multimp_parameter, intbuf_tab)
Definition upgrade_multimp.F:48