C***./ ADD NAME=GSUM
C PARALLEL UTILITY ROUTINES : PVM3.1  VERSION
      SUBROUTINE GSUM(X,NELEM)
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      DIMENSION X(*)
      PARAMETER(MDG=6,MDGBCK=7)
      COMMON/PARAL1/NPROC,NNPROC,IAM,MPOINT,ITASK
      PARAMETER (LIM001=300,LIM002=700,LIM003=60000,LIM004=60000,
     ,LIM005=1000,LIM007=500,LIM006=LIM007+LIM007-1,LIM008=2,
     ,LIM010=36000,LIM012=60000,LIM013=20000,LIM014=10,
     ,LIM015=300,LIM016=90,LIM018=48000,LIM019=200,
     ,LIM020=6,LIM021=700000,LIM024=16800,
     ,LIM025=3000,LIM026=8750,LIM027=410,LIM028=(LIM027+1)*LIM027/2,
     ,LIM030=70000,LIM031=2000,LIM033=8999,
     ,LIM039=25,LIM040=400,LIM041=15,LIM042=2000,LIM011=LIM016*LIM016,
     ,LIM045=LIM012+LIM012,
     ,NDFSQR=2*LIM002*LIM002,
     ,LIM022=LIM021*2,LIM049=50000,LIM050=LIM015*LIM015,
     *LIM071=8,LIM072=5,LIM073=17,LIM077=6000,
     *LIM079=500,LIM080=1600,LIM078=LIM080*3,LIM081=300,LIM082=450,
     *LIM083=LIM080*2,LIM088=20,LIM089=50000,
     *LIM090=16000,LIM091=96,LIM092=(LIM015+1)*LIM015/2,
     *LIM097=LIM021*3,LIM098=100,LIM099=250)
      PARAMETER (MXHOST=256)
      COMMON/PARPVM/MTID,MYTID,NPRCM1,ITIDS(0:MXHOST)
      COMMON /DGSUM/X1(LIM021)
      character*128 zzline
      IF(NPROC.EQ.1) RETURN
      NUP=(IAM-1)/2
      NLFT=IAM+IAM+1
      NRGT=IAM+IAM+2
      IF (NLFT.LT.NPROC) THEN
      CALL PVMFRECV(ITIDS(NLFT),MDG,INFO)
      CALL PVMFUNPACK(6,X1(1),NELEM,1,INFO)
ccc   call FtnFormatArray(zzline,x1(1),nelem,11,izz)
ccc   write(6,*) 'iam=',iam,': 1.Gsum.Recv from ',NLFT,
ccc  .   ', x1()=(',zzline(1:izz),')'
      write(6,*) 'iam=',iam,': 1.Gsum.Recv(',NLFT,',',NELEM,')'
      DO 1 I=1,NELEM
 1    X(I)=X(I)+X1(I)
      ENDIF
ccc   call FtnFormatArray(zzline,x(1),nelem,11,izz)
ccc   write(6,*) 'iam=',iam,': 2.Gsum',
ccc  .   ', x()=(',zzline(1:izz),')'
      IF (NRGT.LT.NPROC) THEN
      CALL PVMFRECV(ITIDS(NRGT),MDG,INFO)
      CALL PVMFUNPACK(6,X1(1),NELEM,1,INFO)
ccc   call FtnFormatArray(zzline,x1(1),nelem,11,izz)
ccc   write(6,*) 'iam=',iam,': 3.Gsum.Recv from ',NRGT,
ccc  .   ', x1()=(',zzline(1:izz),')'
      write(6,*) 'iam=',iam,': 3.Gsum.Recv(',NRGT,',',NELEM,')'
      DO 11 I=1,NELEM
11    X(I)=X(I)+X1(I)
ccc   call FtnFormatArray(zzline,x(1),nelem,11,izz)
ccc   write(6,*) 'iam=',iam,': 4.Gsum',
ccc  .   ', x()=(',zzline(1:izz),')'
      ENDIF
      CALL PVMFINITSEND(0,INFO)
      CALL PVMFPACK(6,X(1),NELEM,1,INFO)
      IF (IAM.NE.0) THEN
C
C     SEND TO UPPER NODE
C
      CALL PVMFSEND(ITIDS(NUP),MDG,INFO)
