OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
spmd_tri25vox.F File Reference
#include "implicit_f.inc"
#include "spmd.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "task_c.inc"
#include "timeri_c.inc"
#include "sms_c.inc"
#include "i25edge_c.inc"
#include "assert.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine spmd_tri25vox (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, ieles, areas, temp, num_imp, nodnx_sms, gap_s_l, ityp, irtlm, i24_time_s, i24_frfi, i24_pene_old, i24_stif_old, nbinflg, ilev, i24_icont_i, intfric, ipartfrics, itied, ivis2, if_adh, ledge, nedge, lndedge, stfm, nedge_local, gape, gap_e_l, stfe, edg_bisector, vtx_bisector, admsr, irect, ebinflg, mvoisin, iedge, icodt, iskew, ipartfric_e, e2s_nod_normal, istif_msdt, stifmsdt_s, stifmsdt_edg, ifsub_carea, intarean)

Function/Subroutine Documentation

◆ spmd_tri25vox()

subroutine spmd_tri25vox ( integer, dimension(*) nsv,
integer nsn,
x,
v,
ms,
bminmal,
integer, dimension(*) weight,
stifn,
integer nin,
integer, dimension(ninter+1,*) isendto,
integer, dimension(ninter+1,*) ircvfrom,
integer, dimension(2,*) iad_elem,
integer, dimension(*) fr_elem,
integer nsnr,
integer igap,
gap_s,
integer, dimension(*) itab,
integer, dimension(*) kinet,
integer ifq,
integer inacti,
integer, dimension(*) nsnfiold,
integer intth,
integer, dimension(*) ieles,
areas,
temp,
integer num_imp,
integer, dimension(*) nodnx_sms,
gap_s_l,
integer ityp,
integer, dimension(*) irtlm,
i24_time_s,
i24_frfi,
i24_pene_old,
i24_stif_old,
integer, dimension(*) nbinflg,
integer ilev,
integer, dimension(*) i24_icont_i,
integer intfric,
integer, dimension(*) ipartfrics,
integer itied,
integer ivis2,
integer, dimension(*) if_adh,
integer, dimension(lndedge,nedge) ledge,
integer nedge,
integer lndedge,
stfm,
integer, intent(in) nedge_local,
gape,
gap_e_l,
stfe,
real*4, dimension(3,4,*) edg_bisector,
real*4, dimension(3,2,*) vtx_bisector,
integer, dimension(4,*) admsr,
integer, dimension(4,*) irect,
integer, dimension(*), intent(in) ebinflg,
integer, dimension(4,*), intent(in) mvoisin,
integer, intent(in) iedge,
integer, dimension(*), intent(in) icodt,
integer, dimension(*), intent(in) iskew,
integer, dimension(*) ipartfric_e,
real*4, dimension(3,*) e2s_nod_normal,
integer, intent(in) istif_msdt,
dimension(nsn), intent(in) stifmsdt_s,
dimension(nedge), intent(in) stifmsdt_edg,
integer, intent(in) ifsub_carea,
dimension(numnod), intent(in) intarean )

Definition at line 39 of file spmd_tri25vox.F.

