C C $Id: printen.F,v 1.6 1998/07/16 16:40:22 jjv5 Exp arjan $ C C------------------------------------------------------------------------ subroutine printen(imc, movedres, wchar, bchar, ok, rok) implicit double precision(a-h,o-z) #include "divcon.dim" #include "divcon.h" logical ok, rok character wchar, bchar CC-------------------------------------------------------------CC if (iensemb.eq.0) bchar = ' ' C C head: cycle step status C if (ok) then C-RDC write(iout,'(/" CYCLE: ",I10," STEP: ",I10, C-RDC & " STATUS: A ",1A,1X,1A)') imc,ntry,wchar,bchar if (wrtmc) then C-RDC write(iscr,'(/" cycle: ",I10," step: ",I10, C-RDC & " status: A ",1A,1X,1A)') imc,ntry,wchar,bchar endif else C-RDC write(iout,'(/" CYCLE: ",I10," STEP: ",I10, C-RDC & " STATUS: R ",1A,1X,1A)') imc,ntry,wchar,bchar if (wrtmc) then C-RDC write(iscr,'(/" cycle: ",I10," step: ",I10, C-RDC & " status: R ",1A,1X,1A)') imc,ntry,wchar,bchar endif endif C C box move /residue move information C if (bchar.eq.'B') then C-RDC write(iout,'(/" MOVED BOX WITH ",F15.10," A IN ALL ", C-RDC & "DIRECTIONS")') sdrbox if (pme.and.setbpme) then C-RDC write(iout,'(" BETAPME IS ",F15.10)') betapme endif if (wrtmc) then C-RDC write(iscr,'(/" moved box with ",F15.10," A in all ", C-RDC & "directions")') sdrbox if (pme.and.setbpme) then C-RDC write(iscr,'(" betapme is ",F15.10)') betapme endif endif else if (imc.gt.1) then do i=1,3 if (ndangle(i).eq.0) then sdangle(i) = 0.0 fdangle(i) = 0.0 hdangle(i) = 0.0 elseif (ndangle(i).eq.1.0) then sdangle(i) = sdangle(i)*degree fdangle(i) = 0.0 else x = dble(ndangle(i)) sdangle(i) = (sdangle(i)*degree)/x fdangle(i) = sqrt(fdangle(i)/(x-1.0))*degree endif hdangle(i) = degree*hdangle(i) if (ndrmc(i).eq.1) then fdrmc(i) = 0.0 else x = dble(ndrmc(i)) sdrmc(i) = sdrmc(i)/x fdrmc(i) = sqrt(fdrmc(i)/(x-1.0)) endif enddo C-RDC write(iout,'(/17X,"X",11X,"|",11X,"Y",11X,"|",11X,"Z", C-RDC & /" NROT.",6x,i6,18x,i6,18x,i6, C-RDC & /" NTR. ",6x,i6,18x,i6,18x,i6)') C-RDC & ndangle(1), ndangle(2), ndangle(3), C-RDC & ndrmc(1), ndrmc(2), ndrmc(3) C-RDC write(iout,'(/17X,"X",11X,"|",11X,"Y",11X,"|",11X,"Z", C-RDC & /,9x,"AV. STD.D. MAX. | AV. STD.D. MAX. |", C-RDC & " AV. STD.D. MAX.", C-RDC & /" ROT.",1X,F7.3,1X,F7.3,1X,F7.3,1X,F7.3,1X,F7.3,1X, C-RDC & F7.3,1X,F7.3,1X,F7.3,1X,F7.3," DEG.", C-RDC & /" TR. ",1X,F7.3,1X,F7.3,1X,F7.3,1X,F7.3,1X,F7.3,1X, C-RDC & F7.3,1X,F7.3,1X,F7.3,1X,F7.3," A")') C-RDC & sdangle(1), fdangle(1), hdangle(1), C-RDC & sdangle(2), fdangle(2), hdangle(2), C-RDC & sdangle(3), fdangle(3), hdangle(3), C-RDC & sdrmc(1), fdrmc(1), hdrmc(1), C-RDC & sdrmc(2), fdrmc(2), hdrmc(2), C-RDC & sdrmc(3), fdrmc(3), hdrmc(3) if (wrtmc) then C-RDC write(iscr,'(/17X,"X",11X,"|",11X,"Y",11X,"|",11X,"Z", C-RDC & /" nrot.",6x,i6,18x,i6,18x,i6, C-RDC & /" ntr. ",6x,i6,18x,i6,18x,i6)') C-RDC & ndangle(1), ndangle(2), ndangle(3), C-RDC & ndrmc(1), ndrmc(2), ndrmc(3) C-RDC write(iscr,'(/17X,"X",11X,"|",11X,"Y",11X,"|",11X,"Z", C-RDC & /,9x, C-RDC & "av. std.d. max. | av. std.d. max. |", C-RDC & " av. std.d. max.", C-RDC & /" rot.",1X,F7.3,1X,F7.3,1X,F7.3,1X,F7.3,1X,F7.3,1X, C-RDC & F7.3,1X,F7.3,1X,F7.3,1X,F7.3," deg.", C-RDC & /" tr. ",1X,F7.3,1X,F7.3,1X,F7.3,1X,F7.3,1X,F7.3,1X, C-RDC & F7.3,1X,F7.3,1X,F7.3,1X,F7.3," A")') C-RDC & sdangle(1), fdangle(1), hdangle(1), C-RDC & sdangle(2), fdangle(2), hdangle(2), C-RDC & sdangle(3), fdangle(3), hdangle(3), C-RDC & sdrmc(1), fdrmc(1), hdrmc(1), C-RDC & sdrmc(2), fdrmc(2), hdrmc(2), C-RDC & sdrmc(3), fdrmc(3), hdrmc(3) endif endif endif C C rejected if close contacts C if (.not.rok) then C-RDC write(iout,'(//" *** REJECTED BECAUSE OF CLOSE ", C-RDC & "CONTACTS (",F8.5," A);", C-RDC & /" *** NO ENERGIES HAVE BEEN CALCULATED.", C-RDC & /,"-----------------------------------------------", C-RDC & "--------------------")') rijmin if (wrtmc) then C-RDC write(iscr,'(//" *** rejected because of close ", C-RDC & "contacts (",F8.5," A);", C-RDC & /" *** no energies have been calculated.", C-RDC & /,"-----------------------------------------------", C-RDC & "--------------------")') rijmin endif return endif C C minimum /maximum distances C C-RDC write(iout,'(/" MINIMUM DISTANCE BETWEEN ATOMS OF", C-RDC & " DIFFERENT RESIDUES IS ",F18.8," A", C-RDC & /" MAXIMUM DISTANCE BETWEEN ATOMS OF", C-RDC & " DIFFERENT RESIDUES IS ",F18.8, C-RDC & " A")') rminimr, rmaximr if (wrtmc) then C-RDC write(iscr,'(/" minimum distance between atoms of", C-RDC & " different residues is ",F18.8," A", C-RDC & /" maximum distance between atoms of different", C-RDC & " residues is ",F18.8," A")') rminimr, rmaximr endif C C energy information etc. C if (ok) then C . accepted C-RDC write(iout,'(/" (ACCEPTED)", C-RDC & /" ELECTRONIC ENERGY: ",F18.8, C-RDC & " eV PRESSURE: ",F18.6," BAR", C-RDC & /" CORE-CORE REPULSION: ",F18.8, C-RDC & " eV VIRIAL: ",F18.6," KCAL")') C-RDC & eelect,pressins,ecore,vir if (wrtmc) then C-RDC write(iscr,'(/" (accepted)", C-RDC & /" electronic energy: ",F18.8, C-RDC & " eV pressure: ",F18.6," bar", C-RDC & /" core-core repulsion: ",F18.8, C-RDC & " eV virial: ",F18.6," kcal")') C-RDC & eelect,pressins,ecore,vir endif else C . rejected C-RDC write(iout,'(/" (REJECTED)", C-RDC & /" ELECTRONIC ENERGY: ",F18.8," eV", C-RDC & /" CORE-CORE REPULSION: ",F18.8," eV")') C-RDC & eelect,ecore if (wrtmc) then C-RDC write(iscr,'(/" (rejected)", C-RDC & /" electronic energy: ",F18.8," eV", C-RDC & /" core-core repulsion: ",F18.8," eV")') C-RDC & eelect,ecore endif endif C C PME info C if (pme) then C-RDC write(iout,'(" PME DIRECT ENERGY: ",F18.8," eV", C-RDC & /" PME RECIPROCAL ENERGY:",F18.8," eV", C-RDC & /" PME SELF ENERGY: ",F18.8," eV", C-RDC & /" CLAS. COULOMB ENERGY: ",F18.8," eV", C-RDC & /" TOTAL LONG RANGE: ",F18.8," eV")') C-RDC & pmedir,pmerec,pmeself,ecoul,elr if (wrtmc) then C-RDC write(iscr,'(" PME direct energy: ",F18.8," eV", C-RDC & /" PME reciprocal energy:",F18.8," eV", C-RDC & /" PME self energy: ",F18.8," eV", C-RDC & /" clas. Coulomb energy: ",F18.8," eV", C-RDC & /" total long range: ",F18.8," eV")') C-RDC & pmedir,pmerec,pmeself,ecoul,elr endif endif C C more energy info etc. C if (iensemb.eq.0) then C . NVT C-RDC write(iout,'(" *TOTAL ENERGY: ",F18.8," eV", C-RDC & /" HEAT OF FORMATION: ",F18.8," KCAL/MOL")') C-RDC & etot,eheat if (wrtmc) then C-RDC write(iscr,'(" *total energy: ",F18.8," eV", C-RDC & /" heat of formation: ",F18.8," kcal/mol")') C-RDC & etot,eheat endif else C . NPT C-RDC write(iout,'(" TOTAL ENERGY: ",F18.8, C-RDC & " eV VOLUME: ",F18.6," A^3", C-RDC & /" HEAT OF FORMATION: ",F18.8, C-RDC & " KCAL/MOL DENSITY: ",F18.6," A^-3", C-RDC & /" PRESSURE TERM: ",F18.8," eV", C-RDC & /" *ENTHALPY ",F18.8," eV")') C-RDC & etot,boxvol,eheat,dens,pterm,enth if (wrtmc) then C-RDC write(iscr,'(" total energy: ",F18.8, C-RDC & " eV volume: ",F18.6," A^3", C-RDC & /" heat of formation: ",F18.8, C-RDC & " kcal/mol density: ",F18.6," A^-3", C-RDC & /" pressure term: ",F18.8," eV", C-RDC & /" *enthalpy: ",F18.8," eV")') C-RDC & etot,boxvol,eheat,dens,pterm,enth endif endif call wrttimmc(imc) end