OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
spmd_ifront.F File Reference
#include "implicit_f.inc"
#include "spmd.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "com08_c.inc"
#include "param_c.inc"
#include "task_c.inc"
#include "assert.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine spmd_ifront (ipari, newfront, isendto, ircvfrom, nsensor, nbintc, intlist, islen7, irlen7, islen11, irlen11, islen17, irlen17, irlen7t, islen7t, irlen20, islen20, irlen20t, islen20t, irlen20e, islen20e, sensor_tab, intbuf_tab, mode)

Function/Subroutine Documentation

◆ spmd_ifront()

subroutine spmd_ifront ( integer, dimension(npari,ninter) ipari,
integer, dimension(*) newfront,
integer, dimension(ninter+1,*) isendto,
integer, dimension(ninter+1,*) ircvfrom,
integer, intent(in) nsensor,
integer nbintc,
integer, dimension(*) intlist,
integer islen7,
integer irlen7,
integer islen11,
integer irlen11,
integer islen17,
integer irlen17,
integer irlen7t,
integer islen7t,
integer irlen20,
integer islen20,
integer irlen20t,
integer islen20t,
integer irlen20e,
integer islen20e,
type (sensor_str_), dimension(nsensor), intent(in) sensor_tab,
type(intbuf_struct_), dimension(*) intbuf_tab,
integer mode )

Definition at line 40 of file spmd_ifront.F.

