********>Bugfix 30: Prepared by: Ben Roberts Date: 1/14/2010 Programs: sander Description: This patch allows sander to work with PUPIL 1.3. Usage: Save this file in your $AMBERHOME directory and then apply this patch file to your amber10 distribution as follows: cd $AMBERHOME patch -p0 -N -r patch_rejects < bugfix.30 ---------------------------------------------------------------------------- --- src/sander/fixport.f.bak 2010-01-11 19:45:40.635234191 -0500 +++ src/sander/fixport.f 2010-01-11 20:01:52.408952568 -0500 @@ -1,35 +1,55 @@ !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -!C PUPIL program ITR-MEDIUM PROJECT C +!C PUPIL program C !C C !C Author: J. Torras C -!C Version: 0.0.8.6 C -!C Date: 09-08-2005 C +!C Version: 1.4 C +!C Date: 08-16-2009 C !C C -!C torras@qtp.ufl.edu C +!C torras@euetii.upc.edu C !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC - SUBROUTINE FIXPORT - CHARACTER*30 ARGV,HOST,PORT,OPTPRINT - INTEGER IOPTPRINT - INTEGER I,IARGC, M - M = IARGC() - DO I = 1, M - CALL GETARG ( I, ARGV ) - IF(ARGV .EQ. "-ORBInitialPort") THEN - CALL GETARG(I+1,PORT) - WRITE(*,*)'FOUND PORT ',PORT - ELSE IF(ARGV .EQ. '-ORBInitialHost') THEN - CALL GETARG(I+1,HOST) - WRITE(*,*)'FOUND HOST ',HOST - ELSE IF(ARGV .EQ. '-OptPrint') THEN - CALL GETARG(I+1,OPTPRINT) - READ(OPTPRINT,'(I30)') IOPTPRINT - WRITE(*,*)'FOUND LOGLEVEL ',IOPTPRINT - END IF - END DO -!C ASSING HOST, PORT AND PRINTLOG TO PUPIL SYSTEM - CALL SETCORBANAMESERVER(HOST,PORT,IOPTPRINT) -!C WRITE( *, '( I2, 1X, A )' ) I, ARGV - RETURN - END - +subroutine fixport + + character*30 argv,host,port,optprint + character*30 jxms,jxmx,jxss + integer i,iargc,ioptprint,m + integer ijxms,ijxmx,ijxss + + m = iargc() + + do i = 1,m + + call getarg(i,argv) + + if (argv .eq. "-ORBInitialPort") then + call getarg(i+1,port) + write(*,*) 'Port: ', port + else if (argv .eq. '-ORBInitialHost') then + call getarg(i+1,host) + write(*,*) 'Host: ', host + else if (argv .eq. '-OptPrint') then + call getarg(i+1,optprint) + read(optprint,'(I30)') ioptprint + write(*,*) 'Log level: ', ioptprint + else if (argv .eq. '-jxms') then + call getarg(i+1,jxms) + read(jxms,'(I30)') ijxms + write(*,*) 'Minimum Java memory: ', ijxms + else if (argv .eq. '-jxmx') then + call getarg(i+1,jxmx) + read(jxmx,'(I30)') ijxmx + write(*,*) 'Maximum Java memory: ', ijxmx + else if (argv .eq. '-jxss') then + call getarg(i+1,jxss) + read(jxss,'(I30)') ijxss + write(*,*) 'Stack size of Java: ', ijxss + end if + end do + + ! Assign host, port and log level to PUPIL system + call setcorbanameserver(host,port,ioptprint) + call setjavamemory(ijxms,ijxmx,ijxss) + + return + +end subroutine fixport --- src/sander/force.f.bak 2010-01-11 20:04:36.926239121 -0500 +++ src/sander/force.f 2010-01-11 20:09:13.732211345 -0500 @@ -364,7 +364,7 @@ ! Getting the Quantum forces with PUPIL package !***************************************************** -! Reconstructing the simulation cell if there is any change +! Reconstruct the simulation cell if there is any change ! call inipupcell(natms,qcell,cell,xxx,yyy,zzz) do iPup=1,3 !vector loop do jPup=1,3 !Component loop @@ -394,18 +394,18 @@ if(ifbox == 2) call wrap_to(nspm,ix(i70),r_stack(l_puptmp),box) end if -! write(6,*) ' Updating PUPIL data structures.' +! write(6,*) 'Updating PUPIL data structures' -! Preparing the coordinates,velocity and classic forces -! to get quantum force +! Preparing the coordinates, velocity and classic forces +! to get quantum force do iPup=1,natom bs1 = (iPup-1)*9 bs2 = (iPup-1)*3 do jPup=1,3 - qcdata(bs1 +jPup) = r_stack(l_puptmp + bs2 +jPup - 1) -! qcdata(bs1 +jPup) = x(bs2+jPup) -! write(6,*) 'Coordinate.',iPup,'==>',realStack(lcrd+bs2+jPup-1),x(bs2+jPup) -! write(6,*) 'Velocity...',iPup,'==>',realStack(lvel+bs2+jPup-1) + qcdata(bs1+jPup) = r_stack(l_puptmp + bs2 + jPup - 1) +! qcdata(bs1+jPup) = x(bs2+jPup) +! write(6,*) 'Coordinate.',iPup,'==>',realStack(lcrd+bs2+jPup-1),x(bs2+jPup) +! write(6,*) 'Velocity...',iPup,'==>',realStack(lvel+bs2+jPup-1) qcdata(bs1+3+jPup) = realStack(lvel+bs2+jPup-1) qcdata(bs1+6+jPup) = f(bs2+jPup) enddo @@ -420,7 +420,7 @@ if(pupStep .EQ. 0) then !!! To keep initial values from the MD step 1 ierr = 0 - allocate ( pupnb14(numnb14*2),stat=ierr) + allocate ( pupnb14(numnb14*3),stat=ierr) REQUIRE(ierr == 0) allocate ( pupbonh(nbonh*3),stat=ierr) @@ -493,13 +493,13 @@ enddo endif -! Getting the quantum forces for a specific quantumn domain +! Getting the quantum forces for a specific quantum domain pupStep = pupStep + 1 puperror = 0 pupLevelData = 3 call getquantumforces(natom,pupLevelData,pupStep,puperror,qcdata,qcell) if (puperror.ne.0) then - write (6,*) "Fatal Error: Error getting quantum forces." + write (6,*) 'Fatal error: Could not obtain quantum forces!' call mexit(6,1) endif ! Quantum energy treatment.... @@ -575,24 +575,24 @@ pupQZchange = 0 endif - ! For PUPIL, rebuild the neighbour list - ! and zero the charges on QM atoms at every step, - ! because the QM atoms list may have changed - if ( igb == 0 .and. iyammp == 0 ) then + ! For PUPIL, rebuild the neighbour list + ! and zero the charges on QM atoms at every step, + ! because the QM atoms list may have changed + if ( igb == 0 .and. iyammp == 0 ) then - ! (for GB: do all nonbondeds together below) - call timer_start(TIME_NONBON) - call timer_start(TIME_LIST) - !do_list_update=.true. - call nonbond_list(x,ix(i04),ix(i06),ix(i08),ix(i10), & - ntypes,natom/am_nbead,xx,ix,ipairs,ntnb, & - ix(ibellygp),belly,newbalance,cn1, & - xx(lvel),xx(lvel2),ntp,xx(l45), qsetup, & - do_list_update) - !call qm_zero_charges(x(L15)) - call timer_stop(TIME_LIST) - call timer_stop(TIME_NONBON) - end if + ! (for GB: do all nonbondeds together below) + call timer_start(TIME_NONBON) + call timer_start(TIME_LIST) + !do_list_update=.true. + call nonbond_list(x,ix(i04),ix(i06),ix(i08),ix(i10), & + ntypes,natom/am_nbead,xx,ix,ipairs,ntnb, & + ix(ibellygp),belly,newbalance,cn1, & + xx(lvel),xx(lvel2),ntp,xx(l45), qsetup, & + do_list_update) + !call qm_zero_charges(x(L15)) + call timer_stop(TIME_LIST) + call timer_stop(TIME_NONBON) + end if #endif /*PUPIL_SUPPORT*/ --- src/sander/mdfil.f.bak 2010-01-11 19:09:18.593307931 -0500 +++ src/sander/mdfil.f 2010-01-11 19:11:16.194650511 -0500 @@ -260,6 +260,9 @@ #ifdef PUPIL_SUPPORT else if ((arg == '-ORBInitialPort') .or. & (arg == '-ORBInitialHost') .or. & + (arg == '-jxms' ) .or. & + (arg == '-jxmx' ) .or. & + (arg == '-jxss' ) .or. & (arg == '-OptPrint')) then iarg = iarg + 1 #endif /*PUPIL_SUPPORT*/ --- src/sander/mexit.f.bak 2010-01-11 20:12:00.741334526 -0500 +++ src/sander/mexit.f 2010-01-11 20:18:26.855188381 -0500 @@ -35,11 +35,12 @@ #ifdef PUPIL_SUPPORT !jtc ========================= PUPIL INTERFACE ========================= -! Terminating the PUPIL corba Interface - if(pupactive) then +! Terminate the PUPIL CORBA interface, only if such an interface +! exists. + if (pupactive) then puperror = 0 call killcorbaintfc(puperror) - if(puperror /= 0) write(6,*) 'Error ending PUPIL CORBA Interface.' + if(puperror /= 0) write(6,*) 'Error ending PUPIL CORBA interface.' end if !jtc ========================= PUPIL INTERFACE ========================= #endif --- src/sander/putvalues.f.bak 2010-01-11 20:18:26.861187990 -0500 +++ src/sander/putvalues.f 2010-01-11 20:15:48.107526966 -0500 @@ -3,7 +3,7 @@ subroutine putforces(nt,qz,a,f,chg,e) !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC !C C -!C PUPIL program ITR-MEDIUM PROJECT C +!C PUPIL Project C !C C !C Author: J. Torras C !C Version: 0.0.8.9 C --- src/sander/sander.f.bak 2010-01-11 19:14:07.135520222 -0500 +++ src/sander/sander.f 2010-01-11 20:18:26.876187013 -0500 @@ -168,23 +168,11 @@ call wallclock( time0 ) call init_timers() - !jtc ========================= PUPIL INTERFACE ========================= -#ifdef PUPIL_SUPPORT - ! captioning line commands and rise up the corba interface - - puperror = 0 - call fixport() - call inicorbaintfcmd(puperror) - if (puperror .ne. 0) then - write(6,*) 'Error in the PUPIL interface initialization.' - call mexit(6,1) - endif - pupactive = .true. - write(6,*) 'PUPIL CORBA Interface initialized.' -#endif - !jtc ========================= PUPIL INTERFACE ========================= - - + ! BPR - original location of PUPIL interface. I moved it further down + ! because, if it's here, it can't print stuff; write(6,...) statements + ! assume mdread1() has already been invoked. However, moving this down + ! may break other things. + ! ==== Flag to tell list builder to print size of list on first call ======= first_list_flag = .true. ! ==== Flag to tell recip space routines to allocate on first call ======= @@ -334,9 +322,24 @@ nr3 = 3*nr belly = ibelly > 0 -!! jtc ========================= PUPIL INTERFACE ========================= + ! ========================= PUPIL INTERFACE ========================= #ifdef PUPIL_SUPPORT - ! Allocation of memory and initialization + + ! I moved the PUPIL interface down here so that write() statements work + ! as advertised. BPR 9/7/09 + + ! Initialise the CORBA interface + puperror = 0 + call fixport() + call inicorbaintfcmd(puperror) + if (puperror .ne. 0) then + write(6,*) 'Error creating PUPIL CORBA interface.' + call mexit(6,1) + end if + pupactive = .true. + write(6,*) 'PUPIL CORBA interface initialized.' + + ! Allocation of memory and initialization pupStep = 0 puperror = 0 allocate (qcell (12 ),stat=puperror) @@ -350,68 +353,68 @@ allocate (pupres (nres ),stat=puperror) allocate (keyres (nres ),stat=puperror) - if(puperror /= 0) then - write(6,*) 'Error allocating PUPIL Interface memory.' + if (puperror /= 0) then + write(6,*) 'Error allocating PUPIL interface memory.' call mexit(6,1) - endif + end if - ! Initialization of the Atomic Numbers and quantum forces vector + ! Initialise the "atomic numbers" and "quantum forces" vectors pupqatoms = 0 iresPup = 1 pupres(1) = 1 do iPup=1,natom bs1 = (iPup-1)*3 call get_atomic_number(ih(iPup+m06-1),pupatm(iPup)) - if(iresPup.lt.nres) then - if(iPup.ge.ix(iresPup+i02)) then - iresPup = iresPup + 1 - pupres(iresPup) = iPup + if (iresPup .lt. nres) then + if (iPup .ge. ix(iresPup+i02)) then + iresPup = iresPup + 1 + pupres(iresPup) = iPup end if - endif - write(strAux,"(A4,'.',A4)") trim(ih(iresPup+m02-1)),adjustl(ih(iPup+m04-1)) + end if + write (strAux,"(A4,'.',A4)") trim(ih(iresPup+m02-1)),adjustl(ih(iPup+m04-1)) keyres(iresPup) = trim(ih(iresPup+m02-1)) keyMM(iPup) = trim(strAux) - ! Getting all the initial charges.... + ! Retrieve the initial charges pupchg(iPup) = x(L15+iPup-1) - ! write(6,*) 'Atom num.',iPup,' Label ', keyMM(iPup), 'Charge', pupchg(iPup) + !write(6,*) 'Atom num.',iPup,' Label ', keyMM(iPup), 'Charge', pupchg(iPup) do jPup=1,3 qfpup(bs1+jPup) = 0.0d0 - enddo - enddo - write(6,*) ' Got all atomic numbers.' + end do + end do + + write(6,*) 'Got all atomic numbers.' - ! Initialization of the PUPIL cell + ! Initialise the PUPIL cell do iPup=1,12 qcell(iPup) = 0.0d0 - enddo + end do - ! Submitting the key MM particles and its atomic numbers to PUPIL + ! Submit the KeyMM particles and their respective atomic numbers to PUPIL puperror = 0 call putatomtypes(natom,puperror,pupatm,keyMM) if (puperror .ne. 0) then write(6,*) 'Error sending MM atom types to PUPIL.' call mexit(6,1) - endif + end if - ! Submitting the Residue Pointer vector to PUPIL - write(6,*) 'Number of residues = ',nres,' Number of atoms= ',natom + ! Submit the Residue Pointer vector to PUPIL + write(6,"(a20,1x,i6,3x,a17,1x,i6)") 'Number of residues =', nres, 'Number of atoms =', natom !do iPup=1,nres - ! write(6,*) 'Residue ',iPup,keyres(iPup),pupres(iPup) - !enddo + ! write(6,*) 'Residue ',iPup,keyres(iPup),pupres(iPup) + !end do puperror = 0 call putresiduetypes(nres,puperror,pupres,keyres) if (puperror .ne. 0) then write(6,*) 'Error sending MM residue types to PUPIL.' call mexit(6,1) - endif + end if - write(6,*) 'PUPIL CORBA Interface initialized.' - write(*,*) ' Initialization of PUPIL structure done.' + write(6,*) 'Sent system data to PUPIL.' + write(*,*) 'PUPIL structure initialized.' #endif -!!jtc ========================= PUPIL INTERFACE ========================= - + ! ========================= PUPIL INTERFACE ========================= ! --- seed the random number generator --- @@ -1132,18 +1135,18 @@ ! ========================= END AMBER/MPI ========================= #endif -!! jtc ========================= PUPIL INTERFACE ========================= +! ========================= PUPIL INTERFACE ========================= #ifdef PUPIL_SUPPORT -! Finalize Corba Interface - puperror = 0 - call killcorbaintfc(puperror) - if(puperror /= 0) then - write(6,*) 'Error ending PUPIL CORBA Interface.' - endif - pupactive = .false. - write(6, '(a)') 'PUPIL CORBA Interface finalized.' + ! Finalize Corba Interface + puperror = 0 + call killcorbaintfc(puperror) + if (puperror /= 0) then + write(6,*) 'Error ending PUPIL CORBA interface.' + end if + write(6,'(a)') 'PUPIL CORBA interface finalized.' + pupactive = .false. #endif -!! jtc ========================= PUPIL INTERFACE ========================= +! ========================= PUPIL INTERFACE ========================= ----------------------------------------------------------------------------