ccc   call FtnFormatArray(zzline,x1(1),nelem,11,izz)
ccc   write(6,*) 'iam=',iam,': 5.Gsum.Send to ',NUP,
ccc  .   ', x1()=(',zzline(1:izz),')'
      write(6,*) 'iam=',iam,': 5.Gsum.Send(',NUP,',',NELEM,')'
C
C     RECEIVE FINAL RESULT FROM MASTER
C
      CALL PVMFRECV(ITIDS(0),MDGBCK,INFO)
      CALL PVMFUNPACK(6,X(1),NELEM,1,INFO)
ccc   call FtnFormatArray(zzline,x1(1),nelem,11,izz)
ccc   write(6,*) 'iam=',iam,': 6.Gsum.Recv from 0',
ccc  .   ', x1()=(',zzline(1:izz),')'
      write(6,*) 'iam=',iam,': 6.Gsum.Recv(0,',NELEM,')'
      ELSE
C
C     MULTISEND FROM MASTER TO N-1 SLAVES FINAL RESULT
C
      CALL PVMFMCAST(NPRCM1,ITIDS(1),MDGBCK,INFO)
ccc   call FtnFormatArray(zzline,x1(1),nelem,11,izz)
ccc   write(6,*) 'iam=',iam,': 7.Gsum.Mcast from 0',
ccc  .   ', x1()=(',zzline(1:izz),')'
      write(6,*) 'iam=',iam,': 7.Gsum.Mcast(0,',NELEM,')'
      ENDIF
      RETURN
      END
C***./ ADD NAME=IGSUM
      SUBROUTINE IGSUM(IX,NELEM)
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      DIMENSION IX(*)
      PARAMETER(MDG=6,MDGBCK=7)
      COMMON/PARAL1/NPROC,NNPROC,IAM,MPOINT,ITASK
      PARAMETER (LIM001=300,LIM002=700,LIM003=60000,LIM004=60000,
     ,LIM005=1000,LIM007=500,LIM006=LIM007+LIM007-1,LIM008=2,
     ,LIM010=36000,LIM012=60000,LIM013=20000,LIM014=10,
     ,LIM015=300,LIM016=90,LIM018=48000,LIM019=200,
     ,LIM020=6,LIM021=700000,LIM024=16800,
     ,LIM025=3000,LIM026=8750,LIM027=410,LIM028=(LIM027+1)*LIM027/2,
     ,LIM030=70000,LIM031=2000,LIM033=8999,
     ,LIM039=25,LIM040=400,LIM041=15,LIM042=2000,LIM011=LIM016*LIM016,
     ,LIM045=LIM012+LIM012,
     ,NDFSQR=2*LIM002*LIM002,
     ,LIM022=LIM021*2,LIM049=50000,LIM050=LIM015*LIM015,
     *LIM071=8,LIM072=5,LIM073=17,LIM077=6000,
     *LIM079=500,LIM080=1600,LIM078=LIM080*3,LIM081=300,LIM082=450,
     *LIM083=LIM080*2,LIM088=20,LIM089=50000,
     *LIM090=16000,LIM091=96,LIM092=(LIM015+1)*LIM015/2,
     *LIM097=LIM021*3,LIM098=100,LIM099=250)
      PARAMETER (MXHOST=256)
      COMMON/PARPVM/MTID,MYTID,NPRCM1,ITIDS(0:MXHOST)
      COMMON /DGSUM/IX1(LIM021)
      character*128 zzline
      IF(NPROC.EQ.1) RETURN
      NUP=(IAM-1)/2
      NLFT=IAM+IAM+1
      NRGT=IAM+IAM+2
      IF (NLFT.LT.NPROC) THEN
      CALL PVMFRECV(ITIDS(NLFT),MDG,INFO)
      CALL PVMFUNPACK(3,IX1(1),NELEM,1,INFO)
ccc   call FtnFormatArray(zzline,ix1(1),nelem,6,izz)
ccc   write(6,*) 'iam=',iam,': 1.Igsum.Recv from ',NLFT,
ccc  .   ', ix1()=(',zzline(1:izz),')'
      write(6,*) 'iam=',iam,': 1.Igsum.Recv(',NLFT,',',NELEM,')'
      DO 1 I=1,NELEM
 1    IX(I)=IX(I)+IX1(I)
