41 1 IPARI ,NEWFRONT,ISENDTO ,IRCVFROM,
42 2 NSENSOR ,NBINTC ,INTLIST ,ISLEN7 ,IRLEN7 ,
43 3 ISLEN11 ,IRLEN11 ,ISLEN17 ,IRLEN17 ,IRLEN7T ,
44 4 ISLEN7T ,IRLEN20 ,ISLEN20 ,IRLEN20T,ISLEN20T,
45 5 IRLEN20E,ISLEN20E,SENSOR_TAB,INTBUF_TAB, MODE)
58 USE spmd_comm_world_mod,
ONLY : spmd_comm_world
59#include "implicit_f.inc"
76 INTEGER ,
INTENT(IN) :: NSENSOR
77 INTEGER NBINTC,ISLEN7,IRLEN7,ISLEN11,IRLEN11,ISLEN17,,
78 . IRLEN7T,ISLEN7T,IRLEN20,ISLEN20 ,IRLEN20T,ISLEN20T,
80 . IPARI(NPARI,NINTER),
81 . newfront(*), intlist(*),
82 . isendto(ninter+1,*) ,ircvfrom(ninter+1,*)
84 TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
85 TYPE (SENSOR_STR_) ,
DIMENSION(NSENSOR) ,
INTENT(IN) :: SENSOR_TAB
91 . P, I, J, L, NIN ,IDEB, IDEB2, IDEB3, II,
92 . LENOUT, I0, NS, INTTH,
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,
101 INTEGER :: SIZ,IDEB_EDGE,NB_SUBINT
102 INTEGER :: INDEX_PROC
103 LOGICAL :: ONLY_INTER_7
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.
188 IF(ity == 7.OR.ity == 11.OR.ity == 24.OR.ity == 25)
THEN
189 isens = ipari(64,nin)
192 ts = sensor_tab(isens)%TSTART
193 IF (tt>=ts) interact = 1
195 startt= intbuf_tab(nin)%VARIABLES(3)
196 stopt = intbuf_tab(nin)%VARIABLES(11)
197 IF (startt<=tt.AND.tt<=stopt) interact = 1
200 dist = intbuf_tab(nin)%VARIABLES(5)
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
217 intbuf_tab(nin)%VARIABLES(5) = -dist
224 len =
nsnfi(nin)%P(p)
229 IF (ipari(36,nin)>0.AND.ipari(7,nin)/=17)
THEN
233 IF(ipari(7,nin)==25.AND. ipari(58,nin) > 0)
THEN
242 IF (ity == 20 .OR. (ity == 25.AND. ipari(58,nin) > 0))
THEN
266 only_inter_7 = .true.
267 IF (p/=loc_proc)
THEN
271 IF(newfront(nin)==2)
THEN
272 IF(isendto(nin,p)/=0.OR.ircvfrom(nin,p)/=0)
THEN
274 IF(ity/=7.AND.ity/=11) only_inter_7 = .false.
276 IF(isendto(nin,p)/=0.AND.ircvfrom(nin,loc_proc)/=0)
icomm2_send(p) = 1
277 IF(ircvfrom(nin,p)/=0.AND.isendto(nin,loc_proc)/=0)
icomm2_rcv(p) = 1
280 IF(.NOT.only_inter_7)
THEN
289 s
sizbuf_s(p)%P(1),l,mpi_integer,it_spmd(p),msgtyp,
304 . mpi_integer,it_spmd(p),
321 ALLOCATE(
msgbuf_s(p)%P(len),stat=ierror)
324 CALL ancmsg(msgid=20,anmode=aninfo)
331 IF(newfront(nin)==2)
THEN
332 IF(
nsnfi(nin)%P(p)>0)
THEN
334 len =
nsnfi(nin)%P(p)
338 idebut(nin) = idebut(nin) + len
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
347 assert(
nsvfie(nin)%P(ideb2+i) > 0)
350 idebut2(nin) = idebut2(nin) + len
358 s
msgbuf_s(p)%P(1),ideb,mpi_integer,it_spmd(p),msgtyp,
364 ELSEIF( mode == 2 )
THEN
389 IF(newfront(nin) == 2)
THEN
390 IF(isendto(nin,loc_proc)/=0.OR.
391 . ircvfrom(nin,loc_proc)/=0)
THEN
393 nsnsi(nin)%P(p) = len
395 IF(ity == 20 .OR. (ity == 25.AND. ipari(58,nin) > 0))
THEN
405 ALLOCATE(
msgbuf_r(p)%P(len),stat=ierror)
407 CALL ancmsg(msgid=20,anmode=aninfo)
441 IF(newfront(nin)==2)
THEN
443 IF(
ASSOCIATED(
nsvsi(nin)%P))
DEALLOCATE(
nsvsi(nin)%P)
446 len = len +
nsnsi(nin)%P(p)
449 IF(len>0)
ALLOCATE(
nsvsi(nin)%P(len),stat=ierror)
451 CALL ancmsg(msgid=20,anmode=aninfo)
455 len =
nsnsi(nin)%P(p)
463 idebut(p) = idebut(p) + len
467 IF(ipari(7,nin) == 20 .OR. (ipari(7,nin) == 25.AND. ipari(58,nin) > 0) )
THEN
472 len = len +
nsnsie(nin)%P(p)
475 IF(len>0)
ALLOCATE(
nsvsie(nin)%P(len),stat=ierror)
477 CALL ancmsg(msgid=20,anmode=aninfo)
491 idebut(p) = idebut(p) + len
526 IF(newfront(nin)==2.AND.ipari(36,nin)>0.AND.
527 + ipari(7,nin)/=17)
THEN
530 len =
nsnsi(nin)%P(p)
534 ns =
nsvsi(nin)%P(ideb+i)
536 lenout = lenout + intbuf_tab(nin)%ADDSUBS(ns+1)-
537 . intbuf_tab(nin)%ADDSUBS(ns) + 1
541 isubtmp(nin,1,p) = lenout
543 IF(ipari(7,nin) ==25 .AND. ipari(58,nin) > 0)
THEN
551 ns =
nsvsie(nin)%P(ideb+i)
553 lenout = lenout + intbuf_tab(nin)%ADDSUBE
554 . intbuf_tab(nin)%ADDSUBE(ns) + 1
561 isubtmp(nin,2,p) = lenout
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)
577 IF(newfront(nin)==2.AND.ipari(36,nin)>0.AND.
578 + ipari(7,nin)==25)
THEN
580 lenout = lenout + 2*isubtmp(nin,2,p) -
nsnsie(nin)%P(p)
588 ALLOCATE(
msgbuf_s(p)%P(lenout),stat=ierror)
590 CALL ancmsg(msgid=20,anmode=aninfo)
596 s isubtmp(1,1,p),siz,mpi_integer,it_spmd(p),msgtyp,
597 g spmd_comm_world,req_s
610 CALL mpi_recv(isubtmp2(1,1,p),siz,mpi_integer,it_spmd(p),
611 . msgtyp,spmd_comm_world,status,ierror)
615 IF(newfront(nin)==2.AND.ipari(36,nin)>0.AND.
616 + ipari(7,nin)/=17)
THEN
618 nb_subint = isubtmp2(nin,1,p) -
nsnfi(nin)%P(p)
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
624 IF(ipari(7,nin)==25)
THEN
625 IF(ipari(58,nin) /= 0)
THEN
628 lenout = lenout + 2*isubtmp2(nin,2,p) -
nsnfie(nin)%P(p)
637 ALLOCATE(
msgbuf_r(p)%P(lenout),stat=ierror)
639 CALL ancmsg(msgid=20,anmode=aninfo)
650 CALL mpi_wait(req_s(p),status,ierror)
662 IF(newfront(nin)==2.AND.ipari(36,nin)>0.AND.
663 + ipari(7,nin)/=17)
THEN
666 len =
nsnsi(nin)%P(p)
670 ns =
nsvsi(nin)%P(ideb+i)
673 msgbuf_s(p)%P(i0) = intbuf_tab(nin)%ADDSUBS(ns+1)-
674 . intbuf_tab(nin)%ADDSUBS
676 DO j = intbuf_tab(nin)%ADDSUBS(ns),
677 . intbuf_tab(nin)%ADDSUBS(ns+1)-1
679 msgbuf_s(p)%P(i0) = intbuf_tab(nin)%LISUBS(j)
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
685 msgbuf_s(p)%P(i0) = intbuf_tab(nin)%INFLG_SUBS(j)
693 IF(ipari(7,nin) == 25 .AND. ipari(58,nin) /= 0)
THEN
701 ns =
nsvsie(nin)%P(ideb_edge+i)
704 msgbuf_s(p)%P(i0) = intbuf_tab(nin)%ADDSUBE(ns+1)-
705 . intbuf_tab(nin)%ADDSUBE(ns)
709 DO j = intbuf_tab(nin)%ADDSUBE(ns),
710 . intbuf_tab(nin)%ADDSUBE(ns+1)-1
712 msgbuf_s(p)%P(i0) = intbuf_tab(nin)%LISUBE(j)
715 DO j = intbuf_tab(nin)%ADDSUBE(ns),
716 . intbuf_tab(nin)%ADDSUBE(ns+1)-1
718 msgbuf_s(p)%P(i0) = intbuf_tab(nin)%INFLG_SUBE(j)
723 ideb_edge = ideb_edge + len
737 g spmd_comm_world,req_s(p),ierror)
750 . msgtyp,spmd_comm_world,status,ierror)
765 IF(newfront(nin)==2.AND.ipari(36,nin)>0.AND.
766 + ipari(7,nin)/=17)
THEN
774 ALLOCATE(
lisubsfi(nin)%P(len),stat=ierror)
776 CALL ancmsg(msgid=20,anmode=aninfo)
779 IF(ipari(7,nin) == 7.OR.ipari(7,nin) == 11.OR.ipari
THEN
783 CALL ancmsg(msgid=20,anmode=aninfo)
791 len = len +
nsnfi(nin)%P(p)
793 ALLOCATE(
addsubsfi(nin)%P(len),stat=ierror)
795 CALL ancmsg(msgid=20,anmode=aninfo)
803 DO i = 1,
nsnfi(nin)%P(p)
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
818 idebut(p) = idebut(p) + len
822 ideb3 = ideb3 +
nsnfi(nin)%P(p)
830 len = len +
nsnfi(nin)%P(p)
832 ALLOCATE(
addsubsfi(nin)%P(len),stat=ierror)
834 CALL ancmsg(msgid=20,anmode=aninfo)
840 DO i = 1,
nsnfi(nin)%P(p)
844 ideb3 = ideb3 +
nsnfi(nin)%P(p)
847 IF(ipari(7,nin) == 25 .AND. ipari(58,nin) > 0)
THEN
857 ALLOCATE(
lisubsfie(nin)%P(len),stat=ierror)
859 CALL ancmsg(msgid=20,anmode=aninfo)
862 IF(ipari(7,nin)==25)
THEN
866 CALL ancmsg(msgid=20,anmode=aninfo)
874 len = len +
nsnfie(nin)%P(p)
879 CALL ancmsg(msgid=20,anmode=aninfo)
887 DO i = 1,
nsnfie(nin)%P(p)
899 idebut(p) = idebut(p) + len + 1
905 idebut(p) = idebut(p) + len
908 ideb3 = ideb3 +
nsnfie(nin)%P(p)
916 len = len +
nsnfie(nin)%P(p)
920 CALL ancmsg(msgid=20,anmode=aninfo)
926 DO i = 1,
nsnfie(nin)%P(p)
930 ideb3 = ideb3 +
nsnfie(nin)%P(p)
939 CALL mpi_wait(req_s(p),status,ierror)
978 IF(newfront(nin)==2) newfront(nin)=0
980 intth = ipari(47,nin)
983 IF(ityp==7.OR.ityp==10.OR.ityp==22.OR.
984 . ityp==23.OR.ityp==24)
THEN
987 islen7 = islen7 +
nsnsi(nin)%P(p)
988 irlen7 = irlen7 +
nsnfi(nin)%P(p)
993 islen7t = islen7t +
nsnsi(nin)%P(p)
994 irlen7t = irlen7t +
nsnfi(nin)%P(p)
997 ELSEIF(ityp == 11)
THEN
1000 islen11 = islen11 +
nsnsi(nin)%P(p)
1001 irlen11 = irlen11 +
nsnfi(nin)%P(p)
1004 ELSEIF(ityp == 17)
THEN
1006 islen17 = islen17 +
nsnsi(nin)%P(p)
1007 irlen17 = irlen17 +
nsnfi(nin)%P(p)
1009 ELSEIF(ityp == 20)
THEN
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)
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)
1026 ELSEIF(ityp == 25)
THEN
1028 iedge = ipari(58,nin)
1033 IF( iedge /= 0)
THEN
1042 IF( iedge /= 0)
THEN
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)