From ed7a32368e30022a229b1f87ca974daa9e3203a2 Mon Sep 17 00:00:00 2001 From: Moses Date: Thu, 21 Mar 2024 14:41:05 -0500 Subject: [PATCH 01/29] save ustc and coordsave implement --- interface/c/tinker/detail/output.hh | 2 + interface/c/tinker/routines.h | 4 + interface/cpp/tinker/detail/output.hh | 6 + interface/cpp/tinker/routines.h | 4 + source/bounds.f | 1 + source/control.f | 3 + source/mdinit.f | 3 + source/mdsave.f | 119 ++++++++----- source/output.f | 4 + source/prtuind.f | 230 ++++++++++++++++++++++++++ 10 files changed, 338 insertions(+), 38 deletions(-) diff --git a/interface/c/tinker/detail/output.hh b/interface/c/tinker/detail/output.hh index fdf26b2f0..6ee7a6108 100644 --- a/interface/c/tinker/detail/output.hh +++ b/interface/c/tinker/detail/output.hh @@ -9,12 +9,14 @@ extern int TINKER_MOD(output, archive); extern int TINKER_MOD(output, binary); extern int TINKER_MOD(output, noversion); extern int TINKER_MOD(output, overwrite); +extern int TINKER_MOD(output, coordsave); extern int TINKER_MOD(output, cyclesave); extern int TINKER_MOD(output, arcsave); extern int TINKER_MOD(output, dcdsave); extern int TINKER_MOD(output, velsave); extern int TINKER_MOD(output, frcsave); extern int TINKER_MOD(output, uindsave); +extern int TINKER_MOD(output, ustcsave); extern char TINKER_MOD(output, coordtype)[9]; #ifdef __cplusplus } diff --git a/interface/c/tinker/routines.h b/interface/c/tinker/routines.h index b3e8b0440..3f9c1fd09 100644 --- a/interface/c/tinker/routines.h +++ b/interface/c/tinker/routines.h @@ -2238,6 +2238,10 @@ void prtuind_(int* iind); #define tinker_f_prtuind prtuind_ void prtdcdu_(int* idcd, int* first); #define tinker_f_prtdcdu prtdcdu_ +void prtustc_(int* istc); +#define tinker_f_prtustc prtustc_ +void prtdcdd_(int* idcd, int* first); +#define tinker_f_prtdcdd prtdcdd_ // prtvel.f void prtvel_(int* ivel); diff --git a/interface/cpp/tinker/detail/output.hh b/interface/cpp/tinker/detail/output.hh index a71ad373c..04e1e7b94 100644 --- a/interface/cpp/tinker/detail/output.hh +++ b/interface/cpp/tinker/detail/output.hh @@ -7,12 +7,14 @@ extern int& archive; extern int& binary; extern int& noversion; extern int& overwrite; +extern int& coordsave; extern int& cyclesave; extern int& arcsave; extern int& dcdsave; extern int& velsave; extern int& frcsave; extern int& uindsave; +extern int& ustcsave; extern char (&coordtype)[9]; #ifdef TINKER_FORTRAN_MODULE_CPP @@ -20,24 +22,28 @@ extern "C" int TINKER_MOD(output, archive); extern "C" int TINKER_MOD(output, binary); extern "C" int TINKER_MOD(output, noversion); extern "C" int TINKER_MOD(output, overwrite); +extern "C" int TINKER_MOD(output, coordsave); extern "C" int TINKER_MOD(output, cyclesave); extern "C" int TINKER_MOD(output, arcsave); extern "C" int TINKER_MOD(output, dcdsave); extern "C" int TINKER_MOD(output, velsave); extern "C" int TINKER_MOD(output, frcsave); extern "C" int TINKER_MOD(output, uindsave); +extern "C" int TINKER_MOD(output, ustcsave); extern "C" char TINKER_MOD(output, coordtype)[9]; int& archive = TINKER_MOD(output, archive); int& binary = TINKER_MOD(output, binary); int& noversion = TINKER_MOD(output, noversion); int& overwrite = TINKER_MOD(output, overwrite); +int& coordsave = TINKER_MOD(output, coordsave); int& cyclesave = TINKER_MOD(output, cyclesave); int& arcsave = TINKER_MOD(output, arcsave); int& dcdsave = TINKER_MOD(output, dcdsave); int& velsave = TINKER_MOD(output, velsave); int& frcsave = TINKER_MOD(output, frcsave); int& uindsave = TINKER_MOD(output, uindsave); +int& ustcsave = TINKER_MOD(output, ustcsave); char (&coordtype)[9] = TINKER_MOD(output, coordtype); #endif } } diff --git a/interface/cpp/tinker/routines.h b/interface/cpp/tinker/routines.h index b3e8b0440..3f9c1fd09 100644 --- a/interface/cpp/tinker/routines.h +++ b/interface/cpp/tinker/routines.h @@ -2238,6 +2238,10 @@ void prtuind_(int* iind); #define tinker_f_prtuind prtuind_ void prtdcdu_(int* idcd, int* first); #define tinker_f_prtdcdu prtdcdu_ +void prtustc_(int* istc); +#define tinker_f_prtustc prtustc_ +void prtdcdd_(int* idcd, int* first); +#define tinker_f_prtdcdd prtdcdd_ // prtvel.f void prtvel_(int* ivel); diff --git a/source/bounds.f b/source/bounds.f index 228a88683..941deec87 100644 --- a/source/bounds.f +++ b/source/bounds.f @@ -33,6 +33,7 @@ subroutine bounds c c locate the center of mass of each molecule c + print*, "bounds" do i = 1, nmol init = imol(1,i) stop = imol(2,i) diff --git a/source/control.f b/source/control.f index 51f734229..d6bc4aa88 100644 --- a/source/control.f +++ b/source/control.f @@ -41,6 +41,7 @@ subroutine control cyclesave = .false. noversion = .false. overwrite = .false. + coordsave = .true. c c check for control parameters on the command line c @@ -90,6 +91,8 @@ subroutine control noversion = .true. else if (keyword(1:10) .eq. 'OVERWRITE ') then overwrite = .true. + else if (keyword(1:8) .eq. 'NOCOORD ') then + coordsave = .false. end if 10 continue end do diff --git a/source/mdinit.f b/source/mdinit.f index 525fda89b..38d68e22c 100644 --- a/source/mdinit.f +++ b/source/mdinit.f @@ -70,6 +70,7 @@ subroutine mdinit (dt) velsave = .false. frcsave = .false. uindsave = .false. + ustcsave = .false. friction = 91.0d0 use_sdarea = .false. iprint = 100 @@ -122,6 +123,8 @@ subroutine mdinit (dt) frcsave = .true. else if (keyword(1:13) .eq. 'SAVE-INDUCED ') then uindsave = .true. + else if (keyword(1:13) .eq. 'SAVE-USTATIC ') then + ustcsave = .true. else if (keyword(1:9) .eq. 'FRICTION ') then read (string,*,err=10,end=10) friction else if (keyword(1:17) .eq. 'FRICTION-SCALING ') then diff --git a/source/mdsave.f b/source/mdsave.f index e3d4eb83a..9c9a7d419 100644 --- a/source/mdsave.f +++ b/source/mdsave.f @@ -39,7 +39,7 @@ subroutine mdsave (istep,dt,epot,eksum) integer i,j,ii integer istep integer ixyz,iind - integer ivel,ifrc + integer ivel,ifrc,istc integer iend,isave,lext integer freeunit,trimtext integer modsave @@ -52,6 +52,7 @@ subroutine mdsave (istep,dt,epot,eksum) character*240 velfile character*240 frcfile character*240 indfile + character*240 stcfile c c c send data via external socket communication if desired @@ -128,42 +129,44 @@ subroutine mdsave (istep,dt,epot,eksum) c c save coordinates to archive or numbered structure file c - ixyz = freeunit () - if (cyclesave) then - xyzfile = filename(1:leng)//'.'//ext(1:lext) - call version (xyzfile,'new') - open (unit=ixyz,file=xyzfile,status='new') - call prtxyz (ixyz) - else if (dcdsave) then - xyzfile = filename(1:leng) - call suffix (xyzfile,'dcd','old') - inquire (file=xyzfile,exist=exist) - if (exist) then - first = .false. - open (unit=ixyz,file=xyzfile,form='unformatted', - & status='old',position='append') - else - first = .true. - open (unit=ixyz,file=xyzfile,form='unformatted', - & status='new') - end if - call prtdcd (ixyz,first) - else - xyzfile = filename(1:leng) - call suffix (xyzfile,'arc','old') - inquire (file=xyzfile,exist=exist) - if (exist) then - call openend (ixyz,xyzfile) - else + write (iout,170) isave + 170 format (' Frame Number',13x,i10) + if (coordsave) then + ixyz = freeunit () + if (cyclesave) then + xyzfile = filename(1:leng)//'.'//ext(1:lext) + call version (xyzfile,'new') open (unit=ixyz,file=xyzfile,status='new') + call prtxyz (ixyz) + else if (dcdsave) then + xyzfile = filename(1:leng) + call suffix (xyzfile,'dcd','old') + inquire (file=xyzfile,exist=exist) + if (exist) then + first = .false. + open (unit=ixyz,file=xyzfile,form='unformatted', + & status='old',position='append') + else + first = .true. + open (unit=ixyz,file=xyzfile,form='unformatted', + & status='new') + end if + call prtdcd (ixyz,first) + else + xyzfile = filename(1:leng) + call suffix (xyzfile,'arc','old') + inquire (file=xyzfile,exist=exist) + if (exist) then + call openend (ixyz,xyzfile) + else + open (unit=ixyz,file=xyzfile,status='new') + end if + call prtxyz (ixyz) end if - call prtxyz (ixyz) + close (unit=ixyz) + write (iout,180) xyzfile(1:trimtext(xyzfile)) + 180 format (' Coordinate File',13x,a) end if - close (unit=ixyz) - write (iout,170) isave - 170 format (' Frame Number',13x,i10) - write (iout,180) xyzfile(1:trimtext(xyzfile)) - 180 format (' Coordinate File',13x,a) c c update the information needed to restart the trajectory c @@ -267,6 +270,7 @@ subroutine mdsave (istep,dt,epot,eksum) indfile = filename(1:leng)//'.'//ext(1:lext)//'u' call version (indfile,'new') open (unit=iind,file=indfile,status='new') + call prtuind (iind) else if (dcdsave) then indfile = filename(1:leng) call suffix (indfile,'dcdu','old') @@ -297,6 +301,45 @@ subroutine mdsave (istep,dt,epot,eksum) 300 format (' Induced Dipole File',9x,a) end if c +c save the static dipole components for the current step +c + if (ustcsave) then + istc = freeunit () + if (cyclesave) then + stcfile = filename(1:leng)//'.'//ext(1:lext)//'d' + call version (stcfile,'new') + open (unit=istc,file=stcfile,status='new') + call prtustc (istc) + else if (dcdsave) then + stcfile = filename(1:leng) + call suffix (stcfile,'dcdd','old') + inquire (file=stcfile,exist=exist) + if (exist) then + first = .false. + open (unit=istc,file=stcfile,form='unformatted', + & status='old',position='append') + else + first = .true. + open (unit=istc,file=stcfile,form='unformatted', + & status='new') + end if + call prtdcdd (istc,first) + else + stcfile = filename(1:leng) + call suffix (stcfile,'ustc','old') + inquire (file=stcfile,exist=exist) + if (exist) then + call openend (istc,stcfile) + else + open (unit=istc,file=stcfile,status='new') + end if + call prtustc (istc) + end if + close (unit=istc) + write (iout,310) stcfile(1:trimtext(stcfile)) + 310 format (' Static Dipole File',10x,a) + end if +c c test for requested termination of the dynamics calculation c endfile = 'tinker.end' @@ -311,8 +354,8 @@ subroutine mdsave (istep,dt,epot,eksum) end if end if if (exist) then - write (iout,310) - 310 format (/,' MDSAVE -- Dynamics Calculation Ending', + write (iout,320) + 320 format (/,' MDSAVE -- Dynamics Calculation Ending', & ' due to User Request') call fatal end if @@ -321,8 +364,8 @@ subroutine mdsave (istep,dt,epot,eksum) c modsave = mod(istep,iprint) if (verbose .and. modsave.ne.0) then - write (iout,320) - 320 format () + write (iout,330) + 330 format () end if return end diff --git a/source/output.f b/source/output.f index 9d36de979..695fabf3b 100644 --- a/source/output.f +++ b/source/output.f @@ -16,12 +16,14 @@ c binary logical flag for coordinates in DCD binary format c noversion logical flag governing use of filename versions c overwrite logical flag to overwrite intermediate files inplace +c coordsave logical flag to save coordinates c arcsave logical flag to save coordinates in Tinker XYZ format c dcdsave logical flag to save coordinates in DCD binary format c cyclesave logical flag to mark use of numbered cycle files c velsave logical flag to save velocity vector components c frcsave logical flag to save force vector components c uindsave logical flag to save induced atomic dipoles +c ustcsave logical flag to save static atomic dipoles c coordtype selects Cartesian, internal, rigid body or none c c @@ -31,12 +33,14 @@ module output logical binary logical noversion logical overwrite + logical coordsave logical cyclesave logical arcsave logical dcdsave logical velsave logical frcsave logical uindsave + logical ustcsave character*9 coordtype save end diff --git a/source/prtuind.f b/source/prtuind.f index 97dd918f9..2fb80b7a6 100644 --- a/source/prtuind.f +++ b/source/prtuind.f @@ -229,3 +229,233 @@ subroutine prtdcdu (idcd,first) if (.not. opened) close (unit=idcd) return end +c +c +c ############################################################### +c ## ## +c ## subroutine prtustc -- output of atomic static dipoles ## +c ## ## +c ############################################################### +c +c +c "prtustc" writes out a set of static dipole components +c to an external disk file in Tinker XYZ format +c +c + subroutine prtustc (istc) + use atomid + use atoms + use bound + use boxes + use couple + use files + use inform + use mpole + use titles + use units + implicit none + integer i,j,k,istc + integer size,crdsiz + real*8 crdmin,crdmax + real*8 c,xd,yd,zd + logical opened + character*2 atmc + character*2 crdc + character*2 digc + character*25 fstr + character*240 stcfile +c +c +c open the output unit if not already done +c + inquire (unit=istc,opened=opened) + if (.not. opened) then + stcfile = filename(1:leng)//'.ustc' + call version (stcfile,'new') + open (unit=istc,file=stcfile,status='new') + end if +c +c check for large systems needing extended formatting +c + atmc = 'i6' + if (n .ge. 100000) atmc = 'i7' + if (n .ge. 1000000) atmc = 'i8' + crdmin = 0.0d0 + crdmax = 0.0d0 + do i = 1, n + crdmin = min(crdmin,x(i),y(i),z(i)) + crdmax = max(crdmax,x(i),y(i),z(i)) + end do + crdsiz = 6 + if (crdmin .le. -1000.0d0) crdsiz = 7 + if (crdmax .ge. 10000.0d0) crdsiz = 7 + if (crdmin .le. -10000.0d0) crdsiz = 8 + if (crdmax .ge. 100000.0d0) crdsiz = 8 + crdsiz = crdsiz + max(6,digits) + size = 0 + call numeral (crdsiz,crdc,size) + if (digits .le. 6) then + digc = '6 ' + else if (digits .le. 8) then + digc = '8' + else + digc = '10' + end if +c +c write out the number of atoms and the title +c + if (ltitle .eq. 0) then + fstr = '('//atmc//')' + write (istc,fstr(1:4)) n + else + fstr = '('//atmc//',2x,a)' + write (istc,fstr(1:9)) n,title(1:ltitle) + end if +c +c write out the periodic cell lengths and angles +c + if (use_bounds) then + fstr = '(1x,6f'//crdc//'.'//digc//')' + write (istc,fstr) xbox,ybox,zbox,alpha,beta,gamma + end if +c +c write out the static dipole components for each atom +c + fstr = '('//atmc//',2x,a3,3f'//crdc// + & '.'//digc//',i6,8'//atmc//')' + do i = 1, n + c = rpole(1,i) + xd = (x(i)*c + rpole(2,i)) * debye + yd = (y(i)*c + rpole(3,i)) * debye + zd = (z(i)*c + rpole(4,i)) * debye + k = n12(i) + if (k .eq. 0) then + write (istc,fstr) i,name(i),xd,yd,zd,type(i) + else + write (istc,fstr) i,name(i),xd,yd,zd,type(i), + & (i12(j,i),j=1,k) + end if + end do +c +c close the output unit if opened by this routine +c + if (.not. opened) close (unit=istc) + return + end +c +c +c ############################################################ +c ## ## +c ## subroutine prtdcdd -- output of DCD static dipoles ## +c ## ## +c ############################################################ +c +c +c "prtdcdd" writes out a set of static dipole components to +c a file in CHARMM DCD binary format compatible with the VMD +c visualization software and other packages +c +c note the format used is based on the "dcdplugin.c" code from +c the NAMD and VMD programs, and tutorial 4.1 from the software +c package GENESIS: Generalized-Ensemble Simulation System +c +c variables and parameters: +c +c header type of data (CORD=coordinates, VELD=velocities) +c nframe number of frames stored in the DCD file +c nprev number of previous integration steps +c ncrdsav frequency in steps for saving coordinate frames +c nstep number of integration steps in the total run +c nvelsav frequency of coordinate saves with velocity data +c ndfree number of degrees of freedom for the system +c nfixat number of fixed atoms for the system +c usebox flag for periodic boundaries (1=true, 0=false) +c use4d flag for 4D trajectory (1=true, 0=false) +c usefq flag for fluctuating charges (1=true, 0=false) +c merged result of merge without checks (1=true, 0=false) +c vcharmm version of CHARMM software for compatibility +c +c in general a value of zero for any of the above indicates that +c the particular feature is unused +c +c + subroutine prtdcdd (idcd,first) + use atoms + use bound + use boxes + use files + use mpole + use titles + use units + implicit none + integer i,idcd + integer zero,one + integer nframe,nprev + integer ncrdsav,nstep + integer nvelsav,ndfree + integer nfixat,usebox + integer use4d,usefq + integer merged,vcharmm + integer ntitle + real*4 tdelta + logical opened,first + character*4 header + character*240 dcdfile +c +c +c open the output unit if not already done +c + inquire (unit=idcd,opened=opened) + if (.not. opened) then + dcdfile = filename(1:leng)//'.dcdd' + call version (dcdfile,'new') + open (unit=idcd,file=dcdfile,form='unformatted',status='new') + end if +c +c write header info along with title and number of atoms +c + if (first) then + first = .false. + zero = 0 + one = 1 + header = 'CORD' + nframe = zero + nprev = zero + ncrdsav = one + nstep = zero + nvelsav = zero + ndfree = zero + nfixat = zero + tdelta = 0.0 + usebox = zero + if (use_bounds) usebox = one + use4d = zero + usefq = zero + merged = zero + vcharmm = 24 + ntitle = one + write (idcd) header,nframe,nprev,ncrdsav,nstep, + & nvelsav,zero,zero,ndfree,nfixat, + & tdelta,usebox,use4d,usefq,merged, + & zero,zero,zero,zero,zero,vcharmm + write (idcd) ntitle,title(1:80) + write (idcd) n + end if +c +c append the lattice values based on header flag value +c + if (use_bounds) then + write (idcd) xbox,gamma_cos,ybox,beta_cos,alpha_cos,zbox + end if +c +c append the static dipoles along each axis in turn +c + write (idcd) (real(debye*(x(i)*rpole(1,i) + rpole(2,i))),i=1,n) + write (idcd) (real(debye*(y(i)*rpole(1,i) + rpole(3,i))),i=1,n) + write (idcd) (real(debye*(z(i)*rpole(1,i) + rpole(4,i))),i=1,n) +c +c close the output unit if opened by this routine +c + if (.not. opened) close (unit=idcd) + return + end From 6f0187e0d6d23dd6ac5a8708130d5184dbcf990c Mon Sep 17 00:00:00 2001 From: Moses Date: Thu, 21 Mar 2024 20:48:17 -0500 Subject: [PATCH 02/29] print system dipole implementation --- source/bounds.f | 1 - source/mdinit.f | 3 +++ source/mdsave.f | 41 +++++++++++++++++++++--------- source/moments.f | 65 ++++++++++++++++++++++++++++++++++++++++++++++++ source/output.f | 2 ++ 5 files changed, 99 insertions(+), 13 deletions(-) diff --git a/source/bounds.f b/source/bounds.f index 941deec87..228a88683 100644 --- a/source/bounds.f +++ b/source/bounds.f @@ -33,7 +33,6 @@ subroutine bounds c c locate the center of mass of each molecule c - print*, "bounds" do i = 1, nmol init = imol(1,i) stop = imol(2,i) diff --git a/source/mdinit.f b/source/mdinit.f index 38d68e22c..ebd2ea0e5 100644 --- a/source/mdinit.f +++ b/source/mdinit.f @@ -71,6 +71,7 @@ subroutine mdinit (dt) frcsave = .false. uindsave = .false. ustcsave = .false. + usyssave = .false. friction = 91.0d0 use_sdarea = .false. iprint = 100 @@ -125,6 +126,8 @@ subroutine mdinit (dt) uindsave = .true. else if (keyword(1:13) .eq. 'SAVE-USTATIC ') then ustcsave = .true. + else if (keyword(1:13) .eq. 'SAVE-USYSTEM ') then + usyssave = .true. else if (keyword(1:9) .eq. 'FRICTION ') then read (string,*,err=10,end=10) friction else if (keyword(1:17) .eq. 'FRICTION-SCALING ') then diff --git a/source/mdsave.f b/source/mdsave.f index 9c9a7d419..7dfe8d8f7 100644 --- a/source/mdsave.f +++ b/source/mdsave.f @@ -28,6 +28,7 @@ subroutine mdsave (istep,dt,epot,eksum) use inform use iounit use mdstuf + use moment use mpole use output use polar @@ -127,10 +128,26 @@ subroutine mdsave (istep,dt,epot,eksum) c if (use_bounds) call bounds c +c compute total dipole of system if desired +c + if (usyssave) then + call dmoments + if (digits .le. 6) then + write (iout,170) xdpl,ydpl,zdpl + 170 format (' System Dipole Moment',1x,3f14.6) + else if (digits .le. 8) then + write (iout,180) xdpl,ydpl,zdpl + 180 format (' System Dipole Moment',1x,3f16.8) + else + write (iout,190) xdpl,ydpl,zdpl + 190 format (' System Dipole Moment',1x,3f18.10) + end if + end if +c c save coordinates to archive or numbered structure file c - write (iout,170) isave - 170 format (' Frame Number',13x,i10) + write (iout,200) isave + 200 format (' Frame Number',13x,i10) if (coordsave) then ixyz = freeunit () if (cyclesave) then @@ -164,8 +181,8 @@ subroutine mdsave (istep,dt,epot,eksum) call prtxyz (ixyz) end if close (unit=ixyz) - write (iout,180) xyzfile(1:trimtext(xyzfile)) - 180 format (' Coordinate File',13x,a) + write (iout,210) xyzfile(1:trimtext(xyzfile)) + 210 format (' Coordinate File',13x,a) end if c c update the information needed to restart the trajectory @@ -204,13 +221,13 @@ subroutine mdsave (istep,dt,epot,eksum) end if end if if (integrate .eq. 'RIGIDBODY') then - write (ivel,190) ngrp,title(1:ltitle) - 190 format (i6,2x,a) + write (ivel,220) ngrp,title(1:ltitle) + 220 format (i6,2x,a) do i = 1, ngrp - write (ivel,200) i,(vcm(j,i),j=1,3) - 200 format (i6,3x,d13.6,3x,d13.6,3x,d13.6) - write (ivel,210) i,(wcm(j,i),j=1,3) - 210 format (i6,3x,d13.6,3x,d13.6,3x,d13.6) + write (ivel,230) i,(vcm(j,i),j=1,3) + 230 format (i6,3x,d13.6,3x,d13.6,3x,d13.6) + write (ivel,240) i,(wcm(j,i),j=1,3) + 240 format (i6,3x,d13.6,3x,d13.6,3x,d13.6) end do else if (dcdsave) then call prtdcdv (ivel,first) @@ -218,8 +235,8 @@ subroutine mdsave (istep,dt,epot,eksum) call prtvel (ivel) end if close (unit=ivel) - write (iout,240) velfile(1:trimtext(velfile)) - 240 format (' Velocity File',15x,a) + write (iout,250) velfile(1:trimtext(velfile)) + 250 format (' Velocity File',15x,a) end if c c save the force vector components for the current step, diff --git a/source/moments.f b/source/moments.f index d9dfced0d..982bf9b04 100644 --- a/source/moments.f +++ b/source/moments.f @@ -309,3 +309,68 @@ subroutine moments (mode) call jacobi (3,a,netqpl,b) return end +c +c +c ############################################################## +c ## ## +c ## subroutine dmoments -- total electric dipole moments ## +c ## ## +c ############################################################## +c +c +c "dmoments" computes the total dipole moments over all atoms; +c called in mdsave, it is assumed bound is called +c +c + subroutine dmoments + use atoms + use moment + use mpole + use polar + use potent + use units + implicit none + integer i +c +c +c zero out total dipole moment +c + xdpl = 0.0d0 + ydpl = 0.0d0 + zdpl = 0.0d0 +c +c OpenMP directives for the major loop structure +c +!$OMP PARALLEL default(private) +!$OMP& shared(n,x,y,z,rpole,uind,use_polar,xdpl,ydpl,zdpl) +!$OMP DO reduction(+:xdpl,ydpl,zdpl) schedule(guided) +c +c compute the static dipole moment +c + do i = 1, n + xdpl = xdpl + x(i)*rpole(1,i) + rpole(2,i) + ydpl = ydpl + y(i)*rpole(1,i) + rpole(3,i) + zdpl = zdpl + z(i)*rpole(1,i) + rpole(4,i) + end do +!$OMP END DO +c +c compute the induced dipole moment +c + if (use_polar) then +!$OMP DO reduction(+:xdpl,ydpl,zdpl) schedule(guided) + do i = 1, n + xdpl = xdpl + uind(1,i) + ydpl = ydpl + uind(2,i) + zdpl = zdpl + uind(3,i) + end do +!$OMP END DO + end if +!$OMP END PARALLEL +c +c convert dipole to Debye +c + xdpl = xdpl * debye + ydpl = ydpl * debye + zdpl = zdpl * debye + return + end diff --git a/source/output.f b/source/output.f index 695fabf3b..d81c51b81 100644 --- a/source/output.f +++ b/source/output.f @@ -24,6 +24,7 @@ c frcsave logical flag to save force vector components c uindsave logical flag to save induced atomic dipoles c ustcsave logical flag to save static atomic dipoles +c usyssave logical flag to save total dipole of the system c coordtype selects Cartesian, internal, rigid body or none c c @@ -41,6 +42,7 @@ module output logical frcsave logical uindsave logical ustcsave + logical usyssave character*9 coordtype save end From cf1503aa9ccee0c57e1b37ed596cf0ce357ef2b1 Mon Sep 17 00:00:00 2001 From: Moses Date: Thu, 21 Mar 2024 20:49:32 -0500 Subject: [PATCH 03/29] generate interface --- interface/c/tinker/detail/output.hh | 1 + interface/c/tinker/routines.h | 2 ++ interface/cpp/tinker/detail/output.hh | 3 +++ interface/cpp/tinker/routines.h | 2 ++ 4 files changed, 8 insertions(+) diff --git a/interface/c/tinker/detail/output.hh b/interface/c/tinker/detail/output.hh index 6ee7a6108..2ce8d6303 100644 --- a/interface/c/tinker/detail/output.hh +++ b/interface/c/tinker/detail/output.hh @@ -17,6 +17,7 @@ extern int TINKER_MOD(output, velsave); extern int TINKER_MOD(output, frcsave); extern int TINKER_MOD(output, uindsave); extern int TINKER_MOD(output, ustcsave); +extern int TINKER_MOD(output, usyssave); extern char TINKER_MOD(output, coordtype)[9]; #ifdef __cplusplus } diff --git a/interface/c/tinker/routines.h b/interface/c/tinker/routines.h index 3f9c1fd09..7d092b38c 100644 --- a/interface/c/tinker/routines.h +++ b/interface/c/tinker/routines.h @@ -1932,6 +1932,8 @@ void moments_(char* mode, tinker_fchar_len_t mode_cap); inline void tinker_f_moments(tinker_fchars mode) { return moments_(mode.string, mode.capacity); } +void dmoments_(); +#define tinker_f_dmoments dmoments_ // mutate.f void mutate_(); diff --git a/interface/cpp/tinker/detail/output.hh b/interface/cpp/tinker/detail/output.hh index 04e1e7b94..9cbc2049d 100644 --- a/interface/cpp/tinker/detail/output.hh +++ b/interface/cpp/tinker/detail/output.hh @@ -15,6 +15,7 @@ extern int& velsave; extern int& frcsave; extern int& uindsave; extern int& ustcsave; +extern int& usyssave; extern char (&coordtype)[9]; #ifdef TINKER_FORTRAN_MODULE_CPP @@ -30,6 +31,7 @@ extern "C" int TINKER_MOD(output, velsave); extern "C" int TINKER_MOD(output, frcsave); extern "C" int TINKER_MOD(output, uindsave); extern "C" int TINKER_MOD(output, ustcsave); +extern "C" int TINKER_MOD(output, usyssave); extern "C" char TINKER_MOD(output, coordtype)[9]; int& archive = TINKER_MOD(output, archive); @@ -44,6 +46,7 @@ int& velsave = TINKER_MOD(output, velsave); int& frcsave = TINKER_MOD(output, frcsave); int& uindsave = TINKER_MOD(output, uindsave); int& ustcsave = TINKER_MOD(output, ustcsave); +int& usyssave = TINKER_MOD(output, usyssave); char (&coordtype)[9] = TINKER_MOD(output, coordtype); #endif } } diff --git a/interface/cpp/tinker/routines.h b/interface/cpp/tinker/routines.h index 3f9c1fd09..7d092b38c 100644 --- a/interface/cpp/tinker/routines.h +++ b/interface/cpp/tinker/routines.h @@ -1932,6 +1932,8 @@ void moments_(char* mode, tinker_fchar_len_t mode_cap); inline void tinker_f_moments(tinker_fchars mode) { return moments_(mode.string, mode.capacity); } +void dmoments_(); +#define tinker_f_dmoments dmoments_ // mutate.f void mutate_(); From e8b97d681b6c595314c769b9b3a98a2ca69c7942 Mon Sep 17 00:00:00 2001 From: Moses Date: Thu, 21 Mar 2024 21:23:40 -0500 Subject: [PATCH 04/29] add coordsave to prtdyn --- source/mdsave.f | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/source/mdsave.f b/source/mdsave.f index 7dfe8d8f7..06518d8eb 100644 --- a/source/mdsave.f +++ b/source/mdsave.f @@ -187,7 +187,7 @@ subroutine mdsave (istep,dt,epot,eksum) c c update the information needed to restart the trajectory c - call prtdyn + if (coordsave) call prtdyn c c save the velocity vector components at the current step c From e84fa5c5bc783e47578b949e7f563dd113552407 Mon Sep 17 00:00:00 2001 From: Moses Date: Sat, 23 Mar 2024 16:41:37 -0500 Subject: [PATCH 05/29] implement SAVE-ONLY and SAVE-USYSEXC --- source/active.f | 226 +++++++++++++++++++++++++++++++++++++++++++++++ source/final.f | 7 ++ source/mdinit.f | 8 ++ source/mdsave.f | 56 +++++++----- source/moments.f | 46 ++++++---- source/output.f | 10 +++ source/prtfrc.f | 72 +++++++++++---- source/prtuind.f | 162 ++++++++++++++++++++++++--------- source/prtvel.f | 72 +++++++++++---- source/prtxyz.f | 72 +++++++++++---- 10 files changed, 599 insertions(+), 132 deletions(-) diff --git a/source/active.f b/source/active.f index f8bfdae2e..f0f2e99ea 100644 --- a/source/active.f +++ b/source/active.f @@ -243,3 +243,229 @@ subroutine active deallocate (fixed) return end +c +c +c ################################################################# +c ## ## +c ## subroutine saveonly -- set the list of save coord atoms ## +c ## ## +c ################################################################# +c +c +c "saveonly" sets the list of atoms that are used during +c coordinate saving routines +c +c + subroutine saveonly + use atoms + use iounit + use keys + use output + implicit none + integer i,j,next + integer nfixed + integer, allocatable :: fixed(:) + character*20 keyword + character*240 record + character*240 string + logical header + logical, allocatable :: saved(:) +c +c +c perform dynamic allocation of some global arrays +c + if (allocated(ionly)) deallocate (ionly) + if (allocated(ionlyinv)) deallocate (ionlyinv) + allocate (ionly(n)) + allocate (ionlyinv(n)) +c +c perform dynamic allocation of some local arrays +c + allocate (fixed(n)) + allocate (saved(n)) +c +c set defaults for the numbers and lists of saved atoms +c + nonly = 0 + do i = 1, n + ionly(i) = 0 + ionlyinv(i) = 0 + end do + nfixed = 0 + do i = 1, n + fixed(i) = 0 + saved(i) = .false. + end do +c +c get any keywords containing save-only atom parameters +c + do j = 1, nkey + next = 1 + record = keyline(j) + call gettext (record,keyword,next) + call upcase (keyword) + string = record(next:240) +c +c get any lists of atoms whose coordinates should be saved +c + if (keyword(1:10) .eq. 'SAVE-ONLY ') then + read (string,*,err=10,end=10) (fixed(i),i=nfixed+1,n) + 10 continue + do while (fixed(nfixed+1) .ne. 0) + nfixed = nfixed + 1 + end do + end if + end do +c +c remove saved atoms not in the system +c + header = .true. + do i = 1, n + if (abs(fixed(i)) .gt. n) then + fixed(i) = 0 + if (header) then + header = .false. + write (iout,20) + 20 format (/,' SAVEONLY -- Warning, Illegal Atom Number', + & ' in SAVE-ONLY Atom List') + end if + end if + end do +c +c set saved atoms to only those marked as save +c + i = 1 + do while (fixed(i) .ne. 0) + if (fixed(i) .gt. 0) then + j = fixed(i) + saved(j) = .true. + i = i + 1 + else + do j = abs(fixed(i)), abs(fixed(i+1)) + saved(j) = .true. + end do + i = i + 2 + end if + end do + do i = 1, n + if (saved(i)) then + nonly = nonly + 1 + ionly(nonly) = i + ionlyinv(i) = nonly + end if + end do + if (nonly > 0) onlysave = .true. +c +c perform deallocation of some local arrays +c + deallocate (fixed) + deallocate (saved) + return + end +c +c +c ################################################################ +c ## ## +c ## subroutine saveusys -- set exclusion for system dipole ## +c ## ## +c ################################################################ +c +c +c "saveusys" sets the list of atoms that are excluded while +c computing system dipole +c +c + subroutine saveusys + use atoms + use iounit + use keys + use output + implicit none + integer i,j,next + integer nfixed + integer, allocatable :: fixed(:) + character*20 keyword + character*240 record + character*240 string + logical header +c +c +c return if not computing system dipole +c + if (.not. usyssave) return +c +c perform dynamic allocation of some global arrays +c + if (allocated(usysuse)) deallocate (usysuse) + allocate (usysuse(n)) +c +c perform dynamic allocation of some local arrays +c + allocate (fixed(n)) +c +c set defaults for the numbers and lists of atoms to be used +c + do i = 1, n + usysuse(i) = .true. + end do + nfixed = 0 + do i = 1, n + fixed(i) = 0 + end do +c +c get any keywords containing save-usysexc atom parameters +c + do j = 1, nkey + next = 1 + record = keyline(j) + call gettext (record,keyword,next) + call upcase (keyword) + string = record(next:240) +c +c get any lists of atoms whose coordinates should be used +c + if (keyword(1:13) .eq. 'SAVE-USYSEXC ') then + read (string,*,err=10,end=10) (fixed(i),i=nfixed+1,n) + 10 continue + do while (fixed(nfixed+1) .ne. 0) + nfixed = nfixed + 1 + end do + end if + end do +c +c remove used atoms not in the system +c + header = .true. + do i = 1, n + if (abs(fixed(i)) .gt. n) then + fixed(i) = 0 + if (header) then + header = .false. + write (iout,20) + 20 format (/,' SAVEUSYS -- Warning, Illegal Atom Number', + & ' in SAVE-USYSEXC Atom List') + end if + end if + end do +c +c set inactive atoms to false +c + i = 1 + do while (fixed(i) .ne. 0) + if (fixed(i) .gt. 0) then + j = fixed(i) + usysuse(j) = .false. + i = i + 1 + else + do j = abs(fixed(i)), abs(fixed(i+1)) + usysuse(j) = .false. + end do + i = i + 2 + end if + end do +c +c perform deallocation of some local arrays +c + deallocate (fixed) + return + end diff --git a/source/final.f b/source/final.f index 46bc6e830..bcef492cc 100644 --- a/source/final.f +++ b/source/final.f @@ -96,6 +96,7 @@ subroutine final use opbend use opdist use orbits + use output use paths use pbstuf use pdb @@ -874,6 +875,12 @@ subroutine final if (allocated(worb)) deallocate (worb) if (allocated(emorb)) deallocate (emorb) c +c deallocation of global arrays from module output +c + if (allocated(ionly)) deallocate (ionly) + if (allocated(ionlyinv)) deallocate (ionlyinv) + if (allocated(usysuse)) deallocate (usysuse) +c c deallocation of global arrays from module paths c if (allocated(pc0)) deallocate (pc0) diff --git a/source/mdinit.f b/source/mdinit.f index ebd2ea0e5..412997a03 100644 --- a/source/mdinit.f +++ b/source/mdinit.f @@ -161,6 +161,14 @@ subroutine mdinit (dt) 10 continue end do c +c check for use of save-only keyword +c + call saveonly +c +c check for use of exclusion in save-usystem +c + call saveusys +c c check for use of induced dipole prediction methods c if (use_polar) call predict diff --git a/source/mdsave.f b/source/mdsave.f index 06518d8eb..b2b14002a 100644 --- a/source/mdsave.f +++ b/source/mdsave.f @@ -46,6 +46,8 @@ subroutine mdsave (istep,dt,epot,eksum) integer modsave real*8 dt,pico real*8 epot,eksum + real*8 xustc,yustc,zustc + real*8 xuind,yuind,zuind logical exist,first character*7 ext character*240 endfile @@ -131,23 +133,35 @@ subroutine mdsave (istep,dt,epot,eksum) c compute total dipole of system if desired c if (usyssave) then - call dmoments + call dmoments (xustc,yustc,zustc,xuind,yuind,zuind) if (digits .le. 6) then - write (iout,170) xdpl,ydpl,zdpl - 170 format (' System Dipole Moment',1x,3f14.6) + write (iout,170) xustc,yustc,zustc + 170 format (' System Static Dipole',1x,3f14.6) else if (digits .le. 8) then - write (iout,180) xdpl,ydpl,zdpl - 180 format (' System Dipole Moment',1x,3f16.8) + write (iout,180) xustc,yustc,zustc + 180 format (' System Static Dipole',1x,3f16.8) else - write (iout,190) xdpl,ydpl,zdpl - 190 format (' System Dipole Moment',1x,3f18.10) + write (iout,190) xustc,yustc,zustc + 190 format (' System Static Dipole',1x,3f18.10) + end if + if (use_polar) then + if (digits .le. 6) then + write (iout,200) xuind,yuind,zuind + 200 format (' System Induced Dipole',3f14.6) + else if (digits .le. 8) then + write (iout,210) xuind,yuind,zuind + 210 format (' System Induced Dipole',3f16.8) + else + write (iout,220) xuind,yuind,zuind + 220 format (' System Induced Dipole',3f18.10) + end if end if end if c c save coordinates to archive or numbered structure file c - write (iout,200) isave - 200 format (' Frame Number',13x,i10) + write (iout,230) isave + 230 format (' Frame Number',13x,i10) if (coordsave) then ixyz = freeunit () if (cyclesave) then @@ -181,8 +195,8 @@ subroutine mdsave (istep,dt,epot,eksum) call prtxyz (ixyz) end if close (unit=ixyz) - write (iout,210) xyzfile(1:trimtext(xyzfile)) - 210 format (' Coordinate File',13x,a) + write (iout,240) xyzfile(1:trimtext(xyzfile)) + 240 format (' Coordinate File',13x,a) end if c c update the information needed to restart the trajectory @@ -221,13 +235,13 @@ subroutine mdsave (istep,dt,epot,eksum) end if end if if (integrate .eq. 'RIGIDBODY') then - write (ivel,220) ngrp,title(1:ltitle) - 220 format (i6,2x,a) + write (ivel,250) ngrp,title(1:ltitle) + 250 format (i6,2x,a) do i = 1, ngrp - write (ivel,230) i,(vcm(j,i),j=1,3) - 230 format (i6,3x,d13.6,3x,d13.6,3x,d13.6) - write (ivel,240) i,(wcm(j,i),j=1,3) - 240 format (i6,3x,d13.6,3x,d13.6,3x,d13.6) + write (ivel,260) i,(vcm(j,i),j=1,3) + 260 format (i6,3x,d13.6,3x,d13.6,3x,d13.6) + write (ivel,270) i,(wcm(j,i),j=1,3) + 270 format (i6,3x,d13.6,3x,d13.6,3x,d13.6) end do else if (dcdsave) then call prtdcdv (ivel,first) @@ -235,8 +249,8 @@ subroutine mdsave (istep,dt,epot,eksum) call prtvel (ivel) end if close (unit=ivel) - write (iout,250) velfile(1:trimtext(velfile)) - 250 format (' Velocity File',15x,a) + write (iout,280) velfile(1:trimtext(velfile)) + 280 format (' Velocity File',15x,a) end if c c save the force vector components for the current step, @@ -275,8 +289,8 @@ subroutine mdsave (istep,dt,epot,eksum) call prtfrc (ifrc) end if close (unit=ifrc) - write (iout,270) frcfile(1:trimtext(frcfile)) - 270 format (' Force Vector File',11x,a) + write (iout,290) frcfile(1:trimtext(frcfile)) + 290 format (' Force Vector File',11x,a) end if c c save the induced dipole components for the current step diff --git a/source/moments.f b/source/moments.f index 982bf9b04..f90901971 100644 --- a/source/moments.f +++ b/source/moments.f @@ -322,46 +322,57 @@ subroutine moments (mode) c called in mdsave, it is assumed bound is called c c - subroutine dmoments + subroutine dmoments (xustc,yustc,zustc,xuind,yuind,zuind) use atoms use moment use mpole + use output use polar use potent use units implicit none integer i + real*8 xustc,yustc,zustc + real*8 xuind,yuind,zuind c c c zero out total dipole moment c - xdpl = 0.0d0 - ydpl = 0.0d0 - zdpl = 0.0d0 + xustc = 0.0d0 + yustc = 0.0d0 + zustc = 0.0d0 + xuind = 0.0d0 + yuind = 0.0d0 + zuind = 0.0d0 c c OpenMP directives for the major loop structure c !$OMP PARALLEL default(private) -!$OMP& shared(n,x,y,z,rpole,uind,use_polar,xdpl,ydpl,zdpl) -!$OMP DO reduction(+:xdpl,ydpl,zdpl) schedule(guided) +!$OMP& shared(n,x,y,z,rpole,uind,use_polar,usysuse, +!$OMP& xustc,yustc,zustc,xuind,yuind,zuind) +!$OMP DO reduction(+:xustc,yustc,zustc) schedule(guided) c c compute the static dipole moment c do i = 1, n - xdpl = xdpl + x(i)*rpole(1,i) + rpole(2,i) - ydpl = ydpl + y(i)*rpole(1,i) + rpole(3,i) - zdpl = zdpl + z(i)*rpole(1,i) + rpole(4,i) + if (usysuse(i)) then + xustc = xustc + x(i)*rpole(1,i) + rpole(2,i) + yustc = yustc + y(i)*rpole(1,i) + rpole(3,i) + zustc = zustc + z(i)*rpole(1,i) + rpole(4,i) + end if end do !$OMP END DO c c compute the induced dipole moment c if (use_polar) then -!$OMP DO reduction(+:xdpl,ydpl,zdpl) schedule(guided) +!$OMP DO reduction(+:xuind,yuind,zuind) schedule(guided) do i = 1, n - xdpl = xdpl + uind(1,i) - ydpl = ydpl + uind(2,i) - zdpl = zdpl + uind(3,i) + if (usysuse(i)) then + xuind = xuind + uind(1,i) + yuind = yuind + uind(2,i) + zuind = zuind + uind(3,i) + end if end do !$OMP END DO end if @@ -369,8 +380,11 @@ subroutine dmoments c c convert dipole to Debye c - xdpl = xdpl * debye - ydpl = ydpl * debye - zdpl = zdpl * debye + xustc = xustc * debye + yustc = yustc * debye + zustc = zustc * debye + xuind = xuind * debye + yuind = yuind * debye + zuind = zuind * debye return end diff --git a/source/output.f b/source/output.f index d81c51b81..7c1095fe8 100644 --- a/source/output.f +++ b/source/output.f @@ -12,11 +12,15 @@ c ################################################################ c c +c nonly total number of save sites in the system +c ionly number of the atom for each save site +c ionlyinv inverse map of ionly c archive logical flag for coordinates in Tinker XYZ format c binary logical flag for coordinates in DCD binary format c noversion logical flag governing use of filename versions c overwrite logical flag to overwrite intermediate files inplace c coordsave logical flag to save coordinates +c onlysave logical flag to only save certain coordinates c arcsave logical flag to save coordinates in Tinker XYZ format c dcdsave logical flag to save coordinates in DCD binary format c cyclesave logical flag to mark use of numbered cycle files @@ -25,17 +29,22 @@ c uindsave logical flag to save induced atomic dipoles c ustcsave logical flag to save static atomic dipoles c usyssave logical flag to save total dipole of the system +c usysuse true if an atom is used for system dipole calculation c coordtype selects Cartesian, internal, rigid body or none c c module output implicit none + integer nonly + integer, allocatable :: ionly(:) + integer, allocatable :: ionlyinv(:) logical archive logical binary logical noversion logical overwrite logical coordsave logical cyclesave + logical onlysave logical arcsave logical dcdsave logical velsave @@ -43,6 +52,7 @@ module output logical uindsave logical ustcsave logical usyssave + logical, allocatable :: usysuse(:) character*9 coordtype save end diff --git a/source/prtfrc.f b/source/prtfrc.f index 2cbc97bd9..f9c959444 100644 --- a/source/prtfrc.f +++ b/source/prtfrc.f @@ -25,9 +25,11 @@ subroutine prtfrc (ifrc) use deriv use files use inform + use output use titles implicit none integer i,j,k,ifrc + integer ii integer size,crdsiz real*8 crdmin,crdmax logical opened @@ -76,12 +78,22 @@ subroutine prtfrc (ifrc) c c write out the number of atoms and the title c - if (ltitle .eq. 0) then - fstr = '('//atmc//')' - write (ifrc,fstr(1:4)) n + if (.not. onlysave) then + if (ltitle .eq. 0) then + fstr = '('//atmc//')' + write (ifrc,fstr(1:4)) n + else + fstr = '('//atmc//',2x,a)' + write (ifrc,fstr(1:9)) n,title(1:ltitle) + end if else - fstr = '('//atmc//',2x,a)' - write (ifrc,fstr(1:9)) n,title(1:ltitle) + if (ltitle .eq. 0) then + fstr = '('//atmc//')' + write (ifrc,fstr(1:4)) nonly + else + fstr = '('//atmc//',2x,a)' + write (ifrc,fstr(1:9)) nonly,title(1:ltitle) + end if end if c c write out the periodic cell lengths and angles @@ -95,15 +107,28 @@ subroutine prtfrc (ifrc) c fstr = '('//atmc//',2x,a3,3f'//crdc// & '.'//digc//',i6,8'//atmc//')' - do i = 1, n - k = n12(i) - if (k .eq. 0) then - write (ifrc,fstr) i,name(i),(-desum(j,i),j=1,3),type(i) - else - write (ifrc,fstr) i,name(i),(-desum(j,i),j=1,3),type(i), - & (i12(j,i),j=1,k) - end if - end do + if (.not. onlysave) then + do i = 1, n + k = n12(i) + if (k .eq. 0) then + write (ifrc,fstr) i,name(i),(-desum(j,i),j=1,3),type(i) + else + write (ifrc,fstr) i,name(i),(-desum(j,i),j=1,3),type(i), + & (i12(j,i),j=1,k) + end if + end do + else + do ii = 1, nonly + i = ionly(ii) + k = n12(i) + if (k .eq. 0) then + write (ifrc,fstr) ii,name(i),(-desum(j,i),j=1,3),type(i) + else + write (ifrc,fstr) ii,name(i),(-desum(j,i),j=1,3),type(i), + & (ionlyinv(i12(j,i)),j=1,k) + end if + end do + end if c c close the output unit if opened by this routine c @@ -153,6 +178,7 @@ subroutine prtdcdf (idcd,first) use boxes use deriv use files + use output use titles implicit none integer i,idcd @@ -206,7 +232,11 @@ subroutine prtdcdf (idcd,first) & tdelta,usebox,use4d,usefq,merged, & zero,zero,zero,zero,zero,vcharmm write (idcd) ntitle,title(1:80) - write (idcd) n + if (.not. onlysave) then + write (idcd) n + else + write (idcd) nonly + end if end if c c append the lattice values based on header flag value @@ -217,9 +247,15 @@ subroutine prtdcdf (idcd,first) c c append the force components along each axis in turn c - write (idcd) (real(-desum(1,i)),i=1,n) - write (idcd) (real(-desum(2,i)),i=1,n) - write (idcd) (real(-desum(3,i)),i=1,n) + if (.not. onlysave) then + write (idcd) (real(-desum(1,i)),i=1,n) + write (idcd) (real(-desum(2,i)),i=1,n) + write (idcd) (real(-desum(3,i)),i=1,n) + else + write (idcd) (real(-desum(1,ionly(i))),i=1,nonly) + write (idcd) (real(-desum(2,ionly(i))),i=1,nonly) + write (idcd) (real(-desum(3,ionly(i))),i=1,nonly) + end if c c close the output unit if opened by this routine c diff --git a/source/prtuind.f b/source/prtuind.f index 2fb80b7a6..fc912b2f3 100644 --- a/source/prtuind.f +++ b/source/prtuind.f @@ -25,10 +25,12 @@ subroutine prtuind (iind) use files use inform use polar + use output use titles use units implicit none integer i,j,k,iind + integer ii integer size,crdsiz real*8 crdmin,crdmax logical opened @@ -77,12 +79,22 @@ subroutine prtuind (iind) c c write out the number of atoms and the title c - if (ltitle .eq. 0) then - fstr = '('//atmc//')' - write (iind,fstr(1:4)) n + if (.not. onlysave) then + if (ltitle .eq. 0) then + fstr = '('//atmc//')' + write (iind,fstr(1:4)) n + else + fstr = '('//atmc//',2x,a)' + write (iind,fstr(1:9)) n,title(1:ltitle) + end if else - fstr = '('//atmc//',2x,a)' - write (iind,fstr(1:9)) n,title(1:ltitle) + if (ltitle .eq. 0) then + fstr = '('//atmc//')' + write (iind,fstr(1:4)) nonly + else + fstr = '('//atmc//',2x,a)' + write (iind,fstr(1:9)) nonly,title(1:ltitle) + end if end if c c write out the periodic cell lengths and angles @@ -96,16 +108,30 @@ subroutine prtuind (iind) c fstr = '('//atmc//',2x,a3,3f'//crdc// & '.'//digc//',i6,8'//atmc//')' - do i = 1, n - k = n12(i) - if (k .eq. 0) then - write (iind,fstr) i,name(i),(debye*uind(j,i),j=1,3), - & type(i) - else - write (iind,fstr) i,name(i),(debye*uind(j,i),j=1,3), - & type(i),(i12(j,i),j=1,k) - end if - end do + if (.not. onlysave) then + do i = 1, n + k = n12(i) + if (k .eq. 0) then + write (iind,fstr) i,name(i),(debye*uind(j,i),j=1,3), + & type(i) + else + write (iind,fstr) i,name(i),(debye*uind(j,i),j=1,3), + & type(i),(i12(j,i),j=1,k) + end if + end do + else + do ii = 1, nonly + i = ionly(ii) + k = n12(i) + if (k .eq. 0) then + write (iind,fstr) ii,name(i),(debye*uind(j,i),j=1,3), + & type(i) + else + write (iind,fstr) ii,name(i),(debye*uind(j,i),j=1,3), + & type(i), (ionlyinv(i12(j,i)),j=1,k) + end if + end do + end if c c close the output unit if opened by this routine c @@ -155,6 +181,7 @@ subroutine prtdcdu (idcd,first) use boxes use files use polar + use output use titles use units implicit none @@ -209,7 +236,11 @@ subroutine prtdcdu (idcd,first) & tdelta,usebox,use4d,usefq,merged, & zero,zero,zero,zero,zero,vcharmm write (idcd) ntitle,title(1:80) - write (idcd) n + if (.not. onlysave) then + write (idcd) n + else + write (idcd) nonly + end if end if c c append the lattice values based on header flag value @@ -220,9 +251,15 @@ subroutine prtdcdu (idcd,first) c c append the induced dipoles along each axis in turn c - write (idcd) (real(debye*uind(1,i)),i=1,n) - write (idcd) (real(debye*uind(2,i)),i=1,n) - write (idcd) (real(debye*uind(3,i)),i=1,n) + if (.not. onlysave) then + write (idcd) (real(debye*uind(1,i)),i=1,n) + write (idcd) (real(debye*uind(2,i)),i=1,n) + write (idcd) (real(debye*uind(3,i)),i=1,n) + else + write (idcd) (real(debye*uind(1,ionly(i))),i=1,nonly) + write (idcd) (real(debye*uind(2,ionly(i))),i=1,nonly) + write (idcd) (real(debye*uind(3,ionly(i))),i=1,nonly) + end if c c close the output unit if opened by this routine c @@ -251,10 +288,12 @@ subroutine prtustc (istc) use files use inform use mpole + use output use titles use units implicit none integer i,j,k,istc + integer ii integer size,crdsiz real*8 crdmin,crdmax real*8 c,xd,yd,zd @@ -304,12 +343,22 @@ subroutine prtustc (istc) c c write out the number of atoms and the title c - if (ltitle .eq. 0) then - fstr = '('//atmc//')' - write (istc,fstr(1:4)) n + if (.not. onlysave) then + if (ltitle .eq. 0) then + fstr = '('//atmc//')' + write (istc,fstr(1:4)) n + else + fstr = '('//atmc//',2x,a)' + write (istc,fstr(1:9)) n,title(1:ltitle) + end if else - fstr = '('//atmc//',2x,a)' - write (istc,fstr(1:9)) n,title(1:ltitle) + if (ltitle .eq. 0) then + fstr = '('//atmc//')' + write (istc,fstr(1:4)) nonly + else + fstr = '('//atmc//',2x,a)' + write (istc,fstr(1:9)) nonly,title(1:ltitle) + end if end if c c write out the periodic cell lengths and angles @@ -323,19 +372,36 @@ subroutine prtustc (istc) c fstr = '('//atmc//',2x,a3,3f'//crdc// & '.'//digc//',i6,8'//atmc//')' - do i = 1, n - c = rpole(1,i) - xd = (x(i)*c + rpole(2,i)) * debye - yd = (y(i)*c + rpole(3,i)) * debye - zd = (z(i)*c + rpole(4,i)) * debye - k = n12(i) - if (k .eq. 0) then - write (istc,fstr) i,name(i),xd,yd,zd,type(i) - else - write (istc,fstr) i,name(i),xd,yd,zd,type(i), - & (i12(j,i),j=1,k) - end if - end do + if (.not. onlysave) then + do i = 1, n + c = rpole(1,i) + xd = (x(i)*c + rpole(2,i)) * debye + yd = (y(i)*c + rpole(3,i)) * debye + zd = (z(i)*c + rpole(4,i)) * debye + k = n12(i) + if (k .eq. 0) then + write (istc,fstr) i,name(i),xd,yd,zd,type(i) + else + write (istc,fstr) i,name(i),xd,yd,zd,type(i), + & (i12(j,i),j=1,k) + end if + end do + else + do ii = 1, nonly + i = ionly(ii) + c = rpole(1,i) + xd = (x(i)*c + rpole(2,i)) * debye + yd = (y(i)*c + rpole(3,i)) * debye + zd = (z(i)*c + rpole(4,i)) * debye + k = n12(i) + if (k .eq. 0) then + write (istc,fstr) ii,name(i),xd,yd,zd,type(i) + else + write (istc,fstr) ii,name(i),xd,yd,zd,type(i), + & (ionlyinv(i12(j,i)),j=1,k) + end if + end do + end if c c close the output unit if opened by this routine c @@ -385,6 +451,7 @@ subroutine prtdcdd (idcd,first) use boxes use files use mpole + use output use titles use units implicit none @@ -439,7 +506,11 @@ subroutine prtdcdd (idcd,first) & tdelta,usebox,use4d,usefq,merged, & zero,zero,zero,zero,zero,vcharmm write (idcd) ntitle,title(1:80) - write (idcd) n + if (.not. onlysave) then + write (idcd) n + else + write (idcd) nonly + end if end if c c append the lattice values based on header flag value @@ -450,9 +521,18 @@ subroutine prtdcdd (idcd,first) c c append the static dipoles along each axis in turn c - write (idcd) (real(debye*(x(i)*rpole(1,i) + rpole(2,i))),i=1,n) - write (idcd) (real(debye*(y(i)*rpole(1,i) + rpole(3,i))),i=1,n) - write (idcd) (real(debye*(z(i)*rpole(1,i) + rpole(4,i))),i=1,n) + if (.not. onlysave) then + write (idcd) (real(debye*(x(i)*rpole(1,i) + rpole(2,i))),i=1,n) + write (idcd) (real(debye*(y(i)*rpole(1,i) + rpole(3,i))),i=1,n) + write (idcd) (real(debye*(z(i)*rpole(1,i) + rpole(4,i))),i=1,n) + else + write (idcd) (real(debye*(x(ionly(i))*rpole(1,ionly(i)) + & + rpole(2,ionly(i)))),i=1,nonly) + write (idcd) (real(debye*(y(ionly(i))*rpole(1,ionly(i)) + & + rpole(3,ionly(i)))),i=1,nonly) + write (idcd) (real(debye*(z(ionly(i))*rpole(1,ionly(i)) + & + rpole(4,ionly(i)))),i=1,nonly) + end if c c close the output unit if opened by this routine c diff --git a/source/prtvel.f b/source/prtvel.f index 1bc624d29..1b6a12341 100644 --- a/source/prtvel.f +++ b/source/prtvel.f @@ -25,9 +25,11 @@ subroutine prtvel (ivel) use files use inform use moldyn + use output use titles implicit none integer i,j,k,ivel + integer ii integer size,crdsiz real*8 crdmin,crdmax logical opened @@ -76,12 +78,22 @@ subroutine prtvel (ivel) c c write out the number of atoms and the title c - if (ltitle .eq. 0) then - fstr = '('//atmc//')' - write (ivel,fstr(1:4)) n + if (.not. onlysave) then + if (ltitle .eq. 0) then + fstr = '('//atmc//')' + write (ivel,fstr(1:4)) n + else + fstr = '('//atmc//',2x,a)' + write (ivel,fstr(1:9)) n,title(1:ltitle) + end if else - fstr = '('//atmc//',2x,a)' - write (ivel,fstr(1:9)) n,title(1:ltitle) + if (ltitle .eq. 0) then + fstr = '('//atmc//')' + write (ivel,fstr(1:4)) nonly + else + fstr = '('//atmc//',2x,a)' + write (ivel,fstr(1:9)) nonly,title(1:ltitle) + end if end if c c write out the periodic cell lengths and angles @@ -95,15 +107,28 @@ subroutine prtvel (ivel) c fstr = '('//atmc//',2x,a3,3f'//crdc// & '.'//digc//',i6,8'//atmc//')' - do i = 1, n - k = n12(i) - if (k .eq. 0) then - write (ivel,fstr) i,name(i),(v(j,i),j=1,3),type(i) - else - write (ivel,fstr) i,name(i),(v(j,i),j=1,3),type(i), - & (i12(j,i),j=1,k) - end if - end do + if (.not. onlysave) then + do i = 1, n + k = n12(i) + if (k .eq. 0) then + write (ivel,fstr) i,name(i),(v(j,i),j=1,3),type(i) + else + write (ivel,fstr) i,name(i),(v(j,i),j=1,3),type(i), + & (i12(j,i),j=1,k) + end if + end do + else + do ii = 1, nonly + i = ionly(ii) + k = n12(i) + if (k .eq. 0) then + write (ivel,fstr) ii,name(i),(v(j,i),j=1,3),type(i) + else + write (ivel,fstr) ii,name(i),(v(j,i),j=1,3),type(i), + & (ionlyinv(i12(j,i)),j=1,k) + end if + end do + end if c c close the output unit if opened by this routine c @@ -153,6 +178,7 @@ subroutine prtdcdv (idcd,first) use boxes use files use moldyn + use output use titles implicit none integer i,idcd @@ -206,7 +232,11 @@ subroutine prtdcdv (idcd,first) & tdelta,usebox,use4d,usefq,merged, & zero,zero,zero,zero,zero,vcharmm write (idcd) ntitle,title(1:80) - write (idcd) n + if (.not. onlysave) then + write (idcd) n + else + write (idcd) nonly + end if end if c c append the lattice values based on header flag value @@ -217,9 +247,15 @@ subroutine prtdcdv (idcd,first) c c append the velocity components along each axis in turn c - write (idcd) (real(v(1,i)),i=1,n) - write (idcd) (real(v(2,i)),i=1,n) - write (idcd) (real(v(3,i)),i=1,n) + if (.not. onlysave) then + write (idcd) (real(v(1,i)),i=1,n) + write (idcd) (real(v(2,i)),i=1,n) + write (idcd) (real(v(3,i)),i=1,n) + else + write (idcd) (real(v(1,ionly(i))),i=1,nonly) + write (idcd) (real(v(2,ionly(i))),i=1,nonly) + write (idcd) (real(v(3,ionly(i))),i=1,nonly) + end if c c close the output unit if opened by this routine c diff --git a/source/prtxyz.f b/source/prtxyz.f index 48733c7ea..62d551eaa 100644 --- a/source/prtxyz.f +++ b/source/prtxyz.f @@ -24,9 +24,11 @@ subroutine prtxyz (ixyz) use couple use files use inform + use output use titles implicit none integer i,j,k,ixyz + integer ii integer size,crdsiz real*8 crdmin,crdmax logical opened @@ -75,12 +77,22 @@ subroutine prtxyz (ixyz) c c write out the number of atoms and the title c - if (ltitle .eq. 0) then - fstr = '('//atmc//')' - write (ixyz,fstr(1:4)) n + if (.not. onlysave) then + if (ltitle .eq. 0) then + fstr = '('//atmc//')' + write (ixyz,fstr(1:4)) n + else + fstr = '('//atmc//',2x,a)' + write (ixyz,fstr(1:9)) n,title(1:ltitle) + end if else - fstr = '('//atmc//',2x,a)' - write (ixyz,fstr(1:9)) n,title(1:ltitle) + if (ltitle .eq. 0) then + fstr = '('//atmc//')' + write (ixyz,fstr(1:4)) nonly + else + fstr = '('//atmc//',2x,a)' + write (ixyz,fstr(1:9)) nonly,title(1:ltitle) + end if end if c c write out the periodic cell lengths and angles @@ -94,15 +106,28 @@ subroutine prtxyz (ixyz) c fstr = '('//atmc//',2x,a3,3f'//crdc// & '.'//digc//',i6,8'//atmc//')' - do i = 1, n - k = n12(i) - if (k .eq. 0) then - write (ixyz,fstr) i,name(i),x(i),y(i),z(i),type(i) - else - write (ixyz,fstr) i,name(i),x(i),y(i),z(i),type(i), - & (i12(j,i),j=1,k) - end if - end do + if (.not. onlysave) then + do i = 1, n + k = n12(i) + if (k .eq. 0) then + write (ixyz,fstr) i,name(i),x(i),y(i),z(i),type(i) + else + write (ixyz,fstr) i,name(i),x(i),y(i),z(i),type(i), + & (i12(j,i),j=1,k) + end if + end do + else + do ii = 1, nonly + i = ionly(ii) + k = n12(i) + if (k .eq. 0) then + write (ixyz,fstr) ii,name(i),x(i),y(i),z(i),type(i) + else + write (ixyz,fstr) ii,name(i),x(i),y(i),z(i),type(i), + & (ionlyinv(i12(j,i)),j=1,k) + end if + end do + end if c c close the output unit if opened by this routine c @@ -151,6 +176,7 @@ subroutine prtdcd (idcd,first) use bound use boxes use files + use output use titles implicit none integer i,idcd @@ -204,7 +230,11 @@ subroutine prtdcd (idcd,first) & tdelta,usebox,use4d,usefq,merged, & zero,zero,zero,zero,zero,vcharmm write (idcd) ntitle,title(1:80) - write (idcd) n + if (.not. onlysave) then + write (idcd) n + else + write (idcd) nonly + end if end if c c append the lattice values based on header flag value @@ -215,9 +245,15 @@ subroutine prtdcd (idcd,first) c c append the atomic coordinates along each axis in turn c - write (idcd) (real(x(i)),i=1,n) - write (idcd) (real(y(i)),i=1,n) - write (idcd) (real(z(i)),i=1,n) + if (.not. onlysave) then + write (idcd) (real(x(i)),i=1,n) + write (idcd) (real(y(i)),i=1,n) + write (idcd) (real(z(i)),i=1,n) + else + write (idcd) (real(x(ionly(i))),i=1,nonly) + write (idcd) (real(y(ionly(i))),i=1,nonly) + write (idcd) (real(z(ionly(i))),i=1,nonly) + end if c c close the output unit if opened by this routine c From 4240757dc5d325b5ac8760eccfb9e0aa20f90068 Mon Sep 17 00:00:00 2001 From: Moses Date: Sat, 23 Mar 2024 17:20:48 -0500 Subject: [PATCH 06/29] onlysave initialize --- source/active.f | 1 + source/mdsave.f | 2 +- 2 files changed, 2 insertions(+), 1 deletion(-) diff --git a/source/active.f b/source/active.f index f0f2e99ea..dca8c6b0c 100644 --- a/source/active.f +++ b/source/active.f @@ -286,6 +286,7 @@ subroutine saveonly c c set defaults for the numbers and lists of saved atoms c + onlysave = .false. nonly = 0 do i = 1, n ionly(i) = 0 diff --git a/source/mdsave.f b/source/mdsave.f index b2b14002a..ebfc618cc 100644 --- a/source/mdsave.f +++ b/source/mdsave.f @@ -201,7 +201,7 @@ subroutine mdsave (istep,dt,epot,eksum) c c update the information needed to restart the trajectory c - if (coordsave) call prtdyn + if (coordsave .and. (.not.onlysave)) call prtdyn c c save the velocity vector components at the current step c From 08dba79357c33d9c0aea06c36b577a0e6205a231 Mon Sep 17 00:00:00 2001 From: Moses Date: Sat, 23 Mar 2024 17:50:28 -0500 Subject: [PATCH 07/29] nodyn option --- source/control.f | 3 +++ source/mdsave.f | 4 +++- source/output.f | 2 ++ 3 files changed, 8 insertions(+), 1 deletion(-) diff --git a/source/control.f b/source/control.f index d6bc4aa88..41ba5fb04 100644 --- a/source/control.f +++ b/source/control.f @@ -42,6 +42,7 @@ subroutine control noversion = .false. overwrite = .false. coordsave = .true. + dynsave = .true. c c check for control parameters on the command line c @@ -93,6 +94,8 @@ subroutine control overwrite = .true. else if (keyword(1:8) .eq. 'NOCOORD ') then coordsave = .false. + else if (keyword(1:6) .eq. 'NODYN ') then + dynsave = .false. end if 10 continue end do diff --git a/source/mdsave.f b/source/mdsave.f index ebfc618cc..6d7ef33e4 100644 --- a/source/mdsave.f +++ b/source/mdsave.f @@ -49,6 +49,7 @@ subroutine mdsave (istep,dt,epot,eksum) real*8 xustc,yustc,zustc real*8 xuind,yuind,zuind logical exist,first + logical savedyn character*7 ext character*240 endfile character*240 xyzfile @@ -201,7 +202,8 @@ subroutine mdsave (istep,dt,epot,eksum) c c update the information needed to restart the trajectory c - if (coordsave .and. (.not.onlysave)) call prtdyn + savedyn = dynsave .and. coordsave .and. (.not.onlysave) + if (savedyn) call prtdyn c c save the velocity vector components at the current step c diff --git a/source/output.f b/source/output.f index 7c1095fe8..b21975a28 100644 --- a/source/output.f +++ b/source/output.f @@ -20,6 +20,7 @@ c noversion logical flag governing use of filename versions c overwrite logical flag to overwrite intermediate files inplace c coordsave logical flag to save coordinates +c dynsave logical flag to save dynamics (.dyn) file c onlysave logical flag to only save certain coordinates c arcsave logical flag to save coordinates in Tinker XYZ format c dcdsave logical flag to save coordinates in DCD binary format @@ -43,6 +44,7 @@ module output logical noversion logical overwrite logical coordsave + logical dynsave logical cyclesave logical onlysave logical arcsave From e81dbdc1221f204568041a86b5a8dacf377a57e5 Mon Sep 17 00:00:00 2001 From: Moses Date: Tue, 26 Mar 2024 11:06:28 -0500 Subject: [PATCH 08/29] save .dyn at the end of simulation if not saved during simulation --- source/dynamic.f | 5 +++++ source/mdsave.f | 4 +--- 2 files changed, 6 insertions(+), 3 deletions(-) diff --git a/source/dynamic.f b/source/dynamic.f index 491bbc678..85b852560 100644 --- a/source/dynamic.f +++ b/source/dynamic.f @@ -28,6 +28,7 @@ program dynamic use mdstuf use potent use stodyn + use output use usage implicit none integer i,next,mode @@ -298,6 +299,10 @@ program dynamic end if end do c +c save dynamic at the end if it was not saved during simulation +c + if (.not. dynsave) call prtdyn +c c perform any final tasks before program exit c call final diff --git a/source/mdsave.f b/source/mdsave.f index 6d7ef33e4..08a6328ee 100644 --- a/source/mdsave.f +++ b/source/mdsave.f @@ -49,7 +49,6 @@ subroutine mdsave (istep,dt,epot,eksum) real*8 xustc,yustc,zustc real*8 xuind,yuind,zuind logical exist,first - logical savedyn character*7 ext character*240 endfile character*240 xyzfile @@ -202,8 +201,7 @@ subroutine mdsave (istep,dt,epot,eksum) c c update the information needed to restart the trajectory c - savedyn = dynsave .and. coordsave .and. (.not.onlysave) - if (savedyn) call prtdyn + if (dynsave) call prtdyn c c save the velocity vector components at the current step c From 43f21ddb8e38e7a32d4e14f61dfaafe74b9e1131 Mon Sep 17 00:00:00 2001 From: Moses Date: Tue, 26 Mar 2024 11:31:27 -0500 Subject: [PATCH 09/29] add interface --- interface/c/tinker/detail/output.hh | 6 ++++++ interface/c/tinker/routines.h | 6 +++++- interface/cpp/tinker/detail/output.hh | 18 ++++++++++++++++++ interface/cpp/tinker/routines.h | 6 +++++- 4 files changed, 34 insertions(+), 2 deletions(-) diff --git a/interface/c/tinker/detail/output.hh b/interface/c/tinker/detail/output.hh index 2ce8d6303..21c1c9a68 100644 --- a/interface/c/tinker/detail/output.hh +++ b/interface/c/tinker/detail/output.hh @@ -5,12 +5,17 @@ #ifdef __cplusplus extern "C" { #endif +extern int TINKER_MOD(output, nonly); +extern int* TINKER_MOD(output, ionly); +extern int* TINKER_MOD(output, ionlyinv); extern int TINKER_MOD(output, archive); extern int TINKER_MOD(output, binary); extern int TINKER_MOD(output, noversion); extern int TINKER_MOD(output, overwrite); extern int TINKER_MOD(output, coordsave); +extern int TINKER_MOD(output, dynsave); extern int TINKER_MOD(output, cyclesave); +extern int TINKER_MOD(output, onlysave); extern int TINKER_MOD(output, arcsave); extern int TINKER_MOD(output, dcdsave); extern int TINKER_MOD(output, velsave); @@ -18,6 +23,7 @@ extern int TINKER_MOD(output, frcsave); extern int TINKER_MOD(output, uindsave); extern int TINKER_MOD(output, ustcsave); extern int TINKER_MOD(output, usyssave); +extern int* TINKER_MOD(output, usysuse); extern char TINKER_MOD(output, coordtype)[9]; #ifdef __cplusplus } diff --git a/interface/c/tinker/routines.h b/interface/c/tinker/routines.h index 7d092b38c..6c90a4bbf 100644 --- a/interface/c/tinker/routines.h +++ b/interface/c/tinker/routines.h @@ -20,6 +20,10 @@ void tinkerFortranRuntimeEnd(); // active.f void active_(); #define tinker_f_active active_ +void saveonly_(); +#define tinker_f_saveonly saveonly_ +void saveusys_(); +#define tinker_f_saveusys saveusys_ // alterchg.f void alterchg_(); @@ -1932,7 +1936,7 @@ void moments_(char* mode, tinker_fchar_len_t mode_cap); inline void tinker_f_moments(tinker_fchars mode) { return moments_(mode.string, mode.capacity); } -void dmoments_(); +void dmoments_(double* xustc, double* yustc, double* zustc, double* xuind, double* yuind, double* zuind); #define tinker_f_dmoments dmoments_ // mutate.f diff --git a/interface/cpp/tinker/detail/output.hh b/interface/cpp/tinker/detail/output.hh index 9cbc2049d..5244bc956 100644 --- a/interface/cpp/tinker/detail/output.hh +++ b/interface/cpp/tinker/detail/output.hh @@ -3,12 +3,17 @@ #include "macro.hh" namespace tinker { namespace output { +extern int& nonly; +extern int*& ionly; +extern int*& ionlyinv; extern int& archive; extern int& binary; extern int& noversion; extern int& overwrite; extern int& coordsave; +extern int& dynsave; extern int& cyclesave; +extern int& onlysave; extern int& arcsave; extern int& dcdsave; extern int& velsave; @@ -16,15 +21,21 @@ extern int& frcsave; extern int& uindsave; extern int& ustcsave; extern int& usyssave; +extern int*& usysuse; extern char (&coordtype)[9]; #ifdef TINKER_FORTRAN_MODULE_CPP +extern "C" int TINKER_MOD(output, nonly); +extern "C" int* TINKER_MOD(output, ionly); +extern "C" int* TINKER_MOD(output, ionlyinv); extern "C" int TINKER_MOD(output, archive); extern "C" int TINKER_MOD(output, binary); extern "C" int TINKER_MOD(output, noversion); extern "C" int TINKER_MOD(output, overwrite); extern "C" int TINKER_MOD(output, coordsave); +extern "C" int TINKER_MOD(output, dynsave); extern "C" int TINKER_MOD(output, cyclesave); +extern "C" int TINKER_MOD(output, onlysave); extern "C" int TINKER_MOD(output, arcsave); extern "C" int TINKER_MOD(output, dcdsave); extern "C" int TINKER_MOD(output, velsave); @@ -32,14 +43,20 @@ extern "C" int TINKER_MOD(output, frcsave); extern "C" int TINKER_MOD(output, uindsave); extern "C" int TINKER_MOD(output, ustcsave); extern "C" int TINKER_MOD(output, usyssave); +extern "C" int* TINKER_MOD(output, usysuse); extern "C" char TINKER_MOD(output, coordtype)[9]; +int& nonly = TINKER_MOD(output, nonly); +int*& ionly = TINKER_MOD(output, ionly); +int*& ionlyinv = TINKER_MOD(output, ionlyinv); int& archive = TINKER_MOD(output, archive); int& binary = TINKER_MOD(output, binary); int& noversion = TINKER_MOD(output, noversion); int& overwrite = TINKER_MOD(output, overwrite); int& coordsave = TINKER_MOD(output, coordsave); +int& dynsave = TINKER_MOD(output, dynsave); int& cyclesave = TINKER_MOD(output, cyclesave); +int& onlysave = TINKER_MOD(output, onlysave); int& arcsave = TINKER_MOD(output, arcsave); int& dcdsave = TINKER_MOD(output, dcdsave); int& velsave = TINKER_MOD(output, velsave); @@ -47,6 +64,7 @@ int& frcsave = TINKER_MOD(output, frcsave); int& uindsave = TINKER_MOD(output, uindsave); int& ustcsave = TINKER_MOD(output, ustcsave); int& usyssave = TINKER_MOD(output, usyssave); +int*& usysuse = TINKER_MOD(output, usysuse); char (&coordtype)[9] = TINKER_MOD(output, coordtype); #endif } } diff --git a/interface/cpp/tinker/routines.h b/interface/cpp/tinker/routines.h index 7d092b38c..6c90a4bbf 100644 --- a/interface/cpp/tinker/routines.h +++ b/interface/cpp/tinker/routines.h @@ -20,6 +20,10 @@ void tinkerFortranRuntimeEnd(); // active.f void active_(); #define tinker_f_active active_ +void saveonly_(); +#define tinker_f_saveonly saveonly_ +void saveusys_(); +#define tinker_f_saveusys saveusys_ // alterchg.f void alterchg_(); @@ -1932,7 +1936,7 @@ void moments_(char* mode, tinker_fchar_len_t mode_cap); inline void tinker_f_moments(tinker_fchars mode) { return moments_(mode.string, mode.capacity); } -void dmoments_(); +void dmoments_(double* xustc, double* yustc, double* zustc, double* xuind, double* yuind, double* zuind); #define tinker_f_dmoments dmoments_ // mutate.f From c402789348ec46841b74884e8d276c6121809f36 Mon Sep 17 00:00:00 2001 From: Moses Date: Wed, 27 Mar 2024 16:42:26 -0500 Subject: [PATCH 10/29] time dependent field --- source/dynamic.f | 8 +++++++ source/epolar.f | 14 +++++++------ source/epolar3.f | 12 +++++------ source/exfield.f | 54 ++++++++++++++++++++++++------------------------ source/extfld.f | 10 +++++++-- source/induce.f | 20 +++++++++--------- source/initprm.f | 3 +++ source/prmkey.f | 6 ++++++ 8 files changed, 76 insertions(+), 51 deletions(-) diff --git a/source/dynamic.f b/source/dynamic.f index 85b852560..1e1939119 100644 --- a/source/dynamic.f +++ b/source/dynamic.f @@ -22,6 +22,7 @@ program dynamic use bath use bndstr use bound + use extfld use inform use iounit use keys @@ -34,6 +35,7 @@ program dynamic integer i,next,mode integer istep,nstep real*8 dt,dtsave + real*8 phs logical exist character*20 keyword character*240 record @@ -276,6 +278,12 @@ program dynamic c integrate equations of motion to take a time step c do istep = 1, nstep + if (use_exfld .and. use_exfreq) then + phs = sin(exfreq * dble(istep-1) * dt) + do i = 1, 3 + texfld(i) = phs * exfld(i) + end do + end if if (integrate .eq. 'VERLET') then call verlet (istep,dt) else if (integrate .eq. 'BEEMAN') then diff --git a/source/epolar.f b/source/epolar.f index e8de6d228..de98db730 100644 --- a/source/epolar.f +++ b/source/epolar.f @@ -483,7 +483,7 @@ subroutine epolar0a do i = 1, npole e = 0.0d0 do j = 1, 3 - e = e - f*uind(j,i)*exfld(j) + e = e - f*uind(j,i)*texfld(j) end do ep = ep + e end do @@ -593,7 +593,8 @@ subroutine epolar0b !$OMP& shared(npole,ipole,rpole,x,y,z,pcore,pval,palpha,uind,n12,i12, !$OMP& n13,i13,n14,i14,n15,i15,np11,ip11,np12,ip12,np13,ip13,np14,ip14, !$OMP& p2scale,p3scale,p4scale,p5scale,p2iscale,p3iscale,p4iscale, -!$OMP& p5iscale,nelst,elst,use_thole,use_chgpen,use_bounds,f,off2,exfld) +!$OMP& p5iscale,nelst,elst,use_thole,use_chgpen,use_bounds,f,off2, +!$OMP& texfld) !$OMP& firstprivate(pscale) shared (ep) !$OMP DO reduction(+:ep) schedule(guided) c @@ -773,7 +774,7 @@ subroutine epolar0b do i = 1, npole e = 0.0d0 do j = 1, 3 - e = e - f*uind(j,i)*exfld(j) + e = e - f*uind(j,i)*texfld(j) end do ep = ep + e end do @@ -1359,7 +1360,7 @@ subroutine epreal0c do i = 1, npole e = 0.0d0 do j = 1, 3 - e = e - f*uind(j,i)*exfld(j) + e = e - f*uind(j,i)*texfld(j) end do ep = ep + e end do @@ -1566,7 +1567,8 @@ subroutine epreal0d !$OMP& shared(npole,ipole,rpole,uind,x,y,z,pcore,pval,palpha,n12,i12, !$OMP& n13,i13,n14,i14,n15,i15,np11,ip11,np12,ip12,np13,ip13,np14,ip14, !$OMP& p2scale,p3scale,p4scale,p5scale,p2iscale,p3iscale,p4iscale, -!$OMP& p5iscale,nelst,elst,use_thole,use_chgpen,use_bounds,off2,f,exfld) +!$OMP& p5iscale,nelst,elst,use_thole,use_chgpen,use_bounds,off2,f, +!$OMP& texfld) !$OMP& firstprivate(pscale) shared (ep) !$OMP DO reduction(+:ep) schedule(guided) c @@ -1763,7 +1765,7 @@ subroutine epreal0d do i = 1, npole e = 0.0d0 do j = 1, 3 - e = e - f*uind(j,i)*exfld(j) + e = e - f*uind(j,i)*texfld(j) end do ep = ep + e end do diff --git a/source/epolar3.f b/source/epolar3.f index 4a40599cc..53b29610a 100644 --- a/source/epolar3.f +++ b/source/epolar3.f @@ -556,7 +556,7 @@ subroutine epolar3a do i = 1, npole e = 0.0d0 do j = 1, 3 - e = e - f*uind(j,i)*exfld(j) + e = e - f*uind(j,i)*texfld(j) end do ep = ep + e nep = nep + 1 @@ -692,7 +692,7 @@ subroutine epolar3b !$OMP& n13,i13,n14,i14,n15,i15,np11,ip11,np12,ip12,np13,ip13,np14,ip14, !$OMP& p2scale,p3scale,p4scale,p5scale,p2iscale,p3iscale,p4iscale, !$OMP& p5iscale,nelst,elst,use_thole,use_chgpen,use_bounds,off2,f, -!$OMP& exfld,molcule,name,verbose,debug,header,iout) +!$OMP& texfld,molcule,name,verbose,debug,header,iout) !$OMP& firstprivate(pscale) shared (ep,nep,aep,einter) !$OMP DO reduction(+:ep,nep,aep,einter) schedule(guided) c @@ -897,7 +897,7 @@ subroutine epolar3b do i = 1, npole e = 0.0d0 do j = 1, 3 - e = e - f*uind(j,i)*exfld(j) + e = e - f*uind(j,i)*texfld(j) end do ep = ep + e nep = nep + 1 @@ -1588,7 +1588,7 @@ subroutine epreal3c do i = 1, npole e = 0.0d0 do j = 1, 3 - e = e - f*uind(j,i)*exfld(j) + e = e - f*uind(j,i)*texfld(j) end do ep = ep + e nep = nep + 1 @@ -1832,7 +1832,7 @@ subroutine epreal3d !$OMP& n13,i13,n14,i14,n15,i15,np11,ip11,np12,ip12,np13,ip13,np14,ip14, !$OMP& p2scale,p3scale,p4scale,p5scale,p2iscale,p3iscale,p4iscale, !$OMP& p5iscale,nelst,elst,use_thole,use_chgpen,use_bounds,off2,f, -!$OMP& exfld,molcule,name,verbose,debug,header,iout) +!$OMP& texfld,molcule,name,verbose,debug,header,iout) !$OMP& firstprivate(pscale) shared (ep,nep,aep,einter) !$OMP DO reduction(+:ep,nep,aep,einter) schedule(guided) c @@ -2062,7 +2062,7 @@ subroutine epreal3d do i = 1, npole e = 0.0d0 do j = 1, 3 - e = e - f*uind(j,i)*exfld(j) + e = e - f*uind(j,i)*texfld(j) end do ep = ep + e nep = nep + 1 diff --git a/source/exfield.f b/source/exfield.f index d40de628f..f5a8e98fd 100644 --- a/source/exfield.f +++ b/source/exfield.f @@ -41,7 +41,7 @@ subroutine exfield (mode,exf) c if (mode .eq. 'CHARGE') then !$OMP PARALLEL default(private) shared(nion,iion,use, -!$OMP& x,y,z,f,pchg,exfld,exf) +!$OMP& x,y,z,f,pchg,texfld,exf) !$OMP DO reduction(+:exf) schedule(guided) do ii = 1, nion i = iion(ii) @@ -50,7 +50,7 @@ subroutine exfield (mode,exf) yi = y(i) zi = z(i) ci = pchg(i) - phi = xi*exfld(1) + yi*exfld(2) + zi*exfld(3) + phi = xi*texfld(1) + yi*texfld(2) + zi*texfld(3) e = -f * ci * phi exf = exf + e end if @@ -63,7 +63,7 @@ subroutine exfield (mode,exf) c if (mode .eq. 'MPOLE') then !$OMP PARALLEL default(private) shared(npole,ipole,use, -!$OMP& x,y,z,f,rpole,exfld,exf) +!$OMP& x,y,z,f,rpole,texfld,exf) !$OMP DO reduction(+:exf) schedule(guided) do ii = 1, npole i = ipole(ii) @@ -72,12 +72,12 @@ subroutine exfield (mode,exf) yi = y(i) zi = z(i) ci = rpole(1,i) - phi = xi*exfld(1) + yi*exfld(2) + zi*exfld(3) + phi = xi*texfld(1) + yi*texfld(2) + zi*texfld(3) dix = rpole(2,i) diy = rpole(3,i) diz = rpole(4,i) - e = -f * (ci*phi + dix*exfld(1) - & + diy*exfld(2) + diz*exfld(3)) + e = -f * (ci*phi + dix*texfld(1) + & + diy*texfld(2) + diz*texfld(3)) exf = exf + e end if end do @@ -135,7 +135,7 @@ subroutine exfield1 (mode,exf) c if (mode .eq. 'CHARGE') then !$OMP PARALLEL default(private) shared(nion,iion,use, -!$OMP& x,y,z,f,pchg,exfld,exf,dec,vir) +!$OMP& x,y,z,f,pchg,texfld,exf,dec,vir) !$OMP DO reduction(+:exf,dec,vir) schedule(guided) do ii = 1, nion i = iion(ii) @@ -144,15 +144,15 @@ subroutine exfield1 (mode,exf) yi = y(i) zi = z(i) ci = pchg(i) - phi = xi*exfld(1) + yi*exfld(2) + zi*exfld(3) + phi = xi*texfld(1) + yi*texfld(2) + zi*texfld(3) e = -f * ci * phi exf = exf + e c c gradient and virial components from charge interactions c - frx = -f * exfld(1) * ci - fry = -f * exfld(2) * ci - frz = -f * exfld(3) * ci + frx = -f * texfld(1) * ci + fry = -f * texfld(2) * ci + frz = -f * texfld(3) * ci dec(1,i) = dec(1,i) + frx dec(2,i) = dec(2,i) + fry dec(3,i) = dec(3,i) + frz @@ -184,7 +184,7 @@ subroutine exfield1 (mode,exf) c if (mode .eq. 'MPOLE') then !$OMP PARALLEL default(private) shared(npole,ipole,use, -!$OMP& x,y,z,xaxis,yaxis,zaxis,f,rpole,exfld,exf,dem,vir) +!$OMP& x,y,z,xaxis,yaxis,zaxis,f,rpole,texfld,exf,dem,vir) !$OMP DO reduction(+:exf,dem,vir) schedule(guided) do ii = 1, npole i = ipole(ii) @@ -196,16 +196,16 @@ subroutine exfield1 (mode,exf) dix = rpole(2,i) diy = rpole(3,i) diz = rpole(4,i) - phi = xi*exfld(1) + yi*exfld(2) + zi*exfld(3) - e = -f * (ci*phi + dix*exfld(1) - & + diy*exfld(2) + diz*exfld(3)) + phi = xi*texfld(1) + yi*texfld(2) + zi*texfld(3) + e = -f * (ci*phi + dix*texfld(1) + & + diy*texfld(2) + diz*texfld(3)) exf = exf + e c c gradient and virial components from dipole interactions c - tem(1) = f * (diy*exfld(3)-diz*exfld(2)) - tem(2) = f * (diz*exfld(1)-dix*exfld(3)) - tem(3) = f * (dix*exfld(2)-diy*exfld(1)) + tem(1) = f * (diy*texfld(3)-diz*texfld(2)) + tem(2) = f * (diz*texfld(1)-dix*texfld(3)) + tem(3) = f * (dix*texfld(2)-diy*texfld(1)) call torque (i,tem,fix,fiy,fiz,dem) iz = zaxis(i) ix = xaxis(i) @@ -234,9 +234,9 @@ subroutine exfield1 (mode,exf) c c gradient and virial components from monopole interactions c - frx = -f * exfld(1) * ci - fry = -f * exfld(2) * ci - frz = -f * exfld(3) * ci + frx = -f * texfld(1) * ci + fry = -f * texfld(2) * ci + frz = -f * texfld(3) * ci dem(1,i) = dem(1,i) + frx dem(2,i) = dem(2,i) + fry dem(3,i) = dem(3,i) + frz @@ -306,7 +306,7 @@ subroutine exfield3 (mode,exf) c if (mode .eq. 'CHARGE') then !$OMP PARALLEL default(private) shared(nion,iion,use, -!$OMP& x,y,z,f,pchg,exfld,exf,nec,aec) +!$OMP& x,y,z,f,pchg,texfld,exf,nec,aec) !$OMP DO reduction(+:exf,nec,aec) schedule(guided) do ii = 1, nion i = iion(ii) @@ -315,7 +315,7 @@ subroutine exfield3 (mode,exf) yi = y(i) zi = z(i) ci = pchg(i) - phi = xi*exfld(1) + yi*exfld(2) + zi*exfld(3) + phi = xi*texfld(1) + yi*texfld(2) + zi*texfld(3) e = -f * ci * phi exf = exf + e nec = nec + 1 @@ -330,7 +330,7 @@ subroutine exfield3 (mode,exf) c if (mode .eq. 'MPOLE') then !$OMP PARALLEL default(private) shared(npole,ipole,use, -!$OMP& x,y,z,f,rpole,exfld,exf,nem,aem) +!$OMP& x,y,z,f,rpole,texfld,exf,nem,aem) !$OMP DO reduction(+:exf,nem,aem) schedule(guided) do ii = 1, npole i = ipole(ii) @@ -339,12 +339,12 @@ subroutine exfield3 (mode,exf) yi = y(i) zi = z(i) ci = rpole(1,i) - phi = xi*exfld(1) + yi*exfld(2) + zi*exfld(3) + phi = xi*texfld(1) + yi*texfld(2) + zi*texfld(3) dix = rpole(2,i) diy = rpole(3,i) diz = rpole(4,i) - e = -f * (ci*phi + dix*exfld(1) - & + diy*exfld(2) + diz*exfld(3)) + e = -f * (ci*phi + dix*texfld(1) + & + diy*texfld(2) + diz*texfld(3)) exf = exf + e nem = nem + 1 aem(i) = aem(i) + e diff --git a/source/extfld.f b/source/extfld.f index d4d99a3bc..b02acf58b 100644 --- a/source/extfld.f +++ b/source/extfld.f @@ -12,13 +12,19 @@ c ################################################################# c c -c exfld components of applied external electric field -c use_exfld flag to include applied external electric field +c exfreq frequency of applied external field in gigahertz +c exfld components of applied external electric field +c texfld components of time dependent applied electric field +c use_exfld flag to include applied external electric field +c use_exfreq flag to oscillate applied external field c c module extfld implicit none + real*8 exfreq real*8 exfld(3) + real*8 texfld(3) logical use_exfld + logical use_exfreq save end diff --git a/source/induce.f b/source/induce.f index 80552f4c6..410ef4ffb 100644 --- a/source/induce.f +++ b/source/induce.f @@ -219,8 +219,8 @@ subroutine induce0a do ii = 1, npole i = ipole(ii) do j = 1, 3 - field(j,i) = field(j,i) + exfld(j) - fieldp(j,i) = fieldp(j,i) + exfld(j) + field(j,i) = field(j,i) + texfld(j) + fieldp(j,i) = fieldp(j,i) + texfld(j) end do end do end if @@ -4642,10 +4642,10 @@ subroutine induce0c do ii = 1, npole i = ipole(ii) do j = 1, 3 - field(j,i) = field(j,i) + exfld(j) - fieldp(j,i) = fieldp(j,i) + exfld(j) - fields(j,i) = fields(j,i) + exfld(j) - fieldps(j,i) = fieldps(j,i) + exfld(j) + field(j,i) = field(j,i) + texfld(j) + fieldp(j,i) = fieldp(j,i) + texfld(j) + fields(j,i) = fields(j,i) + texfld(j) + fieldps(j,i) = fieldps(j,i) + texfld(j) end do end do end if @@ -6013,10 +6013,10 @@ subroutine induce0d do ii = 1, npole i = ipole(ii) do j = 1, 3 - field(j,i) = field(j,i) + exfld(j) - fieldp(j,i) = fieldp(j,i) + exfld(j) - fields(j,i) = fields(j,i) + exfld(j) - fieldps(j,i) = fieldps(j,i) + exfld(j) + field(j,i) = field(j,i) + texfld(j) + fieldp(j,i) = fieldp(j,i) + texfld(j) + fields(j,i) = fields(j,i) + texfld(j) + fieldps(j,i) = fieldps(j,i) + texfld(j) end do end do end if diff --git a/source/initprm.f b/source/initprm.f index 0634201b9..c3aa9d212 100644 --- a/source/initprm.f +++ b/source/initprm.f @@ -380,9 +380,12 @@ subroutine initprm neutnbr = .false. neutcut = .false. use_exfld = .false. + use_exfreq = .false. do i = 1, 3 exfld(i) = 0.0d0 + texfld(i) = 0.0d0 end do + exfreq = 0.0d0 c c set default control parameters for atomic multipole terms c diff --git a/source/prmkey.f b/source/prmkey.f index dd81b90b0..2d77b91db 100644 --- a/source/prmkey.f +++ b/source/prmkey.f @@ -25,6 +25,7 @@ subroutine prmkey (text) use expol use extfld use fields + use math use mplpot use polpot use potent @@ -403,7 +404,12 @@ subroutine prmkey (text) use_exfld = .true. do i = 1, 3 exfld(i) = exfld(i) / elefield + texfld(i) = exfld(i) end do + else if (keyword(1:15) .eq. 'EXFLD-FREQ ') then + read (string,*,err=10,end=10) exfreq + use_exfreq = .true. + exfreq = 2.0d0 * pi * 0.001d0 * exfreq c c set control parameters for atomic multipole potentials c From ea7b072cd20782c352c52287fdcf3018f9810319 Mon Sep 17 00:00:00 2001 From: Moses Date: Wed, 27 Mar 2024 16:44:39 -0500 Subject: [PATCH 11/29] add external field interface --- interface/c/tinker/detail/extfld.hh | 3 +++ interface/cpp/tinker/detail/extfld.hh | 9 +++++++++ 2 files changed, 12 insertions(+) diff --git a/interface/c/tinker/detail/extfld.hh b/interface/c/tinker/detail/extfld.hh index 6e431d2d0..b49d6e581 100644 --- a/interface/c/tinker/detail/extfld.hh +++ b/interface/c/tinker/detail/extfld.hh @@ -5,8 +5,11 @@ #ifdef __cplusplus extern "C" { #endif +extern double TINKER_MOD(extfld, exfreq); extern double TINKER_MOD(extfld, exfld)[3]; +extern double TINKER_MOD(extfld, texfld)[3]; extern int TINKER_MOD(extfld, use_exfld); +extern int TINKER_MOD(extfld, use_exfreq); #ifdef __cplusplus } #endif diff --git a/interface/cpp/tinker/detail/extfld.hh b/interface/cpp/tinker/detail/extfld.hh index fe6555c9f..dc2e8e47b 100644 --- a/interface/cpp/tinker/detail/extfld.hh +++ b/interface/cpp/tinker/detail/extfld.hh @@ -3,14 +3,23 @@ #include "macro.hh" namespace tinker { namespace extfld { +extern double& exfreq; extern double (&exfld)[3]; +extern double (&texfld)[3]; extern int& use_exfld; +extern int& use_exfreq; #ifdef TINKER_FORTRAN_MODULE_CPP +extern "C" double TINKER_MOD(extfld, exfreq); extern "C" double TINKER_MOD(extfld, exfld)[3]; +extern "C" double TINKER_MOD(extfld, texfld)[3]; extern "C" int TINKER_MOD(extfld, use_exfld); +extern "C" int TINKER_MOD(extfld, use_exfreq); +double& exfreq = TINKER_MOD(extfld, exfreq); double (&exfld)[3] = TINKER_MOD(extfld, exfld); +double (&texfld)[3] = TINKER_MOD(extfld, texfld); int& use_exfld = TINKER_MOD(extfld, use_exfld); +int& use_exfreq = TINKER_MOD(extfld, use_exfreq); #endif } } From d3fe1f9b81d93fc97fbd5d41500ce4eb37eb5536 Mon Sep 17 00:00:00 2001 From: Moses Date: Thu, 28 Mar 2024 09:37:59 -0500 Subject: [PATCH 12/29] fix use_exfld bug in epolar openmp directive --- source/epolar.f | 4 ++-- source/epolar3.f | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/source/epolar.f b/source/epolar.f index de98db730..b4ab81f6a 100644 --- a/source/epolar.f +++ b/source/epolar.f @@ -594,7 +594,7 @@ subroutine epolar0b !$OMP& n13,i13,n14,i14,n15,i15,np11,ip11,np12,ip12,np13,ip13,np14,ip14, !$OMP& p2scale,p3scale,p4scale,p5scale,p2iscale,p3iscale,p4iscale, !$OMP& p5iscale,nelst,elst,use_thole,use_chgpen,use_bounds,f,off2, -!$OMP& texfld) +!$OMP& texfld,use_exfld) !$OMP& firstprivate(pscale) shared (ep) !$OMP DO reduction(+:ep) schedule(guided) c @@ -1568,7 +1568,7 @@ subroutine epreal0d !$OMP& n13,i13,n14,i14,n15,i15,np11,ip11,np12,ip12,np13,ip13,np14,ip14, !$OMP& p2scale,p3scale,p4scale,p5scale,p2iscale,p3iscale,p4iscale, !$OMP& p5iscale,nelst,elst,use_thole,use_chgpen,use_bounds,off2,f, -!$OMP& texfld) +!$OMP& texfld,use_exfld) !$OMP& firstprivate(pscale) shared (ep) !$OMP DO reduction(+:ep) schedule(guided) c diff --git a/source/epolar3.f b/source/epolar3.f index 53b29610a..e2681c1f2 100644 --- a/source/epolar3.f +++ b/source/epolar3.f @@ -692,7 +692,7 @@ subroutine epolar3b !$OMP& n13,i13,n14,i14,n15,i15,np11,ip11,np12,ip12,np13,ip13,np14,ip14, !$OMP& p2scale,p3scale,p4scale,p5scale,p2iscale,p3iscale,p4iscale, !$OMP& p5iscale,nelst,elst,use_thole,use_chgpen,use_bounds,off2,f, -!$OMP& texfld,molcule,name,verbose,debug,header,iout) +!$OMP& texfld,molcule,name,verbose,debug,header,iout,use_exfld) !$OMP& firstprivate(pscale) shared (ep,nep,aep,einter) !$OMP DO reduction(+:ep,nep,aep,einter) schedule(guided) c @@ -1832,7 +1832,7 @@ subroutine epreal3d !$OMP& n13,i13,n14,i14,n15,i15,np11,ip11,np12,ip12,np13,ip13,np14,ip14, !$OMP& p2scale,p3scale,p4scale,p5scale,p2iscale,p3iscale,p4iscale, !$OMP& p5iscale,nelst,elst,use_thole,use_chgpen,use_bounds,off2,f, -!$OMP& texfld,molcule,name,verbose,debug,header,iout) +!$OMP& texfld,molcule,name,verbose,debug,header,iout,use_exfld) !$OMP& firstprivate(pscale) shared (ep,nep,aep,einter) !$OMP DO reduction(+:ep,nep,aep,einter) schedule(guided) c From d70fd586296fb15548d1dff98d4037d71dd0aa00 Mon Sep 17 00:00:00 2001 From: Moses Chung Date: Wed, 25 Sep 2024 16:32:52 -0500 Subject: [PATCH 13/29] print unique atom type dipole and velocity --- interface/CMakeLists.txt | 2 + interface/c/tinker/detail/moment.hh | 1 + interface/c/tinker/detail/output.hh | 2 +- interface/c/tinker/detail/uatom.hh | 16 ++++ interface/c/tinker/modc.h | 1 + interface/c/tinker/routines.h | 10 ++- interface/cpp/tinker/detail/moment.hh | 3 + interface/cpp/tinker/detail/output.hh | 6 +- interface/cpp/tinker/detail/uatom.hh | 28 +++++++ interface/cpp/tinker/modcpp.h | 1 + interface/cpp/tinker/routines.h | 10 ++- source/active.f | 40 +++++----- source/analyze.f | 4 + source/final.f | 3 +- source/mdinit.f | 11 ++- source/mdsave.f | 76 +++++++++++++------ source/moment.f | 2 + source/moments.f | 89 ++++++++++++++++++----- source/output.f | 6 +- source/uatom.f | 31 ++++++++ source/uniquetyp.f | 101 ++++++++++++++++++++++++++ 21 files changed, 364 insertions(+), 79 deletions(-) create mode 100644 interface/c/tinker/detail/uatom.hh create mode 100644 interface/cpp/tinker/detail/uatom.hh create mode 100644 source/uatom.f create mode 100644 source/uniquetyp.f diff --git a/interface/CMakeLists.txt b/interface/CMakeLists.txt index e55b7b6f3..0d8082e17 100644 --- a/interface/CMakeLists.txt +++ b/interface/CMakeLists.txt @@ -162,6 +162,7 @@ add_library (tinkerObjF OBJECT ../source/tors.f ../source/tortor.f ../source/tree.f +../source/uatom.f ../source/units.f ../source/uprior.f ../source/urey.f @@ -524,6 +525,7 @@ add_library (tinkerObjF OBJECT ../source/torque.f ../source/torsions.f ../source/trimtext.f +../source/uniquetyp.f ../source/unitcell.f ../source/verlet.f ../source/version.f diff --git a/interface/c/tinker/detail/moment.hh b/interface/c/tinker/detail/moment.hh index 993c087de..a3bbcbfe0 100644 --- a/interface/c/tinker/detail/moment.hh +++ b/interface/c/tinker/detail/moment.hh @@ -20,6 +20,7 @@ extern double TINKER_MOD(moment, yzqpl); extern double TINKER_MOD(moment, zxqpl); extern double TINKER_MOD(moment, zyqpl); extern double TINKER_MOD(moment, zzqpl); +extern int* TINKER_MOD(moment, momuse); #ifdef __cplusplus } #endif diff --git a/interface/c/tinker/detail/output.hh b/interface/c/tinker/detail/output.hh index 21c1c9a68..d8a3e7d7a 100644 --- a/interface/c/tinker/detail/output.hh +++ b/interface/c/tinker/detail/output.hh @@ -23,7 +23,7 @@ extern int TINKER_MOD(output, frcsave); extern int TINKER_MOD(output, uindsave); extern int TINKER_MOD(output, ustcsave); extern int TINKER_MOD(output, usyssave); -extern int* TINKER_MOD(output, usysuse); +extern int TINKER_MOD(output, vsyssave); extern char TINKER_MOD(output, coordtype)[9]; #ifdef __cplusplus } diff --git a/interface/c/tinker/detail/uatom.hh b/interface/c/tinker/detail/uatom.hh new file mode 100644 index 000000000..9febaa05f --- /dev/null +++ b/interface/c/tinker/detail/uatom.hh @@ -0,0 +1,16 @@ +#pragma once + +#include "macro.hh" +#include "sizes.hh" + +#ifdef __cplusplus +extern "C" { +#endif +extern int TINKER_MOD(uatom, nunique); +extern int TINKER_MOD(uatom, utype)[TINKER_MOD__maxtyp]; +extern int TINKER_MOD(uatom, utypeinv)[TINKER_MOD__maxtyp]; +extern double TINKER_MOD(uatom, utv1)[TINKER_MOD__maxtyp][3]; +extern double TINKER_MOD(uatom, utv2)[TINKER_MOD__maxtyp][3]; +#ifdef __cplusplus +} +#endif diff --git a/interface/c/tinker/modc.h b/interface/c/tinker/modc.h index 8999383e2..796b9e780 100644 --- a/interface/c/tinker/modc.h +++ b/interface/c/tinker/modc.h @@ -158,6 +158,7 @@ #include "detail/tors.hh" #include "detail/tortor.hh" #include "detail/tree.hh" +#include "detail/uatom.hh" #include "detail/units.hh" #include "detail/uprior.hh" #include "detail/urey.hh" diff --git a/interface/c/tinker/routines.h b/interface/c/tinker/routines.h index 6c90a4bbf..e48e58af4 100644 --- a/interface/c/tinker/routines.h +++ b/interface/c/tinker/routines.h @@ -22,8 +22,8 @@ void active_(); #define tinker_f_active active_ void saveonly_(); #define tinker_f_saveonly saveonly_ -void saveusys_(); -#define tinker_f_saveusys saveusys_ +void msystem_(); +#define tinker_f_msystem msystem_ // alterchg.f void alterchg_(); @@ -2659,6 +2659,12 @@ inline void tinker_f_lowcase(tinker_fchars string) { return lowcase_(string.string, string.capacity); } +// uniquetyp.f +void uniquetyp_(); +#define tinker_f_uniquetyp uniquetyp_ +void velunique_(); +#define tinker_f_velunique velunique_ + // unitcell.f void unitcell_(); #define tinker_f_unitcell unitcell_ diff --git a/interface/cpp/tinker/detail/moment.hh b/interface/cpp/tinker/detail/moment.hh index 8c4d3bff6..a7483cab0 100644 --- a/interface/cpp/tinker/detail/moment.hh +++ b/interface/cpp/tinker/detail/moment.hh @@ -18,6 +18,7 @@ extern double& yzqpl; extern double& zxqpl; extern double& zyqpl; extern double& zzqpl; +extern int*& momuse; #ifdef TINKER_FORTRAN_MODULE_CPP extern "C" double TINKER_MOD(moment, netchg); @@ -35,6 +36,7 @@ extern "C" double TINKER_MOD(moment, yzqpl); extern "C" double TINKER_MOD(moment, zxqpl); extern "C" double TINKER_MOD(moment, zyqpl); extern "C" double TINKER_MOD(moment, zzqpl); +extern "C" int* TINKER_MOD(moment, momuse); double& netchg = TINKER_MOD(moment, netchg); double& netdpl = TINKER_MOD(moment, netdpl); @@ -51,5 +53,6 @@ double& yzqpl = TINKER_MOD(moment, yzqpl); double& zxqpl = TINKER_MOD(moment, zxqpl); double& zyqpl = TINKER_MOD(moment, zyqpl); double& zzqpl = TINKER_MOD(moment, zzqpl); +int*& momuse = TINKER_MOD(moment, momuse); #endif } } diff --git a/interface/cpp/tinker/detail/output.hh b/interface/cpp/tinker/detail/output.hh index 5244bc956..eba6666ec 100644 --- a/interface/cpp/tinker/detail/output.hh +++ b/interface/cpp/tinker/detail/output.hh @@ -21,7 +21,7 @@ extern int& frcsave; extern int& uindsave; extern int& ustcsave; extern int& usyssave; -extern int*& usysuse; +extern int& vsyssave; extern char (&coordtype)[9]; #ifdef TINKER_FORTRAN_MODULE_CPP @@ -43,7 +43,7 @@ extern "C" int TINKER_MOD(output, frcsave); extern "C" int TINKER_MOD(output, uindsave); extern "C" int TINKER_MOD(output, ustcsave); extern "C" int TINKER_MOD(output, usyssave); -extern "C" int* TINKER_MOD(output, usysuse); +extern "C" int TINKER_MOD(output, vsyssave); extern "C" char TINKER_MOD(output, coordtype)[9]; int& nonly = TINKER_MOD(output, nonly); @@ -64,7 +64,7 @@ int& frcsave = TINKER_MOD(output, frcsave); int& uindsave = TINKER_MOD(output, uindsave); int& ustcsave = TINKER_MOD(output, ustcsave); int& usyssave = TINKER_MOD(output, usyssave); -int*& usysuse = TINKER_MOD(output, usysuse); +int& vsyssave = TINKER_MOD(output, vsyssave); char (&coordtype)[9] = TINKER_MOD(output, coordtype); #endif } } diff --git a/interface/cpp/tinker/detail/uatom.hh b/interface/cpp/tinker/detail/uatom.hh new file mode 100644 index 000000000..04260c90c --- /dev/null +++ b/interface/cpp/tinker/detail/uatom.hh @@ -0,0 +1,28 @@ +#pragma once + +#include "macro.hh" +#include "sizes.hh" + +namespace tinker { namespace uatom { +using namespace sizes; + +extern int& nunique; +extern int (&utype)[maxtyp]; +extern int (&utypeinv)[maxtyp]; +extern double (&utv1)[maxtyp][3]; +extern double (&utv2)[maxtyp][3]; + +#ifdef TINKER_FORTRAN_MODULE_CPP +extern "C" int TINKER_MOD(uatom, nunique); +extern "C" int TINKER_MOD(uatom, utype)[maxtyp]; +extern "C" int TINKER_MOD(uatom, utypeinv)[maxtyp]; +extern "C" double TINKER_MOD(uatom, utv1)[maxtyp][3]; +extern "C" double TINKER_MOD(uatom, utv2)[maxtyp][3]; + +int& nunique = TINKER_MOD(uatom, nunique); +int (&utype)[maxtyp] = TINKER_MOD(uatom, utype); +int (&utypeinv)[maxtyp] = TINKER_MOD(uatom, utypeinv); +double (&utv1)[maxtyp][3] = TINKER_MOD(uatom, utv1); +double (&utv2)[maxtyp][3] = TINKER_MOD(uatom, utv2); +#endif +} } diff --git a/interface/cpp/tinker/modcpp.h b/interface/cpp/tinker/modcpp.h index 8999383e2..796b9e780 100644 --- a/interface/cpp/tinker/modcpp.h +++ b/interface/cpp/tinker/modcpp.h @@ -158,6 +158,7 @@ #include "detail/tors.hh" #include "detail/tortor.hh" #include "detail/tree.hh" +#include "detail/uatom.hh" #include "detail/units.hh" #include "detail/uprior.hh" #include "detail/urey.hh" diff --git a/interface/cpp/tinker/routines.h b/interface/cpp/tinker/routines.h index 6c90a4bbf..e48e58af4 100644 --- a/interface/cpp/tinker/routines.h +++ b/interface/cpp/tinker/routines.h @@ -22,8 +22,8 @@ void active_(); #define tinker_f_active active_ void saveonly_(); #define tinker_f_saveonly saveonly_ -void saveusys_(); -#define tinker_f_saveusys saveusys_ +void msystem_(); +#define tinker_f_msystem msystem_ // alterchg.f void alterchg_(); @@ -2659,6 +2659,12 @@ inline void tinker_f_lowcase(tinker_fchars string) { return lowcase_(string.string, string.capacity); } +// uniquetyp.f +void uniquetyp_(); +#define tinker_f_uniquetyp uniquetyp_ +void velunique_(); +#define tinker_f_velunique velunique_ + // unitcell.f void unitcell_(); #define tinker_f_unitcell unitcell_ diff --git a/source/active.f b/source/active.f index dca8c6b0c..14f2b6f54 100644 --- a/source/active.f +++ b/source/active.f @@ -365,22 +365,22 @@ subroutine saveonly end c c -c ################################################################ -c ## ## -c ## subroutine saveusys -- set exclusion for system dipole ## -c ## ## -c ################################################################ +c ################################################################## +c ## ## +c ## subroutine msystem -- set exclusion for moment of system ## +c ## ## +c ################################################################## c c -c "saveusys" sets the list of atoms that are excluded while -c computing system dipole +c "msystem" sets the list of atoms that are excluded while +c computing moment of system c c - subroutine saveusys + subroutine msystem use atoms use iounit use keys - use output + use moment implicit none integer i,j,next integer nfixed @@ -391,14 +391,10 @@ subroutine saveusys logical header c c -c return if not computing system dipole -c - if (.not. usyssave) return -c c perform dynamic allocation of some global arrays c - if (allocated(usysuse)) deallocate (usysuse) - allocate (usysuse(n)) + if (allocated(momuse)) deallocate (momuse) + allocate (momuse(n)) c c perform dynamic allocation of some local arrays c @@ -407,14 +403,14 @@ subroutine saveusys c set defaults for the numbers and lists of atoms to be used c do i = 1, n - usysuse(i) = .true. + momuse(i) = .true. end do nfixed = 0 do i = 1, n fixed(i) = 0 end do c -c get any keywords containing save-usysexc atom parameters +c get any keywords containing exc-moment atom parameters c do j = 1, nkey next = 1 @@ -425,7 +421,7 @@ subroutine saveusys c c get any lists of atoms whose coordinates should be used c - if (keyword(1:13) .eq. 'SAVE-USYSEXC ') then + if (keyword(1:13) .eq. 'EXC-MOMENT ') then read (string,*,err=10,end=10) (fixed(i),i=nfixed+1,n) 10 continue do while (fixed(nfixed+1) .ne. 0) @@ -443,8 +439,8 @@ subroutine saveusys if (header) then header = .false. write (iout,20) - 20 format (/,' SAVEUSYS -- Warning, Illegal Atom Number', - & ' in SAVE-USYSEXC Atom List') + 20 format (/,' MSYSTEM -- Warning, Illegal Atom Number', + & ' in EXC-MOMENT Atom List') end if end if end do @@ -455,11 +451,11 @@ subroutine saveusys do while (fixed(i) .ne. 0) if (fixed(i) .gt. 0) then j = fixed(i) - usysuse(j) = .false. + momuse(j) = .false. i = i + 1 else do j = abs(fixed(i)), abs(fixed(i+1)) - usysuse(j) = .false. + momuse(j) = .false. end do i = i + 2 end if diff --git a/source/analyze.f b/source/analyze.f index b440e0430..af3607a05 100644 --- a/source/analyze.f +++ b/source/analyze.f @@ -211,6 +211,10 @@ program analyze c if (doconect) call connyze (active) c +c check for use of exclusion in computing moment of system +c + if (domoment) call msystem +c c decide whether to perform analysis of individual frames c abort = .true. diff --git a/source/final.f b/source/final.f index bcef492cc..578397809 100644 --- a/source/final.f +++ b/source/final.f @@ -87,6 +87,7 @@ subroutine final use merck use molcul use moldyn + use moment use mpole use mrecip use mutant @@ -879,7 +880,7 @@ subroutine final c if (allocated(ionly)) deallocate (ionly) if (allocated(ionlyinv)) deallocate (ionlyinv) - if (allocated(usysuse)) deallocate (usysuse) + if (allocated(momuse)) deallocate (momuse) c c deallocation of global arrays from module paths c diff --git a/source/mdinit.f b/source/mdinit.f index 412997a03..68c1dfa06 100644 --- a/source/mdinit.f +++ b/source/mdinit.f @@ -72,6 +72,7 @@ subroutine mdinit (dt) uindsave = .false. ustcsave = .false. usyssave = .false. + vsyssave = .false. friction = 91.0d0 use_sdarea = .false. iprint = 100 @@ -128,6 +129,8 @@ subroutine mdinit (dt) ustcsave = .true. else if (keyword(1:13) .eq. 'SAVE-USYSTEM ') then usyssave = .true. + else if (keyword(1:13) .eq. 'SAVE-VSYSTEM ') then + vsyssave = .true. else if (keyword(1:9) .eq. 'FRICTION ') then read (string,*,err=10,end=10) friction else if (keyword(1:17) .eq. 'FRICTION-SCALING ') then @@ -165,9 +168,13 @@ subroutine mdinit (dt) c call saveonly c -c check for use of exclusion in save-usystem +c check for use of exclusion in computing moment of system c - call saveusys + call msystem +c +c get unique atom types +c + call uniquetyp c c check for use of induced dipole prediction methods c diff --git a/source/mdsave.f b/source/mdsave.f index 08a6328ee..0b4c3e567 100644 --- a/source/mdsave.f +++ b/source/mdsave.f @@ -36,6 +36,7 @@ subroutine mdsave (istep,dt,epot,eksum) use rgddyn use socket use titles + use uatom implicit none integer i,j,ii integer istep @@ -130,7 +131,7 @@ subroutine mdsave (istep,dt,epot,eksum) c if (use_bounds) call bounds c -c compute total dipole of system if desired +c compute dipole moment of system c if (usyssave) then call dmoments (xustc,yustc,zustc,xuind,yuind,zuind) @@ -156,12 +157,41 @@ subroutine mdsave (istep,dt,epot,eksum) 220 format (' System Induced Dipole',3f18.10) end if end if + write (iout,230) + 230 format (' Static Dipole by Atom Type:', + & /,' Type',5x,'X-UStatic',5x,'Y-UStatic',5x,'Z-UStatic') + do i = 1, nunique + write (iout,240) utype(i),utv1(1,i),utv1(2,i),utv1(3,i) + 240 format (i5,3f14.6) + end do + if (use_polar) then + write (iout,250) + 250 format (' Induced Dipole by Atom Type:', + & /,' Type',5x,'X-UInduce',5x,'Y-UInduce',5x,'Z-UInduce') + do i = 1, nunique + write (iout,260) utype(i),utv2(1,i),utv2(2,i),utv2(3,i) + 260 format (i5,3f14.6) + end do + end if + end if +c +c compute velocity of unique atom types in the system +c + if (vsyssave) then + call velunique + write (iout,270) + 270 format (' Velocity by Atom Type:', + & /,' Type',4x,'X-Velocity',4x,'Y-Velocity',4x,'Z-Velocity') + do i = 1, nunique + write (iout,280) utype(i),utv1(1,i),utv1(2,i),utv1(3,i) + 280 format (i5,3f14.6) + end do end if c c save coordinates to archive or numbered structure file c - write (iout,230) isave - 230 format (' Frame Number',13x,i10) + write (iout,290) isave + 290 format (' Frame Number',13x,i10) if (coordsave) then ixyz = freeunit () if (cyclesave) then @@ -195,8 +225,8 @@ subroutine mdsave (istep,dt,epot,eksum) call prtxyz (ixyz) end if close (unit=ixyz) - write (iout,240) xyzfile(1:trimtext(xyzfile)) - 240 format (' Coordinate File',13x,a) + write (iout,300) xyzfile(1:trimtext(xyzfile)) + 300 format (' Coordinate File',13x,a) end if c c update the information needed to restart the trajectory @@ -235,13 +265,13 @@ subroutine mdsave (istep,dt,epot,eksum) end if end if if (integrate .eq. 'RIGIDBODY') then - write (ivel,250) ngrp,title(1:ltitle) - 250 format (i6,2x,a) + write (ivel,310) ngrp,title(1:ltitle) + 310 format (i6,2x,a) do i = 1, ngrp - write (ivel,260) i,(vcm(j,i),j=1,3) - 260 format (i6,3x,d13.6,3x,d13.6,3x,d13.6) - write (ivel,270) i,(wcm(j,i),j=1,3) - 270 format (i6,3x,d13.6,3x,d13.6,3x,d13.6) + write (ivel,320) i,(vcm(j,i),j=1,3) + 320 format (i6,3x,d13.6,3x,d13.6,3x,d13.6) + write (ivel,330) i,(wcm(j,i),j=1,3) + 330 format (i6,3x,d13.6,3x,d13.6,3x,d13.6) end do else if (dcdsave) then call prtdcdv (ivel,first) @@ -249,8 +279,8 @@ subroutine mdsave (istep,dt,epot,eksum) call prtvel (ivel) end if close (unit=ivel) - write (iout,280) velfile(1:trimtext(velfile)) - 280 format (' Velocity File',15x,a) + write (iout,340) velfile(1:trimtext(velfile)) + 340 format (' Velocity File',15x,a) end if c c save the force vector components for the current step, @@ -289,8 +319,8 @@ subroutine mdsave (istep,dt,epot,eksum) call prtfrc (ifrc) end if close (unit=ifrc) - write (iout,290) frcfile(1:trimtext(frcfile)) - 290 format (' Force Vector File',11x,a) + write (iout,350) frcfile(1:trimtext(frcfile)) + 350 format (' Force Vector File',11x,a) end if c c save the induced dipole components for the current step @@ -328,8 +358,8 @@ subroutine mdsave (istep,dt,epot,eksum) call prtuind (iind) end if close (unit=iind) - write (iout,300) indfile(1:trimtext(indfile)) - 300 format (' Induced Dipole File',9x,a) + write (iout,360) indfile(1:trimtext(indfile)) + 360 format (' Induced Dipole File',9x,a) end if c c save the static dipole components for the current step @@ -367,8 +397,8 @@ subroutine mdsave (istep,dt,epot,eksum) call prtustc (istc) end if close (unit=istc) - write (iout,310) stcfile(1:trimtext(stcfile)) - 310 format (' Static Dipole File',10x,a) + write (iout,370) stcfile(1:trimtext(stcfile)) + 370 format (' Static Dipole File',10x,a) end if c c test for requested termination of the dynamics calculation @@ -385,8 +415,8 @@ subroutine mdsave (istep,dt,epot,eksum) end if end if if (exist) then - write (iout,320) - 320 format (/,' MDSAVE -- Dynamics Calculation Ending', + write (iout,380) + 380 format (/,' MDSAVE -- Dynamics Calculation Ending', & ' due to User Request') call fatal end if @@ -395,8 +425,8 @@ subroutine mdsave (istep,dt,epot,eksum) c modsave = mod(istep,iprint) if (verbose .and. modsave.ne.0) then - write (iout,330) - 330 format () + write (iout,390) + 390 format () end if return end diff --git a/source/moment.f b/source/moment.f index d6046ff26..840e80429 100644 --- a/source/moment.f +++ b/source/moment.f @@ -27,6 +27,7 @@ c zxqpl total quadrupole tensor zx-component in global frame c zyqpl total quadrupole tensor zy-component in global frame c zzqpl total quadrupole tensor zz-component in global frame +c momuse true if an atom is used for system moment calculation c c module moment @@ -37,5 +38,6 @@ module moment real*8 xxqpl,xyqpl,xzqpl real*8 yxqpl,yyqpl,yzqpl real*8 zxqpl,zyqpl,zzqpl + logical, allocatable :: momuse(:) save end diff --git a/source/moments.f b/source/moments.f index f90901971..1a913ab8a 100644 --- a/source/moments.f +++ b/source/moments.f @@ -131,7 +131,7 @@ subroutine moments (mode) c do i = 1, nion k = iion(i) - if (use(k)) then + if (use(k) .and. momuse(k)) then netchg = netchg + pchg(k) xdpl = xdpl + xcm(k)*pchg(k) ydpl = ydpl + ycm(k)*pchg(k) @@ -153,7 +153,7 @@ subroutine moments (mode) do i = 1, ndipole j = idpl(1,i) k = idpl(2,i) - if (use(j) .or. use(k)) then + if ((use(j).and.momuse(j)) .or. (use(k).and.momuse(k))) then xi = x(j) - x(k) yi = y(j) - y(k) zi = z(j) - z(k) @@ -205,7 +205,7 @@ subroutine moments (mode) c do i = 1, npole k = ipole(i) - if (use(k)) then + if (use(k) .and. momuse(k)) then netchg = netchg + rpole(1,k) xdpl = xdpl + xcm(k)*rpole(1,k) + rpole(2,k) ydpl = ydpl + ycm(k)*rpole(1,k) + rpole(3,k) @@ -254,7 +254,7 @@ subroutine moments (mode) c do i = 1, npole k = ipole(i) - if (use(k)) then + if (use(k) .and. momuse(k)) then xxqpl = xxqpl + 3.0d0*rpole(5,k) xyqpl = xyqpl + 3.0d0*rpole(6,k) xzqpl = xzqpl + 3.0d0*rpole(7,k) @@ -318,25 +318,48 @@ subroutine moments (mode) c ############################################################## c c -c "dmoments" computes the total dipole moments over all atoms; +c "dmoments" computes the total dipole moments over all atoms and +c the unique atom type dipole moments; c called in mdsave, it is assumed bound is called c c subroutine dmoments (xustc,yustc,zustc,xuind,yuind,zuind) + use atomid use atoms use moment use mpole - use output use polar use potent + use uatom use units implicit none - integer i + integer i,j + integer ut + real*8 xmid,ymid,zmid,weigh + real*8 xu,yu,zu real*8 xustc,yustc,zustc real*8 xuind,yuind,zuind c c -c zero out total dipole moment +c find the center of mass of the set of active atoms +c + weigh = 0.0d0 + xmid = 0.0d0 + ymid = 0.0d0 + zmid = 0.0d0 + do i = 1, n + weigh = weigh + mass(i) + xmid = xmid + x(i)*mass(i) + ymid = ymid + y(i)*mass(i) + zmid = zmid + z(i)*mass(i) + end do + if (weigh .ne. 0.0d0) then + xmid = xmid / weigh + ymid = ymid / weigh + zmid = zmid / weigh + end if +c +c zero out dipole moments c xustc = 0.0d0 yustc = 0.0d0 @@ -344,21 +367,34 @@ subroutine dmoments (xustc,yustc,zustc,xuind,yuind,zuind) xuind = 0.0d0 yuind = 0.0d0 zuind = 0.0d0 + do i = 1, nunique + do j = 1, 3 + utv1(j,i) = 0.0d0 + utv2(j,i) = 0.0d0 + end do + end do c c OpenMP directives for the major loop structure c !$OMP PARALLEL default(private) -!$OMP& shared(n,x,y,z,rpole,uind,use_polar,usysuse, -!$OMP& xustc,yustc,zustc,xuind,yuind,zuind) -!$OMP DO reduction(+:xustc,yustc,zustc) schedule(guided) +!$OMP& shared(n,x,y,z,rpole,uind,use_polar,momuse,xmid,ymid,zmid, +!$OMP& xustc,yustc,zustc,xuind,yuind,zuind,utv1,utv2,type,utypeinv) +!$OMP DO reduction(+:xustc,yustc,zustc,utv1) schedule(guided) c c compute the static dipole moment c do i = 1, n - if (usysuse(i)) then - xustc = xustc + x(i)*rpole(1,i) + rpole(2,i) - yustc = yustc + y(i)*rpole(1,i) + rpole(3,i) - zustc = zustc + z(i)*rpole(1,i) + rpole(4,i) + if (momuse(i)) then + xu = (x(i)-xmid)*rpole(1,i) + rpole(2,i) + yu = (y(i)-ymid)*rpole(1,i) + rpole(3,i) + zu = (z(i)-zmid)*rpole(1,i) + rpole(4,i) + xustc = xustc + xu + yustc = yustc + yu + zustc = zustc + zu + ut = utypeinv(type(i)) + utv1(1,ut) = utv1(1,ut) + xu + utv1(2,ut) = utv1(2,ut) + yu + utv1(3,ut) = utv1(3,ut) + zu end if end do !$OMP END DO @@ -366,12 +402,19 @@ subroutine dmoments (xustc,yustc,zustc,xuind,yuind,zuind) c compute the induced dipole moment c if (use_polar) then -!$OMP DO reduction(+:xuind,yuind,zuind) schedule(guided) +!$OMP DO reduction(+:xuind,yuind,zuind,utv2) schedule(guided) do i = 1, n - if (usysuse(i)) then - xuind = xuind + uind(1,i) - yuind = yuind + uind(2,i) - zuind = zuind + uind(3,i) + if (momuse(i)) then + xu = uind(1,i) + yu = uind(2,i) + zu = uind(3,i) + xuind = xuind + xu + yuind = yuind + yu + zuind = zuind + zu + ut = utypeinv(type(i)) + utv2(1,ut) = utv2(1,ut) + xu + utv2(2,ut) = utv2(2,ut) + yu + utv2(3,ut) = utv2(3,ut) + zu end if end do !$OMP END DO @@ -386,5 +429,11 @@ subroutine dmoments (xustc,yustc,zustc,xuind,yuind,zuind) xuind = xuind * debye yuind = yuind * debye zuind = zuind * debye + do i = 1, nunique + do j = 1, 3 + utv1(j,i) = utv1(j,i) * debye + utv2(j,i) = utv2(j,i) * debye + end do + end do return end diff --git a/source/output.f b/source/output.f index b21975a28..b11b55874 100644 --- a/source/output.f +++ b/source/output.f @@ -29,8 +29,8 @@ c frcsave logical flag to save force vector components c uindsave logical flag to save induced atomic dipoles c ustcsave logical flag to save static atomic dipoles -c usyssave logical flag to save total dipole of the system -c usysuse true if an atom is used for system dipole calculation +c usyssave logical flag to save unique atom type dipole moment +c vsyssave logical flag to save unique atom type velocity c coordtype selects Cartesian, internal, rigid body or none c c @@ -54,7 +54,7 @@ module output logical uindsave logical ustcsave logical usyssave - logical, allocatable :: usysuse(:) + logical vsyssave character*9 coordtype save end diff --git a/source/uatom.f b/source/uatom.f new file mode 100644 index 000000000..1134c5e82 --- /dev/null +++ b/source/uatom.f @@ -0,0 +1,31 @@ +c +c +c ############################################################## +c ## COPYRIGHT (C) 2024 by Moses KJ Chung & Jay W Ponder ## +c ## All Rights Reserved ## +c ############################################################## +c +c ####################################################### +c ## ## +c ## module uatom -- properties based on atom type ## +c ## ## +c ####################################################### +c +c +c nunique number of unique atom types in the system +c utype map from unique type to atom type +c utypeinv map from atom type to unique type +c utv1 unique type vector 1 +c utv2 unique type vector 2 +c +c + module uatom + use sizes + implicit none + integer nunique + integer utype(maxtyp) + integer utypeinv(maxtyp) + real*8 utv1(3,maxtyp) + real*8 utv2(3,maxtyp) + save + end diff --git a/source/uniquetyp.f b/source/uniquetyp.f new file mode 100644 index 000000000..e0d97534d --- /dev/null +++ b/source/uniquetyp.f @@ -0,0 +1,101 @@ +c +c +c ############################################################## +c ## COPYRIGHT (C) 2024 by Moses KJ Chung & Jay W Ponder ## +c ## All Rights Reserved ## +c ############################################################## +c +c ################################################################## +c ## ## +c ## subroutine uniquetyp -- get unique atom type information ## +c ## ## +c ################################################################## +c +c +c "uniquetyp" determines the number of unique types and map between +c atom types and unique types +c +c + subroutine uniquetyp + use atoms + use uatom + implicit none + integer i,j + integer at + real*8 xx +c +c +c initialize nunique, utype, and utypeinv +c + nunique = 0 + do i = 1, maxtyp + utype(i) = 0 + utypeinv(i) = 0 + end do +c +c loop through atoms to find unique atom types +c + do i = 1, n + at = type(i) +c +c check if the current atom type is already in unique type array +c + do j = 1, nunique + if (at .eq. utype(j)) goto 10 + end do +c +c set unique atom types +c + nunique = nunique + 1 + utype(nunique) = at + utypeinv(at) = nunique +10 continue + end do + return + end +c +c +c ########################################################### +c ## ## +c ## subroutine velunique -- unique atom type velocity ## +c ## ## +c ########################################################### +c +c +c "velunique" computes the unique atom type velocities +c +c + subroutine velunique + use atomid + use atoms + use moldyn + use output + use uatom + implicit none + integer i + integer ut +c +c +c zero out velocity +c + do i = 1, nunique + utv1(1,i) = 0.0d0 + utv1(2,i) = 0.0d0 + utv1(3,i) = 0.0d0 + end do +!$OMP PARALLEL default(private) +!$OMP& shared(n,utv1,type,utypeinv,v) +!$OMP DO reduction(+:utv1) schedule(guided) +c +c compute velocity by unique atom type +c + do i = 1, n + ut = utypeinv(type(i)) + utv1(1,ut) = utv1(1,ut) + v(1,i) + utv1(2,ut) = utv1(2,ut) + v(2,i) + utv1(3,ut) = utv1(3,ut) + v(3,i) + end do +!$OMP END DO +!$OMP END PARALLEL + return + end From 7e00665085c6b8c67487b06b1d7983e516312143 Mon Sep 17 00:00:00 2001 From: Moses Chung Date: Wed, 25 Sep 2024 17:20:29 -0500 Subject: [PATCH 14/29] move msystem to kmpole --- source/analyze.f | 4 ---- source/kmpole.f | 4 ++++ source/mdinit.f | 4 ---- 3 files changed, 4 insertions(+), 8 deletions(-) diff --git a/source/analyze.f b/source/analyze.f index af3607a05..b440e0430 100644 --- a/source/analyze.f +++ b/source/analyze.f @@ -211,10 +211,6 @@ program analyze c if (doconect) call connyze (active) c -c check for use of exclusion in computing moment of system -c - if (domoment) call msystem -c c decide whether to perform analysis of individual frames c abort = .true. diff --git a/source/kmpole.f b/source/kmpole.f index 46309e668..c43b80155 100644 --- a/source/kmpole.f +++ b/source/kmpole.f @@ -705,6 +705,10 @@ subroutine kmpole if (use_mpole .and. .not.use_polar .and. .not.use_chgtrn) & call chkpole c +c set exclusion in computing moment of system +c + call msystem +c c turn off atomic multipole potentials if not used c if (npole .eq. 0) use_mpole = .false. diff --git a/source/mdinit.f b/source/mdinit.f index 68c1dfa06..af53e989b 100644 --- a/source/mdinit.f +++ b/source/mdinit.f @@ -168,10 +168,6 @@ subroutine mdinit (dt) c call saveonly c -c check for use of exclusion in computing moment of system -c - call msystem -c c get unique atom types c call uniquetyp From 83a90df8b18a2c854faf8effea17b1f4b05631ac Mon Sep 17 00:00:00 2001 From: Moses Chung Date: Wed, 25 Sep 2024 19:10:30 -0500 Subject: [PATCH 15/29] separate compute center routine --- interface/c/tinker/routines.h | 8 +++--- interface/cpp/tinker/routines.h | 8 +++--- source/center.f | 48 +++++++++++++++++++++++++++++++++ source/mdsave.f | 13 ++++++--- source/moments.f | 31 +++++---------------- source/prtuind.f | 33 +++++++++++++---------- 6 files changed, 92 insertions(+), 49 deletions(-) diff --git a/interface/c/tinker/routines.h b/interface/c/tinker/routines.h index e48e58af4..1c1e3d541 100644 --- a/interface/c/tinker/routines.h +++ b/interface/c/tinker/routines.h @@ -114,6 +114,8 @@ void calendar_(int* year, int* month, int* day, int* hour, int* minute, int* sec // center.f void center_(int* n1, double* x1, double* y1, double* z1, int* n2, double* x2, double* y2, double* z2, double* xmid, double* ymid, double* zmid); #define tinker_f_center center_ +void compcent_(double* xmid, double* ymid, double* zmid); +#define tinker_f_compcent compcent_ // chkpole.f void chkpole_(); @@ -1936,7 +1938,7 @@ void moments_(char* mode, tinker_fchar_len_t mode_cap); inline void tinker_f_moments(tinker_fchars mode) { return moments_(mode.string, mode.capacity); } -void dmoments_(double* xustc, double* yustc, double* zustc, double* xuind, double* yuind, double* zuind); +void dmoments_(double* xm, double* ym, double* zm, double* xustc, double* yustc, double* zustc, double* xuind, double* yuind, double* zuind); #define tinker_f_dmoments dmoments_ // mutate.f @@ -2244,9 +2246,9 @@ void prtuind_(int* iind); #define tinker_f_prtuind prtuind_ void prtdcdu_(int* idcd, int* first); #define tinker_f_prtdcdu prtdcdu_ -void prtustc_(int* istc); +void prtustc_(int* istc, double* xm, double* ym, double* zm); #define tinker_f_prtustc prtustc_ -void prtdcdd_(int* idcd, int* first); +void prtdcdd_(int* idcd, int* first, double* xm, double* ym, double* zm); #define tinker_f_prtdcdd prtdcdd_ // prtvel.f diff --git a/interface/cpp/tinker/routines.h b/interface/cpp/tinker/routines.h index e48e58af4..1c1e3d541 100644 --- a/interface/cpp/tinker/routines.h +++ b/interface/cpp/tinker/routines.h @@ -114,6 +114,8 @@ void calendar_(int* year, int* month, int* day, int* hour, int* minute, int* sec // center.f void center_(int* n1, double* x1, double* y1, double* z1, int* n2, double* x2, double* y2, double* z2, double* xmid, double* ymid, double* zmid); #define tinker_f_center center_ +void compcent_(double* xmid, double* ymid, double* zmid); +#define tinker_f_compcent compcent_ // chkpole.f void chkpole_(); @@ -1936,7 +1938,7 @@ void moments_(char* mode, tinker_fchar_len_t mode_cap); inline void tinker_f_moments(tinker_fchars mode) { return moments_(mode.string, mode.capacity); } -void dmoments_(double* xustc, double* yustc, double* zustc, double* xuind, double* yuind, double* zuind); +void dmoments_(double* xm, double* ym, double* zm, double* xustc, double* yustc, double* zustc, double* xuind, double* yuind, double* zuind); #define tinker_f_dmoments dmoments_ // mutate.f @@ -2244,9 +2246,9 @@ void prtuind_(int* iind); #define tinker_f_prtuind prtuind_ void prtdcdu_(int* idcd, int* first); #define tinker_f_prtdcdu prtdcdu_ -void prtustc_(int* istc); +void prtustc_(int* istc, double* xm, double* ym, double* zm); #define tinker_f_prtustc prtustc_ -void prtdcdd_(int* idcd, int* first); +void prtdcdd_(int* idcd, int* first, double* xm, double* ym, double* zm); #define tinker_f_prtdcdd prtdcdd_ // prtvel.f diff --git a/source/center.f b/source/center.f index 48c29fd36..b034a0592 100644 --- a/source/center.f +++ b/source/center.f @@ -76,3 +76,51 @@ subroutine center (n1,x1,y1,z1,n2,x2,y2,z2,xmid,ymid,zmid) end do return end +c +c +c ####################################################### +c ## ## +c ## subroutine compcent -- compute center of mass ## +c ## ## +c ####################################################### +c +c +c "compcent" computes the center of mass +c +c + subroutine compcent (xmid,ymid,zmid) + use atomid + use atoms + implicit none + integer i + real*8 weigh + real*8 xmid,ymid,zmid +c +c +c find the center of mass of the set of active atoms +c + weigh = 0.0d0 + xmid = 0.0d0 + ymid = 0.0d0 + zmid = 0.0d0 +c +c OpenMP directives for the major loop structure +c +!$OMP PARALLEL default(private) +!$OMP& shared(n,x,y,z,xmid,ymid,zmid,weigh,mass) +!$OMP DO reduction(+:xmid,ymid,zmid,weigh) schedule(guided) + do i = 1, n + weigh = weigh + mass(i) + xmid = xmid + x(i)*mass(i) + ymid = ymid + y(i)*mass(i) + zmid = zmid + z(i)*mass(i) + end do +!$OMP END DO +!$OMP END PARALLEL + if (weigh .ne. 0.0d0) then + xmid = xmid / weigh + ymid = ymid / weigh + zmid = zmid / weigh + end if + return + end diff --git a/source/mdsave.f b/source/mdsave.f index 0b4c3e567..46f7cedf0 100644 --- a/source/mdsave.f +++ b/source/mdsave.f @@ -49,6 +49,7 @@ subroutine mdsave (istep,dt,epot,eksum) real*8 epot,eksum real*8 xustc,yustc,zustc real*8 xuind,yuind,zuind + real*8 xm,ym,zm logical exist,first character*7 ext character*240 endfile @@ -131,10 +132,14 @@ subroutine mdsave (istep,dt,epot,eksum) c if (use_bounds) call bounds c +c compute center of mass if saving dipole moment +c + if (usyssave .or. ustcsave) call compcent(xm,ym,zm) +c c compute dipole moment of system c if (usyssave) then - call dmoments (xustc,yustc,zustc,xuind,yuind,zuind) + call dmoments (xm,ym,zm,xustc,yustc,zustc,xuind,yuind,zuind) if (digits .le. 6) then write (iout,170) xustc,yustc,zustc 170 format (' System Static Dipole',1x,3f14.6) @@ -370,7 +375,7 @@ subroutine mdsave (istep,dt,epot,eksum) stcfile = filename(1:leng)//'.'//ext(1:lext)//'d' call version (stcfile,'new') open (unit=istc,file=stcfile,status='new') - call prtustc (istc) + call prtustc (istc,xm,ym,zm) else if (dcdsave) then stcfile = filename(1:leng) call suffix (stcfile,'dcdd','old') @@ -384,7 +389,7 @@ subroutine mdsave (istep,dt,epot,eksum) open (unit=istc,file=stcfile,form='unformatted', & status='new') end if - call prtdcdd (istc,first) + call prtdcdd (istc,first,xm,ym,zm) else stcfile = filename(1:leng) call suffix (stcfile,'ustc','old') @@ -394,7 +399,7 @@ subroutine mdsave (istep,dt,epot,eksum) else open (unit=istc,file=stcfile,status='new') end if - call prtustc (istc) + call prtustc (istc,xm,ym,zm) end if close (unit=istc) write (iout,370) stcfile(1:trimtext(stcfile)) diff --git a/source/moments.f b/source/moments.f index 1a913ab8a..dd5786faf 100644 --- a/source/moments.f +++ b/source/moments.f @@ -323,8 +323,7 @@ subroutine moments (mode) c called in mdsave, it is assumed bound is called c c - subroutine dmoments (xustc,yustc,zustc,xuind,yuind,zuind) - use atomid + subroutine dmoments (xm,ym,zm,xustc,yustc,zustc,xuind,yuind,zuind) use atoms use moment use mpole @@ -335,30 +334,12 @@ subroutine dmoments (xustc,yustc,zustc,xuind,yuind,zuind) implicit none integer i,j integer ut - real*8 xmid,ymid,zmid,weigh + real*8 xm,ym,zm real*8 xu,yu,zu real*8 xustc,yustc,zustc real*8 xuind,yuind,zuind c c -c find the center of mass of the set of active atoms -c - weigh = 0.0d0 - xmid = 0.0d0 - ymid = 0.0d0 - zmid = 0.0d0 - do i = 1, n - weigh = weigh + mass(i) - xmid = xmid + x(i)*mass(i) - ymid = ymid + y(i)*mass(i) - zmid = zmid + z(i)*mass(i) - end do - if (weigh .ne. 0.0d0) then - xmid = xmid / weigh - ymid = ymid / weigh - zmid = zmid / weigh - end if -c c zero out dipole moments c xustc = 0.0d0 @@ -377,7 +358,7 @@ subroutine dmoments (xustc,yustc,zustc,xuind,yuind,zuind) c OpenMP directives for the major loop structure c !$OMP PARALLEL default(private) -!$OMP& shared(n,x,y,z,rpole,uind,use_polar,momuse,xmid,ymid,zmid, +!$OMP& shared(n,x,y,z,rpole,uind,use_polar,momuse,xm,ym,zm, !$OMP& xustc,yustc,zustc,xuind,yuind,zuind,utv1,utv2,type,utypeinv) !$OMP DO reduction(+:xustc,yustc,zustc,utv1) schedule(guided) c @@ -385,9 +366,9 @@ subroutine dmoments (xustc,yustc,zustc,xuind,yuind,zuind) c do i = 1, n if (momuse(i)) then - xu = (x(i)-xmid)*rpole(1,i) + rpole(2,i) - yu = (y(i)-ymid)*rpole(1,i) + rpole(3,i) - zu = (z(i)-zmid)*rpole(1,i) + rpole(4,i) + xu = (x(i)-xm)*rpole(1,i) + rpole(2,i) + yu = (y(i)-ym)*rpole(1,i) + rpole(3,i) + zu = (z(i)-zm)*rpole(1,i) + rpole(4,i) xustc = xustc + xu yustc = yustc + yu zustc = zustc + zu diff --git a/source/prtuind.f b/source/prtuind.f index fc912b2f3..3961c923f 100644 --- a/source/prtuind.f +++ b/source/prtuind.f @@ -279,7 +279,7 @@ subroutine prtdcdu (idcd,first) c to an external disk file in Tinker XYZ format c c - subroutine prtustc (istc) + subroutine prtustc (istc,xm,ym,zm) use atomid use atoms use bound @@ -297,6 +297,7 @@ subroutine prtustc (istc) integer size,crdsiz real*8 crdmin,crdmax real*8 c,xd,yd,zd + real*8 xm,ym,zm logical opened character*2 atmc character*2 crdc @@ -375,9 +376,9 @@ subroutine prtustc (istc) if (.not. onlysave) then do i = 1, n c = rpole(1,i) - xd = (x(i)*c + rpole(2,i)) * debye - yd = (y(i)*c + rpole(3,i)) * debye - zd = (z(i)*c + rpole(4,i)) * debye + xd = ((x(i)-xm)*c + rpole(2,i)) * debye + yd = ((y(i)-ym)*c + rpole(3,i)) * debye + zd = ((z(i)-zm)*c + rpole(4,i)) * debye k = n12(i) if (k .eq. 0) then write (istc,fstr) i,name(i),xd,yd,zd,type(i) @@ -390,9 +391,9 @@ subroutine prtustc (istc) do ii = 1, nonly i = ionly(ii) c = rpole(1,i) - xd = (x(i)*c + rpole(2,i)) * debye - yd = (y(i)*c + rpole(3,i)) * debye - zd = (z(i)*c + rpole(4,i)) * debye + xd = ((x(i)-xm)*c + rpole(2,i)) * debye + yd = ((y(i)-ym)*c + rpole(3,i)) * debye + zd = ((z(i)-zm)*c + rpole(4,i)) * debye k = n12(i) if (k .eq. 0) then write (istc,fstr) ii,name(i),xd,yd,zd,type(i) @@ -445,7 +446,7 @@ subroutine prtustc (istc) c the particular feature is unused c c - subroutine prtdcdd (idcd,first) + subroutine prtdcdd (idcd,first,xm,ym,zm) use atoms use bound use boxes @@ -465,6 +466,7 @@ subroutine prtdcdd (idcd,first) integer merged,vcharmm integer ntitle real*4 tdelta + real*8 xm,ym,zm logical opened,first character*4 header character*240 dcdfile @@ -522,15 +524,18 @@ subroutine prtdcdd (idcd,first) c append the static dipoles along each axis in turn c if (.not. onlysave) then - write (idcd) (real(debye*(x(i)*rpole(1,i) + rpole(2,i))),i=1,n) - write (idcd) (real(debye*(y(i)*rpole(1,i) + rpole(3,i))),i=1,n) - write (idcd) (real(debye*(z(i)*rpole(1,i) + rpole(4,i))),i=1,n) + write (idcd) (real(debye*((x(i)-xm)*rpole(1,i) + & + rpole(2,i))),i=1,n) + write (idcd) (real(debye*((y(i)-ym)*rpole(1,i) + & + rpole(3,i))),i=1,n) + write (idcd) (real(debye*((z(i)-zm)*rpole(1,i) + & + rpole(4,i))),i=1,n) else - write (idcd) (real(debye*(x(ionly(i))*rpole(1,ionly(i)) + write (idcd) (real(debye*((x(ionly(i))-xm)*rpole(1,ionly(i)) & + rpole(2,ionly(i)))),i=1,nonly) - write (idcd) (real(debye*(y(ionly(i))*rpole(1,ionly(i)) + write (idcd) (real(debye*((y(ionly(i))-ym)*rpole(1,ionly(i)) & + rpole(3,ionly(i)))),i=1,nonly) - write (idcd) (real(debye*(z(ionly(i))*rpole(1,ionly(i)) + write (idcd) (real(debye*((z(ionly(i))-zm)*rpole(1,ionly(i)) & + rpole(4,ionly(i)))),i=1,nonly) end if c From 93da866c92428c27af57fa490f7bd52c6cc5531f Mon Sep 17 00:00:00 2001 From: Moses Chung Date: Thu, 26 Sep 2024 11:23:26 -0500 Subject: [PATCH 16/29] mdsave extended format --- source/mdsave.f | 24 ++++++++++++------------ 1 file changed, 12 insertions(+), 12 deletions(-) diff --git a/source/mdsave.f b/source/mdsave.f index 46f7cedf0..43a460a19 100644 --- a/source/mdsave.f +++ b/source/mdsave.f @@ -142,40 +142,40 @@ subroutine mdsave (istep,dt,epot,eksum) call dmoments (xm,ym,zm,xustc,yustc,zustc,xuind,yuind,zuind) if (digits .le. 6) then write (iout,170) xustc,yustc,zustc - 170 format (' System Static Dipole',1x,3f14.6) + 170 format (' System Static Dipole',1x,3f20.6) else if (digits .le. 8) then write (iout,180) xustc,yustc,zustc - 180 format (' System Static Dipole',1x,3f16.8) + 180 format (' System Static Dipole',1x,3f22.8) else write (iout,190) xustc,yustc,zustc - 190 format (' System Static Dipole',1x,3f18.10) + 190 format (' System Static Dipole',1x,3f24.10) end if if (use_polar) then if (digits .le. 6) then write (iout,200) xuind,yuind,zuind - 200 format (' System Induced Dipole',3f14.6) + 200 format (' System Induced Dipole',3f20.6) else if (digits .le. 8) then write (iout,210) xuind,yuind,zuind - 210 format (' System Induced Dipole',3f16.8) + 210 format (' System Induced Dipole',3f22.8) else write (iout,220) xuind,yuind,zuind - 220 format (' System Induced Dipole',3f18.10) + 220 format (' System Induced Dipole',3f24.10) end if end if write (iout,230) 230 format (' Static Dipole by Atom Type:', - & /,' Type',5x,'X-UStatic',5x,'Y-UStatic',5x,'Z-UStatic') + & /,' Type',11x,'X-UStatic',11x,'Y-UStatic',11x,'Z-UStatic') do i = 1, nunique write (iout,240) utype(i),utv1(1,i),utv1(2,i),utv1(3,i) - 240 format (i5,3f14.6) + 240 format (i5,3f20.6) end do if (use_polar) then write (iout,250) 250 format (' Induced Dipole by Atom Type:', - & /,' Type',5x,'X-UInduce',5x,'Y-UInduce',5x,'Z-UInduce') + & /,' Type',11x,'X-UInduce',11x,'Y-UInduce',11x,'Z-UInduce') do i = 1, nunique write (iout,260) utype(i),utv2(1,i),utv2(2,i),utv2(3,i) - 260 format (i5,3f14.6) + 260 format (i5,3f20.6) end do end if end if @@ -186,10 +186,10 @@ subroutine mdsave (istep,dt,epot,eksum) call velunique write (iout,270) 270 format (' Velocity by Atom Type:', - & /,' Type',4x,'X-Velocity',4x,'Y-Velocity',4x,'Z-Velocity') + & /,' Type',10x,'X-Velocity',10x,'Y-Velocity',10x,'Z-Velocity') do i = 1, nunique write (iout,280) utype(i),utv1(1,i),utv1(2,i),utv1(3,i) - 280 format (i5,3f14.6) + 280 format (i5,3f20.6) end do end if c From 5bba55f77066bcb5a4b9403f9d7375db867f069e Mon Sep 17 00:00:00 2001 From: Moses Date: Thu, 11 Sep 2025 12:48:53 -0500 Subject: [PATCH 17/29] include charge dipoles in SAVE-USYSTEM and add SAVE-UCHARGE keyword --- source/mdinit.f | 5 +- source/mdsave.f | 162 +++++++++++++++-------- source/moments.f | 34 ++++- source/optinit.f | 2 +- source/output.f | 2 + source/prtuind.f | 337 ++++++++++++++++++++++++++++++++++++++++++----- source/uatom.f | 2 + 7 files changed, 448 insertions(+), 96 deletions(-) diff --git a/source/mdinit.f b/source/mdinit.f index af53e989b..3111f4992 100644 --- a/source/mdinit.f +++ b/source/mdinit.f @@ -71,6 +71,7 @@ subroutine mdinit (dt) frcsave = .false. uindsave = .false. ustcsave = .false. + uchgsave = .false. usyssave = .false. vsyssave = .false. friction = 91.0d0 @@ -123,10 +124,12 @@ subroutine mdinit (dt) velsave = .true. else if (keyword(1:11) .eq. 'SAVE-FORCE ') then frcsave = .true. - else if (keyword(1:13) .eq. 'SAVE-INDUCED ') then + else if (keyword(1:13) .eq. 'SAVE-UINDUCE ') then uindsave = .true. else if (keyword(1:13) .eq. 'SAVE-USTATIC ') then ustcsave = .true. + else if (keyword(1:13) .eq. 'SAVE-UCHARGE ') then + uchgsave = .true. else if (keyword(1:13) .eq. 'SAVE-USYSTEM ') then usyssave = .true. else if (keyword(1:13) .eq. 'SAVE-VSYSTEM ') then diff --git a/source/mdsave.f b/source/mdsave.f index 43a460a19..cd0692ce4 100644 --- a/source/mdsave.f +++ b/source/mdsave.f @@ -49,6 +49,7 @@ subroutine mdsave (istep,dt,epot,eksum) real*8 epot,eksum real*8 xustc,yustc,zustc real*8 xuind,yuind,zuind + real*8 xuchg,yuchg,zuchg real*8 xm,ym,zm logical exist,first character*7 ext @@ -134,48 +135,62 @@ subroutine mdsave (istep,dt,epot,eksum) c c compute center of mass if saving dipole moment c - if (usyssave .or. ustcsave) call compcent(xm,ym,zm) + if (usyssave .or. uchgsave) call compcent(xm,ym,zm) c c compute dipole moment of system c if (usyssave) then - call dmoments (xm,ym,zm,xustc,yustc,zustc,xuind,yuind,zuind) + call dmoments (xm,ym,zm,xustc,yustc,zustc,xuind,yuind,zuind, + & xuchg,yuchg,zuchg) if (digits .le. 6) then - write (iout,170) xustc,yustc,zustc - 170 format (' System Static Dipole',1x,3f20.6) - else if (digits .le. 8) then + write (iout,170) xuchg,yuchg,zuchg + 170 format (' System Charge Dipole',1x,3f20.6) write (iout,180) xustc,yustc,zustc - 180 format (' System Static Dipole',1x,3f22.8) + 180 format (' System Static Dipole',1x,3f20.6) + else if (digits .le. 8) then + write (iout,190) xuchg,yuchg,zuchg + 190 format (' System Charge Dipole',1x,3f22.8) + write (iout,200) xustc,yustc,zustc + 200 format (' System Static Dipole',1x,3f22.8) else - write (iout,190) xustc,yustc,zustc - 190 format (' System Static Dipole',1x,3f24.10) + write (iout,210) xuchg,yuchg,zuchg + 210 format (' System Charge Dipole',1x,3f24.10) + write (iout,220) xustc,yustc,zustc + 220 format (' System Static Dipole',1x,3f24.10) end if if (use_polar) then if (digits .le. 6) then - write (iout,200) xuind,yuind,zuind - 200 format (' System Induced Dipole',3f20.6) + write (iout,230) xuind,yuind,zuind + 230 format (' System Induced Dipole',3f20.6) else if (digits .le. 8) then - write (iout,210) xuind,yuind,zuind - 210 format (' System Induced Dipole',3f22.8) + write (iout,240) xuind,yuind,zuind + 240 format (' System Induced Dipole',3f22.8) else - write (iout,220) xuind,yuind,zuind - 220 format (' System Induced Dipole',3f24.10) + write (iout,250) xuind,yuind,zuind + 250 format (' System Induced Dipole',3f24.10) end if end if - write (iout,230) - 230 format (' Static Dipole by Atom Type:', + write (iout,260) + 260 format (' Charge Dipole by Atom Type:', + & /,' Type',11x,'X-UCharge',11x,'Y-UCharge',11x,'Z-UCharge') + do i = 1, nunique + write (iout,270) utype(i),utv3(1,i),utv3(2,i),utv3(3,i) + 270 format (i5,3f20.6) + end do + write (iout,280) + 280 format (' Static Dipole by Atom Type:', & /,' Type',11x,'X-UStatic',11x,'Y-UStatic',11x,'Z-UStatic') do i = 1, nunique - write (iout,240) utype(i),utv1(1,i),utv1(2,i),utv1(3,i) - 240 format (i5,3f20.6) + write (iout,290) utype(i),utv1(1,i),utv1(2,i),utv1(3,i) + 290 format (i5,3f20.6) end do if (use_polar) then - write (iout,250) - 250 format (' Induced Dipole by Atom Type:', + write (iout,300) + 300 format (' Induced Dipole by Atom Type:', & /,' Type',11x,'X-UInduce',11x,'Y-UInduce',11x,'Z-UInduce') do i = 1, nunique - write (iout,260) utype(i),utv2(1,i),utv2(2,i),utv2(3,i) - 260 format (i5,3f20.6) + write (iout,310) utype(i),utv2(1,i),utv2(2,i),utv2(3,i) + 310 format (i5,3f20.6) end do end if end if @@ -184,19 +199,19 @@ subroutine mdsave (istep,dt,epot,eksum) c if (vsyssave) then call velunique - write (iout,270) - 270 format (' Velocity by Atom Type:', + write (iout,320) + 320 format (' Velocity by Atom Type:', & /,' Type',10x,'X-Velocity',10x,'Y-Velocity',10x,'Z-Velocity') do i = 1, nunique - write (iout,280) utype(i),utv1(1,i),utv1(2,i),utv1(3,i) - 280 format (i5,3f20.6) + write (iout,330) utype(i),utv1(1,i),utv1(2,i),utv1(3,i) + 330 format (i5,3f20.6) end do end if c c save coordinates to archive or numbered structure file c - write (iout,290) isave - 290 format (' Frame Number',13x,i10) + write (iout,340) isave + 340 format (' Frame Number',13x,i10) if (coordsave) then ixyz = freeunit () if (cyclesave) then @@ -230,8 +245,8 @@ subroutine mdsave (istep,dt,epot,eksum) call prtxyz (ixyz) end if close (unit=ixyz) - write (iout,300) xyzfile(1:trimtext(xyzfile)) - 300 format (' Coordinate File',13x,a) + write (iout,350) xyzfile(1:trimtext(xyzfile)) + 350 format (' Coordinate File',13x,a) end if c c update the information needed to restart the trajectory @@ -270,13 +285,13 @@ subroutine mdsave (istep,dt,epot,eksum) end if end if if (integrate .eq. 'RIGIDBODY') then - write (ivel,310) ngrp,title(1:ltitle) - 310 format (i6,2x,a) + write (ivel,360) ngrp,title(1:ltitle) + 360 format (i6,2x,a) do i = 1, ngrp - write (ivel,320) i,(vcm(j,i),j=1,3) - 320 format (i6,3x,d13.6,3x,d13.6,3x,d13.6) - write (ivel,330) i,(wcm(j,i),j=1,3) - 330 format (i6,3x,d13.6,3x,d13.6,3x,d13.6) + write (ivel,370) i,(vcm(j,i),j=1,3) + 370 format (i6,3x,d13.6,3x,d13.6,3x,d13.6) + write (ivel,380) i,(wcm(j,i),j=1,3) + 380 format (i6,3x,d13.6,3x,d13.6,3x,d13.6) end do else if (dcdsave) then call prtdcdv (ivel,first) @@ -284,8 +299,8 @@ subroutine mdsave (istep,dt,epot,eksum) call prtvel (ivel) end if close (unit=ivel) - write (iout,340) velfile(1:trimtext(velfile)) - 340 format (' Velocity File',15x,a) + write (iout,390) velfile(1:trimtext(velfile)) + 390 format (' Velocity File',15x,a) end if c c save the force vector components for the current step, @@ -324,8 +339,8 @@ subroutine mdsave (istep,dt,epot,eksum) call prtfrc (ifrc) end if close (unit=ifrc) - write (iout,350) frcfile(1:trimtext(frcfile)) - 350 format (' Force Vector File',11x,a) + write (iout,400) frcfile(1:trimtext(frcfile)) + 400 format (' Force Vector File',11x,a) end if c c save the induced dipole components for the current step @@ -333,13 +348,13 @@ subroutine mdsave (istep,dt,epot,eksum) if (uindsave .and. use_polar) then iind = freeunit () if (cyclesave) then - indfile = filename(1:leng)//'.'//ext(1:lext)//'u' + indfile = filename(1:leng)//'.'//ext(1:lext)//'ui' call version (indfile,'new') open (unit=iind,file=indfile,status='new') call prtuind (iind) else if (dcdsave) then indfile = filename(1:leng) - call suffix (indfile,'dcdu','old') + call suffix (indfile,'dcdui','old') inquire (file=indfile,exist=exist) if (exist) then first = .false. @@ -350,7 +365,7 @@ subroutine mdsave (istep,dt,epot,eksum) open (unit=iind,file=indfile,form='unformatted', & status='new') end if - call prtdcdu (iind,first) + call prtdcdui (iind,first) else indfile = filename(1:leng) call suffix (indfile,'uind','old') @@ -363,8 +378,8 @@ subroutine mdsave (istep,dt,epot,eksum) call prtuind (iind) end if close (unit=iind) - write (iout,360) indfile(1:trimtext(indfile)) - 360 format (' Induced Dipole File',9x,a) + write (iout,410) indfile(1:trimtext(indfile)) + 410 format (' Induced Dipole File',9x,a) end if c c save the static dipole components for the current step @@ -372,13 +387,13 @@ subroutine mdsave (istep,dt,epot,eksum) if (ustcsave) then istc = freeunit () if (cyclesave) then - stcfile = filename(1:leng)//'.'//ext(1:lext)//'d' + stcfile = filename(1:leng)//'.'//ext(1:lext)//'us' call version (stcfile,'new') open (unit=istc,file=stcfile,status='new') call prtustc (istc,xm,ym,zm) else if (dcdsave) then stcfile = filename(1:leng) - call suffix (stcfile,'dcdd','old') + call suffix (stcfile,'dcdus','old') inquire (file=stcfile,exist=exist) if (exist) then first = .false. @@ -389,7 +404,7 @@ subroutine mdsave (istep,dt,epot,eksum) open (unit=istc,file=stcfile,form='unformatted', & status='new') end if - call prtdcdd (istc,first,xm,ym,zm) + call prtdcdus (istc,first,xm,ym,zm) else stcfile = filename(1:leng) call suffix (stcfile,'ustc','old') @@ -402,8 +417,47 @@ subroutine mdsave (istep,dt,epot,eksum) call prtustc (istc,xm,ym,zm) end if close (unit=istc) - write (iout,370) stcfile(1:trimtext(stcfile)) - 370 format (' Static Dipole File',10x,a) + write (iout,420) stcfile(1:trimtext(stcfile)) + 420 format (' Static Dipole File',10x,a) + end if +c +c save the charge dipole components for the current step +c + if (uchgsave) then + istc = freeunit () + if (cyclesave) then + stcfile = filename(1:leng)//'.'//ext(1:lext)//'uc' + call version (stcfile,'new') + open (unit=istc,file=stcfile,status='new') + call prtuchg (istc,xm,ym,zm) + else if (dcdsave) then + stcfile = filename(1:leng) + call suffix (stcfile,'dcduc','old') + inquire (file=stcfile,exist=exist) + if (exist) then + first = .false. + open (unit=istc,file=stcfile,form='unformatted', + & status='old',position='append') + else + first = .true. + open (unit=istc,file=stcfile,form='unformatted', + & status='new') + end if + call prtdcduc (istc,first,xm,ym,zm) + else + stcfile = filename(1:leng) + call suffix (stcfile,'uchg','old') + inquire (file=stcfile,exist=exist) + if (exist) then + call openend (istc,stcfile) + else + open (unit=istc,file=stcfile,status='new') + end if + call prtuchg (istc,xm,ym,zm) + end if + close (unit=istc) + write (iout,430) stcfile(1:trimtext(stcfile)) + 430 format (' Charge Dipole File',10x,a) end if c c test for requested termination of the dynamics calculation @@ -420,8 +474,8 @@ subroutine mdsave (istep,dt,epot,eksum) end if end if if (exist) then - write (iout,380) - 380 format (/,' MDSAVE -- Dynamics Calculation Ending', + write (iout,440) + 440 format (/,' MDSAVE -- Dynamics Calculation Ending', & ' due to User Request') call fatal end if @@ -430,8 +484,8 @@ subroutine mdsave (istep,dt,epot,eksum) c modsave = mod(istep,iprint) if (verbose .and. modsave.ne.0) then - write (iout,390) - 390 format () + write (iout,450) + 450 format () end if return end diff --git a/source/moments.f b/source/moments.f index dd5786faf..75ab6fa0b 100644 --- a/source/moments.f +++ b/source/moments.f @@ -323,7 +323,8 @@ subroutine moments (mode) c called in mdsave, it is assumed bound is called c c - subroutine dmoments (xm,ym,zm,xustc,yustc,zustc,xuind,yuind,zuind) + subroutine dmoments (xm,ym,zm,xustc,yustc,zustc,xuind,yuind,zuind, + & xuchg,yuchg,zuchg) use atoms use moment use mpole @@ -336,8 +337,10 @@ subroutine dmoments (xm,ym,zm,xustc,yustc,zustc,xuind,yuind,zuind) integer ut real*8 xm,ym,zm real*8 xu,yu,zu + real*8 xc,yc,zc real*8 xustc,yustc,zustc real*8 xuind,yuind,zuind + real*8 xuchg,yuchg,zuchg c c c zero out dipole moments @@ -348,10 +351,14 @@ subroutine dmoments (xm,ym,zm,xustc,yustc,zustc,xuind,yuind,zuind) xuind = 0.0d0 yuind = 0.0d0 zuind = 0.0d0 + xuchg = 0.0d0 + yuchg = 0.0d0 + zuchg = 0.0d0 do i = 1, nunique do j = 1, 3 utv1(j,i) = 0.0d0 utv2(j,i) = 0.0d0 + utv3(j,i) = 0.0d0 end do end do c @@ -359,23 +366,34 @@ subroutine dmoments (xm,ym,zm,xustc,yustc,zustc,xuind,yuind,zuind) c !$OMP PARALLEL default(private) !$OMP& shared(n,x,y,z,rpole,uind,use_polar,momuse,xm,ym,zm, -!$OMP& xustc,yustc,zustc,xuind,yuind,zuind,utv1,utv2,type,utypeinv) -!$OMP DO reduction(+:xustc,yustc,zustc,utv1) schedule(guided) +!$OMP& xustc,yustc,zustc,xuind,yuind,zuind,xuchg,yuchg,zuchg, +!$OMP& utv1,utv2,utv3,type,utypeinv) +!$OMP DO reduction(+:xustc,yustc,zustc,xuchg,yuchg,zuchg,utv1,utv3) +!$OMP& schedule(guided) c c compute the static dipole moment c do i = 1, n if (momuse(i)) then - xu = (x(i)-xm)*rpole(1,i) + rpole(2,i) - yu = (y(i)-ym)*rpole(1,i) + rpole(3,i) - zu = (z(i)-zm)*rpole(1,i) + rpole(4,i) + xu = rpole(2,i) + yu = rpole(3,i) + zu = rpole(4,i) + xc = (x(i)-xm)*rpole(1,i) + yc = (y(i)-ym)*rpole(1,i) + zc = (z(i)-zm)*rpole(1,i) xustc = xustc + xu yustc = yustc + yu zustc = zustc + zu + xuchg = xuchg + xc + yuchg = yuchg + yc + zuchg = zuchg + zc ut = utypeinv(type(i)) utv1(1,ut) = utv1(1,ut) + xu utv1(2,ut) = utv1(2,ut) + yu utv1(3,ut) = utv1(3,ut) + zu + utv3(1,ut) = utv3(1,ut) + xc + utv3(2,ut) = utv3(2,ut) + yc + utv3(3,ut) = utv3(3,ut) + zc end if end do !$OMP END DO @@ -410,10 +428,14 @@ subroutine dmoments (xm,ym,zm,xustc,yustc,zustc,xuind,yuind,zuind) xuind = xuind * debye yuind = yuind * debye zuind = zuind * debye + xuchg = xuchg * debye + yuchg = yuchg * debye + zuchg = zuchg * debye do i = 1, nunique do j = 1, 3 utv1(j,i) = utv1(j,i) * debye utv2(j,i) = utv2(j,i) * debye + utv3(j,i) = utv3(j,i) * debye end do end do return diff --git a/source/optinit.f b/source/optinit.f index a1c93069c..d83c8f23b 100644 --- a/source/optinit.f +++ b/source/optinit.f @@ -49,7 +49,7 @@ subroutine optinit read (string,*,err=10,end=10) iwrite else if (keyword(1:11) .eq. 'SAVE-FORCE ') then frcsave = .true. - else if (keyword(1:13) .eq. 'SAVE-INDUCED ') then + else if (keyword(1:13) .eq. 'SAVE-UINDUCE ') then uindsave = .true. end if 10 continue diff --git a/source/output.f b/source/output.f index b11b55874..702f89ac4 100644 --- a/source/output.f +++ b/source/output.f @@ -29,6 +29,7 @@ c frcsave logical flag to save force vector components c uindsave logical flag to save induced atomic dipoles c ustcsave logical flag to save static atomic dipoles +c uchgsave logical flag to save charge atomic dipoles c usyssave logical flag to save unique atom type dipole moment c vsyssave logical flag to save unique atom type velocity c coordtype selects Cartesian, internal, rigid body or none @@ -53,6 +54,7 @@ module output logical frcsave logical uindsave logical ustcsave + logical uchgsave logical usyssave logical vsyssave character*9 coordtype diff --git a/source/prtuind.f b/source/prtuind.f index 3961c923f..30446f980 100644 --- a/source/prtuind.f +++ b/source/prtuind.f @@ -140,14 +140,14 @@ subroutine prtuind (iind) end c c -c ############################################################# -c ## ## -c ## subroutine prtdcdu -- output of DCD induced dipoles ## -c ## ## -c ############################################################# +c ############################################################## +c ## ## +c ## subroutine prtdcdui -- output of DCD induced dipoles ## +c ## ## +c ############################################################## c c -c "prtdcdu" writes out a set of induced dipole components to +c "prtdcdui" writes out a set of induced dipole components to c a file in CHARMM DCD binary format compatible with the VMD c visualization software and other packages c @@ -175,7 +175,7 @@ subroutine prtuind (iind) c the particular feature is unused c c - subroutine prtdcdu (idcd,first) + subroutine prtdcdui (idcd,first) use atoms use bound use boxes @@ -204,7 +204,7 @@ subroutine prtdcdu (idcd,first) c inquire (unit=idcd,opened=opened) if (.not. opened) then - dcdfile = filename(1:leng)//'.dcdu' + dcdfile = filename(1:leng)//'.dcdui' call version (dcdfile,'new') open (unit=idcd,file=dcdfile,form='unformatted',status='new') end if @@ -376,9 +376,9 @@ subroutine prtustc (istc,xm,ym,zm) if (.not. onlysave) then do i = 1, n c = rpole(1,i) - xd = ((x(i)-xm)*c + rpole(2,i)) * debye - yd = ((y(i)-ym)*c + rpole(3,i)) * debye - zd = ((z(i)-zm)*c + rpole(4,i)) * debye + xd = rpole(2,i) * debye + yd = rpole(3,i) * debye + zd = rpole(4,i) * debye k = n12(i) if (k .eq. 0) then write (istc,fstr) i,name(i),xd,yd,zd,type(i) @@ -391,9 +391,9 @@ subroutine prtustc (istc,xm,ym,zm) do ii = 1, nonly i = ionly(ii) c = rpole(1,i) - xd = ((x(i)-xm)*c + rpole(2,i)) * debye - yd = ((y(i)-ym)*c + rpole(3,i)) * debye - zd = ((z(i)-zm)*c + rpole(4,i)) * debye + xd = rpole(2,i) * debye + yd = rpole(3,i) * debye + zd = rpole(4,i) * debye k = n12(i) if (k .eq. 0) then write (istc,fstr) ii,name(i),xd,yd,zd,type(i) @@ -411,14 +411,14 @@ subroutine prtustc (istc,xm,ym,zm) end c c -c ############################################################ -c ## ## -c ## subroutine prtdcdd -- output of DCD static dipoles ## -c ## ## -c ############################################################ +c ############################################################# +c ## ## +c ## subroutine prtdcdus -- output of DCD static dipoles ## +c ## ## +c ############################################################# c c -c "prtdcdd" writes out a set of static dipole components to +c "prtdcdus" writes out a set of static dipole components to c a file in CHARMM DCD binary format compatible with the VMD c visualization software and other packages c @@ -446,7 +446,7 @@ subroutine prtustc (istc,xm,ym,zm) c the particular feature is unused c c - subroutine prtdcdd (idcd,first,xm,ym,zm) + subroutine prtdcdus (idcd,first,xm,ym,zm) use atoms use bound use boxes @@ -476,7 +476,7 @@ subroutine prtdcdd (idcd,first,xm,ym,zm) c inquire (unit=idcd,opened=opened) if (.not. opened) then - dcdfile = filename(1:leng)//'.dcdd' + dcdfile = filename(1:leng)//'.dcdus' call version (dcdfile,'new') open (unit=idcd,file=dcdfile,form='unformatted',status='new') end if @@ -524,19 +524,288 @@ subroutine prtdcdd (idcd,first,xm,ym,zm) c append the static dipoles along each axis in turn c if (.not. onlysave) then - write (idcd) (real(debye*((x(i)-xm)*rpole(1,i) - & + rpole(2,i))),i=1,n) - write (idcd) (real(debye*((y(i)-ym)*rpole(1,i) - & + rpole(3,i))),i=1,n) - write (idcd) (real(debye*((z(i)-zm)*rpole(1,i) - & + rpole(4,i))),i=1,n) + write (idcd) (real(debye * rpole(2,i)),i=1,n) + write (idcd) (real(debye * rpole(3,i)),i=1,n) + write (idcd) (real(debye * rpole(4,i)),i=1,n) + else + write (idcd) (real(debye * rpole(2,ionly(i))),i=1,nonly) + write (idcd) (real(debye * rpole(3,ionly(i))),i=1,nonly) + write (idcd) (real(debye * rpole(4,ionly(i))),i=1,nonly) + end if +c +c close the output unit if opened by this routine +c + if (.not. opened) close (unit=idcd) + return + end +c +c +c ############################################################### +c ## ## +c ## subroutine prtuchg -- output of atomic charge dipoles ## +c ## ## +c ############################################################### +c +c +c "prtuchg" writes out a set of charge dipole components +c to an external disk file in Tinker XYZ format +c +c + subroutine prtuchg (istc,xm,ym,zm) + use atomid + use atoms + use bound + use boxes + use couple + use files + use inform + use mpole + use output + use titles + use units + implicit none + integer i,j,k,istc + integer ii + integer size,crdsiz + real*8 crdmin,crdmax + real*8 c,xd,yd,zd + real*8 xm,ym,zm + logical opened + character*2 atmc + character*2 crdc + character*2 digc + character*25 fstr + character*240 stcfile +c +c +c open the output unit if not already done +c + inquire (unit=istc,opened=opened) + if (.not. opened) then + stcfile = filename(1:leng)//'.uchg' + call version (stcfile,'new') + open (unit=istc,file=stcfile,status='new') + end if +c +c check for large systems needing extended formatting +c + atmc = 'i6' + if (n .ge. 100000) atmc = 'i7' + if (n .ge. 1000000) atmc = 'i8' + crdmin = 0.0d0 + crdmax = 0.0d0 + do i = 1, n + crdmin = min(crdmin,x(i),y(i),z(i)) + crdmax = max(crdmax,x(i),y(i),z(i)) + end do + crdsiz = 6 + if (crdmin .le. -1000.0d0) crdsiz = 7 + if (crdmax .ge. 10000.0d0) crdsiz = 7 + if (crdmin .le. -10000.0d0) crdsiz = 8 + if (crdmax .ge. 100000.0d0) crdsiz = 8 + crdsiz = crdsiz + max(6,digits) + size = 0 + call numeral (crdsiz,crdc,size) + if (digits .le. 6) then + digc = '6 ' + else if (digits .le. 8) then + digc = '8' + else + digc = '10' + end if +c +c write out the number of atoms and the title +c + if (.not. onlysave) then + if (ltitle .eq. 0) then + fstr = '('//atmc//')' + write (istc,fstr(1:4)) n + else + fstr = '('//atmc//',2x,a)' + write (istc,fstr(1:9)) n,title(1:ltitle) + end if + else + if (ltitle .eq. 0) then + fstr = '('//atmc//')' + write (istc,fstr(1:4)) nonly + else + fstr = '('//atmc//',2x,a)' + write (istc,fstr(1:9)) nonly,title(1:ltitle) + end if + end if +c +c write out the periodic cell lengths and angles +c + if (use_bounds) then + fstr = '(1x,6f'//crdc//'.'//digc//')' + write (istc,fstr) xbox,ybox,zbox,alpha,beta,gamma + end if +c +c write out the charge dipole components for each atom +c + fstr = '('//atmc//',2x,a3,3f'//crdc// + & '.'//digc//',i6,8'//atmc//')' + if (.not. onlysave) then + do i = 1, n + c = rpole(1,i) + xd = (x(i)-xm) * c * debye + yd = (y(i)-ym) * c * debye + zd = (z(i)-zm) * c * debye + k = n12(i) + if (k .eq. 0) then + write (istc,fstr) i,name(i),xd,yd,zd,type(i) + else + write (istc,fstr) i,name(i),xd,yd,zd,type(i), + & (i12(j,i),j=1,k) + end if + end do + else + do ii = 1, nonly + i = ionly(ii) + c = rpole(1,i) + xd = (x(i)-xm) * c * debye + yd = (y(i)-ym) * c * debye + zd = (z(i)-zm) * c * debye + k = n12(i) + if (k .eq. 0) then + write (istc,fstr) ii,name(i),xd,yd,zd,type(i) + else + write (istc,fstr) ii,name(i),xd,yd,zd,type(i), + & (ionlyinv(i12(j,i)),j=1,k) + end if + end do + end if +c +c close the output unit if opened by this routine +c + if (.not. opened) close (unit=istc) + return + end +c +c +c ############################################################# +c ## ## +c ## subroutine prtdcduc -- output of DCD charge dipoles ## +c ## ## +c ############################################################# +c +c +c "prtdcduc" writes out a set of charge dipole components to +c a file in CHARMM DCD binary format compatible with the VMD +c visualization software and other packages +c +c note the format used is based on the "dcdplugin.c" code from +c the NAMD and VMD programs, and tutorial 4.1 from the software +c package GENESIS: Generalized-Ensemble Simulation System +c +c variables and parameters: +c +c header type of data (CORD=coordinates, VELD=velocities) +c nframe number of frames stored in the DCD file +c nprev number of previous integration steps +c ncrdsav frequency in steps for saving coordinate frames +c nstep number of integration steps in the total run +c nvelsav frequency of coordinate saves with velocity data +c ndfree number of degrees of freedom for the system +c nfixat number of fixed atoms for the system +c usebox flag for periodic boundaries (1=true, 0=false) +c use4d flag for 4D trajectory (1=true, 0=false) +c usefq flag for fluctuating charges (1=true, 0=false) +c merged result of merge without checks (1=true, 0=false) +c vcharmm version of CHARMM software for compatibility +c +c in general a value of zero for any of the above indicates that +c the particular feature is unused +c +c + subroutine prtdcduc (idcd,first,xm,ym,zm) + use atoms + use bound + use boxes + use files + use mpole + use output + use titles + use units + implicit none + integer i,idcd + integer zero,one + integer nframe,nprev + integer ncrdsav,nstep + integer nvelsav,ndfree + integer nfixat,usebox + integer use4d,usefq + integer merged,vcharmm + integer ntitle + real*4 tdelta + real*8 xm,ym,zm + logical opened,first + character*4 header + character*240 dcdfile +c +c +c open the output unit if not already done +c + inquire (unit=idcd,opened=opened) + if (.not. opened) then + dcdfile = filename(1:leng)//'.dcduc' + call version (dcdfile,'new') + open (unit=idcd,file=dcdfile,form='unformatted',status='new') + end if +c +c write header info along with title and number of atoms +c + if (first) then + first = .false. + zero = 0 + one = 1 + header = 'CORD' + nframe = zero + nprev = zero + ncrdsav = one + nstep = zero + nvelsav = zero + ndfree = zero + nfixat = zero + tdelta = 0.0 + usebox = zero + if (use_bounds) usebox = one + use4d = zero + usefq = zero + merged = zero + vcharmm = 24 + ntitle = one + write (idcd) header,nframe,nprev,ncrdsav,nstep, + & nvelsav,zero,zero,ndfree,nfixat, + & tdelta,usebox,use4d,usefq,merged, + & zero,zero,zero,zero,zero,vcharmm + write (idcd) ntitle,title(1:80) + if (.not. onlysave) then + write (idcd) n + else + write (idcd) nonly + end if + end if +c +c append the lattice values based on header flag value +c + if (use_bounds) then + write (idcd) xbox,gamma_cos,ybox,beta_cos,alpha_cos,zbox + end if +c +c append the charge dipoles along each axis in turn +c + if (.not. onlysave) then + write (idcd) (real(debye*(x(i)-xm)*rpole(1,i)),i=1,n) + write (idcd) (real(debye*(y(i)-ym)*rpole(1,i)),i=1,n) + write (idcd) (real(debye*(z(i)-zm)*rpole(1,i)),i=1,n) else - write (idcd) (real(debye*((x(ionly(i))-xm)*rpole(1,ionly(i)) - & + rpole(2,ionly(i)))),i=1,nonly) - write (idcd) (real(debye*((y(ionly(i))-ym)*rpole(1,ionly(i)) - & + rpole(3,ionly(i)))),i=1,nonly) - write (idcd) (real(debye*((z(ionly(i))-zm)*rpole(1,ionly(i)) - & + rpole(4,ionly(i)))),i=1,nonly) + write (idcd) (real(debye*(x(ionly(i))-xm)*rpole(1,ionly(i))) + & ,i=1,nonly) + write (idcd) (real(debye*(y(ionly(i))-ym)*rpole(1,ionly(i))) + & ,i=1,nonly) + write (idcd) (real(debye*(z(ionly(i))-zm)*rpole(1,ionly(i))) + & ,i=1,nonly) end if c c close the output unit if opened by this routine diff --git a/source/uatom.f b/source/uatom.f index 1134c5e82..ea7c74eb2 100644 --- a/source/uatom.f +++ b/source/uatom.f @@ -17,6 +17,7 @@ c utypeinv map from atom type to unique type c utv1 unique type vector 1 c utv2 unique type vector 2 +c utv3 unique type vector 3 c c module uatom @@ -27,5 +28,6 @@ module uatom integer utypeinv(maxtyp) real*8 utv1(3,maxtyp) real*8 utv2(3,maxtyp) + real*8 utv3(3,maxtyp) save end From 7135a7bbd55900a422f399c111bc5ad024f2fc04 Mon Sep 17 00:00:00 2001 From: Moses Date: Thu, 11 Sep 2025 18:19:09 -0500 Subject: [PATCH 18/29] update interface --- interface/c/tinker/detail/output.hh | 1 + interface/c/tinker/detail/uatom.hh | 1 + interface/c/tinker/routines.h | 14 +++++++++----- interface/cpp/tinker/detail/output.hh | 3 +++ interface/cpp/tinker/detail/uatom.hh | 3 +++ interface/cpp/tinker/routines.h | 14 +++++++++----- 6 files changed, 26 insertions(+), 10 deletions(-) diff --git a/interface/c/tinker/detail/output.hh b/interface/c/tinker/detail/output.hh index d8a3e7d7a..3975f26da 100644 --- a/interface/c/tinker/detail/output.hh +++ b/interface/c/tinker/detail/output.hh @@ -22,6 +22,7 @@ extern int TINKER_MOD(output, velsave); extern int TINKER_MOD(output, frcsave); extern int TINKER_MOD(output, uindsave); extern int TINKER_MOD(output, ustcsave); +extern int TINKER_MOD(output, uchgsave); extern int TINKER_MOD(output, usyssave); extern int TINKER_MOD(output, vsyssave); extern char TINKER_MOD(output, coordtype)[9]; diff --git a/interface/c/tinker/detail/uatom.hh b/interface/c/tinker/detail/uatom.hh index 9febaa05f..40d76e44e 100644 --- a/interface/c/tinker/detail/uatom.hh +++ b/interface/c/tinker/detail/uatom.hh @@ -11,6 +11,7 @@ extern int TINKER_MOD(uatom, utype)[TINKER_MOD__maxtyp]; extern int TINKER_MOD(uatom, utypeinv)[TINKER_MOD__maxtyp]; extern double TINKER_MOD(uatom, utv1)[TINKER_MOD__maxtyp][3]; extern double TINKER_MOD(uatom, utv2)[TINKER_MOD__maxtyp][3]; +extern double TINKER_MOD(uatom, utv3)[TINKER_MOD__maxtyp][3]; #ifdef __cplusplus } #endif diff --git a/interface/c/tinker/routines.h b/interface/c/tinker/routines.h index 1c1e3d541..2dd45b649 100644 --- a/interface/c/tinker/routines.h +++ b/interface/c/tinker/routines.h @@ -1938,7 +1938,7 @@ void moments_(char* mode, tinker_fchar_len_t mode_cap); inline void tinker_f_moments(tinker_fchars mode) { return moments_(mode.string, mode.capacity); } -void dmoments_(double* xm, double* ym, double* zm, double* xustc, double* yustc, double* zustc, double* xuind, double* yuind, double* zuind); +void dmoments_(double* xm, double* ym, double* zm, double* xustc, double* yustc, double* zustc, double* xuind, double* yuind, double* zuind, double* xuchg, double* yuchg, double* zuchg); #define tinker_f_dmoments dmoments_ // mutate.f @@ -2244,12 +2244,16 @@ void prtseq_(int* iseq); // prtuind.f void prtuind_(int* iind); #define tinker_f_prtuind prtuind_ -void prtdcdu_(int* idcd, int* first); -#define tinker_f_prtdcdu prtdcdu_ +void prtdcdui_(int* idcd, int* first); +#define tinker_f_prtdcdui prtdcdui_ void prtustc_(int* istc, double* xm, double* ym, double* zm); #define tinker_f_prtustc prtustc_ -void prtdcdd_(int* idcd, int* first, double* xm, double* ym, double* zm); -#define tinker_f_prtdcdd prtdcdd_ +void prtdcdus_(int* idcd, int* first, double* xm, double* ym, double* zm); +#define tinker_f_prtdcdus prtdcdus_ +void prtuchg_(int* istc, double* xm, double* ym, double* zm); +#define tinker_f_prtuchg prtuchg_ +void prtdcduc_(int* idcd, int* first, double* xm, double* ym, double* zm); +#define tinker_f_prtdcduc prtdcduc_ // prtvel.f void prtvel_(int* ivel); diff --git a/interface/cpp/tinker/detail/output.hh b/interface/cpp/tinker/detail/output.hh index eba6666ec..b93e54b2c 100644 --- a/interface/cpp/tinker/detail/output.hh +++ b/interface/cpp/tinker/detail/output.hh @@ -20,6 +20,7 @@ extern int& velsave; extern int& frcsave; extern int& uindsave; extern int& ustcsave; +extern int& uchgsave; extern int& usyssave; extern int& vsyssave; extern char (&coordtype)[9]; @@ -42,6 +43,7 @@ extern "C" int TINKER_MOD(output, velsave); extern "C" int TINKER_MOD(output, frcsave); extern "C" int TINKER_MOD(output, uindsave); extern "C" int TINKER_MOD(output, ustcsave); +extern "C" int TINKER_MOD(output, uchgsave); extern "C" int TINKER_MOD(output, usyssave); extern "C" int TINKER_MOD(output, vsyssave); extern "C" char TINKER_MOD(output, coordtype)[9]; @@ -63,6 +65,7 @@ int& velsave = TINKER_MOD(output, velsave); int& frcsave = TINKER_MOD(output, frcsave); int& uindsave = TINKER_MOD(output, uindsave); int& ustcsave = TINKER_MOD(output, ustcsave); +int& uchgsave = TINKER_MOD(output, uchgsave); int& usyssave = TINKER_MOD(output, usyssave); int& vsyssave = TINKER_MOD(output, vsyssave); char (&coordtype)[9] = TINKER_MOD(output, coordtype); diff --git a/interface/cpp/tinker/detail/uatom.hh b/interface/cpp/tinker/detail/uatom.hh index 04260c90c..f6d853c43 100644 --- a/interface/cpp/tinker/detail/uatom.hh +++ b/interface/cpp/tinker/detail/uatom.hh @@ -11,6 +11,7 @@ extern int (&utype)[maxtyp]; extern int (&utypeinv)[maxtyp]; extern double (&utv1)[maxtyp][3]; extern double (&utv2)[maxtyp][3]; +extern double (&utv3)[maxtyp][3]; #ifdef TINKER_FORTRAN_MODULE_CPP extern "C" int TINKER_MOD(uatom, nunique); @@ -18,11 +19,13 @@ extern "C" int TINKER_MOD(uatom, utype)[maxtyp]; extern "C" int TINKER_MOD(uatom, utypeinv)[maxtyp]; extern "C" double TINKER_MOD(uatom, utv1)[maxtyp][3]; extern "C" double TINKER_MOD(uatom, utv2)[maxtyp][3]; +extern "C" double TINKER_MOD(uatom, utv3)[maxtyp][3]; int& nunique = TINKER_MOD(uatom, nunique); int (&utype)[maxtyp] = TINKER_MOD(uatom, utype); int (&utypeinv)[maxtyp] = TINKER_MOD(uatom, utypeinv); double (&utv1)[maxtyp][3] = TINKER_MOD(uatom, utv1); double (&utv2)[maxtyp][3] = TINKER_MOD(uatom, utv2); +double (&utv3)[maxtyp][3] = TINKER_MOD(uatom, utv3); #endif } } diff --git a/interface/cpp/tinker/routines.h b/interface/cpp/tinker/routines.h index 1c1e3d541..2dd45b649 100644 --- a/interface/cpp/tinker/routines.h +++ b/interface/cpp/tinker/routines.h @@ -1938,7 +1938,7 @@ void moments_(char* mode, tinker_fchar_len_t mode_cap); inline void tinker_f_moments(tinker_fchars mode) { return moments_(mode.string, mode.capacity); } -void dmoments_(double* xm, double* ym, double* zm, double* xustc, double* yustc, double* zustc, double* xuind, double* yuind, double* zuind); +void dmoments_(double* xm, double* ym, double* zm, double* xustc, double* yustc, double* zustc, double* xuind, double* yuind, double* zuind, double* xuchg, double* yuchg, double* zuchg); #define tinker_f_dmoments dmoments_ // mutate.f @@ -2244,12 +2244,16 @@ void prtseq_(int* iseq); // prtuind.f void prtuind_(int* iind); #define tinker_f_prtuind prtuind_ -void prtdcdu_(int* idcd, int* first); -#define tinker_f_prtdcdu prtdcdu_ +void prtdcdui_(int* idcd, int* first); +#define tinker_f_prtdcdui prtdcdui_ void prtustc_(int* istc, double* xm, double* ym, double* zm); #define tinker_f_prtustc prtustc_ -void prtdcdd_(int* idcd, int* first, double* xm, double* ym, double* zm); -#define tinker_f_prtdcdd prtdcdd_ +void prtdcdus_(int* idcd, int* first, double* xm, double* ym, double* zm); +#define tinker_f_prtdcdus prtdcdus_ +void prtuchg_(int* istc, double* xm, double* ym, double* zm); +#define tinker_f_prtuchg prtuchg_ +void prtdcduc_(int* idcd, int* first, double* xm, double* ym, double* zm); +#define tinker_f_prtdcduc prtdcduc_ // prtvel.f void prtvel_(int* ivel); From a995e622b94a141fbd4776ca1d619432244b2475 Mon Sep 17 00:00:00 2001 From: Moses Date: Sun, 14 Sep 2025 16:31:31 -0500 Subject: [PATCH 19/29] enforce MonteCarlo barostat for NPT + external field simulations --- source/dynamic.f | 51 +++++++++++++++++++++++++++++------------------- 1 file changed, 31 insertions(+), 20 deletions(-) diff --git a/source/dynamic.f b/source/dynamic.f index 1e1939119..2b184113e 100644 --- a/source/dynamic.f +++ b/source/dynamic.f @@ -230,47 +230,58 @@ program dynamic c call mdinit (dt) c +c only allow Montecarlo barostat for NPT + extfield simulation +c + if (use_exfld .and. mode.eq.4) then + if (barostat.ne.'MONTECARLO') then + write (iout,340) + 340 format (/,' DYNAMIC -- NPT with External Field Should', + & ' Use MonteCarlo Barostat') + call fatal + end if + end if +c c print out a header line for the dynamics computation c if (integrate .eq. 'VERLET') then - write (iout,340) - 340 format (/,' Molecular Dynamics Trajectory via', - & ' Velocity Verlet Algorithm') - else if (integrate .eq. 'BEEMAN') then write (iout,350) 350 format (/,' Molecular Dynamics Trajectory via', + & ' Velocity Verlet Algorithm') + else if (integrate .eq. 'BEEMAN') then + write (iout,360) + 360 format (/,' Molecular Dynamics Trajectory via', & ' Modified Beeman Algorithm') else if (integrate .eq. 'BAOAB') then - write (iout,360) - 360 format (/,' Constrained Stochastic Dynamics Trajectory', + write (iout,370) + 370 format (/,' Constrained Stochastic Dynamics Trajectory', & ' via BAOAB Algorithm') else if (integrate .eq. 'BUSSI') then - write (iout,370) - 370 format (/,' Molecular Dynamics Trajectory via', - & ' Bussi-Parrinello NPT Algorithm') - else if (integrate .eq. 'NOSE-HOOVER') then write (iout,380) 380 format (/,' Molecular Dynamics Trajectory via', + & ' Bussi-Parrinello NPT Algorithm') + else if (integrate .eq. 'NOSE-HOOVER') then + write (iout,390) + 390 format (/,' Molecular Dynamics Trajectory via', & ' Nose-Hoover NPT Algorithm') else if (integrate .eq. 'STOCHASTIC') then - write (iout,390) - 390 format (/,' Stochastic Dynamics Trajectory via', - & ' Velocity Verlet Algorithm') - else if (integrate .eq. 'GHMC') then write (iout,400) 400 format (/,' Stochastic Dynamics Trajectory via', + & ' Velocity Verlet Algorithm') + else if (integrate .eq. 'GHMC') then + write (iout,410) + 410 format (/,' Stochastic Dynamics Trajectory via', & ' Generalized Hybrid Monte Carlo') else if (integrate .eq. 'RIGIDBODY') then - write (iout,410) - 410 format (/,' Molecular Dynamics Trajectory via', - & ' Rigid Body Algorithm') - else if (integrate .eq. 'RESPA') then write (iout,420) 420 format (/,' Molecular Dynamics Trajectory via', - & ' r-RESPA MTS Algorithm') - else + & ' Rigid Body Algorithm') + else if (integrate .eq. 'RESPA') then write (iout,430) 430 format (/,' Molecular Dynamics Trajectory via', + & ' r-RESPA MTS Algorithm') + else + write (iout,440) + 440 format (/,' Molecular Dynamics Trajectory via', & ' Modified Beeman Algorithm') end if flush (iout) From 9524fa7a29d06a6a39018475b273aac3842d37c2 Mon Sep 17 00:00:00 2001 From: Moses Date: Mon, 15 Sep 2025 17:25:58 -0500 Subject: [PATCH 20/29] allow NPT + external field simulation if barostat is anisotropic --- source/dynamic.f | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/source/dynamic.f b/source/dynamic.f index 2b184113e..c0704a725 100644 --- a/source/dynamic.f +++ b/source/dynamic.f @@ -233,10 +233,10 @@ program dynamic c only allow Montecarlo barostat for NPT + extfield simulation c if (use_exfld .and. mode.eq.4) then - if (barostat.ne.'MONTECARLO') then + if (barostat.ne.'MONTECARLO' .and. .not.anisotropic) then write (iout,340) 340 format (/,' DYNAMIC -- NPT with External Field Should', - & ' Use MonteCarlo Barostat') + & ' Use MonteCarlo or Anisotropic Barostat') call fatal end if end if From 1ee74298a7e111e0bb60a0247fc728ee1b1850f8 Mon Sep 17 00:00:00 2001 From: Moses Date: Mon, 15 Sep 2025 19:31:25 -0500 Subject: [PATCH 21/29] typo in dynamic.f --- source/dynamic.f | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/source/dynamic.f b/source/dynamic.f index c0704a725..9e60c2fc7 100644 --- a/source/dynamic.f +++ b/source/dynamic.f @@ -230,10 +230,11 @@ program dynamic c call mdinit (dt) c -c only allow Montecarlo barostat for NPT + extfield simulation +c only allow Montecarlo or anisotropic barostat +c for NPT + extfield simulation c if (use_exfld .and. mode.eq.4) then - if (barostat.ne.'MONTECARLO' .and. .not.anisotropic) then + if (barostat.ne.'MONTECARLO' .and. .not.anisotrop) then write (iout,340) 340 format (/,' DYNAMIC -- NPT with External Field Should', & ' Use MonteCarlo or Anisotropic Barostat') From 9132e1d23c2f82739d7d7a28d72d2d52302c4066 Mon Sep 17 00:00:00 2001 From: Moses Date: Thu, 25 Sep 2025 21:52:29 -0500 Subject: [PATCH 22/29] print external field --- source/mdsave.f | 137 ++++++++++++++++++++++++++++-------------------- 1 file changed, 79 insertions(+), 58 deletions(-) diff --git a/source/mdsave.f b/source/mdsave.f index cd0692ce4..69823fa45 100644 --- a/source/mdsave.f +++ b/source/mdsave.f @@ -23,6 +23,7 @@ subroutine mdsave (istep,dt,epot,eksum) use bound use boxes use couple + use extfld use files use group use inform @@ -37,6 +38,7 @@ subroutine mdsave (istep,dt,epot,eksum) use socket use titles use uatom + use units implicit none integer i,j,ii integer istep @@ -50,6 +52,7 @@ subroutine mdsave (istep,dt,epot,eksum) real*8 xustc,yustc,zustc real*8 xuind,yuind,zuind real*8 xuchg,yuchg,zuchg + real*8 xf,yf,zf real*8 xm,ym,zm logical exist,first character*7 ext @@ -129,6 +132,24 @@ subroutine mdsave (istep,dt,epot,eksum) end if end if c +c print the external electric field values +c + if (use_exfld) then + xf = texfld(1) * elefield + yf = texfld(2) * elefield + zf = texfld(3) * elefield + if (digits .le. 6) then + write (iout,170) xf,yf,zf + 170 format (' External Field',7x,3f14.6) + else if (digits .le. 8) then + write (iout,180) xf,yf,zf + 180 format (' External Field',7x,3f16.8) + else + write (iout,190) xf,yf,zf + 190 format (' External Field',7x,3f18.10) + end if + end if +c c move stray molecules into periodic box if desired c if (use_bounds) call bounds @@ -143,54 +164,54 @@ subroutine mdsave (istep,dt,epot,eksum) call dmoments (xm,ym,zm,xustc,yustc,zustc,xuind,yuind,zuind, & xuchg,yuchg,zuchg) if (digits .le. 6) then - write (iout,170) xuchg,yuchg,zuchg - 170 format (' System Charge Dipole',1x,3f20.6) - write (iout,180) xustc,yustc,zustc - 180 format (' System Static Dipole',1x,3f20.6) + write (iout,200) xuchg,yuchg,zuchg + 200 format (' System Charge Dipole',1x,3f20.6) + write (iout,210) xustc,yustc,zustc + 210 format (' System Static Dipole',1x,3f20.6) else if (digits .le. 8) then - write (iout,190) xuchg,yuchg,zuchg - 190 format (' System Charge Dipole',1x,3f22.8) - write (iout,200) xustc,yustc,zustc - 200 format (' System Static Dipole',1x,3f22.8) + write (iout,220) xuchg,yuchg,zuchg + 220 format (' System Charge Dipole',1x,3f22.8) + write (iout,230) xustc,yustc,zustc + 230 format (' System Static Dipole',1x,3f22.8) else - write (iout,210) xuchg,yuchg,zuchg - 210 format (' System Charge Dipole',1x,3f24.10) - write (iout,220) xustc,yustc,zustc - 220 format (' System Static Dipole',1x,3f24.10) + write (iout,240) xuchg,yuchg,zuchg + 240 format (' System Charge Dipole',1x,3f24.10) + write (iout,250) xustc,yustc,zustc + 250 format (' System Static Dipole',1x,3f24.10) end if if (use_polar) then if (digits .le. 6) then - write (iout,230) xuind,yuind,zuind - 230 format (' System Induced Dipole',3f20.6) + write (iout,260) xuind,yuind,zuind + 260 format (' System Induced Dipole',3f20.6) else if (digits .le. 8) then - write (iout,240) xuind,yuind,zuind - 240 format (' System Induced Dipole',3f22.8) + write (iout,270) xuind,yuind,zuind + 270 format (' System Induced Dipole',3f22.8) else - write (iout,250) xuind,yuind,zuind - 250 format (' System Induced Dipole',3f24.10) + write (iout,280) xuind,yuind,zuind + 280 format (' System Induced Dipole',3f24.10) end if end if - write (iout,260) - 260 format (' Charge Dipole by Atom Type:', + write (iout,290) + 290 format (' Charge Dipole by Atom Type:', & /,' Type',11x,'X-UCharge',11x,'Y-UCharge',11x,'Z-UCharge') do i = 1, nunique - write (iout,270) utype(i),utv3(1,i),utv3(2,i),utv3(3,i) - 270 format (i5,3f20.6) + write (iout,300) utype(i),utv3(1,i),utv3(2,i),utv3(3,i) + 300 format (i5,3f20.6) end do - write (iout,280) - 280 format (' Static Dipole by Atom Type:', + write (iout,310) + 310 format (' Static Dipole by Atom Type:', & /,' Type',11x,'X-UStatic',11x,'Y-UStatic',11x,'Z-UStatic') do i = 1, nunique - write (iout,290) utype(i),utv1(1,i),utv1(2,i),utv1(3,i) - 290 format (i5,3f20.6) + write (iout,320) utype(i),utv1(1,i),utv1(2,i),utv1(3,i) + 320 format (i5,3f20.6) end do if (use_polar) then - write (iout,300) - 300 format (' Induced Dipole by Atom Type:', + write (iout,330) + 330 format (' Induced Dipole by Atom Type:', & /,' Type',11x,'X-UInduce',11x,'Y-UInduce',11x,'Z-UInduce') do i = 1, nunique - write (iout,310) utype(i),utv2(1,i),utv2(2,i),utv2(3,i) - 310 format (i5,3f20.6) + write (iout,340) utype(i),utv2(1,i),utv2(2,i),utv2(3,i) + 340 format (i5,3f20.6) end do end if end if @@ -199,19 +220,19 @@ subroutine mdsave (istep,dt,epot,eksum) c if (vsyssave) then call velunique - write (iout,320) - 320 format (' Velocity by Atom Type:', + write (iout,350) + 350 format (' Velocity by Atom Type:', & /,' Type',10x,'X-Velocity',10x,'Y-Velocity',10x,'Z-Velocity') do i = 1, nunique - write (iout,330) utype(i),utv1(1,i),utv1(2,i),utv1(3,i) - 330 format (i5,3f20.6) + write (iout,360) utype(i),utv1(1,i),utv1(2,i),utv1(3,i) + 360 format (i5,3f20.6) end do end if c c save coordinates to archive or numbered structure file c - write (iout,340) isave - 340 format (' Frame Number',13x,i10) + write (iout,370) isave + 370 format (' Frame Number',13x,i10) if (coordsave) then ixyz = freeunit () if (cyclesave) then @@ -245,8 +266,8 @@ subroutine mdsave (istep,dt,epot,eksum) call prtxyz (ixyz) end if close (unit=ixyz) - write (iout,350) xyzfile(1:trimtext(xyzfile)) - 350 format (' Coordinate File',13x,a) + write (iout,380) xyzfile(1:trimtext(xyzfile)) + 380 format (' Coordinate File',13x,a) end if c c update the information needed to restart the trajectory @@ -285,13 +306,13 @@ subroutine mdsave (istep,dt,epot,eksum) end if end if if (integrate .eq. 'RIGIDBODY') then - write (ivel,360) ngrp,title(1:ltitle) - 360 format (i6,2x,a) + write (ivel,390) ngrp,title(1:ltitle) + 390 format (i6,2x,a) do i = 1, ngrp - write (ivel,370) i,(vcm(j,i),j=1,3) - 370 format (i6,3x,d13.6,3x,d13.6,3x,d13.6) - write (ivel,380) i,(wcm(j,i),j=1,3) - 380 format (i6,3x,d13.6,3x,d13.6,3x,d13.6) + write (ivel,400) i,(vcm(j,i),j=1,3) + 400 format (i6,3x,d13.6,3x,d13.6,3x,d13.6) + write (ivel,410) i,(wcm(j,i),j=1,3) + 410 format (i6,3x,d13.6,3x,d13.6,3x,d13.6) end do else if (dcdsave) then call prtdcdv (ivel,first) @@ -299,8 +320,8 @@ subroutine mdsave (istep,dt,epot,eksum) call prtvel (ivel) end if close (unit=ivel) - write (iout,390) velfile(1:trimtext(velfile)) - 390 format (' Velocity File',15x,a) + write (iout,420) velfile(1:trimtext(velfile)) + 420 format (' Velocity File',15x,a) end if c c save the force vector components for the current step, @@ -339,8 +360,8 @@ subroutine mdsave (istep,dt,epot,eksum) call prtfrc (ifrc) end if close (unit=ifrc) - write (iout,400) frcfile(1:trimtext(frcfile)) - 400 format (' Force Vector File',11x,a) + write (iout,430) frcfile(1:trimtext(frcfile)) + 430 format (' Force Vector File',11x,a) end if c c save the induced dipole components for the current step @@ -378,8 +399,8 @@ subroutine mdsave (istep,dt,epot,eksum) call prtuind (iind) end if close (unit=iind) - write (iout,410) indfile(1:trimtext(indfile)) - 410 format (' Induced Dipole File',9x,a) + write (iout,440) indfile(1:trimtext(indfile)) + 440 format (' Induced Dipole File',9x,a) end if c c save the static dipole components for the current step @@ -417,8 +438,8 @@ subroutine mdsave (istep,dt,epot,eksum) call prtustc (istc,xm,ym,zm) end if close (unit=istc) - write (iout,420) stcfile(1:trimtext(stcfile)) - 420 format (' Static Dipole File',10x,a) + write (iout,450) stcfile(1:trimtext(stcfile)) + 450 format (' Static Dipole File',10x,a) end if c c save the charge dipole components for the current step @@ -456,8 +477,8 @@ subroutine mdsave (istep,dt,epot,eksum) call prtuchg (istc,xm,ym,zm) end if close (unit=istc) - write (iout,430) stcfile(1:trimtext(stcfile)) - 430 format (' Charge Dipole File',10x,a) + write (iout,460) stcfile(1:trimtext(stcfile)) + 460 format (' Charge Dipole File',10x,a) end if c c test for requested termination of the dynamics calculation @@ -474,8 +495,8 @@ subroutine mdsave (istep,dt,epot,eksum) end if end if if (exist) then - write (iout,440) - 440 format (/,' MDSAVE -- Dynamics Calculation Ending', + write (iout,470) + 470 format (/,' MDSAVE -- Dynamics Calculation Ending', & ' due to User Request') call fatal end if @@ -484,8 +505,8 @@ subroutine mdsave (istep,dt,epot,eksum) c modsave = mod(istep,iprint) if (verbose .and. modsave.ne.0) then - write (iout,450) - 450 format () + write (iout,480) + 480 format () end if return end From 3345a3353b973a948f0543102ba49c3ef5d04b51 Mon Sep 17 00:00:00 2001 From: Moses Date: Sun, 28 Sep 2025 16:44:10 -0500 Subject: [PATCH 23/29] add SAVE-UDIRECT, SAVE-DEFIELD, SAVE-TEFIELD keywords --- source/final.f | 1 + source/induce.f | 2 +- source/mdinit.f | 13 + source/mdsave.f | 125 ++++++- source/output.f | 6 + source/polar.f | 2 + source/prtuind.f | 914 ++++++++++++++++++++++++++++++++++++++++++++++- 7 files changed, 1055 insertions(+), 8 deletions(-) diff --git a/source/final.f b/source/final.f index 578397809..e35b28a44 100644 --- a/source/final.f +++ b/source/final.f @@ -967,6 +967,7 @@ subroutine final if (allocated(uinds)) deallocate (uinds) if (allocated(uinps)) deallocate (uinps) if (allocated(uexact)) deallocate (uexact) + if (allocated(worker3n)) deallocate (worker3n) if (allocated(douind)) deallocate (douind) c c deallocation of global arrays from module polgrp diff --git a/source/induce.f b/source/induce.f index 410ef4ffb..9385d0600 100644 --- a/source/induce.f +++ b/source/induce.f @@ -261,7 +261,7 @@ subroutine induce0a end do end if end do - +c c get induced dipoles via the OPT extrapolation method c if (poltyp .eq. 'OPT') then diff --git a/source/mdinit.f b/source/mdinit.f index 3111f4992..4ea5b9d62 100644 --- a/source/mdinit.f +++ b/source/mdinit.f @@ -34,6 +34,7 @@ subroutine mdinit (dt) use moldyn use mpole use output + use polar use potent use rgddyn use rigid @@ -74,6 +75,9 @@ subroutine mdinit (dt) uchgsave = .false. usyssave = .false. vsyssave = .false. + udirsave = .false. + defsave = .false. + tefsave = .false. friction = 91.0d0 use_sdarea = .false. iprint = 100 @@ -134,6 +138,12 @@ subroutine mdinit (dt) usyssave = .true. else if (keyword(1:13) .eq. 'SAVE-VSYSTEM ') then vsyssave = .true. + else if (keyword(1:13) .eq. 'SAVE-UDIRECT ') then + udirsave = .true. + else if (keyword(1:13) .eq. 'SAVE-DEFIELD ') then + defsave = .true. + else if (keyword(1:13) .eq. 'SAVE-TEFIELD ') then + tefsave = .true. else if (keyword(1:9) .eq. 'FRICTION ') then read (string,*,err=10,end=10) friction else if (keyword(1:17) .eq. 'FRICTION-SCALING ') then @@ -356,6 +366,9 @@ subroutine mdinit (dt) c perform dynamic allocation of some local arrays c allocate (derivs(3,n)) + if (udirsave.or.defsave.or.tefsave) then + if (.not. allocated(worker3n)) allocate (worker3n(3,n)) + end if c c try to restart using prior velocities and accelerations c diff --git a/source/mdsave.f b/source/mdsave.f index 69823fa45..0dcae2df8 100644 --- a/source/mdsave.f +++ b/source/mdsave.f @@ -481,6 +481,123 @@ subroutine mdsave (istep,dt,epot,eksum) 460 format (' Charge Dipole File',10x,a) end if c +c save the direct induced dipole components for the current step +c + if (udirsave .and. use_polar) then + iind = freeunit () + if (cyclesave) then + indfile = filename(1:leng)//'.'//ext(1:lext)//'ud' + call version (indfile,'new') + open (unit=iind,file=indfile,status='new') + call prtudir (iind) + else if (dcdsave) then + indfile = filename(1:leng) + call suffix (indfile,'dcdud','old') + inquire (file=indfile,exist=exist) + if (exist) then + first = .false. + open (unit=iind,file=indfile,form='unformatted', + & status='old',position='append') + else + first = .true. + open (unit=iind,file=indfile,form='unformatted', + & status='new') + end if + call prtdcdud (iind,first) + else + indfile = filename(1:leng) + call suffix (indfile,'udir','old') + inquire (file=indfile,exist=exist) + if (exist) then + call openend (iind,indfile) + else + open (unit=iind,file=indfile,status='new') + end if + call prtudir (iind) + end if + close (unit=iind) + write (iout,470) indfile(1:trimtext(indfile)) + 470 format (' Direct Induced Dipole File',2x,a) + end if +c +c save the direct atomic electric field for the current step +c + if (defsave .and. use_polar) then + iind = freeunit () + if (cyclesave) then + indfile = filename(1:leng)//'.'//ext(1:lext)//'de' + call version (indfile,'new') + open (unit=iind,file=indfile,status='new') + call prtdef (iind) + else if (dcdsave) then + indfile = filename(1:leng) + call suffix (indfile,'dcdde','old') + inquire (file=indfile,exist=exist) + if (exist) then + first = .false. + open (unit=iind,file=indfile,form='unformatted', + & status='old',position='append') + else + first = .true. + open (unit=iind,file=indfile,form='unformatted', + & status='new') + end if + call prtdcdde (iind,first) + else + indfile = filename(1:leng) + call suffix (indfile,'def','old') + inquire (file=indfile,exist=exist) + if (exist) then + call openend (iind,indfile) + else + open (unit=iind,file=indfile,status='new') + end if + call prtdef (iind) + end if + close (unit=iind) + write (iout,480) indfile(1:trimtext(indfile)) + 480 format (' Direct Electric Field File',2x,a) + end if +c +c save the total atomic electric field for the current step +c + if (tefsave .and. use_polar) then + iind = freeunit () + if (cyclesave) then + indfile = filename(1:leng)//'.'//ext(1:lext)//'te' + call version (indfile,'new') + open (unit=iind,file=indfile,status='new') + call prttef (iind) + else if (dcdsave) then + indfile = filename(1:leng) + call suffix (indfile,'dcdte','old') + inquire (file=indfile,exist=exist) + if (exist) then + first = .false. + open (unit=iind,file=indfile,form='unformatted', + & status='old',position='append') + else + first = .true. + open (unit=iind,file=indfile,form='unformatted', + & status='new') + end if + call prtdcdte (iind,first) + else + indfile = filename(1:leng) + call suffix (indfile,'tef','old') + inquire (file=indfile,exist=exist) + if (exist) then + call openend (iind,indfile) + else + open (unit=iind,file=indfile,status='new') + end if + call prttef (iind) + end if + close (unit=iind) + write (iout,490) indfile(1:trimtext(indfile)) + 490 format (' Total Electric Field File',3x,a) + end if +c c test for requested termination of the dynamics calculation c endfile = 'tinker.end' @@ -495,8 +612,8 @@ subroutine mdsave (istep,dt,epot,eksum) end if end if if (exist) then - write (iout,470) - 470 format (/,' MDSAVE -- Dynamics Calculation Ending', + write (iout,500) + 500 format (/,' MDSAVE -- Dynamics Calculation Ending', & ' due to User Request') call fatal end if @@ -505,8 +622,8 @@ subroutine mdsave (istep,dt,epot,eksum) c modsave = mod(istep,iprint) if (verbose .and. modsave.ne.0) then - write (iout,480) - 480 format () + write (iout,510) + 510 format () end if return end diff --git a/source/output.f b/source/output.f index 702f89ac4..1e9ed010b 100644 --- a/source/output.f +++ b/source/output.f @@ -32,6 +32,9 @@ c uchgsave logical flag to save charge atomic dipoles c usyssave logical flag to save unique atom type dipole moment c vsyssave logical flag to save unique atom type velocity +c udirsave logical flag to save the direct induced atomic dipoles +c defsave logical flag to save the direct electric field +c tefsave logical flag to save the total electric field c coordtype selects Cartesian, internal, rigid body or none c c @@ -57,6 +60,9 @@ module output logical uchgsave logical usyssave logical vsyssave + logical udirsave + logical defsave + logical tefsave character*9 coordtype save end diff --git a/source/polar.f b/source/polar.f index e746f05fd..c0fc21ee3 100644 --- a/source/polar.f +++ b/source/polar.f @@ -30,6 +30,7 @@ c uinds mutual GK or PB induced dipoles for each atom site c uinps mutual induced dipoles in field used for GK or PB energy c uexact exact SCF induced dipoles to full numerical precision +c worker3n worker array for printing dipoles and electric fields c douind flag to allow induced dipoles at each atom site c c @@ -53,6 +54,7 @@ module polar real*8, allocatable :: uinds(:,:) real*8, allocatable :: uinps(:,:) real*8, allocatable :: uexact(:,:) + real*8, allocatable :: worker3n(:,:) logical, allocatable :: douind(:) save end diff --git a/source/prtuind.f b/source/prtuind.f index 30446f980..ba5fe3bb0 100644 --- a/source/prtuind.f +++ b/source/prtuind.f @@ -296,7 +296,7 @@ subroutine prtustc (istc,xm,ym,zm) integer ii integer size,crdsiz real*8 crdmin,crdmax - real*8 c,xd,yd,zd + real*8 xd,yd,zd real*8 xm,ym,zm logical opened character*2 atmc @@ -375,7 +375,6 @@ subroutine prtustc (istc,xm,ym,zm) & '.'//digc//',i6,8'//atmc//')' if (.not. onlysave) then do i = 1, n - c = rpole(1,i) xd = rpole(2,i) * debye yd = rpole(3,i) * debye zd = rpole(4,i) * debye @@ -390,7 +389,6 @@ subroutine prtustc (istc,xm,ym,zm) else do ii = 1, nonly i = ionly(ii) - c = rpole(1,i) xd = rpole(2,i) * debye yd = rpole(3,i) * debye zd = rpole(4,i) * debye @@ -813,3 +811,913 @@ subroutine prtdcduc (idcd,first,xm,ym,zm) if (.not. opened) close (unit=idcd) return end +c +c +c ############################################################### +c ## ## +c ## subroutine prtudir -- output of atomic direct dipoles ## +c ## ## +c ############################################################### +c +c +c "prtudir" writes out a set of directly induced dipole +c components to an external disk file in Tinker XYZ format +c +c + subroutine prtudir (iind) + use atomid + use atoms + use bound + use boxes + use couple + use expol + use files + use inform + use polar + use polpot + use output + use titles + use units + implicit none + integer i,j,k,iind + integer ii + integer size,crdsiz + real*8 crdmin,crdmax + logical opened + character*2 atmc + character*2 crdc + character*2 digc + character*25 fstr + character*240 indfile +c +c +c open the output unit if not already done +c + inquire (unit=iind,opened=opened) + if (.not. opened) then + indfile = filename(1:leng)//'.udir' + call version (indfile,'new') + open (unit=iind,file=indfile,status='new') + end if +c +c check for large systems needing extended formatting +c + atmc = 'i6' + if (n .ge. 100000) atmc = 'i7' + if (n .ge. 1000000) atmc = 'i8' + crdmin = 0.0d0 + crdmax = 0.0d0 + do i = 1, n + crdmin = min(crdmin,x(i),y(i),z(i)) + crdmax = max(crdmax,x(i),y(i),z(i)) + end do + crdsiz = 6 + if (crdmin .le. -1000.0d0) crdsiz = 7 + if (crdmax .ge. 10000.0d0) crdsiz = 7 + if (crdmin .le. -10000.0d0) crdsiz = 8 + if (crdmax .ge. 100000.0d0) crdsiz = 8 + crdsiz = crdsiz + max(6,digits) + size = 0 + call numeral (crdsiz,crdc,size) + if (digits .le. 6) then + digc = '6 ' + else if (digits .le. 8) then + digc = '8' + else + digc = '10' + end if +c +c write out the number of atoms and the title +c + if (.not. onlysave) then + if (ltitle .eq. 0) then + fstr = '('//atmc//')' + write (iind,fstr(1:4)) n + else + fstr = '('//atmc//',2x,a)' + write (iind,fstr(1:9)) n,title(1:ltitle) + end if + else + if (ltitle .eq. 0) then + fstr = '('//atmc//')' + write (iind,fstr(1:4)) nonly + else + fstr = '('//atmc//',2x,a)' + write (iind,fstr(1:9)) nonly,title(1:ltitle) + end if + end if +c +c write out the periodic cell lengths and angles +c + if (use_bounds) then + fstr = '(1x,6f'//crdc//'.'//digc//')' + write (iind,fstr) xbox,ybox,zbox,alpha,beta,gamma + end if +c +c compute the direct dipoles in Debye units +c + if (.not. use_expol) then + do i = 1, n + do j = 1, 3 + worker3n(j,i) = debye*udir(j,i) + end do + end do + else + do i = 1, n + do j = 1, 3 + worker3n(j,i) = 0.0d0 + do k = 1, 3 + worker3n(j,i)=worker3n(j,i)+udir(k,i)*polinv(j,k,i) + end do + worker3n(j,i) = debye*worker3n(j,i) + end do + end do + end if +c +c write out the direct dipole components for each atom +c + fstr = '('//atmc//',2x,a3,3f'//crdc// + & '.'//digc//',i6,8'//atmc//')' + if (.not. onlysave) then + do i = 1, n + k = n12(i) + if (k .eq. 0) then + write (iind,fstr) i,name(i),(worker3n(j,i),j=1,3), + & type(i) + else + write (iind,fstr) i,name(i),(worker3n(j,i),j=1,3), + & type(i),(i12(j,i),j=1,k) + end if + end do + else + do ii = 1, nonly + i = ionly(ii) + k = n12(i) + if (k .eq. 0) then + write (iind,fstr) ii,name(i),(worker3n(j,i),j=1,3), + & type(i) + else + write (iind,fstr) ii,name(i),(worker3n(j,i),j=1,3), + & type(i), (ionlyinv(i12(j,i)),j=1,k) + end if + end do + end if +c +c close the output unit if opened by this routine +c + if (.not. opened) close (unit=iind) + return + end +c +c +c ############################################################# +c ## ## +c ## subroutine prtdcdud -- output of DCD direct dipoles ## +c ## ## +c ############################################################# +c +c +c "prtdcdud" writes out a set of directly induced dipole +c components to a file in CHARMM DCD binary format compatible +c with the VMD visualization software and other packages +c +c note the format used is based on the "dcdplugin.c" code from +c the NAMD and VMD programs, and tutorial 4.1 from the software +c package GENESIS: Generalized-Ensemble Simulation System +c +c variables and parameters: +c +c header type of data (CORD=coordinates, VELD=velocities) +c nframe number of frames stored in the DCD file +c nprev number of previous integration steps +c ncrdsav frequency in steps for saving coordinate frames +c nstep number of integration steps in the total run +c nvelsav frequency of coordinate saves with velocity data +c ndfree number of degrees of freedom for the system +c nfixat number of fixed atoms for the system +c usebox flag for periodic boundaries (1=true, 0=false) +c use4d flag for 4D trajectory (1=true, 0=false) +c usefq flag for fluctuating charges (1=true, 0=false) +c merged result of merge without checks (1=true, 0=false) +c vcharmm version of CHARMM software for compatibility +c +c in general a value of zero for any of the above indicates that +c the particular feature is unused +c +c + subroutine prtdcdud (idcd,first) + use atoms + use bound + use boxes + use expol + use files + use polar + use polpot + use output + use titles + use units + implicit none + integer i,idcd + integer j,k + integer zero,one + integer nframe,nprev + integer ncrdsav,nstep + integer nvelsav,ndfree + integer nfixat,usebox + integer use4d,usefq + integer merged,vcharmm + integer ntitle + real*4 tdelta + logical opened,first + character*4 header + character*240 dcdfile +c +c +c open the output unit if not already done +c + inquire (unit=idcd,opened=opened) + if (.not. opened) then + dcdfile = filename(1:leng)//'.dcdud' + call version (dcdfile,'new') + open (unit=idcd,file=dcdfile,form='unformatted',status='new') + end if +c +c write header info along with title and number of atoms +c + if (first) then + first = .false. + zero = 0 + one = 1 + header = 'CORD' + nframe = zero + nprev = zero + ncrdsav = one + nstep = zero + nvelsav = zero + ndfree = zero + nfixat = zero + tdelta = 0.0 + usebox = zero + if (use_bounds) usebox = one + use4d = zero + usefq = zero + merged = zero + vcharmm = 24 + ntitle = one + write (idcd) header,nframe,nprev,ncrdsav,nstep, + & nvelsav,zero,zero,ndfree,nfixat, + & tdelta,usebox,use4d,usefq,merged, + & zero,zero,zero,zero,zero,vcharmm + write (idcd) ntitle,title(1:80) + if (.not. onlysave) then + write (idcd) n + else + write (idcd) nonly + end if + end if +c +c append the lattice values based on header flag value +c + if (use_bounds) then + write (idcd) xbox,gamma_cos,ybox,beta_cos,alpha_cos,zbox + end if +c +c compute the direct dipoles in Debye units +c + if (.not. use_expol) then + do i = 1, n + do j = 1, 3 + worker3n(j,i) = debye*udir(j,i) + end do + end do + else + do i = 1, n + do j = 1, 3 + worker3n(j,i) = 0.0d0 + do k = 1, 3 + worker3n(j,i)=worker3n(j,i)+udir(k,i)*polinv(j,k,i) + end do + worker3n(j,i) = debye*worker3n(j,i) + end do + end do + end if +c +c append the direct dipoles along each axis in turn +c + if (.not. onlysave) then + write (idcd) (real(worker3n(1,i)),i=1,n) + write (idcd) (real(worker3n(2,i)),i=1,n) + write (idcd) (real(worker3n(3,i)),i=1,n) + else + write (idcd) (real(worker3n(1,ionly(i))),i=1,nonly) + write (idcd) (real(worker3n(2,ionly(i))),i=1,nonly) + write (idcd) (real(worker3n(3,ionly(i))),i=1,nonly) + end if +c +c close the output unit if opened by this routine +c + if (.not. opened) close (unit=idcd) + return + end +c +c +c ############################################################# +c ## ## +c ## subroutine prtdef -- output of atomic direct efield ## +c ## ## +c ############################################################# +c +c +c "prtdef" writes out a set of direct electric field components +c to an external disk file in Tinker XYZ format +c +c + subroutine prtdef (iind) + use atomid + use atoms + use bound + use boxes + use couple + use files + use inform + use polar + use polpot + use output + use titles + use units + implicit none + integer i,j,k,iind + integer ii + integer size,crdsiz + real*8 c + real*8 crdmin,crdmax + logical opened + character*2 atmc + character*2 crdc + character*2 digc + character*25 fstr + character*240 indfile +c +c +c open the output unit if not already done +c + inquire (unit=iind,opened=opened) + if (.not. opened) then + indfile = filename(1:leng)//'.def' + call version (indfile,'new') + open (unit=iind,file=indfile,status='new') + end if +c +c check for large systems needing extended formatting +c + atmc = 'i6' + if (n .ge. 100000) atmc = 'i7' + if (n .ge. 1000000) atmc = 'i8' + crdmin = 0.0d0 + crdmax = 0.0d0 + do i = 1, n + crdmin = min(crdmin,x(i),y(i),z(i)) + crdmax = max(crdmax,x(i),y(i),z(i)) + end do + crdsiz = 6 + if (crdmin .le. -1000.0d0) crdsiz = 7 + if (crdmax .ge. 10000.0d0) crdsiz = 7 + if (crdmin .le. -10000.0d0) crdsiz = 8 + if (crdmax .ge. 100000.0d0) crdsiz = 8 + crdsiz = crdsiz + max(6,digits) + size = 0 + call numeral (crdsiz,crdc,size) + if (digits .le. 6) then + digc = '6 ' + else if (digits .le. 8) then + digc = '8' + else + digc = '10' + end if +c +c write out the number of atoms and the title +c + if (.not. onlysave) then + if (ltitle .eq. 0) then + fstr = '('//atmc//')' + write (iind,fstr(1:4)) n + else + fstr = '('//atmc//',2x,a)' + write (iind,fstr(1:9)) n,title(1:ltitle) + end if + else + if (ltitle .eq. 0) then + fstr = '('//atmc//')' + write (iind,fstr(1:4)) nonly + else + fstr = '('//atmc//',2x,a)' + write (iind,fstr(1:9)) nonly,title(1:ltitle) + end if + end if +c +c write out the periodic cell lengths and angles +c + if (use_bounds) then + fstr = '(1x,6f'//crdc//'.'//digc//')' + write (iind,fstr) xbox,ybox,zbox,alpha,beta,gamma + end if +c +c compute the direct electric field components in MV/cm units +c + do i = 1, n + c = elefield/polarity(i) + do j = 1, 3 + worker3n(j,i) = c * udir(j,i) + end do + end do +c +c write out the direct electric field components for each atom +c + fstr = '('//atmc//',2x,a3,3f'//crdc// + & '.'//digc//',i6,8'//atmc//')' + if (.not. onlysave) then + do i = 1, n + k = n12(i) + if (k .eq. 0) then + write (iind,fstr) i,name(i),(worker3n(j,i),j=1,3), + & type(i) + else + write (iind,fstr) i,name(i),(worker3n(j,i),j=1,3), + & type(i),(i12(j,i),j=1,k) + end if + end do + else + do ii = 1, nonly + i = ionly(ii) + k = n12(i) + if (k .eq. 0) then + write (iind,fstr) ii,name(i),(worker3n(j,i),j=1,3), + & type(i) + else + write (iind,fstr) ii,name(i),(worker3n(j,i),j=1,3), + & type(i), (ionlyinv(i12(j,i)),j=1,k) + end if + end do + end if +c +c close the output unit if opened by this routine +c + if (.not. opened) close (unit=iind) + return + end +c +c +c ############################################################ +c ## ## +c ## subroutine prtdcdde -- output of DCD direct efield ## +c ## ## +c ############################################################ +c +c +c "prtdcdde" writes out a set of direct electric field components +c to a file in CHARMM DCD binary format compatible with the VMD +c visualization software and other packages +c +c note the format used is based on the "dcdplugin.c" code from +c the NAMD and VMD programs, and tutorial 4.1 from the software +c package GENESIS: Generalized-Ensemble Simulation System +c +c variables and parameters: +c +c header type of data (CORD=coordinates, VELD=velocities) +c nframe number of frames stored in the DCD file +c nprev number of previous integration steps +c ncrdsav frequency in steps for saving coordinate frames +c nstep number of integration steps in the total run +c nvelsav frequency of coordinate saves with velocity data +c ndfree number of degrees of freedom for the system +c nfixat number of fixed atoms for the system +c usebox flag for periodic boundaries (1=true, 0=false) +c use4d flag for 4D trajectory (1=true, 0=false) +c usefq flag for fluctuating charges (1=true, 0=false) +c merged result of merge without checks (1=true, 0=false) +c vcharmm version of CHARMM software for compatibility +c +c in general a value of zero for any of the above indicates that +c the particular feature is unused +c +c + subroutine prtdcdde (idcd,first) + use atoms + use bound + use boxes + use files + use polar + use polpot + use output + use titles + use units + implicit none + integer i,idcd + integer j + integer zero,one + integer nframe,nprev + integer ncrdsav,nstep + integer nvelsav,ndfree + integer nfixat,usebox + integer use4d,usefq + integer merged,vcharmm + integer ntitle + real*8 c + real*4 tdelta + logical opened,first + character*4 header + character*240 dcdfile +c +c +c open the output unit if not already done +c + inquire (unit=idcd,opened=opened) + if (.not. opened) then + dcdfile = filename(1:leng)//'.dcdde' + call version (dcdfile,'new') + open (unit=idcd,file=dcdfile,form='unformatted',status='new') + end if +c +c write header info along with title and number of atoms +c + if (first) then + first = .false. + zero = 0 + one = 1 + header = 'CORD' + nframe = zero + nprev = zero + ncrdsav = one + nstep = zero + nvelsav = zero + ndfree = zero + nfixat = zero + tdelta = 0.0 + usebox = zero + if (use_bounds) usebox = one + use4d = zero + usefq = zero + merged = zero + vcharmm = 24 + ntitle = one + write (idcd) header,nframe,nprev,ncrdsav,nstep, + & nvelsav,zero,zero,ndfree,nfixat, + & tdelta,usebox,use4d,usefq,merged, + & zero,zero,zero,zero,zero,vcharmm + write (idcd) ntitle,title(1:80) + if (.not. onlysave) then + write (idcd) n + else + write (idcd) nonly + end if + end if +c +c append the lattice values based on header flag value +c + if (use_bounds) then + write (idcd) xbox,gamma_cos,ybox,beta_cos,alpha_cos,zbox + end if +c +c compute the direct electric field components in MV/cm units +c + do i = 1, n + c = elefield/polarity(i) + do j = 1, 3 + worker3n(j,i) = c * udir(j,i) + end do + end do + +c +c append the direct electric field along each axis in turn +c + if (.not. onlysave) then + write (idcd) (real(worker3n(1,i)),i=1,n) + write (idcd) (real(worker3n(2,i)),i=1,n) + write (idcd) (real(worker3n(3,i)),i=1,n) + else + write (idcd) (real(worker3n(1,ionly(i))),i=1,nonly) + write (idcd) (real(worker3n(2,ionly(i))),i=1,nonly) + write (idcd) (real(worker3n(3,ionly(i))),i=1,nonly) + end if +c +c close the output unit if opened by this routine +c + if (.not. opened) close (unit=idcd) + return + end +c +c +c ############################################################ +c ## ## +c ## subroutine prttef -- output of atomic total efield ## +c ## ## +c ############################################################ +c +c +c "prttef" writes out a set of total electric field components +c to an external disk file in Tinker XYZ format +c +c + subroutine prttef (iind) + use atomid + use atoms + use bound + use boxes + use couple + use expol + use files + use inform + use polar + use polpot + use output + use titles + use units + implicit none + integer i,j,k,iind + integer ii + integer size,crdsiz + real*8 c + real*8 crdmin,crdmax + logical opened + character*2 atmc + character*2 crdc + character*2 digc + character*25 fstr + character*240 indfile +c +c +c open the output unit if not already done +c + inquire (unit=iind,opened=opened) + if (.not. opened) then + indfile = filename(1:leng)//'.tef' + call version (indfile,'new') + open (unit=iind,file=indfile,status='new') + end if +c +c check for large systems needing extended formatting +c + atmc = 'i6' + if (n .ge. 100000) atmc = 'i7' + if (n .ge. 1000000) atmc = 'i8' + crdmin = 0.0d0 + crdmax = 0.0d0 + do i = 1, n + crdmin = min(crdmin,x(i),y(i),z(i)) + crdmax = max(crdmax,x(i),y(i),z(i)) + end do + crdsiz = 6 + if (crdmin .le. -1000.0d0) crdsiz = 7 + if (crdmax .ge. 10000.0d0) crdsiz = 7 + if (crdmin .le. -10000.0d0) crdsiz = 8 + if (crdmax .ge. 100000.0d0) crdsiz = 8 + crdsiz = crdsiz + max(6,digits) + size = 0 + call numeral (crdsiz,crdc,size) + if (digits .le. 6) then + digc = '6 ' + else if (digits .le. 8) then + digc = '8' + else + digc = '10' + end if +c +c write out the number of atoms and the title +c + if (.not. onlysave) then + if (ltitle .eq. 0) then + fstr = '('//atmc//')' + write (iind,fstr(1:4)) n + else + fstr = '('//atmc//',2x,a)' + write (iind,fstr(1:9)) n,title(1:ltitle) + end if + else + if (ltitle .eq. 0) then + fstr = '('//atmc//')' + write (iind,fstr(1:4)) nonly + else + fstr = '('//atmc//',2x,a)' + write (iind,fstr(1:9)) nonly,title(1:ltitle) + end if + end if +c +c write out the periodic cell lengths and angles +c + if (use_bounds) then + fstr = '(1x,6f'//crdc//'.'//digc//')' + write (iind,fstr) xbox,ybox,zbox,alpha,beta,gamma + end if +c +c compute the total electric field components in MV/cm units +c + if (.not. use_expol) then + do i = 1, n + c = elefield/polarity(i) + do j = 1, 3 + worker3n(j,i) = c * uind(j,i) + end do + end do + else + do i = 1, n + c = elefield/polarity(i) + do j = 1, 3 + worker3n(j,i) = 0.0d0 + do k = 1, 3 + worker3n(j,i)=worker3n(j,i)+uind(k,i)*polscale(j,k,i) + end do + worker3n(j,i) = c * worker3n(j,i) + end do + end do + end if +c +c write out the total electric field components for each atom +c + fstr = '('//atmc//',2x,a3,3f'//crdc// + & '.'//digc//',i6,8'//atmc//')' + if (.not. onlysave) then + do i = 1, n + k = n12(i) + if (k .eq. 0) then + write (iind,fstr) i,name(i),(worker3n(j,i),j=1,3), + & type(i) + else + write (iind,fstr) i,name(i),(worker3n(j,i),j=1,3), + & type(i),(i12(j,i),j=1,k) + end if + end do + else + do ii = 1, nonly + i = ionly(ii) + k = n12(i) + if (k .eq. 0) then + write (iind,fstr) ii,name(i),(worker3n(j,i),j=1,3), + & type(i) + else + write (iind,fstr) ii,name(i),(worker3n(j,i),j=1,3), + & type(i), (ionlyinv(i12(j,i)),j=1,k) + end if + end do + end if +c +c close the output unit if opened by this routine +c + if (.not. opened) close (unit=iind) + return + end +c +c +c ########################################################### +c ## ## +c ## subroutine prtdcdte -- output of DCD total efield ## +c ## ## +c ########################################################### +c +c +c "prtdcdte" writes out a set of total electric field components +c to a file in CHARMM DCD binary format compatible with the VMD +c visualization software and other packages +c +c note the format used is based on the "dcdplugin.c" code from +c the NAMD and VMD programs, and tutorial 4.1 from the software +c package GENESIS: Generalized-Ensemble Simulation System +c +c variables and parameters: +c +c header type of data (CORD=coordinates, VELD=velocities) +c nframe number of frames stored in the DCD file +c nprev number of previous integration steps +c ncrdsav frequency in steps for saving coordinate frames +c nstep number of integration steps in the total run +c nvelsav frequency of coordinate saves with velocity data +c ndfree number of degrees of freedom for the system +c nfixat number of fixed atoms for the system +c usebox flag for periodic boundaries (1=true, 0=false) +c use4d flag for 4D trajectory (1=true, 0=false) +c usefq flag for fluctuating charges (1=true, 0=false) +c merged result of merge without checks (1=true, 0=false) +c vcharmm version of CHARMM software for compatibility +c +c in general a value of zero for any of the above indicates that +c the particular feature is unused +c +c + subroutine prtdcdte (idcd,first) + use atoms + use bound + use boxes + use expol + use files + use polar + use polpot + use output + use titles + use units + implicit none + integer i,idcd + integer j,k + integer zero,one + integer nframe,nprev + integer ncrdsav,nstep + integer nvelsav,ndfree + integer nfixat,usebox + integer use4d,usefq + integer merged,vcharmm + integer ntitle + real*8 c + real*4 tdelta + logical opened,first + character*4 header + character*240 dcdfile +c +c +c open the output unit if not already done +c + inquire (unit=idcd,opened=opened) + if (.not. opened) then + dcdfile = filename(1:leng)//'.dcdte' + call version (dcdfile,'new') + open (unit=idcd,file=dcdfile,form='unformatted',status='new') + end if +c +c write header info along with title and number of atoms +c + if (first) then + first = .false. + zero = 0 + one = 1 + header = 'CORD' + nframe = zero + nprev = zero + ncrdsav = one + nstep = zero + nvelsav = zero + ndfree = zero + nfixat = zero + tdelta = 0.0 + usebox = zero + if (use_bounds) usebox = one + use4d = zero + usefq = zero + merged = zero + vcharmm = 24 + ntitle = one + write (idcd) header,nframe,nprev,ncrdsav,nstep, + & nvelsav,zero,zero,ndfree,nfixat, + & tdelta,usebox,use4d,usefq,merged, + & zero,zero,zero,zero,zero,vcharmm + write (idcd) ntitle,title(1:80) + if (.not. onlysave) then + write (idcd) n + else + write (idcd) nonly + end if + end if +c +c append the lattice values based on header flag value +c + if (use_bounds) then + write (idcd) xbox,gamma_cos,ybox,beta_cos,alpha_cos,zbox + end if +c +c compute the total electric field components in MV/cm units +c + if (.not. use_expol) then + do i = 1, n + c = elefield/polarity(i) + do j = 1, 3 + worker3n(j,i) = c * uind(j,i) + end do + end do + else + do i = 1, n + c = elefield/polarity(i) + do j = 1, 3 + worker3n(j,i) = 0.0d0 + do k = 1, 3 + worker3n(j,i)=worker3n(j,i)+uind(k,i)*polscale(j,k,i) + end do + worker3n(j,i) = c * worker3n(j,i) + end do + end do + end if + +c +c append the total electric field along each axis in turn +c + if (.not. onlysave) then + write (idcd) (real(worker3n(1,i)),i=1,n) + write (idcd) (real(worker3n(2,i)),i=1,n) + write (idcd) (real(worker3n(3,i)),i=1,n) + else + write (idcd) (real(worker3n(1,ionly(i))),i=1,nonly) + write (idcd) (real(worker3n(2,ionly(i))),i=1,nonly) + write (idcd) (real(worker3n(3,ionly(i))),i=1,nonly) + end if +c +c close the output unit if opened by this routine +c + if (.not. opened) close (unit=idcd) + return + end From aad9340c17d29eeb6dafcbc8c16fc88af662d6d8 Mon Sep 17 00:00:00 2001 From: Moses Date: Sun, 28 Sep 2025 16:46:43 -0500 Subject: [PATCH 24/29] update interface --- interface/c/tinker/detail/output.hh | 3 +++ interface/c/tinker/detail/polar.hh | 1 + interface/c/tinker/routines.h | 12 ++++++++++++ interface/cpp/tinker/detail/output.hh | 9 +++++++++ interface/cpp/tinker/detail/polar.hh | 3 +++ interface/cpp/tinker/routines.h | 12 ++++++++++++ 6 files changed, 40 insertions(+) diff --git a/interface/c/tinker/detail/output.hh b/interface/c/tinker/detail/output.hh index 3975f26da..cc36ef567 100644 --- a/interface/c/tinker/detail/output.hh +++ b/interface/c/tinker/detail/output.hh @@ -25,6 +25,9 @@ extern int TINKER_MOD(output, ustcsave); extern int TINKER_MOD(output, uchgsave); extern int TINKER_MOD(output, usyssave); extern int TINKER_MOD(output, vsyssave); +extern int TINKER_MOD(output, udirsave); +extern int TINKER_MOD(output, defsave); +extern int TINKER_MOD(output, tefsave); extern char TINKER_MOD(output, coordtype)[9]; #ifdef __cplusplus } diff --git a/interface/c/tinker/detail/polar.hh b/interface/c/tinker/detail/polar.hh index 17443bcad..29ab85e5f 100644 --- a/interface/c/tinker/detail/polar.hh +++ b/interface/c/tinker/detail/polar.hh @@ -23,6 +23,7 @@ extern double* TINKER_MOD(polar, uinp); extern double* TINKER_MOD(polar, uinds); extern double* TINKER_MOD(polar, uinps); extern double* TINKER_MOD(polar, uexact); +extern double* TINKER_MOD(polar, worker3n); extern int* TINKER_MOD(polar, douind); #ifdef __cplusplus } diff --git a/interface/c/tinker/routines.h b/interface/c/tinker/routines.h index 2dd45b649..8c6d3ca9d 100644 --- a/interface/c/tinker/routines.h +++ b/interface/c/tinker/routines.h @@ -2254,6 +2254,18 @@ void prtuchg_(int* istc, double* xm, double* ym, double* zm); #define tinker_f_prtuchg prtuchg_ void prtdcduc_(int* idcd, int* first, double* xm, double* ym, double* zm); #define tinker_f_prtdcduc prtdcduc_ +void prtudir_(int* iind); +#define tinker_f_prtudir prtudir_ +void prtdcdud_(int* idcd, int* first); +#define tinker_f_prtdcdud prtdcdud_ +void prtdef_(int* iind); +#define tinker_f_prtdef prtdef_ +void prtdcdde_(int* idcd, int* first); +#define tinker_f_prtdcdde prtdcdde_ +void prttef_(int* iind); +#define tinker_f_prttef prttef_ +void prtdcdte_(int* idcd, int* first); +#define tinker_f_prtdcdte prtdcdte_ // prtvel.f void prtvel_(int* ivel); diff --git a/interface/cpp/tinker/detail/output.hh b/interface/cpp/tinker/detail/output.hh index b93e54b2c..14e55f96c 100644 --- a/interface/cpp/tinker/detail/output.hh +++ b/interface/cpp/tinker/detail/output.hh @@ -23,6 +23,9 @@ extern int& ustcsave; extern int& uchgsave; extern int& usyssave; extern int& vsyssave; +extern int& udirsave; +extern int& defsave; +extern int& tefsave; extern char (&coordtype)[9]; #ifdef TINKER_FORTRAN_MODULE_CPP @@ -46,6 +49,9 @@ extern "C" int TINKER_MOD(output, ustcsave); extern "C" int TINKER_MOD(output, uchgsave); extern "C" int TINKER_MOD(output, usyssave); extern "C" int TINKER_MOD(output, vsyssave); +extern "C" int TINKER_MOD(output, udirsave); +extern "C" int TINKER_MOD(output, defsave); +extern "C" int TINKER_MOD(output, tefsave); extern "C" char TINKER_MOD(output, coordtype)[9]; int& nonly = TINKER_MOD(output, nonly); @@ -68,6 +74,9 @@ int& ustcsave = TINKER_MOD(output, ustcsave); int& uchgsave = TINKER_MOD(output, uchgsave); int& usyssave = TINKER_MOD(output, usyssave); int& vsyssave = TINKER_MOD(output, vsyssave); +int& udirsave = TINKER_MOD(output, udirsave); +int& defsave = TINKER_MOD(output, defsave); +int& tefsave = TINKER_MOD(output, tefsave); char (&coordtype)[9] = TINKER_MOD(output, coordtype); #endif } } diff --git a/interface/cpp/tinker/detail/polar.hh b/interface/cpp/tinker/detail/polar.hh index 0a175cff9..ad0675a25 100644 --- a/interface/cpp/tinker/detail/polar.hh +++ b/interface/cpp/tinker/detail/polar.hh @@ -21,6 +21,7 @@ extern double*& uinp; extern double*& uinds; extern double*& uinps; extern double*& uexact; +extern double*& worker3n; extern int*& douind; #ifdef TINKER_FORTRAN_MODULE_CPP @@ -42,6 +43,7 @@ extern "C" double* TINKER_MOD(polar, uinp); extern "C" double* TINKER_MOD(polar, uinds); extern "C" double* TINKER_MOD(polar, uinps); extern "C" double* TINKER_MOD(polar, uexact); +extern "C" double* TINKER_MOD(polar, worker3n); extern "C" int* TINKER_MOD(polar, douind); int& npolar = TINKER_MOD(polar, npolar); @@ -62,6 +64,7 @@ double*& uinp = TINKER_MOD(polar, uinp); double*& uinds = TINKER_MOD(polar, uinds); double*& uinps = TINKER_MOD(polar, uinps); double*& uexact = TINKER_MOD(polar, uexact); +double*& worker3n = TINKER_MOD(polar, worker3n); int*& douind = TINKER_MOD(polar, douind); #endif } } diff --git a/interface/cpp/tinker/routines.h b/interface/cpp/tinker/routines.h index 2dd45b649..8c6d3ca9d 100644 --- a/interface/cpp/tinker/routines.h +++ b/interface/cpp/tinker/routines.h @@ -2254,6 +2254,18 @@ void prtuchg_(int* istc, double* xm, double* ym, double* zm); #define tinker_f_prtuchg prtuchg_ void prtdcduc_(int* idcd, int* first, double* xm, double* ym, double* zm); #define tinker_f_prtdcduc prtdcduc_ +void prtudir_(int* iind); +#define tinker_f_prtudir prtudir_ +void prtdcdud_(int* idcd, int* first); +#define tinker_f_prtdcdud prtdcdud_ +void prtdef_(int* iind); +#define tinker_f_prtdef prtdef_ +void prtdcdde_(int* idcd, int* first); +#define tinker_f_prtdcdde prtdcdde_ +void prttef_(int* iind); +#define tinker_f_prttef prttef_ +void prtdcdte_(int* idcd, int* first); +#define tinker_f_prtdcdte prtdcdte_ // prtvel.f void prtvel_(int* ivel); From 35246e0cbe0c8d0465c3b6f13b840b4e6b6b7218 Mon Sep 17 00:00:00 2001 From: Moses Date: Sun, 28 Sep 2025 22:23:43 -0500 Subject: [PATCH 25/29] remove unnecessary loop in induce.f --- source/induce.f | 18 ++++++++---------- 1 file changed, 8 insertions(+), 10 deletions(-) diff --git a/source/induce.f b/source/induce.f index 9385d0600..8c37f7c50 100644 --- a/source/induce.f +++ b/source/induce.f @@ -247,16 +247,14 @@ subroutine induce0a udir(j,i) = polarity(i) * field(j,i) udirp(j,i) = polarity(i) * fieldp(j,i) if (pcgguess) then - do k = 1, 3 - uind(j,i) = polarity(i) - & * (polinv(j,1,i)*field(1,i) - & + polinv(j,2,i)*field(2,i) - & + polinv(j,3,i)*field(3,i)) - uinp(j,i) = polarity(i) - & * (polinv(j,1,i)*fieldp(1,i) - & + polinv(j,2,i)*fieldp(2,i) - & + polinv(j,3,i)*fieldp(3,i)) - end do + uind(j,i) = polarity(i) + & *(polinv(j,1,i)*field(1,i) + & + polinv(j,2,i)*field(2,i) + & + polinv(j,3,i)*field(3,i)) + uinp(j,i) = polarity(i) + & *(polinv(j,1,i)*fieldp(1,i) + & + polinv(j,2,i)*fieldp(2,i) + & + polinv(j,3,i)*fieldp(3,i)) end if end do end if From 05b89f948509b03a7db58a83cb58782a253b859f Mon Sep 17 00:00:00 2001 From: Moses Date: Wed, 4 Mar 2026 23:27:12 -0600 Subject: [PATCH 26/29] call bounds in exfield to maintain PBC --- source/exfield.f | 17 +++++++++++++++++ 1 file changed, 17 insertions(+) diff --git a/source/exfield.f b/source/exfield.f index 8266ed667..42191ca88 100644 --- a/source/exfield.f +++ b/source/exfield.f @@ -18,6 +18,7 @@ c subroutine exfield (mode,exf) use atoms + use bound use charge use chgpot use energi @@ -37,6 +38,10 @@ subroutine exfield (mode,exf) exf = 0.0d0 f = electric / dielec c +c maintain any periodic boundary conditions +c + if (use_bounds) call bounds +c c calculate external field energy over partial charges c if (mode .eq. 'CHARGE') then @@ -101,6 +106,7 @@ subroutine exfield (mode,exf) c subroutine exfield1 (mode,exf) use atoms + use bound use charge use chgpot use deriv @@ -131,6 +137,11 @@ subroutine exfield1 (mode,exf) exf = 0.0d0 f = electric / dielec c +c maintain any periodic boundary conditions +c + if (use_bounds) call bounds +c +c c calculate energy and derivatives over partial charges c if (mode .eq. 'CHARGE') then @@ -283,6 +294,7 @@ subroutine exfield3 (mode,exf) use action use analyz use atoms + use bound use charge use chgpot use energi @@ -302,6 +314,11 @@ subroutine exfield3 (mode,exf) exf = 0.0d0 f = electric / dielec c +c maintain any periodic boundary conditions +c + if (use_bounds) call bounds +c +c c calculate energy and partitioning over partial charges c if (mode .eq. 'CHARGE') then From 236c08ca879953955d0903d00227eb019c79f3e9 Mon Sep 17 00:00:00 2001 From: Moses Date: Wed, 4 Mar 2026 23:38:24 -0600 Subject: [PATCH 27/29] call bounds in exfield to maintain PBC --- source/exfield.f | 15 +++++++++++++++ 1 file changed, 15 insertions(+) diff --git a/source/exfield.f b/source/exfield.f index f5a8e98fd..cf55ac0f3 100644 --- a/source/exfield.f +++ b/source/exfield.f @@ -18,6 +18,7 @@ c subroutine exfield (mode,exf) use atoms + use bound use charge use chgpot use energi @@ -37,6 +38,10 @@ subroutine exfield (mode,exf) exf = 0.0d0 f = electric / dielec c +c maintain any periodic boundary conditions +c + if (use_bounds) call bounds +c c calculate external field energy over partial charges c if (mode .eq. 'CHARGE') then @@ -101,6 +106,7 @@ subroutine exfield (mode,exf) c subroutine exfield1 (mode,exf) use atoms + use bound use charge use chgpot use deriv @@ -131,6 +137,10 @@ subroutine exfield1 (mode,exf) exf = 0.0d0 f = electric / dielec c +c maintain any periodic boundary conditions +c + if (use_bounds) call bounds +c c calculate energy and derivatives over partial charges c if (mode .eq. 'CHARGE') then @@ -283,6 +293,7 @@ subroutine exfield3 (mode,exf) use action use analyz use atoms + use bound use charge use chgpot use energi @@ -302,6 +313,10 @@ subroutine exfield3 (mode,exf) exf = 0.0d0 f = electric / dielec c +c maintain any periodic boundary conditions +c + if (use_bounds) call bounds +c c calculate energy and partitioning over partial charges c if (mode .eq. 'CHARGE') then From decfc397e62eacc037bae74ad3eab7d963899022 Mon Sep 17 00:00:00 2001 From: Moses Date: Fri, 6 Mar 2026 17:17:35 -0600 Subject: [PATCH 28/29] Unify prt routines --- cmake/CMakeLists.txt | 4 +- interface/CMakeLists.txt | 3 - interface/c/tinker/detail/boxes.hh | 3 + interface/c/tinker/detail/output.hh | 1 + interface/c/tinker/detail/polar.hh | 1 - interface/c/tinker/routines.h | 52 +- interface/cpp/tinker/detail/boxes.hh | 9 + interface/cpp/tinker/detail/output.hh | 3 + interface/cpp/tinker/detail/polar.hh | 3 - interface/cpp/tinker/routines.h | 52 +- linux/gfortran/compile.make | 3 - linux/gfortran/debug.make | 3 - linux/gfortran/generic.make | 3 - linux/gfortran/library.make | 3 - linux/intel/compile.make | 3 - linux/intel/compserial.make | 3 - linux/intel/debug.make | 3 - linux/intel/generic.make | 3 - linux/intel/library.make | 3 - macos/gfortran/compile.make | 3 - macos/gfortran/debug.make | 3 - macos/gfortran/library.make | 3 - macos/intel/compile.make | 3 - macos/intel/compprof.make | 3 - macos/intel/compserial.make | 3 - macos/intel/debug.make | 3 - macos/intel/library.make | 3 - make/Makefile | 9 - make/Makefile-apbs | 9 - make/Makefile-ffe-linux | 9 - make/Makefile-ffe-macos | 9 - make/Makefile-ffe-windows | 9 - make/depend.make | 3 - openmm/Makefile | 9 - source/active.f | 2 + source/boxes.f | 4 + source/center.f | 33 +- source/dynamic.f | 4 +- source/final.f | 7 +- source/mdinit.f | 3 - source/mdsave.f | 44 +- source/output.f | 2 + source/polar.f | 2 - source/prtfrc.f | 264 ---- source/prtuind.f | 1723 ------------------------- source/prtvel.f | 264 ---- source/prtxyz.f | 430 ++++++ windows/cygwin/compile.make | 3 - windows/cygwin/library.make | 3 - windows/intel/compile.bat | 3 - windows/intel/generic.bat | 3 - windows/intel/library.lbc | 3 - 52 files changed, 531 insertions(+), 2505 deletions(-) delete mode 100644 source/prtfrc.f delete mode 100644 source/prtuind.f delete mode 100644 source/prtvel.f diff --git a/cmake/CMakeLists.txt b/cmake/CMakeLists.txt index c44b32399..604e93b32 100644 --- a/cmake/CMakeLists.txt +++ b/cmake/CMakeLists.txt @@ -143,8 +143,8 @@ set(_FILES optinit optsave orbital orbits orient orthog output overlap params paths pbstuf pdb phipsi picalc piorbs pistuf pitors pme pmestuf pmpb polar polgrp polopt polpcg polpot poltcg polymer potent - potfit predict pressure prmkey promo prtarc prtdyn prterr prtfrc - prtint prtmol2 prtpdb prtprm prtseq prtuind prtvel prtxyz ptable + potfit predict pressure prmkey promo prtarc prtdyn prterr + prtint prtmol2 prtpdb prtprm prtseq prtxyz ptable qmstuf qrsolve quatfit random rattle readcart readdcd readdyn readgau readgdma readint readmol readmol2 readpdb readprm readseq readxyz refer repel replica reppot resdue respa restrn rgddyn diff --git a/interface/CMakeLists.txt b/interface/CMakeLists.txt index 0d8082e17..7315b8080 100644 --- a/interface/CMakeLists.txt +++ b/interface/CMakeLists.txt @@ -472,14 +472,11 @@ add_library (tinkerObjF OBJECT ../source/prtarc.f ../source/prtdyn.f ../source/prterr.f -../source/prtfrc.f ../source/prtint.f ../source/prtmol2.f ../source/prtpdb.f ../source/prtprm.f ../source/prtseq.f -../source/prtuind.f -../source/prtvel.f ../source/prtxyz.f ../source/qrsolve.f ../source/quatfit.f diff --git a/interface/c/tinker/detail/boxes.hh b/interface/c/tinker/detail/boxes.hh index b5de41ea5..b59e1acde 100644 --- a/interface/c/tinker/detail/boxes.hh +++ b/interface/c/tinker/detail/boxes.hh @@ -24,6 +24,9 @@ extern double TINKER_MOD(boxes, gamma_sin); extern double TINKER_MOD(boxes, gamma_cos); extern double TINKER_MOD(boxes, beta_term); extern double TINKER_MOD(boxes, gamma_term); +extern double TINKER_MOD(boxes, xcenter); +extern double TINKER_MOD(boxes, ycenter); +extern double TINKER_MOD(boxes, zcenter); extern double TINKER_MOD(boxes, lvec)[3][3]; extern double TINKER_MOD(boxes, recip)[3][3]; extern int TINKER_MOD(boxes, orthogonal); diff --git a/interface/c/tinker/detail/output.hh b/interface/c/tinker/detail/output.hh index cc36ef567..f526c69bc 100644 --- a/interface/c/tinker/detail/output.hh +++ b/interface/c/tinker/detail/output.hh @@ -8,6 +8,7 @@ extern "C" { extern int TINKER_MOD(output, nonly); extern int* TINKER_MOD(output, ionly); extern int* TINKER_MOD(output, ionlyinv); +extern double* TINKER_MOD(output, print3n); extern int TINKER_MOD(output, archive); extern int TINKER_MOD(output, binary); extern int TINKER_MOD(output, noversion); diff --git a/interface/c/tinker/detail/polar.hh b/interface/c/tinker/detail/polar.hh index 29ab85e5f..17443bcad 100644 --- a/interface/c/tinker/detail/polar.hh +++ b/interface/c/tinker/detail/polar.hh @@ -23,7 +23,6 @@ extern double* TINKER_MOD(polar, uinp); extern double* TINKER_MOD(polar, uinds); extern double* TINKER_MOD(polar, uinps); extern double* TINKER_MOD(polar, uexact); -extern double* TINKER_MOD(polar, worker3n); extern int* TINKER_MOD(polar, douind); #ifdef __cplusplus } diff --git a/interface/c/tinker/routines.h b/interface/c/tinker/routines.h index 8c6d3ca9d..61fb393e2 100644 --- a/interface/c/tinker/routines.h +++ b/interface/c/tinker/routines.h @@ -114,7 +114,7 @@ void calendar_(int* year, int* month, int* day, int* hour, int* minute, int* sec // center.f void center_(int* n1, double* x1, double* y1, double* z1, int* n2, double* x2, double* y2, double* z2, double* xmid, double* ymid, double* zmid); #define tinker_f_center center_ -void compcent_(double* xmid, double* ymid, double* zmid); +void compcent_(double* xcm, double* ycm, double* zcm); #define tinker_f_compcent compcent_ // chkpole.f @@ -2211,12 +2211,6 @@ void prtdyn_(); void prterr_(); #define tinker_f_prterr prterr_ -// prtfrc.f -void prtfrc_(int* ifrc); -#define tinker_f_prtfrc prtfrc_ -void prtdcdf_(int* idcd, int* first); -#define tinker_f_prtdcdf prtdcdf_ - // prtint.f void prtint_(int* izmt); #define tinker_f_prtint prtint_ @@ -2241,43 +2235,23 @@ void prtprm_(int* itxt); void prtseq_(int* iseq); #define tinker_f_prtseq prtseq_ -// prtuind.f -void prtuind_(int* iind); -#define tinker_f_prtuind prtuind_ -void prtdcdui_(int* idcd, int* first); -#define tinker_f_prtdcdui prtdcdui_ -void prtustc_(int* istc, double* xm, double* ym, double* zm); -#define tinker_f_prtustc prtustc_ -void prtdcdus_(int* idcd, int* first, double* xm, double* ym, double* zm); -#define tinker_f_prtdcdus prtdcdus_ -void prtuchg_(int* istc, double* xm, double* ym, double* zm); -#define tinker_f_prtuchg prtuchg_ -void prtdcduc_(int* idcd, int* first, double* xm, double* ym, double* zm); -#define tinker_f_prtdcduc prtdcduc_ -void prtudir_(int* iind); -#define tinker_f_prtudir prtudir_ -void prtdcdud_(int* idcd, int* first); -#define tinker_f_prtdcdud prtdcdud_ -void prtdef_(int* iind); -#define tinker_f_prtdef prtdef_ -void prtdcdde_(int* idcd, int* first); -#define tinker_f_prtdcdde prtdcdde_ -void prttef_(int* iind); -#define tinker_f_prttef prttef_ -void prtdcdte_(int* idcd, int* first); -#define tinker_f_prtdcdte prtdcdte_ - -// prtvel.f -void prtvel_(int* ivel); -#define tinker_f_prtvel prtvel_ -void prtdcdv_(int* idcd, int* first); -#define tinker_f_prtdcdv prtdcdv_ - // prtxyz.f void prtxyz_(int* ixyz); #define tinker_f_prtxyz prtxyz_ +void prtvec3_(int* iunit, char* mode, tinker_fchar_len_t mode_cap); +inline void tinker_f_prtvec3(int* iunit, tinker_fchars mode) { + return prtvec3_(iunit, mode.string, mode.capacity); +} +void copyvec3_(double* print3n, char* mode, tinker_fchar_len_t mode_cap); +inline void tinker_f_copyvec3(double* print3n, tinker_fchars mode) { + return copyvec3_(print3n, mode.string, mode.capacity); +} void prtdcd_(int* idcd, int* first); #define tinker_f_prtdcd prtdcd_ +void prtdcdv3_(int* idcd, int* first, char* mode, tinker_fchar_len_t mode_cap); +inline void tinker_f_prtdcdv3(int* idcd, int* first, tinker_fchars mode) { + return prtdcdv3_(idcd, first, mode.string, mode.capacity); +} // qrsolve.f void qrfact_(int* n, int* m, double* a, int* pivot, int* ipvt, double* rdiag); diff --git a/interface/cpp/tinker/detail/boxes.hh b/interface/cpp/tinker/detail/boxes.hh index 23b5283fc..ad013fbae 100644 --- a/interface/cpp/tinker/detail/boxes.hh +++ b/interface/cpp/tinker/detail/boxes.hh @@ -22,6 +22,9 @@ extern double& gamma_sin; extern double& gamma_cos; extern double& beta_term; extern double& gamma_term; +extern double& xcenter; +extern double& ycenter; +extern double& zcenter; extern double (&lvec)[3][3]; extern double (&recip)[3][3]; extern int& orthogonal; @@ -53,6 +56,9 @@ extern "C" double TINKER_MOD(boxes, gamma_sin); extern "C" double TINKER_MOD(boxes, gamma_cos); extern "C" double TINKER_MOD(boxes, beta_term); extern "C" double TINKER_MOD(boxes, gamma_term); +extern "C" double TINKER_MOD(boxes, xcenter); +extern "C" double TINKER_MOD(boxes, ycenter); +extern "C" double TINKER_MOD(boxes, zcenter); extern "C" double TINKER_MOD(boxes, lvec)[3][3]; extern "C" double TINKER_MOD(boxes, recip)[3][3]; extern "C" int TINKER_MOD(boxes, orthogonal); @@ -83,6 +89,9 @@ double& gamma_sin = TINKER_MOD(boxes, gamma_sin); double& gamma_cos = TINKER_MOD(boxes, gamma_cos); double& beta_term = TINKER_MOD(boxes, beta_term); double& gamma_term = TINKER_MOD(boxes, gamma_term); +double& xcenter = TINKER_MOD(boxes, xcenter); +double& ycenter = TINKER_MOD(boxes, ycenter); +double& zcenter = TINKER_MOD(boxes, zcenter); double (&lvec)[3][3] = TINKER_MOD(boxes, lvec); double (&recip)[3][3] = TINKER_MOD(boxes, recip); int& orthogonal = TINKER_MOD(boxes, orthogonal); diff --git a/interface/cpp/tinker/detail/output.hh b/interface/cpp/tinker/detail/output.hh index 14e55f96c..4b962e389 100644 --- a/interface/cpp/tinker/detail/output.hh +++ b/interface/cpp/tinker/detail/output.hh @@ -6,6 +6,7 @@ namespace tinker { namespace output { extern int& nonly; extern int*& ionly; extern int*& ionlyinv; +extern double*& print3n; extern int& archive; extern int& binary; extern int& noversion; @@ -32,6 +33,7 @@ extern char (&coordtype)[9]; extern "C" int TINKER_MOD(output, nonly); extern "C" int* TINKER_MOD(output, ionly); extern "C" int* TINKER_MOD(output, ionlyinv); +extern "C" double* TINKER_MOD(output, print3n); extern "C" int TINKER_MOD(output, archive); extern "C" int TINKER_MOD(output, binary); extern "C" int TINKER_MOD(output, noversion); @@ -57,6 +59,7 @@ extern "C" char TINKER_MOD(output, coordtype)[9]; int& nonly = TINKER_MOD(output, nonly); int*& ionly = TINKER_MOD(output, ionly); int*& ionlyinv = TINKER_MOD(output, ionlyinv); +double*& print3n = TINKER_MOD(output, print3n); int& archive = TINKER_MOD(output, archive); int& binary = TINKER_MOD(output, binary); int& noversion = TINKER_MOD(output, noversion); diff --git a/interface/cpp/tinker/detail/polar.hh b/interface/cpp/tinker/detail/polar.hh index ad0675a25..0a175cff9 100644 --- a/interface/cpp/tinker/detail/polar.hh +++ b/interface/cpp/tinker/detail/polar.hh @@ -21,7 +21,6 @@ extern double*& uinp; extern double*& uinds; extern double*& uinps; extern double*& uexact; -extern double*& worker3n; extern int*& douind; #ifdef TINKER_FORTRAN_MODULE_CPP @@ -43,7 +42,6 @@ extern "C" double* TINKER_MOD(polar, uinp); extern "C" double* TINKER_MOD(polar, uinds); extern "C" double* TINKER_MOD(polar, uinps); extern "C" double* TINKER_MOD(polar, uexact); -extern "C" double* TINKER_MOD(polar, worker3n); extern "C" int* TINKER_MOD(polar, douind); int& npolar = TINKER_MOD(polar, npolar); @@ -64,7 +62,6 @@ double*& uinp = TINKER_MOD(polar, uinp); double*& uinds = TINKER_MOD(polar, uinds); double*& uinps = TINKER_MOD(polar, uinps); double*& uexact = TINKER_MOD(polar, uexact); -double*& worker3n = TINKER_MOD(polar, worker3n); int*& douind = TINKER_MOD(polar, douind); #endif } } diff --git a/interface/cpp/tinker/routines.h b/interface/cpp/tinker/routines.h index 8c6d3ca9d..61fb393e2 100644 --- a/interface/cpp/tinker/routines.h +++ b/interface/cpp/tinker/routines.h @@ -114,7 +114,7 @@ void calendar_(int* year, int* month, int* day, int* hour, int* minute, int* sec // center.f void center_(int* n1, double* x1, double* y1, double* z1, int* n2, double* x2, double* y2, double* z2, double* xmid, double* ymid, double* zmid); #define tinker_f_center center_ -void compcent_(double* xmid, double* ymid, double* zmid); +void compcent_(double* xcm, double* ycm, double* zcm); #define tinker_f_compcent compcent_ // chkpole.f @@ -2211,12 +2211,6 @@ void prtdyn_(); void prterr_(); #define tinker_f_prterr prterr_ -// prtfrc.f -void prtfrc_(int* ifrc); -#define tinker_f_prtfrc prtfrc_ -void prtdcdf_(int* idcd, int* first); -#define tinker_f_prtdcdf prtdcdf_ - // prtint.f void prtint_(int* izmt); #define tinker_f_prtint prtint_ @@ -2241,43 +2235,23 @@ void prtprm_(int* itxt); void prtseq_(int* iseq); #define tinker_f_prtseq prtseq_ -// prtuind.f -void prtuind_(int* iind); -#define tinker_f_prtuind prtuind_ -void prtdcdui_(int* idcd, int* first); -#define tinker_f_prtdcdui prtdcdui_ -void prtustc_(int* istc, double* xm, double* ym, double* zm); -#define tinker_f_prtustc prtustc_ -void prtdcdus_(int* idcd, int* first, double* xm, double* ym, double* zm); -#define tinker_f_prtdcdus prtdcdus_ -void prtuchg_(int* istc, double* xm, double* ym, double* zm); -#define tinker_f_prtuchg prtuchg_ -void prtdcduc_(int* idcd, int* first, double* xm, double* ym, double* zm); -#define tinker_f_prtdcduc prtdcduc_ -void prtudir_(int* iind); -#define tinker_f_prtudir prtudir_ -void prtdcdud_(int* idcd, int* first); -#define tinker_f_prtdcdud prtdcdud_ -void prtdef_(int* iind); -#define tinker_f_prtdef prtdef_ -void prtdcdde_(int* idcd, int* first); -#define tinker_f_prtdcdde prtdcdde_ -void prttef_(int* iind); -#define tinker_f_prttef prttef_ -void prtdcdte_(int* idcd, int* first); -#define tinker_f_prtdcdte prtdcdte_ - -// prtvel.f -void prtvel_(int* ivel); -#define tinker_f_prtvel prtvel_ -void prtdcdv_(int* idcd, int* first); -#define tinker_f_prtdcdv prtdcdv_ - // prtxyz.f void prtxyz_(int* ixyz); #define tinker_f_prtxyz prtxyz_ +void prtvec3_(int* iunit, char* mode, tinker_fchar_len_t mode_cap); +inline void tinker_f_prtvec3(int* iunit, tinker_fchars mode) { + return prtvec3_(iunit, mode.string, mode.capacity); +} +void copyvec3_(double* print3n, char* mode, tinker_fchar_len_t mode_cap); +inline void tinker_f_copyvec3(double* print3n, tinker_fchars mode) { + return copyvec3_(print3n, mode.string, mode.capacity); +} void prtdcd_(int* idcd, int* first); #define tinker_f_prtdcd prtdcd_ +void prtdcdv3_(int* idcd, int* first, char* mode, tinker_fchar_len_t mode_cap); +inline void tinker_f_prtdcdv3(int* idcd, int* first, tinker_fchars mode) { + return prtdcdv3_(idcd, first, mode.string, mode.capacity); +} // qrsolve.f void qrfact_(int* n, int* m, double* a, int* pivot, int* ipvt, double* rdiag); diff --git a/linux/gfortran/compile.make b/linux/gfortran/compile.make index 031be6c49..192ba83cd 100755 --- a/linux/gfortran/compile.make +++ b/linux/gfortran/compile.make @@ -516,14 +516,11 @@ gfortran -c -Ofast -mavx -fopenmp protein.f gfortran -c -Ofast -mavx -fopenmp prtarc.f gfortran -c -Ofast -mavx -fopenmp prtdyn.f gfortran -c -Ofast -mavx -fopenmp prterr.f -gfortran -c -Ofast -mavx -fopenmp prtfrc.f gfortran -c -Ofast -mavx -fopenmp prtint.f gfortran -c -Ofast -mavx -fopenmp prtmol2.f gfortran -c -Ofast -mavx -fopenmp prtpdb.f gfortran -c -Ofast -mavx -fopenmp prtprm.f gfortran -c -Ofast -mavx -fopenmp prtseq.f -gfortran -c -Ofast -mavx -fopenmp prtuind.f -gfortran -c -Ofast -mavx -fopenmp prtvel.f gfortran -c -Ofast -mavx -fopenmp prtxyz.f gfortran -c -Ofast -mavx -fopenmp pss.f gfortran -c -Ofast -mavx -fopenmp pssrigid.f diff --git a/linux/gfortran/debug.make b/linux/gfortran/debug.make index a21c0c7a0..80f43d2bf 100755 --- a/linux/gfortran/debug.make +++ b/linux/gfortran/debug.make @@ -516,14 +516,11 @@ gfortran -c -Wall protein.f gfortran -c -Wall prtarc.f gfortran -c -Wall prtdyn.f gfortran -c -Wall prterr.f -gfortran -c -Wall prtfrc.f gfortran -c -Wall prtint.f gfortran -c -Wall prtmol2.f gfortran -c -Wall prtpdb.f gfortran -c -Wall prtprm.f gfortran -c -Wall prtseq.f -gfortran -c -Wall prtuind.f -gfortran -c -Wall prtvel.f gfortran -c -Wall prtxyz.f gfortran -c -Wall pss.f gfortran -c -Wall pssrigid.f diff --git a/linux/gfortran/generic.make b/linux/gfortran/generic.make index c3626c12f..06b2be360 100755 --- a/linux/gfortran/generic.make +++ b/linux/gfortran/generic.make @@ -516,14 +516,11 @@ gfortran -c -Ofast -msse3 -fopenmp protein.f gfortran -c -Ofast -msse3 -fopenmp prtarc.f gfortran -c -Ofast -msse3 -fopenmp prtdyn.f gfortran -c -Ofast -msse3 -fopenmp prterr.f -gfortran -c -Ofast -msse3 -fopenmp prtfrc.f gfortran -c -Ofast -msse3 -fopenmp prtint.f gfortran -c -Ofast -msse3 -fopenmp prtmol2.f gfortran -c -Ofast -msse3 -fopenmp prtpdb.f gfortran -c -Ofast -msse3 -fopenmp prtprm.f gfortran -c -Ofast -msse3 -fopenmp prtseq.f -gfortran -c -Ofast -msse3 -fopenmp prtuind.f -gfortran -c -Ofast -msse3 -fopenmp prtvel.f gfortran -c -Ofast -msse3 -fopenmp prtxyz.f gfortran -c -Ofast -msse3 -fopenmp pss.f gfortran -c -Ofast -msse3 -fopenmp pssrigid.f diff --git a/linux/gfortran/library.make b/linux/gfortran/library.make index 8775637e1..cdc548364 100755 --- a/linux/gfortran/library.make +++ b/linux/gfortran/library.make @@ -431,14 +431,11 @@ promo.o \ prtarc.o \ prtdyn.o \ prterr.o \ -prtfrc.o \ prtint.o \ prtmol2.o \ prtpdb.o \ prtprm.o \ prtseq.o \ -prtuind.o \ -prtvel.o \ prtxyz.o \ ptable.o \ qmstuf.o \ diff --git a/linux/intel/compile.make b/linux/intel/compile.make index 1fe725d54..0fbe27f01 100755 --- a/linux/intel/compile.make +++ b/linux/intel/compile.make @@ -516,14 +516,11 @@ ifort -c -O3 -xHost -no-ipo -no-prec-div -openmp protein.f ifort -c -O3 -xHost -no-ipo -no-prec-div -openmp prtarc.f ifort -c -O3 -xHost -no-ipo -no-prec-div -openmp prtdyn.f ifort -c -O3 -xHost -no-ipo -no-prec-div -openmp prterr.f -ifort -c -O3 -xHost -no-ipo -no-prec-div -openmp prtfrc.f ifort -c -O3 -xHost -no-ipo -no-prec-div -openmp prtint.f ifort -c -O3 -xHost -no-ipo -no-prec-div -openmp prtmol2.f ifort -c -O3 -xHost -no-ipo -no-prec-div -openmp prtpdb.f ifort -c -O3 -xHost -no-ipo -no-prec-div -openmp prtprm.f ifort -c -O3 -xHost -no-ipo -no-prec-div -openmp prtseq.f -ifort -c -O3 -xHost -no-ipo -no-prec-div -openmp prtuind.f -ifort -c -O3 -xHost -no-ipo -no-prec-div -openmp prtvel.f ifort -c -O3 -xHost -no-ipo -no-prec-div -openmp prtxyz.f ifort -c -O3 -xHost -no-ipo -no-prec-div -openmp pss.f ifort -c -O3 -xHost -no-ipo -no-prec-div -openmp pssrigid.f diff --git a/linux/intel/compserial.make b/linux/intel/compserial.make index e6fed89ae..5a3166ca2 100755 --- a/linux/intel/compserial.make +++ b/linux/intel/compserial.make @@ -516,14 +516,11 @@ ifort -c -O3 -axSSSE3 -no-ipo -no-prec-div -vec-report0 protein.f ifort -c -O3 -axSSSE3 -no-ipo -no-prec-div -vec-report0 prtarc.f ifort -c -O3 -axSSSE3 -no-ipo -no-prec-div -vec-report0 prtdyn.f ifort -c -O3 -axSSSE3 -no-ipo -no-prec-div -vec-report0 prterr.f -ifort -c -O3 -axSSSE3 -no-ipo -no-prec-div -vec-report0 prtfrc.f ifort -c -O3 -axSSSE3 -no-ipo -no-prec-div -vec-report0 prtint.f ifort -c -O3 -axSSSE3 -no-ipo -no-prec-div -vec-report0 prtmol2.f ifort -c -O3 -axSSSE3 -no-ipo -no-prec-div -vec-report0 prtpdb.f ifort -c -O3 -axSSSE3 -no-ipo -no-prec-div -vec-report0 prtprm.f ifort -c -O3 -axSSSE3 -no-ipo -no-prec-div -vec-report0 prtseq.f -ifort -c -O3 -axSSSE3 -no-ipo -no-prec-div -vec-report0 prtuind.f -ifort -c -O3 -axSSSE3 -no-ipo -no-prec-div -vec-report0 prtvel.f ifort -c -O3 -axSSSE3 -no-ipo -no-prec-div -vec-report0 prtxyz.f ifort -c -O3 -axSSSE3 -no-ipo -no-prec-div -vec-report0 pss.f ifort -c -O3 -axSSSE3 -no-ipo -no-prec-div -vec-report0 pssrigid.f diff --git a/linux/intel/debug.make b/linux/intel/debug.make index 5e5f697d7..26fe5093c 100755 --- a/linux/intel/debug.make +++ b/linux/intel/debug.make @@ -516,14 +516,11 @@ ifort -c -g -warn all -check all protein.f ifort -c -g -warn all -check all prtarc.f ifort -c -g -warn all -check all prtdyn.f ifort -c -g -warn all -check all prterr.f -ifort -c -g -warn all -check all prtfrc.f ifort -c -g -warn all -check all prtint.f ifort -c -g -warn all -check all prtmol2.f ifort -c -g -warn all -check all prtpdb.f ifort -c -g -warn all -check all prtprm.f ifort -c -g -warn all -check all prtseq.f -ifort -c -g -warn all -check all prtuind.f -ifort -c -g -warn all -check all prtvel.f ifort -c -g -warn all -check all prtxyz.f ifort -c -g -warn all -check all pss.f ifort -c -g -warn all -check all pssrigid.f diff --git a/linux/intel/generic.make b/linux/intel/generic.make index c7b11f79c..ab7ea36fd 100755 --- a/linux/intel/generic.make +++ b/linux/intel/generic.make @@ -516,14 +516,11 @@ ifort -c -O3 -msse3 -no-ipo -no-prec-div -openmp protein.f ifort -c -O3 -msse3 -no-ipo -no-prec-div -openmp prtarc.f ifort -c -O3 -msse3 -no-ipo -no-prec-div -openmp prtdyn.f ifort -c -O3 -msse3 -no-ipo -no-prec-div -openmp prterr.f -ifort -c -O3 -msse3 -no-ipo -no-prec-div -openmp prtfrc.f ifort -c -O3 -msse3 -no-ipo -no-prec-div -openmp prtint.f ifort -c -O3 -msse3 -no-ipo -no-prec-div -openmp prtmol2.f ifort -c -O3 -msse3 -no-ipo -no-prec-div -openmp prtpdb.f ifort -c -O3 -msse3 -no-ipo -no-prec-div -openmp prtprm.f ifort -c -O3 -msse3 -no-ipo -no-prec-div -openmp prtseq.f -ifort -c -O3 -msse3 -no-ipo -no-prec-div -openmp prtuind.f -ifort -c -O3 -msse3 -no-ipo -no-prec-div -openmp prtvel.f ifort -c -O3 -msse3 -no-ipo -no-prec-div -openmp prtxyz.f ifort -c -O3 -msse3 -no-ipo -no-prec-div -openmp pss.f ifort -c -O3 -msse3 -no-ipo -no-prec-div -openmp pssrigid.f diff --git a/linux/intel/library.make b/linux/intel/library.make index 080e034d1..fa624c9e0 100755 --- a/linux/intel/library.make +++ b/linux/intel/library.make @@ -431,14 +431,11 @@ promo.o \ prtarc.o \ prtdyn.o \ prterr.o \ -prtfrc.o \ prtint.o \ prtmol2.o \ prtpdb.o \ prtprm.o \ prtseq.o \ -prtuind.o \ -prtvel.o \ prtxyz.o \ ptable.o \ qmstuf.o \ diff --git a/macos/gfortran/compile.make b/macos/gfortran/compile.make index f418447f2..4c9bdd536 100755 --- a/macos/gfortran/compile.make +++ b/macos/gfortran/compile.make @@ -516,14 +516,11 @@ gfortran -c -Ofast -mssse3 -fopenmp protein.f gfortran -c -Ofast -mssse3 -fopenmp prtarc.f gfortran -c -Ofast -mssse3 -fopenmp prtdyn.f gfortran -c -Ofast -mssse3 -fopenmp prterr.f -gfortran -c -Ofast -mssse3 -fopenmp prtfrc.f gfortran -c -Ofast -mssse3 -fopenmp prtint.f gfortran -c -Ofast -mssse3 -fopenmp prtmol2.f gfortran -c -Ofast -mssse3 -fopenmp prtpdb.f gfortran -c -Ofast -mssse3 -fopenmp prtprm.f gfortran -c -Ofast -mssse3 -fopenmp prtseq.f -gfortran -c -Ofast -mssse3 -fopenmp prtuind.f -gfortran -c -Ofast -mssse3 -fopenmp prtvel.f gfortran -c -Ofast -mssse3 -fopenmp prtxyz.f gfortran -c -Ofast -mssse3 -fopenmp pss.f gfortran -c -Ofast -mssse3 -fopenmp pssrigid.f diff --git a/macos/gfortran/debug.make b/macos/gfortran/debug.make index c2af0946c..d620af310 100755 --- a/macos/gfortran/debug.make +++ b/macos/gfortran/debug.make @@ -516,14 +516,11 @@ gfortran -c -Og -g -fbacktrace -fcheck=bounds -Wunused -Wmaybe-uninitialized pro gfortran -c -Og -g -fbacktrace -fcheck=bounds -Wunused -Wmaybe-uninitialized prtarc.f gfortran -c -Og -g -fbacktrace -fcheck=bounds -Wunused -Wmaybe-uninitialized prtdyn.f gfortran -c -Og -g -fbacktrace -fcheck=bounds -Wunused -Wmaybe-uninitialized prterr.f -gfortran -c -Og -g -fbacktrace -fcheck=bounds -Wunused -Wmaybe-uninitialized prtfrc.f gfortran -c -Og -g -fbacktrace -fcheck=bounds -Wunused -Wmaybe-uninitialized prtint.f gfortran -c -Og -g -fbacktrace -fcheck=bounds -Wunused -Wmaybe-uninitialized prtmol2.f gfortran -c -Og -g -fbacktrace -fcheck=bounds -Wunused -Wmaybe-uninitialized prtpdb.f gfortran -c -Og -g -fbacktrace -fcheck=bounds -Wunused -Wmaybe-uninitialized prtprm.f gfortran -c -Og -g -fbacktrace -fcheck=bounds -Wunused -Wmaybe-uninitialized prtseq.f -gfortran -c -Og -g -fbacktrace -fcheck=bounds -Wunused -Wmaybe-uninitialized prtuind.f -gfortran -c -Og -g -fbacktrace -fcheck=bounds -Wunused -Wmaybe-uninitialized prtvel.f gfortran -c -Og -g -fbacktrace -fcheck=bounds -Wunused -Wmaybe-uninitialized prtxyz.f gfortran -c -Og -g -fbacktrace -fcheck=bounds -Wunused -Wmaybe-uninitialized pss.f gfortran -c -Og -g -fbacktrace -fcheck=bounds -Wunused -Wmaybe-uninitialized pssrigid.f diff --git a/macos/gfortran/library.make b/macos/gfortran/library.make index 3b63e9543..3eb2384a8 100755 --- a/macos/gfortran/library.make +++ b/macos/gfortran/library.make @@ -431,14 +431,11 @@ promo.o \ prtarc.o \ prtdyn.o \ prterr.o \ -prtfrc.o \ prtint.o \ prtmol2.o \ prtpdb.o \ prtprm.o \ prtseq.o \ -prtuind.o \ -prtvel.o \ prtxyz.o \ ptable.o \ qmstuf.o \ diff --git a/macos/intel/compile.make b/macos/intel/compile.make index 3fc5e9272..f911fdbea 100755 --- a/macos/intel/compile.make +++ b/macos/intel/compile.make @@ -516,14 +516,11 @@ ifort -c -O3 -axSSSE3 -no-ipo -no-prec-div -inline -mdynamic-no-pic -w -qopenmp ifort -c -O3 -axSSSE3 -no-ipo -no-prec-div -inline -mdynamic-no-pic -w -qopenmp prtarc.f ifort -c -O3 -axSSSE3 -no-ipo -no-prec-div -inline -mdynamic-no-pic -w -qopenmp prtdyn.f ifort -c -O3 -axSSSE3 -no-ipo -no-prec-div -inline -mdynamic-no-pic -w -qopenmp prterr.f -ifort -c -O3 -axSSSE3 -no-ipo -no-prec-div -inline -mdynamic-no-pic -w -qopenmp prtfrc.f ifort -c -O3 -axSSSE3 -no-ipo -no-prec-div -inline -mdynamic-no-pic -w -qopenmp prtint.f ifort -c -O3 -axSSSE3 -no-ipo -no-prec-div -inline -mdynamic-no-pic -w -qopenmp prtmol2.f ifort -c -O3 -axSSSE3 -no-ipo -no-prec-div -inline -mdynamic-no-pic -w -qopenmp prtpdb.f ifort -c -O3 -axSSSE3 -no-ipo -no-prec-div -inline -mdynamic-no-pic -w -qopenmp prtprm.f ifort -c -O3 -axSSSE3 -no-ipo -no-prec-div -inline -mdynamic-no-pic -w -qopenmp prtseq.f -ifort -c -O3 -axSSSE3 -no-ipo -no-prec-div -inline -mdynamic-no-pic -w -qopenmp prtuind.f -ifort -c -O3 -axSSSE3 -no-ipo -no-prec-div -inline -mdynamic-no-pic -w -qopenmp prtvel.f ifort -c -O3 -axSSSE3 -no-ipo -no-prec-div -inline -mdynamic-no-pic -w -qopenmp prtxyz.f ifort -c -O3 -axSSSE3 -no-ipo -no-prec-div -inline -mdynamic-no-pic -w -qopenmp pss.f ifort -c -O3 -axSSSE3 -no-ipo -no-prec-div -inline -mdynamic-no-pic -w -qopenmp pssrigid.f diff --git a/macos/intel/compprof.make b/macos/intel/compprof.make index 49fd717e4..1530ba615 100755 --- a/macos/intel/compprof.make +++ b/macos/intel/compprof.make @@ -516,14 +516,11 @@ ifort -c -O3 -g -axSSSE3 -no-ipo -no-prec-div -mdynamic-no-pic -w -qopenmp prote ifort -c -O3 -g -axSSSE3 -no-ipo -no-prec-div -mdynamic-no-pic -w -qopenmp prtarc.f ifort -c -O3 -g -axSSSE3 -no-ipo -no-prec-div -mdynamic-no-pic -w -qopenmp prtdyn.f ifort -c -O3 -g -axSSSE3 -no-ipo -no-prec-div -mdynamic-no-pic -w -qopenmp prterr.f -ifort -c -O3 -g -axSSSE3 -no-ipo -no-prec-div -mdynamic-no-pic -w -qopenmp prtfrc.f ifort -c -O3 -g -axSSSE3 -no-ipo -no-prec-div -mdynamic-no-pic -w -qopenmp prtint.f ifort -c -O3 -g -axSSSE3 -no-ipo -no-prec-div -mdynamic-no-pic -w -qopenmp prtmol2.f ifort -c -O3 -g -axSSSE3 -no-ipo -no-prec-div -mdynamic-no-pic -w -qopenmp prtpdb.f ifort -c -O3 -g -axSSSE3 -no-ipo -no-prec-div -mdynamic-no-pic -w -qopenmp prtprm.f ifort -c -O3 -g -axSSSE3 -no-ipo -no-prec-div -mdynamic-no-pic -w -qopenmp prtseq.f -ifort -c -O3 -g -axSSSE3 -no-ipo -no-prec-div -mdynamic-no-pic -w -qopenmp prtuind.f -ifort -c -O3 -g -axSSSE3 -no-ipo -no-prec-div -mdynamic-no-pic -w -qopenmp prtvel.f ifort -c -O3 -g -axSSSE3 -no-ipo -no-prec-div -mdynamic-no-pic -w -qopenmp prtxyz.f ifort -c -O3 -g -axSSSE3 -no-ipo -no-prec-div -mdynamic-no-pic -w -qopenmp pss.f ifort -c -O3 -g -axSSSE3 -no-ipo -no-prec-div -mdynamic-no-pic -w -qopenmp pssrigid.f diff --git a/macos/intel/compserial.make b/macos/intel/compserial.make index 9f6145e67..dea4b7c02 100755 --- a/macos/intel/compserial.make +++ b/macos/intel/compserial.make @@ -516,14 +516,11 @@ ifort -c -O3 -axSSSE3 -no-ipo -no-prec-div -mdynamic-no-pic -w -vec-report0 prot ifort -c -O3 -axSSSE3 -no-ipo -no-prec-div -mdynamic-no-pic -w -vec-report0 prtarc.f ifort -c -O3 -axSSSE3 -no-ipo -no-prec-div -mdynamic-no-pic -w -vec-report0 prtdyn.f ifort -c -O3 -axSSSE3 -no-ipo -no-prec-div -mdynamic-no-pic -w -vec-report0 prterr.f -ifort -c -O3 -axSSSE3 -no-ipo -no-prec-div -mdynamic-no-pic -w -vec-report0 prtfrc.f ifort -c -O3 -axSSSE3 -no-ipo -no-prec-div -mdynamic-no-pic -w -vec-report0 prtint.f ifort -c -O3 -axSSSE3 -no-ipo -no-prec-div -mdynamic-no-pic -w -vec-report0 prtmol2.f ifort -c -O3 -axSSSE3 -no-ipo -no-prec-div -mdynamic-no-pic -w -vec-report0 prtpdb.f ifort -c -O3 -axSSSE3 -no-ipo -no-prec-div -mdynamic-no-pic -w -vec-report0 prtprm.f ifort -c -O3 -axSSSE3 -no-ipo -no-prec-div -mdynamic-no-pic -w -vec-report0 prtseq.f -ifort -c -O3 -axSSSE3 -no-ipo -no-prec-div -mdynamic-no-pic -w -vec-report0 prtuind.f -ifort -c -O3 -axSSSE3 -no-ipo -no-prec-div -mdynamic-no-pic -w -vec-report0 prtvel.f ifort -c -O3 -axSSSE3 -no-ipo -no-prec-div -mdynamic-no-pic -w -vec-report0 prtxyz.f ifort -c -O3 -axSSSE3 -no-ipo -no-prec-div -mdynamic-no-pic -w -vec-report0 pss.f ifort -c -O3 -axSSSE3 -no-ipo -no-prec-div -mdynamic-no-pic -w -vec-report0 pssrigid.f diff --git a/macos/intel/debug.make b/macos/intel/debug.make index 82e9c6f89..af4b05520 100755 --- a/macos/intel/debug.make +++ b/macos/intel/debug.make @@ -516,14 +516,11 @@ ifort -c -g -warn all -check all protein.f ifort -c -g -warn all -check all prtarc.f ifort -c -g -warn all -check all prtdyn.f ifort -c -g -warn all -check all prterr.f -ifort -c -g -warn all -check all prtfrc.f ifort -c -g -warn all -check all prtint.f ifort -c -g -warn all -check all prtmol2.f ifort -c -g -warn all -check all prtpdb.f ifort -c -g -warn all -check all prtprm.f ifort -c -g -warn all -check all prtseq.f -ifort -c -g -warn all -check all prtuind.f -ifort -c -g -warn all -check all prtvel.f ifort -c -g -warn all -check all prtxyz.f ifort -c -g -warn all -check all pss.f ifort -c -g -warn all -check all pssrigid.f diff --git a/macos/intel/library.make b/macos/intel/library.make index cfd90b9c8..dc6b39871 100755 --- a/macos/intel/library.make +++ b/macos/intel/library.make @@ -431,14 +431,11 @@ promo.o \ prtarc.o \ prtdyn.o \ prterr.o \ -prtfrc.o \ prtint.o \ prtmol2.o \ prtpdb.o \ prtprm.o \ prtseq.o \ -prtuind.o \ -prtvel.o \ prtxyz.o \ ptable.o \ qmstuf.o \ diff --git a/make/Makefile b/make/Makefile index 348ad94e4..2315c9f6d 100644 --- a/make/Makefile +++ b/make/Makefile @@ -607,14 +607,11 @@ OBJS = action.o \ prtarc.o \ prtdyn.o \ prterr.o \ - prtfrc.o \ prtint.o \ prtmol2.o \ prtpdb.o \ prtprm.o \ prtseq.o \ - prtuind.o \ - prtvel.o \ prtxyz.o \ pss.o \ pssrigid.o \ @@ -1510,14 +1507,11 @@ libtinker.a: ${OBJS} prtarc.o \ prtdyn.o \ prterr.o \ - prtfrc.o \ prtint.o \ prtmol2.o \ prtpdb.o \ prtprm.o \ prtseq.o \ - prtuind.o \ - prtvel.o \ prtxyz.o \ ptable.o \ qmstuf.o \ @@ -2073,14 +2067,11 @@ promo.o: iounit.o protein.o: atomid.o atoms.o couple.o files.o group.o inform.o iounit.o katoms.o math.o molcul.o output.o phipsi.o potent.o resdue.o restrn.o rigid.o sequen.o titles.o usage.o prtarc.o: atomid.o atoms.o bound.o boxes.o couple.o files.o inform.o output.o titles.o usage.o prtdyn.o: atoms.o boxes.o files.o group.o mdstuf.o moldyn.o rgddyn.o titles.o -prtfrc.o: atomid.o atoms.o bound.o boxes.o couple.o deriv.o files.o inform.o titles.o prtint.o: atomid.o atoms.o files.o inform.o titles.o zclose.o zcoord.o prtmol2.o: angbnd.o atmlst.o atomid.o atoms.o bndstr.o couple.o files.o iounit.o ptable.o ring.o titles.o tors.o prtpdb.o: bound.o boxes.o files.o pdb.o sequen.o titles.o prtprm.o: angpot.o bndpot.o chgpot.o fields.o kanang.o kangs.o kantor.o katoms.o kbonds.o kcflux.o kchrge.o kcpen.o kctrn.o kdipol.o kdsp.o kexpl.o khbond.o kiprop.o kitors.o kmulti.o kopbnd.o kopdst.o korbs.o kpitor.o kpolpr.o kpolr.o krepl.o ksolut.o kstbnd.o ksttor.o ktorsn.o ktrtor.o kurybr.o kvdwpr.o kvdws.o mplpot.o polpot.o sizes.o urypot.o vdwpot.o prtseq.o: files.o sequen.o -prtuind.o: atomid.o atoms.o bound.o boxes.o couple.o files.o inform.o polar.o titles.o units.o -prtvel.o: atomid.o atoms.o bound.o boxes.o couple.o files.o inform.o moldyn.o titles.o prtxyz.o: atomid.o atoms.o bound.o boxes.o couple.o files.o inform.o titles.o pss.o: atoms.o files.o hescut.o inform.o iounit.o math.o omega.o refer.o tree.o warp.o zcoord.o pssrigid.o: atoms.o files.o group.o inform.o iounit.o math.o minima.o molcul.o refer.o rigid.o sizes.o warp.o diff --git a/make/Makefile-apbs b/make/Makefile-apbs index 3fad2819a..013d9f4e9 100644 --- a/make/Makefile-apbs +++ b/make/Makefile-apbs @@ -622,14 +622,11 @@ OBJS = action.o \ prtarc.o \ prtdyn.o \ prterr.o \ - prtfrc.o \ prtint.o \ prtmol2.o \ prtpdb.o \ prtprm.o \ prtseq.o \ - prtuind.o \ - prtvel.o \ prtxyz.o \ pss.o \ pssrigid.o \ @@ -1528,14 +1525,11 @@ libtinker.a: ${OBJS} prtarc.o \ prtdyn.o \ prterr.o \ - prtfrc.o \ prtint.o \ prtmol2.o \ prtpdb.o \ prtprm.o \ prtseq.o \ - prtuind.o \ - prtvel.o \ prtxyz.o \ ptable.o \ qmstuf.o \ @@ -2091,14 +2085,11 @@ promo.o: iounit.o protein.o: atomid.o atoms.o couple.o files.o group.o inform.o iounit.o katoms.o math.o molcul.o output.o phipsi.o potent.o resdue.o restrn.o rigid.o sequen.o titles.o usage.o prtarc.o: atomid.o atoms.o bound.o boxes.o couple.o files.o inform.o output.o titles.o usage.o prtdyn.o: atoms.o boxes.o files.o group.o mdstuf.o moldyn.o rgddyn.o titles.o -prtfrc.o: atomid.o atoms.o bound.o boxes.o couple.o deriv.o files.o inform.o titles.o prtint.o: atomid.o atoms.o files.o inform.o titles.o zclose.o zcoord.o prtmol2.o: angbnd.o atmlst.o atomid.o atoms.o bndstr.o couple.o files.o iounit.o ptable.o ring.o titles.o tors.o prtpdb.o: bound.o boxes.o files.o pdb.o sequen.o titles.o prtprm.o: angpot.o bndpot.o chgpot.o fields.o kanang.o kangs.o kantor.o katoms.o kbonds.o kcflux.o kchrge.o kcpen.o kctrn.o kdipol.o kdsp.o kexpl.o khbond.o kiprop.o kitors.o kmulti.o kopbnd.o kopdst.o korbs.o kpitor.o kpolpr.o kpolr.o krepl.o ksolut.o kstbnd.o ksttor.o ktorsn.o ktrtor.o kurybr.o kvdwpr.o kvdws.o mplpot.o polpot.o sizes.o urypot.o vdwpot.o prtseq.o: files.o sequen.o -prtuind.o: atomid.o atoms.o bound.o boxes.o couple.o files.o inform.o polar.o titles.o units.o -prtvel.o: atomid.o atoms.o bound.o boxes.o couple.o files.o inform.o moldyn.o titles.o prtxyz.o: atomid.o atoms.o bound.o boxes.o couple.o files.o inform.o titles.o pss.o: atoms.o files.o hescut.o inform.o iounit.o math.o omega.o refer.o tree.o warp.o zcoord.o pssrigid.o: atoms.o files.o group.o inform.o iounit.o math.o minima.o molcul.o refer.o rigid.o sizes.o warp.o diff --git a/make/Makefile-ffe-linux b/make/Makefile-ffe-linux index 831de9143..4acbad80f 100644 --- a/make/Makefile-ffe-linux +++ b/make/Makefile-ffe-linux @@ -653,14 +653,11 @@ OBJS = action.o \ prtarc.o \ prtdyn.o \ prterr.o \ - prtfrc.o \ prtint.o \ prtmol2.o \ prtpdb.o \ prtprm.o \ prtseq.o \ - prtuind.o \ - prtvel.o \ prtxyz.o \ pss.o \ pssrigid.o \ @@ -1559,14 +1556,11 @@ libtinker.a: ${OBJS} prtarc.o \ prtdyn.o \ prterr.o \ - prtfrc.o \ prtint.o \ prtmol2.o \ prtpdb.o \ prtprm.o \ prtseq.o \ - prtuind.o \ - prtvel.o \ prtxyz.o \ ptable.o \ qmstuf.o \ @@ -2122,14 +2116,11 @@ promo.o: iounit.o protein.o: atomid.o atoms.o couple.o files.o group.o inform.o iounit.o katoms.o math.o molcul.o output.o phipsi.o potent.o resdue.o restrn.o rigid.o sequen.o titles.o usage.o prtarc.o: atomid.o atoms.o bound.o boxes.o couple.o files.o inform.o output.o titles.o usage.o prtdyn.o: atoms.o boxes.o files.o group.o mdstuf.o moldyn.o rgddyn.o titles.o -prtfrc.o: atomid.o atoms.o bound.o boxes.o couple.o deriv.o files.o inform.o titles.o prtint.o: atomid.o atoms.o files.o inform.o titles.o zclose.o zcoord.o prtmol2.o: angbnd.o atmlst.o atomid.o atoms.o bndstr.o couple.o files.o iounit.o ptable.o ring.o titles.o tors.o prtpdb.o: bound.o boxes.o files.o pdb.o sequen.o titles.o prtprm.o: angpot.o bndpot.o chgpot.o fields.o kanang.o kangs.o kantor.o katoms.o kbonds.o kcflux.o kchrge.o kcpen.o kctrn.o kdipol.o kdsp.o kexpl.o khbond.o kiprop.o kitors.o kmulti.o kopbnd.o kopdst.o korbs.o kpitor.o kpolpr.o kpolr.o krepl.o ksolut.o kstbnd.o ksttor.o ktorsn.o ktrtor.o kurybr.o kvdwpr.o kvdws.o mplpot.o polpot.o sizes.o urypot.o vdwpot.o prtseq.o: files.o sequen.o -prtuind.o: atomid.o atoms.o bound.o boxes.o couple.o files.o inform.o polar.o titles.o units.o -prtvel.o: atomid.o atoms.o bound.o boxes.o couple.o files.o inform.o moldyn.o titles.o prtxyz.o: atomid.o atoms.o bound.o boxes.o couple.o files.o inform.o titles.o pss.o: atoms.o files.o hescut.o inform.o iounit.o math.o omega.o refer.o tree.o warp.o zcoord.o pssrigid.o: atoms.o files.o group.o inform.o iounit.o math.o minima.o molcul.o refer.o rigid.o sizes.o warp.o diff --git a/make/Makefile-ffe-macos b/make/Makefile-ffe-macos index 4f6b04bbc..23f2f653f 100644 --- a/make/Makefile-ffe-macos +++ b/make/Makefile-ffe-macos @@ -653,14 +653,11 @@ OBJS = action.o \ prtarc.o \ prtdyn.o \ prterr.o \ - prtfrc.o \ prtint.o \ prtmol2.o \ prtpdb.o \ prtprm.o \ prtseq.o \ - prtuind.o \ - prtvel.o \ prtxyz.o \ pss.o \ pssrigid.o \ @@ -1559,14 +1556,11 @@ libtinker.a: ${OBJS} prtarc.o \ prtdyn.o \ prterr.o \ - prtfrc.o \ prtint.o \ prtmol2.o \ prtpdb.o \ prtprm.o \ prtseq.o \ - prtuind.o \ - prtvel.o \ prtxyz.o \ ptable.o \ qmstuf.o \ @@ -2122,14 +2116,11 @@ promo.o: iounit.o protein.o: atomid.o atoms.o couple.o files.o group.o inform.o iounit.o katoms.o math.o molcul.o output.o phipsi.o potent.o resdue.o restrn.o rigid.o sequen.o titles.o usage.o prtarc.o: atomid.o atoms.o bound.o boxes.o couple.o files.o inform.o output.o titles.o usage.o prtdyn.o: atoms.o boxes.o files.o group.o mdstuf.o moldyn.o rgddyn.o titles.o -prtfrc.o: atomid.o atoms.o bound.o boxes.o couple.o deriv.o files.o inform.o titles.o prtint.o: atomid.o atoms.o files.o inform.o titles.o zclose.o zcoord.o prtmol2.o: angbnd.o atmlst.o atomid.o atoms.o bndstr.o couple.o files.o iounit.o ptable.o ring.o titles.o tors.o prtpdb.o: bound.o boxes.o files.o pdb.o sequen.o titles.o prtprm.o: angpot.o bndpot.o chgpot.o fields.o kanang.o kangs.o kantor.o katoms.o kbonds.o kcflux.o kchrge.o kcpen.o kctrn.o kdipol.o kdsp.o kexpl.o khbond.o kiprop.o kitors.o kmulti.o kopbnd.o kopdst.o korbs.o kpitor.o kpolpr.o kpolr.o krepl.o ksolut.o kstbnd.o ksttor.o ktorsn.o ktrtor.o kurybr.o kvdwpr.o kvdws.o mplpot.o polpot.o sizes.o urypot.o vdwpot.o prtseq.o: files.o sequen.o -prtuind.o: atomid.o atoms.o bound.o boxes.o couple.o files.o inform.o polar.o titles.o units.o -prtvel.o: atomid.o atoms.o bound.o boxes.o couple.o files.o inform.o moldyn.o titles.o prtxyz.o: atomid.o atoms.o bound.o boxes.o couple.o files.o inform.o titles.o pss.o: atoms.o files.o hescut.o inform.o iounit.o math.o omega.o refer.o tree.o warp.o zcoord.o pssrigid.o: atoms.o files.o group.o inform.o iounit.o math.o minima.o molcul.o refer.o rigid.o sizes.o warp.o diff --git a/make/Makefile-ffe-windows b/make/Makefile-ffe-windows index 25e398db4..99fcdea24 100644 --- a/make/Makefile-ffe-windows +++ b/make/Makefile-ffe-windows @@ -653,14 +653,11 @@ OBJS = action.o \ prtarc.o \ prtdyn.o \ prterr.o \ - prtfrc.o \ prtint.o \ prtmol2.o \ prtpdb.o \ prtprm.o \ prtseq.o \ - prtuind.o \ - prtvel.o \ prtxyz.o \ pss.o \ pssrigid.o \ @@ -1568,14 +1565,11 @@ libtinker.a: ${OBJS} prtarc.o \ prtdyn.o \ prterr.o \ - prtfrc.o \ prtint.o \ prtmol2.o \ prtpdb.o \ prtprm.o \ prtseq.o \ - prtuind.o \ - prtvel.o \ prtxyz.o \ ptable.o \ qmstuf.o \ @@ -2131,14 +2125,11 @@ promo.o: iounit.o protein.o: atomid.o atoms.o couple.o files.o group.o inform.o iounit.o katoms.o math.o molcul.o output.o phipsi.o potent.o resdue.o restrn.o rigid.o sequen.o titles.o usage.o prtarc.o: atomid.o atoms.o bound.o boxes.o couple.o files.o inform.o output.o titles.o usage.o prtdyn.o: atoms.o boxes.o files.o group.o mdstuf.o moldyn.o rgddyn.o titles.o -prtfrc.o: atomid.o atoms.o bound.o boxes.o couple.o deriv.o files.o inform.o titles.o prtint.o: atomid.o atoms.o files.o inform.o titles.o zclose.o zcoord.o prtmol2.o: angbnd.o atmlst.o atomid.o atoms.o bndstr.o couple.o files.o iounit.o ptable.o ring.o titles.o tors.o prtpdb.o: bound.o boxes.o files.o pdb.o sequen.o titles.o prtprm.o: angpot.o bndpot.o chgpot.o fields.o kanang.o kangs.o kantor.o katoms.o kbonds.o kcflux.o kchrge.o kcpen.o kctrn.o kdipol.o kdsp.o kexpl.o khbond.o kiprop.o kitors.o kmulti.o kopbnd.o kopdst.o korbs.o kpitor.o kpolpr.o kpolr.o krepl.o ksolut.o kstbnd.o ksttor.o ktorsn.o ktrtor.o kurybr.o kvdwpr.o kvdws.o mplpot.o polpot.o sizes.o urypot.o vdwpot.o prtseq.o: files.o sequen.o -prtuind.o: atomid.o atoms.o bound.o boxes.o couple.o files.o inform.o polar.o titles.o units.o -prtvel.o: atomid.o atoms.o bound.o boxes.o couple.o files.o inform.o moldyn.o titles.o prtxyz.o: atomid.o atoms.o bound.o boxes.o couple.o files.o inform.o titles.o pss.o: atoms.o files.o hescut.o inform.o iounit.o math.o omega.o refer.o tree.o warp.o zcoord.o pssrigid.o: atoms.o files.o group.o inform.o iounit.o math.o minima.o molcul.o refer.o rigid.o sizes.o warp.o diff --git a/make/depend.make b/make/depend.make index ee4d39632..5860d40f7 100755 --- a/make/depend.make +++ b/make/depend.make @@ -462,14 +462,11 @@ document 5 promo.f | grep 'o:' document 5 protein.f | grep 'o:' document 5 prtarc.f | grep 'o:' document 5 prtdyn.f | grep 'o:' -document 5 prtfrc.f | grep 'o:' document 5 prtint.f | grep 'o:' document 5 prtmol2.f | grep 'o:' document 5 prtpdb.f | grep 'o:' document 5 prtprm.f | grep 'o:' document 5 prtseq.f | grep 'o:' -document 5 prtuind.f | grep 'o:' -document 5 prtvel.f | grep 'o:' document 5 prtxyz.f | grep 'o:' document 5 pss.f | grep 'o:' document 5 pssrigid.f | grep 'o:' diff --git a/openmm/Makefile b/openmm/Makefile index 0dfb6b200..8c78e894d 100644 --- a/openmm/Makefile +++ b/openmm/Makefile @@ -609,14 +609,11 @@ OBJS = action.o \ prtarc.o \ prtdyn.o \ prterr.o \ - prtfrc.o \ prtint.o \ prtmol2.o \ prtpdb.o \ prtprm.o \ prtseq.o \ - prtuind.o \ - prtvel.o \ prtxyz.o \ pss.o \ pssrigid.o \ @@ -1223,14 +1220,11 @@ libtinker.a: ${OBJS} prtarc.o \ prtdyn.o \ prterr.o \ - prtfrc.o \ prtint.o \ prtmol2.o \ prtpdb.o \ prtprm.o \ prtseq.o \ - prtuind.o \ - prtvel.o \ prtxyz.o \ ptable.o \ qmstuf.o \ @@ -1794,14 +1788,11 @@ promo.o: iounit.o protein.o: atomid.o atoms.o couple.o files.o group.o inform.o iounit.o katoms.o math.o molcul.o output.o phipsi.o potent.o resdue.o restrn.o rigid.o sequen.o titles.o usage.o prtarc.o: atomid.o atoms.o bound.o boxes.o couple.o files.o inform.o output.o titles.o usage.o prtdyn.o: atoms.o boxes.o files.o group.o mdstuf.o moldyn.o rgddyn.o titles.o -prtfrc.o: atomid.o atoms.o bound.o boxes.o couple.o deriv.o files.o inform.o titles.o prtint.o: atomid.o atoms.o files.o inform.o titles.o zclose.o zcoord.o prtmol2.o: angbnd.o atmlst.o atomid.o atoms.o bndstr.o couple.o files.o iounit.o ptable.o ring.o titles.o tors.o prtpdb.o: bound.o boxes.o files.o pdb.o sequen.o titles.o prtprm.o: angpot.o bndpot.o chgpot.o fields.o kanang.o kangs.o kantor.o katoms.o kbonds.o kcflux.o kchrge.o kcpen.o kctrn.o kdipol.o kdsp.o kexpl.o khbond.o kiprop.o kitors.o kmulti.o kopbnd.o kopdst.o korbs.o kpitor.o kpolpr.o kpolr.o krepl.o ksolut.o kstbnd.o ksttor.o ktorsn.o ktrtor.o kurybr.o kvdwpr.o kvdws.o mplpot.o polpot.o sizes.o urypot.o vdwpot.o prtseq.o: files.o sequen.o -prtuind.o: atomid.o atoms.o bound.o boxes.o couple.o files.o inform.o polar.o titles.o units.o -prtvel.o: atomid.o atoms.o bound.o boxes.o couple.o files.o inform.o moldyn.o titles.o prtxyz.o: atomid.o atoms.o bound.o boxes.o couple.o files.o inform.o titles.o pss.o: atoms.o files.o hescut.o inform.o iounit.o math.o omega.o refer.o tree.o warp.o zcoord.o pssrigid.o: atoms.o files.o group.o inform.o iounit.o math.o minima.o molcul.o refer.o rigid.o sizes.o warp.o diff --git a/source/active.f b/source/active.f index 14f2b6f54..c9244695d 100644 --- a/source/active.f +++ b/source/active.f @@ -276,8 +276,10 @@ subroutine saveonly c if (allocated(ionly)) deallocate (ionly) if (allocated(ionlyinv)) deallocate (ionlyinv) + if (allocated(print3n)) deallocate (print3n) allocate (ionly(n)) allocate (ionlyinv(n)) + allocate (print3n(3,n)) c c perform dynamic allocation of some local arrays c diff --git a/source/boxes.f b/source/boxes.f index 9eb1e38b4..18d8eabaf 100644 --- a/source/boxes.f +++ b/source/boxes.f @@ -31,6 +31,9 @@ c gamma_cos cosine of the gamma periodic box angle c beta_term term used in generating triclinic box c gamma_term term used in generating triclinic box +c xcenter x-coordinate of center of mass of system in Angstroms +c ycenter y-coordinate of center of mass of system in Angstroms +c zcenter z-coordinate of center of mass of system in Angstroms c lvec real space lattice vectors as matrix rows c recip reciprocal lattice vectors as matrix columns c orthogonal flag to mark periodic box as orthogonal @@ -57,6 +60,7 @@ module boxes real*8 gamma_cos real*8 beta_term real*8 gamma_term + real*8 xcenter,ycenter,zcenter real*8 lvec(3,3) real*8 recip(3,3) logical orthogonal diff --git a/source/center.f b/source/center.f index b034a0592..e95cb1bb4 100644 --- a/source/center.f +++ b/source/center.f @@ -88,39 +88,46 @@ subroutine center (n1,x1,y1,z1,n2,x2,y2,z2,xmid,ymid,zmid) c "compcent" computes the center of mass c c - subroutine compcent (xmid,ymid,zmid) + subroutine compcent (xcm,ycm,zcm) use atomid use atoms + use boxes implicit none integer i real*8 weigh - real*8 xmid,ymid,zmid + real*8 xcm,ycm,zcm c c c find the center of mass of the set of active atoms c weigh = 0.0d0 - xmid = 0.0d0 - ymid = 0.0d0 - zmid = 0.0d0 + xcenter = 0.0d0 + ycenter = 0.0d0 + zcenter = 0.0d0 c c OpenMP directives for the major loop structure c !$OMP PARALLEL default(private) -!$OMP& shared(n,x,y,z,xmid,ymid,zmid,weigh,mass) -!$OMP DO reduction(+:xmid,ymid,zmid,weigh) schedule(guided) +!$OMP& shared(n,x,y,z,xcenter,ycenter,zcenter,weigh,mass) +!$OMP DO reduction(+:xcenter,ycenter,zcenter,weigh) schedule(guided) do i = 1, n weigh = weigh + mass(i) - xmid = xmid + x(i)*mass(i) - ymid = ymid + y(i)*mass(i) - zmid = zmid + z(i)*mass(i) + xcenter = xcenter + x(i)*mass(i) + ycenter = ycenter + y(i)*mass(i) + zcenter = zcenter + z(i)*mass(i) end do !$OMP END DO !$OMP END PARALLEL if (weigh .ne. 0.0d0) then - xmid = xmid / weigh - ymid = ymid / weigh - zmid = zmid / weigh + xcenter = xcenter / weigh + ycenter = ycenter / weigh + zcenter = zcenter / weigh end if +c +c copy xcenter, ycenter, zcenter to xcm, ycm, zcm +c + xcm = xcenter + ycm = ycenter + zcm = zcenter return end diff --git a/source/dynamic.f b/source/dynamic.f index 9e60c2fc7..90252dbff 100644 --- a/source/dynamic.f +++ b/source/dynamic.f @@ -234,10 +234,10 @@ program dynamic c for NPT + extfield simulation c if (use_exfld .and. mode.eq.4) then - if (barostat.ne.'MONTECARLO' .and. .not.anisotrop) then + if (barostat.ne.'MONTECARLO') then write (iout,340) 340 format (/,' DYNAMIC -- NPT with External Field Should', - & ' Use MonteCarlo or Anisotropic Barostat') + & ' Use MonteCarlo Barostat') call fatal end if end if diff --git a/source/final.f b/source/final.f index e35b28a44..ff091e0f4 100644 --- a/source/final.f +++ b/source/final.f @@ -800,6 +800,10 @@ subroutine final if (allocated(a)) deallocate (a) if (allocated(aalt)) deallocate (aalt) c +c deallocation of global arrays from module moment +c + if (allocated(momuse)) deallocate (momuse) +c c deallocation of global arrays from module mpole c if (allocated(ipole)) deallocate (ipole) @@ -880,7 +884,7 @@ subroutine final c if (allocated(ionly)) deallocate (ionly) if (allocated(ionlyinv)) deallocate (ionlyinv) - if (allocated(momuse)) deallocate (momuse) + if (allocated(print3n)) deallocate (print3n) c c deallocation of global arrays from module paths c @@ -967,7 +971,6 @@ subroutine final if (allocated(uinds)) deallocate (uinds) if (allocated(uinps)) deallocate (uinps) if (allocated(uexact)) deallocate (uexact) - if (allocated(worker3n)) deallocate (worker3n) if (allocated(douind)) deallocate (douind) c c deallocation of global arrays from module polgrp diff --git a/source/mdinit.f b/source/mdinit.f index 4ea5b9d62..d5cf6d84b 100644 --- a/source/mdinit.f +++ b/source/mdinit.f @@ -366,9 +366,6 @@ subroutine mdinit (dt) c perform dynamic allocation of some local arrays c allocate (derivs(3,n)) - if (udirsave.or.defsave.or.tefsave) then - if (.not. allocated(worker3n)) allocate (worker3n(3,n)) - end if c c try to restart using prior velocities and accelerations c diff --git a/source/mdsave.f b/source/mdsave.f index 0dcae2df8..9e3816bfc 100644 --- a/source/mdsave.f +++ b/source/mdsave.f @@ -315,9 +315,9 @@ subroutine mdsave (istep,dt,epot,eksum) 410 format (i6,3x,d13.6,3x,d13.6,3x,d13.6) end do else if (dcdsave) then - call prtdcdv (ivel,first) + call prtdcdv3 (ivel,first,'VEL') else - call prtvel (ivel) + call prtvec3 (ivel,'VEL') end if close (unit=ivel) write (iout,420) velfile(1:trimtext(velfile)) @@ -347,7 +347,7 @@ subroutine mdsave (istep,dt,epot,eksum) open (unit=ifrc,file=frcfile,form='unformatted', & status='new') end if - call prtdcdf (ifrc,first) + call prtdcdv3 (ifrc,first,'FRC') else frcfile = filename(1:leng) call suffix (frcfile,'frc','old') @@ -357,7 +357,7 @@ subroutine mdsave (istep,dt,epot,eksum) else open (unit=ifrc,file=frcfile,status='new') end if - call prtfrc (ifrc) + call prtvec3 (ifrc,'FRC') end if close (unit=ifrc) write (iout,430) frcfile(1:trimtext(frcfile)) @@ -372,7 +372,7 @@ subroutine mdsave (istep,dt,epot,eksum) indfile = filename(1:leng)//'.'//ext(1:lext)//'ui' call version (indfile,'new') open (unit=iind,file=indfile,status='new') - call prtuind (iind) + call prtvec3 (iind,'UIN') else if (dcdsave) then indfile = filename(1:leng) call suffix (indfile,'dcdui','old') @@ -386,7 +386,7 @@ subroutine mdsave (istep,dt,epot,eksum) open (unit=iind,file=indfile,form='unformatted', & status='new') end if - call prtdcdui (iind,first) + call prtdcdv3 (iind,first,'UIN') else indfile = filename(1:leng) call suffix (indfile,'uind','old') @@ -396,7 +396,7 @@ subroutine mdsave (istep,dt,epot,eksum) else open (unit=iind,file=indfile,status='new') end if - call prtuind (iind) + call prtvec3 (iind,'UIN') end if close (unit=iind) write (iout,440) indfile(1:trimtext(indfile)) @@ -411,7 +411,7 @@ subroutine mdsave (istep,dt,epot,eksum) stcfile = filename(1:leng)//'.'//ext(1:lext)//'us' call version (stcfile,'new') open (unit=istc,file=stcfile,status='new') - call prtustc (istc,xm,ym,zm) + call prtvec3 (istc,'UST') else if (dcdsave) then stcfile = filename(1:leng) call suffix (stcfile,'dcdus','old') @@ -425,7 +425,7 @@ subroutine mdsave (istep,dt,epot,eksum) open (unit=istc,file=stcfile,form='unformatted', & status='new') end if - call prtdcdus (istc,first,xm,ym,zm) + call prtdcdv3 (istc,first,'UST') else stcfile = filename(1:leng) call suffix (stcfile,'ustc','old') @@ -435,7 +435,7 @@ subroutine mdsave (istep,dt,epot,eksum) else open (unit=istc,file=stcfile,status='new') end if - call prtustc (istc,xm,ym,zm) + call prtvec3 (istc,'UST') end if close (unit=istc) write (iout,450) stcfile(1:trimtext(stcfile)) @@ -450,7 +450,7 @@ subroutine mdsave (istep,dt,epot,eksum) stcfile = filename(1:leng)//'.'//ext(1:lext)//'uc' call version (stcfile,'new') open (unit=istc,file=stcfile,status='new') - call prtuchg (istc,xm,ym,zm) + call prtvec3 (istc,'UCH') else if (dcdsave) then stcfile = filename(1:leng) call suffix (stcfile,'dcduc','old') @@ -464,7 +464,7 @@ subroutine mdsave (istep,dt,epot,eksum) open (unit=istc,file=stcfile,form='unformatted', & status='new') end if - call prtdcduc (istc,first,xm,ym,zm) + call prtdcdv3 (istc,first,'UCH') else stcfile = filename(1:leng) call suffix (stcfile,'uchg','old') @@ -474,7 +474,7 @@ subroutine mdsave (istep,dt,epot,eksum) else open (unit=istc,file=stcfile,status='new') end if - call prtuchg (istc,xm,ym,zm) + call prtvec3 (istc,'UCH') end if close (unit=istc) write (iout,460) stcfile(1:trimtext(stcfile)) @@ -489,7 +489,7 @@ subroutine mdsave (istep,dt,epot,eksum) indfile = filename(1:leng)//'.'//ext(1:lext)//'ud' call version (indfile,'new') open (unit=iind,file=indfile,status='new') - call prtudir (iind) + call prtvec3 (iind,'UDR') else if (dcdsave) then indfile = filename(1:leng) call suffix (indfile,'dcdud','old') @@ -503,7 +503,7 @@ subroutine mdsave (istep,dt,epot,eksum) open (unit=iind,file=indfile,form='unformatted', & status='new') end if - call prtdcdud (iind,first) + call prtdcdv3 (iind,first,'UDR') else indfile = filename(1:leng) call suffix (indfile,'udir','old') @@ -513,7 +513,7 @@ subroutine mdsave (istep,dt,epot,eksum) else open (unit=iind,file=indfile,status='new') end if - call prtudir (iind) + call prtvec3 (iind,'UDR') end if close (unit=iind) write (iout,470) indfile(1:trimtext(indfile)) @@ -528,7 +528,7 @@ subroutine mdsave (istep,dt,epot,eksum) indfile = filename(1:leng)//'.'//ext(1:lext)//'de' call version (indfile,'new') open (unit=iind,file=indfile,status='new') - call prtdef (iind) + call prtvec3 (iind,'DEF') else if (dcdsave) then indfile = filename(1:leng) call suffix (indfile,'dcdde','old') @@ -542,7 +542,7 @@ subroutine mdsave (istep,dt,epot,eksum) open (unit=iind,file=indfile,form='unformatted', & status='new') end if - call prtdcdde (iind,first) + call prtdcdv3 (iind,first,'DEF') else indfile = filename(1:leng) call suffix (indfile,'def','old') @@ -552,7 +552,7 @@ subroutine mdsave (istep,dt,epot,eksum) else open (unit=iind,file=indfile,status='new') end if - call prtdef (iind) + call prtvec3 (iind,'DEF') end if close (unit=iind) write (iout,480) indfile(1:trimtext(indfile)) @@ -567,7 +567,7 @@ subroutine mdsave (istep,dt,epot,eksum) indfile = filename(1:leng)//'.'//ext(1:lext)//'te' call version (indfile,'new') open (unit=iind,file=indfile,status='new') - call prttef (iind) + call prtvec3 (iind,'TEF') else if (dcdsave) then indfile = filename(1:leng) call suffix (indfile,'dcdte','old') @@ -581,7 +581,7 @@ subroutine mdsave (istep,dt,epot,eksum) open (unit=iind,file=indfile,form='unformatted', & status='new') end if - call prtdcdte (iind,first) + call prtdcdv3 (iind,first,'TEF') else indfile = filename(1:leng) call suffix (indfile,'tef','old') @@ -591,7 +591,7 @@ subroutine mdsave (istep,dt,epot,eksum) else open (unit=iind,file=indfile,status='new') end if - call prttef (iind) + call prtvec3 (iind,'TEF') end if close (unit=iind) write (iout,490) indfile(1:trimtext(indfile)) diff --git a/source/output.f b/source/output.f index 1e9ed010b..39151c7e4 100644 --- a/source/output.f +++ b/source/output.f @@ -15,6 +15,7 @@ c nonly total number of save sites in the system c ionly number of the atom for each save site c ionlyinv inverse map of ionly +c print3n array for printing atomic 3D vectors c archive logical flag for coordinates in Tinker XYZ format c binary logical flag for coordinates in DCD binary format c noversion logical flag governing use of filename versions @@ -43,6 +44,7 @@ module output integer nonly integer, allocatable :: ionly(:) integer, allocatable :: ionlyinv(:) + real*8, allocatable :: print3n(:,:) logical archive logical binary logical noversion diff --git a/source/polar.f b/source/polar.f index c0fc21ee3..e746f05fd 100644 --- a/source/polar.f +++ b/source/polar.f @@ -30,7 +30,6 @@ c uinds mutual GK or PB induced dipoles for each atom site c uinps mutual induced dipoles in field used for GK or PB energy c uexact exact SCF induced dipoles to full numerical precision -c worker3n worker array for printing dipoles and electric fields c douind flag to allow induced dipoles at each atom site c c @@ -54,7 +53,6 @@ module polar real*8, allocatable :: uinds(:,:) real*8, allocatable :: uinps(:,:) real*8, allocatable :: uexact(:,:) - real*8, allocatable :: worker3n(:,:) logical, allocatable :: douind(:) save end diff --git a/source/prtfrc.f b/source/prtfrc.f deleted file mode 100644 index f9c959444..000000000 --- a/source/prtfrc.f +++ /dev/null @@ -1,264 +0,0 @@ -c -c -c ################################################### -c ## COPYRIGHT (C) 2023 by Jay William Ponder ## -c ## All Rights Reserved ## -c ################################################### -c -c ############################################################## -c ## ## -c ## subroutine prtfrc -- output of atom force components ## -c ## ## -c ############################################################## -c -c -c "prtfrc" writes out a set of atom force components -c to an external disk file in Tinker XYZ format -c -c - subroutine prtfrc (ifrc) - use atomid - use atoms - use bound - use boxes - use couple - use deriv - use files - use inform - use output - use titles - implicit none - integer i,j,k,ifrc - integer ii - integer size,crdsiz - real*8 crdmin,crdmax - logical opened - character*2 atmc - character*2 crdc - character*2 digc - character*25 fstr - character*240 frcfile -c -c -c open the output unit if not already done -c - inquire (unit=ifrc,opened=opened) - if (.not. opened) then - frcfile = filename(1:leng)//'.frc' - call version (frcfile,'new') - open (unit=ifrc,file=frcfile,status='new') - end if -c -c check for large systems needing extended formatting -c - atmc = 'i6' - if (n .ge. 100000) atmc = 'i7' - if (n .ge. 1000000) atmc = 'i8' - crdmin = 0.0d0 - crdmax = 0.0d0 - do i = 1, n - crdmin = min(crdmin,x(i),y(i),z(i)) - crdmax = max(crdmax,x(i),y(i),z(i)) - end do - crdsiz = 6 - if (crdmin .le. -1000.0d0) crdsiz = 7 - if (crdmax .ge. 10000.0d0) crdsiz = 7 - if (crdmin .le. -10000.0d0) crdsiz = 8 - if (crdmax .ge. 100000.0d0) crdsiz = 8 - crdsiz = crdsiz + max(6,digits) - size = 0 - call numeral (crdsiz,crdc,size) - if (digits .le. 6) then - digc = '6 ' - else if (digits .le. 8) then - digc = '8' - else - digc = '10' - end if -c -c write out the number of atoms and the title -c - if (.not. onlysave) then - if (ltitle .eq. 0) then - fstr = '('//atmc//')' - write (ifrc,fstr(1:4)) n - else - fstr = '('//atmc//',2x,a)' - write (ifrc,fstr(1:9)) n,title(1:ltitle) - end if - else - if (ltitle .eq. 0) then - fstr = '('//atmc//')' - write (ifrc,fstr(1:4)) nonly - else - fstr = '('//atmc//',2x,a)' - write (ifrc,fstr(1:9)) nonly,title(1:ltitle) - end if - end if -c -c write out the periodic cell lengths and angles -c - if (use_bounds) then - fstr = '(1x,6f'//crdc//'.'//digc//')' - write (ifrc,fstr) xbox,ybox,zbox,alpha,beta,gamma - end if -c -c write out the atom force components for each atom -c - fstr = '('//atmc//',2x,a3,3f'//crdc// - & '.'//digc//',i6,8'//atmc//')' - if (.not. onlysave) then - do i = 1, n - k = n12(i) - if (k .eq. 0) then - write (ifrc,fstr) i,name(i),(-desum(j,i),j=1,3),type(i) - else - write (ifrc,fstr) i,name(i),(-desum(j,i),j=1,3),type(i), - & (i12(j,i),j=1,k) - end if - end do - else - do ii = 1, nonly - i = ionly(ii) - k = n12(i) - if (k .eq. 0) then - write (ifrc,fstr) ii,name(i),(-desum(j,i),j=1,3),type(i) - else - write (ifrc,fstr) ii,name(i),(-desum(j,i),j=1,3),type(i), - & (ionlyinv(i12(j,i)),j=1,k) - end if - end do - end if -c -c close the output unit if opened by this routine -c - if (.not. opened) close (unit=ifrc) - return - end -c -c -c ############################################################## -c ## ## -c ## subroutine prtdcdf -- output of DCD force components ## -c ## ## -c ############################################################## -c -c -c "prtdcdf" writes out a set of atomic force components to -c a file in CHARMM DCD binary format compatible with the VMD -c visualization software and other packages -c -c note the format used is based on the "dcdplugin.c" code from -c the NAMD and VMD programs, and tutorial 4.1 from the software -c package GENESIS: Generalized-Ensemble Simulation System -c -c variables and parameters: -c -c header type of data (CORD=coordinates, VELD=velocities) -c nframe number of frames stored in the DCD file -c nprev number of previous integration steps -c ncrdsav frequency in steps for saving coordinate frames -c nstep number of integration steps in the total run -c nvelsav frequency of coordinate saves with velocity data -c ndfree number of degrees of freedom for the system -c nfixat number of fixed atoms for the system -c usebox flag for periodic boundaries (1=true, 0=false) -c use4d flag for 4D trajectory (1=true, 0=false) -c usefq flag for fluctuating charges (1=true, 0=false) -c merged result of merge without checks (1=true, 0=false) -c vcharmm version of CHARMM software for compatibility -c -c in general a value of zero for any of the above indicates that -c the particular feature is unused -c -c - subroutine prtdcdf (idcd,first) - use atoms - use bound - use boxes - use deriv - use files - use output - use titles - implicit none - integer i,idcd - integer zero,one - integer nframe,nprev - integer ncrdsav,nstep - integer nvelsav,ndfree - integer nfixat,usebox - integer use4d,usefq - integer merged,vcharmm - integer ntitle - real*4 tdelta - logical opened,first - character*4 header - character*240 dcdfile -c -c -c open the output unit if not already done -c - inquire (unit=idcd,opened=opened) - if (.not. opened) then - dcdfile = filename(1:leng)//'.dcdf' - call version (dcdfile,'new') - open (unit=idcd,file=dcdfile,form='unformatted',status='new') - end if -c -c write header info along with title and number of atoms -c - if (first) then - first = .false. - zero = 0 - one = 1 - header = 'CORD' - nframe = zero - nprev = zero - ncrdsav = one - nstep = zero - nvelsav = zero - ndfree = zero - nfixat = zero - tdelta = 0.0 - usebox = zero - if (use_bounds) usebox = one - use4d = zero - usefq = zero - merged = zero - vcharmm = 24 - ntitle = one - write (idcd) header,nframe,nprev,ncrdsav,nstep, - & nvelsav,zero,zero,ndfree,nfixat, - & tdelta,usebox,use4d,usefq,merged, - & zero,zero,zero,zero,zero,vcharmm - write (idcd) ntitle,title(1:80) - if (.not. onlysave) then - write (idcd) n - else - write (idcd) nonly - end if - end if -c -c append the lattice values based on header flag value -c - if (use_bounds) then - write (idcd) xbox,gamma_cos,ybox,beta_cos,alpha_cos,zbox - end if -c -c append the force components along each axis in turn -c - if (.not. onlysave) then - write (idcd) (real(-desum(1,i)),i=1,n) - write (idcd) (real(-desum(2,i)),i=1,n) - write (idcd) (real(-desum(3,i)),i=1,n) - else - write (idcd) (real(-desum(1,ionly(i))),i=1,nonly) - write (idcd) (real(-desum(2,ionly(i))),i=1,nonly) - write (idcd) (real(-desum(3,ionly(i))),i=1,nonly) - end if -c -c close the output unit if opened by this routine -c - if (.not. opened) close (unit=idcd) - return - end diff --git a/source/prtuind.f b/source/prtuind.f deleted file mode 100644 index ba5fe3bb0..000000000 --- a/source/prtuind.f +++ /dev/null @@ -1,1723 +0,0 @@ -c -c -c ################################################### -c ## COPYRIGHT (C) 2023 by Jay William Ponder ## -c ## All Rights Reserved ## -c ################################################### -c -c ################################################################ -c ## ## -c ## subroutine prtuind -- output of atomic induced dipoles ## -c ## ## -c ################################################################ -c -c -c "prtuind" writes out a set of induced dipole components -c to an external disk file in Tinker XYZ format -c -c - subroutine prtuind (iind) - use atomid - use atoms - use bound - use boxes - use couple - use files - use inform - use polar - use output - use titles - use units - implicit none - integer i,j,k,iind - integer ii - integer size,crdsiz - real*8 crdmin,crdmax - logical opened - character*2 atmc - character*2 crdc - character*2 digc - character*25 fstr - character*240 indfile -c -c -c open the output unit if not already done -c - inquire (unit=iind,opened=opened) - if (.not. opened) then - indfile = filename(1:leng)//'.uind' - call version (indfile,'new') - open (unit=iind,file=indfile,status='new') - end if -c -c check for large systems needing extended formatting -c - atmc = 'i6' - if (n .ge. 100000) atmc = 'i7' - if (n .ge. 1000000) atmc = 'i8' - crdmin = 0.0d0 - crdmax = 0.0d0 - do i = 1, n - crdmin = min(crdmin,x(i),y(i),z(i)) - crdmax = max(crdmax,x(i),y(i),z(i)) - end do - crdsiz = 6 - if (crdmin .le. -1000.0d0) crdsiz = 7 - if (crdmax .ge. 10000.0d0) crdsiz = 7 - if (crdmin .le. -10000.0d0) crdsiz = 8 - if (crdmax .ge. 100000.0d0) crdsiz = 8 - crdsiz = crdsiz + max(6,digits) - size = 0 - call numeral (crdsiz,crdc,size) - if (digits .le. 6) then - digc = '6 ' - else if (digits .le. 8) then - digc = '8' - else - digc = '10' - end if -c -c write out the number of atoms and the title -c - if (.not. onlysave) then - if (ltitle .eq. 0) then - fstr = '('//atmc//')' - write (iind,fstr(1:4)) n - else - fstr = '('//atmc//',2x,a)' - write (iind,fstr(1:9)) n,title(1:ltitle) - end if - else - if (ltitle .eq. 0) then - fstr = '('//atmc//')' - write (iind,fstr(1:4)) nonly - else - fstr = '('//atmc//',2x,a)' - write (iind,fstr(1:9)) nonly,title(1:ltitle) - end if - end if -c -c write out the periodic cell lengths and angles -c - if (use_bounds) then - fstr = '(1x,6f'//crdc//'.'//digc//')' - write (iind,fstr) xbox,ybox,zbox,alpha,beta,gamma - end if -c -c write out the induced dipole components for each atom -c - fstr = '('//atmc//',2x,a3,3f'//crdc// - & '.'//digc//',i6,8'//atmc//')' - if (.not. onlysave) then - do i = 1, n - k = n12(i) - if (k .eq. 0) then - write (iind,fstr) i,name(i),(debye*uind(j,i),j=1,3), - & type(i) - else - write (iind,fstr) i,name(i),(debye*uind(j,i),j=1,3), - & type(i),(i12(j,i),j=1,k) - end if - end do - else - do ii = 1, nonly - i = ionly(ii) - k = n12(i) - if (k .eq. 0) then - write (iind,fstr) ii,name(i),(debye*uind(j,i),j=1,3), - & type(i) - else - write (iind,fstr) ii,name(i),(debye*uind(j,i),j=1,3), - & type(i), (ionlyinv(i12(j,i)),j=1,k) - end if - end do - end if -c -c close the output unit if opened by this routine -c - if (.not. opened) close (unit=iind) - return - end -c -c -c ############################################################## -c ## ## -c ## subroutine prtdcdui -- output of DCD induced dipoles ## -c ## ## -c ############################################################## -c -c -c "prtdcdui" writes out a set of induced dipole components to -c a file in CHARMM DCD binary format compatible with the VMD -c visualization software and other packages -c -c note the format used is based on the "dcdplugin.c" code from -c the NAMD and VMD programs, and tutorial 4.1 from the software -c package GENESIS: Generalized-Ensemble Simulation System -c -c variables and parameters: -c -c header type of data (CORD=coordinates, VELD=velocities) -c nframe number of frames stored in the DCD file -c nprev number of previous integration steps -c ncrdsav frequency in steps for saving coordinate frames -c nstep number of integration steps in the total run -c nvelsav frequency of coordinate saves with velocity data -c ndfree number of degrees of freedom for the system -c nfixat number of fixed atoms for the system -c usebox flag for periodic boundaries (1=true, 0=false) -c use4d flag for 4D trajectory (1=true, 0=false) -c usefq flag for fluctuating charges (1=true, 0=false) -c merged result of merge without checks (1=true, 0=false) -c vcharmm version of CHARMM software for compatibility -c -c in general a value of zero for any of the above indicates that -c the particular feature is unused -c -c - subroutine prtdcdui (idcd,first) - use atoms - use bound - use boxes - use files - use polar - use output - use titles - use units - implicit none - integer i,idcd - integer zero,one - integer nframe,nprev - integer ncrdsav,nstep - integer nvelsav,ndfree - integer nfixat,usebox - integer use4d,usefq - integer merged,vcharmm - integer ntitle - real*4 tdelta - logical opened,first - character*4 header - character*240 dcdfile -c -c -c open the output unit if not already done -c - inquire (unit=idcd,opened=opened) - if (.not. opened) then - dcdfile = filename(1:leng)//'.dcdui' - call version (dcdfile,'new') - open (unit=idcd,file=dcdfile,form='unformatted',status='new') - end if -c -c write header info along with title and number of atoms -c - if (first) then - first = .false. - zero = 0 - one = 1 - header = 'CORD' - nframe = zero - nprev = zero - ncrdsav = one - nstep = zero - nvelsav = zero - ndfree = zero - nfixat = zero - tdelta = 0.0 - usebox = zero - if (use_bounds) usebox = one - use4d = zero - usefq = zero - merged = zero - vcharmm = 24 - ntitle = one - write (idcd) header,nframe,nprev,ncrdsav,nstep, - & nvelsav,zero,zero,ndfree,nfixat, - & tdelta,usebox,use4d,usefq,merged, - & zero,zero,zero,zero,zero,vcharmm - write (idcd) ntitle,title(1:80) - if (.not. onlysave) then - write (idcd) n - else - write (idcd) nonly - end if - end if -c -c append the lattice values based on header flag value -c - if (use_bounds) then - write (idcd) xbox,gamma_cos,ybox,beta_cos,alpha_cos,zbox - end if -c -c append the induced dipoles along each axis in turn -c - if (.not. onlysave) then - write (idcd) (real(debye*uind(1,i)),i=1,n) - write (idcd) (real(debye*uind(2,i)),i=1,n) - write (idcd) (real(debye*uind(3,i)),i=1,n) - else - write (idcd) (real(debye*uind(1,ionly(i))),i=1,nonly) - write (idcd) (real(debye*uind(2,ionly(i))),i=1,nonly) - write (idcd) (real(debye*uind(3,ionly(i))),i=1,nonly) - end if -c -c close the output unit if opened by this routine -c - if (.not. opened) close (unit=idcd) - return - end -c -c -c ############################################################### -c ## ## -c ## subroutine prtustc -- output of atomic static dipoles ## -c ## ## -c ############################################################### -c -c -c "prtustc" writes out a set of static dipole components -c to an external disk file in Tinker XYZ format -c -c - subroutine prtustc (istc,xm,ym,zm) - use atomid - use atoms - use bound - use boxes - use couple - use files - use inform - use mpole - use output - use titles - use units - implicit none - integer i,j,k,istc - integer ii - integer size,crdsiz - real*8 crdmin,crdmax - real*8 xd,yd,zd - real*8 xm,ym,zm - logical opened - character*2 atmc - character*2 crdc - character*2 digc - character*25 fstr - character*240 stcfile -c -c -c open the output unit if not already done -c - inquire (unit=istc,opened=opened) - if (.not. opened) then - stcfile = filename(1:leng)//'.ustc' - call version (stcfile,'new') - open (unit=istc,file=stcfile,status='new') - end if -c -c check for large systems needing extended formatting -c - atmc = 'i6' - if (n .ge. 100000) atmc = 'i7' - if (n .ge. 1000000) atmc = 'i8' - crdmin = 0.0d0 - crdmax = 0.0d0 - do i = 1, n - crdmin = min(crdmin,x(i),y(i),z(i)) - crdmax = max(crdmax,x(i),y(i),z(i)) - end do - crdsiz = 6 - if (crdmin .le. -1000.0d0) crdsiz = 7 - if (crdmax .ge. 10000.0d0) crdsiz = 7 - if (crdmin .le. -10000.0d0) crdsiz = 8 - if (crdmax .ge. 100000.0d0) crdsiz = 8 - crdsiz = crdsiz + max(6,digits) - size = 0 - call numeral (crdsiz,crdc,size) - if (digits .le. 6) then - digc = '6 ' - else if (digits .le. 8) then - digc = '8' - else - digc = '10' - end if -c -c write out the number of atoms and the title -c - if (.not. onlysave) then - if (ltitle .eq. 0) then - fstr = '('//atmc//')' - write (istc,fstr(1:4)) n - else - fstr = '('//atmc//',2x,a)' - write (istc,fstr(1:9)) n,title(1:ltitle) - end if - else - if (ltitle .eq. 0) then - fstr = '('//atmc//')' - write (istc,fstr(1:4)) nonly - else - fstr = '('//atmc//',2x,a)' - write (istc,fstr(1:9)) nonly,title(1:ltitle) - end if - end if -c -c write out the periodic cell lengths and angles -c - if (use_bounds) then - fstr = '(1x,6f'//crdc//'.'//digc//')' - write (istc,fstr) xbox,ybox,zbox,alpha,beta,gamma - end if -c -c write out the static dipole components for each atom -c - fstr = '('//atmc//',2x,a3,3f'//crdc// - & '.'//digc//',i6,8'//atmc//')' - if (.not. onlysave) then - do i = 1, n - xd = rpole(2,i) * debye - yd = rpole(3,i) * debye - zd = rpole(4,i) * debye - k = n12(i) - if (k .eq. 0) then - write (istc,fstr) i,name(i),xd,yd,zd,type(i) - else - write (istc,fstr) i,name(i),xd,yd,zd,type(i), - & (i12(j,i),j=1,k) - end if - end do - else - do ii = 1, nonly - i = ionly(ii) - xd = rpole(2,i) * debye - yd = rpole(3,i) * debye - zd = rpole(4,i) * debye - k = n12(i) - if (k .eq. 0) then - write (istc,fstr) ii,name(i),xd,yd,zd,type(i) - else - write (istc,fstr) ii,name(i),xd,yd,zd,type(i), - & (ionlyinv(i12(j,i)),j=1,k) - end if - end do - end if -c -c close the output unit if opened by this routine -c - if (.not. opened) close (unit=istc) - return - end -c -c -c ############################################################# -c ## ## -c ## subroutine prtdcdus -- output of DCD static dipoles ## -c ## ## -c ############################################################# -c -c -c "prtdcdus" writes out a set of static dipole components to -c a file in CHARMM DCD binary format compatible with the VMD -c visualization software and other packages -c -c note the format used is based on the "dcdplugin.c" code from -c the NAMD and VMD programs, and tutorial 4.1 from the software -c package GENESIS: Generalized-Ensemble Simulation System -c -c variables and parameters: -c -c header type of data (CORD=coordinates, VELD=velocities) -c nframe number of frames stored in the DCD file -c nprev number of previous integration steps -c ncrdsav frequency in steps for saving coordinate frames -c nstep number of integration steps in the total run -c nvelsav frequency of coordinate saves with velocity data -c ndfree number of degrees of freedom for the system -c nfixat number of fixed atoms for the system -c usebox flag for periodic boundaries (1=true, 0=false) -c use4d flag for 4D trajectory (1=true, 0=false) -c usefq flag for fluctuating charges (1=true, 0=false) -c merged result of merge without checks (1=true, 0=false) -c vcharmm version of CHARMM software for compatibility -c -c in general a value of zero for any of the above indicates that -c the particular feature is unused -c -c - subroutine prtdcdus (idcd,first,xm,ym,zm) - use atoms - use bound - use boxes - use files - use mpole - use output - use titles - use units - implicit none - integer i,idcd - integer zero,one - integer nframe,nprev - integer ncrdsav,nstep - integer nvelsav,ndfree - integer nfixat,usebox - integer use4d,usefq - integer merged,vcharmm - integer ntitle - real*4 tdelta - real*8 xm,ym,zm - logical opened,first - character*4 header - character*240 dcdfile -c -c -c open the output unit if not already done -c - inquire (unit=idcd,opened=opened) - if (.not. opened) then - dcdfile = filename(1:leng)//'.dcdus' - call version (dcdfile,'new') - open (unit=idcd,file=dcdfile,form='unformatted',status='new') - end if -c -c write header info along with title and number of atoms -c - if (first) then - first = .false. - zero = 0 - one = 1 - header = 'CORD' - nframe = zero - nprev = zero - ncrdsav = one - nstep = zero - nvelsav = zero - ndfree = zero - nfixat = zero - tdelta = 0.0 - usebox = zero - if (use_bounds) usebox = one - use4d = zero - usefq = zero - merged = zero - vcharmm = 24 - ntitle = one - write (idcd) header,nframe,nprev,ncrdsav,nstep, - & nvelsav,zero,zero,ndfree,nfixat, - & tdelta,usebox,use4d,usefq,merged, - & zero,zero,zero,zero,zero,vcharmm - write (idcd) ntitle,title(1:80) - if (.not. onlysave) then - write (idcd) n - else - write (idcd) nonly - end if - end if -c -c append the lattice values based on header flag value -c - if (use_bounds) then - write (idcd) xbox,gamma_cos,ybox,beta_cos,alpha_cos,zbox - end if -c -c append the static dipoles along each axis in turn -c - if (.not. onlysave) then - write (idcd) (real(debye * rpole(2,i)),i=1,n) - write (idcd) (real(debye * rpole(3,i)),i=1,n) - write (idcd) (real(debye * rpole(4,i)),i=1,n) - else - write (idcd) (real(debye * rpole(2,ionly(i))),i=1,nonly) - write (idcd) (real(debye * rpole(3,ionly(i))),i=1,nonly) - write (idcd) (real(debye * rpole(4,ionly(i))),i=1,nonly) - end if -c -c close the output unit if opened by this routine -c - if (.not. opened) close (unit=idcd) - return - end -c -c -c ############################################################### -c ## ## -c ## subroutine prtuchg -- output of atomic charge dipoles ## -c ## ## -c ############################################################### -c -c -c "prtuchg" writes out a set of charge dipole components -c to an external disk file in Tinker XYZ format -c -c - subroutine prtuchg (istc,xm,ym,zm) - use atomid - use atoms - use bound - use boxes - use couple - use files - use inform - use mpole - use output - use titles - use units - implicit none - integer i,j,k,istc - integer ii - integer size,crdsiz - real*8 crdmin,crdmax - real*8 c,xd,yd,zd - real*8 xm,ym,zm - logical opened - character*2 atmc - character*2 crdc - character*2 digc - character*25 fstr - character*240 stcfile -c -c -c open the output unit if not already done -c - inquire (unit=istc,opened=opened) - if (.not. opened) then - stcfile = filename(1:leng)//'.uchg' - call version (stcfile,'new') - open (unit=istc,file=stcfile,status='new') - end if -c -c check for large systems needing extended formatting -c - atmc = 'i6' - if (n .ge. 100000) atmc = 'i7' - if (n .ge. 1000000) atmc = 'i8' - crdmin = 0.0d0 - crdmax = 0.0d0 - do i = 1, n - crdmin = min(crdmin,x(i),y(i),z(i)) - crdmax = max(crdmax,x(i),y(i),z(i)) - end do - crdsiz = 6 - if (crdmin .le. -1000.0d0) crdsiz = 7 - if (crdmax .ge. 10000.0d0) crdsiz = 7 - if (crdmin .le. -10000.0d0) crdsiz = 8 - if (crdmax .ge. 100000.0d0) crdsiz = 8 - crdsiz = crdsiz + max(6,digits) - size = 0 - call numeral (crdsiz,crdc,size) - if (digits .le. 6) then - digc = '6 ' - else if (digits .le. 8) then - digc = '8' - else - digc = '10' - end if -c -c write out the number of atoms and the title -c - if (.not. onlysave) then - if (ltitle .eq. 0) then - fstr = '('//atmc//')' - write (istc,fstr(1:4)) n - else - fstr = '('//atmc//',2x,a)' - write (istc,fstr(1:9)) n,title(1:ltitle) - end if - else - if (ltitle .eq. 0) then - fstr = '('//atmc//')' - write (istc,fstr(1:4)) nonly - else - fstr = '('//atmc//',2x,a)' - write (istc,fstr(1:9)) nonly,title(1:ltitle) - end if - end if -c -c write out the periodic cell lengths and angles -c - if (use_bounds) then - fstr = '(1x,6f'//crdc//'.'//digc//')' - write (istc,fstr) xbox,ybox,zbox,alpha,beta,gamma - end if -c -c write out the charge dipole components for each atom -c - fstr = '('//atmc//',2x,a3,3f'//crdc// - & '.'//digc//',i6,8'//atmc//')' - if (.not. onlysave) then - do i = 1, n - c = rpole(1,i) - xd = (x(i)-xm) * c * debye - yd = (y(i)-ym) * c * debye - zd = (z(i)-zm) * c * debye - k = n12(i) - if (k .eq. 0) then - write (istc,fstr) i,name(i),xd,yd,zd,type(i) - else - write (istc,fstr) i,name(i),xd,yd,zd,type(i), - & (i12(j,i),j=1,k) - end if - end do - else - do ii = 1, nonly - i = ionly(ii) - c = rpole(1,i) - xd = (x(i)-xm) * c * debye - yd = (y(i)-ym) * c * debye - zd = (z(i)-zm) * c * debye - k = n12(i) - if (k .eq. 0) then - write (istc,fstr) ii,name(i),xd,yd,zd,type(i) - else - write (istc,fstr) ii,name(i),xd,yd,zd,type(i), - & (ionlyinv(i12(j,i)),j=1,k) - end if - end do - end if -c -c close the output unit if opened by this routine -c - if (.not. opened) close (unit=istc) - return - end -c -c -c ############################################################# -c ## ## -c ## subroutine prtdcduc -- output of DCD charge dipoles ## -c ## ## -c ############################################################# -c -c -c "prtdcduc" writes out a set of charge dipole components to -c a file in CHARMM DCD binary format compatible with the VMD -c visualization software and other packages -c -c note the format used is based on the "dcdplugin.c" code from -c the NAMD and VMD programs, and tutorial 4.1 from the software -c package GENESIS: Generalized-Ensemble Simulation System -c -c variables and parameters: -c -c header type of data (CORD=coordinates, VELD=velocities) -c nframe number of frames stored in the DCD file -c nprev number of previous integration steps -c ncrdsav frequency in steps for saving coordinate frames -c nstep number of integration steps in the total run -c nvelsav frequency of coordinate saves with velocity data -c ndfree number of degrees of freedom for the system -c nfixat number of fixed atoms for the system -c usebox flag for periodic boundaries (1=true, 0=false) -c use4d flag for 4D trajectory (1=true, 0=false) -c usefq flag for fluctuating charges (1=true, 0=false) -c merged result of merge without checks (1=true, 0=false) -c vcharmm version of CHARMM software for compatibility -c -c in general a value of zero for any of the above indicates that -c the particular feature is unused -c -c - subroutine prtdcduc (idcd,first,xm,ym,zm) - use atoms - use bound - use boxes - use files - use mpole - use output - use titles - use units - implicit none - integer i,idcd - integer zero,one - integer nframe,nprev - integer ncrdsav,nstep - integer nvelsav,ndfree - integer nfixat,usebox - integer use4d,usefq - integer merged,vcharmm - integer ntitle - real*4 tdelta - real*8 xm,ym,zm - logical opened,first - character*4 header - character*240 dcdfile -c -c -c open the output unit if not already done -c - inquire (unit=idcd,opened=opened) - if (.not. opened) then - dcdfile = filename(1:leng)//'.dcduc' - call version (dcdfile,'new') - open (unit=idcd,file=dcdfile,form='unformatted',status='new') - end if -c -c write header info along with title and number of atoms -c - if (first) then - first = .false. - zero = 0 - one = 1 - header = 'CORD' - nframe = zero - nprev = zero - ncrdsav = one - nstep = zero - nvelsav = zero - ndfree = zero - nfixat = zero - tdelta = 0.0 - usebox = zero - if (use_bounds) usebox = one - use4d = zero - usefq = zero - merged = zero - vcharmm = 24 - ntitle = one - write (idcd) header,nframe,nprev,ncrdsav,nstep, - & nvelsav,zero,zero,ndfree,nfixat, - & tdelta,usebox,use4d,usefq,merged, - & zero,zero,zero,zero,zero,vcharmm - write (idcd) ntitle,title(1:80) - if (.not. onlysave) then - write (idcd) n - else - write (idcd) nonly - end if - end if -c -c append the lattice values based on header flag value -c - if (use_bounds) then - write (idcd) xbox,gamma_cos,ybox,beta_cos,alpha_cos,zbox - end if -c -c append the charge dipoles along each axis in turn -c - if (.not. onlysave) then - write (idcd) (real(debye*(x(i)-xm)*rpole(1,i)),i=1,n) - write (idcd) (real(debye*(y(i)-ym)*rpole(1,i)),i=1,n) - write (idcd) (real(debye*(z(i)-zm)*rpole(1,i)),i=1,n) - else - write (idcd) (real(debye*(x(ionly(i))-xm)*rpole(1,ionly(i))) - & ,i=1,nonly) - write (idcd) (real(debye*(y(ionly(i))-ym)*rpole(1,ionly(i))) - & ,i=1,nonly) - write (idcd) (real(debye*(z(ionly(i))-zm)*rpole(1,ionly(i))) - & ,i=1,nonly) - end if -c -c close the output unit if opened by this routine -c - if (.not. opened) close (unit=idcd) - return - end -c -c -c ############################################################### -c ## ## -c ## subroutine prtudir -- output of atomic direct dipoles ## -c ## ## -c ############################################################### -c -c -c "prtudir" writes out a set of directly induced dipole -c components to an external disk file in Tinker XYZ format -c -c - subroutine prtudir (iind) - use atomid - use atoms - use bound - use boxes - use couple - use expol - use files - use inform - use polar - use polpot - use output - use titles - use units - implicit none - integer i,j,k,iind - integer ii - integer size,crdsiz - real*8 crdmin,crdmax - logical opened - character*2 atmc - character*2 crdc - character*2 digc - character*25 fstr - character*240 indfile -c -c -c open the output unit if not already done -c - inquire (unit=iind,opened=opened) - if (.not. opened) then - indfile = filename(1:leng)//'.udir' - call version (indfile,'new') - open (unit=iind,file=indfile,status='new') - end if -c -c check for large systems needing extended formatting -c - atmc = 'i6' - if (n .ge. 100000) atmc = 'i7' - if (n .ge. 1000000) atmc = 'i8' - crdmin = 0.0d0 - crdmax = 0.0d0 - do i = 1, n - crdmin = min(crdmin,x(i),y(i),z(i)) - crdmax = max(crdmax,x(i),y(i),z(i)) - end do - crdsiz = 6 - if (crdmin .le. -1000.0d0) crdsiz = 7 - if (crdmax .ge. 10000.0d0) crdsiz = 7 - if (crdmin .le. -10000.0d0) crdsiz = 8 - if (crdmax .ge. 100000.0d0) crdsiz = 8 - crdsiz = crdsiz + max(6,digits) - size = 0 - call numeral (crdsiz,crdc,size) - if (digits .le. 6) then - digc = '6 ' - else if (digits .le. 8) then - digc = '8' - else - digc = '10' - end if -c -c write out the number of atoms and the title -c - if (.not. onlysave) then - if (ltitle .eq. 0) then - fstr = '('//atmc//')' - write (iind,fstr(1:4)) n - else - fstr = '('//atmc//',2x,a)' - write (iind,fstr(1:9)) n,title(1:ltitle) - end if - else - if (ltitle .eq. 0) then - fstr = '('//atmc//')' - write (iind,fstr(1:4)) nonly - else - fstr = '('//atmc//',2x,a)' - write (iind,fstr(1:9)) nonly,title(1:ltitle) - end if - end if -c -c write out the periodic cell lengths and angles -c - if (use_bounds) then - fstr = '(1x,6f'//crdc//'.'//digc//')' - write (iind,fstr) xbox,ybox,zbox,alpha,beta,gamma - end if -c -c compute the direct dipoles in Debye units -c - if (.not. use_expol) then - do i = 1, n - do j = 1, 3 - worker3n(j,i) = debye*udir(j,i) - end do - end do - else - do i = 1, n - do j = 1, 3 - worker3n(j,i) = 0.0d0 - do k = 1, 3 - worker3n(j,i)=worker3n(j,i)+udir(k,i)*polinv(j,k,i) - end do - worker3n(j,i) = debye*worker3n(j,i) - end do - end do - end if -c -c write out the direct dipole components for each atom -c - fstr = '('//atmc//',2x,a3,3f'//crdc// - & '.'//digc//',i6,8'//atmc//')' - if (.not. onlysave) then - do i = 1, n - k = n12(i) - if (k .eq. 0) then - write (iind,fstr) i,name(i),(worker3n(j,i),j=1,3), - & type(i) - else - write (iind,fstr) i,name(i),(worker3n(j,i),j=1,3), - & type(i),(i12(j,i),j=1,k) - end if - end do - else - do ii = 1, nonly - i = ionly(ii) - k = n12(i) - if (k .eq. 0) then - write (iind,fstr) ii,name(i),(worker3n(j,i),j=1,3), - & type(i) - else - write (iind,fstr) ii,name(i),(worker3n(j,i),j=1,3), - & type(i), (ionlyinv(i12(j,i)),j=1,k) - end if - end do - end if -c -c close the output unit if opened by this routine -c - if (.not. opened) close (unit=iind) - return - end -c -c -c ############################################################# -c ## ## -c ## subroutine prtdcdud -- output of DCD direct dipoles ## -c ## ## -c ############################################################# -c -c -c "prtdcdud" writes out a set of directly induced dipole -c components to a file in CHARMM DCD binary format compatible -c with the VMD visualization software and other packages -c -c note the format used is based on the "dcdplugin.c" code from -c the NAMD and VMD programs, and tutorial 4.1 from the software -c package GENESIS: Generalized-Ensemble Simulation System -c -c variables and parameters: -c -c header type of data (CORD=coordinates, VELD=velocities) -c nframe number of frames stored in the DCD file -c nprev number of previous integration steps -c ncrdsav frequency in steps for saving coordinate frames -c nstep number of integration steps in the total run -c nvelsav frequency of coordinate saves with velocity data -c ndfree number of degrees of freedom for the system -c nfixat number of fixed atoms for the system -c usebox flag for periodic boundaries (1=true, 0=false) -c use4d flag for 4D trajectory (1=true, 0=false) -c usefq flag for fluctuating charges (1=true, 0=false) -c merged result of merge without checks (1=true, 0=false) -c vcharmm version of CHARMM software for compatibility -c -c in general a value of zero for any of the above indicates that -c the particular feature is unused -c -c - subroutine prtdcdud (idcd,first) - use atoms - use bound - use boxes - use expol - use files - use polar - use polpot - use output - use titles - use units - implicit none - integer i,idcd - integer j,k - integer zero,one - integer nframe,nprev - integer ncrdsav,nstep - integer nvelsav,ndfree - integer nfixat,usebox - integer use4d,usefq - integer merged,vcharmm - integer ntitle - real*4 tdelta - logical opened,first - character*4 header - character*240 dcdfile -c -c -c open the output unit if not already done -c - inquire (unit=idcd,opened=opened) - if (.not. opened) then - dcdfile = filename(1:leng)//'.dcdud' - call version (dcdfile,'new') - open (unit=idcd,file=dcdfile,form='unformatted',status='new') - end if -c -c write header info along with title and number of atoms -c - if (first) then - first = .false. - zero = 0 - one = 1 - header = 'CORD' - nframe = zero - nprev = zero - ncrdsav = one - nstep = zero - nvelsav = zero - ndfree = zero - nfixat = zero - tdelta = 0.0 - usebox = zero - if (use_bounds) usebox = one - use4d = zero - usefq = zero - merged = zero - vcharmm = 24 - ntitle = one - write (idcd) header,nframe,nprev,ncrdsav,nstep, - & nvelsav,zero,zero,ndfree,nfixat, - & tdelta,usebox,use4d,usefq,merged, - & zero,zero,zero,zero,zero,vcharmm - write (idcd) ntitle,title(1:80) - if (.not. onlysave) then - write (idcd) n - else - write (idcd) nonly - end if - end if -c -c append the lattice values based on header flag value -c - if (use_bounds) then - write (idcd) xbox,gamma_cos,ybox,beta_cos,alpha_cos,zbox - end if -c -c compute the direct dipoles in Debye units -c - if (.not. use_expol) then - do i = 1, n - do j = 1, 3 - worker3n(j,i) = debye*udir(j,i) - end do - end do - else - do i = 1, n - do j = 1, 3 - worker3n(j,i) = 0.0d0 - do k = 1, 3 - worker3n(j,i)=worker3n(j,i)+udir(k,i)*polinv(j,k,i) - end do - worker3n(j,i) = debye*worker3n(j,i) - end do - end do - end if -c -c append the direct dipoles along each axis in turn -c - if (.not. onlysave) then - write (idcd) (real(worker3n(1,i)),i=1,n) - write (idcd) (real(worker3n(2,i)),i=1,n) - write (idcd) (real(worker3n(3,i)),i=1,n) - else - write (idcd) (real(worker3n(1,ionly(i))),i=1,nonly) - write (idcd) (real(worker3n(2,ionly(i))),i=1,nonly) - write (idcd) (real(worker3n(3,ionly(i))),i=1,nonly) - end if -c -c close the output unit if opened by this routine -c - if (.not. opened) close (unit=idcd) - return - end -c -c -c ############################################################# -c ## ## -c ## subroutine prtdef -- output of atomic direct efield ## -c ## ## -c ############################################################# -c -c -c "prtdef" writes out a set of direct electric field components -c to an external disk file in Tinker XYZ format -c -c - subroutine prtdef (iind) - use atomid - use atoms - use bound - use boxes - use couple - use files - use inform - use polar - use polpot - use output - use titles - use units - implicit none - integer i,j,k,iind - integer ii - integer size,crdsiz - real*8 c - real*8 crdmin,crdmax - logical opened - character*2 atmc - character*2 crdc - character*2 digc - character*25 fstr - character*240 indfile -c -c -c open the output unit if not already done -c - inquire (unit=iind,opened=opened) - if (.not. opened) then - indfile = filename(1:leng)//'.def' - call version (indfile,'new') - open (unit=iind,file=indfile,status='new') - end if -c -c check for large systems needing extended formatting -c - atmc = 'i6' - if (n .ge. 100000) atmc = 'i7' - if (n .ge. 1000000) atmc = 'i8' - crdmin = 0.0d0 - crdmax = 0.0d0 - do i = 1, n - crdmin = min(crdmin,x(i),y(i),z(i)) - crdmax = max(crdmax,x(i),y(i),z(i)) - end do - crdsiz = 6 - if (crdmin .le. -1000.0d0) crdsiz = 7 - if (crdmax .ge. 10000.0d0) crdsiz = 7 - if (crdmin .le. -10000.0d0) crdsiz = 8 - if (crdmax .ge. 100000.0d0) crdsiz = 8 - crdsiz = crdsiz + max(6,digits) - size = 0 - call numeral (crdsiz,crdc,size) - if (digits .le. 6) then - digc = '6 ' - else if (digits .le. 8) then - digc = '8' - else - digc = '10' - end if -c -c write out the number of atoms and the title -c - if (.not. onlysave) then - if (ltitle .eq. 0) then - fstr = '('//atmc//')' - write (iind,fstr(1:4)) n - else - fstr = '('//atmc//',2x,a)' - write (iind,fstr(1:9)) n,title(1:ltitle) - end if - else - if (ltitle .eq. 0) then - fstr = '('//atmc//')' - write (iind,fstr(1:4)) nonly - else - fstr = '('//atmc//',2x,a)' - write (iind,fstr(1:9)) nonly,title(1:ltitle) - end if - end if -c -c write out the periodic cell lengths and angles -c - if (use_bounds) then - fstr = '(1x,6f'//crdc//'.'//digc//')' - write (iind,fstr) xbox,ybox,zbox,alpha,beta,gamma - end if -c -c compute the direct electric field components in MV/cm units -c - do i = 1, n - c = elefield/polarity(i) - do j = 1, 3 - worker3n(j,i) = c * udir(j,i) - end do - end do -c -c write out the direct electric field components for each atom -c - fstr = '('//atmc//',2x,a3,3f'//crdc// - & '.'//digc//',i6,8'//atmc//')' - if (.not. onlysave) then - do i = 1, n - k = n12(i) - if (k .eq. 0) then - write (iind,fstr) i,name(i),(worker3n(j,i),j=1,3), - & type(i) - else - write (iind,fstr) i,name(i),(worker3n(j,i),j=1,3), - & type(i),(i12(j,i),j=1,k) - end if - end do - else - do ii = 1, nonly - i = ionly(ii) - k = n12(i) - if (k .eq. 0) then - write (iind,fstr) ii,name(i),(worker3n(j,i),j=1,3), - & type(i) - else - write (iind,fstr) ii,name(i),(worker3n(j,i),j=1,3), - & type(i), (ionlyinv(i12(j,i)),j=1,k) - end if - end do - end if -c -c close the output unit if opened by this routine -c - if (.not. opened) close (unit=iind) - return - end -c -c -c ############################################################ -c ## ## -c ## subroutine prtdcdde -- output of DCD direct efield ## -c ## ## -c ############################################################ -c -c -c "prtdcdde" writes out a set of direct electric field components -c to a file in CHARMM DCD binary format compatible with the VMD -c visualization software and other packages -c -c note the format used is based on the "dcdplugin.c" code from -c the NAMD and VMD programs, and tutorial 4.1 from the software -c package GENESIS: Generalized-Ensemble Simulation System -c -c variables and parameters: -c -c header type of data (CORD=coordinates, VELD=velocities) -c nframe number of frames stored in the DCD file -c nprev number of previous integration steps -c ncrdsav frequency in steps for saving coordinate frames -c nstep number of integration steps in the total run -c nvelsav frequency of coordinate saves with velocity data -c ndfree number of degrees of freedom for the system -c nfixat number of fixed atoms for the system -c usebox flag for periodic boundaries (1=true, 0=false) -c use4d flag for 4D trajectory (1=true, 0=false) -c usefq flag for fluctuating charges (1=true, 0=false) -c merged result of merge without checks (1=true, 0=false) -c vcharmm version of CHARMM software for compatibility -c -c in general a value of zero for any of the above indicates that -c the particular feature is unused -c -c - subroutine prtdcdde (idcd,first) - use atoms - use bound - use boxes - use files - use polar - use polpot - use output - use titles - use units - implicit none - integer i,idcd - integer j - integer zero,one - integer nframe,nprev - integer ncrdsav,nstep - integer nvelsav,ndfree - integer nfixat,usebox - integer use4d,usefq - integer merged,vcharmm - integer ntitle - real*8 c - real*4 tdelta - logical opened,first - character*4 header - character*240 dcdfile -c -c -c open the output unit if not already done -c - inquire (unit=idcd,opened=opened) - if (.not. opened) then - dcdfile = filename(1:leng)//'.dcdde' - call version (dcdfile,'new') - open (unit=idcd,file=dcdfile,form='unformatted',status='new') - end if -c -c write header info along with title and number of atoms -c - if (first) then - first = .false. - zero = 0 - one = 1 - header = 'CORD' - nframe = zero - nprev = zero - ncrdsav = one - nstep = zero - nvelsav = zero - ndfree = zero - nfixat = zero - tdelta = 0.0 - usebox = zero - if (use_bounds) usebox = one - use4d = zero - usefq = zero - merged = zero - vcharmm = 24 - ntitle = one - write (idcd) header,nframe,nprev,ncrdsav,nstep, - & nvelsav,zero,zero,ndfree,nfixat, - & tdelta,usebox,use4d,usefq,merged, - & zero,zero,zero,zero,zero,vcharmm - write (idcd) ntitle,title(1:80) - if (.not. onlysave) then - write (idcd) n - else - write (idcd) nonly - end if - end if -c -c append the lattice values based on header flag value -c - if (use_bounds) then - write (idcd) xbox,gamma_cos,ybox,beta_cos,alpha_cos,zbox - end if -c -c compute the direct electric field components in MV/cm units -c - do i = 1, n - c = elefield/polarity(i) - do j = 1, 3 - worker3n(j,i) = c * udir(j,i) - end do - end do - -c -c append the direct electric field along each axis in turn -c - if (.not. onlysave) then - write (idcd) (real(worker3n(1,i)),i=1,n) - write (idcd) (real(worker3n(2,i)),i=1,n) - write (idcd) (real(worker3n(3,i)),i=1,n) - else - write (idcd) (real(worker3n(1,ionly(i))),i=1,nonly) - write (idcd) (real(worker3n(2,ionly(i))),i=1,nonly) - write (idcd) (real(worker3n(3,ionly(i))),i=1,nonly) - end if -c -c close the output unit if opened by this routine -c - if (.not. opened) close (unit=idcd) - return - end -c -c -c ############################################################ -c ## ## -c ## subroutine prttef -- output of atomic total efield ## -c ## ## -c ############################################################ -c -c -c "prttef" writes out a set of total electric field components -c to an external disk file in Tinker XYZ format -c -c - subroutine prttef (iind) - use atomid - use atoms - use bound - use boxes - use couple - use expol - use files - use inform - use polar - use polpot - use output - use titles - use units - implicit none - integer i,j,k,iind - integer ii - integer size,crdsiz - real*8 c - real*8 crdmin,crdmax - logical opened - character*2 atmc - character*2 crdc - character*2 digc - character*25 fstr - character*240 indfile -c -c -c open the output unit if not already done -c - inquire (unit=iind,opened=opened) - if (.not. opened) then - indfile = filename(1:leng)//'.tef' - call version (indfile,'new') - open (unit=iind,file=indfile,status='new') - end if -c -c check for large systems needing extended formatting -c - atmc = 'i6' - if (n .ge. 100000) atmc = 'i7' - if (n .ge. 1000000) atmc = 'i8' - crdmin = 0.0d0 - crdmax = 0.0d0 - do i = 1, n - crdmin = min(crdmin,x(i),y(i),z(i)) - crdmax = max(crdmax,x(i),y(i),z(i)) - end do - crdsiz = 6 - if (crdmin .le. -1000.0d0) crdsiz = 7 - if (crdmax .ge. 10000.0d0) crdsiz = 7 - if (crdmin .le. -10000.0d0) crdsiz = 8 - if (crdmax .ge. 100000.0d0) crdsiz = 8 - crdsiz = crdsiz + max(6,digits) - size = 0 - call numeral (crdsiz,crdc,size) - if (digits .le. 6) then - digc = '6 ' - else if (digits .le. 8) then - digc = '8' - else - digc = '10' - end if -c -c write out the number of atoms and the title -c - if (.not. onlysave) then - if (ltitle .eq. 0) then - fstr = '('//atmc//')' - write (iind,fstr(1:4)) n - else - fstr = '('//atmc//',2x,a)' - write (iind,fstr(1:9)) n,title(1:ltitle) - end if - else - if (ltitle .eq. 0) then - fstr = '('//atmc//')' - write (iind,fstr(1:4)) nonly - else - fstr = '('//atmc//',2x,a)' - write (iind,fstr(1:9)) nonly,title(1:ltitle) - end if - end if -c -c write out the periodic cell lengths and angles -c - if (use_bounds) then - fstr = '(1x,6f'//crdc//'.'//digc//')' - write (iind,fstr) xbox,ybox,zbox,alpha,beta,gamma - end if -c -c compute the total electric field components in MV/cm units -c - if (.not. use_expol) then - do i = 1, n - c = elefield/polarity(i) - do j = 1, 3 - worker3n(j,i) = c * uind(j,i) - end do - end do - else - do i = 1, n - c = elefield/polarity(i) - do j = 1, 3 - worker3n(j,i) = 0.0d0 - do k = 1, 3 - worker3n(j,i)=worker3n(j,i)+uind(k,i)*polscale(j,k,i) - end do - worker3n(j,i) = c * worker3n(j,i) - end do - end do - end if -c -c write out the total electric field components for each atom -c - fstr = '('//atmc//',2x,a3,3f'//crdc// - & '.'//digc//',i6,8'//atmc//')' - if (.not. onlysave) then - do i = 1, n - k = n12(i) - if (k .eq. 0) then - write (iind,fstr) i,name(i),(worker3n(j,i),j=1,3), - & type(i) - else - write (iind,fstr) i,name(i),(worker3n(j,i),j=1,3), - & type(i),(i12(j,i),j=1,k) - end if - end do - else - do ii = 1, nonly - i = ionly(ii) - k = n12(i) - if (k .eq. 0) then - write (iind,fstr) ii,name(i),(worker3n(j,i),j=1,3), - & type(i) - else - write (iind,fstr) ii,name(i),(worker3n(j,i),j=1,3), - & type(i), (ionlyinv(i12(j,i)),j=1,k) - end if - end do - end if -c -c close the output unit if opened by this routine -c - if (.not. opened) close (unit=iind) - return - end -c -c -c ########################################################### -c ## ## -c ## subroutine prtdcdte -- output of DCD total efield ## -c ## ## -c ########################################################### -c -c -c "prtdcdte" writes out a set of total electric field components -c to a file in CHARMM DCD binary format compatible with the VMD -c visualization software and other packages -c -c note the format used is based on the "dcdplugin.c" code from -c the NAMD and VMD programs, and tutorial 4.1 from the software -c package GENESIS: Generalized-Ensemble Simulation System -c -c variables and parameters: -c -c header type of data (CORD=coordinates, VELD=velocities) -c nframe number of frames stored in the DCD file -c nprev number of previous integration steps -c ncrdsav frequency in steps for saving coordinate frames -c nstep number of integration steps in the total run -c nvelsav frequency of coordinate saves with velocity data -c ndfree number of degrees of freedom for the system -c nfixat number of fixed atoms for the system -c usebox flag for periodic boundaries (1=true, 0=false) -c use4d flag for 4D trajectory (1=true, 0=false) -c usefq flag for fluctuating charges (1=true, 0=false) -c merged result of merge without checks (1=true, 0=false) -c vcharmm version of CHARMM software for compatibility -c -c in general a value of zero for any of the above indicates that -c the particular feature is unused -c -c - subroutine prtdcdte (idcd,first) - use atoms - use bound - use boxes - use expol - use files - use polar - use polpot - use output - use titles - use units - implicit none - integer i,idcd - integer j,k - integer zero,one - integer nframe,nprev - integer ncrdsav,nstep - integer nvelsav,ndfree - integer nfixat,usebox - integer use4d,usefq - integer merged,vcharmm - integer ntitle - real*8 c - real*4 tdelta - logical opened,first - character*4 header - character*240 dcdfile -c -c -c open the output unit if not already done -c - inquire (unit=idcd,opened=opened) - if (.not. opened) then - dcdfile = filename(1:leng)//'.dcdte' - call version (dcdfile,'new') - open (unit=idcd,file=dcdfile,form='unformatted',status='new') - end if -c -c write header info along with title and number of atoms -c - if (first) then - first = .false. - zero = 0 - one = 1 - header = 'CORD' - nframe = zero - nprev = zero - ncrdsav = one - nstep = zero - nvelsav = zero - ndfree = zero - nfixat = zero - tdelta = 0.0 - usebox = zero - if (use_bounds) usebox = one - use4d = zero - usefq = zero - merged = zero - vcharmm = 24 - ntitle = one - write (idcd) header,nframe,nprev,ncrdsav,nstep, - & nvelsav,zero,zero,ndfree,nfixat, - & tdelta,usebox,use4d,usefq,merged, - & zero,zero,zero,zero,zero,vcharmm - write (idcd) ntitle,title(1:80) - if (.not. onlysave) then - write (idcd) n - else - write (idcd) nonly - end if - end if -c -c append the lattice values based on header flag value -c - if (use_bounds) then - write (idcd) xbox,gamma_cos,ybox,beta_cos,alpha_cos,zbox - end if -c -c compute the total electric field components in MV/cm units -c - if (.not. use_expol) then - do i = 1, n - c = elefield/polarity(i) - do j = 1, 3 - worker3n(j,i) = c * uind(j,i) - end do - end do - else - do i = 1, n - c = elefield/polarity(i) - do j = 1, 3 - worker3n(j,i) = 0.0d0 - do k = 1, 3 - worker3n(j,i)=worker3n(j,i)+uind(k,i)*polscale(j,k,i) - end do - worker3n(j,i) = c * worker3n(j,i) - end do - end do - end if - -c -c append the total electric field along each axis in turn -c - if (.not. onlysave) then - write (idcd) (real(worker3n(1,i)),i=1,n) - write (idcd) (real(worker3n(2,i)),i=1,n) - write (idcd) (real(worker3n(3,i)),i=1,n) - else - write (idcd) (real(worker3n(1,ionly(i))),i=1,nonly) - write (idcd) (real(worker3n(2,ionly(i))),i=1,nonly) - write (idcd) (real(worker3n(3,ionly(i))),i=1,nonly) - end if -c -c close the output unit if opened by this routine -c - if (.not. opened) close (unit=idcd) - return - end diff --git a/source/prtvel.f b/source/prtvel.f deleted file mode 100644 index 1b6a12341..000000000 --- a/source/prtvel.f +++ /dev/null @@ -1,264 +0,0 @@ -c -c -c ################################################### -c ## COPYRIGHT (C) 2023 by Jay William Ponder ## -c ## All Rights Reserved ## -c ################################################### -c -c ############################################################ -c ## ## -c ## subroutine prtvel -- output of velocity components ## -c ## ## -c ############################################################ -c -c -c "prtvel" writes out a set of atomic velocity components -c to an external disk file in Tinker XYZ format -c -c - subroutine prtvel (ivel) - use atomid - use atoms - use bound - use boxes - use couple - use files - use inform - use moldyn - use output - use titles - implicit none - integer i,j,k,ivel - integer ii - integer size,crdsiz - real*8 crdmin,crdmax - logical opened - character*2 atmc - character*2 crdc - character*2 digc - character*25 fstr - character*240 velfile -c -c -c open the output unit if not already done -c - inquire (unit=ivel,opened=opened) - if (.not. opened) then - velfile = filename(1:leng)//'.vel' - call version (velfile,'new') - open (unit=ivel,file=velfile,status='new') - end if -c -c check for large systems needing extended formatting -c - atmc = 'i6' - if (n .ge. 100000) atmc = 'i7' - if (n .ge. 1000000) atmc = 'i8' - crdmin = 0.0d0 - crdmax = 0.0d0 - do i = 1, n - crdmin = min(crdmin,x(i),y(i),z(i)) - crdmax = max(crdmax,x(i),y(i),z(i)) - end do - crdsiz = 6 - if (crdmin .le. -1000.0d0) crdsiz = 7 - if (crdmax .ge. 10000.0d0) crdsiz = 7 - if (crdmin .le. -10000.0d0) crdsiz = 8 - if (crdmax .ge. 100000.0d0) crdsiz = 8 - crdsiz = crdsiz + max(6,digits) - size = 0 - call numeral (crdsiz,crdc,size) - if (digits .le. 6) then - digc = '6 ' - else if (digits .le. 8) then - digc = '8' - else - digc = '10' - end if -c -c write out the number of atoms and the title -c - if (.not. onlysave) then - if (ltitle .eq. 0) then - fstr = '('//atmc//')' - write (ivel,fstr(1:4)) n - else - fstr = '('//atmc//',2x,a)' - write (ivel,fstr(1:9)) n,title(1:ltitle) - end if - else - if (ltitle .eq. 0) then - fstr = '('//atmc//')' - write (ivel,fstr(1:4)) nonly - else - fstr = '('//atmc//',2x,a)' - write (ivel,fstr(1:9)) nonly,title(1:ltitle) - end if - end if -c -c write out the periodic cell lengths and angles -c - if (use_bounds) then - fstr = '(1x,6f'//crdc//'.'//digc//')' - write (ivel,fstr) xbox,ybox,zbox,alpha,beta,gamma - end if -c -c write out the velocity components for each atom -c - fstr = '('//atmc//',2x,a3,3f'//crdc// - & '.'//digc//',i6,8'//atmc//')' - if (.not. onlysave) then - do i = 1, n - k = n12(i) - if (k .eq. 0) then - write (ivel,fstr) i,name(i),(v(j,i),j=1,3),type(i) - else - write (ivel,fstr) i,name(i),(v(j,i),j=1,3),type(i), - & (i12(j,i),j=1,k) - end if - end do - else - do ii = 1, nonly - i = ionly(ii) - k = n12(i) - if (k .eq. 0) then - write (ivel,fstr) ii,name(i),(v(j,i),j=1,3),type(i) - else - write (ivel,fstr) ii,name(i),(v(j,i),j=1,3),type(i), - & (ionlyinv(i12(j,i)),j=1,k) - end if - end do - end if -c -c close the output unit if opened by this routine -c - if (.not. opened) close (unit=ivel) - return - end -c -c -c ################################################################# -c ## ## -c ## subroutine prtdcdv -- output of DCD velocity components ## -c ## ## -c ################################################################# -c -c -c "prtdcdv" writes out a set of atomic velocity components to -c a file in CHARMM DCD binary format compatible with the VMD -c visualization software and other packages -c -c note the format used is based on the "dcdplugin.c" code from -c the NAMD and VMD programs, and tutorial 4.1 from the software -c package GENESIS: Generalized-Ensemble Simulation System -c -c variables and parameters: -c -c header type of data (CORD=coordinates, VELD=velocities) -c nframe number of frames stored in the DCD file -c nprev number of previous integration steps -c ncrdsav frequency in steps for saving coordinate frames -c nstep number of integration steps in the total run -c nvelsav frequency of coordinate saves with velocity data -c ndfree number of degrees of freedom for the system -c nfixat number of fixed atoms for the system -c usebox flag for periodic boundaries (1=true, 0=false) -c use4d flag for 4D trajectory (1=true, 0=false) -c usefq flag for fluctuating charges (1=true, 0=false) -c merged result of merge without checks (1=true, 0=false) -c vcharmm version of CHARMM software for compatibility -c -c in general a value of zero for any of the above indicates that -c the particular feature is unused -c -c - subroutine prtdcdv (idcd,first) - use atoms - use bound - use boxes - use files - use moldyn - use output - use titles - implicit none - integer i,idcd - integer zero,one - integer nframe,nprev - integer ncrdsav,nstep - integer nvelsav,ndfree - integer nfixat,usebox - integer use4d,usefq - integer merged,vcharmm - integer ntitle - real*4 tdelta - logical opened,first - character*4 header - character*240 dcdfile -c -c -c open the output unit if not already done -c - inquire (unit=idcd,opened=opened) - if (.not. opened) then - dcdfile = filename(1:leng)//'.dcdv' - call version (dcdfile,'new') - open (unit=idcd,file=dcdfile,form='unformatted',status='new') - end if -c -c write header info along with title and number of atoms -c - if (first) then - first = .false. - zero = 0 - one = 1 - header = 'CORD' - nframe = zero - nprev = zero - ncrdsav = one - nstep = zero - nvelsav = zero - ndfree = zero - nfixat = zero - tdelta = 0.0 - usebox = zero - if (use_bounds) usebox = one - use4d = zero - usefq = zero - merged = zero - vcharmm = 24 - ntitle = one - write (idcd) header,nframe,nprev,ncrdsav,nstep, - & nvelsav,zero,zero,ndfree,nfixat, - & tdelta,usebox,use4d,usefq,merged, - & zero,zero,zero,zero,zero,vcharmm - write (idcd) ntitle,title(1:80) - if (.not. onlysave) then - write (idcd) n - else - write (idcd) nonly - end if - end if -c -c append the lattice values based on header flag value -c - if (use_bounds) then - write (idcd) xbox,gamma_cos,ybox,beta_cos,alpha_cos,zbox - end if -c -c append the velocity components along each axis in turn -c - if (.not. onlysave) then - write (idcd) (real(v(1,i)),i=1,n) - write (idcd) (real(v(2,i)),i=1,n) - write (idcd) (real(v(3,i)),i=1,n) - else - write (idcd) (real(v(1,ionly(i))),i=1,nonly) - write (idcd) (real(v(2,ionly(i))),i=1,nonly) - write (idcd) (real(v(3,ionly(i))),i=1,nonly) - end if -c -c close the output unit if opened by this routine -c - if (.not. opened) close (unit=idcd) - return - end diff --git a/source/prtxyz.f b/source/prtxyz.f index 62d551eaa..99629e6db 100644 --- a/source/prtxyz.f +++ b/source/prtxyz.f @@ -136,6 +136,282 @@ subroutine prtxyz (ixyz) end c c +c ########################################################### +c ## ## +c ## subroutine prtvec3 -- output of atomic 3D vectors ## +c ## ## +c ########################################################### +c +c +c "prtvec3" writes out a set of atomic vectors +c to an external disk file in Tinker XYZ format +c +c + subroutine prtvec3 (iunit,mode) + use atomid + use atoms + use bound + use boxes + use couple + use files + use inform + use output + use titles + implicit none + integer i,j,k + integer ii,iunit + integer size,crdsiz + real*8 crdmin,crdmax + logical opened + character*2 atmc + character*2 crdc + character*2 digc + character*3 mode + character*25 fstr + character*240 outputfile +c +c +c open the output unit if not already done +c + inquire (unit=iunit,opened=opened) + if (.not. opened) then + if (mode .eq. 'XYZ') then + outputfile = filename(1:leng)//'.xyz' + else if (mode .eq. 'VEL') then + outputfile = filename(1:leng)//'.vel' + else if (mode .eq. 'FRC') then + outputfile = filename(1:leng)//'.frc' + else if (mode .eq. 'UIN') then + outputfile = filename(1:leng)//'.uind' + else if (mode .eq. 'UST') then + outputfile = filename(1:leng)//'.ustc' + else if (mode .eq. 'UCH') then + outputfile = filename(1:leng)//'.uchg' + else if (mode .eq. 'UDR') then + outputfile = filename(1:leng)//'.udir' + else if (mode .eq. 'DEF') then + outputfile = filename(1:leng)//'.def' + else if (mode .eq. 'TEF') then + outputfile = filename(1:leng)//'.tef' + end if + call version (outputfile,'new') + open (unit=iunit,file=outputfile,status='new') + end if +c +c copy the vector values to a common array +c + call copyvec3 (print3n,mode) +c +c check for large systems needing extended formatting +c + atmc = 'i6' + if (n .ge. 100000) atmc = 'i7' + if (n .ge. 1000000) atmc = 'i8' + crdmin = 0.0d0 + crdmax = 0.0d0 + do i = 1, n + crdmin = min(crdmin,print3n(1,i),print3n(2,i),print3n(3,i)) + crdmax = max(crdmax,print3n(1,i),print3n(2,i),print3n(3,i)) + end do + crdsiz = 6 + if (crdmin .le. -1000.0d0) crdsiz = 7 + if (crdmax .ge. 10000.0d0) crdsiz = 7 + if (crdmin .le. -10000.0d0) crdsiz = 8 + if (crdmax .ge. 100000.0d0) crdsiz = 8 + crdsiz = crdsiz + max(6,digits) + size = 0 + call numeral (crdsiz,crdc,size) + if (digits .le. 6) then + digc = '6 ' + else if (digits .le. 8) then + digc = '8' + else + digc = '10' + end if +c +c write out the number of atoms and the title +c + if (.not. onlysave) then + if (ltitle .eq. 0) then + fstr = '('//atmc//')' + write (iunit,fstr(1:4)) n + else + fstr = '('//atmc//',2x,a)' + write (iunit,fstr(1:9)) n,title(1:ltitle) + end if + else + if (ltitle .eq. 0) then + fstr = '('//atmc//')' + write (iunit,fstr(1:4)) nonly + else + fstr = '('//atmc//',2x,a)' + write (iunit,fstr(1:9)) nonly,title(1:ltitle) + end if + end if +c +c write out the periodic cell lengths and angles +c + if (use_bounds) then + fstr = '(1x,6f'//crdc//'.'//digc//')' + write (iunit,fstr) xbox,ybox,zbox,alpha,beta,gamma + end if +c +c write out the atomic coordinates for each atom +c + fstr = '('//atmc//',2x,a3,3f'//crdc// + & '.'//digc//',i6,8'//atmc//')' + if (.not. onlysave) then + do i = 1, n + k = n12(i) + if (k .eq. 0) then + write (iunit,fstr) i,name(i),(print3n(j,i),j=1,3), + & type(i) + else + write (iunit,fstr) i,name(i),(print3n(j,i),j=1,3), + & type(i),(i12(j,i),j=1,k) + end if + end do + else + do ii = 1, nonly + i = ionly(ii) + k = n12(i) + if (k .eq. 0) then + write (iunit,fstr) ii,name(i),(print3n(j,i),j=1,3), + & type(i) + else + write (iunit,fstr) ii,name(i),(print3n(j,i),j=1,3), + & type(i),(ionlyinv(i12(j,i)),j=1,k) + end if + end do + end if +c +c close the output unit if opened by this routine +c + if (.not. opened) close (unit=iunit) + return + end +c +c +c ############################################################## +c ## ## +c ## subroutine copyvec3 -- copy vector values to print3n ## +c ## ## +c ############################################################## +c +c +c "copyvec3" copies the values of the requested vector to the +c common array "print3n" +c +c + subroutine copyvec3 (print3n,mode) + use atoms + use boxes + use deriv + use expol + use moldyn + use mpole + use polar + use polpot + use units + implicit none + integer i,j,k + real*8 c + real*8 xi,yi,zi + real*8 print3n(3,*) + character*3 mode +c +c +c copy the requested vector values to the common array "print3n" +c + if (mode .eq. 'XYZ') then + do i = 1, n + print3n(1,i) = x(i) + print3n(2,i) = y(i) + print3n(3,i) = z(i) + end do + else if (mode .eq. 'VEL') then + do i = 1, n + print3n(1,i) = v(1,i) + print3n(2,i) = v(2,i) + print3n(3,i) = v(3,i) + end do + else if (mode .eq. 'FRC') then + do i = 1, n + print3n(1,i) = -desum(1,i) + print3n(2,i) = -desum(2,i) + print3n(3,i) = -desum(3,i) + end do + else if (mode .eq. 'UIN') then + do i = 1, n + print3n(1,i) = debye*uind(1,i) + print3n(2,i) = debye*uind(2,i) + print3n(3,i) = debye*uind(3,i) + end do + else if (mode .eq. 'UST') then + do i = 1, n + print3n(1,i) = debye*rpole(2,i) + print3n(2,i) = debye*rpole(3,i) + print3n(3,i) = debye*rpole(4,i) + end do + else if (mode .eq. 'UCH') then + do i = 1, n + c = rpole(1,i) + print3n(1,i) = c*debye*(x(i)-xcenter) + print3n(2,i) = c*debye*(y(i)-ycenter) + print3n(3,i) = c*debye*(z(i)-zcenter) + end do + else if (mode .eq. 'UDR') then + if (.not. use_expol) then + do i = 1, n + do j = 1, 3 + print3n(j,i) = debye*udir(j,i) + end do + end do + else + do i = 1, n + do j = 1, 3 + print3n(j,i) = 0.0d0 + do k = 1, 3 + print3n(j,i) = print3n(j,i) + & + udir(k,i)*polinv(j,k,i) + end do + print3n(j,i) = debye*print3n(j,i) + end do + end do + end if + else if (mode .eq. 'DEF') then + do i = 1, n + c = elefield/polarity(i) + do j = 1, 3 + print3n(j,i) = c * udir(j,i) + end do + end do + else if (mode .eq. 'TEF') then + if (.not. use_expol) then + do i = 1, n + c = elefield/polarity(i) + do j = 1, 3 + print3n(j,i) = c * uind(j,i) + end do + end do + else + do i = 1, n + c = elefield/polarity(i) + do j = 1, 3 + print3n(j,i) = 0.0d0 + do k = 1, 3 + print3n(j,i) = print3n(j,i) + & + uind(k,i)*polscale(j,k,i) + end do + print3n(j,i) = c * print3n(j,i) + end do + end do + end if + end if + return + end +c +c c ############################################################### c ## ## c ## subroutine prtdcd -- output of DCD atomic coordinates ## @@ -260,3 +536,157 @@ subroutine prtdcd (idcd,first) if (.not. opened) close (unit=idcd) return end +c +c +c ################################################################ +c ## ## +c ## subroutine prtdcdv3 -- output of DCD atomic 3D vectors ## +c ## ## +c ################################################################ +c +c +c "prtdcdV3" writes out a set of atomic 3D vectors to +c a file in CHARMM DCD binary format compatible with the VMD +c visualization software and other packages +c +c note the format used is based on the "dcdplugin.c" code from +c the NAMD and VMD programs, and tutorial 4.1 from the software +c package GENESIS: Generalized-Ensemble Simulation System +c +c variables and parameters: +c +c header type of data (CORD=coordinates, VELD=velocities) +c nframe number of frames stored in the DCD file +c nprev number of previous integration steps +c ncrdsav frequency in steps for saving coordinate frames +c nstep number of integration steps in the total run +c nvelsav frequency of coordinate saves with velocity data +c ndfree number of degrees of freedom for the system +c nfixat number of fixed atoms for the system +c usebox flag for periodic boundaries (1=true, 0=false) +c use4d flag for 4D trajectory (1=true, 0=false) +c usefq flag for fluctuating charges (1=true, 0=false) +c merged result of merge without checks (1=true, 0=false) +c vcharmm version of CHARMM software for compatibility +c +c in general a value of zero for any of the above indicates that +c the particular feature is unused +c +c + subroutine prtdcdv3 (idcd,first,mode) + use atoms + use bound + use boxes + use files + use output + use titles + implicit none + integer i,idcd + integer zero,one + integer nframe,nprev + integer ncrdsav,nstep + integer nvelsav,ndfree + integer nfixat,usebox + integer use4d,usefq + integer merged,vcharmm + integer ntitle + real*4 tdelta + logical opened,first + character*3 mode + character*4 header + character*240 dcdfile +c +c +c open the output unit if not already done +c + inquire (unit=idcd,opened=opened) + if (.not. opened) then + dcdfile = filename(1:leng)//'.dcd' + call version (dcdfile,'new') + open (unit=idcd,file=dcdfile,form='unformatted',status='new') + end if + if (.not. opened) then + if (mode .eq. 'XYZ') then + dcdfile = filename(1:leng)//'.dcd' + else if (mode .eq. 'VEL') then + dcdfile = filename(1:leng)//'.dcdv' + else if (mode .eq. 'FRC') then + dcdfile = filename(1:leng)//'.dcdf' + else if (mode .eq. 'UIN') then + dcdfile = filename(1:leng)//'.dcdui' + else if (mode .eq. 'UST') then + dcdfile = filename(1:leng)//'.dcdus' + else if (mode .eq. 'UCH') then + dcdfile = filename(1:leng)//'.dcduc' + else if (mode .eq. 'UDR') then + dcdfile = filename(1:leng)//'.dcdud' + else if (mode .eq. 'DEF') then + dcdfile = filename(1:leng)//'.dcdde' + else if (mode .eq. 'TEF') then + dcdfile = filename(1:leng)//'.dcdte' + end if + call version (dcdfile,'new') + open (unit=idcd,file=dcdfile,form='unformatted',status='new') + end if +c +c write header info along with title and number of atoms +c + if (first) then + first = .false. + zero = 0 + one = 1 + header = 'CORD' + nframe = zero + nprev = zero + ncrdsav = one + nstep = zero + nvelsav = zero + ndfree = zero + nfixat = zero + tdelta = 0.0 + usebox = zero + if (use_bounds) usebox = one + use4d = zero + usefq = zero + merged = zero + vcharmm = 24 + ntitle = one + write (idcd) header,nframe,nprev,ncrdsav,nstep, + & nvelsav,zero,zero,ndfree,nfixat, + & tdelta,usebox,use4d,usefq,merged, + & zero,zero,zero,zero,zero,vcharmm + write (idcd) ntitle,title(1:80) + if (.not. onlysave) then + write (idcd) n + else + write (idcd) nonly + end if + end if +c +c append the lattice values based on header flag value +c + if (use_bounds) then + write (idcd) xbox,gamma_cos,ybox,beta_cos,alpha_cos,zbox + end if +c +c copy the vector values to a common array +c + call copyvec3 (print3n,mode) +c +c append the atomic coordinates along each axis in turn +c + if (.not. onlysave) then + write (idcd) (real(print3n(1,i)),i=1,n) + write (idcd) (real(print3n(2,i)),i=1,n) + write (idcd) (real(print3n(3,i)),i=1,n) + else + write (idcd) (real(print3n(1,ionly(i))),i=1,nonly) + write (idcd) (real(print3n(2,ionly(i))),i=1,nonly) + write (idcd) (real(print3n(3,ionly(i))),i=1,nonly) + end if +c +c close the output unit if opened by this routine +c + if (.not. opened) close (unit=idcd) + return + end \ No newline at end of file diff --git a/windows/cygwin/compile.make b/windows/cygwin/compile.make index 9efa8ece5..cef0363cf 100755 --- a/windows/cygwin/compile.make +++ b/windows/cygwin/compile.make @@ -516,14 +516,11 @@ gfortran -c -O3 -ffast-math -fopenmp protein.f gfortran -c -O3 -ffast-math -fopenmp prtarc.f gfortran -c -O3 -ffast-math -fopenmp prtdyn.f gfortran -c -O3 -ffast-math -fopenmp prterr.f -gfortran -c -O3 -ffast-math -fopenmp prtfrc.f gfortran -c -O3 -ffast-math -fopenmp prtint.f gfortran -c -O3 -ffast-math -fopenmp prtmol2.f gfortran -c -O3 -ffast-math -fopenmp prtpdb.f gfortran -c -O3 -ffast-math -fopenmp prtprm.f gfortran -c -O3 -ffast-math -fopenmp prtseq.f -gfortran -c -O3 -ffast-math -fopenmp prtuind.f -gfortran -c -O3 -ffast-math -fopenmp prtvel.f gfortran -c -O3 -ffast-math -fopenmp prtxyz.f gfortran -c -O3 -ffast-math -fopenmp pss.f gfortran -c -O3 -ffast-math -fopenmp pssrigid.f diff --git a/windows/cygwin/library.make b/windows/cygwin/library.make index 5c06ac86a..427fd542f 100755 --- a/windows/cygwin/library.make +++ b/windows/cygwin/library.make @@ -431,14 +431,11 @@ promo.o \ prtarc.o \ prtdyn.o \ prterr.o \ -prtfrc.o \ prtint.o \ prtmol2.o \ prtpdb.o \ prtprm.o \ prtseq.o \ -prtuind.o \ -prtvel.o \ prtxyz.o \ ptable.o \ qmstuf.o \ diff --git a/windows/intel/compile.bat b/windows/intel/compile.bat index 9ab0e3bc6..d4e0a4e51 100755 --- a/windows/intel/compile.bat +++ b/windows/intel/compile.bat @@ -517,14 +517,11 @@ ifort /c /O3 /QxHost /Qip- /Qprec-div- /w /Qopenmp protein.f ifort /c /O3 /QxHost /Qip- /Qprec-div- /w /Qopenmp prtarc.f ifort /c /O3 /QxHost /Qip- /Qprec-div- /w /Qopenmp prtdyn.f ifort /c /O3 /QxHost /Qip- /Qprec-div- /w /Qopenmp prterr.f -ifort /c /O3 /QxHost /Qip- /Qprec-div- /w /Qopenmp prtfrc.f ifort /c /O3 /QxHost /Qip- /Qprec-div- /w /Qopenmp prtint.f ifort /c /O3 /QxHost /Qip- /Qprec-div- /w /Qopenmp prtmol2.f ifort /c /O3 /QxHost /Qip- /Qprec-div- /w /Qopenmp prtpdb.f ifort /c /O3 /QxHost /Qip- /Qprec-div- /w /Qopenmp prtprm.f ifort /c /O3 /QxHost /Qip- /Qprec-div- /w /Qopenmp prtseq.f -ifort /c /O3 /QxHost /Qip- /Qprec-div- /w /Qopenmp prtuind.f -ifort /c /O3 /QxHost /Qip- /Qprec-div- /w /Qopenmp prtvel.f ifort /c /O3 /QxHost /Qip- /Qprec-div- /w /Qopenmp prtxyz.f ifort /c /O3 /QxHost /Qip- /Qprec-div- /w /Qopenmp pss.f ifort /c /O3 /QxHost /Qip- /Qprec-div- /w /Qopenmp pssrigid.f diff --git a/windows/intel/generic.bat b/windows/intel/generic.bat index 1b543d18a..d05f66ff8 100755 --- a/windows/intel/generic.bat +++ b/windows/intel/generic.bat @@ -515,14 +515,11 @@ ifort /c /O3 /arch:sse3 /Qip- /Qprec-div- /w /Qopenmp protein.f ifort /c /O3 /arch:sse3 /Qip- /Qprec-div- /w /Qopenmp prtarc.f ifort /c /O3 /arch:sse3 /Qip- /Qprec-div- /w /Qopenmp prtdyn.f ifort /c /O3 /arch:sse3 /Qip- /Qprec-div- /w /Qopenmp prterr.f -ifort /c /O3 /arch:sse3 /Qip- /Qprec-div- /w /Qopenmp prtfrc.f ifort /c /O3 /arch:sse3 /Qip- /Qprec-div- /w /Qopenmp prtint.f ifort /c /O3 /arch:sse3 /Qip- /Qprec-div- /w /Qopenmp prtmol2.f ifort /c /O3 /arch:sse3 /Qip- /Qprec-div- /w /Qopenmp prtpdb.f ifort /c /O3 /arch:sse3 /Qip- /Qprec-div- /w /Qopenmp prtprm.f ifort /c /O3 /arch:sse3 /Qip- /Qprec-div- /w /Qopenmp prtseq.f -ifort /c /O3 /arch:sse3 /Qip- /Qprec-div- /w /Qopenmp prtuind.f -ifort /c /O3 /arch:sse3 /Qip- /Qprec-div- /w /Qopenmp prtvel.f ifort /c /O3 /arch:sse3 /Qip- /Qprec-div- /w /Qopenmp prtxyz.f ifort /c /O3 /arch:sse3 /Qip- /Qprec-div- /w /Qopenmp pss.f ifort /c /O3 /arch:sse3 /Qip- /Qprec-div- /w /Qopenmp pssrigid.f diff --git a/windows/intel/library.lbc b/windows/intel/library.lbc index e9d34b755..56c3bc9ac 100644 --- a/windows/intel/library.lbc +++ b/windows/intel/library.lbc @@ -420,14 +420,11 @@ promo.obj prtarc.obj prtdyn.obj prterr.obj -prtfrc.obj prtint.obj prtmol2.obj prtpdb.obj prtprm.obj prtseq.obj -prtuind.obj -prtvel.obj prtxyz.obj ptable.obj qmstuf.obj From 6138902c49019f0f2d450d779a5ec6fb395d95a5 Mon Sep 17 00:00:00 2001 From: Moses Date: Sat, 7 Mar 2026 15:20:38 -0600 Subject: [PATCH 29/29] small changes after merging --- interface/c/tinker/routines.h | 18 ------------------ interface/cpp/tinker/routines.h | 18 ------------------ macos/flang/compile.make | 3 --- source/moments.f | 12 ++++++------ source/prtxyz.f | 2 ++ 5 files changed, 8 insertions(+), 45 deletions(-) diff --git a/interface/c/tinker/routines.h b/interface/c/tinker/routines.h index cb89d1e47..c96715cdc 100644 --- a/interface/c/tinker/routines.h +++ b/interface/c/tinker/routines.h @@ -2255,12 +2255,6 @@ void prtdyn_(); void prterr_(); #define tinker_f_prterr prterr_ -// prtfrc.f -void prtfrc_(int* ifrc); -#define tinker_f_prtfrc prtfrc_ -void prtdcdf_(int* idcd, int* first); -#define tinker_f_prtdcdf prtdcdf_ - // prtint.f void prtint_(int* izmt); #define tinker_f_prtint prtint_ @@ -2285,18 +2279,6 @@ void prtprm_(int* itxt); void prtseq_(int* iseq); #define tinker_f_prtseq prtseq_ -// prtuind.f -void prtuind_(int* iind); -#define tinker_f_prtuind prtuind_ -void prtdcdu_(int* idcd, int* first); -#define tinker_f_prtdcdu prtdcdu_ - -// prtvel.f -void prtvel_(int* ivel); -#define tinker_f_prtvel prtvel_ -void prtdcdv_(int* idcd, int* first); -#define tinker_f_prtdcdv prtdcdv_ - // prtxyz.f void prtxyz_(int* ixyz); #define tinker_f_prtxyz prtxyz_ diff --git a/interface/cpp/tinker/routines.h b/interface/cpp/tinker/routines.h index cb89d1e47..c96715cdc 100644 --- a/interface/cpp/tinker/routines.h +++ b/interface/cpp/tinker/routines.h @@ -2255,12 +2255,6 @@ void prtdyn_(); void prterr_(); #define tinker_f_prterr prterr_ -// prtfrc.f -void prtfrc_(int* ifrc); -#define tinker_f_prtfrc prtfrc_ -void prtdcdf_(int* idcd, int* first); -#define tinker_f_prtdcdf prtdcdf_ - // prtint.f void prtint_(int* izmt); #define tinker_f_prtint prtint_ @@ -2285,18 +2279,6 @@ void prtprm_(int* itxt); void prtseq_(int* iseq); #define tinker_f_prtseq prtseq_ -// prtuind.f -void prtuind_(int* iind); -#define tinker_f_prtuind prtuind_ -void prtdcdu_(int* idcd, int* first); -#define tinker_f_prtdcdu prtdcdu_ - -// prtvel.f -void prtvel_(int* ivel); -#define tinker_f_prtvel prtvel_ -void prtdcdv_(int* idcd, int* first); -#define tinker_f_prtdcdv prtdcdv_ - // prtxyz.f void prtxyz_(int* ixyz); #define tinker_f_prtxyz prtxyz_ diff --git a/macos/flang/compile.make b/macos/flang/compile.make index b75a96c4b..ee7fa5bdc 100755 --- a/macos/flang/compile.make +++ b/macos/flang/compile.make @@ -531,14 +531,11 @@ flang -c -O3 -fopenmp prtarc.f flang -c -O3 -fopenmp prtcif.f flang -c -O3 -fopenmp prtdyn.f flang -c -O3 -fopenmp prterr.f -flang -c -O3 -fopenmp prtfrc.f flang -c -O3 -fopenmp prtint.f flang -c -O3 -fopenmp prtmol2.f flang -c -O3 -fopenmp prtpdb.f flang -c -O3 -fopenmp prtprm.f flang -c -O3 -fopenmp prtseq.f -flang -c -O3 -fopenmp prtuind.f -flang -c -O3 -fopenmp prtvel.f flang -c -O3 -fopenmp prtxyz.f flang -c -O3 -fopenmp pss.f flang -c -O3 -fopenmp pssrigid.f diff --git a/source/moments.f b/source/moments.f index 0538318da..e83c163c7 100644 --- a/source/moments.f +++ b/source/moments.f @@ -371,7 +371,7 @@ subroutine dmoments (xm,ym,zm,xustc,yustc,zustc,xuind,yuind,zuind, c OpenMP directives for the major loop structure c !$OMP PARALLEL default(private) -!$OMP& shared(nion,x,y,z,pchg,momuse,xuchg,yuchg,zuchg,utv3,type, +!$OMP& shared(nion,iion,x,y,z,pchg,momuse,xuchg,yuchg,zuchg,utv3,type, !$OMP& utypeinv) !$OMP DO reduction(+:xuchg,yuchg,zuchg,utv3) c @@ -398,9 +398,9 @@ subroutine dmoments (xm,ym,zm,xustc,yustc,zustc,xuind,yuind,zuind, c OpenMP directives for the major loop structure c !$OMP PARALLEL default(private) -!$OMP& shared(ndipole,x,y,z,idpl,bdpl,momuse,xustc,yustc,zustc,debye, +!$OMP& shared(ndipole,x,y,z,idpl,bdpl,momuse,xustc,yustc,zustc, !$OMP& utv1,type,utypeinv) -!$OMP DO reduction(+:xuchg,yuchg,zuchg,utv1) +!$OMP DO reduction(+:xustc,yustc,zustc,utv1) c c compute the static dipole moment due to bond dipoles c @@ -430,9 +430,9 @@ subroutine dmoments (xm,ym,zm,xustc,yustc,zustc,xuind,yuind,zuind, c OpenMP directives for the major loop structure c !$OMP PARALLEL default(private) -!$OMP& shared(npole,x,y,z,rpole,uind,uinds,use_polar,solvtyp,momuse, -!$OMP& xm,ym,zm,xustc,yustc,zustc,xuind,yuind,zuind,xuchg,yuchg,zuchg, -!$OMP& utv1,utv2,utv3,type,utypeinv) +!$OMP& shared(npole,x,y,z,ipole,rpole,uind,uinds,use_polar,solvtyp, +!$OMP& momuse,xm,ym,zm,xustc,yustc,zustc,xuind,yuind,zuind, +!$OMP& xuchg,yuchg,zuchg,utv1,utv2,utv3,type,utypeinv) !$OMP DO reduction(+:xustc,yustc,zustc,xuchg,yuchg,zuchg,utv1,utv3) c c compute the static dipole moment due to atomic multipoles diff --git a/source/prtxyz.f b/source/prtxyz.f index e74e2209d..1a3101e6d 100644 --- a/source/prtxyz.f +++ b/source/prtxyz.f @@ -306,7 +306,9 @@ subroutine prtvec3 (iunit,mode) subroutine copyvec3 (print3n,mode) use atoms use boxes + use dipole use deriv + use charge use expol use moldyn use mpole