55C-----------------------------------------------
56C M o d u l e s
57C-----------------------------------------------
58 USE tri7box
59 USE tri25ebox
60 USE message_mod
61 USE spmd_mod
62C-----------------------------------------------
63C I m p l i c i t T y p e s
64C-----------------------------------------------
65#include "implicit_f.inc"
66C-----------------------------------------------
67C M e s s a g e P a s s i n g
68C-----------------------------------------------
69#include "spmd.inc"
70C-----------------------------------------------
71C C o m m o n B l o c k s
72C-----------------------------------------------
73#include "com01_c.inc"
74#include "com04_c.inc"
75#include "task_c.inc"
76#include "timeri_c.inc"
77#include "sms_c.inc"
78#include "i25edge_c.inc"
79#include "assert.inc"
80C-----------------------------------------------
81C D u m m y A r g u m e n t s
82C-----------------------------------------------
83 INTEGER NIN, NSN, IFQ, INACTI, IGAP,INTTH,NSNR,INTFRIC,
84 . ITIED, IVIS2,
85 . NSNFIOLD(*), NSV(*), WEIGHT(*),
86 . ISENDTO(NINTER+1,*), IRCVFROM(NINTER+1,*),
87 . IAD_ELEM(2,*), FR_ELEM(*), ITAB(*), KINET(*),
88 . IELES(*),NUM_IMP, NODNX_SMS(*),IRTLM(*),ITYP,
89 . NBINFLG(*),ILEV,I24_ICONT_I(*),IPARTFRICS(*),IF_ADH(*),
90 . IPARTFRIC_E(*)
91 INTEGER :: NEDGE, LNDEDGE, LEDGE(LNDEDGE,NEDGE)
92 INTEGER :: ADMSR(4,*),IRECT(4,*)
93 INTEGER, INTENT(IN) :: EBINFLG(*)
94 INTEGER, INTENT(IN) :: NEDGE_LOCAL
95 INTEGER, INTENT(IN) :: MVOISIN(4,*)
96 INTEGER, INTENT(IN) :: IEDGE
97 INTEGER, INTENT(IN) :: ICODT(*)
98 INTEGER, INTENT(IN) :: ISKEW(*)
99 INTEGER, INTENT(IN) :: ISTIF_MSDT, IFSUB_CAREA
100
101C INTEGER :: NSNFIEOLD(*)
102
103 my_real
104 . x(3,*), v(3,*), ms(*), bminmal(*), stifn(*), gap_s(*),
105 . areas(*),temp(*),gap_s_l(*),i24_time_s(*),i24_frfi(6,*),
106 . i24_pene_old(5,*),i24_stif_old(2,*),stfm(*),
107 . gape(*),
108 . gap_e_l(*),
109 . stfe(*)
110 real*4 edg_bisector(3,4,*),vtx_bisector(3,2,*),e2s_nod_normal(3,*)
111 my_real , INTENT(IN) :: stifmsdt_s(nsn), stifmsdt_edg(nedge)
112 my_real , INTENT(IN) :: intarean(numnod)
113
114C-----------------------------------------------
115C L o c a l V a r i a b l e s
116C-----------------------------------------------
117#ifdef MPI
118 INTEGER MSGTYP,INFO,I,NOD, DT_CST, LOC_PROC,P,IDEB,
119 . SIZ,J, L, BUFSIZ, LEN, NB, IERROR1, IAD,
120 . STATUS(MPI_STATUS_SIZE),IERROR,REQ_SB(NSPMD),
121 . REQ_RB(NSPMD),KK,NBIRECV,IRINDEXI(NSPMD),
122 . REQ_RD(NSPMD),REQ_SD(NSPMD),REQ_SD2(NSPMD),
123 . REQ_RC(NSPMD),REQ_SC(NSPMD),
124 . INDEXI,ISINDEXI(NSPMD),INDEX(NUMNOD),
125 . NBOX2(2,NSPMD),NBOX(2,NSPMD),
126 . NBX,NBY,NBZ,IX,IY,IZ,
127 . MSGOFF, MSGOFF2, MSGOFF3, MSGOFF4, MSGOFF5,MSGOFF6,
128 . MSGOFF7,
129 . RSIZ, ISIZ, L2, REQ_SD3(NSPMD),REQ_RD2(NSPMD),
130 . REQ_SD4(NSPMD),REQ_RD4(NSPMD),
131 . REQ_SD5(NSPMD),REQ_RD5(NSPMD),
132 . LEN2, RSHIFT, ISHIFT, ND, JDEB, Q, NBB,
133 . NB_EDGE, IDEB_EDGE,
134 . ISIZ_EDGE
135
136 my_real:: xmins,ymins,zmins
137 my_real:: xmaxs,ymaxs,zmaxs
138 INTEGER :: N1,N2 ,NN1,NN2
139 INTEGER :: IX1,IX2,IY1,IY2,IZ1,IZ2
140 INTEGER :: IE,JE,I1,I2
141
142 my_real :: dx,dy,dz
143 my_real :: stf
144
145 DATA msgoff/6000/
146 DATA msgoff2/6001/
147 DATA msgoff3/6002/
148 DATA msgoff4/6003/
149 DATA msgoff5/6004/
150 DATA msgoff6/6006/
151 DATA msgoff7/6007/
152
153 my_real
154 . bminma(6,nspmd),
155 . xmaxb,ymaxb,zmaxb,xminb,yminb,zminb
156
157 TYPE(real_pointer), DIMENSION(NSPMD) :: RBUF
158 TYPE(int_pointer) , DIMENSION(NSPMD) :: IBUF
159 TYPE(int_pointer) , DIMENSION(NSPMD) :: IBUF_EDGE
160 TYPE(real_pointer), DIMENSION(NSPMD) :: RBUF_EDGE
161
162 INTEGER, DIMENSION(:), ALLOCATABLE :: ITAGNSNFI
163 INTEGER, DIMENSION(:), ALLOCATABLE :: INDEX_EDGE
164
165 INTEGER :: NBIRECV_NODE,NBIRECV_EDGE
166 INTEGER :: IAM,JAM,IM,M1,M2
167
168C-----------------------------------------------
169C S o u r c e L i n e s
170C-----------------------------------------------
171C
172C=======================================================================
173C tag des boites contenant des facettes
174C et creation des candidats
175C=======================================================================
176 loc_proc = ispmd + 1
177 nbx = lrvoxel
178 nby = lrvoxel
179 nbz = lrvoxel
180C
181C Sauvegarde valeur ancienne des nsn frontieres
182C
183 IF(inacti==5.OR.inacti==6.OR.inacti==7.OR.ifq>0
184 . .OR.num_imp>0.OR.itied/=0.OR.ityp==23.OR.ityp==24
185 . .OR.ityp==25) THEN
186 DO p = 1, nspmd
187 nsnfiold(p) = nsnfi(nin)%P(p)
188 IF(iedge > 0) THEN
189 nsnfieold(p) = nsnfie(nin)%P(p)
190 ENDIF
191 END DO
192 END IF
193C
194C boite minmax pour le tri provenant de i7buce BMINMA
195C
196 nedge_remote = 0
197 DO p = 1, nspmd
198 nsnfi(nin)%P(p) = 0
199 IF(iedge /= 0) nsnfie(nin)%P(p) = 0
200 ENDDO
201
202 IF(ircvfrom(nin,loc_proc)==0.AND.
203 . isendto(nin,loc_proc)==0) RETURN
204
205 bminma(1,loc_proc) = bminmal(1)
206 bminma(2,loc_proc) = bminmal(2)
207 bminma(3,loc_proc) = bminmal(3)
208 bminma(4,loc_proc) = bminmal(4)
209 bminma(5,loc_proc) = bminmal(5)
210 bminma(6,loc_proc) = bminmal(6)
211C
212C envoi voxel + boite min/max
213C
214 IF(ircvfrom(nin,loc_proc)/=0) THEN
215 DO p = 1, nspmd
216 IF(isendto(nin,p)/=0) THEN
217 IF(p/=loc_proc) THEN
218 msgtyp = msgoff
219 CALL spmd_isend(
220 . crvoxel25(0,0,1,loc_proc),
221 . 2*(lrvoxel25+1)*(lrvoxel25+1),
222 . it_spmd(p),msgtyp,req_sc(p))
223 msgtyp = msgoff2
224 CALL spmd_isend(
225 . bminma(1,loc_proc),6 ,it_spmd(p),msgtyp,req_sb(p))
226 ENDIF
227 ENDIF
228 ENDDO
229 ENDIF
230C
231C reception voxel + boites min-max
232C
233 IF(isendto(nin,loc_proc)/=0) THEN
234 nbirecv=0
235 DO p = 1, nspmd
236 IF(ircvfrom(nin,p)/=0) THEN
237 IF(loc_proc/=p) THEN
238 nbirecv=nbirecv+1
239 irindexi(nbirecv)=p
240 msgtyp = msgoff
241 CALL spmd_irecv(
242 . crvoxel25(0,0,1,p),
243 . 2*(lrvoxel+1)*(lrvoxel+1),
244 . it_spmd(p),msgtyp,req_rc(nbirecv))
245 msgtyp = msgoff2
246 CALL spmd_irecv(
247 . bminma(1,p) ,6 ,it_spmd(p),msgtyp,
248 . req_rb(nbirecv))
249 ENDIF
250 ENDIF
251 ENDDO
252 ENDIF
253C
254C envoi de XREM
255C
256C computation of real and integer sending buffers sizes
257c general case
258 rsiz = 8
259 isiz = 6
260
261 IF(.true.) THEN
262 isiz = isiz + 2
263 ENDIF
264
265c specific cases
266c IGAP=1 or IGAP=2
267 IF(igap==1 .OR. igap==2)THEN
268 rsiz = rsiz + 1
269c IGAP=3
270 ELSEIF(igap==3)THEN
271 rsiz = rsiz + 2
272 ENDIF
273
274C thermic
275 IF(intth > 0 ) THEN
276 rsiz = rsiz + 2
277 isiz = isiz + 1
278 ENDIF
279
280C Interface Adhesion
281 IF(ityp==25.AND.ivis2==-1 ) THEN
282 IF(intth==0) rsiz = rsiz + 1 ! areas
283 isiz = isiz + 2 ! if_adh+ioldnsnfi
284 ENDIF
285
286C Friction
287 IF(intfric > 0 ) THEN
288 isiz = isiz + 1
289 ENDIF
290
291C---Stiffness based on mass and time step
292 IF(istif_msdt > 0) rsiz = rsiz + 1
293C---CAREA output
294 IF(ifsub_carea > 0) rsiz = rsiz + 1
295
296C -- IDTMINS==2
297 IF(idtmins == 2)THEN
298 isiz = isiz + 2
299C -- IDTMINS_INT /= 0
300 ELSEIF(idtmins_int/=0)THEN
301 isiz = isiz + 1
302 END IF
303
304c INT24
305 IF(ityp==24)THEN
306 rsiz = rsiz + 8
307 isiz = isiz + 3
308C-----for NBINFLG
309 IF (ilev==2) isiz = isiz + 1
310
311 ENDIF
312
313c INT25
314 IF(ityp==25)THEN
315 rsiz = rsiz + 3
316 isiz = isiz + 6
317C-----for NBINFLG
318 IF (ilev==2) isiz = isiz + 1
319 ENDIF
320 ideb = 1
321 req_sd4(1:nspmd) = mpi_request_null
322 req_sd5(1:nspmd) = mpi_request_null
323 req_rd(1:nspmd) = mpi_request_null
324 req_rd2(1:nspmd) = mpi_request_null
325 req_rd4(1:nspmd) = mpi_request_null
326 req_rd5(1:nspmd) = mpi_request_null
327
328
329
330 jdeb = 0
331 IF(ityp==25)THEN
332 ALLOCATE(itagnsnfi(numnod),stat=ierror)
333 itagnsnfi(1:numnod) = 0
334 ALLOCATE(index_edge(nedge),stat=ierror)
335 index_edge(1:nedge) = 0
336 END IF
337
338 IF(isendto(nin,loc_proc)/=0) THEN
339 DO kk = 1, nbirecv
340 CALL spmd_waitany(nbirecv,req_rb,indexi)
341 p=irindexi(indexi)
342 CALL spmd_wait(req_rc(indexi))
343C Traitement special sur d.d. ne consever que les noeuds internes
344 DO j = iad_elem(1,p), iad_elem(1,p+1)-1
345 nod = fr_elem(j)
346C weight < 0 temporairement pour ne conserver que les noeuds non frontiere
347 weight(nod) = weight(nod)*(-1)
348 ENDDO
349C
350 l = ideb
351 nbox(2,p) = 0
352 nb = 0
353 xmaxb = bminma(1,p)
354 ymaxb = bminma(2,p)
355 zmaxb = bminma(3,p)
356 xminb = bminma(4,p)
357 yminb = bminma(5,p)
358 zminb = bminma(6,p)
359C ==================== Secnd nodes =============================
360 DO i=1,nsn
361 nod = nsv(i)
362 IF(weight(nod)==1)THEN
363 IF(stifn(i)>zero)THEN
364 IF(ityp==25.AND.irtlm(4*(i-1)+4)==p)THEN
365 nb = nb + 1
366 index(nb) = i
367 ELSEIF(itied/=0.AND.ityp==7.AND.candf_si(nin)%P(i)/=0) THEN
368 nb = nb + 1
369 index(nb) = i
370 ELSE
371 IF(x(1,nod) < xminb) cycle
372 IF(x(1,nod) > xmaxb) cycle
373 IF(x(2,nod) < yminb) cycle
374 IF(x(2,nod) > ymaxb) cycle
375 IF(x(3,nod) < zminb) cycle
376 IF(x(3,nod) > zmaxb) cycle
377 ix=int(nbx*(x(1,nod)-xminb)/(xmaxb-xminb))
378 IF(ix >= 0 .AND. ix <= nbx) THEN
379 iy=int(nby*(x(2,nod)-yminb)/(ymaxb-yminb))
380 IF(iy >= 0 .AND. iy <= nby) THEN
381 iz=int(nbz*(x(3,nod)-zminb)/(zmaxb-zminb))
382 IF(iz >= 0 .AND. iz <= nbz) THEN
383 IF(btest(crvoxel25(iy,iz,1,p),ix)) THEN
384 nb = nb + 1
385 index(nb) = i
386 ENDIF
387 ENDIF
388 ENDIF
389 ENDIF
390 ENDIF
391 ENDIF
392 ENDIF
393 ENDDO
394 nbox(1,p) = nb
395 DO j = iad_elem(1,p), iad_elem(1,p+1)-1
396 nod = fr_elem(j)
397C remise de weight > 0
398 weight(nod) = weight(nod)*(-1)
399 ENDDO
400
401C ==================== Secnd edges =============================
402 dx=xmaxb-xminb
403 dy=ymaxb-yminb
404 dz=zmaxb-zminb
405 nb_edge = 0
406! loop over edge that are local to ISPMD (ISPMD is main of the edge,
407! even if it is a boundary edge
408 IF(iedge /= 0) THEN
409 DO i=1,nedge_local
410 assert(ledge(9,i) == 1)
411 n1=ledge(5,i)
412 n2=ledge(6,i)
413 assert(n1 > 0)
414 assert(n2 > 0)
415 assert(n1 <= numnod)
416 assert(n2 <= numnod)
417
418 IF(ledge(1,i) > 0) THEN
419C First segment is local
420 stf = stfm(ledge(1,i))
421 ELSEIF (ledge(3,i) > 0) THEN
422C First segment is on the other side of the boundary
423 stf = one
424 IF(mvoisin(ledge(4,i),ledge(3,i)) == 0) stf = 0
425 ELSE !
426
427 ! ISPMD owns a boundary edge, but the local segment is deleted
428 stf = one
429 ENDIF
430 debug_e2e(ledge(8,i) == d_es,p-1)
431 debug_e2e(ledge(8,i) == d_es,stf)
432 debug_e2e(ledge(8,i) == d_es,ledge(7,i))
433
434
435 IF( stf > zero .AND. ledge(7,i) >= 0) THEN
436C
437C GAPE inutile ici (Redondant avec BGAPEMAX cote main) !
438 xmins = min(x(1,n1),x(1,n2))!- GAPE(I)
439 ymins = min(x(2,n1),x(2,n2))!- GAPE(I)
440 zmins = min(x(3,n1),x(3,n2))!- GAPE(I)
441 xmaxs = max(x(1,n1),x(1,n2))!+ GAPE(I)
442 ymaxs = max(x(2,n1),x(2,n2))!+ GAPE(I)
443 zmaxs = max(x(3,n1),x(3,n2))!+ GAPE(I)
444
445 debug_e2e(ledge(8,i) == d_es, xmins)
446 debug_e2e(ledge(8,i) == d_es, ymins)
447 debug_e2e(ledge(8,i) == d_es, zmins)
448 debug_e2e(ledge(8,i) == d_es, xmaxs)
449 debug_e2e(ledge(8,i) == d_es, ymaxs)
450 debug_e2e(ledge(8,i) == d_es, zmaxs)
451
452 ix1=int(nbx*(xmins-xminb)/dx)
453 ix2=int(nbx*(xmaxs-xminb)/dx)
454
455 IF(ix2>=0.AND.ix1<=nbx)THEN
456 iy1=int(nby*(ymins-yminb)/dy)
457 iy2=int(nby*(ymaxs-yminb)/dy)
458
459 IF(iy2>=0.AND.iy1<=nby)THEN
460 iz1=int(nbz*(zmins-zminb)/dz)
461 iz2=int(nbz*(zmaxs-zminb)/dz)
462
463 IF(iz2>=0.AND.iz1<=nbz)THEN
464 ix1=max(ix1,0)
465 ix2=min(ix2,nbx)
466 iy1=max(iy1,0)
467 iy2=min(iy2,nbx)
468 iz1=max(iz1,0)
469 iz2=min(iz2,nbx)
470 DO ix=ix1,ix2
471 DO iy=iy1,iy2
472 DO iz=iz1,iz2
473 IF(btest(crvoxel25(iy,iz,1,p),ix)) THEN
474 nb_edge = nb_edge + 1
475 index_edge(nb_edge) = i
476 debug_e2e(ledge(8,i)==d_es,nb_edge)
477 GOTO 111 !next I
478 END IF
479 END DO
480 END DO
481 END DO
482 ENDIF
483 ENDIF
484 ENDIF
485 111 CONTINUE
486 ENDIF !
487 ENDDO
488 ENDIF ! IEDGE
489
490 nbox(2,p) = nb_edge
491C WRITE(6,*) ISPMD,"sends ",NB_EDGE,"to,",P-1
492 IF(ityp==25)THEN
493 jdeb = 0
494 DO q=1,p-1
495 jdeb = jdeb + nsnsi(nin)%P(q)
496 END DO
497 nbb = nsnsi(nin)%P(p)
498 DO j = 1, nbb
499 nd = nsvsi(nin)%P(jdeb+j)
500 nod= nsv(nd)
501 itagnsnfi(nod)=j
502 END DO
503 END IF
504C
505C Envoi taille msg
506C
507 msgtyp = msgoff3
508 CALL spmd_isend(nbox(1,p),2,it_spmd(p),msgtyp,req_sd(p))
509C
510C Alloc buffer
511C
512 IF( nb_edge > 0) THEN
513 ALLOCATE(ibuf_edge(p)%P(e_ibuf_size*nb_edge))
514 ALLOCATE(rbuf_edge(p)%P(e_rbuf_size*nb_edge))
515
516 l = 0
517 DO j=1,nb_edge
518 i = index_edge(j)
519 assert(i > 0)
520 assert(i <= nedge)
521 ibuf_edge(p)%p(e_global_id + l) = ledge(8,i)
522 ibuf_edge(p)%p(e_left_seg + l) = ledge(1,i)
523 ibuf_edge(p)%p(e_left_id + l) = ledge(2,i)
524 ibuf_edge(p)%p(e_right_seg + l) = ledge(3,i)
525 ibuf_edge(p)%p(e_right_id + l) = ledge(4,i)
526 ibuf_edge(p)%p(e_node1_id + l) = ledge(5,i)
527 ibuf_edge(p)%p(e_node2_id + l) = ledge(6,i)
528 ibuf_edge(p)%p(e_type + l) = ledge(7,i)
529! It is possible that one of the node is not sent
530 ibuf_edge(p)%p(e_node1_globid + l) = itab((ledge(5,i)))
531 ibuf_edge(p)%p(e_node2_globid + l) = itab((ledge(6,i)))
532 ibuf_edge(p)%p(e_local_id + l) = i
533 IF(ilev == 2) THEN
534 ibuf_edge(p)%p(e_ebinflg + l) = ebinflg(i)
535 ELSE
536 ibuf_edge(p)%p(e_ebinflg + l) = 0
537 ENDIF
538 iam= ledge(1,i)
539 jam= ledge(2,i)
540 m1 = ledge(5,i)
541 m2 = ledge(6,i)
542 im = ledge(10,i)
543 ibuf_edge(p)%p(e_im + l) = im
544 IF(idtmins /= 0) THEN
545 IF(idtmins/=2 .AND. idtmins_int == 0) THEN
546 ELSEIF(idtmins==2) THEN
547 ibuf_edge(p)%p(e_nodnx1 + l) = nodnx_sms(m1)
548 ibuf_edge(p)%p(e_nodams1 + l) = m1
549 ibuf_edge(p)%p(e_nodnx2 + l) = nodnx_sms(m2)
550 ibuf_edge(p)%p(e_nodams2 + l) = m2
551 ELSE ! IDTMINS_INT == 0
552 ibuf_edge(p)%p(e_nodnx1 + l) = 0
553 ibuf_edge(p)%p(e_nodams1 + l) = m1
554 ibuf_edge(p)%p(e_nodnx2 + l) = 0
555 ibuf_edge(p)%p(e_nodams2 + l) = m2
556 ENDIF
557 assert(nodnx_sms(m1) >=0)
558 assert(nodnx_sms(m2) >=0)
559 debug_e2e(nodnx_sms(m1) < 0,nodnx_sms(m1))
560 debug_e2e(nodnx_sms(m2) < 0,nodnx_sms(m2))
561 ENDIF ! IDTMINS /= 0
562 IF(intfric > 0) THEN
563 ibuf_edge(p)%p(e_ipartfric_e + l) = ipartfric_e(i)
564 ELSE
565 ibuf_edge(p)%p(e_ipartfric_e + l) = 0
566 ENDIF
567 l = l + e_ibuf_size
568 ENDDO
569
570 l = 0
571 DO j=1,nb_edge
572 i = index_edge(j)
573 rbuf_edge(p)%p(e_x1+ l) = x(1,(ledge(5,i)))
574 rbuf_edge(p)%p(e_y1+ l) = x(2,(ledge(5,i)))
575 rbuf_edge(p)%p(e_z1+ l) = x(3,(ledge(5,i)))
576 rbuf_edge(p)%p(e_x2+ l) = x(1,(ledge(6,i)))
577 rbuf_edge(p)%p(e_y2+ l) = x(2,(ledge(6,i)))
578 rbuf_edge(p)%p(e_z2+ l) = x(3,(ledge(6,i)))
579 rbuf_edge(p)%p(e_vx1+ l) = v(1,(ledge(5,i)))
580 rbuf_edge(p)%p(e_vy1+ l) = v(2,(ledge(5,i)))
581 rbuf_edge(p)%p(e_vz1+ l) = v(3,(ledge(5,i)))
582 rbuf_edge(p)%p(e_vx2+ l) = v(1,(ledge(6,i)))
583 rbuf_edge(p)%p(e_vy2+ l) = v(2,(ledge(6,i)))
584 rbuf_edge(p)%p(e_vz2+ l) = v(3,(ledge(6,i)))
585 rbuf_edge(p)%p(e_ms1+ l) = ms((ledge(5,i)))
586 rbuf_edge(p)%p(e_ms2+ l) = ms((ledge(6,i)))
587 rbuf_edge(p)%p(e_gap+ l) = gape(i)
588 IF(igap == 3) THEN
589 rbuf_edge(p)%p(e_gapl+ l) = gap_e_l(i)
590 ELSE
591 rbuf_edge(p)%p(e_gapl+ l) = 0
592 ENDIF
593 assert(not(isnan( rbuf_edge(p)%p(e_gapl+ l))))
594
595C RBUF_EDGE(P)%p(E_STIFE+ L) = STFM(LEDGE(1,I))
596 rbuf_edge(p)%p(e_stife+ l) = stfe(i)
597 assert(not(isnan(stfe(i))))
598
599C TO DO: single precision
600 l2 = e_edg_bis + l
601
602 ie = abs(ledge(1,i))
603 je = ledge(2,i)
604 iam = ledge(1,i)
605 jam = ledge(2,i)
606 m1 = ledge(5,i)
607 m2 = ledge(6,i)
608 im = ledge(10,i)
609 i1 = ledge(11,i)
610 i2 = ledge(12,i)
611 nn1 = admsr(je,ie)
612 nn2 = admsr(mod(je,4)+1,ie)
613
614
615 rbuf_edge(p)%p(l2:l2+2) = edg_bisector(1:3,je,ie)
616
617 l2 = e_vtx_bis + l
618 rbuf_edge(p)%p(l2:l2+2) = vtx_bisector(1:3,1,i1)
619
620 l2 = l2 + 3
621 rbuf_edge(p)%p(l2:l2+2) = vtx_bisector(1:3,2,i1)
622
623 l2 = l2 + 3
624 rbuf_edge(p)%p(l2:l2+2) = vtx_bisector(1:3,1,i2)
625
626 l2 = l2 + 3
627 rbuf_edge(p)%p(l2:l2+2) = vtx_bisector(1:3,2,i2)
628
629 l2 = l2 + 3
630 rbuf_edge(p)%p(l2:l2+2) = e2s_nod_normal(1:3,nn1)
631
632 l2 = l2 + 3
633 rbuf_edge(p)%p(l2:l2+2) = e2s_nod_normal(1:3,nn2)
634
635 IF(istif_msdt > 0) rbuf_edge(p)%p(e_stife_msdt_fi+ l) = stifmsdt_edg(i)
636
637 l = l + e_rbuf_size
638 ENDDO
639
640c DO J = 1, L-1
641c IF(ISNAN(RBUF_EDGE(P)%p(J))) THEN
642c WRITE(6,*) ISPMD,"NaN found",J,"/",L
643c ENDIF
644C ENDDO
645 ENDIF
646
647 IF (nb > 0) THEN
648 ALLOCATE(rbuf(p)%P(rsiz*nb),stat=ierror)
649 ALLOCATE(ibuf(p)%P(isiz*nb),stat=ierror)
650 l = 0
651 l2= 0
652
653#include "vectorize.inc"
654 DO j = 1, nb
655 i = index(j)
656 nod = nsv(i)
657 rbuf(p)%p(l+1) = x(1,nod)
658 rbuf(p)%p(l+2) = x(2,nod)
659 rbuf(p)%p(l+3) = x(3,nod)
660 rbuf(p)%p(l+4) = v(1,nod)
661 rbuf(p)%p(l+5) = v(2,nod)
662 rbuf(p)%p(l+6) = v(3,nod)
663 rbuf(p)%p(l+7) = ms(nod)
664 rbuf(p)%p(l+8) = stifn(i)
665 ibuf(p)%p(l2+1) = i
666 ibuf(p)%p(l2+2) = itab(nod)
667 ibuf(p)%p(l2+3) = kinet(nod)
668! save specifics irem and xrem indexes for int24 sorting
669 ibuf(p)%p(l2+4) = 0 !IGAPXREMP
670 ibuf(p)%p(l2+5) = 0 !I24XREMP
671 ibuf(p)%p(l2+6) = 0 !I24IREMP
672 l = l + rsiz
673 l2 = l2 + isiz
674 END DO
675
676c shift for real variables (prepare for next setting)
677 rshift = 9
678c shift for integer variables (prepare for next setting)
679 ishift = 7
680
681C symmetric plane
682 IF(.true. )THEN
683 l = 0
684#include "vectorize.inc"
685 DO j = 1, nb
686 i = index(j)
687 nod = nsv(i)
688 ibuf(p)%p(l+ishift+0)= icodt(nod)
689 ibuf(p)%p(l+ishift+1)= iskew(nod)
690 l = l + isiz
691 ENDDO
692 ishift = ishift + 2
693 ENDIF
694
695
696
697
698
699c specific cases
700c IGAP=1 or IGAP=2
701 IF(igap==1 .OR. igap==2)THEN
702 l = 0
703 igapxremp = rshift
704#include "vectorize.inc"
705 DO j = 1, nb
706 i = index(j)
707 rbuf(p)%p(l+rshift)= gap_s(i)
708 l = l + rsiz
709 ENDDO
710 rshift = rshift + 1
711
712c IGAP=3
713 ELSEIF(igap==3)THEN
714 l = 0
715 igapxremp = rshift
716#include "vectorize.inc"
717 DO j = 1, nb
718 i = index(j)
719 rbuf(p)%p(l+rshift) = gap_s(i)
720 rbuf(p)%p(l+rshift+1)= gap_s_l(i)
721 l = l + rsiz
722 END DO
723 rshift = rshift + 2
724 ENDIF
725
726C thermic
727 IF(intth>0)THEN
728 l = 0
729 l2 = 0
730#include "vectorize.inc"
731 DO j = 1, nb
732 i = index(j)
733 nod = nsv(i)
734 rbuf(p)%p(l+rshift) = temp(nod)
735 rbuf(p)%p(l+rshift+1) = areas(i)
736 ibuf(p)%p(l2+ishift) = ieles(i)
737 l = l + rsiz
738 l2 = l2 + isiz
739 END DO
740 rshift = rshift + 2
741 ishift = ishift + 1
742 ENDIF
743
744C Interface Adhesion
745 IF(ityp==25.AND.ivis2==-1)THEN
746 l = 0
747 l2 = 0
748#include "vectorize.inc"
749 DO j = 1, nb
750 i = index(j)
751 nod = nsv(i)
752 IF(intth==0) rbuf(p)%p(l+rshift) = areas(i)
753 ibuf(p)%p(l2+ishift) = if_adh(i)
754 ibuf(p)%p(l2+ishift+1)=itagnsnfi(nod)
755 IF(intth==0) l = l + rsiz
756 l2 = l2 + isiz
757 END DO
758 IF(intth==0) rshift = rshift + 1
759 ishift = ishift + 2
760 ENDIF
761
762C Friction
763 IF(intfric>0)THEN
764 l2 = 0
765#include "vectorize.inc"
766 DO j = 1, nb
767 i = index(j)
768 ibuf(p)%p(l2+ishift) = ipartfrics(i)
769 l2 = l2 + isiz
770 END DO
771 ishift = ishift + 1
772 ENDIF
773
774 IF(istif_msdt > 0) THEN
775 l = 0
776#include "vectorize.inc"
777 DO j = 1, nb
778 i = index(j)
779 rbuf(p)%p(l+rshift) =stifmsdt_s(i)
780 l = l + rsiz
781 END DO
782 rshift = rshift + 1
783 ENDIF
784
785
786 IF(ifsub_carea > 0) THEN
787 l = 0
788#include "vectorize.inc"
789 DO j = 1, nb
790 i = index(j)
791 nod = nsv(i)
792 rbuf(p)%p(l+rshift) =intarean(nod)
793 l = l + rsiz
794 END DO
795 rshift = rshift + 1
796 ENDIF
797
798C -- IDTMINS==2
799 IF(idtmins==2)THEN
800 l2 = 0
801#include "vectorize.inc"
802 DO j = 1, nb
803 i = index(j)
804 nod = nsv(i)
805 ibuf(p)%p(l2+ishift) = nodnx_sms(nod)
806 ibuf(p)%p(l2+ishift+1)= nod
807 l2 = l2 + isiz
808 END DO
809 ishift = ishift + 2
810
811C -- IDTMINS_INT /= 0
812 ELSEIF(idtmins_int/=0)THEN
813 l2 = 0
814#include "vectorize.inc"
815 DO j = 1, nb
816 i = index(j)
817 nod = nsv(i)
818 ibuf(p)%p(l2+ishift)= nod
819 l2 = l2 + isiz
820 END DO
821 ishift = ishift + 1
822 ENDIF
823
824c INT24
825 IF(ityp==24)THEN
826
827 l = 0
828 i24xremp = rshift
829#include "vectorize.inc"
830 DO j = 1, nb
831 i = index(j)
832 rbuf(p)%p(l+rshift) =i24_time_s(i)
833 rbuf(p)%p(l+rshift+1) =i24_frfi(1,i)
834 rbuf(p)%p(l+rshift+2) =i24_frfi(2,i)
835 rbuf(p)%p(l+rshift+3) =i24_frfi(3,i)
836 rbuf(p)%p(l+rshift+4) =i24_pene_old(1,i)
837 rbuf(p)%p(l+rshift+5) =i24_stif_old(1,i)
838 rbuf(p)%p(l+rshift+6) =i24_pene_old(3,i)
839 rbuf(p)%p(l+rshift+7) =i24_pene_old(5,i)
840 l = l + rsiz
841 END DO
842 rshift = rshift + 8
843
844 l2 = 0
845 i24iremp = ishift
846#include "vectorize.inc"
847 DO j = 1, nb
848 i = index(j)
849C IRTLM(2,NSN) in TYPE24
850 ibuf(p)%p(l2+ishift) =irtlm(2*(i-1)+1)
851 ibuf(p)%p(l2+ishift+1)=irtlm(2*(i-1)+2)
852 ibuf(p)%p(l2+ishift+2)=i24_icont_i(i)
853 l2 = l2 + isiz
854 END DO
855 ishift = ishift + 3
856C---pay attention in i24sto.F IREM(I24IREMP+3,N-NSN) is used,
857C----change the shift value when new table was added like I24_ICONT_I
858 IF (ilev==2) THEN
859 l2 = 0
860#include "vectorize.inc"
861 DO j = 1, nb
862 i = index(j)
863 ibuf(p)%p(l2+ishift)=nbinflg(i)
864 l2 = l2 + isiz
865 END DO
866 END IF
867 ishift = ishift + 1
868
869 END IF !(ITYP==24)
870
871c INT25
872 IF(ityp==25)THEN
873 l = 0
874 i24xremp = rshift
875#include "vectorize.inc"
876 DO j = 1, nb
877 i = index(j)
878 rbuf(p)%p(l+rshift) =i24_time_s(2*(i-1)+1)
879 rbuf(p)%p(l+rshift+1) =i24_time_s(2*(i-1)+2)
880 rbuf(p)%p(l+rshift+2) =i24_pene_old(5,i) ! used only at time=0
881 l = l + rsiz
882 END DO
883 rshift = rshift + 3
884
885 l2 = 0
886 i24iremp = ishift
887
888#include "vectorize.inc"
889 DO j = 1, nb
890 i = index(j)
891 nod = nsv(i)
892C IRTLM(3,NSN) en TYPE25 / IRTLM(3,-) inutile ici
893 ibuf(p)%p(l2+ishift) =irtlm(4*(i-1)+1)
894 ibuf(p)%p(l2+ishift+1)=irtlm(4*(i-1)+2)
895C
896C IRTLM(3,I) == local n of the impacted segment is shared but only valid on proc == IRTLM(4,I)
897 ibuf(p)%p(l2+ishift+2)=irtlm(4*(i-1)+3)
898 ibuf(p)%p(l2+ishift+3)=irtlm(4*(i-1)+4)
899 ibuf(p)%p(l2+ishift+4)=i24_icont_i(i)
900 ibuf(p)%p(l2+ishift+5)=itagnsnfi(nod)
901 l2 = l2 + isiz
902 END DO
903 ishift = ishift + 6
904C---pay attention in i25sto.F IREM(I24IREMP+4,N-NSN) is used,
905C----change the shift value when new table was added like IRTLM(3*(I-1)+2)
906 IF (ilev==2) THEN
907 l2 = 0
908#include "vectorize.inc"
909 DO j = 1, nb
910 i = index(j)
911 ibuf(p)%p(l2+ishift)=nbinflg(i)
912 l2 = l2 + isiz
913 END DO
914 END IF
915 ishift = ishift + 1
916
917 END IF !(ITYP==25)
918C
919 !save specifics IREM and XREM indexes for INT24 sorting
920 l2 = 0
921#include "vectorize.inc"
922 DO j = 1, nb
923 i = index(j)
924 nod = nsv(i)
925 !save specifics IREM and XREM indexes for INT24 sorting
926 ibuf(p)%p(l2+4) = igapxremp
927 ibuf(p)%p(l2+5) = i24xremp
928 ibuf(p)%p(l2+6) = i24iremp
929 l2 = l2 + isiz
930 END DO
931 ENDIF ! NB > 0
932
933 IF( nb > 0 ) THEN
934C WRITE(6,*) "Sends",NB,"nodes to",P-1
935 msgtyp = msgoff4
936 CALL spmd_isend(
937 1 rbuf(p)%P(1),nb*rsiz,it_spmd(p),msgtyp,
938 2 req_sd2(p))
939
940 msgtyp = msgoff5
941 CALL spmd_isend(
942 1 ibuf(p)%P(1),nb*isiz,it_spmd(p),msgtyp,
943 2 req_sd3(p))
944 ENDIF
945 IF(nb_edge > 0) THEN
946
947 msgtyp = msgoff6
948 CALL spmd_isend(
949 1 ibuf_edge(p)%P(1),e_ibuf_size*nb_edge ,it_spmd(p),msgtyp,
950 2 req_sd4(p))
951
952 msgtyp = msgoff7
953 CALL spmd_isend(
954 1 rbuf_edge(p)%P(1),e_rbuf_size*nb_edge ,it_spmd(p),msgtyp,
955 2 req_sd5(p))
956 ENDIF ! NB_EDGE > 0
957c ENDIF
958C
959C reset old tag for next P
960 IF(ityp==25)THEN
961C reset
962 nbb = nsnsi(nin)%P(p)
963 DO j = 1, nbb
964 nd = nsvsi(nin)%P(jdeb+j)
965 nod= nsv(nd)
966 itagnsnfi(nod)=0
967 END DO
968 END IF
969 ENDDO
970 ENDIF
971C
972 IF(ityp==25) THEN
973 DEALLOCATE(itagnsnfi)
974 DEALLOCATE(index_edge)
975 ENDIF
976C
977C reception des donnees XREM
978C
979 nedge_remote = 0
980 IF(ircvfrom(nin,loc_proc)/=0) THEN
981 nsnr = 0
982 l=0
983 DO p = 1, nspmd
984 nsnfi(nin)%P(p) = 0
985 IF(iedge /= 0) nsnfie(nin)%P(p) = 0
986 IF(isendto(nin,p)/=0) THEN
987 IF(loc_proc/=p) THEN
988 msgtyp = msgoff3
989 CALL spmd_recv(nbox2(1,p),2,it_spmd(p),msgtyp)
990 nsnfi(nin)%P(p) = nbox2(1,p)
991
992 IF(iedge /= 0) THEN
993 nedge_remote = nedge_remote + nbox2(2,p)
994 edge_fi(nin)%P(p) = nbox2(2,p)
995 nsnfie(nin)%P(p) = nbox2(2,p)
996 ELSE
997C EDGE_FI(NIN)%P(P) = 0
998C NSNFIE(NIN)%P(P) = 0
999 ENDIF
1000
1001 IF(nsnfi(nin)%P(p)> 0 .OR. nbox2(2,p) > 0) THEN
1002 l=l+1
1003 isindexi(l)=p
1004 nsnr = nsnr + nsnfi(nin)%P(p)
1005 ENDIF
1006 ENDIF
1007 ENDIF
1008 ENDDO
1009 nbirecv=l
1010C
1011C Allocate total size
1012C
1013
1014 IF(nsnr > 0 .OR. nedge_remote > 0 ) THEN
1015 ALLOCATE(xrem(rsiz,nsnr),stat=ierror)
1016 IF(ierror/=0) THEN
1017 CALL ancmsg(msgid=20,anmode=aninfo)
1018 CALL arret(2)
1019 ENDIF
1020 ALLOCATE(irem(isiz,nsnr),stat=ierror)
1021 IF(ierror/=0) THEN
1022 CALL ancmsg(msgid=20,anmode=aninfo)
1023 CALL arret(2)
1024 ENDIF
1025 IF(iedge /= 0) THEN
1026 ALLOCATE(irem_edge(e_ibuf_size,nedge_remote),stat=ierror)
1027 IF(ierror/=0) THEN
1028 CALL ancmsg(msgid=20,anmode=aninfo)
1029 CALL arret(2)
1030 ENDIF
1031 ALLOCATE(xrem_edge(e_rbuf_size,nedge_remote),stat=ierror)
1032 IF(ierror/=0) THEN
1033 CALL ancmsg(msgid=20,anmode=aninfo)
1034 CALL arret(2)
1035 ENDIF
1036 ENDIF
1037 ideb = 1
1038 ideb_edge = 1
1039 nbirecv_edge = 0
1040 nbirecv_node = 0
1041 DO l = 1, nbirecv
1042 p = isindexi(l)
1043 IF(nsnfi(nin)%P(p) > 0 ) THEN
1044 len = nsnfi(nin)%P(p)*rsiz
1045 msgtyp = msgoff4
1046 nbirecv_node = nbirecv_node + 1
1047 CALL spmd_irecv(
1048 1 xrem(1,ideb),len,it_spmd(p),
1049 2 msgtyp,req_rd(nbirecv_node))
1050
1051 len2 = nsnfi(nin)%P(p)*isiz
1052 msgtyp = msgoff5
1053 CALL spmd_irecv(
1054 1 irem(1,ideb),len2,it_spmd(p),
1055 2 msgtyp,req_rd2(nbirecv_node))
1056 ideb = ideb + nsnfi(nin)%P(p)
1057 ENDIF
1058
1059 IF(iedge /= 0) THEN
1060 IF(edge_fi(nin)%P(p) > 0 ) THEN
1061 msgtyp = msgoff6
1062 len2 = edge_fi(nin)%P(p)*e_ibuf_size
1063 nbirecv_edge = nbirecv_edge + 1
1064
1065 CALL spmd_irecv(
1066 1 irem_edge(1,ideb_edge),len2,it_spmd(p),
1067 2 msgtyp,req_rd4(nbirecv_edge))
1068
1069 msgtyp = msgoff7
1070 len2 = edge_fi(nin)%P(p)*e_rbuf_size
1071 CALL spmd_irecv(
1072 1 xrem_edge(1,ideb_edge),len2,it_spmd(p),
1073 2 msgtyp,req_rd5(nbirecv_edge))
1074 ideb_edge = ideb_edge + edge_fi(nin)%P(p)
1075 ENDIF
1076 ENDIF
1077 ENDDO
1078
1079
1080
1081 CALL spmd_waitall(nbirecv_node,req_rd )
1082 CALL spmd_waitall(nbirecv_node,req_rd2)
1083 CALL spmd_waitall(nbirecv_edge,req_rd4)
1084 CALL spmd_waitall(nbirecv_edge,req_rd5)
1085
1086 !set specifics IREM and XREM indexes for INT24 sorting
1087 IF(isiz > 5 .AND. nsnr > 0) THEN
1088 igapxremp = irem(4,1)
1089 i24xremp = irem(5,1)
1090 i24iremp = irem(6,1)
1091 ENDIF
1092 ENDIF
1093 ENDIF
1094C
1095 IF(ircvfrom(nin,loc_proc)/=0) THEN
1096 DO p = 1, nspmd
1097 IF(isendto(nin,p)/=0) THEN
1098 IF(p/=loc_proc) THEN
1099 CALL spmd_wait(req_sb(p))
1100 CALL spmd_wait(req_sc(p))
1101 ENDIF
1102 ENDIF
1103 ENDDO
1104 ENDIF
1105C
1106 IF(isendto(nin,loc_proc)/=0) THEN
1107 DO p = 1, nspmd
1108 IF(ircvfrom(nin,p)/=0) THEN
1109 IF(p/=loc_proc) THEN
1110 CALL spmd_wait(req_sd(p))
1111 IF(nbox(1,p) > 0) THEN
1112 CALL spmd_wait(req_sd2(p))
1113 DEALLOCATE(rbuf(p)%p)
1114 CALL spmd_wait(req_sd3(p))
1115 DEALLOCATE(ibuf(p)%p)
1116 ENDIF
1117 IF(nbox(2,p) > 0) THEN
1118 CALL spmd_wait(req_sd4(p))
1119 DEALLOCATE(ibuf_edge(p)%p)
1120 CALL spmd_wait(req_sd5(p))
1121 DEALLOCATE(rbuf_edge(p)%p)
1122 END IF
1123 ENDIF
1124 ENDIF
1125 ENDDO
1126 ENDIF
1127C
1128#endif
1129 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
for
for(i8=*sizetab-1;i8 >=0;i8--)
Definition mumps_common.c:91
message_mod
Definition message_mod.F:1249
tri25ebox::nedge_remote
integer nedge_remote
Definition tri25ebox.F:73
tri25ebox::crvoxel25
integer, dimension(:,:,:,:), allocatable crvoxel25
Definition tri25ebox.F:70
tri25ebox::lrvoxel25
integer, parameter lrvoxel25
Definition tri25ebox.F:69
tri25ebox::irem_edge
integer, dimension(:,:), allocatable irem_edge
Definition tri25ebox.F:64
tri25ebox::nsnfieold
integer, dimension(:), allocatable nsnfieold
Definition tri25ebox.F:95
tri25ebox::edge_fi
type(int_pointer), dimension(:), allocatable edge_fi
Definition tri25ebox.F:67
tri7box::candf_si
type(int_pointer), dimension(:), allocatable candf_si
Definition tri7box.F:560
tri7box::nsvsi
type(int_pointer), dimension(:), allocatable nsvsi
Definition tri7box.F:485
tri7box::i24iremp
integer i24iremp
Definition tri7box.F:423
tri7box::nsnfie
type(int_pointer), dimension(:), allocatable nsnfie
Definition tri7box.F:440
tri7box::nsnsi
type(int_pointer), dimension(:), allocatable nsnsi
Definition tri7box.F:491
tri7box::i24xremp
integer i24xremp
Definition tri7box.F:423
tri7box::igapxremp
integer igapxremp
Definition tri7box.F:423
tri7box::lrvoxel
integer lrvoxel
Definition tri7box.F:54
tri7box::nsnfi
type(int_pointer), dimension(:), allocatable nsnfi
Definition tri7box.F:440
tri7box::irem
integer, dimension(:,:), allocatable irem
Definition tri7box.F:339
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