46C============================================================================
47C M o d u l e s
48C-----------------------------------------------
49 USE tri25ebox
50 USE tri7box
51 USE ifront_mod
52 USE message_mod
53 USE intbufdef_mod
54 USE sensor_mod
55C-----------------------------------------------
56C I m p l i c i t T y p e s
57C-----------------------------------------------
58 USE spmd_comm_world_mod, ONLY : spmd_comm_world
59#include "implicit_f.inc"
60C-----------------------------------------------
61C M e s s a g e P a s s i n g
62C-----------------------------------------------
63#include "spmd.inc"
64C-----------------------------------------------
65C C o m m o n B l o c k s
66C-----------------------------------------------
67#include "com01_c.inc"
68#include "com04_c.inc"
69#include "com08_c.inc"
70#include "param_c.inc"
71#include "task_c.inc"
72#include "assert.inc"
73C-----------------------------------------------
74C D u m m y A r g u m e n t s
75C-----------------------------------------------
76 INTEGER ,INTENT(IN) :: NSENSOR
77 INTEGER NBINTC,ISLEN7,IRLEN7,ISLEN11,IRLEN11,ISLEN17,IRLEN17,
78 . IRLEN7T,ISLEN7T,IRLEN20,ISLEN20 ,IRLEN20T,ISLEN20T,
79 . IRLEN20E,ISLEN20E,
80 . IPARI(NPARI,NINTER),
81 . NEWFRONT(*), INTLIST(*),
82 . ISENDTO(NINTER+1,*) ,IRCVFROM(NINTER+1,*)
83 INTEGER MODE
84 TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
85 TYPE (SENSOR_STR_) ,DIMENSION(NSENSOR) ,INTENT(IN) :: SENSOR_TAB
86C-----------------------------------------------
87C L o c a l V a r i a b l e s
88C-----------------------------------------------
89#ifdef MPI
90 INTEGER LEN, ITYP,
91 . P, I, J, L, NIN ,IDEB, IDEB2, IDEB3, II,
92 . LENOUT, I0, NS, INTTH,
93 . ITY,
94 . SIZE, LOC_PROC, MSGTYP,
95 . MSGOFF, MSGOFF2, MSGOFF3, MSGOFF4,
96 . IERROR, IDEBUT(NSPMD+NINTER),
97 . STATUS(MPI_STATUS_SIZE),REQ_S(NSPMD),
98 . ISUBTMP(NINTER,2,NSPMD),ISUBTMP2(NINTER,2,NSPMD),
99 . IDEBUT2(NINTER), ISENS,INTERACT,
100 . IEDGE
101 INTEGER :: SIZ,IDEB_EDGE,NB_SUBINT
102 INTEGER :: INDEX_PROC
103 LOGICAL :: ONLY_INTER_7
104 DATA msgoff/1009/
105 DATA msgoff2/1010/
106 DATA msgoff3/1011/
107 DATA msgoff4/1012/
108
109C REAL
110 my_real
111 . startt,stopt,dist,
112 . ts
113
114
115C-----------------------------------------------
116 IF(nspmd==1) RETURN
117 loc_proc = ispmd+1
118
119
120c NBINTC = 0
121c DO NIN = 1,NINTER
122c IF(IPARI(7,NIN) == 25) THEN
123c NBINTC = NBINTC + 1
124c INTLIST(NBINTC) = NIN
125c ENDIF
126c ENDDO
127c DO II = 1, NBINTC
128c NIN = INTLIST(II)
129c ITY=IPARI(7,NIN)
130c IF(ITY /= 25) THEN
131c NBINTC = NBINTC + 1
132c INTLIST(NBINTC) = NIN
133c ENDIF
134c ENDDO
135
136C ===========================================================
137 IF(mode == 1) THEN
138
139 icomm = 0
140C
141
142 ! Allocation done once for all
143 IF(.NOT. ALLOCATED(proc_list)) THEN
144 ALLOCATE(proc_list(nspmd) )
145 ALLOCATE(icomm2(nspmd), req_send_siz(nspmd), req_send_msg(nspmd))
146 ALLOCATE(req_recv_siz(nspmd), req_recv_msg(nspmd))
147 ALLOCATE(ircom(nspmd), iscom(nspmd), iscoms(nspmd))
148 ALLOCATE(sizbuf_r(nspmd))
149 ALLOCATE(sizbuf_s(nspmd))
150 ALLOCATE(msgbuf_r(nspmd))
151 ALLOCATE(msgbuf_s(nspmd))
152 ALLOCATE(icomm2_send(nspmd),icomm2_rcv(nspmd))
153c ALLOCATE(MSGBUF_S_LEN(NSPMD))
154c MSGBUF_S_LEN(1:NSPMD) = 0
155c ALLOCATE(MSGBUF_R_LEN(NSPMD))
156c MSGBUF_R_LEN(1:NSPMD) = 0
157 DO p=1,nspmd
158 ALLOCATE(sizbuf_r(p)%P(2*nbintc))
159 ALLOCATE(sizbuf_s(p)%P(2*nbintc))
160 sizbuf_r(p)%P(1:2*nbintc) = 0
161 sizbuf_s(p)%P(1:2*nbintc) = 0
162 ENDDO
163 ENDIF
164
165 !Initialization
166 req_recv_siz(1:nspmd) = mpi_request_null
167 req_recv_msg(1:nspmd) = mpi_request_null
168 proc_list(1:nspmd) = 0
169 iscom(1:nspmd) = 0
170 iscoms(1:nspmd) = 0
171
172
173C
174 nisubg = 0
175 l = 0
176 SIZE = 4+2*nspmd
177 DO ii = 1, nbintc
178 nin = intlist(ii)
179 ity=ipari(7,nin)
180 IF(ity==7.OR.ity==10.OR.
181 . ity==22.OR.ity==23.OR.ity==24.OR.
182 . ity==20.OR.ity==11.OR.ity==17.OR.
183 . ity==25) THEN
184C Take care if inactive interfaces
185C
186 interact = 0
187 isens = 0
188 IF(ity == 7.OR.ity == 11.OR.ity == 24.OR.ity == 25) THEN
189 isens = ipari(64,nin) ! IF an interface sensor is defined
190 ENDIF
191 IF (isens > 0) THEN ! Sensor ID
192 ts = sensor_tab(isens)%TSTART
193 IF (tt>=ts) interact = 1
194 ELSE
195 startt= intbuf_tab(nin)%VARIABLES(3)
196 stopt = intbuf_tab(nin)%VARIABLES(11)
197 IF (startt<=tt.AND.tt<=stopt) interact = 1
198 ENDIF
199C
200 dist = intbuf_tab(nin)%VARIABLES(5)
201C
202c IF(ITY == 25) THEN
203c WRITE(6,*) "DIST=",DIST
204c WRITE(6,*) "INTERACT=",INTERACT
205c ENDIF
206
207 IF (ity == 25 .OR. (dist<=zero.AND.interact/=0))THEN
208 IF(isendto(nin,loc_proc)/=0.OR.
209 . ircvfrom(nin,loc_proc)/=0) THEN
210
211 newfront(nin) = 2
212c IF(ITY == 25) THEN
213c WRITE(6,*) "NEWFRONT",NIN,"=",2
214c ENDIF
215
216 icomm = 1
217 intbuf_tab(nin)%VARIABLES(5) = -dist
218c Rbufs (L+1) = Nin
219c RBUFS(L+2)= INTBUF_TAB(NIN)%VARIABLES(8)
220c RBUFS(L+3)= INTBUF_TAB(NIN)%VARIABLES(9)
221c RBUFS(L+4)= INTBUF_TAB(NIN)%VARIABLES(12)
222
223 DO p = 1, nspmd
224 len = nsnfi(nin)%P(p)
225C IF(IPARI(7,NIN)==20) LEN = LEN + NSNFIE(NIN)%P(P)
226 sizbuf_s(p)%P(ii)= len
227 iscom(p) = iscom(p) + len
228 ENDDO
229 IF (ipari(36,nin)>0.AND.ipari(7,nin)/=17) THEN
230 nisubg = max(nisubg,ipari(36,nin))
231 DO p=1,nspmd
232 iscoms(p) = iscoms(p) + nsnfi(nin)%P(p)
233 IF(ipari(7,nin)==25.AND. ipari(58,nin) > 0) THEN
234 iscoms(p) = iscoms(p) + nsnfie(nin)%P(p)
235 ENDIF
236 ENDDO
237 END IF
238C
239C Edge part addition for type 20
240C
241 ity=ipari(7,nin)
242 IF (ity == 20 .OR. (ity == 25.AND. ipari(58,nin) > 0)) THEN
243 DO p = 1, nspmd
244 len = nsnfie(nin)%P(p)
245 sizbuf_s(p)%P(ii+nbintc)= len
246 iscom(p) = iscom(p) + len
247 END DO
248 ELSE
249 DO p = 1, nspmd
250 sizbuf_s(p)%P(ii+nbintc)= 0
251 END DO
252 END IF
253C
254 l = l + SIZE
255 ENDIF
256 ENDIF
257 ENDIF
258 ENDDO
259C
260C Verification of the end of sorting (i7buce)
261C
262 DO p = 1, nspmd
263 icomm2(p) = 0
264 icomm2_send(p) = 0
265 icomm2_rcv(p) = 0
266 only_inter_7 = .true.
267 IF (p/=loc_proc) THEN
268 DO ii = 1, nbintc
269 nin = intlist(ii)
270 ity=ipari(7,nin)
271 IF(newfront(nin)==2) THEN
272 IF(isendto(nin,p)/=0.OR.ircvfrom(nin,p)/=0) THEN
273 icomm2(p) = 1
274 IF(ity/=7.AND.ity/=11) only_inter_7 = .false.
275 ENDIF
276 IF(isendto(nin,p)/=0.AND.ircvfrom(nin,loc_proc)/=0) icomm2_send(p) = 1 ! nsn > 0 on p & nmn > 0 on ispmd
277 IF(ircvfrom(nin,p)/=0.AND.isendto(nin,loc_proc)/=0) icomm2_rcv(p) = 1 ! nmn > 0 on p & nsn > 0 on ispmd
278 ENDIF
279 ENDDO
280 IF(.NOT.only_inter_7) THEN
281 icomm2_rcv(p) = icomm2(p)
282 icomm2_send(p) = icomm2(p)
283 ENDIF
284 END IF
285 IF (icomm2_send(p)==1)THEN
286 msgtyp = msgoff
287 l = 2*nbintc
288 CALL mpi_isend(
289 s sizbuf_s(p)%P(1),l,mpi_integer,it_spmd(p),msgtyp,
290 g spmd_comm_world,req_send_siz(p),ierror)
291 ENDIF
292 ENDDO
293
294
295 nb_to_recv = 0
296 DO p = 1, nspmd
297 ircom(p) = 0
298 IF(icomm2_rcv(p)==1)THEN
299 msgtyp = msgoff
300 nb_to_recv = nb_to_recv + 1
301 proc_list(nb_to_recv) = p
302 l = 2 * nbintc
303 CALL mpi_irecv(sizbuf_r(p)%P(1),l,
304 . mpi_integer,it_spmd(p),
305 . msgtyp,spmd_comm_world,req_recv_siz(nb_to_recv),ierror)
306
307 ENDIF
308 ENDDO
309C=======================================================================
310C ENVOI
311 IF(icomm /= 0) THEN
312 DO ii = 1, nbintc
313 i = intlist(ii)
314 idebut(i) = 0
315 idebut2(i) = 0
316 ENDDO
317 DO p = 1, nspmd
318 len = iscom(p)
319 IF(len/=0) THEN
320C allocate communication structure
321 ALLOCATE(msgbuf_s(p)%P(len),stat=ierror)
322
323 IF(ierror/=0) THEN
324 CALL ancmsg(msgid=20,anmode=aninfo)
325 CALL arret(2)
326 ENDIF
327 ideb = 0
328 DO ii = 1, nbintc
329 nin = intlist(ii)
330C interface retriee ?
331 IF(newfront(nin)==2) THEN
332 IF(nsnfi(nin)%P(p)>0) THEN
333 ideb2 = idebut(nin)
334 len = nsnfi(nin)%P(p)
335 DO i = 1, len
336 msgbuf_s(p)%P(ideb+i) = nsvfi(nin)%P(ideb2+i)
337 ENDDO
338 idebut(nin) = idebut(nin) + len
339 ideb = ideb + len
340 ENDIF
341 IF(ipari(7,nin) == 20 .OR. (ipari(7,nin) == 25.AND. ipari(58,nin) > 0))THEN
342 IF(nsnfie(nin)%P(p)>0) THEN
343 ideb2 = idebut2(nin)
344 len = nsnfie(nin)%P(p)
345C WRITE(6,*) __FILE__,ISPMD,"RECV",P-1,LEN
346 DO i = 1, len
347 assert(nsvfie(nin)%P(ideb2+i) > 0)
348 msgbuf_s(p)%P(ideb+i) = abs(nsvfie(nin)%P(ideb2+i))
349 ENDDO
350 idebut2(nin) = idebut2(nin) + len
351 ideb = ideb + len
352 ENDIF
353 END IF
354 ENDIF
355 ENDDO
356 msgtyp = msgoff2
357 CALL mpi_isend(
358 s msgbuf_s(p)%P(1),ideb,mpi_integer,it_spmd(p),msgtyp,
359 g spmd_comm_world,req_send_msg(p),ierror)
360 ENDIF
361 ENDDO
362 ENDIF ! ICOMM /= 0)
363
364 ELSEIF( mode == 2 ) THEN
365C =========================================
366c _ ,/'
367c (_). ,/'
368c __ :: - - - - - - - - - - - -
369c (__)' `\.
370c `\.
371C ==========================================
372
373
374
375
376C ==========================================================================
377C RECEPTION OF sizes
378! CALL MPI_WAITALL(NB_TO_RECV,REQ_RECV_SIZ(1:NB_TO_RECV),MPI_STATUSES_IGNORE,IERROR)
379
380 DO i = 1, nb_to_recv
381 CALL mpi_waitany(nb_to_recv,req_recv_siz,index_proc,status,ierror)
382 p = proc_list(index_proc)
383! P = PROC_LIST(I)
384
385 ircom(p) = 0
386 DO ii = 1, nbintc
387 nin = intlist(ii)
388 ity=ipari(7,nin)
389 IF(newfront(nin) == 2) THEN
390 IF(isendto(nin,loc_proc)/=0.OR.
391 . ircvfrom(nin,loc_proc)/=0) THEN
392 len = sizbuf_r(p)%P(ii)
393 nsnsi(nin)%P(p) = len
394 ircom(p) = ircom(p) + len
395 IF(ity == 20 .OR. (ity == 25.AND. ipari(58,nin) > 0))THEN
396 len = sizbuf_r(p)%P(ii+nbintc)
397 nsnsie(nin)%P(p) = len
398 ircom(p) = ircom(p) + len
399 END IF
400 ENDIF
401 ENDIF
402 ENDDO ! NBINTC
403 len = ircom(p)
404 IF(len>0) THEN
405 ALLOCATE(msgbuf_r(p)%P(len),stat=ierror)
406 IF(ierror/=0) THEN
407 CALL ancmsg(msgid=20,anmode=aninfo)
408 CALL arret(2)
409 ENDIF
410 msgtyp = msgoff2
411 CALL mpi_irecv(msgbuf_r(p)%P(1),len,mpi_integer,it_spmd(p),
412 . msgtyp,spmd_comm_world,req_recv_msg(i),ierror)
413
414 ENDIF
415 ENDDO
416
417
418
419
420
421
422C RECEPTION of messages
423 DO p = 1, nb_to_recv
424 CALL mpi_wait(req_recv_msg(p),status,ierror)
425 ENDDO
426 DO p = 1, nspmd
427 IF (icomm2_send(p)==1) THEN
428 CALL mpi_wait(req_send_siz(p),status,ierror)
429 ENDIF
430 ENDDO
431
432 IF(icomm==0) RETURN
433
434 DO p = 1, nspmd
435 idebut(p) = 0
436 ENDDO
437C MAJ STRUCTURES D ECHANGES
438 DO ii = 1, nbintc
439 nin = intlist(ii)
440C interface retriee ?
441 IF(newfront(nin)==2) THEN
442 ideb = 0
443 IF(ASSOCIATED(nsvsi(nin)%P))DEALLOCATE(nsvsi(nin)%P)
444 len = 0
445 DO p = 1, nspmd
446 len = len + nsnsi(nin)%P(p)
447 ENDDO
448 ierror = 0
449 IF(len>0)ALLOCATE(nsvsi(nin)%P(len),stat=ierror)
450 IF(ierror/=0) THEN
451 CALL ancmsg(msgid=20,anmode=aninfo)
452 CALL arret(2)
453 ENDIF
454 DO p = 1, nspmd
455 len = nsnsi(nin)%P(p)
456C test if proc has sent something
457 IF(len>0) THEN
458 ideb2 = idebut(p)
459 DO i = 1, len
460 nsvsi(nin)%P(ideb+i) = msgbuf_r(p)%P(ideb2+i)
461 ENDDO
462 ideb = ideb + len
463 idebut(p) = idebut(p) + len
464 ENDIF
465 ENDDO
466C
467 IF(ipari(7,nin) == 20 .OR. (ipari(7,nin) == 25.AND. ipari(58,nin) > 0) )THEN
468 ideb = 0
469 IF(ASSOCIATED(nsvsie(nin)%P))DEALLOCATE(nsvsie(nin)%P)
470 len = 0
471 DO p = 1, nspmd
472 len = len + nsnsie(nin)%P(p)
473 ENDDO
474 ierror = 0
475 IF(len>0)ALLOCATE(nsvsie(nin)%P(len),stat=ierror)
476 IF(ierror/=0) THEN
477 CALL ancmsg(msgid=20,anmode=aninfo)
478 CALL arret(2)
479 ENDIF
480 DO p = 1, nspmd
481 len = nsnsie(nin)%P(p)
482C test if proc has sent something
483 IF(len>0) THEN
484C WRITE(6,*) __FILE__,ISPMD,"SEND",P-1,LEN
485 ideb2 = idebut(p)
486 DO i = 1, len
487 assert(msgbuf_r(p)%P(ideb2+i) > 0)
488 nsvsie(nin)%P(ideb+i) = abs(msgbuf_r(p)%P(ideb2+i))
489 ENDDO
490 ideb = ideb + len
491 idebut(p) = idebut(p) + len
492 ENDIF
493 ENDDO
494 END IF
495 ENDIF
496 ENDDO
497C Waiting for message reception
498 DO p = 1, nspmd
499 IF(ircom(p)>0) THEN
500 DEALLOCATE(msgbuf_r(p)%P)
501 ENDIF
502 IF(iscom(p)>0) THEN
503 CALL mpi_wait(req_send_msg(p),status,ierror)
504 DEALLOCATE(msgbuf_s(p)%P)
505 ENDIF
506 ENDDO
507
508C
509 IF(nisubg>0) THEN
510C interface with sub-interface output
511C
512C Calculation and sending of the size of sub-interface parts on the border part
513C
514 DO p = 1, nspmd
515 IF(ircom(p)>0) THEN
516 DO ii = 1, nbintc
517 i = intlist(ii)
518 isubtmp(i,1,p) = 0
519 isubtmp(i,2,p) = 0
520 END DO
521 END IF
522 END DO
523 DO ii = 1, nbintc
524 nin = intlist(ii)
525C interface stripped with sub-interfaces ?
526 IF(newfront(nin)==2.AND.ipari(36,nin)>0.AND.
527 + ipari(7,nin)/=17) THEN
528 ideb = 0
529 DO p = 1, nspmd
530 len = nsnsi(nin)%P(p)
531 lenout = 0
532 IF(len>0) THEN
533 DO i = 1, len
534 ns = nsvsi(nin)%P(ideb+i)
535C addition of +1 to send the number of sub-interfaces per node
536 lenout = lenout + intbuf_tab(nin)%ADDSUBS(ns+1)-
537 . intbuf_tab(nin)%ADDSUBS(ns) + 1
538 END DO
539 ideb = ideb + len
540 END IF
541 isubtmp(nin,1,p) = lenout
542 ENDDO
543 IF(ipari(7,nin) ==25 .AND. ipari(58,nin) > 0) THEN
544 ideb = 0
545 DO p=1,nspmd
546C Partie Eedge
547 len = nsnsie(nin)%P(p)
548 lenout = 0
549 IF(len>0) THEN
550 DO i = 1, len
551 ns = nsvsie(nin)%P(ideb+i)
552C addition of +1 to send the number of sub-interfaces per node
553 lenout = lenout + intbuf_tab(nin)%ADDSUBE(ns+1)-
554 . intbuf_tab(nin)%ADDSUBE(ns) + 1
555C WRITE(6,*) "Node",I,INTBUF_TAB(NIN)%ADDSUBE(NS),
556C . INTBUF_TAB(NIN)%ADDSUBE(NS+1)-1
557 END DO
558 ideb = ideb + len
559 END IF
560C WRITE(6,*) "ISUBTMP(",P-1,")=",LENOUT
561 isubtmp(nin,2,p) = lenout
562 END DO ! NSPMD
563 ENDIF ! type 25 E2E
564 END IF ! NEWFRONT
565 END DO ! NBINTC
566C
567 DO p = 1, nspmd
568 IF(ircom(p)>0) THEN
569 lenout = 0
570 DO ii = 1, nbintc
571 nin = intlist(ii)
572 lenout = lenout + isubtmp(nin,1,p)
573 IF(newfront(nin)==2.AND.ipari(36,nin)>0.AND.
574 + (ipari(7,nin) == 7.OR.ipari(7,nin) == 11.OR.ipari(7,nin) == 24.OR.ipari(7,nin) == 25)) THEN
575 lenout = lenout + isubtmp(nin,1,p) - nsnsi(nin)%P(p)
576 ENDIF
577 IF(newfront(nin)==2.AND.ipari(36,nin)>0.AND.
578 + ipari(7,nin)==25) THEN
579 IF(ipari(58,nin) /= 0) THEN
580 lenout = lenout + 2*isubtmp(nin,2,p) - nsnsie(nin)%P(p)
581 ENDIF
582 ENDIF
583 END DO
584C Comm Save length in IRCOM
585 ircom(p) = lenout
586 IF(lenout>0) THEN
587C allocate communication structure
588 ALLOCATE(msgbuf_s(p)%P(lenout),stat=ierror)
589 IF(ierror/=0) THEN
590 CALL ancmsg(msgid=20,anmode=aninfo)
591 CALL arret(2)
592 END IF
593 msgtyp = msgoff3
594 siz = ninter * 2
595 CALL mpi_isend(
596 s isubtmp(1,1,p),siz,mpi_integer,it_spmd(p),msgtyp,
597 g spmd_comm_world,req_s(p),ierror)
598 END IF
599 END IF
600 END DO
601C
602C Reception of the size of sub-interface parts on the border part
603C
604 DO p = 1, nspmd
605 IF(iscoms(p)>0) THEN
606 msgtyp = msgoff3
607 lenout = 0
608 siz = ninter * 2
609C received in the unused part of the isubtmp buffer
610 CALL mpi_recv(isubtmp2(1,1,p),siz,mpi_integer,it_spmd(p),
611 . msgtyp,spmd_comm_world,status,ierror)
612 DO ii = 1, nbintc
613 nin = intlist(ii)
614C interface stripped with sub-interfaces ?
615 IF(newfront(nin)==2.AND.ipari(36,nin)>0.AND.
616 + ipari(7,nin)/=17) THEN
617C subtracting the number of nodes to find the length of sub-interfaces
618 nb_subint = isubtmp2(nin,1,p) - nsnfi(nin)%P(p)
619 nisubsfi(nin)%P(p) = nb_subint
620 lenout = lenout + isubtmp2(nin,1,p)
621 IF(ipari(7,nin) == 7.OR.ipari(7,nin) == 11.OR.ipari(7,nin) == 24.OR.ipari(7,nin) == 25) THEN
622 lenout = lenout + nb_subint
623 ENDIF
624 IF(ipari(7,nin)==25) THEN
625 IF(ipari(58,nin) /= 0) THEN ! edge to edge
626 nisubsfie(nin)%P(p) = isubtmp2(nin,2,p) - nsnfie(nin)%P(p)
627C WRITE(6,*) "NISUBSFIE(NIN)%P(",P-1,")=",NIN,NISUBSFIE(NIN)%P(P),ISUBTMP2(NIN,2,P), NSNFIE(NIN)%P(P)
628 lenout = lenout + 2*isubtmp2(nin,2,p) - nsnfie(nin)%P(p)
629! Buffer is [ Size , I_1, I_2, ...., wize]
630 ENDIF
631 ENDIF
632 END IF
633 END DO
634C Comm Save length in Iscom
635 iscom(p) = lenout
636 IF(lenout>0) THEN
637 ALLOCATE(msgbuf_r(p)%P(lenout),stat=ierror)
638 IF(ierror/=0) THEN
639 CALL ancmsg(msgid=20,anmode=aninfo)
640 CALL arret(2)
641 ENDIF
642 END IF
643 ELSE
644 iscom(p) = 0
645 END IF
646 END DO
647C
648 DO p = 1, nspmd
649 IF(ircom(p)>0) THEN
650 CALL mpi_wait(req_s(p),status,ierror)
651 END IF
652 END DO
653C
654C Sending of sub-interface parts on the border part
655C
656 DO p = 1, nspmd
657 idebut(p) = 0
658 END DO
659 DO ii = 1, nbintc
660 nin = intlist(ii)
661C interface stripped with sub-interfaces ?
662 IF(newfront(nin)==2.AND.ipari(36,nin)>0.AND.
663 + ipari(7,nin)/=17) THEN
664 ideb = 0
665 DO p = 1, nspmd
666 len = nsnsi(nin)%P(p)
667 IF(len>0) THEN
668 i0 = idebut(p)
669 DO i = 1, len
670 ns = nsvsi(nin)%P(ideb+i)
671 i0 = i0 + 1
672C retrieves the number of sub-interfaces for the node
673 msgbuf_s(p)%P(i0) = intbuf_tab(nin)%ADDSUBS(ns+1)-
674 . intbuf_tab(nin)%ADDSUBS(ns)
675
676 DO j = intbuf_tab(nin)%ADDSUBS(ns),
677 . intbuf_tab(nin)%ADDSUBS(ns+1)-1
678 i0 = i0 + 1
679 msgbuf_s(p)%P(i0) = intbuf_tab(nin)%LISUBS(j)
680 END DO
681 IF(ipari(7,nin) == 7.OR.ipari(7,nin) == 11.OR.ipari(7,nin) == 24.OR.ipari(7,nin) == 25) THEN
682 DO j = intbuf_tab(nin)%ADDSUBS(ns),
683 . intbuf_tab(nin)%ADDSUBS(ns+1)-1
684 i0 = i0 + 1
685 msgbuf_s(p)%P(i0) = intbuf_tab(nin)%INFLG_SUBS(j)
686 END DO
687 END IF
688 END DO
689 idebut(p) = i0
690 ideb = ideb + len
691 END IF
692 END DO
693 IF(ipari(7,nin) == 25 .AND. ipari(58,nin) /= 0)THEN
694 ideb_edge = 0
695 DO p = 1,nspmd
696C Sub interface for Edges
697 len = nsnsie(nin)%P(p)
698 IF(len>0) THEN
699 i0 = idebut(p)
700 DO i = 1, len
701 ns = nsvsie(nin)%P(ideb_edge+i)
702 i0 = i0 + 1
703C retrieves the number of sub-interfaces for the node
704 msgbuf_s(p)%P(i0) = intbuf_tab(nin)%ADDSUBE(ns+1)-
705 . intbuf_tab(nin)%ADDSUBE(ns)
706
707C WRITE(6,*) P-1,"MSGBUF_S(",I0,")=",LEN
708
709 DO j = intbuf_tab(nin)%ADDSUBE(ns),
710 . intbuf_tab(nin)%ADDSUBE(ns+1)-1
711 i0 = i0 + 1
712 msgbuf_s(p)%P(i0) = intbuf_tab(nin)%LISUBE(j)
713C WRITE(6,*) P-1,"LISUBE---MSGBUF_S(",I0,")=",MSGBUF_S(P)%P(I0)
714 END DO
715 DO j = intbuf_tab(nin)%ADDSUBE(ns),
716 . intbuf_tab(nin)%ADDSUBE(ns+1)-1
717 i0 = i0 + 1
718 msgbuf_s(p)%P(i0) = intbuf_tab(nin)%INFLG_SUBE(j)
719C WRITE(6,*) P-1,"INFLG---MSGBUF_S(",I0,")=",MSGBUF_S(P)%P(I0)
720 END DO
721 END DO
722 idebut(p) = i0
723 ideb_edge = ideb_edge + len
724 END IF ! LEN
725 END DO
726 ENDIF ! IEDGE
727 END IF
728 END DO
729C
730 DO p = 1, nspmd
731C Comm Save length in IRCOM
732 IF(ircom(p)>0) THEN
733 msgtyp = msgoff4
734C WRITE(6,*) "SEND",IRCOM(P) ,"TO",P-1
735 CALL mpi_isend(
736 s msgbuf_s(p)%P(1),ircom(p),mpi_integer,it_spmd(p),msgtyp,
737 g spmd_comm_world,req_s(p),ierror)
738 END IF
739 END DO
740C
741C Reception of sub-interface parts on the border part
742C
743 DO p = 1, nspmd
744C Comm Save length in Iscom
745 IF(iscom(p)>0) THEN
746 msgtyp = msgoff4
747C WRITE(6,*) "RECV",ISCOM(P) ,"FROM",P-1
748
749 CALL mpi_recv(msgbuf_r(p)%P(1),iscom(p),mpi_integer,it_spmd(p),
750 . msgtyp,spmd_comm_world,status,ierror)
751C DO II = 1,ISCOM(P)
752C WRITE(6,*) "MSGBUF_R(",P-1,")%P(",II,")=",MSGBUF_R(P)%P(II)
753C ENDDO
754 END IF
755 END DO
756C
757C Maj structures sous interfaces
758C
759 DO p = 1, nspmd
760 idebut(p) = 0
761 END DO
762 DO ii = 1, nbintc
763 nin = intlist(ii)
764C interface stripped with sub-interfaces ?
765 IF(newfront(nin)==2.AND.ipari(36,nin)>0.AND.
766 + ipari(7,nin)/=17) THEN
767 IF(ASSOCIATED(lisubsfi(nin)%P))DEALLOCATE(lisubsfi(nin)%P)
768 len = 0
769 DO p = 1, nspmd
770 len = len + nisubsfi(nin)%P(p)
771 END DO
772 ierror = 0
773 IF(len>0) THEN
774 ALLOCATE(lisubsfi(nin)%P(len),stat=ierror)
775 IF(ierror/=0) THEN
776 CALL ancmsg(msgid=20,anmode=aninfo)
777 CALL arret(2)
778 END IF
779 IF(ipari(7,nin) == 7.OR.ipari(7,nin) == 11.OR.ipari(7,nin) == 24.OR.ipari(7,nin) == 25) THEN
780 IF(ASSOCIATED(inflg_subsfi(nin)%P))DEALLOCATE(inflg_subsfi(nin)%P)
781 ALLOCATE(inflg_subsfi(nin)%P(len),stat=ierror)
782 IF(ierror/=0) THEN
783 CALL ancmsg(msgid=20,anmode=aninfo)
784 CALL arret(2)
785 END IF
786 END IF
787 len = 1
788 IF(ASSOCIATED(addsubsfi(nin)%P))
789 . DEALLOCATE(addsubsfi(nin)%P)
790 DO p = 1, nspmd
791 len = len + nsnfi(nin)%P(p)
792 END DO
793 ALLOCATE(addsubsfi(nin)%P(len),stat=ierror)
794 IF(ierror/=0) THEN
795 CALL ancmsg(msgid=20,anmode=aninfo)
796 CALL arret(2)
797 END IF
798 ideb = 0
799 ideb3 = 0
800 addsubsfi(nin)%P(1) = 1
801 DO p = 1, nspmd
802 IF(iscom(p)>0) THEN
803 DO i = 1, nsnfi(nin)%P(p)
804 ideb2 = idebut(p)
805 ideb2 = ideb2 + 1
806 len = msgbuf_r(p)%P(ideb2)
807 addsubsfi(nin)%P(ideb3+i+1) =
808 + addsubsfi(nin)%P(ideb3+i) + len
809 DO j = 1, len
810 lisubsfi(nin)%P(ideb+j) = msgbuf_r(p)%P(ideb2+j)
811 END DO
812 idebut(p) = idebut(p) + len + 1
813 IF(ipari(7,nin) == 7.OR.ipari(7,nin) == 11.OR.ipari(7,nin) == 24.OR.ipari(7,nin) == 25) THEN
814 ideb2 = ideb2 + len
815 DO j = 1, len
816 inflg_subsfi(nin)%P(ideb+j) = msgbuf_r(p)%P(ideb2+j)
817 END DO
818 idebut(p) = idebut(p) + len
819 END IF
820 ideb = ideb + len
821 END DO
822 ideb3 = ideb3 + nsnfi(nin)%P(p)
823 ENDIF
824 END DO
825 ELSE
826 len = 1
827 IF(ASSOCIATED(addsubsfi(nin)%P))
828 . DEALLOCATE(addsubsfi(nin)%P)
829 DO p = 1, nspmd
830 len = len + nsnfi(nin)%P(p)
831 END DO
832 ALLOCATE(addsubsfi(nin)%P(len),stat=ierror)
833 IF(ierror/=0) THEN
834 CALL ancmsg(msgid=20,anmode=aninfo)
835 CALL arret(2)
836 END IF
837 ideb3 = 0
838 addsubsfi(nin)%P(1) = 1
839 DO p = 1, nspmd
840 DO i = 1, nsnfi(nin)%P(p)
841 addsubsfi(nin)%P(ideb3+i+1) =
842 + addsubsfi(nin)%P(ideb3+i)
843 END DO
844 ideb3 = ideb3 + nsnfi(nin)%P(p)
845 END DO
846 END IF
847 IF(ipari(7,nin) == 25 .AND. ipari(58,nin) > 0) THEN
848 !type 25 edge part
849 IF(ASSOCIATED(lisubsfie(nin)%P))DEALLOCATE(lisubsfie(nin)%P)
850 len = 0
851 DO p = 1, nspmd
852 len = len + nisubsfie(nin)%P(p)
853 END DO
854 ierror = 0
855C WRITE(6,*) NIN,"SIZE LISUBSFIE=",LEN
856 IF(len>0) THEN
857 ALLOCATE(lisubsfie(nin)%P(len),stat=ierror)
858 IF(ierror/=0) THEN
859 CALL ancmsg(msgid=20,anmode=aninfo)
860 CALL arret(2)
861 END IF
862 IF(ipari(7,nin)==25)THEN
863 IF(ASSOCIATED(inflg_subsfie(nin)%P))DEALLOCATE(inflg_subsfie(nin)%P)
864 ALLOCATE(inflg_subsfie(nin)%P(len),stat=ierror)
865 IF(ierror/=0) THEN
866 CALL ancmsg(msgid=20,anmode=aninfo)
867 CALL arret(2)
868 END IF
869 END IF
870 len = 1
871 IF(ASSOCIATED(addsubsfie(nin)%P))
872 . DEALLOCATE(addsubsfie(nin)%P)
873 DO p = 1, nspmd
874 len = len + nsnfie(nin)%P(p)
875 END DO
876 ALLOCATE(addsubsfie(nin)%P(len),stat=ierror)
877C WRITE(6,*) NIN,"ADDSUBSFIE size:",LEN
878 IF(ierror/=0) THEN
879 CALL ancmsg(msgid=20,anmode=aninfo)
880 CALL arret(2)
881 END IF
882 ideb = 0
883 ideb3 = 0
884 addsubsfie(nin)%P(1) = 1
885 DO p = 1, nspmd
886 IF(iscom(p)>0) THEN
887 DO i = 1, nsnfie(nin)%P(p)
888 ideb2 = idebut(p)
889 ideb2 = ideb2 + 1
890 len = msgbuf_r(p)%P(ideb2)
891C WRITE(6,*) P-1,"MSGBUF_R(",IDEB2,")=",LEN
892 addsubsfie(nin)%P(ideb3+i+1) =
893 + addsubsfie(nin)%P(ideb3+i) + len
894C WRITE(6,*) "ADDSUBSFIE(NIN)%P(",IDEB3+I+1,") =", ADDSUBSFIE(NIN)%P(IDEB3+I+1)
895 DO j = 1, len
896 lisubsfie(nin)%P(ideb+j) = msgbuf_r(p)%P(ideb2+j)
897C WRITE(6,*) P-1,"LISUBFIE --- MSGBUF_R(",IDEB2+J,")=", MSGBUF_R(P)%P(IDEB2+J)
898 END DO
899 idebut(p) = idebut(p) + len + 1
900 ideb2 = ideb2 + len
901 DO j = 1, len
902 inflg_subsfie(nin)%P(ideb+j) = msgbuf_r(p)%P(ideb2+j)
903C WRITE(6,*) P-1,"INFLG --- MSGBUF_R(",IDEB2+J,")=", MSGBUF_R(P)%P(IDEB2+J)
904 END DO
905 idebut(p) = idebut(p) + len
906 ideb = ideb + len
907 END DO
908 ideb3 = ideb3 + nsnfie(nin)%P(p)
909 ENDIF
910 END DO
911 ELSE
912 len = 1
913 IF(ASSOCIATED(addsubsfie(nin)%P))
914 . DEALLOCATE(addsubsfie(nin)%P)
915 DO p = 1, nspmd
916 len = len + nsnfie(nin)%P(p)
917 END DO
918 ALLOCATE(addsubsfie(nin)%P(len),stat=ierror)
919 IF(ierror/=0) THEN
920 CALL ancmsg(msgid=20,anmode=aninfo)
921 CALL arret(2)
922 END IF
923 ideb3 = 0
924 addsubsfie(nin)%P(1) = 1
925 DO p = 1, nspmd
926 DO i = 1, nsnfie(nin)%P(p)
927 addsubsfie(nin)%P(ideb3+i+1) =
928 + addsubsfie(nin)%P(ideb3+i)
929 END DO
930 ideb3 = ideb3 + nsnfie(nin)%P(p)
931 END DO
932 END IF
933 ENDIF ! TYPE25 EDGE PART
934 END IF
935 END DO
936C
937 DO p = 1, nspmd
938 IF(ircom(p)>0) THEN
939 CALL mpi_wait(req_s(p),status,ierror)
940 DEALLOCATE(msgbuf_s(p)%P)
941 END IF
942 IF(iscom(p)>0) THEN
943 DEALLOCATE(msgbuf_r(p)%P)
944 END IF
945 END DO
946C
947 END IF
948C
949C remise a 0 de newfront + recalcul size msg
950C
951 islen7 = 0
952 irlen7 = 0
953 islen7t = 0
954 irlen7t = 0
955 islen11 = 0
956 irlen11 = 0
957 islen17 = 0
958 irlen17 = 0
959 irlen20 = 0
960 islen20 = 0
961 irlen20t = 0
962 islen20t = 0
963 irlen20e = 0
964 islen20e = 0
965C type 25
966 islen25 = 0
967 islen25e = 0
968 irlen25 = 0
969 irlen25e = 0
970 islen25t = 0
971 islen25et = 0
972 irlen25t = 0
973 irlen25et = 0
974
975 DO ii = 1, nbintc
976 nin = intlist(ii)
977
978 IF(newfront(nin)==2) newfront(nin)=0
979 ityp = ipari(7,nin)
980 intth = ipari(47,nin)
981
982C type 7
983 IF(ityp==7.OR.ityp==10.OR.ityp==22.OR.
984 . ityp==23.OR.ityp==24)THEN
985 IF(intth == 0 ) THEN
986 DO p = 1, nspmd
987 islen7 = islen7 + nsnsi(nin)%P(p)
988 irlen7 = irlen7 + nsnfi(nin)%P(p)
989 END DO
990C type 7 + heat trasfert
991 ELSE
992 DO p = 1, nspmd
993 islen7t = islen7t + nsnsi(nin)%P(p)
994 irlen7t = irlen7t + nsnfi(nin)%P(p)
995 END DO
996 ENDIF
997 ELSEIF(ityp == 11) THEN
998C type 11
999 DO p = 1, nspmd
1000 islen11 = islen11 + nsnsi(nin)%P(p)
1001 irlen11 = irlen11 + nsnfi(nin)%P(p)
1002 END DO
1003C type 17
1004 ELSEIF(ityp == 17) THEN
1005 DO p = 1, nspmd
1006 islen17 = islen17 + nsnsi(nin)%P(p)
1007 irlen17 = irlen17 + nsnfi(nin)%P(p)
1008 END DO
1009 ELSEIF(ityp == 20)THEN
1010C type 20
1011 IF(intth == 0) THEN
1012 DO p = 1, nspmd
1013 islen20 = islen20 + nsnsi(nin)%P(p)
1014 irlen20 = irlen20 + nsnfi(nin)%P(p)
1015 islen20e= islen20e+ nsnsie(nin)%P(p)
1016 irlen20e= irlen20e+ nsnfie(nin)%P(p)
1017 END DO
1018 ELSE
1019 DO p = 1, nspmd
1020 islen20t = islen20t + nsnsi(nin)%P(p)
1021 irlen20t = irlen20t + nsnfi(nin)%P(p)
1022 islen20e= islen20e+ nsnsie(nin)%P(p)
1023 irlen20e= irlen20e+ nsnfie(nin)%P(p)
1024 END DO
1025 ENDIF
1026 ELSEIF(ityp == 25)THEN
1027C type 25
1028 iedge = ipari(58,nin)
1029 IF(intth == 0) THEN
1030 DO p = 1, nspmd
1031 islen25 = islen25 + nsnsi(nin)%P(p)
1032 irlen25 = irlen25 + nsnfi(nin)%P(p)
1033 IF( iedge /= 0) THEN
1034 islen25e= islen25e+ nsnsie(nin)%P(p)
1035 irlen25e= irlen25e+ nsnfie(nin)%P(p)
1036 ENDIF
1037 END DO
1038 ELSE
1039 DO p = 1, nspmd
1040 islen25t = islen25t + nsnsi(nin)%P(p)
1041 irlen25t = irlen25t + nsnfi(nin)%P(p)
1042 IF( iedge /= 0) THEN
1043 islen25e= islen25e+ nsnsie(nin)%P(p)
1044 irlen25e= irlen25e+ nsnfie(nin)%P(p)
1045 ENDIF
1046 END DO
1047 ENDIF
1048
1049 END IF
1050 ENDDO
1051
1052C ====================
1053 ENDIF ! MODE = 2
1054C ====================
1055
1056C
1057#endif
1058 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
max
#define max(a, b)
Definition macros.h:21
mpi_recv
subroutine mpi_recv(buf, cnt, datatype, source, tag, comm, status, ierr)
Definition mpi.f:461
mpi_isend
subroutine mpi_isend(buf, cnt, datatype, dest, tag, comm, ireq, ierr)
Definition mpi.f:382
mpi_wait
subroutine mpi_wait(ireq, status, ierr)
Definition mpi.f:525
mpi_waitany
subroutine mpi_waitany(cnt, array_of_requests, index, status, ierr)
Definition mpi.f:549
mpi_irecv
subroutine mpi_irecv(buf, cnt, datatype, source, tag, comm, ireq, ierr)
Definition mpi.f:372
ifront_mod
Definition ifront_mod.F:31
ifront_mod::icomm2_rcv
integer, dimension(:), allocatable icomm2_rcv
Definition ifront_mod.F:39
ifront_mod::req_recv_msg
integer, dimension(:), allocatable req_recv_msg
Definition ifront_mod.F:40
ifront_mod::nb_to_recv
integer nb_to_recv
Definition ifront_mod.F:36
ifront_mod::proc_list
integer, dimension(:), allocatable proc_list
Definition ifront_mod.F:37
ifront_mod::icomm2_send
integer, dimension(:), allocatable icomm2_send
Definition ifront_mod.F:39
ifront_mod::req_send_msg
integer, dimension(:), allocatable req_send_msg
Definition ifront_mod.F:41
ifront_mod::nisubg
integer nisubg
Definition ifront_mod.F:36
ifront_mod::req_recv_siz
integer, dimension(:), allocatable req_recv_siz
Definition ifront_mod.F:40
ifront_mod::ircom
integer, dimension(:), allocatable ircom
Definition ifront_mod.F:42
ifront_mod::sizbuf_r
type(int_pointer), dimension(:), allocatable sizbuf_r
Definition ifront_mod.F:35
ifront_mod::iscoms
integer, dimension(:), allocatable iscoms
Definition ifront_mod.F:42
ifront_mod::icomm
integer icomm
Definition ifront_mod.F:36
ifront_mod::sizbuf_s
type(int_pointer), dimension(:), allocatable sizbuf_s
Definition ifront_mod.F:35
ifront_mod::req_send_siz
integer, dimension(:), allocatable req_send_siz
Definition ifront_mod.F:41
ifront_mod::icomm2
integer, dimension(:), allocatable icomm2
Definition ifront_mod.F:38
ifront_mod::iscom
integer, dimension(:), allocatable iscom
Definition ifront_mod.F:42
ifront_mod::msgbuf_r
type(int_pointer), dimension(:), allocatable msgbuf_r
Definition ifront_mod.F:34
ifront_mod::msgbuf_s
type(int_pointer), dimension(:), allocatable msgbuf_s
Definition ifront_mod.F:34
message_mod
Definition message_mod.F:1257
tri25ebox::nisubsfie
type(int_pointer), dimension(:), allocatable nisubsfie
Definition tri25ebox.F:103
tri25ebox::islen25e
integer islen25e
Definition tri25ebox.F:79
tri25ebox::inflg_subsfie
type(int_pointer), dimension(:), allocatable inflg_subsfie
Definition tri25ebox.F:111
tri25ebox::islen25et
integer islen25et
Definition tri25ebox.F:81
tri25ebox::irlen25et
integer irlen25et
Definition tri25ebox.F:81
tri25ebox::irlen25
integer irlen25
Definition tri25ebox.F:78
tri25ebox::irlen25t
integer irlen25t
Definition tri25ebox.F:80
tri25ebox::lisubsfie
type(int_pointer), dimension(:), allocatable lisubsfie
Definition tri25ebox.F:107
tri25ebox::addsubsfie
type(int_pointer), dimension(:), allocatable addsubsfie
Definition tri25ebox.F:115
tri25ebox::islen25t
integer islen25t
Definition tri25ebox.F:80
tri25ebox::islen25
integer islen25
Definition tri25ebox.F:78
tri25ebox::irlen25e
integer irlen25e
Definition tri25ebox.F:79
tri7box::inflg_subsfi
type(int_pointer), dimension(:), allocatable inflg_subsfi
Definition tri7box.F:505
tri7box::nsvsi
type(int_pointer), dimension(:), allocatable nsvsi
Definition tri7box.F:485
tri7box::nsnfie
type(int_pointer), dimension(:), allocatable nsnfie
Definition tri7box.F:440
tri7box::nsnsie
type(int_pointer), dimension(:), allocatable nsnsie
Definition tri7box.F:491
tri7box::lisubsfi
type(int_pointer), dimension(:), allocatable lisubsfi
Definition tri7box.F:501
tri7box::nsvsie
type(int_pointer), dimension(:), allocatable nsvsie
Definition tri7box.F:485
tri7box::nsnsi
type(int_pointer), dimension(:), allocatable nsnsi
Definition tri7box.F:491
tri7box::nisubsfi
type(int_pointer), dimension(:), allocatable nisubsfi
Definition tri7box.F:497
tri7box::nsvfi
type(int_pointer), dimension(:), allocatable nsvfi
Definition tri7box.F:431
tri7box::nsvfie
type(int_pointer), dimension(:), allocatable nsvfie
Definition tri7box.F:440
tri7box::addsubsfi
type(int_pointer), dimension(:), allocatable addsubsfi
Definition tri7box.F:509
tri7box::nsnfi
type(int_pointer), dimension(:), allocatable nsnfi
Definition tri7box.F:440
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:895
arret
subroutine arret(nn)
Definition arret.F:86