********> bugfix.60 Author: Tom Cheatham Date: 1/5/95 Programs: Gibbs Severity: Limited Problem: The MPI parallel version of gibbs does not exit gracefully, and does not work with the MPICH implementation of MPI. Fix: Make the following changes to gib.f: ------------------------------------------------------------------ *** OLD gib.f --- NEW gib.f *************** *** 308,313 **** --- 308,314 ---- call mpi_init(ierr) call mpi_comm_rank(MPI_COMM_WORLD,mytaskid,ierr) call mpi_comm_size(MPI_COMM_WORLD,numtasks,ierr) + notdone = 1 c JV Make PE 0 the master master = mytaskid.EQ.0 c JV Nodes skip reading/writing *************** *** 675,684 **** call startup(x,ix,lh,im) c JV Nodes call force only master just continues if(.NOT.master) then ! do while(.true.) c JV Need to get real value of IMES call FORCE(X(L30),X(L35),X(LVM01),ENER,VIR,IMES,x,ix,lh,im) enddo endif c ========================= END AMBER/MPI ========================= #endif --- 676,686 ---- call startup(x,ix,lh,im) c JV Nodes call force only master just continues if(.NOT.master) then ! do while( notdone .eq. 1 ) c JV Need to get real value of IMES call FORCE(X(L30),X(L35),X(LVM01),ENER,VIR,IMES,x,ix,lh,im) enddo + call mexit(0,0) endif c ========================= END AMBER/MPI ========================= #endif *************** *** 790,809 **** #ifdef MPI c =========================== AMBER/MPI =========================== c ! c ...in the current implementation, all nodes except the master ! c enter a never ending loop repeatedly calling force(). This ! c leads to hanging in a barrier when the master node exits. To ! c circumvent this, we need to call MPI_ABORT() in a native ! c implementation or kill all nodes; this can be accomplished by ! c calling mexit with ierr > 0 as we do below... ! c ! IF (ERROR) THEN ! WRITE(6,'(/5X,A)') 'AMBER/MPI: ERRORS ENCOUNTERED' ! ELSE ! WRITE(6,'(/5X,A)') 'AMBER/MPI: ERRORS ENCOUNTERED' ! ENDIF ! ! CALL MEXIT(6,1) c c ========================= END AMBER/MPI ========================= #endif --- 792,800 ---- #ifdef MPI c =========================== AMBER/MPI =========================== c ! notdone = 0 ! call MPI_BCAST(notdone,1,MPI_INTEGER,0, ! . MPI_COMM_WORLD,ierr) c c ========================= END AMBER/MPI ========================= #endif ------------------------------------------------------------------ Fix: Make the following changes to gibb.f: ------------------------------------------------------------------ *** OLD gibb.f --- NEW gibb.f *************** *** 1122,1127 **** --- 1122,1128 ---- C #ifdef MPI #include "parallel.h" + #include "mpif.h" #endif #include "mdtype.h" #include "mdcon.h" *************** *** 1245,1250 **** --- 1246,1267 ---- c c ======================= END SHARED MEMORY ======================= #endif /* SHARED_MEMORY */ + #ifdef MPI + c =========================== AMBER/MPI =========================== + c + c Check to see if we are done yet (tec3). This is done by monitoring + c the status of an integer notdone. If notdone .eq. 1 then we keep + c going. When we no longer want to call force(), notdone is set to + c zero byt the master... + c [This perhaps isn't the most efficient means to implement this check, + c but it works] + c + call mpi_bcast(notdone,1,MPI_INTEGER,0,MPI_COMM_WORLD,ierr) + if (notdone .ne. 1) return + c + c =========================== AMBER/MPI =========================== + #endif + C C ZERO = 0.0D0 C ------------------------------------------------------------------ Fix: Make the following changes to machinedep.f: ------------------------------------------------------------------ *** OLD machinedep.f --- NEW machinedep.f *************** *** 5035,5040 **** --- 5035,5044 ---- C O[verwrite] output if (arg .eq. '-O') then owrite = 'UNKNOWN' + #ifdef MPI + elseif (arg .eq. '-p4pg') then + iarg = iarg + 1 + #endif C pin elseif (arg .eq. '-i') then iarg = iarg + 1 ------------------------------------------------------------------ Fix: Make the following changes to parallel.f: ------------------------------------------------------------------ *** OLD parallel.f --- NEW parallel.f *************** *** 83,192 **** c if(first) then c JV Send/receive common blocks from master c POLZ ! call mpi_bcast(ipol,1,MPI_INTEGER,0,0,ierr) c MDINFO ! call mpi_bcast(NTB,8,MPI_INTEGER,0,0,ierr) ! call mpi_bcast(BETA,4,MPI_DOUBLE,0,0,ierr) c MDTYPE ! call mpi_bcast(NTX,10,MPI_INTEGER,0,0,ierr) ! call mpi_bcast(T,2,MPI_DOUBLE,0,0,ierr) ! call mpi_bcast(ISOLVP,3,MPI_INTEGER,0,0,ierr) c MDCON ! call mpi_bcast(NTC,8,MPI_INTEGER,0,0,ierr) ! call mpi_bcast(TOL,2,MPI_DOUBLE,0,0,ierr) ! call mpi_bcast(ISHKFL,1,MPI_INTEGER,0,0,ierr) c MACRO ! call mpi_bcast(TEMP0,9,MPI_DOUBLE,0,0,ierr) c MDSOL ! call mpi_bcast(IFTRES,7,MPI_INTEGER,0,0,ierr) c WATCAP ! call mpi_bcast(IFCAP,2,MPI_INTEGER,0,0,ierr) ! call mpi_bcast(CUTCAP,5,MPI_DOUBLE,0,0,ierr) c RADII ! call mpi_bcast(RAD,1400,MPI_DOUBLE,0,0,ierr) ! call mpi_bcast(NTYPS,1,MPI_INTEGER,0,0,ierr) c INFOV ! call mpi_bcast(NATOM,23,MPI_INTEGER,0,0,ierr) c PERTRB ! call mpi_bcast(IFPERT,8,MPI_INTEGER,0,0,ierr) ! call mpi_bcast(ALMDA,12,MPI_DOUBLE,0,0,ierr) ! call mpi_bcast(NSTPE,2,MPI_INTEGER,0,0,ierr) ! call mpi_bcast(DTE,2,MPI_DOUBLE,0,0,ierr) c PERTRS ! call mpi_bcast(ICSTAT,2,MPI_INTEGER,0,0,ierr) ! call mpi_bcast(EPERT,190,MPI_DOUBLE,0,0,ier) c MEMLA ! call mpi_bcast(I02,40,MPI_INTEGER,0,0,ierr) c MEMLB ! call mpi_bcast(L05,29,MPI_INTEGER,0,0,ierr) c MEMLC ! call mpi_bcast(M02,4,MPI_INTEGER,0,0,ierr) c MEMLF ! call mpi_bcast(LP01,16,MPI_INTEGER,0,0,ierr) c PNTATP ! call mpi_bcast(IPERAT,7,MPI_INTEGER,0,0,ierr) c MEMCON ! call mpi_bcast(LCR04,25,MPI_INTEGER,0,0,ierr) c NBTERM ! call mpi_bcast(CUT,6,MPI_DOUBLE,0,0,ierr) ! call mpi_bcast(IDIEL,5,MPI_INTEGER,0,0,ierr) c PARMS ! call mpi_bcast(RK,3600,MPI_DOUBLE,0,0,ierr) ! call mpi_bcast(PK,2700,MPI_DOUBLE,0,0,ierr) ! call mpi_bcast(CN1,3720,MPI_DOUBLE,0,0,ierr) c HBPAR ! call mpi_bcast(ASOL,1000,MPI_DOUBLE,0,0,ierr) c DIFFRN ! call mpi_bcast(EPERTD,466,MPI_DOUBLE,0,0,ierr) ! call mpi_bcast(IDIFRG,2,MPI_INTEGER,0,0,ierr) c PERTIM ! call mpi_bcast(CTIMT,5,MPI_DOUBLE,0,0,ierr) ! call mpi_bcast(IFTIME,1,MPI_INTEGER,0,0,ierr) c CORC ! call mpi_bcast(ICORC,4,MPI_INTEGER,0,0,ierr) c TIMSTT ! call mpi_bcast(TIMSTS,10,MPI_DOUBLE,0,0,ierr) c RSTCL0 ! call mpi_bcast(NBRST,6,MPI_INTEGER,0,0,ierr) ! call mpi_bcast(TOL2,1,MPI_DOUBLE,0,0,ierr) ! call mpi_bcast(IRINGC,6,MPI_INTEGER,0,0,ierr) ! call mpi_bcast(ALMCC,6,MPI_DOUBLE,0,0,ierr) ! call mpi_bcast(IBIGM,1,MPI_INTEGER,0,0,ierr) c DOUBW ! call mpi_bcast(IDWIDE,2,MPI_INTEGER,0,0,ierr) c INPERT ! call mpi_bcast(INTPRT,1,MPI_INTEGER,0,0,ierr) c NMRSTF ! call mpi_bcast(INMR,5,MPI_INTEGER,0,0,ierr) c SFTREP ! call mpi_bcast(ISFTRP,2,MPI_INTEGER,0,0,ierr) ! call mpi_bcast(RWELL,1,MPI_DOUBLE,0,0,ierr) c PRMLIM ! call mpi_bcast(NUMBND,5,MPI_INTEGER,0,0,ierr) c FSTWAT ! call mpi_bcast(JFASTW,10,MPI_INTEGER,0,0,ierr) ! call mpi_bcast(RBTARG,8,MPI_DOUBLE,0,0,ierr) c thrbod ! call mpi_bcast(iat1,10,MPI_INTEGER,0,0,ierr) ! call mpi_bcast(acon,30,MPI_DOUBLE,0,0,ierr) ! call mpi_bcast(i3b,7,MPI_INTEGER,0,0,ierr) c RESTC ! call mpi_bcast(TAUR,1,MPI_DOUBLE,0,0,ierr) ! call mpi_bcast(NSTLIM,7,MPI_INTEGER,0,0,ierr) c DSX000 ! call mpi_bcast(DSX0,1,MPI_DOUBLE,0,0,ierr) ! call mpi_bcast(IDSX0,1,MPI_INTEGER,0,0,ierr) c COMMON ! call mpi_bcast(IOLEPS,1,MPI_INTEGER,0,0,ierr) c SLVTRN ! call mpi_bcast(ISVAT,2,MPI_INTEGER,0,0,ierr) c IX,XX,LH,IM c JV Send almost all of IX and XX (not all is needed) ! call mpi_bcast(IX(I02),I60-I02,MPI_INTEGER,0,0,ierr) ! call mpi_bcast(IX(I60),I78-I60,MPI_INTEGER,0,0,ierr) ! call mpi_bcast(LH(m02),m08-m02,MPI_INTEGER,0,0,ierr) ! call mpi_bcast(XX(L05),L100-L05,MPI_DOUBLE,0,0,ierr) ! call mpi_bcast(IM(LH05),(LH75+natom)-LH05,MPI_INTEGER,0,0,ierr) first = .false. c endif --- 83,213 ---- c if(first) then c JV Send/receive common blocks from master c POLZ ! call mpi_bcast(ipol,1,MPI_INTEGER,0,MPI_COMM_WORLD,ierr) c MDINFO ! call mpi_bcast(NTB,8,MPI_INTEGER,0,MPI_COMM_WORLD,ierr) ! call mpi_bcast(BETA,4,MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,ierr) c MDTYPE ! call mpi_bcast(NTX,10,MPI_INTEGER,0,MPI_COMM_WORLD,ierr) ! call mpi_bcast(T,2,MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,ierr) ! call mpi_bcast(ISOLVP,3,MPI_INTEGER,0,MPI_COMM_WORLD,ierr) c MDCON ! call mpi_bcast(NTC,8,MPI_INTEGER,0,MPI_COMM_WORLD,ierr) ! call mpi_bcast(TOL,2,MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,ierr) ! call mpi_bcast(ISHKFL,1,MPI_INTEGER,0,MPI_COMM_WORLD,ierr) c MACRO ! call mpi_bcast(TEMP0,9,MPI_DOUBLE_PRECISION,0, ! . MPI_COMM_WORLD,ierr) c MDSOL ! call mpi_bcast(IFTRES,7,MPI_INTEGER,0,MPI_COMM_WORLD,ierr) c WATCAP ! call mpi_bcast(IFCAP,2,MPI_INTEGER,0,MPI_COMM_WORLD,ierr) ! call mpi_bcast(CUTCAP,5,MPI_DOUBLE_PRECISION,0, ! . MPI_COMM_WORLD,ierr) c RADII ! call mpi_bcast(RAD,1400,MPI_DOUBLE_PRECISION,0, ! . MPI_COMM_WORLD,ierr) ! call mpi_bcast(NTYPS,1,MPI_INTEGER,0,MPI_COMM_WORLD,ierr) c INFOV ! call mpi_bcast(NATOM,23,MPI_INTEGER,0,MPI_COMM_WORLD,ierr) c PERTRB ! call mpi_bcast(IFPERT,8,MPI_INTEGER,0,MPI_COMM_WORLD,ierr) ! call mpi_bcast(ALMDA,12,MPI_DOUBLE_PRECISION,0, ! . MPI_COMM_WORLD,ierr) ! call mpi_bcast(NSTPE,2,MPI_INTEGER,0,MPI_COMM_WORLD,ierr) ! call mpi_bcast(DTE,2,MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,ierr) c PERTRS ! call mpi_bcast(ICSTAT,2,MPI_INTEGER,0,MPI_COMM_WORLD,ierr) ! call mpi_bcast(EPERT,190,MPI_DOUBLE_PRECISION,0, ! . MPI_COMM_WORLD,ier) c MEMLA ! call mpi_bcast(I02,40,MPI_INTEGER,0,MPI_COMM_WORLD,ierr) c MEMLB ! call mpi_bcast(L05,29,MPI_INTEGER,0,MPI_COMM_WORLD,ierr) c MEMLC ! call mpi_bcast(M02,4,MPI_INTEGER,0,MPI_COMM_WORLD,ierr) c MEMLF ! call mpi_bcast(LP01,16,MPI_INTEGER,0,MPI_COMM_WORLD,ierr) c PNTATP ! call mpi_bcast(IPERAT,7,MPI_INTEGER,0,MPI_COMM_WORLD,ierr) c MEMCON ! call mpi_bcast(LCR04,25,MPI_INTEGER,0,MPI_COMM_WORLD,ierr) c NBTERM ! call mpi_bcast(CUT,6,MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,ierr) ! call mpi_bcast(IDIEL,5,MPI_INTEGER,0,MPI_COMM_WORLD,ierr) c PARMS ! call mpi_bcast(RK,3600,MPI_DOUBLE_PRECISION,0, ! . MPI_COMM_WORLD,ierr) ! call mpi_bcast(PK,2700,MPI_DOUBLE_PRECISION,0, ! . MPI_COMM_WORLD,ierr) ! call mpi_bcast(CN1,3720,MPI_DOUBLE_PRECISION,0, ! . MPI_COMM_WORLD,ierr) c HBPAR ! call mpi_bcast(ASOL,1000,MPI_DOUBLE_PRECISION,0, ! . MPI_COMM_WORLD,ierr) c DIFFRN ! call mpi_bcast(EPERTD,466,MPI_DOUBLE_PRECISION,0, ! . MPI_COMM_WORLD,ierr) ! call mpi_bcast(IDIFRG,2,MPI_INTEGER,0,MPI_COMM_WORLD,ierr) c PERTIM ! call mpi_bcast(CTIMT,5,MPI_DOUBLE_PRECISION,0, ! . MPI_COMM_WORLD,ierr) ! call mpi_bcast(IFTIME,1,MPI_INTEGER,0,MPI_COMM_WORLD,ierr) c CORC ! call mpi_bcast(ICORC,4,MPI_INTEGER,0,MPI_COMM_WORLD,ierr) c TIMSTT ! call mpi_bcast(TIMSTS,10,MPI_DOUBLE_PRECISION,0, ! . MPI_COMM_WORLD,ierr) c RSTCL0 ! call mpi_bcast(NBRST,6,MPI_INTEGER,0,MPI_COMM_WORLD,ierr) ! call mpi_bcast(TOL2,1,MPI_DOUBLE_PRECISION,0, ! . MPI_COMM_WORLD,ierr) ! call mpi_bcast(IRINGC,6,MPI_INTEGER,0,MPI_COMM_WORLD,ierr) ! call mpi_bcast(ALMCC,6,MPI_DOUBLE_PRECISION,0, ! . MPI_COMM_WORLD,ierr) ! call mpi_bcast(IBIGM,1,MPI_INTEGER,0,MPI_COMM_WORLD,ierr) c DOUBW ! call mpi_bcast(IDWIDE,2,MPI_INTEGER,0,MPI_COMM_WORLD,ierr) c INPERT ! call mpi_bcast(INTPRT,1,MPI_INTEGER,0,MPI_COMM_WORLD,ierr) c NMRSTF ! call mpi_bcast(INMR,5,MPI_INTEGER,0,MPI_COMM_WORLD,ierr) c SFTREP ! call mpi_bcast(ISFTRP,2,MPI_INTEGER,0,MPI_COMM_WORLD,ierr) ! call mpi_bcast(RWELL,1,MPI_DOUBLE_PRECISION,0, ! . MPI_COMM_WORLD,ierr) c PRMLIM ! call mpi_bcast(NUMBND,5,MPI_INTEGER,0,MPI_COMM_WORLD,ierr) c FSTWAT ! call mpi_bcast(JFASTW,10,MPI_INTEGER,0,MPI_COMM_WORLD,ierr) ! call mpi_bcast(RBTARG,8,MPI_DOUBLE_PRECISION,0, ! . MPI_COMM_WORLD,ierr) c thrbod ! call mpi_bcast(iat1,10,MPI_INTEGER,0,MPI_COMM_WORLD,ierr) ! call mpi_bcast(acon,30,MPI_DOUBLE_PRECISION,0, ! . MPI_COMM_WORLD,ierr) ! call mpi_bcast(i3b,7,MPI_INTEGER,0,MPI_COMM_WORLD,ierr) c RESTC ! call mpi_bcast(TAUR,1,MPI_DOUBLE_PRECISION,0, ! . MPI_COMM_WORLD,ierr) ! call mpi_bcast(NSTLIM,7,MPI_INTEGER,0,MPI_COMM_WORLD,ierr) c DSX000 ! call mpi_bcast(DSX0,1,MPI_DOUBLE_PRECISION,0, ! . MPI_COMM_WORLD,ierr) ! call mpi_bcast(IDSX0,1,MPI_INTEGER,0,MPI_COMM_WORLD,ierr) c COMMON ! call mpi_bcast(IOLEPS,1,MPI_INTEGER,0,MPI_COMM_WORLD,ierr) c SLVTRN ! call mpi_bcast(ISVAT,2,MPI_INTEGER,0,MPI_COMM_WORLD,ierr) c IX,XX,LH,IM c JV Send almost all of IX and XX (not all is needed) ! call mpi_bcast(IX(I02),I60-I02,MPI_INTEGER,0,MPI_COMM_WORLD,ierr) ! call mpi_bcast(IX(I60),I78-I60,MPI_INTEGER,0,MPI_COMM_WORLD,ierr) ! call mpi_bcast(LH(m02),m08-m02,MPI_INTEGER,0,MPI_COMM_WORLD,ierr) ! call mpi_bcast(XX(L05),L100-L05,MPI_DOUBLE_PRECISION,0, ! . MPI_COMM_WORLD,ierr) ! call mpi_bcast(IM(LH05),(LH75+natom)-LH05,MPI_INTEGER,0, ! . MPI_COMM_WORLD,ierr) first = .false. c endif *************** *** 220,248 **** c JV Send setbox common block , vir, and xyz coords every time c SETBOX ! call mpi_bcast(box,13,MPI_DOUBLE,0,0,ierr) ! call mpi_bcast(NTM,2,MPI_INTEGER,0,0,ierr) c PERTRB ! call mpi_bcast(IFPERT,8,MPI_INTEGER,0,0,ierr) ! call mpi_bcast(ALMDA,12,MPI_DOUBLE,0,0,ierr) ! call mpi_bcast(NSTPE,2,MPI_INTEGER,0,0,ierr) ! call mpi_bcast(DTE,2,MPI_DOUBLE,0,0,ierr) c RADII ! call mpi_bcast(RAD,1400,MPI_DOUBLE,0,0,ierr) ! call mpi_bcast(NTYPS,1,MPI_INTEGER,0,0,ierr) c PARMS ! c call mpi_bcast(RK,3600,MPI_DOUBLE,0,0,ierr) ! c call mpi_bcast(PK,2700,MPI_DOUBLE,0,0,ierr) ! c call mpi_bcast(CN1,3720,MPI_DOUBLE,0,0,ierr) c VIR ! call mpi_bcast(vir,3,MPI_DOUBLE,0,0,ierr) c XYZ coords ! call mpi_bcast(XX(L30),3*natom,MPI_DOUBLE,0,0,ierr) ! call mpi_bcast(NTNB,1,MPI_INTEGER,0,0,ierr) c If not virial don't send xrc if (IABS(NTB) .GE. 2) then ! call mpi_bcast(XX(L45),3*natom,MPI_DOUBLE,0,0,ierr) endif return end --- 241,279 ---- c JV Send setbox common block , vir, and xyz coords every time c SETBOX ! call mpi_bcast(box,13,MPI_DOUBLE_PRECISION,0, ! . MPI_COMM_WORLD,ierr) ! call mpi_bcast(NTM,2,MPI_INTEGER,0,MPI_COMM_WORLD,ierr) c PERTRB ! call mpi_bcast(IFPERT,8,MPI_INTEGER,0,MPI_COMM_WORLD,ierr) ! call mpi_bcast(ALMDA,12,MPI_DOUBLE_PRECISION,0, ! . MPI_COMM_WORLD,ierr) ! call mpi_bcast(NSTPE,2,MPI_INTEGER,0,MPI_COMM_WORLD,ierr) ! call mpi_bcast(DTE,2,MPI_DOUBLE_PRECISION,0, ! . MPI_COMM_WORLD,ierr) c RADII ! call mpi_bcast(RAD,1400,MPI_DOUBLE_PRECISION,0, ! . MPI_COMM_WORLD,ierr) ! call mpi_bcast(NTYPS,1,MPI_INTEGER,0,MPI_COMM_WORLD,ierr) c PARMS ! c call mpi_bcast(RK,3600,MPI_DOUBLE_PRECISION,0, ! c . MPI_COMM_WORLD,ierr) ! c call mpi_bcast(PK,2700,MPI_DOUBLE_PRECISION,0, ! c . MPI_COMM_WORLD,ierr) ! c call mpi_bcast(CN1,3720,MPI_DOUBLE_PRECISION,0, ! c . MPI_COMM_WORLD,ierr) c VIR ! call mpi_bcast(vir,3,MPI_DOUBLE_PRECISION,0, ! . MPI_COMM_WORLD,ierr) c XYZ coords ! call mpi_bcast(XX(L30),3*natom,MPI_DOUBLE_PRECISION,0, ! . MPI_COMM_WORLD,ierr) ! call mpi_bcast(NTNB,1,MPI_INTEGER,0,MPI_COMM_WORLD,ierr) c If not virial don't send xrc if (IABS(NTB) .GE. 2) then ! call mpi_bcast(XX(L45),3*natom,MPI_DOUBLE_PRECISION,0, ! . MPI_COMM_WORLD,ierr) endif return end *************** *** 297,303 **** c Add all copies of force array together from all nodes call mpi_reduce(f,forcetmp, ! + (3*natom+45),MPI_DOUBLE,0,0,0,ierr) c JV Extract ene and vir off end of force array c This is done to avoid two reduce calls on machines with --- 328,335 ---- c Add all copies of force array together from all nodes call mpi_reduce(f,forcetmp, ! + (3*natom+45),MPI_DOUBLE_PRECISION,MPI_SUM,0, ! + MPI_COMM_WORLD,ierr) c JV Extract ene and vir off end of force array c This is done to avoid two reduce calls on machines with ------------------------------------------------------------------ Temporary workarounds: None --