ccc   call FtnFormatArray(zzline,ix(1),nelem,6,izz)
ccc   write(6,*) 'iam=',iam,': 2.Igsum',
ccc  .   ', ix()=(',zzline(1:izz),')'
      ENDIF
      IF (NRGT.LT.NPROC) THEN
      CALL PVMFRECV(ITIDS(NRGT),MDG,INFO)
      CALL PVMFUNPACK(3,IX1(1),NELEM,1,INFO)
ccc   call FtnFormatArray(zzline,ix1(1),nelem,6,izz)
ccc   write(6,*) 'iam=',iam,': 3.Igsum.Recv from ',NRGT,
ccc  .   ', ix1()=(',zzline(1:izz),')'
      write(6,*) 'iam=',iam,': 3.Igsum.Recv(',NRGT,',',NELEM,')'
      DO 11 I=1,NELEM
11    IX(I)=IX(I)+IX1(I)
ccc   call FtnFormatArray(zzline,ix(1),nelem,6,izz)
ccc   write(6,*) 'iam=',iam,': 4.Igsum',
ccc  .   ', ix()=(',zzline(1:izz),')'
      ENDIF
      CALL PVMFINITSEND(0,INFO)
      CALL PVMFPACK(3,IX(1),NELEM,1,INFO)
      IF (IAM.NE.0) THEN
C
C     SEND TO UPPER NODE
C
      CALL PVMFSEND(ITIDS(NUP),MDG,INFO)
ccc   call FtnFormatArray(zzline,ix(1),nelem,6,izz)
ccc   write(6,*) 'iam=',iam,': 5.Igsum.Send to ',NUP,
ccc  .   ', ix()=(',zzline(1:izz),')'
      write(6,*) 'iam=',iam,': 5.Igsum.Send(',NUP,',',NELEM,')'
C
C     RECEIVE FINAL RESULT FROM MASTER
C
      CALL PVMFRECV(ITIDS(0),MDGBCK,INFO)
      CALL PVMFUNPACK(3,IX(1),NELEM,1,INFO)
ccc   call FtnFormatArray(zzline,ix(1),nelem,6,izz)
ccc   write(6,*) 'iam=',iam,': 6.Igsum.Recv from 0',
ccc  .   ', ix()=(',zzline(1:izz),')'
      write(6,*) 'iam=',iam,': 6.Igsum.Recv(0,',NELEM,')'
      ELSE
C
C     MULTISEND FROM MASTER TO N-1 SLAVES FINAL RESULT
C
      CALL PVMFMCAST(NPRCM1,ITIDS(1),MDGBCK,INFO)
ccc   call FtnFormatArray(zzline,ix(1),nelem,6,izz)
ccc   write(6,*) 'iam=',iam,': 7.Igsum.Mcast from 0',
ccc  .   ', ix()=(',zzline(1:izz),')'
      write(6,*) 'iam=',iam,': 7.Igsum.Mcast(0,',NELEM,')'
      ENDIF
      RETURN
      END
C***./ ADD NAME=INITPP
      SUBROUTINE INITPP
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      PARAMETER(MSGBGN=1,MSGCNF=2,MSGGO=5,MSGTRM=10,MSGDIR=33)
      PARAMETER (LIMPAR=50,LIMPRN=200,LIMFTN=100,LIMTOL=50,LIMINF=200)
      COMMON/PARINF/PAR(LIMPAR),LPRINT(LIMPRN),IUNIT(LIMFTN),
     *ITOL(LIMTOL),INF(LIMINF),ITIT(20),IIN,IOUT
      COMMON/PARAL1/NPROC,NNPROC,IAM,MPOINT,ITASK
      PARAMETER (MXHOST=256)
      COMMON/PARPVM/MTID,MYTID,NPRCM1,ITIDS(0:MXHOST)
      CHARACTER*1 NULL
      DATA NULL/' '/
      IIN=88
      IOUT=89
      MPOINT=0
      CALL SECOND(FT)
C
C  ENROLL THIS PROGRAM IN PVM
C
      CALL PVMFMYTID( MYTID )
