46
47
48
53 USE intbufdef_mod
54 USE sensor_mod
55
56
57
58 USE spmd_comm_world_mod, ONLY : spmd_comm_world
59#include "implicit_f.inc"
60
61
62
63#include "spmd.inc"
64
65
66
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"
73
74
75
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
86
87
88
89#ifdef MPI
90 INTEGER NSEG, LEN, NI, ITYP, OLD_LEN,
91 . N, P, I, J, K, L, PP, NIN ,IDEB, IDEB2, IDEB3, II,
92 . LENOUT, I0, NS, INTTH,
93 . NOINT, MULTIMP, ITY, I_STOK_G, ISTK,
94 . SIZE, ALEN, LOC_PROC, MSGTYP,
95 . MSGOFF, MSGOFF2, MSGOFF3, ,
96 . IERROR, IERROR2, IDEBUT(NSPMD+NINTER),
97 . STATUS(MPI_STATUS_SIZE),REQ_S(NSPMD),
98 . ISUBTMP(NINTER,2,NSPMD),(NINTER,2,NSPMD),
99 . IDEBUT2(NINTER), ISENS,INTERACT,
100 .
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
109
111 . startt,gap,maxbox,minbox,stopt,dist,tzinf,dist0,
112 . xmax,
ymax, zmax, xmin, ymin, zmin,ts
113
114
115
116 IF(nspmd==1) RETURN
117 loc_proc = ispmd+1
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138 IF(mode == 1) THEN
139
141
142
143
154
155
156
157
158 DO p=1,nspmd
163 ENDDO
164 ENDIF
165
166
172
173
174
176 l = 0
177 SIZE = 4+2*nspmd
178 DO ii = 1, nbintc
179 nin = intlist(ii)
180 ity=ipari(7,nin)
181 IF(ity==7.OR.ity==10.OR.
182 . ity==22.OR.ity==23.OR.ity==24.OR.
183 . ity==20.OR.ity==11.OR.ity==17.OR.
184 . ity==25) THEN
185
186
187 interact = 0
188 isens = 0
189 IF(ity == 7.OR.ity == 11.OR.ity == 24.OR.ity == 25) THEN
190 isens = ipari(64,nin)
191 ENDIF
192 IF (isens > 0) THEN
193 ts = sensor_tab(isens)%TSTART
194 IF (tt>=ts) interact = 1
195 ELSE
196 startt= intbuf_tab(nin)%VARIABLES(3)
197 stopt = intbuf_tab(nin)%VARIABLES(11)
198 IF (startt<=tt.AND.tt<=stopt) interact = 1
199 ENDIF
200
201 dist = intbuf_tab(nin)%VARIABLES(5)
202
203
204
205
206
207
208 IF (ity == 25 .OR. (dist<=zero.AND.interact/=0))THEN
209 IF(isendto(nin,loc_proc)/=0.OR.
210 . ircvfrom(nin,loc_proc)/=0) THEN
211
212 newfront(nin) = 2
213
214
215
216
218 intbuf_tab(nin)%VARIABLES(5) = -dist
219
220
221
222
223
224 DO p = 1, nspmd
225 len =
nsnfi(nin)%P(p)
226
229 ENDDO
230 IF (ipari(36,nin)>0.AND.ipari(7,nin)/=17) THEN
232 DO p=1,nspmd
234 IF(ipari(7,nin)==25.AND. ipari(58,nin) > 0) THEN
236 ENDIF
237 ENDDO
238 END IF
239
240
241
242 ity=ipari(7,nin)
243 IF (ity == 20 .OR. (ity == 25.AND. ipari(58,nin) > 0)) THEN
244 DO p = 1, nspmd
248 END DO
249 ELSE
250 DO p = 1, nspmd
252 END DO
253 END IF
254
255 l = l + SIZE
256 ENDIF
257 ENDIF
258 ENDIF
259 ENDDO
260
261
262
263 DO p = 1, nspmd
267 only_inter_7 = .true.
268 IF (p/=loc_proc) THEN
269 DO ii = 1, nbintc
270 nin = intlist(ii)
271 ity=ipari(7,nin)
272 IF(newfront(nin)==2) THEN
273 IF(isendto(nin,p)/=0.OR.ircvfrom(nin,p)/=0) THEN
275 IF(ity/=7.AND.ity/=11) only_inter_7 = .false.
276 ENDIF
277 IF(isendto(nin,p)/=0.AND.ircvfrom(nin,loc_proc)/=0)
icomm2_send(p) = 1 ! nsn > 0 on p & nmn > 0 on ispmd
278 IF(ircvfrom(nin,p)/=0.AND.isendto(nin,loc_proc)/=0)
icomm2_rcv(p) = 1
279 ENDIF
280 ENDDO
281 IF(.NOT.only_inter_7) THEN
284 ENDIF
285 END IF
287 msgtyp = msgoff
288 l = 2*nbintc
290 s
sizbuf_s(p)%P(1),l,mpi_integer,it_spmd(p),msgtyp,
292 ENDIF
293 ENDDO
294
295
297 DO p = 1, nspmd
300 msgtyp = msgoff
303 l = 2 * nbintc
305 . mpi_integer,it_spmd(p),
307
308 ENDIF
309 ENDDO
310
311
313 DO ii = 1, nbintc
314 i = intlist(ii)
315 idebut(i) = 0
316 idebut2(i) = 0
317 ENDDO
318 DO p = 1, nspmd
320 IF(len/=0) THEN
321
322 ALLOCATE(
msgbuf_s(p)%P(len),stat=ierror)
323
324 IF(ierror/=0) THEN
325 CALL ancmsg(msgid=20,anmode=aninfo)
327 ENDIF
328 ideb = 0
329 DO ii = 1, nbintc
330 nin = intlist(ii)
331
332 IF(newfront(nin)==2) THEN
333 IF(
nsnfi(nin)%P(p)>0)
THEN
334 ideb2 = idebut(nin)
335 len =
nsnfi(nin)%P(p)
336 DO i = 1, len
338 ENDDO
339 idebut(nin) = idebut(nin) + len
340 ideb = ideb + len
341 ENDIF
342 IF(ipari(7,nin) == 20 .OR. (ipari(7,nin) == 25.AND. ipari(58,nin) > 0))THEN
343 IF(
nsnfie(nin)%P(p)>0)
THEN
344 ideb2 = idebut2(nin)
346
347 DO i = 1, len
348 assert(
nsvfie(nin)%P(ideb2+i) > 0)
350 ENDDO
351 idebut2(nin) = idebut2(nin) + len
352 ideb = ideb + len
353 ENDIF
354 END IF
355 ENDIF
356 ENDDO
357 msgtyp = msgoff2
359 s
msgbuf_s(p)%P(1),ideb,mpi_integer,it_spmd(p),msgtyp,
361 ENDIF
362 ENDDO
363 ENDIF
364
365 ELSEIF( mode == 2 ) THEN
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
384
385
387 DO ii = 1, nbintc
388 nin = intlist(ii)
389 ity=ipari(7,nin)
390 IF(newfront(nin) == 2) THEN
391 IF(isendto(nin,loc_proc)/=0.OR.
392 . ircvfrom(nin,loc_proc)/=0) THEN
394 nsnsi(nin)%P(p) = len
396 IF(ity == 20 .OR. (ity == 25.AND. ipari(58,nin) > 0))THEN
400 END IF
401 ENDIF
402 ENDIF
403 ENDDO
405 IF(len>0) THEN
406 ALLOCATE(
msgbuf_r(p)%P(len),stat=ierror)
407 IF(ierror/=0) THEN
408 CALL ancmsg(msgid=20,anmode=aninfo)
410 ENDIF
411 msgtyp = msgoff2
414
415 ENDIF
416 ENDDO
417
418
419
420
421
422
423
426 ENDDO
427 DO p = 1, nspmd
430 ENDIF
431 ENDDO
432
434
435 DO p = 1, nspmd
436 idebut(p) = 0
437 ENDDO
438
439 DO ii = 1, nbintc
440 nin = intlist(ii)
441
442 IF(newfront(nin)==2) THEN
443 ideb = 0
444 IF(
ASSOCIATED(
nsvsi(nin)%P))
DEALLOCATE(
nsvsi(nin)%P)
445 len = 0
446 DO p = 1, nspmd
447 len = len +
nsnsi(nin)%P(p)
448 ENDDO
449 ierror = 0
450 IF(len>0)
ALLOCATE(
nsvsi(nin)%P(len),stat=ierror)
451 IF(ierror/=0) THEN
452 CALL ancmsg(msgid=20,anmode=aninfo)
454 ENDIF
455 DO p = 1, nspmd
456 len =
nsnsi(nin)%P(p)
457
458 IF(len>0) THEN
459 ideb2 = idebut(p)
460 DO i = 1, len
462 ENDDO
463 ideb = ideb + len
464 idebut(p) = idebut(p) + len
465 ENDIF
466 ENDDO
467
468 IF(ipari(7,nin) == 20 .OR. (ipari(7,nin) == 25.AND. ipari(58,nin) > 0) )THEN
469 ideb = 0
471 len = 0
472 DO p = 1, nspmd
473 len = len +
nsnsie(nin)%P(p)
474 ENDDO
475 ierror = 0
476 IF(len>0)
ALLOCATE(
nsvsie(nin)%P(len),stat=ierror)
477 IF(ierror/=0) THEN
478 CALL ancmsg(msgid=20,anmode=aninfo)
480 ENDIF
481 DO p = 1, nspmd
483
484 IF(len>0) THEN
485
486 ideb2 = idebut(p)
487 DO i = 1, len
490 ENDDO
491 ideb = ideb + len
492 idebut(p) = idebut(p) + len
493 ENDIF
494 ENDDO
495 END IF
496 ENDIF
497 ENDDO
498
499 DO p = 1, nspmd
502 ENDIF
506 ENDIF
507 ENDDO
508
509
511
512
513
514
515 DO p = 1, nspmd
517 DO ii = 1, nbintc
518 i = intlist(ii)
519 isubtmp(i,1,p) = 0
520 isubtmp(i,2,p) = 0
521 END DO
522 END IF
523 END DO
524 DO ii = 1, nbintc
525 nin = intlist(ii)
526
527 IF(newfront(nin)==2.AND.ipari(36,nin)>0.AND.
528 + ipari(7,nin)/=17) THEN
529 ideb = 0
530 DO p = 1, nspmd
531 len =
nsnsi(nin)%P(p)
532 lenout = 0
533 IF(len>0) THEN
534 DO i = 1, len
535 ns =
nsvsi(nin)%P(ideb+i)
536
537 lenout = lenout + intbuf_tab(nin)%ADDSUBS(ns+1)-
538 . intbuf_tab(nin)%ADDSUBS(ns) + 1
539 END DO
540 ideb = ideb + len
541 END IF
542 isubtmp(nin,1,p) = lenout
543 ENDDO
544 IF(ipari(7,nin) ==25 .AND. ipari(58,nin) > 0) THEN
545 ideb = 0
546 DO p=1,nspmd
547
549 lenout = 0
550 IF(len>0) THEN
551 DO i = 1, len
552 ns =
nsvsie(nin)%P(ideb+i)
553
554 lenout = lenout + intbuf_tab(nin)%ADDSUBE(ns+1)-
555 . intbuf_tab(nin)%ADDSUBE(ns) + 1
556
557
558 END DO
559 ideb = ideb + len
560 END IF
561
562 isubtmp(nin,2,p) = lenout
563 END DO
564 ENDIF
565 END IF
566 END DO
567
568 DO p = 1, nspmd
570 lenout = 0
571 DO ii = 1, nbintc
572 nin = intlist(ii)
573 lenout = lenout + isubtmp(nin,1,p)
574 IF(newfront(nin)==2.AND.ipari(36,nin)>0.AND.
575 + (ipari(7,nin) == 7.OR.ipari(7,nin) == 11.OR.ipari(7,nin) == 24.OR.ipari(7,nin) == 25)) THEN
576 lenout = lenout + isubtmp(nin,1,p) -
nsnsi(nin)%P(p)
577 ENDIF
578 IF(newfront(nin)==2.AND.ipari(36,nin)>0.AND.
579 + ipari(7,nin)==25) THEN
580 IF(ipari(58,nin) /= 0) THEN
581 lenout = lenout + 2*isubtmp(nin
582 ENDIF
583 ENDIF
584 END DO
585
587 IF(lenout>0) THEN
588
589 ALLOCATE(
msgbuf_s(p)%P(lenout),stat=ierror)
590 IF(ierror/=0) THEN
591 CALL ancmsg(msgid=20,anmode=aninfo)
593 END IF
594 msgtyp = msgoff3
595 siz = ninter * 2
597 s isubtmp(1,1,p),siz,mpi_integer,it_spmd(p),msgtyp,
598 g spmd_comm_world,req_s(p),ierror)
599 END IF
600 END IF
601 END DO
602
603
604
605 DO p = 1, nspmd
607 msgtyp = msgoff3
608 lenout = 0
609 siz = ninter * 2
610
611 CALL mpi_recv(isubtmp2(1,1,p),siz,mpi_integer,it_spmd(p),
612 . msgtyp,spmd_comm_world,status,ierror)
613 DO ii = 1, nbintc
614 nin = intlist(ii)
615
616 IF(newfront(nin)==2.AND.ipari(36,nin)>0.AND.
617 + ipari(7,nin)/=17) THEN
618
619 nb_subint = isubtmp2(nin,1,p) -
nsnfi(nin)%P(p)
621 lenout = lenout + isubtmp2(nin,1,p)
622 IF(ipari(7,nin) == 7.OR.ipari(7,nin) == 11.OR.ipari(7,nin) == 24.OR.ipari(7,nin) == 25) THEN
623 lenout = lenout + nb_subint
624 ENDIF
625 IF(ipari(7,nin)==25) THEN
626 IF(ipari(58,nin) /= 0) THEN
628
629 lenout = lenout + 2*isubtmp2(nin,2,p) -
nsnfie(nin)%P(p)
630
631 ENDIF
632 ENDIF
633 END IF
634 END DO
635
637 IF(lenout>0) THEN
638 ALLOCATE(
msgbuf_r(p)%P(lenout),stat=ierror)
639 IF(ierror/=0) THEN
640 CALL ancmsg(msgid=20,anmode=aninfo)
642 ENDIF
643 END IF
644 ELSE
646 END IF
647 END DO
648
649 DO p = 1, nspmd
651 CALL mpi_wait(req_s(p),status,ierror)
652 END IF
653 END DO
654
655
656
657 DO p = 1, nspmd
658 idebut(p) = 0
659 END DO
660 DO ii = 1, nbintc
661 nin = intlist(ii)
662
663 IF(newfront(nin)==2.AND.ipari(36,nin)>0.AND.
664 + ipari(7,nin)/=17) THEN
665 ideb = 0
666 DO p = 1, nspmd
667 len =
nsnsi(nin)%P(p)
668 IF(len>0) THEN
669 i0 = idebut(p)
670 DO i = 1, len
671 ns =
nsvsi(nin)%P(ideb+i)
672 i0 = i0 + 1
673
674 msgbuf_s(p)%P(i0) = intbuf_tab(nin)%ADDSUBS(ns+1)-
675 . intbuf_tab(nin)%ADDSUBS(ns)
676
677 DO j = intbuf_tab(nin)%ADDSUBS(ns),
678 . intbuf_tab(nin)%ADDSUBS(ns+1)-1
679 i0 = i0 + 1
680 msgbuf_s(p)%P(i0) = intbuf_tab(nin)%LISUBS(j)
681 END DO
682 IF(ipari(7,nin) == 7.OR.ipari(7,nin) == 11.OR.ipari(7,nin) == 24.OR.ipari(7,nin) == 25) THEN
683 DO j = intbuf_tab(nin)%ADDSUBS(ns),
684 . intbuf_tab(nin)%ADDSUBS(ns+1)-1
685 i0 = i0 + 1
686 msgbuf_s(p)%P(i0) = intbuf_tab(nin)%INFLG_SUBS(j)
687 END DO
688 END IF
689 END DO
690 idebut(p) = i0
691 ideb = ideb + len
692 END IF
693 END DO
694 IF(ipari(7,nin) == 25 .AND. ipari(58,nin) /= 0)THEN
695 ideb_edge = 0
696 DO p = 1,nspmd
697
699 IF(len>0) THEN
700 i0 = idebut(p)
701 DO i = 1, len
702 ns =
nsvsie(nin)%P(ideb_edge+i)
703 i0 = i0 + 1
704
705 msgbuf_s(p)%P(i0) = intbuf_tab(nin)%ADDSUBE(ns+1)-
706 . intbuf_tab(nin)%ADDSUBE(ns)
707
708
709
710 DO j = intbuf_tab(nin)%ADDSUBE(ns),
711 . intbuf_tab(nin)%ADDSUBE(ns+1)-1
712 i0 = i0 + 1
713 msgbuf_s(p)%P(i0) = intbuf_tab(nin)%LISUBE(j)
714
715 END DO
716 DO j = intbuf_tab(nin)%ADDSUBE(ns),
717 . intbuf_tab(nin)%ADDSUBE(ns+1)-1
718 i0 = i0 + 1
719 msgbuf_s(p)%P(i0) = intbuf_tab(nin)%INFLG_SUBE(j)
720
721 END DO
722 END DO
723 idebut(p) = i0
724 ideb_edge = ideb_edge + len
725 END IF
726 END DO
727 ENDIF
728 END IF
729 END DO
730
731 DO p = 1, nspmd
732
734 msgtyp = msgoff4
735
738 g spmd_comm_world,req_s(p),ierror)
739 END IF
740 END DO
741
742
743
744 DO p = 1, nspmd
745
747 msgtyp = msgoff4
748
749
751 . msgtyp,spmd_comm_world,status,ierror)
752
753
754
755 END IF
756 END DO
757
758
759
760 DO p = 1, nspmd
761 idebut(p) = 0
762 END DO
763 DO ii = 1, nbintc
764 nin = intlist(ii)
765
766 IF(newfront(nin)==2.AND.ipari(36,nin)>0.AND.
767 + ipari(7,nin)/=17) THEN
769 len = 0
770 DO p = 1, nspmd
772 END DO
773 ierror = 0
774 IF(len>0) THEN
775 ALLOCATE(
lisubsfi(nin)%P(len),stat=ierror)
776 IF(ierror/=0) THEN
777 CALL ancmsg(msgid=20,anmode=aninfo)
779 END IF
780 IF(ipari(7,nin) == 7.OR.ipari(7,nin) == 11.OR.ipari(7,nin) == 24.OR.ipari(7,nin) == 25) THEN
783 IF(ierror/=0) THEN
784 CALL ancmsg(msgid=20,anmode=aninfo)
786 END IF
787 END IF
788 len = 1
791 DO p = 1, nspmd
792 len = len +
nsnfi(nin)%P(p)
793 END DO
794 ALLOCATE(
addsubsfi(nin)%P(len),stat=ierror)
795 IF(ierror/=0) THEN
796 CALL ancmsg(msgid=20,anmode=aninfo)
798 END IF
799 ideb = 0
800 ideb3 = 0
802 DO p = 1, nspmd
804 DO i = 1,
nsnfi(nin)%P(p)
805 ideb2 = idebut(p)
806 ideb2 = ideb2 + 1
810 DO j = 1, len
812 END DO
813 idebut(p) = idebut(p) + len + 1
814 IF(ipari(7,nin) == 7.OR.ipari(7,nin) == 11.OR.ipari(7,nin) == 24.OR.ipari(7,nin) == 25) THEN
815 ideb2 = ideb2 + len
816 DO j = 1, len
818 END DO
819 idebut(p) = idebut(p) + len
820 END IF
821 ideb = ideb + len
822 END DO
823 ideb3 = ideb3 +
nsnfi(nin)%P(p)
824 ENDIF
825 END DO
826 ELSE
827 len = 1
830 DO p = 1, nspmd
831 len = len +
nsnfi(nin)%P(p)
832 END DO
833 ALLOCATE(
addsubsfi(nin)%P(len),stat=ierror)
834 IF(ierror/=0) THEN
835 CALL ancmsg(msgid=20,anmode=aninfo)
837 END IF
838 ideb3 = 0
840 DO p = 1, nspmd
841 DO i = 1,
nsnfi(nin)%P(p)
844 END DO
845 ideb3 = ideb3 +
nsnfi(nin)%P(p)
846 END DO
847 END IF
848 IF(ipari(7,nin) == 25 .AND. ipari(58,nin) > 0) THEN
849
851 len = 0
852 DO p = 1, nspmd
854 END DO
855 ierror = 0
856
857 IF(len>0) THEN
858 ALLOCATE(
lisubsfie(nin)%P(len),stat=ierror)
859 IF(ierror/=0) THEN
860 CALL ancmsg(msgid=20,anmode=aninfo)
862 END IF
863 IF(ipari(7,nin)==25)THEN
866 IF(ierror/=0) THEN
867 CALL ancmsg(msgid=20,anmode=aninfo)
869 END IF
870 END IF
871 len = 1
874 DO p = 1, nspmd
875 len = len +
nsnfie(nin)%P(p)
876 END DO
878
879 IF(ierror/=0) THEN
880 CALL ancmsg(msgid=20,anmode=aninfo)
882 END IF
883 ideb = 0
884 ideb3 = 0
886 DO p = 1, nspmd
888 DO i = 1,
nsnfie(nin)%P(p)
889 ideb2 = idebut(p)
890 ideb2 = ideb2 + 1
892
895
896 DO j = 1, len
898
899 END DO
900 idebut(p) = idebut(p) + len + 1
901 ideb2 = ideb2 + len
902 DO j = 1, len
904
905 END DO
906 idebut(p) = idebut(p) + len
907 ideb = ideb + len
908 END DO
909 ideb3 = ideb3 +
nsnfie(nin)%P(p)
910 ENDIF
911 END DO
912 ELSE
913 len = 1
916 DO p = 1, nspmd
917 len = len +
nsnfi(nin)%P(p)
918 END DO
920 IF(ierror/=0) THEN
921 CALL ancmsg(msgid=20,anmode=aninfo)
923 END IF
924 ideb3 = 0
926 DO p = 1, nspmd
927 DO i = 1,
nsnfi(nin)%P(p)
930 END DO
931 ideb3 = ideb3 +
nsnfi(nin)%P(p)
932 END DO
933 END IF
934 ENDIF
935 END IF
936 END DO
937
938 DO p = 1, nspmd
940 CALL mpi_wait(req_s(p),status,ierror)
942 END IF
945 END IF
946 END DO
947
948 END IF
949
950
951
952 islen7 = 0
953 irlen7 = 0
954 islen7t = 0
955 irlen7t = 0
956 islen11 = 0
957 irlen11 = 0
958 islen17 = 0
959 irlen17 = 0
960 irlen20 = 0
961 islen20 = 0
962 irlen20t = 0
963 islen20t = 0
964 irlen20e = 0
965 islen20e = 0
966
975
976 DO ii = 1, nbintc
977 nin = intlist(ii)
978
979 IF(newfront(nin)==2) newfront(nin)=0
980 ityp = ipari(7,nin)
981 intth = ipari(47,nin)
982
983
984 IF(ityp==7.OR.ityp==10.OR.ityp==22.OR.
985 . ityp==23.OR.ityp==24)THEN
986 IF(intth == 0 ) THEN
987 DO p = 1, nspmd
988 islen7 = islen7 +
nsnsi(nin)%P(p)
989 irlen7 = irlen7 +
nsnfi(nin)%P(p)
990 END DO
991
992 ELSE
993 DO p = 1, nspmd
994 islen7t = islen7t +
nsnsi(nin)%P(p)
995 irlen7t = irlen7t +
nsnfi(nin)%P(p)
996 END DO
997 ENDIF
998 ELSEIF(ityp == 11) THEN
999
1000 DO p = 1, nspmd
1001 islen11 = islen11 +
nsnsi(nin)%P(p)
1002 irlen11 = irlen11 +
nsnfi(nin)%P(p)
1003 END DO
1004
1005 ELSEIF(ityp == 17) THEN
1006 DO p = 1, nspmd
1007 islen17 = islen17 +
nsnsi(nin)%P(p)
1008 irlen17 = irlen17 +
nsnfi(nin)%P(p)
1009 END DO
1010 ELSEIF(ityp == 20)THEN
1011
1012 IF(intth == 0) THEN
1013 DO p = 1, nspmd
1014 islen20 = islen20 +
nsnsi(nin)%P(p)
1015 irlen20 = irlen20 +
nsnfi(nin)%P(p)
1016 islen20e= islen20e+
nsnsie(nin)%P(p)
1017 irlen20e= irlen20e+
nsnfie(nin)%P(p)
1018 END DO
1019 ELSE
1020 DO p = 1, nspmd
1021 islen20t = islen20t +
nsnsi(nin)%P(p)
1022 irlen20t = irlen20t +
nsnfi(nin)%P(p)
1023 islen20e= islen20e+
nsnsie(nin)%P(p)
1024 irlen20e= irlen20e+
nsnfie(nin)%P(p)
1025 END DO
1026 ENDIF
1027 ELSEIF(ityp == 25)THEN
1028
1029 iedge = ipari(58,nin)
1030 IF(intth == 0) THEN
1031 DO p = 1, nspmd
1034 IF( iedge /= 0) THEN
1037 ENDIF
1038 END DO
1039 ELSE
1040 DO p = 1, nspmd
1043 IF( iedge /= 0) THEN
1046 ENDIF
1047 END DO
1048 ENDIF
1049
1050 END IF
1051 ENDDO
1052
1053
1054 ENDIF
1055
1056
1057
1058#endif
1059 RETURN
subroutine ymax(idn, fac, npc, pld, stiffmin, stiffmax, stiffini, stiffavg)
subroutine mpi_recv(buf, cnt, datatype, source, tag, comm, status, ierr)
subroutine mpi_isend(buf, cnt, datatype, dest, tag, comm, ireq, ierr)
subroutine mpi_wait(ireq, status, ierr)
subroutine mpi_waitany(cnt, array_of_requests, index, status, ierr)
subroutine mpi_irecv(buf, cnt, datatype, source, tag, comm, ireq, ierr)
integer, dimension(:), allocatable icomm2_rcv
integer, dimension(:), allocatable req_recv_msg
integer, dimension(:), allocatable proc_list
integer, dimension(:), allocatable icomm2_send
integer, dimension(:), allocatable req_send_msg
integer, dimension(:), allocatable req_recv_siz
integer, dimension(:), allocatable ircom
type(int_pointer), dimension(:), allocatable sizbuf_r
integer, dimension(:), allocatable iscoms
type(int_pointer), dimension(:), allocatable sizbuf_s
integer, dimension(:), allocatable req_send_siz
integer, dimension(:), allocatable icomm2
integer, dimension(:), allocatable iscom
type(int_pointer), dimension(:), allocatable msgbuf_r
type(int_pointer), dimension(:), allocatable msgbuf_s
type(int_pointer), dimension(:), allocatable nisubsfie
type(int_pointer), dimension(:), allocatable inflg_subsfie
type(int_pointer), dimension(:), allocatable lisubsfie
type(int_pointer), dimension(:), allocatable addsubsfie
type(int_pointer), dimension(:), allocatable inflg_subsfi
type(int_pointer), dimension(:), allocatable nsvsi
type(int_pointer), dimension(:), allocatable nsnfie
type(int_pointer), dimension(:), allocatable nsnsie
type(int_pointer), dimension(:), allocatable lisubsfi
type(int_pointer), dimension(:), allocatable nsvsie
type(int_pointer), dimension(:), allocatable nsnsi
type(int_pointer), dimension(:), allocatable nisubsfi
type(int_pointer), dimension(:), allocatable nsvfi
type(int_pointer), dimension(:), allocatable nsvfie
type(int_pointer), dimension(:), allocatable addsubsfi
type(int_pointer), dimension(:), allocatable nsnfi
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)