C
C  GET THE MASTER'S TASK ID
C
      CALL PVMFPARENT( MTID )
      CALL PVMFRECV( MTID, MSGBGN, INFO )
      CALL PVMFUNPACK(3, NPROC, 1, 1, INFO )
      CALL PVMFUNPACK(3, ITIDS, NPROC, 1, INFO )
      NNPROC = -NPROC
      NPRCM1=NPROC-1
C
C     DETERMINE WHICH SLAVE I AM (0 -- NPROC-1)
C
      DO 5 I=0,NPRCM1
      IAM=I
      IF( ITIDS(I).EQ.MYTID)GOTO 9876
  5   CONTINUE
      CALL ERRVRS(0,'INITPP','INCORRECT TASK ID')
C
C SCRDIR.C: RECEIVES SCRATCH DIR FROM MASTER AND CHANGES CURRENT WORKING
C           DIRECTORY. RETURNS (1)SUCCESS OR (-1)FAILURE
C
9876  CALL SCRDIR(IANSW)
      IANSW=IANSW*(IAM+1)
C
C SEND RESPONSE TO MASTER
C
      CALL PVMFINITSEND(0,INFO)
      CALL PVMFPACK(3,IANSW,1,1,INFO)
      CALL PVMFSEND(MTID,MSGCNF,INFO)
C
C     WAIT FOR SIGNAL TO GO (ALL TMPDIR EXISTING)
C
      CALL PVMFRECV(MTID,MSGGO,INFO)
      CALL PVMFUNPACK(3,IGO,1,1,INFO)
      IF(IGO.EQ.0) THEN
C
C     ANSWER TO MASTER: TERM SIGNAL RECEIVED
C
       CALL PVMFINITSEND(0,INFO)
       CALL PVMFPACK(3,IANSW,1,1,INFO)
       CALL PVMFSEND(MTID,MSGTRM,INFO)
       CALL STOPPE
      ENDIF
      OPEN(UNIT=IIN,FILE='INPUT',FORM='FORMATTED')
      OPEN(UNIT=IOUT,FILE='OUTPUT',FORM='FORMATTED')
      CALL GCOPYF
      RETURN
      END
C***./ ADD NAME=STOPPE
      SUBROUTINE STOPPE
C... ERROR EXIT
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      CALL TIMVRS('ERR     ')
      CALL PVMFEXIT(INFO)
      STOP
      END
C***./ ADD NAME=STOPPP
      SUBROUTINE STOPPP
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      character*24   fdate
      external       fdate
      open(unit=100,file='listtime',access='append')
      write(100,*)' Stoppp ended at ', fdate()
      close(unit=100)
      CALL TIMVRS('END     ')
      CALL TREPOR
      JUNK=NXTVAL(0)
      CALL PVMFEXIT(INFO)
      STOP
      END
C***./ ADD NAME=GCOPYF
      SUBROUTINE GCOPYF
C **************************************************************
C COPY IIN ON NODE 0  TO IIN ON ALL NODES
C **************************************************************
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      PARAMETER (MSGINP=8)
      CHARACTER*80 REC80,NULL
      PARAMETER (LIMPAR=50,LIMPRN=200,LIMFTN=100,LIMTOL=50,LIMINF=200)
      COMMON/PARINF/PAR(LIMPAR),LPRINT(LIMPRN),IUNIT(LIMFTN),
     *ITOL(LIMTOL),INF(LIMINF),ITIT(20),IIN,IOUT
      COMMON/PARAL1/NPROC,NNPROC,IAM,MPOINT,ITASK
      PARAMETER (MXHOST=256)
      COMMON/PARPVM/MTID,MYTID,NPRCM1,ITIDS(0:MXHOST)
      DATA NULL/'                              '/
      IF(NPROC.NE.1)THEN
      IF(IAM.EQ.0) THEN
100   READ(IIN,1000,END=999) REC80
      WRITE(IOUT,1001) REC80
      CALL PVMFINITSEND( 0, INFO )
      CALL PVMFPACK(0, REC80, 80, 1, INFO )
      CALL PVMFMCAST(NPRCM1,ITIDS(1), MSGINP, INFO )
      GOTO 100
999   CALL PVMFINITSEND( 0, INFO )
      CALL PVMFPACK(0, NULL, 80, 1, INFO )
      CALL PVMFMCAST(NPRCM1,ITIDS(1), MSGINP, INFO )
      ELSE
300   CALL PVMFRECV(ITIDS(0), MSGINP, INFO )
      CALL PVMFUNPACK(0,REC80, 80, 1, INFO )
      IF(REC80.EQ.NULL) GOTO 200
      WRITE(IIN,1000)REC80
      GOTO 300
      ENDIF
200   CLOSE(UNIT=IIN)
      OPEN(UNIT=IIN,FILE='INPUT',FORM='FORMATTED')
      ENDIF
      RETURN
 1000 FORMAT(A80)
 1001 FORMAT(1X,A80)
      END
C***./ ADD NAME=IGPVAL
      SUBROUTINE IGPVAL
C IMPLEMENTS A GLOBAL POINTER
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      COMMON/PARAL1/NPROC,NNPROC,IAM,MPOINT,ITASK
      IF(NPROC.NE.1)MPOINT=NXTVAL(NPROC)
      MPOINT=MPOINT+1
      RETURN
      END
C***./ ADD NAME=IGPRST
      SUBROUTINE IGPRST
C RESETS THE GLOBAL POINTER
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      COMMON/PARAL1/NPROC,NNPROC,IAM,MPOINT,ITASK
      IF(NPROC.NE.1)THEN
      M=NXTVAL(NNPROC)
      ELSE
      MPOINT=0
      ENDIF
      RETURN
      END
C***./ ADD NAME=NXTVAL
      FUNCTION NXTVAL(MPROC)
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      PARAMETER (NXTVA=3,NXTVR=4)
      PARAMETER (MXHOST=256)
      COMMON/PARPVM/MTID,MYTID,NPRCM1,ITIDS(0:MXHOST)
      common/paral1/nproc,nnproc,iam,mpoint,itask
      CALL PVMFINITSEND(0,INFO)
      CALL PVMFPACK(3,MYTID,1,1,INFO)
      CALL PVMFPACK(3,MPROC,1,1,INFO)
      write(6,*) 'iam=',iam,' Try NxtVal(MPROC=',Mproc,')'
      CALL PVMFSEND(MTID,NXTVA,INFO)
C
C     WAIT FOR REPLY FROM MASTER
C
      CALL PVMFRECV(MTID,NXTVR,INFO)
      CALL PVMFUNPACK(3,NVAL,1,1,INFO)
      write(6,*) 'iam=',iam,' End NxtVal()=',NVAL
      NXTVAL=NVAL
      RETURN
      END
C***./ ADD NAME=TREPOR
      SUBROUTINE TREPOR
C COLLECT TOTAL CPU TIMES FROM ALL ACTIVE NODES
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      PARAMETER (MSGTIM=9)
      PARAMETER (LIMPAR=50,LIMPRN=200,LIMFTN=100,LIMTOL=50,LIMINF=200)
      COMMON/PARINF/PAR(LIMPAR),LPRINT(LIMPRN),IUNIT(LIMFTN),
     *ITOL(LIMTOL),INF(LIMINF),ITIT(20),IIN,IOUT
      COMMON/PARAL1/NPROC,NNPROC,IAM,MPOINT,ITASK
      PARAMETER (MXHOST=256)
      COMMON/PARPVM/MTID,MYTID,NPRCM1,ITIDS(0:MXHOST)
      CALL SECOND(TEND)
      IF(IAM.NE.0) THEN
      CALL PVMFINITSEND(0,INFO)
      CALL PVMFPACK(6,TEND,1,1,INFO)
      CALL PVMFSEND(ITIDS(0),MSGTIM,INFO)
      ELSE
      WRITE(IOUT,100)IAM,TEND
      TTEND=TEND
      DO 10 I=1,NPRCM1
      CALL PVMFRECV(ITIDS(I),MSGTIM,INFO)
      CALL PVMFUNPACK(6,TEND,1,1,INFO)
      WRITE(IOUT,100)I,TEND
10    TTEND=TTEND+TEND
      WRITE(IOUT,101)TTEND
      ENDIF
      RETURN
100   FORMAT('NODE',I5,' CPU TIME =',F14.3)
101   FORMAT('    TOTAL CPU TIME =',F14.3)
      END
