diff --git a/patches/amber14.config b/patches/amber14.config
deleted file mode 100644
index 1f859fdf6c53352ef5b30c3c8439764f9c0f897b..0000000000000000000000000000000000000000
--- a/patches/amber14.config
+++ /dev/null
@@ -1,32 +0,0 @@
-
-
-function plumed_preliminary_test(){
-# check if the README contains the word AMBER and if amber has been already configured
- grep -q Amber README 1>/dev/null 2>/dev/null
-}
-
-function plumed_patch_info(){
-cat << EOF
-
-PLUMED can be incorporated into amber (sander module) using the standard patching procedure.
-Patching must be done in the root directory of amber _before_
-compilation.
-
-To enable PLUMED in a sander simulation one should use
-add to the cntrl input namelist these two fields:
-
-plumed=1 , plumedfile='plumed.dat'
-
-The first is switching plumed on, the second is specifying the name of the plumed
-input file.
-
-This patch is compatible with the MPI version of sander and support
-multisander. However, replica exchange is not supported.
-Multisander can thus only be used for multiple walkers
-metadynamics or for ensemble restraints.
-
-For more information on amber you should visit http://ambermd.org
-
-EOF
-}
-
diff --git a/patches/amber14.diff/AmberTools/src/sander/Makefile b/patches/amber14.diff/AmberTools/src/sander/Makefile
deleted file mode 100644
index 03d5dc447e9e76712195e4fef0d32d930134f8f4..0000000000000000000000000000000000000000
--- a/patches/amber14.diff/AmberTools/src/sander/Makefile
+++ /dev/null
@@ -1,423 +0,0 @@
-#
-#************************************************************************
-# AMBER **
-# **
-# Copyright (c) 1986, 1991, 1995, 1997, 1999 **
-# Regents of the University of California **
-# All Rights Reserved. **
-# **
-# This software provided pursuant to a license agreement containing **
-# restrictions on its disclosure, duplication, and use. This software **
-# contains confidential and proprietary information, and may not be **
-# extracted or distributed, in whole or in part, for any purpose **
-# whatsoever, without the express written permission of the authors. **
-# This notice, and the associated author list, must be attached to **
-# all copies, or extracts, of this software. Any additional **
-# restrictions set forth in the license agreement also apply to this **
-# software. **
-#************************************************************************
-#
-# Makefile for Amber 14 SANDER
-#
-include ../config.h
-include ../../../Plumed.inc
-
-CONFIG_FILE=../config.h
-CONFIG_COMMAND=configure
-PARALLEL_TOKEN=DMPI
-
-# Sander Fortran source files are free format
-# Add also search paths for .mod files
-LOCALFLAGS = $(FREEFORMAT_FLAG) -I../pbsa -I../sqm -I../rism -I../../../include
-
-SHELL=/bin/sh
-VPATH=
-
-EMILOBJ= \
- emil.o mdin_emil_dat.o
-
-NCSU_OBJECTS = \
- ncsu-abmd-hooks.o ncsu-bbmd-ctxt.o ncsu-bbmd-hooks.o ncsu-cftree.o \
- ncsu-colvar.o ncsu-colvar-math.o ncsu-colvar-type.o ncsu-colvar-utils.o \
- ncsu-constants.o ncsu-cv-ANGLE.o ncsu-cv-COM_ANGLE.o \
- ncsu-cv-COM_DISTANCE.o ncsu-cv-COM_TORSION.o ncsu-cv-COS_OF_DIHEDRAL.o \
- ncsu-cv-DISTANCE.o ncsu-cv-HANDEDNESS.o ncsu-cv-LCOD.o \
- ncsu-cv-MULTI_RMSD.o ncsu-cv-N_OF_BONDS.o ncsu-cv-N_OF_STRUCTURES.o \
- ncsu-cv-R_OF_GYRATION.o ncsu-cv-TORSION.o ncsu-lexer.o ncsu-parser.o \
- ncsu-pmd-hooks.o ncsu-rmsd.o ncsu-sander-hooks.o ncsu-sander-proxy.o \
- ncsu-cv-PCA.o ncsu-read-pca.o \
- ncsu-smd-hooks.o ncsu-umbrella.o ncsu-utils.o ncsu-value.o mt19937.o
-
-EVB_BASE = evb_vars.o evb_mathf.o evb_init.o evb_bcast.o \
- evb_dealloc.o check_input.o evb_io.o evb_keywrd.o \
- exchange_gauss.o exchange_warshel.o react_flux_init.o \
- react_path.o react_flux.o kappa_keck.o \
- schlegel_dg.o schlegel_full.o schlegel_diis.o schlegel_gmres.o \
- schlegel_gbasis.o schlegel_pgbasis.o \
- bnd_strtch.o ang_bend.o dihed_tors.o torinternal.o \
- evb_gfchk.o bmat_inv.o bmat_grad.o \
- unitv.o crossv.o cart2internal.o wdc_bmat.o select_coord.o \
- schlegel_uff.o schlegel_dihed.o schlegel_angle.o \
- schlegel_poh_uff.o schlegel_poh_irc.o schlegel_hcn_cart.o \
- schlegel_hcn_int_irc.o schlegel_hcn_cart_irc.o evb_outoptions.o
-
-EVB_DEBUG = evb_2stdebug.o egap_umb_2stdebug.o dg_debug.o \
- evb_io_debug.o bmat_debug.o bmat_inv_debug.o evb_io_debug2.o \
- morse_anal2num.o xwarshel_anal2num.o xgauss_anal2num.o \
- vdw_anal2num.o rcdbonds_anal2num.o rcbond_anal2num.o \
- dg_grad_anal2num.o
-
-EVBOBJ = $(EVB_BASE) $(EVB_DEBUG) evb_input.o evb_alloc.o evb_matrix.o \
- morsify.o mod_vdw.o evb_ntrfc.o evb_force.o out_evb.o \
- dbonds_anal2num.o bond_anal2num.o evb_umb.o evb_umb_primitive.o
-
-EVBPIMD = $(EVB_BASE) $(EVB_DEBUG) evb_input.LES.o evb_alloc.LES.o evb_matrix.LES.o \
- morsify.LES.o mod_vdw.LES.o evb_ntrfc.LES.o evb_force.LES.o \
- evb_pimd_init.LES.o out_evb.LES.o dbonds_anal2num.o bond_anal2num.o \
- evb_umb.LES.o evb_umb_primitive.LES.o
-
-AMOEBAOBJ= \
- amoeba_valence.o amoeba_multipoles.o amoeba_recip.o amoeba_interface.o\
- amoeba_direct.o amoeba_mdin.o amoeba_adjust.o amoeba_self.o\
- amoeba_vdw.o amoeba_induced.o amoeba_runmd.o
-
-APBSOBJ= \
- file_io_dat.APBS.o apbs_vars.APBS.o apbs.APBS.o \
- constants.o state.o memory_module.o stack.o \
- nose_hoover.o nose_hoover_init.o \
- trace.o rmsgrd.o lmod.o rand2.o lmodC.o xminC.o decomp.o \
- icosasurf.o egb.o remd.o findmask.o \
- relax_mat.o nmr.o multitmd.o \
- multisander.o sander.APBS.o trajene.o cshf.o nmrcal.o mtmdcall.o pearsn.o \
- printe.APBS.o runmin.o rdparm.o \
- mdread.APBS.o locmem.o runmd.o getcor.o degcnt.o decnvh.o \
- fastwt.o parallel.o shake.o ene.o mdwrit.o minrit.o \
- set.o dynlib.APBS.o mdfil.o nmlsrc.o \
- ew_force.o ew_setup.o ew_box.o ew_bspline.o\
- ew_fft.o nonbond_list.o short_ene.o ew_recip.o pcshift.o align.o csa.o \
- rfree.o rgroup.o amopen.o \
- debug.o ew_recip_reg.o ew_handle_dips.o ew_dipole_recip.o \
- mexit.o new_time.o extra_pts.o thermo_int.o \
- matinv.o assert.o mmtsb.o mmtsb_client.o erfcfun.o \
- constantph.o prn_dipoles.o ips.o sglds.o iwrap2.o emap.o \
- $(AMOEBAOBJ) $(SANDER_RISM_INTERFACE) AmberNetcdf.o bintraj.o binrestart.o \
- spatial_recip.o spatial_fft.o parms.o softcore.o mbar.o linear_response.o molecule.o xref.o dssp.o \
- charmm.o crg_reloc.o sander_lib.o amd.o scaledMD.o barostats.o $(EMILOBJ)
-
-QMOBJ= \
- abfqmmm_module.o qm_mm.o qm_ewald.o qmmm_vsolv.o \
- qm2_extern_util_module.o qm2_extern_module.o qm2_extern_adf_module.o qm2_read_adf_results.o KFReader.o \
- ArrayList.o qm2_extern_gms_module.o qm2_extern_tc_module.o qm2_extern_gau_module.o \
- qm2_extern_orc_module.o qm2_extern_nw_module.o qm2_extern_genmpi_module.o \
- qmmm_adaptive_module.o prn_qmmm_dipole.o
-
-ifdef LIOLIBS
-QMOBJ += qm2_extern_lio_module.o
-endif
-
-SEBOMDOBJ = \
- sebomd_module.o sebomd_arrays.o
-
-SEBOMDLIB = ../sebomd/sebomd.a
-
-MMOBJ= file_io_dat.o constants.o state.o memory_module.o stack.o \
- nose_hoover.o nose_hoover_init.o \
- trace.o rmsgrd.o lmod.o rand2.o lmodC.o xminC.o decomp.o \
- icosasurf.o egb.o remd.o findmask.o \
- relax_mat.o nmr.o multitmd.o \
- multisander.o sander.o trajene.o cshf.o nmrcal.o mtmdcall.o pearsn.o \
- printe.o runmin.o rdparm.o sander_lib.o \
- mdread.o locmem.o runmd.o getcor.o degcnt.o decnvh.o \
- fastwt.o parallel.o shake.o ene.o mdwrit.o minrit.o \
- set.o dynlib.o mdfil.o nmlsrc.o \
- ew_force.o ew_setup.o ew_box.o ew_bspline.o\
- ew_fft.o nonbond_list.o short_ene.o ew_recip.o pcshift.o align.o csa.o \
- rfree.o rgroup.o amopen.o \
- debug.o ew_recip_reg.o ew_handle_dips.o ew_dipole_recip.o \
- mexit.o new_time.o extra_pts.o thermo_int.o \
- matinv.o assert.o mmtsb.o mmtsb_client.o erfcfun.o \
- constantph.o prn_dipoles.o ips.o sglds.o iwrap2.o emap.o\
- $(EMILOBJ) $(AMOEBAOBJ) $(SANDER_RISM_INTERFACE) AmberNetcdf.o bintraj.o binrestart.o \
- spatial_recip.o spatial_fft.o parms.o softcore.o mbar.o linear_response.o molecule.o xref.o dssp.o \
- charmm.o crg_reloc.o amd.o scaledMD.o barostats.o
-
-FULLPIMDOBJ = pimd_vars.o pimd_force.o pimd_init.o cmd_vars.o cmd_matrix.o
-
-PARTPIMDOBJ = pimd_vars.o pimd_force.LES.o pimd_init.LES.o cmd_vars.o cmd_matrix.LES.o
-
-PUPILOBJ= file_io_dat.o constants.o state.o memory_module.o stack.o \
- nose_hoover.o nose_hoover_init.o \
- trace.o rmsgrd.o lmod.o rand2.o lmodC.o xminC.o decomp.o \
- pupildata.o icosasurf.o egb.o findmask.o \
- relax_mat.o nmr.o multitmd.o \
- multisander.o sander.PUPIL.o trajene.o cshf.o nmrcal.o mtmdcall.o pearsn.o \
- printe.PUPIL.o runmin.o force.PUPIL.o rdparm.o \
- mdread.PUPIL.o locmem.o runmd.o getcor.o degcnt.o decnvh.o \
- fastwt.o parallel.o shake.o ene.o mdwrit.o minrit.o \
- set.o dynlib.PUPIL.o mdfil.PUPIL.o nmlsrc.o \
- ew_force.o ew_setup.o ew_box.o ew_bspline.o\
- ew_fft.o nonbond_list.o short_ene.o ew_recip.o pcshift.o align.o csa.o \
- rfree.o rgroup.o amopen.o sander_lib.o \
- debug.o ew_recip_reg.o ew_handle_dips.o ew_dipole_recip.o \
- mexit.PUPIL.o new_time.o extra_pts.o thermo_int.o \
- matinv.o assert.o mmtsb.o mmtsb_client.o erfcfun.o \
- constantph.o prn_dipoles.o ips.o sglds.o iwrap2.o emap.o \
- $(EMILOBJ) $(AMOEBAOBJ) $(SANDER_RISM_INTERFACE) AmberNetcdf.o bintraj.o binrestart.o \
- spatial_recip.o spatial_fft.o parms.o softcore.o mbar.o linear_response.o molecule.o xref.o \
- putvalues.o fixport.o dssp.o charmm.o crg_reloc.o amd.o scaledMD.o \
- barostats.o
-
-LSCIVROBJ = lscivr_vars.o lsc_init.o lsc_xp.o
-
-LESOBJ= memory_module.o stack.o file_io_dat.o \
- constants.o state.o nose_hoover.o nose_hoover_init_LES.o \
- trace.o rmsgrd.o rand2.o lmodC.o xminC.o decomp.o icosasurf.o \
- egb.LES.o remd.LES.o findmask.o \
- relax_mat.o nmr.LES.o multitmd.o \
- multisander.LES.o sander.LES.o cshf.o nmrcal.o mtmdcall.o pearsn.o \
- printe.o runmin.o nonbond_list.LES.o force.LES.o rdparm.LES.o \
- mdread.LES.o locmem.LES.o runmd.LES.o degcnt.LES.o decnvh.o \
- fastwt.o parallel.LES.o shake.o ene.LES.o \
- dynlib.LES.o nmlsrc.o \
- ew_force.LES.o ew_setup.LES.o ew_bspline.o\
- ew_fft.o short_ene.LES.o ew_recip.LES.o pcshift.o \
- align.o csa.o rfree.o rgroup.o \
- amopen.o sander_lib.o \
- debug.o ew_recip_reg.o ew_handle_dips.o ew_dipole_recip.o \
- mexit.o new_time.o extra_pts.LES.o thermo_int.o matinv.o assert.o \
- mmtsb.o mmtsb_client.o erfcfun.o \
- constantph.o prn_dipoles.o ips.o sglds.o iwrap2.o emap.o \
- $(AMOEBAOBJ) $(EMILOBJ) $(SANDER_RISM_INTERFACE) \
- $(SEBOMDOBJ) \
- spatial_recip.o spatial_fft.o parms.o softcore.o mbar.o linear_response.o molecule.o xref.o dssp.o \
- charmm.o crg_reloc.o barostats.o \
- qm_ewald.o qmmm_vsolv.o \
- qm2_extern_util_module.o qm2_extern_module.o qm2_extern_adf_module.o qm2_read_adf_results.o KFReader.o \
- ArrayList.o qm2_extern_gms_module.o qm2_extern_tc_module.o qm2_extern_gau_module.o \
- qm2_extern_orc_module.o qm2_extern_nw_module.o qm2_extern_genmpi_module.o \
- qmmm_adaptive_module.o abfqmmm_module.o prn_qmmm_dipole.o \
- AmberNetcdf.o bintraj.LES.o binrestart.LES.o getcor.LES.o mdfil.LES.o mdwrit.LES.o \
- lmod.LES.o trajene.LES.o ew_box.LES.o minrit.LES.o set.LES.o qm_mm.LES.o amd.o scaledMD.o
-ifdef LIOLIBS
-LESOBJ += qm2_extern_lio_module.o
-endif
-
-# Xray sources are incomplete, but should not interfere with normal SANDER function.
-# Add the following to ../config.h to build new X-ray sources:
-#
-# AMBERBUILDFLAGS=-D_XRAY
-# XRAY_OBJS = \
-# xray_fftpack.o xray_fourier.o xray_globals.o xray_interface.o \
-# xray_real_space.o xray_reciprocal_space.o xray_utils.o
-
-.PHONY: configured configured-serial configured_parallel serial parallel
-
-install: serial
-
-SERIALPROGS = $(BINDIR)/sander$(SFX) $(BINDIR)/sander.LES$(SFX) $(BINDIR)/ambmask$(SFX)
-
-.NOTPARALLEL: $(SERIALPROGS)
-
-serial: configured_serial $(SERIALPROGS)
-
-PARALLELPROGS = $(BINDIR)/sander.MPI$(SFX) $(BINDIR)/sander.LES.MPI$(SFX)
-
-.NOTPARALLEL: $(PARALLELPROGS)
-
-parallel: configured_parallel $(PARALLELPROGS)
-
-all_serial_programs: $(SERIALPROGS)
- $(MAKE) $(BINDIR)/sander.PUPIL$(SFX)
- $(MAKE) $(BINDIR)/sander.APBS$(SFX)
-
-#---------------------------------------------------------------------------
-$(BINDIR)/sander$(SFX): libsqm $(MMOBJ) $(QMOBJ) $(FULLPIMDOBJ) $(EMIL) \
- $(SEBOMDOBJ) sebomd \
- $(LSCIVROBJ) force.o syslib \
- ../lib/nxtsec.o netlib configured_serial \
- $(NCSU_OBJECTS) $(XRAY_OBJS) libpbsa librism
- $(FC) $(FPPFLAGS) $(FFLAGS) $(AMBERFFLAGS) -o $@ $(MMOBJ) $(QMOBJ) $(SEBOMDOBJ) \
- $(FULLPIMDOBJ) $(LSCIVROBJ) force.o -L$(LIBDIR) -lsqm \
- $(NCSU_OBJECTS) $(XRAY_OBJS) \
- -lFpbsa ../lib/nxtsec.o $(EMILLIB) \
- $(SEBOMDLIB) \
- ../lib/sys.a $(NETCDFLIBF) \
- $(FLIBS_RISMSANDER) $(FLIBS_FFTW3) $(FLIBSF) \
- $(LDFLAGS) $(AMBERLDFLAGS) $(LIOLIBS) $(PLUMED_LOAD)
-
-#---------------------------------------------------------------------------
-$(BINDIR)/sander.MPI$(SFX): libsqm $(MMOBJ) $(QMOBJ) $(FULLPIMDOBJ) $(EMIL) \
- $(LSCIVROBJ) $(EVBOBJ) force.o \
- $(SEBOMDOBJ) sebomd \
- syslib ../lib/nxtsec.o netlib libpbsa librism_mpi configured_parallel $(NCSU_OBJECTS)
- $(FC) $(FPPFLAGS) $(FFLAGS) $(AMBERFFLAGS) -o $@ $(MMOBJ) $(QMOBJ) $(SEBOMDOBJ) \
- $(FULLPIMDOBJ) $(LSCIVROBJ) $(EVBOBJ) force.o \
- -L$(LIBDIR) -lsqm -lFpbsa $(EMILLIB) \
- $(SEBOMDLIB) \
- ../lib/nxtsec.o ../lib/sys.a $(NCSU_OBJECTS) $(NETCDFLIBF) \
- $(FLIBS_RISMSANDER) $(FLIBS_FFTW3) $(FLIBSF) \
- $(LDFLAGS) $(AMBERLDFLAGS) $(LIOLIBS) $(PLUMED_LOAD)
-
-
-#---------------------------------------------------------------------------
-$(BINDIR)/sander.PUPIL$(SFX): libsqm $(PUPILOBJ) $(QMOBJ) $(FULLPIMDOBJ) $(EMIL) \
- $(LSCIVROBJ) syslib \
- $(SEBOMDOBJ) sebomd \
- ../lib/nxtsec.o netlib libpbsa librism configured_serial $(NCSU_OBJECTS)
- $(FC) $(FPPFLAGS) $(FFLAGS) $(AMBERFFLAGS) -o $@ $(PUPILOBJ) $(QMOBJ) $(SEBOMDOBJ) $(FULLPIMDOBJ) \
- $(LSCIVROBJ) -L$(LIBDIR) -lsqm -lFpbsa \
- $(SEBOMDLIB) \
- ../lib/nxtsec.o $(EMILLIB) ../lib/sys.a $(NCSU_OBJECTS) $(NETCDFLIBF) \
- $(FLIBS_RISMSANDER) $(FLIBS_FFTW3) $(FLIBSF) \
- $(PUPILLIBS) $(LDFLAGS) $(AMBERLDFLAGS) $(LIOLIBS)
-
-
-#---------------------------------------------------------------------------
-$(BINDIR)/sander.LES$(SFX): libsqm $(LESOBJ) $(PARTPIMDOBJ) syslib \
- ../lib/nxtsec.o netlib \
- $(LSCIVROBJ) $(NCSU_OBJECTS) $(XRAY_OBJS) configured_serial \
- libpbsa librism $(EMIL) sebomd
- $(FC) $(FPPFLAGS) $(FFLAGS) $(AMBERFFLAGS) -o $@ $(LESOBJ) $(PARTPIMDOBJ) $(LSCIVROBJ) \
- $(XRAY_OBJS) -L$(LIBDIR) -lsqm -lFpbsa $(EMILLIB) \
- $(SEBOMDLIB) \
- ../lib/nxtsec.o ../lib/sys.a $(NCSU_OBJECTS) $(NETCDFLIBF) \
- $(FLIBS_RISMSANDER) $(FLIBS_FFTW3) $(FLIBSF) \
- $(LDFLAGS) $(AMBERLDFLAGS) $(LIOLIBS) $(PLUMED_LOAD)
-
-#---------------------------------------------------------------------------
-$(BINDIR)/sander.LES.MPI$(SFX): libsqm $(LESOBJ) $(EVBPIMD) \
- $(PARTPIMDOBJ) syslib ../lib/nxtsec.o \
- netlib libpbsa librism_mpi $(EMIL) \
- $(LSCIVROBJ) $(NCSU_OBJECTS) sebomd configured_parallel
- $(FC) $(FPPFLAGS) $(FFLAGS) $(AMBERFFLAGS) -o $@ $(LESOBJ) $(EVBPIMD) \
- $(PARTPIMDOBJ) $(LSCIVROBJ) \
- -L$(LIBDIR) -lsqm -lFpbsa $(EMILLIB) \
- $(SEBOMDLIB) \
- ../lib/nxtsec.o ../lib/sys.a $(NCSU_OBJECTS) $(NETCDFLIBF) \
- $(FLIBS_RISMSANDER) $(FLIBS_FFTW3) $(FLIBSF) \
- $(LDFLAGS) $(AMBERLDFLAGS) $(LIOLIBS) $(PLUMED_LOAD)
-
-#---------------------------------------------------------------------------
-$(BINDIR)/sander.APBS$(SFX): libsqm $(APBSOBJ) $(QMOBJ) \
- $(LSCIVROBJ) $(FULLPIMDOBJ) $(NCSU_OBJECTS) \
- force.APBS.o syslib librism $(EMIL) \
- $(SEBOMDOBJ) sebomd \
- ../lib/nxtsec.o netlib configured_serial
- $(FC) $(FPPFLAGS) $(FFLAGS) $(AMBERFFLAGS) -o $@ $(APBSOBJ) $(QMOBJ) $(SEBOMDOBJ) \
- $(FULLPIMDOBJ) $(LSCIVROBJ) force.APBS.o \
- -L$(APBS_LIBDIR) $(APBS_LIBS) \
- -L$(LIBDIR) -lsqm -lFpbsa $(EMILLIB) \
- $(SEBOMDLIB) \
- ../lib/nxtsec.o ../lib/sys.a $(NCSU_OBJECTS) $(NETCDFLIBF) \
- $(FLIBS_RISMSANDER) $(FLIBS_FFTW3) $(FLIBSF) \
- $(LDFLAGS) $(AMBERLDFLAGS) $(LIOLIBS)
-
-#---------------------------------------------------------------------------
-$(BINDIR)/ambmask$(SFX): ambmask.o findmask.o amopen.o parms.o \
- memory_module.o mexit.o ../lib/nxtsec.o
- $(FC) $(FPPFLAGS) $(FFLAGS) $(AMBERFFLAGS) -o $@ ambmask.o findmask.o \
- amopen.o mexit.o ../lib/nxtsec.o constants.o memory_module.o parms.o \
- $(LDFLAGS) $(AMBERLDFLAGS) $(LIOLIBS)
-
-
-#-----------LIBS
-
-EMIL:
- $(MAKE) -C ../emil install
-
-syslib:
- cd ../lib && $(MAKE) sys.a
-
-netlib:
- cd ../blas && $(MAKE) $(BLAS)
- cd ../lapack && $(MAKE) $(LAPACK)
- cd ../arpack && $(MAKE) install
-
-sebomd: $(SEBOMDOBJ)
- cd ../sebomd && $(MAKE) sebomd.a
-
-../lib/nxtsec.o: ../lib/nxtsec.F
- cd ../lib && $(MAKE) nxtsec.o
-
-pmemd_clib:
- cd ../pmemd/src && $(CC) -c $(CPPFLAGS) $(CNOOPTFLAGS) \
- $(CFLAGS) $(AMBERCFLAGS) pmemd_clib.c
-
-../lib/mexit.o: ../lib/mexit.F
- cd ../lib && $(MAKE) mexit.o
-
-rand2.o: ../sff/rand2.c
- $(CC) -c $(CNOOPTFLAGS) $(CFLAGS) $(AMBERCFLAGS) \
- -o rand2.o ../sff/rand2.c
-
-lmodC.o: ../sff/lmodC.c
- $(CC) -c -DSQM $(CNOOPTFLAGS) $(CFLAGS) $(AMBERCFLAGS) \
- -o lmodC.o ../sff/lmodC.c
-
-xminC.o: ../sff/xminC.c
- $(CC) -c -DSQM $(CNOOPTFLAGS) $(CFLAGS) $(AMBERCFLAGS) \
- -o xminC.o ../sff/xminC.c
-
-libsqm:
- cd ../sqm && $(MAKE) $@
-
-librism librism_mpi:
- if [ -n "$(RISMSANDER)" ]; then \
- cd ../rism && $(MAKE) $@; \
- fi
-
-libpbsa: decomp.o
- cd ../pbsa && $(MAKE) libFpbsa.a
-
-clean:
- -/bin/rm -f sander.PUPIL$(SFX)
- -/bin/rm -f sander.APBS$(SFX)
- /bin/rm -f *.o
- /bin/rm -f
- /bin/rm -f *.mod
- /bin/rm -f *.d
- /bin/rm -f *nbflag
-
-uninstall.serial:
- -rm -f $(BINDIR)/mopac.sh
- -for file in $(SERIALPROGS) ; do \
- rm -f $${file} ; \
- done
-
-uninstall.parallel:
- -for file in $(PARALLELPROGS) ; do \
- rm -f $${file} ; \
- done
-
-uninstall: uninstall.serial uninstall.parallel
-
-depend::
- ./makedepend > depend
-
-configured:
- @(if [ ! -f $(CONFIG_FILE) ] ; then \
- echo "Error: $(CONFIG_COMMAND) must be executed before $(MAKE) !" ;\
- exit 2 ;\ # $(CONFIG_COMMAND) ;\
- fi ;\
- )
-
-configured_serial: configured
- @(if grep $(PARALLEL_TOKEN) $(CONFIG_FILE) > /dev/null ; then \
- echo "Error: $(CONFIG_FILE) is of type parallel, not serial !" ;\
- echo " Rerun $(CONFIG_COMMAND) and do NOT specify -mpi." ;\
- exit 2 ;\
- fi ;\
- )
-
-configured_parallel: configured
- @(grep $(PARALLEL_TOKEN) $(CONFIG_FILE) > /dev/null || \
- { echo "Error: $(CONFIG_FILE) is of type serial, not parallel !" ;\
- echo " Rerun $(CONFIG_COMMAND) and specify an MPI implementation." ;\
- exit 2 ;\
- } ;\
- )
-
-
-#----------HEADER DEPENDENCIES (constructed from ./makedepend > depend)
-include depend
-# DO NOT DELETE
diff --git a/patches/amber14.diff/AmberTools/src/sander/Makefile.preplumed b/patches/amber14.diff/AmberTools/src/sander/Makefile.preplumed
deleted file mode 100644
index ec1f1f90daebec308e03d1ef8319c5a40b62089e..0000000000000000000000000000000000000000
--- a/patches/amber14.diff/AmberTools/src/sander/Makefile.preplumed
+++ /dev/null
@@ -1,422 +0,0 @@
-#
-#************************************************************************
-# AMBER **
-# **
-# Copyright (c) 1986, 1991, 1995, 1997, 1999 **
-# Regents of the University of California **
-# All Rights Reserved. **
-# **
-# This software provided pursuant to a license agreement containing **
-# restrictions on its disclosure, duplication, and use. This software **
-# contains confidential and proprietary information, and may not be **
-# extracted or distributed, in whole or in part, for any purpose **
-# whatsoever, without the express written permission of the authors. **
-# This notice, and the associated author list, must be attached to **
-# all copies, or extracts, of this software. Any additional **
-# restrictions set forth in the license agreement also apply to this **
-# software. **
-#************************************************************************
-#
-# Makefile for Amber 14 SANDER
-#
-include ../config.h
-
-CONFIG_FILE=../config.h
-CONFIG_COMMAND=configure
-PARALLEL_TOKEN=DMPI
-
-# Sander Fortran source files are free format
-# Add also search paths for .mod files
-LOCALFLAGS = $(FREEFORMAT_FLAG) -I../pbsa -I../sqm -I../rism -I../../../include
-
-SHELL=/bin/sh
-VPATH=
-
-EMILOBJ= \
- emil.o mdin_emil_dat.o
-
-NCSU_OBJECTS = \
- ncsu-abmd-hooks.o ncsu-bbmd-ctxt.o ncsu-bbmd-hooks.o ncsu-cftree.o \
- ncsu-colvar.o ncsu-colvar-math.o ncsu-colvar-type.o ncsu-colvar-utils.o \
- ncsu-constants.o ncsu-cv-ANGLE.o ncsu-cv-COM_ANGLE.o \
- ncsu-cv-COM_DISTANCE.o ncsu-cv-COM_TORSION.o ncsu-cv-COS_OF_DIHEDRAL.o \
- ncsu-cv-DISTANCE.o ncsu-cv-HANDEDNESS.o ncsu-cv-LCOD.o \
- ncsu-cv-MULTI_RMSD.o ncsu-cv-N_OF_BONDS.o ncsu-cv-N_OF_STRUCTURES.o \
- ncsu-cv-R_OF_GYRATION.o ncsu-cv-TORSION.o ncsu-lexer.o ncsu-parser.o \
- ncsu-pmd-hooks.o ncsu-rmsd.o ncsu-sander-hooks.o ncsu-sander-proxy.o \
- ncsu-cv-PCA.o ncsu-read-pca.o \
- ncsu-smd-hooks.o ncsu-umbrella.o ncsu-utils.o ncsu-value.o mt19937.o
-
-EVB_BASE = evb_vars.o evb_mathf.o evb_init.o evb_bcast.o \
- evb_dealloc.o check_input.o evb_io.o evb_keywrd.o \
- exchange_gauss.o exchange_warshel.o react_flux_init.o \
- react_path.o react_flux.o kappa_keck.o \
- schlegel_dg.o schlegel_full.o schlegel_diis.o schlegel_gmres.o \
- schlegel_gbasis.o schlegel_pgbasis.o \
- bnd_strtch.o ang_bend.o dihed_tors.o torinternal.o \
- evb_gfchk.o bmat_inv.o bmat_grad.o \
- unitv.o crossv.o cart2internal.o wdc_bmat.o select_coord.o \
- schlegel_uff.o schlegel_dihed.o schlegel_angle.o \
- schlegel_poh_uff.o schlegel_poh_irc.o schlegel_hcn_cart.o \
- schlegel_hcn_int_irc.o schlegel_hcn_cart_irc.o evb_outoptions.o
-
-EVB_DEBUG = evb_2stdebug.o egap_umb_2stdebug.o dg_debug.o \
- evb_io_debug.o bmat_debug.o bmat_inv_debug.o evb_io_debug2.o \
- morse_anal2num.o xwarshel_anal2num.o xgauss_anal2num.o \
- vdw_anal2num.o rcdbonds_anal2num.o rcbond_anal2num.o \
- dg_grad_anal2num.o
-
-EVBOBJ = $(EVB_BASE) $(EVB_DEBUG) evb_input.o evb_alloc.o evb_matrix.o \
- morsify.o mod_vdw.o evb_ntrfc.o evb_force.o out_evb.o \
- dbonds_anal2num.o bond_anal2num.o evb_umb.o evb_umb_primitive.o
-
-EVBPIMD = $(EVB_BASE) $(EVB_DEBUG) evb_input.LES.o evb_alloc.LES.o evb_matrix.LES.o \
- morsify.LES.o mod_vdw.LES.o evb_ntrfc.LES.o evb_force.LES.o \
- evb_pimd_init.LES.o out_evb.LES.o dbonds_anal2num.o bond_anal2num.o \
- evb_umb.LES.o evb_umb_primitive.LES.o
-
-AMOEBAOBJ= \
- amoeba_valence.o amoeba_multipoles.o amoeba_recip.o amoeba_interface.o\
- amoeba_direct.o amoeba_mdin.o amoeba_adjust.o amoeba_self.o\
- amoeba_vdw.o amoeba_induced.o amoeba_runmd.o
-
-APBSOBJ= \
- file_io_dat.APBS.o apbs_vars.APBS.o apbs.APBS.o \
- constants.o state.o memory_module.o stack.o \
- nose_hoover.o nose_hoover_init.o \
- trace.o rmsgrd.o lmod.o rand2.o lmodC.o xminC.o decomp.o \
- icosasurf.o egb.o remd.o findmask.o \
- relax_mat.o nmr.o multitmd.o \
- multisander.o sander.APBS.o trajene.o cshf.o nmrcal.o mtmdcall.o pearsn.o \
- printe.APBS.o runmin.o rdparm.o \
- mdread.APBS.o locmem.o runmd.o getcor.o degcnt.o decnvh.o \
- fastwt.o parallel.o shake.o ene.o mdwrit.o minrit.o \
- set.o dynlib.APBS.o mdfil.o nmlsrc.o \
- ew_force.o ew_setup.o ew_box.o ew_bspline.o\
- ew_fft.o nonbond_list.o short_ene.o ew_recip.o pcshift.o align.o csa.o \
- rfree.o rgroup.o amopen.o \
- debug.o ew_recip_reg.o ew_handle_dips.o ew_dipole_recip.o \
- mexit.o new_time.o extra_pts.o thermo_int.o \
- matinv.o assert.o mmtsb.o mmtsb_client.o erfcfun.o \
- constantph.o prn_dipoles.o ips.o sglds.o iwrap2.o emap.o \
- $(AMOEBAOBJ) $(SANDER_RISM_INTERFACE) AmberNetcdf.o bintraj.o binrestart.o \
- spatial_recip.o spatial_fft.o parms.o softcore.o mbar.o linear_response.o molecule.o xref.o dssp.o \
- charmm.o crg_reloc.o sander_lib.o amd.o scaledMD.o barostats.o $(EMILOBJ)
-
-QMOBJ= \
- abfqmmm_module.o qm_mm.o qm_ewald.o qmmm_vsolv.o \
- qm2_extern_util_module.o qm2_extern_module.o qm2_extern_adf_module.o qm2_read_adf_results.o KFReader.o \
- ArrayList.o qm2_extern_gms_module.o qm2_extern_tc_module.o qm2_extern_gau_module.o \
- qm2_extern_orc_module.o qm2_extern_nw_module.o qm2_extern_genmpi_module.o \
- qmmm_adaptive_module.o prn_qmmm_dipole.o
-
-ifdef LIOLIBS
-QMOBJ += qm2_extern_lio_module.o
-endif
-
-SEBOMDOBJ = \
- sebomd_module.o sebomd_arrays.o
-
-SEBOMDLIB = ../sebomd/sebomd.a
-
-MMOBJ= file_io_dat.o constants.o state.o memory_module.o stack.o \
- nose_hoover.o nose_hoover_init.o \
- trace.o rmsgrd.o lmod.o rand2.o lmodC.o xminC.o decomp.o \
- icosasurf.o egb.o remd.o findmask.o \
- relax_mat.o nmr.o multitmd.o \
- multisander.o sander.o trajene.o cshf.o nmrcal.o mtmdcall.o pearsn.o \
- printe.o runmin.o rdparm.o sander_lib.o \
- mdread.o locmem.o runmd.o getcor.o degcnt.o decnvh.o \
- fastwt.o parallel.o shake.o ene.o mdwrit.o minrit.o \
- set.o dynlib.o mdfil.o nmlsrc.o \
- ew_force.o ew_setup.o ew_box.o ew_bspline.o\
- ew_fft.o nonbond_list.o short_ene.o ew_recip.o pcshift.o align.o csa.o \
- rfree.o rgroup.o amopen.o \
- debug.o ew_recip_reg.o ew_handle_dips.o ew_dipole_recip.o \
- mexit.o new_time.o extra_pts.o thermo_int.o \
- matinv.o assert.o mmtsb.o mmtsb_client.o erfcfun.o \
- constantph.o prn_dipoles.o ips.o sglds.o iwrap2.o emap.o\
- $(EMILOBJ) $(AMOEBAOBJ) $(SANDER_RISM_INTERFACE) AmberNetcdf.o bintraj.o binrestart.o \
- spatial_recip.o spatial_fft.o parms.o softcore.o mbar.o linear_response.o molecule.o xref.o dssp.o \
- charmm.o crg_reloc.o amd.o scaledMD.o barostats.o
-
-FULLPIMDOBJ = pimd_vars.o pimd_force.o pimd_init.o cmd_vars.o cmd_matrix.o
-
-PARTPIMDOBJ = pimd_vars.o pimd_force.LES.o pimd_init.LES.o cmd_vars.o cmd_matrix.LES.o
-
-PUPILOBJ= file_io_dat.o constants.o state.o memory_module.o stack.o \
- nose_hoover.o nose_hoover_init.o \
- trace.o rmsgrd.o lmod.o rand2.o lmodC.o xminC.o decomp.o \
- pupildata.o icosasurf.o egb.o findmask.o \
- relax_mat.o nmr.o multitmd.o \
- multisander.o sander.PUPIL.o trajene.o cshf.o nmrcal.o mtmdcall.o pearsn.o \
- printe.PUPIL.o runmin.o force.PUPIL.o rdparm.o \
- mdread.PUPIL.o locmem.o runmd.o getcor.o degcnt.o decnvh.o \
- fastwt.o parallel.o shake.o ene.o mdwrit.o minrit.o \
- set.o dynlib.PUPIL.o mdfil.PUPIL.o nmlsrc.o \
- ew_force.o ew_setup.o ew_box.o ew_bspline.o\
- ew_fft.o nonbond_list.o short_ene.o ew_recip.o pcshift.o align.o csa.o \
- rfree.o rgroup.o amopen.o sander_lib.o \
- debug.o ew_recip_reg.o ew_handle_dips.o ew_dipole_recip.o \
- mexit.PUPIL.o new_time.o extra_pts.o thermo_int.o \
- matinv.o assert.o mmtsb.o mmtsb_client.o erfcfun.o \
- constantph.o prn_dipoles.o ips.o sglds.o iwrap2.o emap.o \
- $(EMILOBJ) $(AMOEBAOBJ) $(SANDER_RISM_INTERFACE) AmberNetcdf.o bintraj.o binrestart.o \
- spatial_recip.o spatial_fft.o parms.o softcore.o mbar.o linear_response.o molecule.o xref.o \
- putvalues.o fixport.o dssp.o charmm.o crg_reloc.o amd.o scaledMD.o \
- barostats.o
-
-LSCIVROBJ = lscivr_vars.o lsc_init.o lsc_xp.o
-
-LESOBJ= memory_module.o stack.o file_io_dat.o \
- constants.o state.o nose_hoover.o nose_hoover_init_LES.o \
- trace.o rmsgrd.o rand2.o lmodC.o xminC.o decomp.o icosasurf.o \
- egb.LES.o remd.LES.o findmask.o \
- relax_mat.o nmr.LES.o multitmd.o \
- multisander.LES.o sander.LES.o cshf.o nmrcal.o mtmdcall.o pearsn.o \
- printe.o runmin.o nonbond_list.LES.o force.LES.o rdparm.LES.o \
- mdread.LES.o locmem.LES.o runmd.LES.o degcnt.LES.o decnvh.o \
- fastwt.o parallel.LES.o shake.o ene.LES.o \
- dynlib.LES.o nmlsrc.o \
- ew_force.LES.o ew_setup.LES.o ew_bspline.o\
- ew_fft.o short_ene.LES.o ew_recip.LES.o pcshift.o \
- align.o csa.o rfree.o rgroup.o \
- amopen.o sander_lib.o \
- debug.o ew_recip_reg.o ew_handle_dips.o ew_dipole_recip.o \
- mexit.o new_time.o extra_pts.LES.o thermo_int.o matinv.o assert.o \
- mmtsb.o mmtsb_client.o erfcfun.o \
- constantph.o prn_dipoles.o ips.o sglds.o iwrap2.o emap.o \
- $(AMOEBAOBJ) $(EMILOBJ) $(SANDER_RISM_INTERFACE) \
- $(SEBOMDOBJ) \
- spatial_recip.o spatial_fft.o parms.o softcore.o mbar.o linear_response.o molecule.o xref.o dssp.o \
- charmm.o crg_reloc.o barostats.o \
- qm_ewald.o qmmm_vsolv.o \
- qm2_extern_util_module.o qm2_extern_module.o qm2_extern_adf_module.o qm2_read_adf_results.o KFReader.o \
- ArrayList.o qm2_extern_gms_module.o qm2_extern_tc_module.o qm2_extern_gau_module.o \
- qm2_extern_orc_module.o qm2_extern_nw_module.o qm2_extern_genmpi_module.o \
- qmmm_adaptive_module.o abfqmmm_module.o prn_qmmm_dipole.o \
- AmberNetcdf.o bintraj.LES.o binrestart.LES.o getcor.LES.o mdfil.LES.o mdwrit.LES.o \
- lmod.LES.o trajene.LES.o ew_box.LES.o minrit.LES.o set.LES.o qm_mm.LES.o amd.o scaledMD.o
-ifdef LIOLIBS
-LESOBJ += qm2_extern_lio_module.o
-endif
-
-# Xray sources are incomplete, but should not interfere with normal SANDER function.
-# Add the following to ../config.h to build new X-ray sources:
-#
-# AMBERBUILDFLAGS=-D_XRAY
-# XRAY_OBJS = \
-# xray_fftpack.o xray_fourier.o xray_globals.o xray_interface.o \
-# xray_real_space.o xray_reciprocal_space.o xray_utils.o
-
-.PHONY: configured configured-serial configured_parallel serial parallel
-
-install: serial
-
-SERIALPROGS = $(BINDIR)/sander$(SFX) $(BINDIR)/sander.LES$(SFX) $(BINDIR)/ambmask$(SFX)
-
-.NOTPARALLEL: $(SERIALPROGS)
-
-serial: configured_serial $(SERIALPROGS)
-
-PARALLELPROGS = $(BINDIR)/sander.MPI$(SFX) $(BINDIR)/sander.LES.MPI$(SFX)
-
-.NOTPARALLEL: $(PARALLELPROGS)
-
-parallel: configured_parallel $(PARALLELPROGS)
-
-all_serial_programs: $(SERIALPROGS)
- $(MAKE) $(BINDIR)/sander.PUPIL$(SFX)
- $(MAKE) $(BINDIR)/sander.APBS$(SFX)
-
-#---------------------------------------------------------------------------
-$(BINDIR)/sander$(SFX): libsqm $(MMOBJ) $(QMOBJ) $(FULLPIMDOBJ) $(EMIL) \
- $(SEBOMDOBJ) sebomd \
- $(LSCIVROBJ) force.o syslib \
- ../lib/nxtsec.o netlib configured_serial \
- $(NCSU_OBJECTS) $(XRAY_OBJS) libpbsa librism
- $(FC) $(FPPFLAGS) $(FFLAGS) $(AMBERFFLAGS) -o $@ $(MMOBJ) $(QMOBJ) $(SEBOMDOBJ) \
- $(FULLPIMDOBJ) $(LSCIVROBJ) force.o -L$(LIBDIR) -lsqm \
- $(NCSU_OBJECTS) $(XRAY_OBJS) \
- -lFpbsa ../lib/nxtsec.o $(EMILLIB) \
- $(SEBOMDLIB) \
- ../lib/sys.a $(NETCDFLIBF) \
- $(FLIBS_RISMSANDER) $(FLIBS_FFTW3) $(FLIBSF) \
- $(LDFLAGS) $(AMBERLDFLAGS) $(LIOLIBS)
-
-#---------------------------------------------------------------------------
-$(BINDIR)/sander.MPI$(SFX): libsqm $(MMOBJ) $(QMOBJ) $(FULLPIMDOBJ) $(EMIL) \
- $(LSCIVROBJ) $(EVBOBJ) force.o \
- $(SEBOMDOBJ) sebomd \
- syslib ../lib/nxtsec.o netlib libpbsa librism_mpi configured_parallel $(NCSU_OBJECTS)
- $(FC) $(FPPFLAGS) $(FFLAGS) $(AMBERFFLAGS) -o $@ $(MMOBJ) $(QMOBJ) $(SEBOMDOBJ) \
- $(FULLPIMDOBJ) $(LSCIVROBJ) $(EVBOBJ) force.o \
- -L$(LIBDIR) -lsqm -lFpbsa $(EMILLIB) \
- $(SEBOMDLIB) \
- ../lib/nxtsec.o ../lib/sys.a $(NCSU_OBJECTS) $(NETCDFLIBF) \
- $(FLIBS_RISMSANDER) $(FLIBS_FFTW3) $(FLIBSF) \
- $(LDFLAGS) $(AMBERLDFLAGS) $(LIOLIBS)
-
-
-#---------------------------------------------------------------------------
-$(BINDIR)/sander.PUPIL$(SFX): libsqm $(PUPILOBJ) $(QMOBJ) $(FULLPIMDOBJ) $(EMIL) \
- $(LSCIVROBJ) syslib \
- $(SEBOMDOBJ) sebomd \
- ../lib/nxtsec.o netlib libpbsa librism configured_serial $(NCSU_OBJECTS)
- $(FC) $(FPPFLAGS) $(FFLAGS) $(AMBERFFLAGS) -o $@ $(PUPILOBJ) $(QMOBJ) $(SEBOMDOBJ) $(FULLPIMDOBJ) \
- $(LSCIVROBJ) -L$(LIBDIR) -lsqm -lFpbsa \
- $(SEBOMDLIB) \
- ../lib/nxtsec.o $(EMILLIB) ../lib/sys.a $(NCSU_OBJECTS) $(NETCDFLIBF) \
- $(FLIBS_RISMSANDER) $(FLIBS_FFTW3) $(FLIBSF) \
- $(PUPILLIBS) $(LDFLAGS) $(AMBERLDFLAGS) $(LIOLIBS)
-
-
-#---------------------------------------------------------------------------
-$(BINDIR)/sander.LES$(SFX): libsqm $(LESOBJ) $(PARTPIMDOBJ) syslib \
- ../lib/nxtsec.o netlib \
- $(LSCIVROBJ) $(NCSU_OBJECTS) $(XRAY_OBJS) configured_serial \
- libpbsa librism $(EMIL) sebomd
- $(FC) $(FPPFLAGS) $(FFLAGS) $(AMBERFFLAGS) -o $@ $(LESOBJ) $(PARTPIMDOBJ) $(LSCIVROBJ) \
- $(XRAY_OBJS) -L$(LIBDIR) -lsqm -lFpbsa $(EMILLIB) \
- $(SEBOMDLIB) \
- ../lib/nxtsec.o ../lib/sys.a $(NCSU_OBJECTS) $(NETCDFLIBF) \
- $(FLIBS_RISMSANDER) $(FLIBS_FFTW3) $(FLIBSF) \
- $(LDFLAGS) $(AMBERLDFLAGS) $(LIOLIBS)
-
-#---------------------------------------------------------------------------
-$(BINDIR)/sander.LES.MPI$(SFX): libsqm $(LESOBJ) $(EVBPIMD) \
- $(PARTPIMDOBJ) syslib ../lib/nxtsec.o \
- netlib libpbsa librism_mpi $(EMIL) \
- $(LSCIVROBJ) $(NCSU_OBJECTS) sebomd configured_parallel
- $(FC) $(FPPFLAGS) $(FFLAGS) $(AMBERFFLAGS) -o $@ $(LESOBJ) $(EVBPIMD) \
- $(PARTPIMDOBJ) $(LSCIVROBJ) \
- -L$(LIBDIR) -lsqm -lFpbsa $(EMILLIB) \
- $(SEBOMDLIB) \
- ../lib/nxtsec.o ../lib/sys.a $(NCSU_OBJECTS) $(NETCDFLIBF) \
- $(FLIBS_RISMSANDER) $(FLIBS_FFTW3) $(FLIBSF) \
- $(LDFLAGS) $(AMBERLDFLAGS) $(LIOLIBS)
-
-#---------------------------------------------------------------------------
-$(BINDIR)/sander.APBS$(SFX): libsqm $(APBSOBJ) $(QMOBJ) \
- $(LSCIVROBJ) $(FULLPIMDOBJ) $(NCSU_OBJECTS) \
- force.APBS.o syslib librism $(EMIL) \
- $(SEBOMDOBJ) sebomd \
- ../lib/nxtsec.o netlib configured_serial
- $(FC) $(FPPFLAGS) $(FFLAGS) $(AMBERFFLAGS) -o $@ $(APBSOBJ) $(QMOBJ) $(SEBOMDOBJ) \
- $(FULLPIMDOBJ) $(LSCIVROBJ) force.APBS.o \
- -L$(APBS_LIBDIR) $(APBS_LIBS) \
- -L$(LIBDIR) -lsqm -lFpbsa $(EMILLIB) \
- $(SEBOMDLIB) \
- ../lib/nxtsec.o ../lib/sys.a $(NCSU_OBJECTS) $(NETCDFLIBF) \
- $(FLIBS_RISMSANDER) $(FLIBS_FFTW3) $(FLIBSF) \
- $(LDFLAGS) $(AMBERLDFLAGS) $(LIOLIBS)
-
-#---------------------------------------------------------------------------
-$(BINDIR)/ambmask$(SFX): ambmask.o findmask.o amopen.o parms.o \
- memory_module.o mexit.o ../lib/nxtsec.o
- $(FC) $(FPPFLAGS) $(FFLAGS) $(AMBERFFLAGS) -o $@ ambmask.o findmask.o \
- amopen.o mexit.o ../lib/nxtsec.o constants.o memory_module.o parms.o \
- $(LDFLAGS) $(AMBERLDFLAGS) $(LIOLIBS)
-
-
-#-----------LIBS
-
-EMIL:
- $(MAKE) -C ../emil install
-
-syslib:
- cd ../lib && $(MAKE) sys.a
-
-netlib:
- cd ../blas && $(MAKE) $(BLAS)
- cd ../lapack && $(MAKE) $(LAPACK)
- cd ../arpack && $(MAKE) install
-
-sebomd: $(SEBOMDOBJ)
- cd ../sebomd && $(MAKE) sebomd.a
-
-../lib/nxtsec.o: ../lib/nxtsec.F
- cd ../lib && $(MAKE) nxtsec.o
-
-pmemd_clib:
- cd ../pmemd/src && $(CC) -c $(CPPFLAGS) $(CNOOPTFLAGS) \
- $(CFLAGS) $(AMBERCFLAGS) pmemd_clib.c
-
-../lib/mexit.o: ../lib/mexit.F
- cd ../lib && $(MAKE) mexit.o
-
-rand2.o: ../sff/rand2.c
- $(CC) -c $(CNOOPTFLAGS) $(CFLAGS) $(AMBERCFLAGS) \
- -o rand2.o ../sff/rand2.c
-
-lmodC.o: ../sff/lmodC.c
- $(CC) -c -DSQM $(CNOOPTFLAGS) $(CFLAGS) $(AMBERCFLAGS) \
- -o lmodC.o ../sff/lmodC.c
-
-xminC.o: ../sff/xminC.c
- $(CC) -c -DSQM $(CNOOPTFLAGS) $(CFLAGS) $(AMBERCFLAGS) \
- -o xminC.o ../sff/xminC.c
-
-libsqm:
- cd ../sqm && $(MAKE) $@
-
-librism librism_mpi:
- if [ -n "$(RISMSANDER)" ]; then \
- cd ../rism && $(MAKE) $@; \
- fi
-
-libpbsa: decomp.o
- cd ../pbsa && $(MAKE) libFpbsa.a
-
-clean:
- -/bin/rm -f sander.PUPIL$(SFX)
- -/bin/rm -f sander.APBS$(SFX)
- /bin/rm -f *.o
- /bin/rm -f
- /bin/rm -f *.mod
- /bin/rm -f *.d
- /bin/rm -f *nbflag
-
-uninstall.serial:
- -rm -f $(BINDIR)/mopac.sh
- -for file in $(SERIALPROGS) ; do \
- rm -f $${file} ; \
- done
-
-uninstall.parallel:
- -for file in $(PARALLELPROGS) ; do \
- rm -f $${file} ; \
- done
-
-uninstall: uninstall.serial uninstall.parallel
-
-depend::
- ./makedepend > depend
-
-configured:
- @(if [ ! -f $(CONFIG_FILE) ] ; then \
- echo "Error: $(CONFIG_COMMAND) must be executed before $(MAKE) !" ;\
- exit 2 ;\ # $(CONFIG_COMMAND) ;\
- fi ;\
- )
-
-configured_serial: configured
- @(if grep $(PARALLEL_TOKEN) $(CONFIG_FILE) > /dev/null ; then \
- echo "Error: $(CONFIG_FILE) is of type parallel, not serial !" ;\
- echo " Rerun $(CONFIG_COMMAND) and do NOT specify -mpi." ;\
- exit 2 ;\
- fi ;\
- )
-
-configured_parallel: configured
- @(grep $(PARALLEL_TOKEN) $(CONFIG_FILE) > /dev/null || \
- { echo "Error: $(CONFIG_FILE) is of type serial, not parallel !" ;\
- echo " Rerun $(CONFIG_COMMAND) and specify an MPI implementation." ;\
- exit 2 ;\
- } ;\
- )
-
-
-#----------HEADER DEPENDENCIES (constructed from ./makedepend > depend)
-include depend
-# DO NOT DELETE
diff --git a/patches/amber14.diff/AmberTools/src/sander/constants.F90 b/patches/amber14.diff/AmberTools/src/sander/constants.F90
deleted file mode 100644
index 50dfb223025e578f144b22581da0809909b979ef..0000000000000000000000000000000000000000
--- a/patches/amber14.diff/AmberTools/src/sander/constants.F90
+++ /dev/null
@@ -1,270 +0,0 @@
-! <compile=optimized>
-#include "copyright.h"
-#include "../include/dprec.fh"
-
-!+++++++++++++++++++++++++++++++++++++++
-!This module contains various parameters
-!and constants used by the different
-!routines that make up sander.
-!
-!If you want to use one of the constants
-!in your routine you should include the
-!line:
-!
-!use constants, only : xxx, yyy, zzz
-!
-!where xxx,yyy,zzz are the constants you plan
-!to use in your routine.
-!This line needs to go before the
-!implicit none declaration.
-!
-! Based on constants.h, a pre Fortran 90 version, by Scott Brozell
-! and Dave Case (TSRI, 2002)
-! Converted into a Fortran 90 module by: Ross Walker (TSRI, 2005)
-! Expanded by others including: Matthew Clark, Andreas Goetz,
-!
-!++++++++++++++++++++++++++++++++++++++++
-
-module constants
-
- implicit none
-
- ! by default everything in this module is public
- public
-
- !------------------------------------------------------------
- ! Generic Floating Point Constants
- _REAL_, parameter :: TEN_TO_MINUS2 = 1.0d-2
- _REAL_, parameter :: TEN_TO_MINUS3 = 1.0d-3
- _REAL_, parameter :: TEN_TO_MINUS4 = 1.0d-4
- _REAL_, parameter :: TEN_TO_MINUS5 = 1.0d-5
- _REAL_, parameter :: TEN_TO_MINUS6 = 1.0d-6
- _REAL_, parameter :: TEN_TO_MINUS8 = 1.0d-8
- _REAL_, parameter :: TEN_TO_MINUS10 = 1.0d-10
- _REAL_, parameter :: TEN_TO_MINUS25 = 1.0d-25
- _REAL_, parameter :: TEN_TO_PLUS3 = 1.0d+3
- _REAL_, parameter :: TEN_TO_PLUS10 = 1.0d+10
-
- _REAL_, parameter :: zero = 0.0d0
- _REAL_, parameter :: one = 1.0d0
- _REAL_, parameter :: two = 2.0d0
- _REAL_, parameter :: three = 3.0d0
- _REAL_, parameter :: four = 4.0d0
- _REAL_, parameter :: five = 5.0d0
- _REAL_, parameter :: six = 6.0d0
- _REAL_, parameter :: seven = 7.0d0
- _REAL_, parameter :: eight = 8.0d0
- _REAL_, parameter :: nine = 9.0d0
- _REAL_, parameter :: ten = 10.0d0
- _REAL_, parameter :: eleven = 11.0d0
- _REAL_, parameter :: twelve = 12.0d0
- _REAL_, parameter :: sixteen = 16.0d0
- _REAL_, parameter :: twenty = 20.0d0
- _REAL_, parameter :: thirtytwo = 32.0d0
- _REAL_, parameter :: sixtyfour = 64.0d0
-
- _REAL_, parameter :: half = one/two
- _REAL_, parameter :: third = one/three
- _REAL_, parameter :: fourth = one/four
- _REAL_, parameter :: fifth = one/five
- _REAL_, parameter :: sixth = one/six
- _REAL_, parameter :: seventh = one/seven
- _REAL_, parameter :: eighth = one/eight
- _REAL_, parameter :: ninth = one/nine
- _REAL_, parameter :: tenth = one/ten
- _REAL_, parameter :: eleventh = one/eleven
- _REAL_, parameter :: twelfth = one/twelve
- _REAL_, parameter :: sixteenth = one/sixteen
- _REAL_, parameter :: thirtysecond = one/thirtytwo
- _REAL_, parameter :: sixtyfourth = one/sixtyfour
-
- _REAL_, parameter :: thirtieth = one/30.0d0
-
- !------------------------------------------------------------
- ! THE ARRAY FC(I) CONTAINS THE FACTORIALS OF (I-1).
-
- _REAL_, parameter :: FC(1:17) =&
- (/ 1.0D0,1.0D0, 2.0D0, 6.0D0, 24.0D0, 120.0D0, 720.0D0, 5040.0D0, &
- 40320.0D0, 362880.0D0, 3628800.0D0, 39916800.0D0, &
- 4.790016D+08, 6.2270208D+09, 8.71782912D+10, &
- 1.307674368D+12, 2.092278989D+13 /)
-
- _REAL_, parameter :: logFC(1:17) = (/ 0.0D0, 0.0D0, 0.6931471805599D0, &
- & 1.7917594692281D0, 3.1780538303479D0, 4.7874917427820D0, &
- & 6.5792512120101D0, 8.5251613610654D0, 10.6046029027453D0, &
- & 12.8018274800815D0, 15.1044125730755D0, 17.5023078458739D0, &
- & 19.9872144956619D0, 22.5521638531234D0, 25.1912211827387D0, &
- & 27.8992713838409D0, 30.6718601061763D0 /)
-
- ! DEFINE C COEFFICIENTS FOR ASSOCIATE LEGENDRE POLYNOMIALS.
- _REAL_, parameter::CC(1:21,1:3) = reshape ( (/ &
- 8.0D0, 8.0D0, 4.0D0, -4.0D0, 4.0D0, &
- 4.0D0, -12.0D0, -6.0D0, 20.0D0, 5.0D0, &
- 3.0D0, -30.0D0, -10.0D0, 35.0D0, 7.0D0, &
- 15.0D0, 7.5D0, -70.0D0, -17.5D0, 63.0D0, &
- 10.5D0, &
- 0.0D0, 0.0D0, 0.0D0, 12.0D0, 0.0D0, &
- 0.0D0, 20.0D0, 30.0D0, 0.0D0, 0.0D0, &
- -30.0D0, 70.0D0, 70.0D0, 0.0D0, 0.0D0, &
- -70.0D0, -105.D0, 210.0D0, 157.5D0, 0.0D0, &
- 0.0D0, &
- 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, &
- 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, &
- 35.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, &
- 63.0D0, 157.5D0, 0.0D0, 0.0D0, 0.0D0, &
- 0.0D0/), (/ 21, 3 /) )
-
- !------------------------------------------------------------
- ! Physical Constants
- _REAL_, parameter :: LIGHT_SPEED = 2.997924d08
- _REAL_, parameter :: HBAR = 627.509d0 * 0.0241888d-3 * 20.455d0 !Planck's constant in internal units
- _REAL_, parameter :: J_PER_CAL = 4.184d0 ! This is defined as the thermochemical calorie
- _REAL_, parameter :: JPKC = J_PER_CAL * 1000.0d0 !kilocalories per joule
- _REAL_, parameter :: BOLTZMANN = 1.380658d-23 !Boltzmann's constant in J/K
- _REAL_, parameter :: AVOGADRO = 6.0221367d+23 !Avogadro's number
- _REAL_, parameter :: KB = (BOLTZMANN * AVOGADRO) / JPKC !Boltzmann's constant in internal units
- _REAL_, parameter :: AMBER_ELECTROSTATIC = 18.2223d0
- _REAL_, parameter :: AMBER_ELECTROSTATIC2 = AMBER_ELECTROSTATIC * AMBER_ELECTROSTATIC
- !Ratio by which to scale amber charges to get electron charges - amberchg * oneqscale = electron charges
- ! = 1.0 / 18.2223d0
- _REAL_, parameter :: INV_AMBER_ELECTROSTATIC = 1.0d0/AMBER_ELECTROSTATIC
- _REAL_, parameter :: INV_AMBER_ELECTROSTATIC2 = 1.0d0/AMBER_ELECTROSTATIC2
-
- _REAL_, parameter :: CHARGE_ON_ELEC = 1.60217733d-19 !Charge on an electron in Coulombs
- _REAL_, parameter :: BOHR_RADIUS = 52.9177249d-12 ! in meter
- _REAL_, parameter :: BOHRS_TO_A = 0.529177249D0 ! Bohrs * this = angstroms - Same constants as used in dynamo v2.
- !_REAL_, parameter :: BOHRS_TO_A = 0.52917706D0 ! Bohrs * this = angstroms - Same constants as used in Gaussian 98
- !_REAL_, parameter :: BOHRS_TO_A = 0.529177D0 ! Bohrs * this = angstroms - Same constants as used in Mopac6 hcore.f
- !_REAL_, parameter :: BOHRS_TO_A = 0.529167D0 ! as used in Mopac6 repp.f
- _REAL_, parameter :: A_TO_BOHRS = 1.0d0 / BOHRS_TO_A
- !_REAL_, parameter :: A_TO_BOHRS = 1.88976D0 !Same constants as used in Mopac6 gover.f
- _REAL_, parameter :: A2_TO_BOHRS2 = A_TO_BOHRS * A_TO_BOHRS !Mopac6 uses 3.5711928576D0 in gover.f for this.
- _REAL_, parameter :: A3_TO_BOHRS3 = A2_TO_BOHRS2 * A_TO_BOHRS
- _REAL_, parameter :: A4_TO_BOHRS4 = A2_TO_BOHRS2 * A2_TO_BOHRS2
-
- _REAL_, parameter :: ONE_AU = 27.2113962d0 !One atomic unit of energy in eV.
- _REAL_, parameter :: HARTREE_TO_JOULE = ONE_AU * CHARGE_ON_ELEC !conversion from hartrees to joules
- _REAL_, parameter :: HART_BOHR_TO_JOULE_A = HARTREE_TO_JOULE * BOHRS_TO_A !hartree*bohrs to joules*angstroms
- _REAL_, parameter :: COULOMB_CONST_E = HART_BOHR_TO_JOULE_A*AVOGADRO/JPKC
- !Coulomb's constant for charges in units of e
- !This is the same as AMBER_ELECTROSTATIC2 but to higher precision
- !_REAL_, parameter :: AU_TO_EV = ONE_AU !Conversion from AU to EV - not used because we match dynamo v2 below.
- _REAL_, parameter :: AU_TO_EV = 27.21d0 !Conversion from AU to EV - Same as dynamo v2 uses and Gaussian 98
- !Note (RCW+MC): more precise would be: 1 a.u. 27.211396 eV
- !Mopac6 uses 27.21D0 in calpar.f, delri.f and repp.f but in
- !ffhpol.f it uses 27.2107 and in the manual it quotes 27.211
- _REAL_, parameter :: HALF_AU_TO_EV = AU_TO_EV * half
- _REAL_, parameter :: FOURTH_AU_TO_EV = AU_TO_EV * fourth
- _REAL_, parameter :: EIGHTH_AU_TO_EV = AU_TO_EV * eighth
- _REAL_, parameter :: SXNTH_AU_TO_EV = EIGHTH_AU_TO_EV * half
- _REAL_, parameter :: A2_TO_BOHRS2xAU_TO_EV = A2_TO_BOHRS2*AU_TO_EV
-
- !_REAL_, parameter :: EV_TO_KCAL = 23.060362D0 !Conversion from EV to KCAL/MOL
- !Dynamo parameter
- _REAL_, parameter :: EV_TO_KCAL = 23.061d0 !Dynamo's conversion
- !Mopac6 uses 23.061 in ffhpol.f analyt.f compfg.f datin.f dcart.f
- ! delri1.f delri2.f deritr.f interp.f iter.f
- ! moldat.f mopac.f
- _REAL_, parameter :: KCAL_TO_EV = one / EV_TO_KCAL
-
- _REAL_, parameter :: AU_TO_KCAL = AU_TO_EV*EV_TO_KCAL !1 hartree.
-
-
- ! The following are updated constants from Mohr, Taylor, Newell, Rev. Mod. Phys. 80 (2008) 633-730.
- !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~!
- ! NAME REFERENCE VALUE UNITS !
- !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~!
- ! Avogadro constant (Table XLVIII, p.708) 6.0221417930E23 mol^-1 !
- ! Bohr radius (Table XLIX, p. 710) 0.5291772085936E-10 m !
- ! a.u. of energy (Table LII, p. 717) 4.3597439422E-18 J !
- ! speed of light (vacuum) (Table I, p.637) 299 792 458 m*s^−1 !
- ! a.u. of charge (Table LIII, p. 717) 1.60217648740E-19 C !
- !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~!
- _REAL_, parameter :: CODATA08_AVOGADRO = 6.0221417930d23 ! Avogadro's number
- _REAL_, parameter :: CODATA08_BOHR_RADIUS = 0.5291772085936d-10
- _REAL_, parameter :: CODATA08_ONE_AU = 4.3597439422d-18 ! Atomic unit of energy in joules
- _REAL_, parameter :: CODATA08_LIGHT_SPEED = 2.99792458d08
- _REAL_, parameter :: CODATA08_CHARGE_ON_ELEC = 1.60217648740d-19
- ! Derived values
- _REAL_, parameter :: CODATA08_A_TO_BOHRS = 1d-10 / CODATA08_BOHR_RADIUS
- _REAL_, parameter :: CODATA08_AU_TO_KCAL = CODATA08_ONE_AU / J_PER_CAL / 1000 * CODATA08_AVOGADRO
- _REAL_, parameter :: CODATA08_AU_TO_DEBYE = &
- CODATA08_LIGHT_SPEED * CODATA08_CHARGE_ON_ELEC * CODATA08_BOHR_RADIUS / 1d-21
- !_REAL_, parameter :: AU_TO_DEBYE = 1.0d0/0.393430 ! from http://cccbdb.nist.gov/debye.asp (April 12 2011)
-
- !------------------------------------------------------------
- !Numeric Constants
- _REAL_, parameter :: PI = 3.1415926535897932384626433832795d0
-
- !The BOOK says :
- !
- !2Chronicles 4:2 reads thus, 'Also he made a molten sea of ten cubits
- !from brim to brim, round in compass, and five cubits the height thereof;
- !and a line of thirty cubits did compass it round about.'
- !
- !Hence, Pi is exactly equal to three and there is nothing more to discuss!
- !
- !If you want to use the value of PI defined by 'the BOOK' then uncomment
- !the following line and comment out the definition above...
- !_REAL_, parameter :: PI = 3.0d0
-
- _REAL_, parameter :: PI2 = PI*PI
- _REAL_, parameter :: HALFPI = PI * 0.5d0
- _REAL_, parameter :: TWOPI = 2.0d0 * PI
- _REAL_, parameter :: FOURPI = 4.0d0 * PI
- _REAL_, parameter :: INVPI = 1.0d0 / PI
- _REAL_, parameter :: SQRTPI = 1.77245385090551602729816748334d0 !sqrt(PI)
- _REAL_, parameter :: INVSQRTPI = 1.0d0 / SQRTPI
- _REAL_, parameter :: DEG_TO_RAD = PI / 180.0d0
- _REAL_, parameter :: RAD_TO_DEG = 180.0d0 / PI
- _REAL_, parameter :: LN_TO_LOG = 2.30258509299404568402d0 ! log(1.0d1)
-
- _REAL_, parameter :: SQRT2 = 1.4142135623730950488016887242097d0
- _REAL_, parameter :: INVSQRT2 = 1.0d0 / SQRT2
-
- !------------------------------------------------------------
- !Generalised Born Constants
- _REAL_, parameter :: alpb_alpha = 0.571412d0 !Alpha prefactor for alpb_alpha
-
- !------------------------------------------------------------
- ! Unusual Constants
- integer, parameter :: RETIRED_INPUT_OPTION = -10301 ! first 5 digit palindromic prime
- integer, parameter :: NO_INPUT_VALUE = 12344321 ! from Bob Duke
- _REAL_, parameter :: NO_INPUT_VALUE_FLOAT = 12344321.d0
-
- integer :: plumed
- character(256) :: plumedfile
-
-contains
-
- function BinomialCoefficient(m, n) result (bioCoeff)
-
- integer, intent(in)::m,n
- _REAL_::bioCoeff
-
- integer, parameter::size=30
- integer, save::bc(size,size)=0
- logical, save::initialized=.false.;
-
- integer::i,j,k
-
- if (.not.initialized) then
- do i=1,size
- bc(i,1)=one
- bc(i,2:size)=zero
- end do
- do i=2, size
- do j=2, i
- bc(i,j)=bc(i-1,j-1)+bc(i-1,j)
- end do
- end do
-
- initialized=.true.
- end if
-
- bioCoeff=one*bc(m,n)
-
- end function BinomialCoefficient
-
-end module constants
-
diff --git a/patches/amber14.diff/AmberTools/src/sander/constants.F90.preplumed b/patches/amber14.diff/AmberTools/src/sander/constants.F90.preplumed
deleted file mode 100644
index c9aeeb8812eb98e8b0cfc2bfa7f4afe04f495899..0000000000000000000000000000000000000000
--- a/patches/amber14.diff/AmberTools/src/sander/constants.F90.preplumed
+++ /dev/null
@@ -1,267 +0,0 @@
-! <compile=optimized>
-#include "copyright.h"
-#include "../include/dprec.fh"
-
-!+++++++++++++++++++++++++++++++++++++++
-!This module contains various parameters
-!and constants used by the different
-!routines that make up sander.
-!
-!If you want to use one of the constants
-!in your routine you should include the
-!line:
-!
-!use constants, only : xxx, yyy, zzz
-!
-!where xxx,yyy,zzz are the constants you plan
-!to use in your routine.
-!This line needs to go before the
-!implicit none declaration.
-!
-! Based on constants.h, a pre Fortran 90 version, by Scott Brozell
-! and Dave Case (TSRI, 2002)
-! Converted into a Fortran 90 module by: Ross Walker (TSRI, 2005)
-! Expanded by others including: Matthew Clark, Andreas Goetz,
-!
-!++++++++++++++++++++++++++++++++++++++++
-
-module constants
-
- implicit none
-
- ! by default everything in this module is public
- public
-
- !------------------------------------------------------------
- ! Generic Floating Point Constants
- _REAL_, parameter :: TEN_TO_MINUS2 = 1.0d-2
- _REAL_, parameter :: TEN_TO_MINUS3 = 1.0d-3
- _REAL_, parameter :: TEN_TO_MINUS4 = 1.0d-4
- _REAL_, parameter :: TEN_TO_MINUS5 = 1.0d-5
- _REAL_, parameter :: TEN_TO_MINUS6 = 1.0d-6
- _REAL_, parameter :: TEN_TO_MINUS8 = 1.0d-8
- _REAL_, parameter :: TEN_TO_MINUS10 = 1.0d-10
- _REAL_, parameter :: TEN_TO_MINUS25 = 1.0d-25
- _REAL_, parameter :: TEN_TO_PLUS3 = 1.0d+3
- _REAL_, parameter :: TEN_TO_PLUS10 = 1.0d+10
-
- _REAL_, parameter :: zero = 0.0d0
- _REAL_, parameter :: one = 1.0d0
- _REAL_, parameter :: two = 2.0d0
- _REAL_, parameter :: three = 3.0d0
- _REAL_, parameter :: four = 4.0d0
- _REAL_, parameter :: five = 5.0d0
- _REAL_, parameter :: six = 6.0d0
- _REAL_, parameter :: seven = 7.0d0
- _REAL_, parameter :: eight = 8.0d0
- _REAL_, parameter :: nine = 9.0d0
- _REAL_, parameter :: ten = 10.0d0
- _REAL_, parameter :: eleven = 11.0d0
- _REAL_, parameter :: twelve = 12.0d0
- _REAL_, parameter :: sixteen = 16.0d0
- _REAL_, parameter :: twenty = 20.0d0
- _REAL_, parameter :: thirtytwo = 32.0d0
- _REAL_, parameter :: sixtyfour = 64.0d0
-
- _REAL_, parameter :: half = one/two
- _REAL_, parameter :: third = one/three
- _REAL_, parameter :: fourth = one/four
- _REAL_, parameter :: fifth = one/five
- _REAL_, parameter :: sixth = one/six
- _REAL_, parameter :: seventh = one/seven
- _REAL_, parameter :: eighth = one/eight
- _REAL_, parameter :: ninth = one/nine
- _REAL_, parameter :: tenth = one/ten
- _REAL_, parameter :: eleventh = one/eleven
- _REAL_, parameter :: twelfth = one/twelve
- _REAL_, parameter :: sixteenth = one/sixteen
- _REAL_, parameter :: thirtysecond = one/thirtytwo
- _REAL_, parameter :: sixtyfourth = one/sixtyfour
-
- _REAL_, parameter :: thirtieth = one/30.0d0
-
- !------------------------------------------------------------
- ! THE ARRAY FC(I) CONTAINS THE FACTORIALS OF (I-1).
-
- _REAL_, parameter :: FC(1:17) =&
- (/ 1.0D0,1.0D0, 2.0D0, 6.0D0, 24.0D0, 120.0D0, 720.0D0, 5040.0D0, &
- 40320.0D0, 362880.0D0, 3628800.0D0, 39916800.0D0, &
- 4.790016D+08, 6.2270208D+09, 8.71782912D+10, &
- 1.307674368D+12, 2.092278989D+13 /)
-
- _REAL_, parameter :: logFC(1:17) = (/ 0.0D0, 0.0D0, 0.6931471805599D0, &
- & 1.7917594692281D0, 3.1780538303479D0, 4.7874917427820D0, &
- & 6.5792512120101D0, 8.5251613610654D0, 10.6046029027453D0, &
- & 12.8018274800815D0, 15.1044125730755D0, 17.5023078458739D0, &
- & 19.9872144956619D0, 22.5521638531234D0, 25.1912211827387D0, &
- & 27.8992713838409D0, 30.6718601061763D0 /)
-
- ! DEFINE C COEFFICIENTS FOR ASSOCIATE LEGENDRE POLYNOMIALS.
- _REAL_, parameter::CC(1:21,1:3) = reshape ( (/ &
- 8.0D0, 8.0D0, 4.0D0, -4.0D0, 4.0D0, &
- 4.0D0, -12.0D0, -6.0D0, 20.0D0, 5.0D0, &
- 3.0D0, -30.0D0, -10.0D0, 35.0D0, 7.0D0, &
- 15.0D0, 7.5D0, -70.0D0, -17.5D0, 63.0D0, &
- 10.5D0, &
- 0.0D0, 0.0D0, 0.0D0, 12.0D0, 0.0D0, &
- 0.0D0, 20.0D0, 30.0D0, 0.0D0, 0.0D0, &
- -30.0D0, 70.0D0, 70.0D0, 0.0D0, 0.0D0, &
- -70.0D0, -105.D0, 210.0D0, 157.5D0, 0.0D0, &
- 0.0D0, &
- 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, &
- 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, &
- 35.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, &
- 63.0D0, 157.5D0, 0.0D0, 0.0D0, 0.0D0, &
- 0.0D0/), (/ 21, 3 /) )
-
- !------------------------------------------------------------
- ! Physical Constants
- _REAL_, parameter :: LIGHT_SPEED = 2.997924d08
- _REAL_, parameter :: HBAR = 627.509d0 * 0.0241888d-3 * 20.455d0 !Planck's constant in internal units
- _REAL_, parameter :: J_PER_CAL = 4.184d0 ! This is defined as the thermochemical calorie
- _REAL_, parameter :: JPKC = J_PER_CAL * 1000.0d0 !kilocalories per joule
- _REAL_, parameter :: BOLTZMANN = 1.380658d-23 !Boltzmann's constant in J/K
- _REAL_, parameter :: AVOGADRO = 6.0221367d+23 !Avogadro's number
- _REAL_, parameter :: KB = (BOLTZMANN * AVOGADRO) / JPKC !Boltzmann's constant in internal units
- _REAL_, parameter :: AMBER_ELECTROSTATIC = 18.2223d0
- _REAL_, parameter :: AMBER_ELECTROSTATIC2 = AMBER_ELECTROSTATIC * AMBER_ELECTROSTATIC
- !Ratio by which to scale amber charges to get electron charges - amberchg * oneqscale = electron charges
- ! = 1.0 / 18.2223d0
- _REAL_, parameter :: INV_AMBER_ELECTROSTATIC = 1.0d0/AMBER_ELECTROSTATIC
- _REAL_, parameter :: INV_AMBER_ELECTROSTATIC2 = 1.0d0/AMBER_ELECTROSTATIC2
-
- _REAL_, parameter :: CHARGE_ON_ELEC = 1.60217733d-19 !Charge on an electron in Coulombs
- _REAL_, parameter :: BOHR_RADIUS = 52.9177249d-12 ! in meter
- _REAL_, parameter :: BOHRS_TO_A = 0.529177249D0 ! Bohrs * this = angstroms - Same constants as used in dynamo v2.
- !_REAL_, parameter :: BOHRS_TO_A = 0.52917706D0 ! Bohrs * this = angstroms - Same constants as used in Gaussian 98
- !_REAL_, parameter :: BOHRS_TO_A = 0.529177D0 ! Bohrs * this = angstroms - Same constants as used in Mopac6 hcore.f
- !_REAL_, parameter :: BOHRS_TO_A = 0.529167D0 ! as used in Mopac6 repp.f
- _REAL_, parameter :: A_TO_BOHRS = 1.0d0 / BOHRS_TO_A
- !_REAL_, parameter :: A_TO_BOHRS = 1.88976D0 !Same constants as used in Mopac6 gover.f
- _REAL_, parameter :: A2_TO_BOHRS2 = A_TO_BOHRS * A_TO_BOHRS !Mopac6 uses 3.5711928576D0 in gover.f for this.
- _REAL_, parameter :: A3_TO_BOHRS3 = A2_TO_BOHRS2 * A_TO_BOHRS
- _REAL_, parameter :: A4_TO_BOHRS4 = A2_TO_BOHRS2 * A2_TO_BOHRS2
-
- _REAL_, parameter :: ONE_AU = 27.2113962d0 !One atomic unit of energy in eV.
- _REAL_, parameter :: HARTREE_TO_JOULE = ONE_AU * CHARGE_ON_ELEC !conversion from hartrees to joules
- _REAL_, parameter :: HART_BOHR_TO_JOULE_A = HARTREE_TO_JOULE * BOHRS_TO_A !hartree*bohrs to joules*angstroms
- _REAL_, parameter :: COULOMB_CONST_E = HART_BOHR_TO_JOULE_A*AVOGADRO/JPKC
- !Coulomb's constant for charges in units of e
- !This is the same as AMBER_ELECTROSTATIC2 but to higher precision
- !_REAL_, parameter :: AU_TO_EV = ONE_AU !Conversion from AU to EV - not used because we match dynamo v2 below.
- _REAL_, parameter :: AU_TO_EV = 27.21d0 !Conversion from AU to EV - Same as dynamo v2 uses and Gaussian 98
- !Note (RCW+MC): more precise would be: 1 a.u. 27.211396 eV
- !Mopac6 uses 27.21D0 in calpar.f, delri.f and repp.f but in
- !ffhpol.f it uses 27.2107 and in the manual it quotes 27.211
- _REAL_, parameter :: HALF_AU_TO_EV = AU_TO_EV * half
- _REAL_, parameter :: FOURTH_AU_TO_EV = AU_TO_EV * fourth
- _REAL_, parameter :: EIGHTH_AU_TO_EV = AU_TO_EV * eighth
- _REAL_, parameter :: SXNTH_AU_TO_EV = EIGHTH_AU_TO_EV * half
- _REAL_, parameter :: A2_TO_BOHRS2xAU_TO_EV = A2_TO_BOHRS2*AU_TO_EV
-
- !_REAL_, parameter :: EV_TO_KCAL = 23.060362D0 !Conversion from EV to KCAL/MOL
- !Dynamo parameter
- _REAL_, parameter :: EV_TO_KCAL = 23.061d0 !Dynamo's conversion
- !Mopac6 uses 23.061 in ffhpol.f analyt.f compfg.f datin.f dcart.f
- ! delri1.f delri2.f deritr.f interp.f iter.f
- ! moldat.f mopac.f
- _REAL_, parameter :: KCAL_TO_EV = one / EV_TO_KCAL
-
- _REAL_, parameter :: AU_TO_KCAL = AU_TO_EV*EV_TO_KCAL !1 hartree.
-
-
- ! The following are updated constants from Mohr, Taylor, Newell, Rev. Mod. Phys. 80 (2008) 633-730.
- !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~!
- ! NAME REFERENCE VALUE UNITS !
- !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~!
- ! Avogadro constant (Table XLVIII, p.708) 6.0221417930E23 mol^-1 !
- ! Bohr radius (Table XLIX, p. 710) 0.5291772085936E-10 m !
- ! a.u. of energy (Table LII, p. 717) 4.3597439422E-18 J !
- ! speed of light (vacuum) (Table I, p.637) 299 792 458 m*s^−1 !
- ! a.u. of charge (Table LIII, p. 717) 1.60217648740E-19 C !
- !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~!
- _REAL_, parameter :: CODATA08_AVOGADRO = 6.0221417930d23 ! Avogadro's number
- _REAL_, parameter :: CODATA08_BOHR_RADIUS = 0.5291772085936d-10
- _REAL_, parameter :: CODATA08_ONE_AU = 4.3597439422d-18 ! Atomic unit of energy in joules
- _REAL_, parameter :: CODATA08_LIGHT_SPEED = 2.99792458d08
- _REAL_, parameter :: CODATA08_CHARGE_ON_ELEC = 1.60217648740d-19
- ! Derived values
- _REAL_, parameter :: CODATA08_A_TO_BOHRS = 1d-10 / CODATA08_BOHR_RADIUS
- _REAL_, parameter :: CODATA08_AU_TO_KCAL = CODATA08_ONE_AU / J_PER_CAL / 1000 * CODATA08_AVOGADRO
- _REAL_, parameter :: CODATA08_AU_TO_DEBYE = &
- CODATA08_LIGHT_SPEED * CODATA08_CHARGE_ON_ELEC * CODATA08_BOHR_RADIUS / 1d-21
- !_REAL_, parameter :: AU_TO_DEBYE = 1.0d0/0.393430 ! from http://cccbdb.nist.gov/debye.asp (April 12 2011)
-
- !------------------------------------------------------------
- !Numeric Constants
- _REAL_, parameter :: PI = 3.1415926535897932384626433832795d0
-
- !The BOOK says :
- !
- !2Chronicles 4:2 reads thus, 'Also he made a molten sea of ten cubits
- !from brim to brim, round in compass, and five cubits the height thereof;
- !and a line of thirty cubits did compass it round about.'
- !
- !Hence, Pi is exactly equal to three and there is nothing more to discuss!
- !
- !If you want to use the value of PI defined by 'the BOOK' then uncomment
- !the following line and comment out the definition above...
- !_REAL_, parameter :: PI = 3.0d0
-
- _REAL_, parameter :: PI2 = PI*PI
- _REAL_, parameter :: HALFPI = PI * 0.5d0
- _REAL_, parameter :: TWOPI = 2.0d0 * PI
- _REAL_, parameter :: FOURPI = 4.0d0 * PI
- _REAL_, parameter :: INVPI = 1.0d0 / PI
- _REAL_, parameter :: SQRTPI = 1.77245385090551602729816748334d0 !sqrt(PI)
- _REAL_, parameter :: INVSQRTPI = 1.0d0 / SQRTPI
- _REAL_, parameter :: DEG_TO_RAD = PI / 180.0d0
- _REAL_, parameter :: RAD_TO_DEG = 180.0d0 / PI
- _REAL_, parameter :: LN_TO_LOG = 2.30258509299404568402d0 ! log(1.0d1)
-
- _REAL_, parameter :: SQRT2 = 1.4142135623730950488016887242097d0
- _REAL_, parameter :: INVSQRT2 = 1.0d0 / SQRT2
-
- !------------------------------------------------------------
- !Generalised Born Constants
- _REAL_, parameter :: alpb_alpha = 0.571412d0 !Alpha prefactor for alpb_alpha
-
- !------------------------------------------------------------
- ! Unusual Constants
- integer, parameter :: RETIRED_INPUT_OPTION = -10301 ! first 5 digit palindromic prime
- integer, parameter :: NO_INPUT_VALUE = 12344321 ! from Bob Duke
- _REAL_, parameter :: NO_INPUT_VALUE_FLOAT = 12344321.d0
-
-contains
-
- function BinomialCoefficient(m, n) result (bioCoeff)
-
- integer, intent(in)::m,n
- _REAL_::bioCoeff
-
- integer, parameter::size=30
- integer, save::bc(size,size)=0
- logical, save::initialized=.false.;
-
- integer::i,j,k
-
- if (.not.initialized) then
- do i=1,size
- bc(i,1)=one
- bc(i,2:size)=zero
- end do
- do i=2, size
- do j=2, i
- bc(i,j)=bc(i-1,j-1)+bc(i-1,j)
- end do
- end do
-
- initialized=.true.
- end if
-
- bioCoeff=one*bc(m,n)
-
- end function BinomialCoefficient
-
-end module constants
-
diff --git a/patches/amber14.diff/AmberTools/src/sander/mdread.F90 b/patches/amber14.diff/AmberTools/src/sander/mdread.F90
deleted file mode 100644
index d0365a01fa3ab5cd98acfdc0b5cc0f123fde413b..0000000000000000000000000000000000000000
--- a/patches/amber14.diff/AmberTools/src/sander/mdread.F90
+++ /dev/null
@@ -1,3856 +0,0 @@
-#include "copyright.h"
-#include "../include/dprec.fh"
-#include "ncsu-config.h"
-#include "../include/assert.fh"
-#ifndef PBSA
-!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-!+ Open input files and read cntrl namelist.
-subroutine mdread1()
-
- use file_io_dat
- use lmod_driver, only : read_lmod_namelist
- use qmmm_module, only : qmmm_nml,qmmm_struct, qm_gb
- use constants, only : RETIRED_INPUT_OPTION, zero, one, two, three, seven, &
- eight, NO_INPUT_VALUE_FLOAT, NO_INPUT_VALUE, &
- plumed, plumedfile
- use constantph, only : mccycles
- use amoeba_mdin, only: AMOEBA_read_mdin, iamoeba
- use nose_hoover_module, only: nchain ! APJ
- use lscivr_vars, only: ilscivr, icorf_lsc
- use pimd_vars, only: ipimd,itimass
- use neb_vars, only: ineb
- use cmd_vars, only: restart_cmd, eq_cmd, adiab_param
- use stack, only: lastist,lastrst
- use nmr, only: echoin
- use crg_reloc, only: ifcr, cropt, crcut, crskin, crin, crprintcharges
- use sgld, only : isgld, isgsta,isgend,fixcom, &
- tsgavg,sgft,sgff,sgfd,tempsg,treflf,tsgavp
- use amd_mod, only: iamd,iamdlag,EthreshD,alphaD,EthreshP,alphaP, &
- w_amd,EthreshD_w,alphaD_w,EthreshP_w,alphaP_w
- use scaledMD_mod, only: scaledMD,scaledMD_lambda
- use nbips, only: ips,teips,tvips,teaips,tvaips,raips,mipsx,mipsy,mipsz, &
- mipso,gridips,dvbips
- use emap,only: temap,gammamap
-#ifdef DSSP
- use dssp, only: idssp
-#endif /* DSSP */
-
- use emil_mod, only : emil_do_calc
- use mdin_emil_dat_mod, only : error_hdr
-
-#if !defined(DISABLE_NCSU) && defined(MPI)
- use ncsu_sander_hooks, only : ncsu_on_mdread1 => on_mdread1
-#endif /* ! DISABLE_NCSU && MPI */
-#ifdef _XRAY
- use xray_interface_module, only: xray_active, xray_read_mdin
-#endif /* _XRAY */
-#ifdef MPI /* SOFT CORE */
- use softcore, only : scalpha,scbeta,ifsc,scmask,logdvdl,dvdl_norest,dynlmb, &
- sceeorder, tishake, emil_sc
- use mbar, only : ifmbar, bar_intervall, bar_l_min, bar_l_max, bar_l_incr
- use remd, only : rem
-#endif /* MPI */
- ! Parameter for LIE module
- use linear_response, only: ilrt, lrt_interval, lrtmask
-#ifdef RISMSANDER
- use sander_rism_interface, only: rismprm,xvvfile, guvfile, huvfile, cuvfile,&
- uuvfile, asympfile, quvFile, chgDistFile
-#endif /*RISMSANDER*/
-#ifdef APBS
- use apbs
-#endif /* APBS */
- use sebomd_module, only: read_sebomd_namelist, sebomd_namelist_default
- implicit none
-# include "box.h"
-# include "def_time.h"
-# include "ew_cntrl.h"
-# include "ew_pme_recip.h"
-# include "../include/md.h"
-# include "../include/memory.h"
-# include "mmtsb.h"
-# include "nmr.h"
-# include "tgtmd.h"
-# include "multitmd.h"
-# include "ew_erfc_spline.h"
-#ifdef LES
-# include "les.h"
-#else
- _REAL_ temp0les
-#endif
-
- character(len=4) watdef(4),watnam,owtnm,hwtnm1,hwtnm2
-
- _REAL_ dele
- integer ierr
- integer ifind
- integer imcdo
- integer itotst
- integer jn
- integer inerr
- logical mdin_cntrl, mdin_lmod, mdin_qmmm ! true if namelists are in mdin
- logical mdin_sebomd
- integer :: ifqnt ! local here --> put into qmmm_nml%ifqnt after read here
- integer mxgrp
- integer iemap
- character(len=8) date
- character(len=10) time
- character(len=512) :: char_tmp_512
- _REAL_ dtemp ! retired
- _REAL_ dxm ! retired
- _REAL_ heat ! retired
- _REAL_ timlim ! retired
-
-#ifdef RISMSANDER
- integer irism
-#endif /*RISMSANDER*/
-
- namelist /cntrl/ irest,ibelly, &
- ntx,ntxo,ntcx,ig,tempi, &
- ntb,ntt,nchain,temp0,tautp, &
- ntp,pres0,comp,taup,barostat,mcbarint, &
- nscm,nstlim,t,dt, &
- ntc,ntcc,nconp,tol,ntf,ntn,nsnb, &
- cut,dielc, &
- ntpr,ntwx,ntwv,ntwe,ntwf,ntave,ntpp,ioutfm, &
- ntr,nrc,ntrx,taur,nmropt, &
- ivcap,cutcap,xcap,ycap,zcap,fcap, &
- xlorth,ylorth,zlorth,xorth,yorth,zorth,forth, &
- imin,drms,dele,dx0, &
- pencut,ipnlty,iscale,scalm,noeskp, &
- maxcyc,ncyc,ntmin,vlimit, &
- mxsub,ipol,jfastw,watnam,owtnm,hwtnm1,hwtnm2, iesp, &
- skmin, skmax, vv,vfac, tmode, ips, &
- mipsx,mipsy,mipsz,mipso,gridips,raips,dvbips, &
- iamd,iamdlag,EthreshD,alphaD,EthreshP,alphaP, &
- w_amd,EthreshD_w,alphaD_w,EthreshP_w,alphaP_w, &
- scaledMD,scaledMD_lambda, &
- iemap,gammamap, &
- isgld,isgsta,isgend,fixcom,tsgavg,sgft,sgff,sgfd,tempsg,treflf,tsgavp,&
- jar, iamoeba, &
- numexchg, repcrd, numwatkeep, hybridgb, &
- ntwprt,tausw, &
- ntwr,iyammp,imcdo, &
- igb,alpb,Arad,rgbmax,saltcon,offset,gbsa,vrand, &
- surften,iwrap,nrespa,nrespai,gamma_ln,extdiel,intdiel, &
- cut_inner,icfe,clambda,klambda, rbornstat,lastrst,lastist, &
- itgtmd,tgtrmsd,tgtmdfrc,tgtfitmask,tgtrmsmask, dec_verbose, &
- idecomp,temp0les,restraintmask,restraint_wt,bellymask, &
- noshakemask,crgmask, iwrap_mask,mmtsb_switch,mmtsb_iterations, &
- rdt,icnstph,solvph,ntcnstph,ntrelax, mccycles, &
- ifqnt,ievb, ipimd, itimass, ineb,profile_mpi, ilscivr, icorf_lsc, &
- ipb, inp, plumed,plumedfile, &
- gbneckscale, &
- gbalphaH,gbbetaH,gbgammaH, &
- gbalphaC,gbbetaC,gbgammaC, &
- gbalphaN,gbbetaN,gbgammaN, &
- gbalphaOS,gbbetaOS,gbgammaOS, &
- gbalphaP,gbbetaP,gbgammaP, &
- Sh,Sc,Sn,So,Ss,Sp, &
- lj1264, &
- ifcr, cropt, crcut, crskin, crin, crprintcharges, &
- csurften, ninterface, gamma_ten, &
-#ifdef MPI /* SOFT CORE */
- scalpha, scbeta, ifsc, scmask, logdvdl, dvdl_norest, dynlmb, &
- sceeorder, &
- ifmbar, bar_intervall, bar_l_min, bar_l_max, bar_l_incr, tishake, &
- emil_sc, &
-#endif
- ilrt, lrt_interval, lrtmask, &
-#ifdef DSSP
- idssp, &
-#endif
-#ifdef RISMSANDER
- irism,&
-#endif /*RISMSANDER*/
- emil_do_calc, &
- restart_cmd, eq_cmd, adiab_param, &
- vdwmodel, & ! mjhsieh - the model used for van der Waals
- dtemp, heat, timlim !all retired
-
- ! Define default water residue name and the names of water oxygen & hydrogens
-
- data watdef/'WAT ','O ','H1 ','H2 '/
-
- ! ----- READ THE CONTROL DATA AND OPEN DIFFERENT FILES -----
-
- if (mdout /= "stdout" ) &
- call amopen(6,mdout,owrite,'F','W')
- call amopen(5,mdin,'O','F','R')
- write(6,9308)
- call date_and_time( DATE=date, TIME=time )
- write(6,'(12(a))') '| Run on ', date(5:6), '/', date(7:8), '/', &
- date(1:4), ' at ', time(1:2), ':', time(3:4), ':', time(5:6)
-
- ! Write the path of the current executable and working directory
- call get_command_argument(0, char_tmp_512)
- write(6,'(/,a,a)') '| Executable path: ', trim(char_tmp_512)
- call getcwd(char_tmp_512)
- write(6,'(a,a)') '| Working directory: ', trim(char_tmp_512)
-! Write the hostname if we can get it from environment variable
-! Note: get_environment_variable is part of the F2003 standard but seems
-! to be supported by GNU, Intel, IBM and Portland (2010+) compilers
- call get_environment_variable("HOSTNAME", char_tmp_512, inerr)
- if (inerr .eq. 0) then
- write(6,'(a,a,/)') '| Hostname: Unknown'
- else
- write(6,'(a,a,/)') '| Hostname: ', trim(char_tmp_512)
- end if
-
- if (owrite /= 'N') write(6, '(2x,a)') '[-O]verwriting output'
-
- ! Echo the file assignments to the user:
-
- write(6,9700) 'MDIN' ,mdin(1:70) , 'MDOUT' ,mdout(1:70) , &
- 'INPCRD' ,inpcrd(1:70), 'PARM' ,parm(1:70) , &
- 'RESTRT',restrt(1:70) , 'REFC' ,refc(1:70) , &
- 'MDVEL' ,mdvel(1:70) , 'MDFRC' ,mdfrc(1:70) , &
- 'MDEN' ,mden(1:70) , &
- 'MDCRD' ,mdcrd(1:70) , 'MDINFO' ,mdinfo(1:70), &
- 'MTMD' ,mtmd(1:70) , 'INPDIP', inpdip(1:70), &
- 'RSTDIP', rstdip(1:70), 'INPTRAJ', inptraj(1:70)
-# ifdef MPI
- write(6,9702) 'REMLOG', trim(remlog), &
- 'REMTYPE', trim(remtype), &
- 'REMSTRIP', trim(remstripcoord), &
- 'SAVEENE', trim(saveenefile), &
- 'CLUSTERINF', trim(clusterinfofile), &
- 'RESERVOIR', trim(reservoirname), &
- 'REMDDIM', trim(remd_dimension_file)
-# endif
-#ifdef RISMSANDER
- if(len_trim(xvvfile) > 0)&
- write(6,9701) 'Xvv',trim(xvvfile)
- if(len_trim(guvfile) > 0)&
- write(6,9701) 'Guv',trim(Guvfile)
- if(len_trim(huvfile) > 0)&
- write(6,9701) 'Huv',trim(Huvfile)
- if(len_trim(cuvfile) > 0)&
- write(6,9701) 'Cuv',trim(Cuvfile)
- if(len_trim(uuvfile) > 0)&
- write(6,9701) 'Uuv',trim(Uuvfile)
- if(len_trim(asympfile) > 0)&
- write(6,9701) 'Asymptotics',trim(asympfile)
- if(len_trim(quvfile) > 0)&
- write(6,9701) 'Quv',trim(Quvfile)
- if(len_trim(chgDistfile) > 0)&
- write(6,9701) 'ChgDist',trim(chgDistfile)
-#endif /*RISMSANDER*/
-
- ! Echo the input file to the user:
- call echoin(5,6)
- ! ----- READ DATA CHARACTERIZING THE MD-RUN -----
- read(5,'(a80)') title
- ! ----read input in namelist format, first setting up defaults
-
- dtemp = RETIRED_INPUT_OPTION
- dxm = RETIRED_INPUT_OPTION
- heat = RETIRED_INPUT_OPTION
- timlim = RETIRED_INPUT_OPTION
- irest = 0
- ibelly = 0
- ipol = RETIRED_INPUT_OPTION
- iesp = 0
- ntx = 1
- ntxo = NO_INPUT_VALUE
- ig = 71277
- tempi = ZERO
- ntb = NO_INPUT_VALUE
- ntt = 0
- nchain = 1
- temp0 = 300.0d0
- plumed = 0
- plumedfile = 'plumed.dat'
-
-#ifdef LES
- ! alternate temp for LES copies, if negative then use single bath
- ! single bath not the same as 2 baths with same target T
- temp0les = -ONE
- rdt = ZERO
-#endif
- ipimd =0
- itimass = 0 ! Default = no TI w.r.t. mass.
- ineb =0
-
- tautp = ONE
- ntp = 0
- barostat = 1
- mcbarint = 100
- pres0 = ONE
- comp = 44.6d0
- taup = ONE
- npscal = 1
- nscm = 1000
- nstlim = 1
- t = ZERO
- dt = 0.001d0
- ntc = 1
- tol = 0.00001
- ntf = 1
- nsnb = 25
- cut = NO_INPUT_VALUE_FLOAT
- dielc = ONE
- ntpr = 50
- ntwr = 500
- ntwx = 0
- ntwv = 0
- ntwf = 0
- ntwe = 0
- ipb = 0
- inp = 2
-
-#ifdef RISMSANDER
- irism = 0
-#endif /*RISMSANDER*/
-
- ntave = 0
- ioutfm = 0
- ntr = 0
- ntrx = 1
- ivcap = 0
- natcap = 0
- fcap = 1.5d0
- cutcap = 0.0d0
- xcap = 0.0d0
- ycap = 0.0d0
- zcap = 0.0d0
- forth = 1.5d0
- xlorth = -1.0d0
- ylorth = -1.0d0
- zlorth = -1.0d0
- xorth = 47114711.0d0
- yorth = 47114711.0d0
- zorth = 47114711.0d0
- numexchg = 0
- repcrd = 1
- lj1264 = 0
-
- profile_mpi = 0 !whether to write profile_mpi timing file - default = 0 (NO).
-
- ! number of waters to keep for hybrid model,
- ! numwatkeep: the number of closest
- ! waters to keep. close is defined as close to non-water.
- ! for simulations with ions, ions should be stripped too
- ! or at least ignored in the "closest" calculation. this
- ! is not currently done.
-
- ! if it stays at -1 then we keep all waters
- ! 0 would mean to strip them all
-
- numwatkeep=-1
-
- ! hybridgb: gb model to use with hybrid REMD.
- hybridgb=0
-
- ! carlos targeted MD, like ntr
-
- itgtmd=0
- tgtrmsd=0.
- tgtmdfrc=0.
- tgtfitmask=''
- tgtrmsmask=''
-
- pencut = 0.1d0
- taumet = 0.0001d0
- omega = 500.0d0
- ipnlty = 1
- scalm = 100.0d0
- iscale = 0
- noeskp = 1
- nmropt = 0
- jar = 0
- tausw = 0.1d0
- imin = 0
- isftrp = 0
- rwell = ONE
- maxcyc = 1
- ncyc = 10
- ntmin = 1
- dx0 = 0.01d0
- drms = 1.0d-4
- vlimit = 20.0d0
- mxsub = 1
- jfastw = 0
- watnam = ' '
- owtnm = ' '
- hwtnm1 = ' '
- hwtnm2 = ' '
- ntwprt = 0
- igb = 0
- alpb = 0
- Arad = 15.0d0
- rgbmax = 25.d0
- saltcon = ZERO
-
- ! default offset depends on igb value, and users need to
- ! be able to modify it, so we need to set a dummy value. if it's still the
- ! dummy after we read the namelist, we set the default based on igb. if not,
- ! we leave it at what the user set.
- ! best solution would be to create a GB namelist.
- offset = -999999.d0
- gbneckscale = -999999.d0
-
- iyammp = 0
- imcdo = -1
- gbsa = 0
- vrand=1000
- surften = 0.005d0
- iwrap = 0
- nrespa = 1
- nrespai = 1
- irespa = 1
- gamma_ln = ZERO
- extdiel = 78.5d0
- intdiel = ONE
- gbgamma = ZERO
- gbbeta = ZERO
- gbalpha = ONE
-
- !Hai Nguyen: set default parameters for igb = 8
- ! NOTE THAT NONE OF THESE ARE USED UNLESS IGB=8, SO USERS SHOULD NOT EVEN SET
- ! THEM
- gbalphaH = 0.788440d0
- gbbetaH = 0.798699d0
- gbgammaH = 0.437334d0
- gbalphaC = 0.733756d0
- gbbetaC = 0.506378d0
- gbgammaC = 0.205844d0
- gbalphaN = 0.503364d0
- gbbetaN = 0.316828d0
- gbgammaN = 0.192915d0
- gbalphaOS = 0.867814d0
- gbbetaOS = 0.876635d0
- gbgammaOS = 0.387882d0
- gbalphaP = 1.0d0 !P parameters are not optimized yet
- gbbetaP = 0.8d0 !P parameters are not optimized yet
- gbgammaP = 4.85d0 !P parameters are not optimized yet
- !scaling parameters below will only be used for igb=8.
- ! the actual code does not use these variables, it uses X(l96)
- ! if igb=8, we will use these to set the X(l96) array.
- Sh = 1.425952d0
- Sc = 1.058554d0
- Sn = 0.733599d0
- So = 1.061039d0
- Ss = -0.703469d0
- Sp = 0.5d0 !P parameters are not optimized yet
- !End Hai Nguyen
-
- iconstreff = 0
- cut_inner = EIGHT
- icfe = 0
- clambda = ZERO
- klambda = 1
- ievb = 0
- rbornstat = 0
- idecomp = 0
- ! added a flag to control output of BDC/SDC synonymous with MMPBSA.py's
- ! version of the same variable.
- dec_verbose = 3
- lastrst = 1
- lastist = 1
- restraintmask=''
- restraint_wt = ZERO
- bellymask=''
- noshakemask=''
- iwrap_mask='' ! GMS: mask to wrap around if iwrap == 2
- crgmask=''
- mmtsb_switch = mmtsb_off ! MMTSB Replica Exchange Off by Default
- mmtsb_iterations = 100 ! MMTSB Replica Exchange Frequency in Iterations
-
- icnstph = 0
- solvph = SEVEN
- ntcnstph = 10
- ntrelax = 500 ! how long to let waters relax
- mccycles = 1 ! How many cycles of Monte Carlo steps to run
- skmin = 50 !used by neb calculation
- skmax = 100 !used by neb calculation
- vv = 0 !velocity verlet -- off if vv/=1
- vfac = 0 !velocity verlet scaling factor, 0 by default
- tmode = 1 !default tangent mode for NEB calculation
-
- ifqnt = NO_INPUT_VALUE
-
- ifcr = 0 ! no charge relocation
- cropt = 0 ! 1-4 EEL is calculated with the original charges
- crcut = 3.0
- crskin = 2.0
- crin = ''
- crprintcharges = 0
-
- ips = 0 ! no isotropic periodic sum
- raips=-1.0d0 ! automatically determined
- mipsx=-1 ! number of grids in x direction, <0 for automatically determined
- mipsy=-1 ! number of grids in y direction, <0 for automatically determined
- mipsz=-1 ! number of grids in z direction, <0 for automatically determined
- mipso=4 ! default 4th order b-spline
- gridips=2 ! grid size. used to determine grid number if not defined
- dvbips=1.0d-8 ! Volume change tolerance. aips will be done when change more than dvbips
-
- iamd = 0 ! No accelerated MD used
- iamdlag = 0 !frequency of boosting in steps
- EthreshD = 0.d0
- alphaD = 0.d0
- EthreshP = 0.d0
- alphaP = 0.d0
- w_amd = 0 ! windowed amd
- EthreshD_w = 0.d0
- alphaD_w = 0.d0
- EthreshP_w = 0.d0
- alphaP_w = 0.d0
-
- scaledMD = 0 ! No scaled MD used
- scaledMD_lambda = 0.d0
-
- iemap=0 ! no emap constraint
- gammamap=1 ! default friction constant for map motion, 1/ps
- isgld = 0 ! no self-guiding
- isgsta=1 ! Begining index of SGLD range
- isgend=0 ! Ending index of SGLD range
- fixcom=-1 ! fix center of mass in SGLD simulation
- tsgavg=0.2d0 ! Local averaging time of SGLD simulation
- sgft=-1.0d3 ! Guiding factor of SGLD simulation
- sgff=-1.0d3 ! Guiding factor of SGLD simulation
- sgfd=-1.0d3 ! Guiding factor of SGLD simulation
- tempsg=0.0d0 ! Guiding temperature of SGLD simulation
- treflf=0.0d0 ! Reference low frequency temperature of SGLD simulation
- tsgavp=2.0d0 ! Convergency time of SGLD simulation
-
- ! Check to see if "cntrl" namelist has been defined.
- mdin_cntrl=.false.
- mdin_qmmm = .false.
- mdin_ewald=.false.
- mdin_pb=.false.
-#ifdef APBS
- mdin_apbs = .false.
-#endif /* APBS */
- mdin_lmod=.false.
- mdin_amoeba=.false.
- mdin_sebomd=.false.
- iamoeba = 0
-#ifdef MPI /* SOFT CORE */
- scalpha=0.5
- scbeta=12.0
- sceeorder=2
- ifsc=0
- logdvdl=0
- dvdl_norest=0
- dynlmb=0.0
- ifmbar=0
- bar_intervall=100
- bar_l_min=0.1
- bar_l_max=0.9
- bar_l_incr=0.1
- tishake = 0
- emil_sc = 0
-#endif
- ilrt = 0
- lrt_interval = 50
- lrtmask=''
-#ifdef DSSP
- idssp = 0
-#endif
- emil_do_calc = 0
-
-! Constant Surface Tension
- csurften = 0 !constant surface tension off (valid options are 0,1,2,3)
- gamma_ten = 0.0d0 !0.0 dyne/cm - default used in charmm. Ignored for csurften=0
- ninterface = 2 !Number of interfaces in the surface tension (Must be greater than 2)
-
- call nmlsrc('cntrl',5,ifind)
- if (ifind /= 0) mdin_cntrl=.true.
-
- call nmlsrc('ewald',5,ifind)
- if (ifind /= 0) mdin_ewald=.true.
-
- call nmlsrc('pb',5,ifind)
- if (ifind /= 0) mdin_pb=.true.
-
- call nmlsrc('qmmm', 5, ifind)
- if (ifind /= 0) mdin_qmmm = .true.
-
-#ifdef APBS
- call nmlsrc('apbs',5,ifind)
- if (ifind /= 0) mdin_apbs=.true.
-#endif /* APBS */
-
- call nmlsrc('lmod',5,ifind)
- if (ifind /= 0) mdin_lmod=.true.
-
- call nmlsrc('amoeba',5,ifind)
- if (ifind /= 0) mdin_amoeba=.true.
-
- call nmlsrc('sebomd',5,ifind)
- if (ifind /= 0) mdin_sebomd=.true.
-
-#ifdef _XRAY
- call nmlsrc('xray',5,ifind)
- xray_active = (ifind /= 0)
-#endif
-
- rewind 5
- if ( mdin_cntrl ) then
- read(5,nml=cntrl,err=999)
- else
- write(6, '(1x,a,/)') 'Could not find cntrl namelist'
- call mexit(6,1)
- end if
-
- if ( igb == 10 .and. ipb == 0 ) ipb = 2
- if ( igb == 0 .and. ipb /= 0 ) igb = 10
-
- if (plumed.eq.1) then
- write(6, '(1x,a,/)') 'PLUMED is on'
- write(6, '(1x,a,a,/)') 'PLUMEDfile is ',plumedfile
- endif
-
- if (ifqnt == NO_INPUT_VALUE) then
- ifqnt = 0 ! default value
- if (mdin_qmmm) then
- write(6, '(1x,a,/)') &
- '| WARNING qmmm namelist found, but ifqnt was not set! QMMM NOT &
- &active.'
- end if
- end if
-
- ! Now that we've read the input file, set up the defaults for variables
- ! whose values depend on other input values (ntb, cut)
- if (ntb == NO_INPUT_VALUE) then
- if (ntp > 0) then
- ntb = 2
- else if (igb > 0) then
- ntb = 0
- else
- ntb = 1
- end if
- end if
-
- if (ntxo == NO_INPUT_VALUE) then
-#ifdef MPI
- if (rem < 0) then
- ntxo = 2
- else
- ntxo = 1
- end if
-#else
- ntxo = 1
-#endif
- end if
-
- if (cut == NO_INPUT_VALUE_FLOAT) then
- if (igb == 0) then
- cut = EIGHT
- else
- cut = 9999.d0
- end if
- end if
-
-#ifdef RISMSANDER
- !force igb=6 to get vacuum electrostatics. This must be done ASAP to ensure SANDER's
- !electrostatics are initialized properly
- rismprm%irism=irism
- if(irism/=0) then
- write(6,'(a)') "|3D-RISM Forcing igb=6"
- igb=6
- end if
-#endif /*RISMSANDER*/
-
-
- if (ifqnt>0) then
- qmmm_nml%ifqnt = .true.
- if (saltcon /= 0.0d0) then
- qm_gb%saltcon_on = .true.
- else
- qm_gb%saltcon_on = .false.
- end if
- if (alpb == 1) then
- qm_gb%alpb_on = .true.
- else
- qm_gb%alpb_on = .false.
- end if
- if (igb == 10 .or. ipb /= 0) then
- write(6, '(1x,a,/)') 'QMMM is not compatible with Poisson Boltzmann (igb=10 or ipb/=0).'
- call mexit(6,1)
- end if
- else
- qmmm_nml%ifqnt = .false.
- end if
-
- if ( mdin_lmod ) then
- rewind 5
- call read_lmod_namelist()
- end if
-
- !--------------------------------------------------------------------
- ! --- vars have been read ---
- !--------------------------------------------------------------------
-
- write(6,9309)
-
- ! emit warnings for retired cntrl namelist variables
-
- if ( dtemp /= RETIRED_INPUT_OPTION ) then
- write(6,'(/,a,/,a,/,a)') 'Warning: dtemp has been retired.', &
- ' Check the Retired Namelist Variables Appendix in the manual.'
- end if
- if ( dxm /= RETIRED_INPUT_OPTION ) then
- write(6,'(/,a,/,a,/,a)') 'Warning: dxm has been retired.', &
- ' Check the Retired Namelist Variables Appendix in the manual.'
- ! ' The step length will be unlimited.'
- end if
- if ( heat /= RETIRED_INPUT_OPTION ) then
- write(6,'(/,a,/,a,/,a)') 'Warning: heat has been retired.', &
- ' Check the Retired Namelist Variables Appendix in the manual.'
- end if
-
- if ( timlim /= RETIRED_INPUT_OPTION ) then
- write(6,'(/,a,/,a,/,a)') 'Warning: timlim has been retired.', &
- ' Check the Retired Namelist Variables Appendix in the manual.'
- end if
-
-! Constant surface tension valid options
- if (csurften > 0) then
- if (csurften < 0 .or. csurften > 3) then
- write(6,'(/2x,a)') &
- 'Invalid csurften value. csurften must be between 0 and 3'
- call mexit(6,1)
- end if
- if (ntb /= 2) then
- write(6,'(/2x,a)') &
- 'ntb invalid. ntb must be 2 for constant surface tension.'
- call mexit(6,1)
- end if
- if (ntp < 2) then
- write(6,'(/2x,a)') &
- 'ntp invalid. ntp must be 2 or 3 for constant surface tension.'
- call mexit(6,1)
- end if
- if (ninterface < 2) then
- write(6,'(/2x,a)') &
- 'ninterface must be greater than 2 for constant surface tension.'
- call mexit(6,1)
- end if
-
- if (iamoeba > 0 ) then
- write(6,'(/2x,a)') &
- 'Constant Surface Tension is not compatible with Amoeba Runs.'
- call mexit(6,1)
- end if
-
- if (ipimd > 0 ) then
- write(6,'(/2x,a)') &
- 'Constant Surface Tension is not compatible with PIMD Runs.'
- call mexit(6,1)
- end if
-
- end if
-
-! MC Barostat valid options. Some of these may work, but disable them until they
-! are fully tested.
-
- if (ntp > 0 .and. barostat == 2) then
- inerr = 0
- if (ievb /= 0) then
- write(6, '(/2x,a)') 'AMOEBA is not compatible with the MC Barostat'
- inerr = 1
- end if
- if (ipimd /= 0) then
- write(6, '(/2x,a)') 'PIMD is not compatible with the MC Barostat'
- inerr = 1
- end if
- if (icfe /= 0) then
- write(6, '(/2x,a)') 'TI is not compatible with the MC Barostat'
- inerr = 1
- end if
-#ifdef LES
- write(6, '(/2x,a)') 'LES is not compatible with the MC Barostat'
- inerr = 1
-#endif
- ! Any others? Hopefully most or all of the above can be made compatible.
- if (inerr == 1) &
- call mexit(6, 1)
- end if
-
- call printflags()
-
- !--------------------------------------------------------------------
- ! If user has requested ewald electrostatics, read some more input
- !--------------------------------------------------------------------
-
- if( igb == 0 .and. ipb == 0 ) call load_ewald_info(parm,inpcrd,ntp)
-
- !--------------------------------------------------------------------
- ! parameters for IPS and for SGLD:
- ! ips=1 3D IPS for electrostatic and Lennard-Jones potentials
- ! ips=2 3D IPS for electrostatic potential only
- ! ips=3 3D IPS for Lennard-Jones potential only
- ! ips=4 3D IPS/DFFT for electrostatic and Lennard-Jones potentials
- ! ips=5 3D IPS/DFFT for electrostatic potential only
- ! ips=6 3D IPS/DFFT for Lennard-Jones potential only
- !--------------------------------------------------------------------
-
- teips=.false.
- tvips=.false.
- teaips=.false.
- tvaips=.false.
- if((ips-4)*(ips-6) == 0 )tvaips =.true.
- if ( (ips-4)*(ips-5) == 0 )teaips =.true.
- if( tvaips.OR.( (ips -1)*(ips-3) == 0 ))tvips =.true.
- if( teaips.OR.((ips -1)*(ips-2) == 0 ))teips =.true.
- if( teips ) then
- use_pme = 0
- eedmeth = 6
- end if
- if( tvips ) then
- vdwmeth = 2
- if(use_pme/=0.and.tvaips)then
- mipsx=nfft1 ! number of grids in x direction, <0 for automatically determined
- mipsy=nfft2 ! number of grids in y direction, <0 for automatically determined
- mipsz=nfft3 ! number of grids in z direction, <0 for automatically determined
- mipso=order ! default 6th order b-spline
- endif
- end if
- temap=iemap>0
- ishake = 0
- if (ntc > 1) ishake = 1
-
- !--------------------------------------------------------------------
- ! Set up some parameters for AMD simulations:
- ! AMD initialization
- ! iamd=0 no boost is used, 1 boost on the total energy,
- ! 2 boost on the dohedrals, 3 boost on dihedrals and total energy
- !--------------------------------------------------------------------
- if(iamd.gt.0)then
- if(iamd.eq.1)then !only total potential energy will be boosted
- EthreshD=0.d0
- alphaD=0.d0
- else if(iamd.eq.2)then !only dihedral energy will be boosted
- EthreshP=0.d0
- alphaP=0.d0
- endif
- if(w_amd.gt.0)then
- if(iamd.eq.1)then !only total potential energy will be boosted
- EthreshD_w=0.d0
- alphaD_w=0.d0
- else if(iamd.eq.2)then !only dihedral energy will be boosted
- EthreshP_w=0.d0
- alphaP_w=0.d0
- endif
- write(6,'(a,i3)')'| Using Windowed Accelerated MD (wAMD) &
- &LOWERING BARRIERS to enhance sampling w_amd =', w_amd
- write(6,'(a,2f22.12)')'| AMD boost to total energy: EthreshP,alphaP',&
- EthreshP, alphaP
- write(6,'(a,2f22.12)')'| AMD boost to dihedrals: EthreshD,alphaD',&
- EthreshD,alphaD
- write(6,'(a,2f22.12)')'| AMD extra parameters boost to total energy: &
- &EthreshP_w,alphaP_w', EthreshP_w, alphaP_w
- write(6,'(a,2f22.12)')'| AMD extra parameters boost to dihedrals: &
- &EthreshD_w,alphaD_w', EthreshD_w, alphaD_w
- else
- write(6,'(a,i3)')'| Using Accelerated MD (AMD) RASING VALLEYS to &
- &enhance sampling iamd =',iamd
- write(6,'(a,2f22.12)')'| AMD boost to total energy: EthreshP,alphaP', &
- EthreshP, alphaP
- write(6,'(a,2f22.12)')'| AMD boost to dihedrals: EthreshD,alphaD', &
- EthreshD, alphaD
- endif
- endif
-
-
- !--------------------------------------------------------------------
- ! Set up some parameters for scaledMD simulations:
- ! scaledMD initialization
- ! scaledMD=0 no scaling is used, 1 scale the potential energy
- !--------------------------------------------------------------------
- if(scaledMD.gt.0)then
- write(6,'(a,i3)')'| Using Scaled MD to enhance sampling scaledMD =',&
- scaledMD
- write(6,'(a,f22.12)')'| scaledMD scaling factor lambda: ',scaledMD_lambda
- endif
-
-
-
-
- !--------------------------------------------------------------------
- ! Set up some parameters for GB simulations:
- !--------------------------------------------------------------------
- !Hai Nguyen: update offset = 0.09d0 for igb /= 8
- !I add this step because I want to use different offset value as default value
- !for igb = 8
-
- if ( igb == 8 ) then
- if (offset == -999999.d0) then
- offset = 0.195141d0 !set to default for igb=8
- end if
- if (gbneckscale == -999999.d0) then
- gbneckscale = 0.826836d0
- end if
- else
- ! not igb=8, use old defaults
- if (offset == -999999.d0) then
- offset = 0.09d0
- end if
- if (gbneckscale == -999999.d0) then
- gbneckscale = 0.361825d0
- end if
- endif
-
- if( igb == 2 .or. hybridgb == 2 ) then
- ! --- use our best guesses for Onufriev/Case GB (GB^OBC I)
-
- gbgamma = 2.90912499999d0 ! (the "99999" to force roundoff on print)
- gbbeta = ZERO
- gbalpha = 0.8d0
- end if
-
- if( igb == 5 .or. hybridgb == 5 ) then
-
- ! --- use our second best guesses for Onufriev/Case GB (GB^OBC II)
-
- gbgamma = 4.850d0
- gbbeta = 0.8d0
- gbalpha = ONE
- end if
-
- if( igb == 7 ) then
-
- ! --- use parameters for Mongan et al. CFA GBNECK
-
- gbgamma = 2.50798245d0
- gbbeta = 1.90792938d0
- gbalpha = 1.09511284d0
- end if
-
- !--------------------------------------------------------------------
- ! If user has requested PB electrostatics, read some more input
- !--------------------------------------------------------------------
-
- if ( igb == 10 .or. ipb /= 0 ) then
-#ifdef MPI
- write(6,'(a)') "PBSA currently doesn't work with MPI inside SANDER."
- call mexit(6,1)
-#endif /*MPI*/
- call pb_read
- end if
-
-#ifdef APBS
- if ( mdin_apbs ) then
- call apbs_read
- end if
-#endif /* APBS */
-
-#ifdef _XRAY
- call xray_read_mdin(mdin_lun=5)
-#endif
-
- call sebomd_namelist_default
- if (mdin_sebomd) then
- rewind 5
- call read_sebomd_namelist
- endif
-
- if( iamoeba == 1 ) then
- if( mdin_amoeba ) then
- call AMOEBA_read_mdin(5)
- else
- write(6,*) ' iamoeba is set but the &amoeba namelist was not found'
- call mexit(6,1)
- end if
- end if
-
- ! -------------------------------------------------------------------
- ! If the user has requested NMR restraints, do a cursory read of the
- ! restraints file(s) now to determine the amount of memory necessary
- ! for these restraints:
- ! -------------------------------------------------------------------
-
- if (jar == 1 ) nmropt = 1
- intreq = 0
- irlreq = 0
- if (nmropt > 0) then
- mxgrp = 0
- itotst = 1
-
- ! Set ITOTST to 0 if IMIN equals 1 (i.e. if minimization, not dynamics)
- ! This will cause any "time-averaged" requests to be over-ridden.
-
- if (imin == 1) then
- itotst = 0
- end if
- ! CALL AMOPEN(31,NMR,'O','F','R')
- call restlx(5,itotst,mxgrp,dt,6,ierr)
- ! CLOSE(31)
- end if
-
- ! -------------------------------------------------------------------
- ! If EMIL was requested, make sure it was compiled in, and validate.
- ! -------------------------------------------------------------------
- if( emil_do_calc .gt. 0 ) then
-#ifdef EMIL
- if( ntc .ne. 1 ) then
- write (6, '(a,a)') error_hdr, 'emil_do_calc == 1,'
- write (6, '(a)') ' and ntc != 1.'
- write (6, '(a)') ' Current thinking is that SHAKE and '
- write (6, '(a)') ' EMIL do not mix well, consider setting ntc = 1, ntf = 1,'
- write (6, '(a)') ' and dt = 0.001.'
- call mexit(6,1)
- end if
-#else
- write (6, '(a,a)') error_hdr, 'emil_do_calc = 1,'
- write (6, '(a)') ' but AMBER was compiled with EMIL switched out.'
- write (6, '(a)') ' Run $AMBERHOME/configure --help for more info.'
- call mexit(6,1)
-#endif
- end if
-
-
- ! Set the definition of the water molecule. The default definition is in
- ! WATDEF(4).
-
- read(watdef(1),'(A4)') iwtnm
- read(watdef(2),'(A4)') iowtnm
- read(watdef(3),'(A4)') ihwtnm(1)
- read(watdef(4),'(A4)') ihwtnm(2)
- if (watnam /= ' ') read(watnam,'(A4)') iwtnm
- if (owtnm /= ' ') read(owtnm, '(A4)') iowtnm
- if (hwtnm1 /= ' ') read(hwtnm1,'(A4)') ihwtnm(1)
- if (hwtnm2 /= ' ') read(hwtnm2,'(A4)') ihwtnm(2)
-
-#if !defined(DISABLE_NCSU) && defined(MPI)
- call ncsu_on_mdread1()
-#endif
-
- return
- 999 continue ! bad cntrl read
- write(6,*) 'error in reading namelist cntrl'
- call mexit(6,1)
-
- ! --- input file polar opts read err trapping:
-
- 9308 format(/10x,55('-'),/10x, &
- 'Amber 14 SANDER 2014', &
- /10x,55('-')/)
- 9309 format(/80('-')/' 1. RESOURCE USE: ',/80('-')/)
- 9700 format(/,'File Assignments:',/,15('|',a6,': ',a,/))
- 9701 format('|',a6,': ',a)
- 9702 format(7('|',a10,': ',a,/))
-end subroutine mdread1
-#endif /*ifndef PBSA*/
-
-#ifndef PBSA
-!======================================================================
-! MDREAD2
-!======================================================================
-
-!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-!+ Initialize to defaults and print the inputable variables.
-subroutine mdread2(x,ix,ih,ipairs)
-
- use molecule, only: n_iwrap_mask_atoms, iwrap_mask_atoms
- use lmod_driver, only : LMOD_NTMIN_LMOD, LMOD_NTMIN_XMIN, write_lmod_namelist
- use decomp, only : jgroup, indx, irespw
- use findmask
- use qmmm_module, only : qmmm_nml,qmmm_struct, qm2_struct, qm2_rij_eqns, qm_gb, qmmm_vsolv
- use qmmm_vsolv_module, only : print
- use constants, only : ZERO, ONE, TWO
- use parms, only: req
- use nbips, only: ips
- use amd_mod, only: iamd,iamdlag,EthreshD,alphaD,EthreshP,alphaP, &
- w_amd,EthreshD_w,alphaD_w,EthreshP_w,alphaP_w
- use scaledMD_mod, only: scaledMD
- use nblist, only: a,b,c,alpha,beta,gamma,nbflag,skinnb,sphere,nbtell,cutoffnb
- use amoeba_mdin, only : iamoeba,beeman_integrator
- use amoeba_runmd, only : AM_RUNMD_get_coords
- use nose_hoover_module, only: nchain ! APJ
- use pimd_vars, only: ipimd, itimass
- use neb_vars, only: last_neb_atom, ineb
- use cmd_vars, only: restart_cmd, eq_cmd, adiab_param
- use constantph, only: cnstphread, cnstph_zero, cph_igb, mccycles
- use file_io_dat
- use sander_lib, only: upper
-
- use emap,only: temap,emap_options
-
- use qmmm_module, only: get_atomic_number
-
- use sebomd_module, only: sebomd_obj, sebomd_write_info, sebomd_write_options
-
-#ifdef APBS
- use apbs
-#endif /* APBS */
-#ifdef EMIL
- use emil_mod, only : emil_do_calc
- use mdin_emil_dat_mod, only : error_hdr, init_emil_dat
-#endif /* EMIL */
-#ifdef _XRAY
- use xray_interface_module, only: xray_write_options
-#endif /* _XRAY */
-#if defined(LES) && defined(MPI)
- use evb_pimd, only: evb_pimd_init
-#endif /* LES && MPI */
-#ifdef MPI /* SOFT CORE */
- use softcore, only : ifsc, scmask, scalpha, scbeta, dvdl_norest, &
- sceeorder, logdvdl, dynlmb, tishake
- use mbar, only : ifmbar, bar_intervall, bar_l_min, bar_l_max, bar_l_incr
-! REMD
- use remd, only : rem, rremd
-#endif
- use crg_reloc, only: ifcr, cropt, crcut, crskin, crprintcharges
- use linear_response, only: ilrt, lrt_interval, lrtmask
-! SGLD
- use sgld, only : isgld
-
- implicit none
- _REAL_ x(*)
-# include "../include/memory.h"
- integer ix(lasti),ipairs(*)
- character(len=4) ih(*)
- integer nbond
- integer atom1,atom2
- integer ntmp
- logical belly,konst
- character(len=1) atsymb,atsymb2
- character(len=2) atype
- integer atomicnumber, hybridization
- integer ngrp,inerr,nr,iaci,ir,i,mxresat,j
- integer noshakegp( natom ), natnos
- integer iwrap_maskgp( natom ) , ier
- logical errFlag
- integer crggp( natom )
- _REAL_ dummy,rvdw,dcharge,emtmd
- logical newstyle
-
-#ifdef MPI
- ! =========================== AMBER/MPI ===========================
-#ifdef MPI_DOUBLE_PRECISION
-# undef MPI_DOUBLE_PRECISION
-#endif
- include 'mpif.h'
-# include "parallel.h"
- integer ist(MPI_STATUS_SIZE), partner, ierr, nbonh_c, num_noshake_c
- integer nquant_c, noshake_overlap_c
-#ifdef CRAY_PVP
-# define MPI_DOUBLE_PRECISION MPI_REAL8
-#endif
- ! ========================= END AMBER/MPI =========================
-#endif
-# include "../include/md.h"
-# include "box.h"
-# include "mmtsb.h"
-# include "nmr.h"
-# include "extra_pts.h"
-# include "ew_cntrl.h"
-# include "ew_pme_recip.h"
-# include "ew_erfc_spline.h"
-# include "ew_mpole.h"
-# include "ew_legal.h"
-# include "def_time.h"
-# include "tgtmd.h"
-# include "multitmd.h"
-#ifdef LES
-# include "les.h"
-#endif
-
- ! -------------------------------------------------------------------
- ! --- set up resat array, containing string identifying
- ! residue for each atom
- ! -------------------------------------------------------------------
-
- mxresat = min( natom, matom )
- ir = 0
- do i=1,mxresat
- if (i >= ix(ir+i02)) ir=ir+1
- write(resat(i),'(a4,1x,a4,i4)') ih(m04+i-1), &
- ih(ir+m02-1),ir
- ! ---null terminator:
- resat(i)(14:14) = char(0)
- end do
- close(unit=8)
-
- ! -------------------------------------------------------------------
- ! ----- SET THE DEFAULT VALUES FOR SOME VARIABLES -----
- ! -------------------------------------------------------------------
-
- nrp = natom
-
- if (ifbox == 1) write(6, '(/5x,''BOX TYPE: RECTILINEAR'')')
- if (ifbox == 2) write(6, '(/5x,''BOX TYPE: TRUNCATED OCTAHEDRON'')')
- if (ifbox == 3) write(6, '(/5x,''BOX TYPE: GENERAL'')')
-
- ! For 0< ipimd <= 3, no removal of COM motion
- if (ipimd>0.and.ipimd<=3) then
- nscm = 0
- ndfmin = 0
- endif
-
- if (ntr.eq.1) &
- nscm = 0
-
- nsolut = nrp
- if ( nscm > 0 .and. ntb == 0 ) then
- ndfmin = 6 ! both translation and rotation com motion removed
- if (nsolut == 1) ndfmin = 3
- if (nsolut == 2) ndfmin = 5
- else if ( nscm > 0 ) then
- ndfmin = 3 ! just translation com will be removed
- else
- ndfmin = 0
- end if
- if (ibelly > 0) then ! No COM Motion Removal, ever.
- nscm = 0
- ndfmin = 0
-
- !Do not allow ntt=3 with ibelly=1 - this does not make sense and will cause
- !issues.
- if (ntt==3) then
- call sander_bomb("mdread2","ibelly=1 with ntt=3 is not a valid option.", &
- "Either use a different thermostat or avoid using ibelly.")
- end if
- end if
- if(nscm <= 0) nscm = 0
- if(gamma_ln > 0.0d0)ndfmin=0 ! No COM motion removal for LD simulation
- if(ntt == 4)ndfmin=0 ! No COM motion removal for Nose'-Hoover simulation
- init = 3
- if (irest > 0) init = 4
- if (dielc <= ZERO ) dielc = ONE
- if (tautp <= ZERO ) tautp = 0.2d0
- if (taup <= ZERO ) taup = 0.2d0
-
- ! ----- RESET THE CAP IF NEEDED -----
-
- ! ivcap == 0: Cap will be in effect if it is in the prmtop file (ifcap = 1)
-
- if(ivcap == 1) then
- ! Cap will be in effect even if not in prmtop file
- ! requires additional information in sander.in file as in the case of ivcap == 3, 4, or 5
- ifcap = 2
- else if(ivcap == 2) then
- ! Inactivate cap
- ifcap = 0
- else if(ivcap == 3) then
- ! Sphere -> not yet implemented
- ifcap = 3
- else if(ivcap == 4) then
- ! Orthorhombus
- ifcap = 4
- else if(ivcap == 5) then
- ! Shell of waters around solute
- ifcap = 5
- end if
-
- !Support for random seed using time of day in microsecs
- if( ig==-1 ) then
- !Turn on NO_NTT3_SYNC when ig=-1. This means the code no
- !longer synchronized the random numbers between streams when
- !running in parallel giving better scaling.
- no_ntt3_sync = 1
- call microsec(ig)
-#ifdef MPI
- write (6, '(a,i8,a)') "Note: ig = -1. Setting random seed to ", ig ," based on wallclock &
- &time in microseconds"
- write (6, '(a)') " and disabling the synchronization of random &
- &numbers between tasks"
- write (6, '(a)') " to improve performance."
-#else
- write (6, '(a,i8,a)') "Note: ig = -1. Setting random seed to ", ig ," based on wallclock &
- &time in microseconds."
-#endif
- end if
-
-#ifdef MPI
- !For some runs using multisander where the coordinates of the two 'replicas' need to be identical,
- !for example TI, it is critical that the random number stream is synchronized between all replicas.
- !Only use the IG value from worldrank=0. Ok to broadcast between the various sander masters since
- !they all call mdread2.
- !Also needs to be synchronized for adaptive QM/MM (qmmm_nml%vsolv > 1)
- if ( (icfe > 0) .or. (qmmm_nml%vsolv > 1) ) then
- ! no_ntt3_sync currently does not work with softcore TI simulations
- ! see sc_lngdyn in softcore.F90
- ! AWG: I think I also need to set no_ntt3_sync=0 ???
- if ( (ifsc > 0) .or. (qmmm_nml%vsolv > 1) ) no_ntt3_sync = 0
- call mpi_bcast(ig, 1, MPI_INTEGER, 0, commmaster, ierr)
- end if
-#endif
-
- ! -------------------------------------------------------------------
- ! ----- PRINT DATA CHARACTERIZING THE RUN -----
- ! -------------------------------------------------------------------
-
- nr = nrp
- write(6,9328)
- write(6,9008) title
- write(6,'(/a)') 'General flags:'
- write(6,'(5x,2(a,i8))') 'imin =',imin,', nmropt =',nmropt
-
- ! Error Checking for REMD
-#ifdef MPI
- if (rem/=0) then
- ! Make sure that the number of replicas is even so
- ! that they all have partners in the exchange step
- if (mod(numgroup,2).ne.0) then
- write (6,'(a)') "==================================="
- write (6,'(a)') "REMD requires an even # of replicas"
- write (6,'(a)') "==================================="
- call mexit (6,1)
- endif
-
- write(6,'(/a)') 'Replica exchange'
- write(6,'(5x,4(a,i8))') 'numexchg=',numexchg,', rem=',rem
-
- ! REPCRD option temporarily disabled
- if (repcrd == 0) write(6,'(a)') &
- "REMD WARNING: repcrd disabled. Only replica &
- &trajectories/output can be written."
-
- ! Check for correct number of exchanges
- if (numexchg <= 0) then
- write(6,'(a)') "REMD ERROR: numexchg must be > 0, "
- call mexit(6,1)
- endif
-
- ! RXSGLD
- if (isgld > 0 .and. rem < 0) then
- write(6, '(a)') 'Multi-D REMD and replica-exchange SGLD are not &
- &supported yet!'
- call mexit(6, 1)
- end if
-
- ! Hybrid GB
- if (numwatkeep >= 0) then
- write(6,'(5x,4(a,i8))') 'numwatkeep=',numwatkeep,', hybridgb=',hybridgb
- ! Check that user specified GB model for hybrid REMD
- if (hybridgb /= 2 .and. hybridgb /= 5 .and. hybridgb /= 1) then
- write(6,'(a)') "HYBRID REMD ERROR: hybridgb must be 1, 2, or 5."
- call mexit(6,1)
- endif
- else
- !Check that user did not specify GB model if no hybrid run.
- if (hybridgb /= 0) then
- write(6,'(a)') &
- "HYBRID REMD ERROR: numwatkeep must be >= 0 when hybridgb is set."
- call mexit(6,1)
- endif
- endif
- ! RREMD
- if (rremd>0) then
- write(6,'(5x,4(a,i8))') "rremd=",rremd
- endif
-
- ! ntp > 0 not allowed for remd
- if (ntp > 0) then
- write(6,'(a,i1)') "ERROR: ntp > 0 not allowed for rem > 0, ntp=", ntp
- call mexit(6,1)
- endif
-
- ! M-REMD (rem < 0) requires netcdf output.
- if (rem < 0 .and. ioutfm .ne. 1) then
- write(6,'(a)') "ERROR: Multi-D REMD (rem < 0) requires NetCDF &
- &trajectories (ioutfm=1)"
- call mexit(6,1)
- endif
-
-# ifdef LES
- ! DAN ROE: Temporarily disable LES REMD until it is verified with new
- ! REMD code
- if (rem==2) then
- write (6,*) "******* LES REM (rem==2) temporarily disabled. Stop. *******"
- call mexit(6,1)
- endif
-
- if (rem==2 .and. igb/=1) then
- write (6,*) ' partial REM (rem=2) only works with igb=1'
- call mexit(6,1)
- endif
-# else
- if (rem==2) then
- write(6,*) '******* For rem ==2, partial REM'
- write(6,*) 'use sander.LES with topology created by addles'
- call mexit(6,1)
- endif
-# endif
-
- endif ! rem>0
-
-#else /* _NO_ MPI */
- ! Check if user set numexchg with no MPI
- if (numexchg>0) write(6,'(a)') &
- "WARNING: numexchg > 0 - for REMD run please recompile sander for &
- ¶llel runs."
-
- ! Check if user set numwatkeep or hybridgb with no MPI - not sensible.
- if (numwatkeep>=0) write(6,'(a)') &
- "WARNING: numwatkeep >= 0 - for hybrid REMD run please recompile &
- &sander for parallel runs."
-
- if (hybridgb>0) write(6,'(a)') &
- "WARNING: hybridgb > 0 - for hybrid REMD run please recompile &
- &sander for parallel runs."
-#endif /* MPI */
- ! End error checking for REMD
-
- write(6,'(/a)') 'Nature and format of input:'
- write(6,'(5x,4(a,i8))') 'ntx =',ntx,', irest =',irest, &
- ', ntrx =',ntrx
-
- write(6,'(/a)') 'Nature and format of output:'
- write(6,'(5x,4(a,i8))') 'ntxo =',ntxo,', ntpr =',ntpr, &
- ', ntrx =',ntrx,', ntwr =',ntwr
- write(6,'(5x,5(a,i8))') 'iwrap =',iwrap,', ntwx =',ntwx, &
- ', ntwv =',ntwv,', ntwe =',ntwe
- write(6,'(5x,3(a,i8),a,i7)') 'ioutfm =',ioutfm, &
- ', ntwprt =',ntwprt, &
- ', idecomp =',idecomp,', rbornstat=',rbornstat
- if (ntwf > 0) &
- write(6,'(5x, a,i8)') 'ntwf =',ntwf
- write(6,'(/a)') 'Potential function:'
- write(6,'(5x,5(a,i8))') 'ntf =',ntf,', ntb =',ntb, &
- ', igb =',igb,', nsnb =',nsnb
- write(6,'(5x,3(a,i8))') 'ipol =',ipol,', gbsa =',gbsa, &
- ', iesp =',iesp
- write(6,'(5x,3(a,f10.5))') 'dielc =',dielc, &
- ', cut =',cut,', intdiel =',intdiel
-
- ! charge relocation
- if ( ifcr /= 0 ) then
- write(6,'(/a)') 'Charge relocation:'
- write(6,'(5x,2(a,i8))') 'cropt =', cropt, &
- ', crprintcharges=', crprintcharges
- write(6,'(5x,2(a,f10.5))') 'crcut =', crcut, ', crskin =', crskin
- end if
-
- if (( igb /= 0 .and. igb /= 10 .and. ipb == 0 .and. igb /= 8) &
- .or.hybridgb>0.or.icnstph>1) then
- write(6,'(5x,3(a,f10.5))') 'saltcon =',saltcon, &
- ', offset =',offset,', gbalpha= ',gbalpha
- write(6,'(5x,3(a,f10.5))') 'gbbeta =',gbbeta, &
- ', gbgamma =',gbgamma,', surften =',surften
- write(6,'(5x,3(a,f10.5))') 'rdt =',rdt, ', rgbmax =',rgbmax, &
- ' extdiel =',extdiel
- write(6,'(5x,3(a,i8))') 'alpb = ',alpb
- end if
-
- !Hai Nguyen: print output for igb=8
- if ( igb == 8 ) then
- write(6,'(5x,3(a,f10.5))') 'saltcon =',saltcon, &
- ', offset =',offset,', surften =',surften
- write(6,'(5x,3(a,f10.5))') 'rdt =',rdt, ', rgbmax =',rgbmax, &
- ' extdiel =',extdiel
- write(6,'(5x,3(a,i8))') 'alpb = ',alpb
- write(6,'(5x,3(a,f10.5))') 'gbalphaH =',gbalphaH, &
- ', gbbetaH =',gbbetaH,', gbgammaH = ',gbgammaH
- write(6,'(5x,3(a,f10.5))') 'gbalphaC =',gbalphaC, &
- ', gbbetaC =',gbbetaC,', gbgammaC = ',gbgammaC
- write(6,'(5x,3(a,f10.5))') 'gbalphaN =',gbalphaN, &
- ', gbbetaN =',gbbetaN,', gbgammaN = ',gbgammaN
- write(6,'(5x,3(a,f10.5))') 'gbalphaOS =',gbalphaOS, &
- ', gbbetaOS =',gbbetaOS,', gbgammaOS = ',gbgammaOS
- write(6,'(5x,3(a,f10.5))') 'gbalphaP =',gbalphaP, &
- ', gbbetaP =',gbbetaP,', gbgammaP = ',gbgammaP
- end if
-
-
- if( alpb /= 0 ) then
- write(6,'(5x,3(a,f10.5))') 'Arad =', Arad
- end if
-
- write(6,'(/a)') 'Frozen or restrained atoms:'
- write(6,'(5x,4(a,i8))') 'ibelly =',ibelly,', ntr =',ntr
- if( ntr == 1 ) write(6,'(5x,a,f10.5)') 'restraint_wt =', restraint_wt
-
- if( imin /= 0 ) then
- if( ipimd > 0 ) then
- write(6,'(/a)') 'pimd cannot be used in energy minimization'
- stop
- end if
-
- write(6,'(/a)') 'Energy minimization:'
- ! print inputable variables applicable to all minimization methods.
- write(6,'(5x,4(a,i8))') 'maxcyc =',maxcyc,', ncyc =',ncyc, &
- ', ntmin =',ntmin
- write(6,'(5x,2(a,f10.5))') 'dx0 =',dx0, ', drms =',drms
-
- ! Input flag ntmin determines the method of minimization
- select case ( ntmin )
- case ( 0, 1, 2 )
- ! no specific output
- case ( LMOD_NTMIN_XMIN, LMOD_NTMIN_LMOD )
- call write_lmod_namelist( )
- case default
- ! invalid ntmin
- write(6,'(/2x,a,i3,a)') 'Error: Invalid NTMIN (',ntmin,').'
- stop
- end select
- else
- write(6,'(/a)') 'Molecular dynamics:'
- write(6,'(5x,4(a,i10))') 'nstlim =',nstlim,', nscm =',nscm, &
- ', nrespa =',nrespa
- write(6,'(5x,3(a,f10.5))') 't =',t, &
- ', dt =',dt,', vlimit =',vlimit
-
- if ( ntt == 0 .and. tempi > 0.0d0 .and. irest == 0 ) then
- write(6,'(/a)') 'Initial temperature generation:'
- write(6,'(5x,a,i8)') 'ig =',ig
- write(6,'(5x,a,f10.5)') 'tempi =',tempi
- else if( ntt == 1 ) then
- write(6,'(/a)') 'Berendsen (weak-coupling) temperature regulation:'
- write(6,'(5x,3(a,f10.5))') 'temp0 =',temp0, &
- ', tempi =',tempi,', tautp =', tautp
-#ifdef LES
- write(6,'(5x,3(a,f10.5))') 'temp0LES =',temp0les
-#endif
- else if( ntt == 2 ) then
- write(6,'(/a)') 'Anderson (strong collision) temperature regulation:'
- write(6,'(5x,4(a,i8))') 'ig =',ig, ', vrand =',vrand
- write(6,'(5x,3(a,f10.5))') 'temp0 =',temp0, ', tempi =',tempi
- else if( ntt == 3 ) then
- write(6,'(/a)') 'Langevin dynamics temperature regulation:'
- write(6,'(5x,4(a,i8))') 'ig =',ig
- write(6,'(5x,3(a,f10.5))') 'temp0 =',temp0, &
- ', tempi =',tempi,', gamma_ln=', gamma_ln
- else if( ntt == 4 ) then
- write(6,'(/a)') 'Nose-Hoover chains'
- write(6,'(5x,(a,f10.5))') 'gamma_ln=', gamma_ln
- write(6,'(5x,(a,i8))') 'number of oscillators=', nchain
- else if( ntt == 5 ) then ! APJ
- write(6,'(/a)') 'Nose-Hoover chains Langevin' ! APJ
- write(6,'(5x,4(a,i8))') 'ig =',ig ! APJ
- write(6,'(5x,(a,f10.5))') 'gamma_ln=', gamma_ln ! APJ
- write(6,'(5x,(a,i8))') 'number of oscillators=', nchain ! APJ
- else if( ntt == 6 ) then ! APJ
- write(6,'(/a)') 'Adaptive Langevin temperature regulation:' ! APJ
- write(6,'(5x,4(a,i8))') 'ig =',ig ! APJ
- write(6,'(5x,3(a,f10.5))') 'temp0 =',temp0, & ! APJ
- ', tempi =',tempi,', gamma_ln=', gamma_ln ! APJ
- else if( ntt == 7 ) then ! APJ
- write(6,'(/a)') 'Adaptive Nose-Hoover chains' ! APJ
- write(6,'(5x,(a,f10.5))') 'gamma_ln=', gamma_ln ! APJ
- write(6,'(5x,(a,i8))') 'number of oscillators=', nchain ! APJ
- else if( ntt == 8 ) then ! APJ
- write(6,'(/a)') 'Adaptive Nose-Hoover chains Langevin' ! APJ
- write(6,'(5x,4(a,i8))') 'ig =',ig ! APJ
- write(6,'(5x,(a,f10.5))') 'gamma_ln=', gamma_ln ! APJ
- write(6,'(5x,(a,i8))') 'number of oscillators=', nchain ! APJ
- end if
-
- if( ntp /= 0 ) then
- write(6,'(/a)') 'Pressure regulation:'
- write(6,'(5x,4(a,i8))') 'ntp =',ntp
- write(6,'(5x,3(a,f10.5))') 'pres0 =',pres0, &
- ', comp =',comp,', taup =',taup
- if (barostat == 2) then
- write(6, '(5x,a)') 'Monte-Carlo Barostat:'
- write(6, '(5x,a,i8)') 'mcbarint =', mcbarint
- end if
- end if
-
- if (csurften /= 0) then
- write(6,'(/a)') 'Constant surface tension:'
- write(6,'(5x,a,i8)') 'csurften =', csurften
- write(6,'(5x,a,f10.5,a,i8)') 'gamma_ten =', gamma_ten, ' ninterface =', ninterface
- end if
-
- end if
-
- if( ntc /= 1 ) then
- write(6,'(/a)') 'SHAKE:'
- write(6,'(5x,4(a,i8))') 'ntc =',ntc,', jfastw =',jfastw
- write(6,'(5x,3(a,f10.5))') 'tol =',tol
- end if
-
- if( ifcap == 1 .or. ifcap == 2 .or. ifcap == 3 ) then
- write(6,'(/a)') 'Water cap:'
- write(6,'(5x,2(a,i8))') 'ivcap =',ivcap,', natcap =',natcap
- write(6,'(5x,2(a,f10.5))') 'fcap =',fcap, ', cutcap =',cutcap
- write(6,'(5x,3(a,f10.5))') 'xcap =',xcap, ', ycap =',ycap, &
- ', zcap =',zcap
- else if( ifcap == 4 ) then
- write(6,'(/a)') 'Orthorhombus:'
- write(6,'(5x,1(a,i8))') 'ivcap =',ivcap
- write(6,'(5x,1(a,f10.5))') 'forth =',forth
- write(6,'(5x,3(a,f10.5))') 'xlorth =',xlorth,', ylorth =',ylorth, &
- ', zlorth =',zlorth
- write(6,'(5x,3(a,f10.5))') 'xorth =',xorth, ', yorth =',yorth, &
- ', zorth =',zorth
- else if( ifcap == 5 ) then
- write(6,'(/a)') 'Water shell:'
- write(6,'(5x,(a,i8,a,f10.5))') 'ivcap =',ivcap,', cutcap =',cutcap
- endif
-
- if( nmropt > 0 ) then
- write(6,'(/a)') 'NMR refinement options:'
- write(6,'(5x,4(a,i8))')'iscale =',iscale,', noeskp =',noeskp, &
- ', ipnlty =',ipnlty,', mxsub =',mxsub
- write(6,'(5x,3(a,f10.5))') 'scalm =',scalm, &
- ', pencut =',pencut,', tausw =',tausw
- end if
-
- if( numextra > 0 ) then
- write(6,'(/a)') 'Extra-points options:'
- write(6,'(5x,4(a,i8))') 'frameon =',frameon, &
- ', chngmask=',chngmask
- end if
-
- if( ipol > 0 ) then
- write(6,'(/a)') 'Polarizable options:'
- write(6,'(5x,4(a,i8))') 'indmeth =',indmeth, &
- ', maxiter =',maxiter,', irstdip =',irstdip, &
- ', scaldip =',scaldip
- write(6,'(5x,3(a,f10.5))') &
- 'diptau =',diptau,', dipmass =',dipmass
- if ( ipol > 1 ) then
- write(6,'(5x,3(a,f10.5))') &
- 'Default Thole coefficient = ',dipdamp
- end if
- end if
-
-#ifdef MPI /* SOFT CORE */
- if( icfe /= 0 .or. ifsc/=0) then
- write(6,'(/a)') 'Free energy options:'
- write(6,'(5x,a,i8,a,i8,a,i8)') 'icfe =', icfe , ', ifsc =', ifsc, ', klambda =', klambda
- write(6,'(5x,a,f8.4,a,f8.4,a,f8.4)') 'clambda =', clambda, ', scalpha =', scalpha, ', scbeta =', scbeta
- write(6,'(5x,a,i8,a,i8)') 'sceeorder =', sceeorder, ' dvdl_norest =', dvdl_norest
- write(6,'(5x,a,f8.4,a,i8)') 'dynlmb =', dynlmb, ' logdvdl =', logdvdl
- end if
- if ( ifmbar /= 0 ) then
- write (6,'(/a)') 'FEP MBAR options:'
- write(6,'(5x,a,i8,a,i8)') 'ifmbar =', ifmbar, ', bar_intervall = ', bar_intervall
- write(6,'(5x,a,f6.4,a,f6.4,a,f6.4)') 'bar_l_min =', bar_l_min, ', bar_l_max =', bar_l_max, ', bar_l_incr =', bar_l_incr
- end if
-#endif
-
- if (ilrt /= 0) then
- write (6,*)
- write (6,'(a,i4,a,i4)') ' Linear Response Theory: ilrt =', ilrt, ' lrt_interval =', lrt_interval
- write (6,*)
- end if
-
- ! Options for TI w.r.t. mass.
- select case (itimass)
- case (0) ! Default: no TI wrt. mass.
- case (1,2) ! 1 = use virial est., 2 = use thermodynamic est.
- write(6,'(/a)') 'Isotope effects (thermodynamic integration w.r.t. mass):'
- write(6,'(5x,4(a,i8))') 'itimass =',itimass
- write(6,'(5x,3(a,f10.5))') 'clambda =',clambda
- if (icfe /= 0) then
- write(6,'(/2x,a,i2,a,i2,a)') 'Error: Cannot do TI w.r.t. both potential (icfe =', &
- icfe, ') and mass (itimass =', itimass, ').'
- stop
- endif
- if (ipimd == 0) then
- write(6,'(/2x,a)') 'Error (IPIMD=0): TI w.r.t. mass requires a PIMD run.'
- stop
- endif
- case default ! Invalid itimass
- write(6,'(/2x,a,i2,a)') 'Error: Invalid ITIMASS (', itimass, ' ).'
- stop
- end select
-
-!KFW
-! call mpi_bcast ( ievb, 1, MPI_INTEGER, 0, commworld, ierr )
-! call mpi_barrier ( commworld, ierr )
-
-! if( ievb == 1 ) then
-!KFW write(6,'(/a)') 'EVB options:'
-!KFW write(6,'(5x,3(a,f10.5))') 'V11 =',v11,', V22 =', v22, &
-!KFW ', V12 =', v12
-!kfw write(6,'(5x,3(a,f10.5))') 'kevb =',kevb,', evbt =', evbt
-! end if
-
- if( itgtmd == 1 ) then
- write(6,'(/a)') 'Targeted molecular dynamics:'
- write(6,'(5x,3(a,f10.5))') 'tgtrmsd =',tgtrmsd, &
- ', tgtmdfrc=',tgtmdfrc
- end if
-
- if( icnstph /= 0) then
- write(6, '(/a)') 'Constant pH options:'
- if ( icnstph .ne. 1 ) &
- write(6, '(5x,a,i8)') 'icnstph =', icnstph
- write(6, '(5x,a,i8)') 'ntcnstph =', ntcnstph
- write(6, '(5x,a,f10.5)') 'solvph =', solvph
- if ( icnstph .ne. 1 ) &
- write(6,'(5x,2(a,i8))') 'ntrelax =', ntrelax, ' mccycles =', mccycles
- end if
- if( icnstph /= 2) then
- ntrelax = 0 ! needed for proper behavior of timing
- end if
-
- if( ntb > 0 ) then
- write(6,'(/a)') 'Ewald parameters:'
- write(6,'(5x,4(a,i8))') 'verbose =',verbose, &
- ', ew_type =',ew_type,', nbflag =',nbflag, &
- ', use_pme =',use_pme
- write(6,'(5x,4(a,i8))') 'vdwmeth =',vdwmeth, &
- ', eedmeth =',eedmeth,', netfrc =',netfrc
- write(6, 9002) a, b, c
- write(6, 9003) alpha, beta, gamma
- write(6, 9004) nfft1, nfft2, nfft3
- write(6, 9006) cutoffnb, dsum_tol
- write(6, 9007) ew_coeff
- write(6, 9005) order
- 9002 format (5x,'Box X =',f9.3,3x,'Box Y =',f9.3,3x,'Box Z =',f9.3)
- 9003 format (5x,'Alpha =',f9.3,3x,'Beta =',f9.3,3x,'Gamma =',f9.3)
- 9004 format (5x,'NFFT1 =',i5 ,7x,'NFFT2 =',i5 ,7x,'NFFT3 =',i5)
- 9005 format (5x,'Interpolation order =',i5)
- 9006 format (5x,'Cutoff=',f9.3,3x,'Tol =',e9.3)
- 9007 format (5x,'Ewald Coefficient =',f9.5)
- end if
-
- if( mmtsb_switch /= mmtsb_off ) then
- call mmtsb_print_banner()
- call mmtsb_init( temp0, clambda )
- end if
-
-!---- QMMM Options ----
-
- if( qmmm_nml%ifqnt ) then
- write(6, '(/a)') 'QMMM options:'
- write(6, '(5x," ifqnt = True nquant = ",i8)') &
- qmmm_struct%nquant
- write(6, '(5x," qmgb = ",i8," qmcharge = ",i8," adjust_q = ",i8)') &
- qmmm_nml%qmgb, qmmm_nml%qmcharge, qmmm_nml%adjust_q
- write(6, '(5x," spin = ",i8," qmcut = ",f8.4, " qmshake = ",i8)') qmmm_nml%spin, &
- qmmm_nml%qmcut, qmmm_nml%qmshake
- write(6, '(5x," qmmm_int = ",i8)') qmmm_nml%qmmm_int
- write(6, '(5x,"lnk_atomic_no = ",i8," lnk_dis = ",f8.4," lnk_method = ",i8)') &
- qmmm_nml%lnk_atomic_no,qmmm_nml%lnk_dis, qmmm_nml%lnk_method
- if ( qmmm_nml%qmtheory%PM3 ) then
- write(6, '(5x," qm_theory = PM3")',ADVANCE='NO')
- else if ( qmmm_nml%qmtheory%AM1 ) then
- write(6, '(5x," qm_theory = AM1")',ADVANCE='NO')
- else if ( qmmm_nml%qmtheory%AM1D ) then
- write(6, '(5x," qm_theory = AM1/d")',ADVANCE='NO')
- else if ( qmmm_nml%qmtheory%MNDO ) then
- write(6, '(5x," qm_theory = MNDO")',ADVANCE='NO')
- else if ( qmmm_nml%qmtheory%MNDOD ) then
- write(6, '(5x," qm_theory = MNDO/d")',ADVANCE='NO')
- else if ( qmmm_nml%qmtheory%PDDGPM3 ) then
- write(6, '(5x," qm_theory = PDDGPM3")',ADVANCE='NO')
- else if ( qmmm_nml%qmtheory%PDDGMNDO ) then
- write(6, '(5x," qm_theory =PDDGMNDO")',ADVANCE='NO')
- else if ( qmmm_nml%qmtheory%PM3CARB1 ) then
- write(6, '(5x," qm_theory =PM3CARB1")',ADVANCE='NO')
- else if ( qmmm_nml%qmtheory%DFTB ) then
- write(6, '(5x," qm_theory = DFTB")',ADVANCE='NO')
- else if ( qmmm_nml%qmtheory%RM1 ) then
- write(6, '(5x," qm_theory = RM1")',ADVANCE='NO')
- else if ( qmmm_nml%qmtheory%PDDGPM3_08 ) then
- write(6, '(5x," qm_theory = PDDGPM3_08")',ADVANCE='NO')
- else if ( qmmm_nml%qmtheory%PM6 ) then
- write(6, '(5x," qm_theory = PM6")',ADVANCE='NO')
- else if ( qmmm_nml%qmtheory%PM3ZNB ) then
- write(6, '(5x," qm_theory = PM3/ZnB")',ADVANCE='NO')
- else if ( qmmm_nml%qmtheory%PM3MAIS ) then
- write(6, '(5x," qm_theory = PM3-MAIS")',ADVANCE='NO')
- else if ( qmmm_nml%qmtheory%EXTERN ) then
- write(6, '(5x," qm_theory = EXTERN")',ADVANCE='NO')
- else
- write(6, '(5x," qm_theory = UNKNOWN!")',ADVANCE='NO')
- end if
- write (6, '(" verbosity = ",i8)') qmmm_nml%verbosity
- if (qmmm_nml%qmqm_analyt) then
- write(6, '(5x," qmqmdx = Analytical")')
- else
- write(6, '(5x," qmqmdx = Numerical")')
- end if
- !AWG: if EXTERN in use, skip printing of options that do not apply
- EXTERN: if ( .not. qmmm_nml%qmtheory%EXTERN ) then
- if (qmmm_nml%tight_p_conv) then
- write(6, '(5x," tight_p_conv = True (converge density to SCFCRT)")')
- else
- write(6, '(5x," tight_p_conv = False (converge density to 0.05xSqrt[SCFCRT])")')
- end if
- write(6, '(5x," scfconv = ",e9.3," itrmax = ",i8)') qmmm_nml%scfconv, qmmm_nml%itrmax
- if (qmmm_nml%printcharges) then
- write(6, '(5x," printcharges = True ")',ADVANCE='NO')
- else
- write(6, '(5x," printcharges = False")',ADVANCE='NO')
- end if
- select case (qmmm_nml%printdipole)
- case (1)
- write(6, '(5x," printdipole = QM ")',ADVANCE='NO')
- case (2)
- write(6, '(5x," printdipole = QM+MM")',ADVANCE='NO')
- case default
- write(6, '(5x," printdipole = False")',ADVANCE='NO')
- end select
- if (qmmm_nml%peptide_corr) then
- write(6, '(5x," peptide_corr = True")')
- else
- write(6, '(5x," peptide_corr = False")')
- end if
- if (qmmm_nml%qmmmrij_incore) then
- write(6, '(4x,"qmmmrij_incore = True ")')
- else
- write(6, '(4x,"qmmmrij_incore = False")')
- end if
- if (qmmm_nml%qmqm_erep_incore) then
- write(6, '(2x,"qmqm_erep_incore = True ")')
- else
- write(6, '(2x,"qmqm_erep_incore = False")')
- end if
- if (qmmm_nml%allow_pseudo_diag) then
- write(6, '(7x,"pseudo_diag = True ")',ADVANCE='NO')
- write(6, '("pseudo_diag_criteria = ",f8.4)') qmmm_nml%pseudo_diag_criteria
- else
- write(6, '(7x,"pseudo_diag = False")')
- end if
- write(6, '(6x,"diag_routine = ",i8)') qmmm_nml%diag_routine
- end if EXTERN
- !If ntb=0 or use_pme =0 then we can't do qm_ewald so overide what the user may
- !have put in the namelist and set the value to false.
- if (qmmm_nml%qm_ewald>0) then
- if (qmmm_nml%qm_pme) then
- write(6, '(10x,"qm_ewald = ",i8, " qm_pme = True ")') qmmm_nml%qm_ewald
- else
- write(6, '(10x,"qm_ewald = ",i8, " qm_pme = False ")') qmmm_nml%qm_ewald
- end if
- write(6, '(10x," kmaxqx = ",i4," kmaxqy = ",i4," kmaxqz = ",i4," ksqmaxq = ",i4)') &
- qmmm_nml%kmaxqx, qmmm_nml%kmaxqy, qmmm_nml%kmaxqz, qmmm_nml%ksqmaxq
- else
- write(6, '(10x,"qm_ewald = ",i8, " qm_pme = False ")') qmmm_nml%qm_ewald
- end if
- !Print the fock matrix prediction params if it is in use.
- if (qmmm_nml%fock_predict>0) then
- write(6, '(6x,"fock_predict = ",i4)') qmmm_nml%fock_predict
- write(6, '(6x," fockp_d1 = ",f8.4," fockp_d2 = ",f8.4)') qmmm_nml%fockp_d1, qmmm_nml%fockp_d2
- write(6, '(6x," fockp_d2 = ",f8.4," fockp_d4 = ",f8.4)') qmmm_nml%fockp_d3, qmmm_nml%fockp_d4
- end if
-
- if (qmmm_nml%qmmm_switch) then
- write(6, '(7x,"qmmm_switch = True",3x,"r_switch_lo =",f8.4,3x,"r_switch_hi =",f8.4)') &
- & qmmm_nml%r_switch_lo, qmmm_nml%r_switch_hi
- !else
- ! write(6, '(7x,"qmmm_switch = False")')
- end if
-
- if (qmmm_nml%printdipole==2) then
- write(6, '("|",2x,"INFO: To compute MM dipole WAT residues will be stripped")')
- end if
- end if
-
- if (qmmm_nml%vsolv > 0) then
- call print(qmmm_vsolv)
- end if
-
-!---- SEBOMD options ----
-
- if (sebomd_obj%do_sebomd) then
- call sebomd_write_info()
- call sebomd_write_options()
- endif
-
-#ifdef _XRAY
-!---- XRAY Options ----
- call xray_write_options()
-#endif
-
-! ----EMAP Options-----
- if(temap)call emap_options(5)
-! ---------------------
-
-#ifdef EMIL
-! ----EMIL Options-----
- if(emil_do_calc.gt.0)call init_emil_dat(5, 6)
-! ---------------------
-#endif
-
-
-#ifdef MPI
-! --- MPI TIMING OPTIONS ---
- write(6, '(/a)') '| MPI Timing options:'
- write(6, '("|",5x," profile_mpi = ",i8)') profile_mpi
-! Sanity check for profile_mpi
- call int_legal_range('profile_mpi',profile_mpi,0,1)
-! --------------------------
-#endif
-
- cut = cut*cut
- cut_inner = cut_inner*cut_inner
-
- !------------------------------------------------------------------------
- ! If user has requested generalized born electrostatics, set up variables
- !------------------------------------------------------------------------
-
- if( igb == 0 .and. gbsa > 0 ) then
- write(0,*) 'GB/SA calculation is performed only when igb>0'
- call mexit( 6,1 )
- end if
- if( gbsa == 2 .and. &
- ((imin == 0 .and. nstlim > 1) .or. &
- (imin == 1 .and. maxcyc > 1)) ) then
- write(0,*) 'GBSA=2 only works for single point energy calc'
- call mexit( 6,1 )
- end if
-#ifdef APBS
- if( igb /= 0 .and. igb /= 10 .and. ipb == 0 .and. .not. mdin_apbs) then
-#else
- if (( igb /= 0 .and. igb /= 10 .and. ipb == 0 ).or.hybridgb>0.or.icnstph>1) then
-#endif /* APBS */
-#ifdef LES
- write(6,*) 'igb=1,5,7 are working with LES, no SA term included'
-#endif
- ! igb7 uses special S_x screening params.
- ! overwrite the tinker values read from the prmtop
- if (igb == 7) then
- do i=1,natom
- if(ix(i100) .eq. 1) then
- atomicnumber = ix(i100+i)
- else
- call get_atomic_number(ih(m04+i-1), x(lmass+i-1), &
- atomicnumber, errFlag)
-#ifdef LES
- if(errFlag) then
- call get_atomic_number(ih(m04+i-1), &
- x(lmass+i-1)*lesfac((lestyp(i)-1)*nlesty+lestyp(i)), &
- atomicnumber, errFlag)
- end if
-#endif
- end if
-
- if (atomicnumber .eq. 6) then
- x(l96+i-1) = 4.84353823306d-1
- else if (atomicnumber .eq. 1) then
- x(l96+i-1) = 1.09085413633d0
- else if (atomicnumber .eq. 7) then
- x(l96+i-1) = 7.00147318409d-1
- else if (atomicnumber .eq. 8) then
- x(l96+i-1) = 1.06557401132d0
- else if (atomicnumber .eq. 16) then
- x(l96+i-1) = 6.02256336067d-1
- else if (atomicnumber .eq. 15) then
- x(l96+i-1) = 5d-1
- else
- x(l96+i-1) = 5d-1
- end if
- end do
- end if
-
- ! Hai Nguyen: changing S_x screening params for igb = 8
- ! overwrite the tinker values read from the prmtop
-
- if (igb == 8) then
- do i=1,natom
- if (ix(i100) .eq. 1) then
- atomicnumber = ix(i100+i)
- else
- call get_atomic_number(ih(m04+i-1), x(lmass+i-1), &
- atomicnumber, errFlag)
-#ifdef LES
- if(errFlag) then
- call get_atomic_number(ih(m04+i-1), &
- x(lmass+i-1)*lesfac((lestyp(i)-1)*nlesty+lestyp(i)), &
- atomicnumber, errFlag)
- end if
-#endif
- end if
-
- if (atomicnumber .eq. 6) then
- x(l96+i-1) = Sc
- else if (atomicnumber .eq. 1) then
- x(l96+i-1) = Sh
- else if (atomicnumber .eq. 7) then
- x(l96+i-1) = Sn
- else if (atomicnumber .eq. 8) then
- x(l96+i-1) = So
- else if (atomicnumber .eq. 16) then
- x(l96+i-1) = Ss
- else if (atomicnumber .eq. 15) then
- x(l96+i-1) = Sp ! Hai Nguyen: We still don't have an optimized Sp parameter
- else
- !for atom type Cl,Br,...
- !These parameters are also not optimized.
- x(l96+i-1) = 5d-1
- end if
- end do
- end if
-
-
- ! Hai Nguyen: set up for igb == 2, 5, 7, 8
- ! Put gb parameters in arrays
- if ( igb == 2 .or. igb == 5 .or. igb == 7 .or. &
- hybridgb == 2 .or. hybridgb == 5) then
- do i=1,natom
- x(l2402+i-1) = gbalpha
- x(l2403+i-1) = gbbeta
- x(l2404+i-1) = gbgamma
- end do
- end if
-
- !Hai Nguyen: IGB = 8
- if ( igb == 8 ) then
- do i=1,natom
- if (ix(i100) .eq. 1) then
- atomicnumber = ix(i100+i)
- else
- call get_atomic_number(ih(m04+i-1), x(lmass+i-1), &
- atomicnumber, errFlag)
-#ifdef LES
- if(errFlag) then
- call get_atomic_number(ih(m04+i-1), &
- x(lmass+i-1)*lesfac((lestyp(i)-1)*nlesty+lestyp(i)), &
- atomicnumber, errFlag)
- end if
-#endif
- end if
-
- if (atomicnumber .eq. 1) then
- x(l2402+i-1) = gbalphaH
- x(l2403+i-1) = gbbetaH
- x(l2404+i-1) = gbgammaH
- else if (atomicnumber .eq. 6) then
- x(l2402+i-1) = gbalphaC
- x(l2403+i-1) = gbbetaC
- x(l2404+i-1) = gbgammaC
- else if (atomicnumber .eq. 7) then
- x(l2402+i-1) = gbalphaN
- x(l2403+i-1) = gbbetaN
- x(l2404+i-1) = gbgammaN
- else if (atomicnumber .eq. 8) then
- x(l2402+i-1) = gbalphaOS
- x(l2403+i-1) = gbbetaOS
- x(l2404+i-1) = gbgammaOS
- else if (atomicnumber .eq. 16) then
- x(l2402+i-1) = gbalphaOS
- x(l2403+i-1) = gbbetaOS
- x(l2404+i-1) = gbgammaOS
- else if (atomicnumber .eq. 15) then
- x(l2402+i-1) = gbalphaP
- x(l2403+i-1) = gbbetaP
- x(l2404+i-1) = gbgammaP
- else
- !use GBOBC set for other atom types
- x(l2402+i-1) = 1.0d0
- x(l2403+i-1) = 0.8d0
- x(l2404+i-1) = 4.85d0
- end if
- end do
- end if ! end Hai Nguyen section
-
- ! put fs(i)*(rborn(i) - offset) into the "fs" array
-
- fsmax = 0.d0
- do i=1,natom
- x(l96-1+i) = x(l96-1+i)*( x(l97-1+i) - offset )
- fsmax = max( fsmax, x(l96-1+i) )
- if (rbornstat == 1) then
- x(l186-1+i) = 0.d0
- x(l187-1+i) = 999.d0
- x(l188-1+i) = 0.d0
- x(l189-1+i) = 0.d0
- end if
- end do
-
- ! ---------------------------------------------------------------------
- ! ---get Debye-Huckel kappa (A**-1) from salt concentration (M), assuming:
- ! T = 298.15, epsext=78.5,
-
- kappa = sqrt( 0.10806d0 * saltcon )
-
- ! ---scale kappa by 0.73 to account(?) for lack of ion exclusions:
-
- kappa = 0.73d0* kappa
-
- !Set kappa for qmmm if needed
- qm_gb%kappa = kappa
- ! ---------------------------------------------------------------------
-
- if ( gbsa == 1 ) then
-
- ! --- assign parameters for calculating SASA according to the
- ! LCPO method ---
-
- do i=1,natom
- ix(i80+i-1)=0
- end do
-
- ! --- get the number of bonded neighbors for each atom:
-
- do i=1,nbona
- atom1=ix(iiba+i-1)/3+1
- atom2=ix(ijba+i-1)/3+1
- ix(i80+atom1-1)=ix(i80+atom1-1)+1
- ix(i80+atom2-1)=ix(i80+atom2-1)+1
- end do
-
- do i=1,natom
- ix(i80-i)=ix(i80+i-1)
- end do
-
- do i=1,nbonh
- atom1=ix(iibh+i-1)/3+1
- atom2=ix(ijbh+i-1)/3+1
- ix(i80-atom1)=ix(i80-atom1)+1
- ix(i80-atom2)=ix(i80-atom2)+1
- end do
-
-
- ! --- construct parameters for SA calculation; note that the
- ! radii stored in L165 are augmented by 1.4 Ang.
-
- do i=1,natom
- write(atype,'(a2)') ih(m06+i-1)
- call upper(atype)
- if (ix(i100) .eq. 1) then
- atomicnumber = ix(i100+i)
- else
- call get_atomic_number(ih(m04+i-1), x(lmass+i-1), &
- atomicnumber, errFlag)
-#ifdef LES
- if(errFlag) then
- call get_atomic_number(ih(m04+i-1), &
- x(lmass+i-1)*lesfac((lestyp(i)-1)*nlesty+lestyp(i)), &
- atomicnumber, errFlag)
- end if
-#endif
- end if
- hybridization = ix(i80-i)
- nbond=ix(i80+i-1)
- if (atomicnumber .eq. 6) then
- if (hybridization .eq. 4) then
- if (nbond == 1) then
- x(l165-1+i) = 1.70d0 + 1.4d0
- x(l170-1+i) = 0.77887d0
- x(l175-1+i) = -0.28063d0
- x(l180-1+i) = -0.0012968d0
- x(l185-1+i) = 0.00039328d0
- else if (nbond == 2) then
- x(l165-1+i) = 1.70d0 + 1.4d0
- x(l170-1+i) = 0.56482d0
- x(l175-1+i) = -0.19608d0
- x(l180-1+i) = -0.0010219d0
- x(l185-1+i) = 0.0002658d0
- else if (nbond == 3) then
- x(l165-1+i) = 1.70d0 + 1.4d0
- x(l170-1+i) = 0.23348d0
- x(l175-1+i) = -0.072627d0
- x(l180-1+i) = -0.00020079d0
- x(l185-1+i) = 0.00007967d0
- else if (nbond == 4) then
- x(l165-1+i) = 1.70d0 + 1.4d0
- x(l170-1+i) = 0.00000d0
- x(l175-1+i) = 0.00000d0
- x(l180-1+i) = 0.00000d0
- x(l185-1+i) = 0.00000d0
- else
- write(6,*) 'Unusual nbond for CT:', i, nbond, &
- ' Using default carbon LCPO parameters'
- x(l165-1+i) = 1.70d0 + 1.4d0
- x(l170-1+i) = 0.77887d0
- x(l175-1+i) = -0.28063d0
- x(l180-1+i) = -0.0012968d0
- x(l185-1+i) = 0.00039328d0
- end if
- else
- if (nbond == 2) then
- x(l165-1+i) = 1.70d0 + 1.4d0
- x(l170-1+i) = 0.51245d0
- x(l175-1+i) = -0.15966d0
- x(l180-1+i) = -0.00019781d0
- x(l185-1+i) = 0.00016392d0
- else if (nbond == 3) then
- x(l165-1+i) = 1.70d0 + 1.4d0
- x(l170-1+i) = 0.070344d0
- x(l175-1+i) = -0.019015d0
- x(l180-1+i) = -0.000022009d0
- x(l185-1+i) = 0.000016875d0
- else
- write(6,*) 'Unusual nbond for C :', i, nbond, &
- ' Using default carbon LCPO parameters'
- x(l165-1+i) = 1.70d0 + 1.4d0
- x(l170-1+i) = 0.77887d0
- x(l175-1+i) = -0.28063d0
- x(l180-1+i) = -0.0012968d0
- x(l185-1+i) = 0.00039328d0
- end if
- end if
- else if (atomicnumber .eq. 8) then
- if (atype == 'O ') then
- x(l165-1+i) = 1.60d0 + 1.4d0
- x(l170-1+i) = 0.68563d0
- x(l175-1+i) = -0.1868d0
- x(l180-1+i) = -0.00135573d0
- x(l185-1+i) = 0.00023743d0
- else if (atype == 'O2') then
- x(l165-1+i) = 1.60d0 + 1.4d0
- x(l170-1+i) = 0.88857d0
- x(l175-1+i) = -0.33421d0
- x(l180-1+i) = -0.0018683d0
- x(l185-1+i) = 0.00049372d0
- else
- if (nbond == 1) then
- x(l165-1+i) = 1.60d0 + 1.4d0
- x(l170-1+i) = 0.77914d0
- x(l175-1+i) = -0.25262d0
- x(l180-1+i) = -0.0016056d0
- x(l185-1+i) = 0.00035071d0
- else if (nbond == 2) then
- x(l165-1+i) = 1.60d0 + 1.4d0
- x(l170-1+i) = 0.49392d0
- x(l175-1+i) = -0.16038d0
- x(l180-1+i) = -0.00015512d0
- x(l185-1+i) = 0.00016453d0
- else
- write(6,*) 'Unusual nbond for O:', i, nbond, &
- ' Using default oxygen LCPO parameters'
- x(l165-1+i) = 1.60d0 + 1.4d0
- x(l170-1+i) = 0.77914d0
- x(l175-1+i) = -0.25262d0
- x(l180-1+i) = -0.0016056d0
- x(l185-1+i) = 0.00035071d0
- end if
- end if
- else if(atomicnumber .eq. 7) then
- if (atype == 'N3') then
- if (nbond == 1) then
- x(l165-1+i) = 1.65d0 + 1.4d0
- x(l170-1+i) = 0.078602d0
- x(l175-1+i) = -0.29198d0
- x(l180-1+i) = -0.0006537d0
- x(l185-1+i) = 0.00036247d0
- else if (nbond == 2) then
- x(l165-1+i) = 1.65d0 + 1.4d0
- x(l170-1+i) = 0.22599d0
- x(l175-1+i) = -0.036648d0
- x(l180-1+i) = -0.0012297d0
- x(l185-1+i) = 0.000080038d0
- else if (nbond == 3) then
- x(l165-1+i) = 1.65d0 + 1.4d0
- x(l170-1+i) = 0.051481d0
- x(l175-1+i) = -0.012603d0
- x(l180-1+i) = -0.00032006d0
- x(l185-1+i) = 0.000024774d0
- else
- write(6,*) 'Unusual nbond for N3:', i, nbond, &
- ' Using default nitrogen LCPO parameters'
- x(l165-1+i) = 1.65d0 + 1.4d0
- x(l170-1+i) = 0.078602d0
- x(l175-1+i) = -0.29198d0
- x(l180-1+i) = -0.0006537d0
- x(l185-1+i) = 0.00036247d0
- end if
- else
- if (nbond == 1) then
- x(l165-1+i) = 1.65d0 + 1.4d0
- x(l170-1+i) = 0.73511d0
- x(l175-1+i) = -0.22116d0
- x(l180-1+i) = -0.00089148d0
- x(l185-1+i) = 0.0002523d0
- else if (nbond == 2) then
- x(l165-1+i) = 1.65d0 + 1.4d0
- x(l170-1+i) = 0.41102d0
- x(l175-1+i) = -0.12254d0
- x(l180-1+i) = -0.000075448d0
- x(l185-1+i) = 0.00011804d0
- else if (nbond == 3) then
- x(l165-1+i) = 1.65d0 + 1.4d0
- x(l170-1+i) = 0.062577d0
- x(l175-1+i) = -0.017874d0
- x(l180-1+i) = -0.00008312d0
- x(l185-1+i) = 0.000019849d0
- else
- write(6,*) 'Unusual nbond for N:', i, nbond, &
- ' Using default nitrogen LCPO parameters'
- x(l165-1+i) = 1.65d0 + 1.4d0
- x(l170-1+i) = 0.078602d0
- x(l175-1+i) = -0.29198d0
- x(l180-1+i) = -0.0006537d0
- x(l185-1+i) = 0.00036247d0
- end if
- end if
- else if(atomicnumber .eq. 16) then
- if (atype == 'SH') then
- x(l165-1+i) = 1.90d0 + 1.4d0
- x(l170-1+i) = 0.7722d0
- x(l175-1+i) = -0.26393d0
- x(l180-1+i) = 0.0010629d0
- x(l185-1+i) = 0.0002179d0
- else
- x(l165-1+i) = 1.90d0 + 1.4d0
- x(l170-1+i) = 0.54581d0
- x(l175-1+i) = -0.19477d0
- x(l180-1+i) = -0.0012873d0
- x(l185-1+i) = 0.00029247d0
- end if
- else if (atomicnumber .eq. 15) then
- if (nbond == 3) then
- x(l165-1+i) = 1.90d0 + 1.4d0
- x(l170-1+i) = 0.3865d0
- x(l175-1+i) = -0.18249d0
- x(l180-1+i) = -0.0036598d0
- x(l185-1+i) = 0.0004264d0
- else if (nbond == 4) then
- x(l165-1+i) = 1.90d0 + 1.4d0
- x(l170-1+i) = 0.03873d0
- x(l175-1+i) = -0.0089339d0
- x(l180-1+i) = 0.0000083582d0
- x(l185-1+i) = 0.0000030381d0
- else
- write(6,*) 'Unusual nbond for P:', i, nbond, &
- ' Using default phosphorus LCPO parameters'
- x(l165-1+i) = 1.90d0 + 1.4d0
- x(l170-1+i) = 0.3865d0
- x(l175-1+i) = -0.18249d0
- x(l180-1+i) = -0.0036598d0
- x(l185-1+i) = 0.0004264d0
- end if
- else if (atype(1:1) == 'Z') then
- x(l165-1+i) = 0.00000d0 + 1.4d0
- x(l170-1+i) = 0.00000d0
- x(l175-1+i) = 0.00000d0
- x(l180-1+i) = 0.00000d0
- x(l185-1+i) = 0.00000d0
- else if (atomicnumber .eq. 1) then
- x(l165-1+i) = 0.00000d0 + 1.4d0
- x(l170-1+i) = 0.00000d0
- x(l175-1+i) = 0.00000d0
- x(l180-1+i) = 0.00000d0
- x(l185-1+i) = 0.00000d0
- else if (atype == 'MG') then
- ! Mg radius = 0.99A: ref. 21 in J. Chem. Phys. 1997, 107, 5422
- ! Mg radius = 1.18A: ref. 30 in J. Chem. Phys. 1997, 107, 5422
- ! Mg radius = 1.45A: Aqvist 1992
- x(l165-1+i) = 1.18d0 + 1.4d0
- ! The following values were taken from O.sp3 with two bonded
- ! neighbors -> O has the smallest van der Waals radius
- ! compared to all other elements which had been parametrized
- x(l170-1+i) = 0.49392d0
- x(l175-1+i) = -0.16038d0
- x(l180-1+i) = -0.00015512d0
- x(l185-1+i) = 0.00016453d0
- else if (atype == 'F') then
- x(l165-1+i) = 1.47d0 + 1.4d0
- x(l170-1+i) = 0.68563d0
- x(l175-1+i) = -0.1868d0
- x(l180-1+i) = -0.00135573d0
- x(l185-1+i) = 0.00023743d0
- else
- ! write( 0,* ) 'bad atom type: ',atype
- ! call mexit( 6,1 )
- x(l165-1+i) = 1.70 + 1.4;
- x(l170-1+i) = 0.51245;
- x(l175-1+i) = -0.15966;
- x(l180-1+i) = -0.00019781;
- x(l185-1+i) = 0.00016392;
- write(6,'(a,a)') 'Using carbon SA parms for atom type', atype
- end if
- end do ! i=1,natom
- !
- else if ( gbsa == 2 ) then
-
- ! --- assign parameters for calculating SASA according to the
- ! ICOSA method; the radii are augmented by 1.4 A ---
-
- do i=1,natom
- write(atype,'(a2)') ih(m06+i-1)
- if(ix(i100) .eq. 1) then
- atomicnumber = ix(i100+i)
- else
- call get_atomic_number(ih(m04+i-1), x(lmass+i-1), &
- atomicnumber, errFlag)
-#ifdef LES
- if(errFlag) then
- call get_atomic_number(ih(m04+i-1), &
- x(lmass+i-1)*lesfac((lestyp(i)-1)*nlesty+lestyp(i)), &
- atomicnumber, errFlag)
- end if
-#endif
- end if
- if (atomicnumber .eq. 7) then
- x(L165-1+i) = 1.55d0 + 1.4d0
- else if (atomicnumber .eq. 6) then
- x(L165-1+i) = 1.70d0 + 1.4d0
- else if (atomicnumber .eq. 1) then
- x(L165-1+i) = 1.20d0 + 1.4d0
- else if (atomicnumber .eq. 8) then
- x(L165-1+i) = 1.50d0 + 1.4d0
- else if (atomicnumber .eq. 15) then
- x(L165-1+i) = 1.80d0 + 1.4d0
- else if (atomicnumber .eq. 16) then
- x(L165-1+i) = 1.80d0 + 1.4d0
- else if (atomicnumber .eq. 17) then
- ! Cl radius
- x(L165-1+i) = 1.70d0 + 1.4d0
- else if (atomicnumber .eq. 9) then
- ! F radius
- x(L165-1+i) = 1.50d0 + 1.4d0
- else if (atomicnumber .eq. 35) then
- ! Br radius
- ! Bondi, J. Phys. Chem. 1964, 68, 441.
- x(L165-1+i) = 1.85d0 + 1.4d0
- else if (atomicnumber .eq. 20) then
- ! Ca radius
- ! Calculated from Aqvist, J. Phys. Chem. 1990, 94, 8021.
- x(L165-1+i) = 1.33d0 + 1.4d0
- else if (atomicnumber .eq. 11) then
- ! Na radius
- ! Calculated from Aqvist, J. Phys. Chem. 1990, 94, 8021.
- x(L165-1+i) = 1.87d0 + 1.4d0
- else if (atomicnumber .eq. 30) then
- ! Zn radius
- ! Hoops, Anderson, Merz, JACS 1991, 113, 8262.
- x(L165-1+i) = 1.10d0 + 1.4d0
- else if (atomicnumber .eq. 12) then
- ! Mg radius = 0.99A: ref. 21 in J. Chem. Phys. 1997, 107, 5422
- ! Mg radius = 1.18A: ref. 30 in J. Chem. Phys. 1997, 107, 5422
- ! Mg radius = 1.45A: Aqvist 1992
- x(L165-1+i) = 1.18d0 + 1.4d0
- else
- write( 0,* ) 'bad atom type: ',atype
- call mexit( 6,1 )
- end if
-
- ! dummy LCPO values:
- x(L170-1+i) = 0.0d0
- x(L175-1+i) = 0.0d0
- x(L180-1+i) = 0.0d0
- x(L185-1+i) = 0.0d0
- ! write(6,*) i,' ',atype,x(L165-1+i)
- end do ! i=1,natom
-
- end if ! ( gbsa == 1 )
-
- end if ! ( igb /= 0 .and. igb /= 10 .and. ipb == 0 )
-
- !-----------------------------------
- ! If a LRT calculation is requested,
- ! setup the icosa-SASA parameters
- ! this code is copied from above
- !-----------------------------------
-
- if ( ilrt /= 0 ) then
- ! --- assign parameters for calculating SASA according to the
- ! ICOSA method; the radii are augmented by 1.4 A ---
- do i=1,natom
- write(atype,'(a2)') ih(m06+i-1)
- if(ix(i100) .eq. 1) then
- atomicnumber = ix(i100+i)
- else
- call get_atomic_number(ih(m04+i-1), x(lmass+i-1), &
- atomicnumber, errFlag)
-#ifdef LES
- if(errFlag) then
- call get_atomic_number(ih(m04+i-1), &
- x(lmass+i-1)*lesfac((lestyp(i)-1)*nlesty+lestyp(i)), &
- atomicnumber, errFlag)
- end if
-#endif
- end if
- if (atomicnumber .eq. 7) then
- x(L165-1+i) = 1.55d0 + 1.4d0
- else if (atomicnumber .eq. 6) then
- x(L165-1+i) = 1.70d0 + 1.4d0
- else if (atomicnumber .eq. 1 .or. &
- ! added for lone pairs
- atype == 'EP') then
- x(L165-1+i) = 1.20d0 + 1.4d0
- else if (atomicnumber .eq. 8) then
- x(L165-1+i) = 1.50d0 + 1.4d0
- else if (atomicnumber .eq. 15) then
- x(L165-1+i) = 1.80d0 + 1.4d0
- else if (atomicnumber .eq. 16) then
- x(L165-1+i) = 1.80d0 + 1.4d0
- else if (atomicnumber .eq. 12) then
- ! Mg radius = 0.99A: ref. 21 in J. Chem. Phys. 1997, 107, 5422
- ! Mg radius = 1.18A: ref. 30 in J. Chem. Phys. 1997, 107, 5422
- ! Mg radius = 1.45A: Aqvist 1992
- x(L165-1+i) = 1.18d0 + 1.4d0
- else
- write( 0,* ) 'bad atom type: ',atype,' cannot perform SASA calculation'
- call mexit( 6,1 )
- end if ! atype(1:1) == 'N'
- x(L170-1+i) = 0.0d0
- x(L175-1+i) = 0.0d0
- x(L180-1+i) = 0.0d0
- x(L185-1+i) = 0.0d0
- !write(6,*) i,' ',atype,x(L165-1+i)
- end do ! i=1,natom
-
- end if ! ( ilrt /= 0 )
-
- !------------------------------------------------------------------------
- ! If user has requested Poisson-Boltzmann electrostatics, set up variables
- !------------------------------------------------------------------------
-
- if ( igb == 10 .or. ipb /= 0 ) then
- call pb_init(ifcap,natom,nres,ntypes,nbonh,nbona,ix(i02),ix(i04),ix(i06),ix(i08),ix(i10),&
- ix(iibh),ix(ijbh),ix(iiba),ix(ijba),ix(ibellygp),ih(m02),ih(m04),ih(m06),x(l15),x(l97))
- end if ! ( igb == 10 .or. ipb /= 0 )
-
- if (icnstph /= 0) then
- ! Initialize all constant pH data to 0 and read it in
- call cnstph_zero()
- call cnstphread(x(l15))
-
- ! Fill proposed charges array from current charges
- do i=1,natom
- x(l190-1+i) = x(l15-1+i)
- end do
-
- ! If we're doing explicit CpH, fill gbv* arrays
- if ( icnstph .gt. 1 .and. cph_igb == 2 .or. cph_igb == 5) then
- do i=1,natom
- x(l2402+i-1) = gbalpha
- x(l2403+i-1) = gbbeta
- x(l2404+i-1) = gbgamma
- end do
- end if
- end if
-
-! +---------------------------------------------------------------+
-! | Read EVB input file |
-! +---------------------------------------------------------------+
-
- if( ievb /= 0 ) then
-#ifdef MPI
- call evb_input
- call evb_init
-# if defined(LES)
-!KFW call evb_pimd_init
-# endif
-#else
- write(6,'(/2x,a)') 'Setting ievb>0 requires compilation with MPI'
- call mexit(6,1)
-#endif
- endif
-
- if( iyammp /= 0 ) write( 6, '(a)' ) ' Using yammp non-bonded potential'
-
- ! -------------------------------------------------------------------
- !
- ! -- add check to see if the space in nmr.h is likely to be
- ! too small for this run:
- ! [Note: this check does *not* indicate if MXTAU and MXP are
- ! too small. There is no easy way to ensure this, since
- ! the experimental intensities are read in a namelist
- ! command: if too many intensities are input, the read
- ! statment may cause a coredump before returning control
- ! to the main program. Be careful. sigh....]
-
- if (natom > matom .and. nmropt > 1) then
- write(6,*) 'WARNING: MATOM in nmr.h is smaller than the ', &
- natom,' atoms in this molecule.'
- write(6,*) 'Printout of NMR violations may be compromised.'
- end if
-
- ! -------------------------------------------------------------------
- ! --- checks on bogus data ---
- ! -------------------------------------------------------------------
-
- inerr = 0
-
- if( icfe < 0 .or. icfe > 1 ) then
- write(6,*) 'icfe must be 0 or 1 (icfe=2 is no longer supported)'
- inerr = 1
- end if
- if( icfe /= 0 .and. numgroup /= 2 ) then
- write(6,*) 'numgroup must be 2 if icfe is set'
- inerr = 1
- end if
- if (ievb>0) then
-#ifdef MPI
-!KFW if( numgroup /= 2 ) then
-!KFW write(6,*) 'numgroup must be 2 if ievb is set'
-!KFW inerr = 1
-!KFW end if
-#else
- write(6,'(/2x,a)') 'Setting ievb>0 requires compilation with MPI'
- inerr = 1
-#endif
- end if
-#ifdef PUPIL_SUPPORT
- ! BPR: PUPIL does not work with GB (or, I suppose, PB) for the
- ! time being. It is known to either crash or produce bogus
- ! results.
- if (igb > 0 .or. ipb /= 0) then
- write(6,'(a)') 'Cannot use implicit solvation (GB or PB) with PUPIL'
- inerr = 1
- end if
-#endif /*PUPIL_SUPPORT*/
- if( (igb > 0 .or. ipb /= 0) .and. numextra > 0) then
- write(6,'(a)') 'Cannot use igb>0 with extra-point force fields'
- inerr = 1
- end if
-
-!AMD validation
- if(iamd.gt.0)then
- if (EthreshD .eq. 0.d0 .and. alphaD .eq. 0.d0 .and. EthreshP .eq. 0.d0 .and. alphaP .eq. 0.d0) then
- write(6,'(a,i3)')'| AMD error all main parameters are 0.0 for Accelerated MD (AMD) or Windowed Accelerated MD (wAMD) '
- inerr = 1
- endif
- if(w_amd.gt.0)then
- if (EthreshD_w .eq. 0.d0 .and. alphaD_w .eq. 0.d0 .and. EthreshP_w .eq. 0.d0 .and. alphaP_w .eq. 0.d0) then
- write(6,'(a,i3)')'| AMD error all extra parameters are 0.0 for Windowed Accelerated MD (wAMD) LOWERING BARRIERS'
- inerr = 1
- endif
- endif
- endif
- if (iamd .gt. 0 .and. iamoeba ==1) then
- write(6,*)'amoeba is incompatible with AMD for now'
- inerr=1
- end if
-
- if (ips < 0 .or. ips > 6) then
- write(6,'(/2x,a,i3,a)') 'IPS (',ips,') must be between 0 and 6'
- inerr = 1
- end if
- if (ips /= 0 .and. ipol > 0 ) then
- write(6,'(/2x,a)') 'IPS and IPOL are inconsistent options'
- inerr = 1
- endif
- if (ips /= 0 .and. lj1264 /= 0) then
- write(6, '(/2x,a)') 'IPS and the LJ 12-6-4 potential are incompatible'
- inerr = 1
- endif
- if ( (igb > 0 .or. ipb /= 0) .and. ips > 0 ) then
- write(6,'(/2x,a,i3,a,i3,a)') 'IGB (',igb,') and ips (',ips, &
- ') cannot both be turned on'
- inerr = 1
- end if
- if (igb /= 0 .and. igb /= 1 .and. igb /= 2 .and. igb /= 5 &
- .and. igb /= 6 .and. igb /= 7 .and. igb /= 8 .and. igb /= 10) then
- write(6,'(/2x,a,i3,a)') 'IGB (',igb,') must be 0,1,2,5,6,7,8 or 10.'
- inerr = 1
- end if
- if (alpb /= 0 .and. alpb /= 1 ) then
- write(6,'(/2x,a,i3,a)') 'ALPB (',alpb,') must be 0 or 1.'
- inerr = 1
- end if
- if (alpb /= 0 .and. igb /= 1 .and. igb /= 2 .and. igb /= 5 .and. igb /=7 ) then
- write(6,'(/2x,a,i3,a)') 'IGB (',igb,') must be 1,2,5, or 7 if ALPB > 0.'
- inerr = 1
- end if
-
- if (jar < 0 .or. jar > 1) then
- write(6,'(/2x,a,i3,a)') 'JAR (',jar,') must be 0 or 1'
- inerr = 1
- end if
-
-#ifdef LES
- if( igb /= 0 .and. igb /= 1 .and. igb /= 5 .and. igb /=7 ) then
- write(6,'(/,a)') 'Error: LES is only compatible with IGB > 0,1,5,7'
- inerr = 1
- end if
- if( alpb /= 0) then
- write(6,'(/,a)') 'Error: LES is not compatible with ALPB'
- inerr = 1
- end if
- if( gbsa > 0 ) then
- write(6,'(/,a)') 'Error: LES is not compatible with GBSA > 0'
- inerr = 1
- end if
- if( qmmm_nml%ifqnt ) then
- write(6,'(/,a)') 'Error: LES is not compatible with QM/MM'
- inerr = 1
- end if
- if( ipol > 0 ) then
- write(6,'(/,a)') 'Error: LES is not compatible with IPOL > 0'
- inerr = 1
- end if
- if (temp0les >= 0.d0 .and. iscale > 0 ) then
- write (6,'(/,a)') 'Error: iscale cannot be used with temp0les'
- inerr = 1
- end if
-#endif
- if (irest /= 0 .and. irest /= 1) then
- write(6,'(/2x,a,i3,a)') 'IREST (',irest,') must be 0 or 1.'
- inerr = 1
- end if
- if (ibelly /= 0 .and. ibelly /= 1) then
- write(6,'(/2x,a,i3,a)') 'IBELLY (',ibelly,') must be 0 or 1.'
- inerr = 1
- end if
- if (imin < 0) then
- write(6,'(/2x,a,i3,a)') 'IMIN (',imin,') must be >= 0.'
- inerr = 1
- end if
- if (imin == 5) then
- if (ifbox /= 0 .and. ntb == 2) then
- write(6,'(/2x,a)') 'WARNING: IMIN=5 with changing periodic boundaries (NTB=2) can result in'
- write(6,'(/2x,a)') ' odd energies being calculated. Use with caution.'
- endif
-#ifdef MPI
- if (sandersize > 1 .and. ntb == 2) then
- write(6,'(/2x,a)') 'ERROR: IMIN=5 and NTB=2 cannot be run with multiple processors.'
- inerr = 1
- endif
-#endif
- end if
-
-
- if (iscale > mxvar) then
- write(6,9501) iscale,mxvar
- 9501 format('ERROR: ISCALE (',i5,') exceeds MXVAR (',i5, &
- '). See nmr.h')
- inerr = 1
- end if
- if (ntx < 1 .or. ntx > 7) then
- write(6,'(/2x,a,i3,a)') 'NTX (',ntx,') must be in 1..7'
- inerr = 1
- end if
-
- if (ntb /= 0 .and. ntb /= 1 .and. ntb /= 2) then
- write(6,'(/2x,a,i3,a)') 'NTB (',ntb,') must be 0, 1 or 2.'
- inerr = 1
- end if
- if (ntb == 0 .and. iwrap > 0) then
- write(6,'(/2x,a)') 'Error: IWRAP > 0 cannot be used without a periodic box.'
- inerr = 1
- end if
-
- if (ntt < 0 .or. ntt > 8) then ! APJ
- write(6,'(/2x,a,i3,a)') 'NTT (',ntt,') must be between 0 and 8.' ! APJ
- inerr = 1
- end if
- if (ntt == 1 .and. tautp < dt) then
- write(6, '(/2x,a,f6.2,a)') 'TAUTP (',tautp,') < DT (step size)'
- inerr = 1
- end if
- if( ntt < 3 .or. ntt > 8 ) then ! APJ
- if( gamma_ln > 0.d0 ) then
- write(6,'(a)') 'ntt must be 3 to 8 if gamma_ln > 0' ! APJ
- inerr = 1
- end if
- end if
-
- if ( ntt==3 .or. ntt==6 ) nchain = 0 !APJ: Langevin, Adaptive-Langevin must have chain set to zero. ! APJ
-
- if (ntt == 3 .or. ntt == 4) then
- if ( ntb == 2) then
- !Require gamma_ln > 0.0d0 for ntt=3 and ntb=2 - strange things happen
- !if you run NPT with NTT=3 and gamma_ln = 0.
- if ( gamma_ln <= 0.0d0 ) then
- write(6,'(a)') 'gamma_ln must be > 0 for ntt=3 .or. 4 with ntb=2.'
- inerr = 1
- end if
- end if
- end if
-
- if (ntp /= 0 .and. ntp /= 1 .and. ntp /= 2 .and. ntp /= 3) then
- write(6,'(/2x,a,i3,a)') 'NTP (',ntp,') must be 0, 1, 2, or 3.'
- inerr = 1
- end if
- if (ntp == 3 .and. csurften < 1) then
- write(6,'(/2x,a)') 'csurften must be greater than 0 for ntp=3.'
- inerr = 1
- end if
- if (ntp > 0 .and. taup < dt .and. barostat == 1) then
- write(6, '(/2x,a,f6.2,a)') 'TAUP (',taup,') < DT (step size)'
- inerr = 1
- end if
- if (npscal < 0 .or. npscal > 1) then
- write(6,'(/2x,a,i3,a)') 'NPSCAL (',npscal,') must be 0 or 1.'
- inerr = 1
- end if
- if (ntp > 0) then
- if (barostat /= 1 .and. barostat /= 2) then
- write(6, '(/2x,a,i3,a)') 'BAROSTAT (', barostat, ') must be 1 or 2'
- inerr = 1
- end if
- if (barostat == 2) then
- if (mcbarint <= 0) then
- write(6, '(/2x,a,i3,a)') 'MCBARINT (',mcbarint,') must be positive'
- inerr = 1
- end if
- if (mcbarint >= nstlim) then
- write(6, '(a)') 'WARNING: mcbarint is greater than the number of &
- &steps. This is effectively constant volume.'
- end if
- end if
- end if
-
- if (ntc < 1 .or. ntc > 4) then
- write(6,'(/2x,a,i3,a)') 'NTC (',ntc,') must be 1,2,3 or 4.'
- inerr = 1
- end if
- if (jfastw < 0 .or. jfastw > 4) then
- write(6,'(/2x,a,i3,a)') 'JFASTW (',jfastw,') must be 0->4.'
- inerr = 1
- end if
-
- if (ntf < 1 .or. ntf > 8) then
- write(6,'(/2x,a,i3,a)') 'NTF (',ntf,') must be in 1..8.'
- inerr = 1
- end if
-
- if (ioutfm /= 0 .and. ioutfm /= 1) then
- write(6,'(/2x,a,i3,a)') 'IOUTFM (',ioutfm,') must be 0 or 1.'
- inerr = 1
- end if
-
- if (ntpr < 0) then
- write(6,'(/2x,a,i3,a)') 'NTPR (',ntpr,') must be >= 0.'
- inerr = 1
- end if
- if (ntwx < 0) then
- write(6,'(/2x,a,i3,a)') 'NTWX (',ntwx,') must be >= 0.'
- inerr = 1
- end if
- if (ntwv < -1) then
- write(6,'(/2x,a,i3,a)') 'NTWV (',ntwv,') must be >= -1.'
- inerr = 1
- end if
- if (ntwf < -1) then
- write(6, '(/2x,a,i3,a)') 'NTWF (',ntwf,') must be >= -1.'
- inerr = 1
- end if
- if (ntwv == -1 .and. ioutfm /= 1) then
- write (6, '(/2x,a)') 'IOUTFM must be 1 for NTWV == -1.'
- inerr = 1
- end if
- if (ntwf == -1 .and. ioutfm /= 1) then
- write(6, '(/2x,a)') 'IOUTFM must be 1 for NTWF == -1.'
- inerr = 1
- end if
- if (ntwv == -1 .and. ntwx == 0) then
- write (6, '(/2x,a)') 'NTWX must be > 0 for NTWV == -1.'
- inerr = 1
- end if
- if (ntwe < 0) then
- write(6,'(/2x,a,i3,a)') 'NTWE (',ntwe,') must be >= 0.'
- inerr = 1
- end if
- if (ntave < 0) then
- write(6,'(/2x,a,i3,a)') 'NTAVE (',ntave,') must be >= 0.'
- inerr = 1
- end if
- if (ntr /= 0 .and. ntr /= 1) then
- write(6,'(/2x,a,i3,a)') 'NTR (',ntr,') must be 0 or 1.'
- inerr = 1
- end if
- if (ntrx /= 0 .and. ntrx /= 1) then
- write(6,'(/2x,a,i3,a)') 'NTRX (',ntrx,') must be 0 or 1.'
- inerr = 1
- end if
- if (nmropt < 0 .or. nmropt > 2) then
- write(6,'(/2x,a,i3,a)') 'NMROPT (',nmropt,') must be in 0..2.'
- inerr = 1
- end if
-
- if (idecomp < 0 .or. idecomp > 4) then
- write(6,'(/2x,a)') 'IDECOMP must be 0..4'
- inerr = 1
- end if
-
- ! check settings related to ivcap
-
- if(ivcap == 3 .or. ivcap == 4) then
- write(6,'(/2x,a)') 'IVCAP == 3 and IVCAP == 4 currently not implemented'
- inerr = 1
- endif
- if (ivcap < 0 .and. ivcap > 5) then
- write(6,'(/2x,a)') 'IVCAP must be 0 ... 5'
- inerr = 1
- end if
- if ((ivcap == 1 .or. ivcap == 5) .and. igb /= 10 .and. ipb == 0) then
- write(6,'(/2x,a)') 'IVCAP == 1,5 only works with Poisson Boltzmann (igb=10 or ipb/=0)'
- inerr = 1
- end if
- if((ivcap == 1 .or. ivcap == 3 .or. ivcap == 5 ) .and. cutcap <= 0.0d0) then
- write(6,'(/2x,a)') 'For IVCAP == 1,3, or 5, cutcap must be > 0.0'
- inerr = 1
- endif
- if (ivcap == 4 .and. &
- (xlorth < ZERO .or. ylorth < ZERO .or. zlorth < ZERO .or. &
-! give magic numbers a name srb aug 2007 !
- xorth > 47114710.0d0 .or. &
-! give magic numbers a name !
- yorth > 47114710.0d0 .or. &
-! give magic numbers a name !
- zorth > 47114710.0d0)) then
- write(6,'(/2x,a)') &
- 'For IVCAP == 4, xlorth, ylorth, zlorth, xorth, yorth, zorth must be set'
- inerr = 1
- end if
- if ((ivcap == 3 .or. ivcap == 4) .and. ibelly == 0) then
- write(6,'(/2x,a,a)') &
- 'For IVCAP == 3 or 4, ibelly must be 1 and all atoms', &
- ' not in the spherical or orthorhombic region must be set NOT moving'
- inerr = 1
- end if
- if (ivcap == 5 .and. (imin /= 1 .or. maxcyc > 1)) then
- write(6,'(/2x,a,a)') &
- 'IVCAP == 5 only works for single-point energy calculation'
- inerr = 1
- end if
-
- ! check if ifbox variable from prmtop file matches actual angles:
-
- if ( igb == 0 .and. ipb == 0 .and. ntb /= 0 ) then
- if ( ifbox == 1 ) then
- if ( abs(alpha - 90.0d0) > 1.d-5 .or. &
- abs(beta - 90.0d0) > 1.d-5 .or. &
- abs(gamma - 90.0d0) > 1.d-5 ) then
- ifbox =3
- write(6,'(a)') ' Setting ifbox to 3 for non-orthogonal unit cell'
- end if
- end if
-
- if ( ifbox == 2 ) then
- if ( abs(alpha - 109.4712190d0) > 1.d-5 .or. &
- abs(beta - 109.4712190d0) > 1.d-5 .or. &
- abs(gamma - 109.4712190d0) > 1.d-5 ) then
- write(6,'(/2x,a)') &
- 'Error: ifbox=2 in prmtop but angles are not correct'
- inerr = 1
- end if
- end if
- end if
-
- ! checks for targeted MD
- if (itgtmd /= 0 .and. itgtmd > 2) then
- write(6,'(/2x,a,i3,a)') 'ITGTMD (',itgtmd,') must be 0, 1 or 2.'
- inerr = 1
- end if
- if (itgtmd == 1 .and. ntr == 1) then
- if (len_trim(tgtfitmask) > 0 .or. len_trim(tgtrmsmask) <= 0) then
- write(6,'(/2x,a)') 'ITGTMD: tgtrmsmask (and not tgtfitmask) ' // &
- 'should be specified if NTR=1'
- inerr = 1
- end if
- end if
- ! skip this test until fallback to rgroup() is supported
- !if (itgtmd == 1 .and. ntr == 0) then
- ! if (len_trim(tgtfitmask) == 0 .and. len_trim(tgtrmsmask) == 0) then
- ! write(6,'(/2x,a)') &
- ! 'ITGTMD: both tgtfitmask and tgtrmsmask should be specified if NTR=0'
- ! inerr = 1
- ! end if
- !end if
-
- ! -- consistency checking
-
- if (imin > 0.and.nrespa > 1) then
- write(6,'(/2x,a)') 'For minimization, set nrespa,nrespai=1'
- inerr = 1
- end if
- if (ntp > 0 .and. nrespa > 1) then
- write(6,'(/2x,a)') 'nrespa must be 1 if ntp>0'
- inerr = 1
- end if
- if (ntx < 4.and.init /= 3) then
- write(6,'(/2x,a)') 'NTX / IREST inconsistency'
- inerr = 1
- end if
- if (ntb == 2 .and. ntp == 0) then
- write(6,'(/2x,a)') 'NTB set but no NTP option (must be 1 or 2)'
- inerr = 1
- end if
- if (ntp /= 0 .and. ntb /= 2) then
- write(6,'(/,a,a)')' NTP > 0 but not constant pressure P.B.C.', &
- ' (NTB = 2) must be used'
- inerr = 1
- end if
- if (ntb /= 0 .and. ifbox == 0 .and. ntp /= 0) then
- write(6,'(/,a)') ' (NTB /= 0 and NTP /= 0) but IFBOX == 0'
- write(6,'(/,a)') ' This combination is not supported'
- inerr = 1
- end if
- if (ntb /= 0 .and. &
- ( box(1) < 1.d0 .or. &
- box(2) < 1.d0 .or. &
- box(3) < 1.d0 ) ) then
- write(6,'(/,a,3f10.3)') ' BOX is too small: ',box(1),box(2),box(3)
- inerr = 1
- else if (ntb /= 0 .and. &
- (sqrt(cut) >= box(1)*0.5d0 .or. &
- sqrt(cut) >= box(2)*0.5d0 .or. &
- sqrt(cut) >= box(3)*0.5d0) ) then
- write(6,'(/,a)') ' CUT must be < half smallest box dimension'
- inerr = 1
- end if
- if (ntb /= 0 .and. (igb > 0 .or. ipb /= 0) ) then
- write(6,'(/,a)') ' igb>0 is only compatible with ntb=0'
- inerr = 1
- end if
-#ifdef APBS
- if ( ntb == 0 .and. sqrt(cut) < 8.05 .and. igb /= 10 .and. ipb == 0 .and. &
- .not. mdin_apbs) then
-#else
- if ( ntb == 0 .and. sqrt(cut) < 8.05 .and. igb /= 10 .and. ipb == 0 ) then
-#endif /* APBS */
- write(6,'(/,a,f8.2)') ' unreasonably small cut for non-periodic run: ', &
- sqrt(cut)
- inerr = 1
- end if
- if ( rgbmax < 5.d0*fsmax ) then
- write(6,'(/,a,f8.2)') ' rgbmax must be at least ', 5.d0*fsmax
- inerr = 1
- end if
- if (icfe /= 0 .and. indmeth == 3 ) then
- write(6,'(/,a)') ' indmeth=3 cannot be used with icfe>0'
- inerr = 1
- end if
- if (icfe /= 0 .and. ibelly /= 0 ) then
- write(6,'(/,a)') ' ibelly cannot be used with icfe'
- inerr = 1
- end if
-#ifdef MPI /* SOFT CORE */
- if (icfe /= 0 .and. dvdl_norest /= 0 ) then
- write(6,'(/,a)') 'dvdl_norest must == 0!'
- write(6,'(/,a)') 'The dvdl_norest option is deprecated.'
- write(6,'(/,a)') 'Restraint energies are seperated, &
- &and do not contribute to dvdl.'
- inerr = 1
- end if
-#endif
- ! Modification done by Ilyas Yildirim
- if (icfe == 1 .and. (klambda < 1 .or. klambda > 6)) then
- write(6,'(/,a)') ' klambda must be between 1 and 6'
- inerr = 1
- end if
- ! End of modification done by Ilyas Yildirim
-
- if (clambda < 0.d0 .or. clambda > 1.d0 ) then
- write(6,'(/,a)') ' clambda must be between 0 and 1'
- inerr = 1
- end if
-
- if (icfe /= 0 .and. (idecomp == 3 .or. idecomp == 4)) then
- write(6,'(/,a)') ' Pairwise decomposition for thermodynamic integration not implemented'
- inerr = 1
- end if
- if (icfe /= 0 .and. idecomp /= 0 .and. ipol > 0) then
- write(6,'(/,a)') ' IPOL is incompatible with IDECOMP and ICFE'
- inerr = 1
- end if
-
-#ifdef MPI /* SOFT CORE */
- if (ifsc /= 0) then
- if (ifsc == 2) then
- write (6,'(/,a)') 'The ifsc=2 option is no longer supported. &
- &Internal energies of the soft core region.'
- write (6,'(a)') 'are now handled implicitly and setting ifsc=2 &
- &is no longer needed'
- inerr = 1
- end if
- if (icfe /= 1 .and. ifsc==1) then
- write (6,'(/,a)') ' Softcore potential requires a standard TI run, set icfe to 1'
- inerr = 1
- end if
- if ( igb > 0 .or. ipb /= 0 ) then
- write (6,'(/,a)') ' Softcore potential is incompatible with GB (for now)'
- inerr = 1
- end if
- if ( ntf > 1 ) then
- write (6,'(/,a)') ' Softcore potentials require ntf=1 because SHAKE &
- &constraints on some bonds might be removed'
- inerr = 1
- end if
- if (clambda > 0.995 .or. clambda < 0.005) then
- write (6,'(/,a)') ' Softcore potentials cannot be used with clambda < 0.005 or > 0.995'
- inerr = 1
- end if
- if (klambda /= 1) then
- write (6,'(/,a)') ' Softcore potential requires linear mixing, set klambda to 1'
- inerr = 1
- end if
- if (imin == 1 .and. ntmin /= 2) then
- write (6,'(/,a)') ' Minimizations with ifsc=1 require the steepest descent algorithm.'
- write (6,'(/,a)') ' Set ntmin to 2 and restart'
- inerr = 1
- end if
- end if
- if (ifmbar /= 0) then
- if (icfe /= 1) then
- write (6,'(/,a)') ' MBAR requires a standard TI run, set icfe to 1'
- inerr = 1
- end if
- if (ifsc /=0 .and. (bar_l_max > 0.995 .or. bar_l_min < 0.005) ) then
- write (6,'(/,a)') ' Softcore potentials cannot be used with &
- &bar_l_min < 0.005 or bar_l_max > 0.995'
- inerr = 1
- end if
- if (klambda /= 1) then
- write (6,'(/,a)') ' MBAR requires linear mixing, set klambda to 1'
- inerr = 1
- end if
- end if
-#endif
-
- if (ilrt /= 0 .and. lrtmask == '') then
- write (6,'(a)') 'Linear Response Theory activated, but lrtmask is not set'
- inerr = 1
- end if
-
- if (idecomp > 0 .and. (ntr > 0 .or. ibelly > 0)) then
- write(6,'(/,a)') 'IDECOMP is not compatible with NTR or IBELLY'
- inerr = 1
- end if
- if (icnstph /= 0) then
-
- if ( icnstph < 0 ) then
- write(6, '(/,a)') 'icnstph must be greater than 0'
- inerr = 1
- end if
- if ( igb == 0 .and. ipb == 0 .and. icnstph == 1 ) then
- write(6, '(/,a)') 'Constant pH using icnstph = 1 requires &
- &GB implicit solvent'
- inerr = 1
- end if
- if ( ntb .eq. 0 .and. icnstph .gt. 1 ) then
- write(6, '(/,a)') 'Constant pH using icnstph = 2 requires &
- &periodic boundary conditions'
- inerr = 1
- end if
- if (icfe /= 0) then
- write(6, '(/,a)') &
- 'Constant pH and thermodynamic integration are incompatable'
- inerr = 1
- end if
-
- if (ntcnstph <= 0) then
- write(6, '(/,a)') 'ntcnstph must be a positive integer.'
- inerr = 1
- end if
-
- if (icnstph > 1 .and. mccycles <= 0) then
- write(6, '(/,a)') 'mccycles must be a positive integer.'
- inerr = 1
- end if
-
- end if ! icnstph
-
-#ifdef noVIRIAL
- if( ntp > 0 .and. barostat == 1 ) then
- write(6,'(/,a)') 'Error: Berendsen barostat is incompatible with noVIRIAL'
- inerr = 1
- end if
-#endif
-
- !-----------------------------------------------------
- ! ----sanity checks for Ewald
- !-----------------------------------------------------
-
- if( igb == 0 .and. ipb == 0 ) then
- call float_legal_range('skinnb: (nonbond list skin) ', &
- skinnb,skinlo,skinhi)
-
- ! --- Will check on sanity of settings after coords are read in
- ! and the extent of the system is determined.
-
- if(periodic == 1)then
- call float_legal_range('skinnb+cutoffnb: (nonbond list cut) ', &
- skinnb+cutoffnb,zero,sphere)
- end if
- if (ntb==0 .and. use_pme/=0) then
- write(6,'(/,a)') &
- 'Using PME with a non-periodic simulation does not make sense. Set either ntb>0 of use_pme=0.'
- inerr = 1
- end if
- call float_legal_range('a: (unit cell size) ',a,boxlo,boxhi)
- call float_legal_range('b: (unit cell size) ',b,boxlo,boxhi)
- call float_legal_range('c: (unit cell size) ',c,boxlo,boxhi)
- call float_legal_range('alpha: (unit cell angle) ', &
- alpha,anglo,anghi)
- call float_legal_range('beta: (unit cell angle) ', &
- beta,anglo,anghi)
- call float_legal_range('gamma: (unit cell angle) ', &
- gamma,anglo,anghi)
- call int_legal_range('order: (interpolation order) ', &
- order,orderlo,orderhi)
- call opt_legal_range('verbose: ',verbose,0,4)
- call opt_legal_range('netfrc: ',netfrc,0,1)
- call opt_legal_range('nbflag: ',nbflag,0,1)
- call opt_legal_range('nbtell: ',nbtell,0,2)
- call opt_legal_range('ew_type: ',ew_type,0,1)
- call opt_legal_range('vdwmeth: ',vdwmeth,0,2)
- call opt_legal_range('eedmeth: ',eedmeth,1,6)
- call opt_legal_range('ee_type: ',ee_type,1,2)
- call opt_legal_range('maxiter: ',maxiter,1,50)
- call opt_legal_range('indmeth: ',indmeth,0,3)
- call opt_legal_range('fix_quad: ',fix_quad,0,1)
- call float_legal_range('eedtbdns: (erfc table density) ', &
- eedtbdns,denslo,denshi)
- end if ! ( igb == 0 .and. ipb == 0 )
-
- if( ntb==2 .and. ipimd==1) then
- write(6,*) 'primitive PIMD is incompatible with NTP ensemble'
- inerr=1
- endif
-
- if( ntb==2 .and. ipimd==3 ) then
- write(6,*) 'CMD is incompatible with NTP ensemble'
- inerr=1
- endif
-
- if( ipimd==3 .and. adiab_param>=1.0 ) then
- write(6,*) 'For CMD adiab_param must be <=1'
- inerr=1
- endif
-
- if( ntb==2 .and. ipimd==4 ) then
- write(6,*) 'RPMD is incompatible with NTP ensemble'
- inerr=1
- endif
-
- if( ntt/=0 .and. ipimd==4 ) then
- write(6,*) 'RPMD is incompatible with NVT ensemble'
- inerr=1
- endif
-
- if( ntt/=4 .and. ipimd==2 ) then
- write(6,*) 'NMPIMD requires Nose-Hoover chains (ntt=4)'
- inerr=1
- endif
-
- if( ntt/=4 .and. ipimd==3 ) then
- write(6,*) 'CMD requires Nose-Hoover chains (ntt=4)'
- inerr=1
- endif
-
-#if !defined(MPI)
- if( ineb > 0 ) then
- write(6,*) 'NEB requires MPI'
- inerr=1
- endif
-#endif
-
-#ifdef LES
- if( ineb > 0 ) then
- write(6,*) 'NEB no longer works with LES: use multiple groups and a groupfile instead'
- inerr=1
- endif
-#endif
-
- if( ineb > 0 .and. ipimd > 0 ) then
- write(6,*) 'ineb>0 and ipimd>0 are incompatible options'
- inerr=1
- endif
-
- if( iamoeba == 1 )then
-#ifdef LES
- write(6,*)'amoeba is incompatible with LES'
- inerr=1
-#endif
-
- if( ntc > 1 ) then
- write(6,*) 'SHAKE (ntc>1) and amoeba are incompatible options'
- inerr=1
- end if
- if( ntp > 1 .and. beeman_integrator > 0 ) then
- write(6,*) 'ntp>1 is not consistent with the beeman integrator'
- inerr=1
- end if
- if ( igb /= 0 ) then
- write (6,'(/,a)') 'amoeba (iamoeba=1) is incompatible with GB (igb>0)'
- inerr=1
- end if
- if ( ipb /= 0 ) then
- write (6,'(/,a)') 'amoeba (iamoeba=1) is incompatible with PB (ipb>0)'
- inerr=1
- end if
-#ifdef MPI
- if (numtasks > 1) then
- write(6, '(/,a)') 'amoeba (iamoeba=1) cannot be run in parallel in &
- &sander'
- inerr=1
- end if
-#endif
-
- end if
-
- ! ---WARNINGS:
-
- if ( ibelly == 1 .and. igb == 0 .and. ipb == 0 .and. ntb /= 0 ) then
- write(6,'(/,a,/,a,/,a)') &
- 'Warning: Although EWALD will work with belly', &
- '(for equilibration), it is not strictly correct!'
- end if
-
- if (inerr == 1) then
- write(6, '(/,a)') ' *** input error(s)'
- call mexit(6,1)
- end if
-
- ! Load the restrained atoms (ntr=1) or the belly atoms (ibelly=1)
- ! or atoms for targeted md (itgtmd=1). Selections are read from
- ! &cntrl variables or, if these are not defined, it falls back to
- ! the old group input format.
-
- if(mtmd /= 'mtmd') then
- itgtmd = 2
- ntr = 0
- emtmd = 0.0d0
- end if
- konst = ntr > 0
- dotgtmd = itgtmd > 0
- belly = .false.
- natc = 0
- ngrp = 0
- natbel = 0
- nattgtfit = 0 ! number of atoms for tgtmd fitting (=overlap)
- nattgtrms = 0 ! number of atoms for tgtmd rmsd calculation
- nrc = 0
- if(konst.or.dotgtmd) then
-
- ! inserted here to fix the bug that coords are not available
- ! yet when distance based selection (<,>) is requested
-#ifdef LES
- call getcor(nr,x(lcrd),x(lvel),x(lforce),ntx,box,irest,t,temp0les,.FALSE.,solvph)
-#else
- call AMOEBA_check_newstyle_inpcrd(inpcrd,newstyle)
- if ( newstyle )then
- call AM_RUNMD_get_coords(natom,t,irest,ntb,x(lcrd),x(lvel))
- else
- if( irest == 1 .and. beeman_integrator > 0 ) then
- write(6,*) 'Cannot do a beeman_integrator restart with old-style coordinates'
- call mexit(6,1)
- end if
- call getcor(nr,x(lcrd),x(lvel),x(lforce),ntx,box,irest,t,temp0,.FALSE.,solvph)
- endif
-#endif
-
- if(itgtmd == 2) then
- call mtmdcall(emtmd,x(lmtmd01),ix(imtmd02),x(lcrd),x(lforce),ih(m04),ih(m02),ix(i02),&
- ih(m06),x(lmass),natom,nres,'READ')
- else
- ! DRR - Open and close calls are now in rdrest
- !if (ntrx <= 0) then
- ! call amopen(10,refc,'O','U','R')
- !else
- ! call amopen(10,refc,'O','F','R')
- !end if
- ! these messages should be written after "5. REFERENCE..." ?
- if (konst) write(6,9408)
- if (dotgtmd) write(6,9409)
-
- call rdrest(natom,ntrx,refc,x(lcrdr))
- !close(10)
-
-
-
-
- ! VH - tgtmd change: preferably call atommask() instead of rgroup()
- if (konst) then
- if( len_trim(restraintmask) <= 0 ) then
- call rgroup(natom,natc,nres,ngrp,ix(i02),ih(m02), &
- ih(m04),ih(m06),ih(m08),ix(icnstrgp),jgroup,indx,irespw,npdec, &
- x(l60),x(lcrdr),konst,dotgtmd,belly,idecomp,5,.true.)
- else
- call atommask( natom, nres, 0, ih(m04), ih(m06), &
- ix(i02), ih(m02), x(lcrd), restraintmask, ix(icnstrgp) )
-
- ! for now, emulate the "GATHER ALL THE CONSTRAINED ATOMS TOGETHER"
- ! section of rgroup(); later, the various masks should be done
- ! differently, i.e. without the "gather", as in the following:
- ! x(l60:l60+natom-1) = restraint_wt
- ! natc = sum(ix(icnstrgp:icnstrgp+natom-1))
-
- natc = 0
- do i=1,natom
- if( ix(icnstrgp-1+i) <= 0 ) cycle
- natc = natc + 1
- ix(icnstrgp-1+natc) = i
- x(l60-1+natc) = restraint_wt
- end do
- write(6,'(a,a,a,i5,a)') ' Mask ', &
- restraintmask(1:len_trim(restraintmask)), ' matches ',natc,' atoms'
- end if
- end if
- nrc = natc
-
- if (itgtmd == 1) then
- if (len_trim(tgtfitmask) <= 0 .and. len_trim(tgtrmsmask) <= 0) then
- ! the following if-endif can be deleted when we stop
- ! supporting rgroup()
- if (konst) then
- ! cannot do both ntr and tgtmd together using old group format
- write(6,'(/2x,a)') 'NTR must be 0 for targeted MD (TGTMD=1)'
- call mexit(6,1)
- else ! the following only for backward compatibility
- call rgroup(natom,natc,nres,ngrp,ix(i02),ih(m02), &
- ih(m04),ih(m06),ih(m08),ix(icnstrgp), &
- jgroup,indx,irespw,npdec, &
- x(l60),x(lcrdr),konst,dotgtmd,belly,idecomp,5,.true.)
- ! tgtmd atoms are now stored in nattgt, igroup -> icnstrgp
- nattgtfit = natc
- nattgtrms = natc
- do i=1,nattgtfit
- ix(itgtfitgp-1+i) = ix(icnstrgp-1+i)
- ix(itgtrmsgp-1+i) = ix(icnstrgp-1+i)
- end do
- end if
- else
- if (ntr == 0) then ! read tgtfitmask only if ntr=1
- ! read in atom group for tgtmd fitting (=overlap region)
- call atommask( natom, nres, 0, ih(m04), ih(m06), &
- ix(i02), ih(m02), x(lcrd), tgtfitmask, ix(itgtfitgp) )
- ! see comments above (for ntr) for the following reduction cycle
- nattgtfit = 0
- do i=1,natom
- if( ix(itgtfitgp-1+i) <= 0 ) cycle
- nattgtfit = nattgtfit + 1
- ix(itgtfitgp-1+nattgtfit) = i
- end do
- write(6,'(a,a,a,i5,a)') &
- ' Mask "', tgtfitmask(1:len_trim(tgtfitmask)-1), &
- '" matches ',nattgtfit,' atoms'
- end if
- ! read in atom group for tgtmd rmsd calculation
- call atommask( natom, nres, 0, ih(m04), ih(m06), &
- ix(i02), ih(m02), x(lcrd), tgtrmsmask, ix(itgtrmsgp) )
- nattgtrms = 0
- do i=1,natom
- if( ix(itgtrmsgp-1+i) <= 0 ) cycle
- nattgtrms = nattgtrms + 1
- ix(itgtrmsgp-1+nattgtrms) = i
- end do
- write(6,'(a,a,a,i5,a)') &
- ' Mask "', tgtrmsmask(1:len_trim(tgtrmsmask)-1), &
- '" matches ',nattgtrms,' atoms'
- end if
- end if
-
- end if ! (itgtmd == 2)
-
- end if ! (konst.or.dotgtmd)
-
- if (ineb>0) then
- ! carlos: read in fitmask and rmsmask info for NEB, just as done for tgtmd
- ! init last_neb_atom, which is used to determine the limits for the
- ! communication of neighbor coordinates (to reduce size for explicit
- ! water)
- last_neb_atom = 0
-
- if (ntr /= 0) then
- write(6,'(/2x,a)') 'cannot use NEB with ntr restraints'
-! CARLOS: WHY NOT? SHOULD BE OK.
-! potential for user error is restrained region overlaps with NEB region. would
-! blow up.
- call mexit(6,1)
- else
- ! read in atom group for fitting (=overlap region)
- call atommask( natom, nres, 0, ih(m04), ih(m06), &
- ix(i02), ih(m02), x(lcrd), tgtfitmask, ix(itgtfitgp) )
- ! see comments above (for ntr) for the following reduction cycle
- nattgtfit = 0
- do i=1,natom
- if( ix(itgtfitgp-1+i) <= 0 ) cycle
- nattgtfit = nattgtfit + 1
- ix(itgtfitgp-1+nattgtfit) = i
- if (i.gt.last_neb_atom) last_neb_atom = i
- end do
- write(6,'(a)') "The following selection will be used for NEB structure fitting"
- write(6,'(a,a,a,i5,a)') &
- ' Mask "', tgtfitmask(1:len_trim(tgtfitmask)-1), &
- '" matches ',nattgtfit,' atoms'
- end if
- ! read in atom group for tgtmd rmsd calculation
- call atommask( natom, nres, 0, ih(m04), ih(m06), &
- ix(i02), ih(m02), x(lcrd), tgtrmsmask, ix(itgtrmsgp) )
- nattgtrms = 0
- do i=1,natom
- if( ix(itgtrmsgp-1+i) <= 0 ) cycle
- nattgtrms = nattgtrms + 1
- ix(itgtrmsgp-1+nattgtrms) = i
- if (i.gt.last_neb_atom) last_neb_atom = i
- end do
- write(6,'(a)') "The following selection will be used for NEB force application"
- write(6,'(a,a,a,i5,a)') &
- ' Mask "', tgtrmsmask(1:len_trim(tgtrmsmask)-1), &
- '" matches ',nattgtrms,' atoms'
- write(6,'(/2x,a,i6)') "Last atom in NEB fitmask or rmsmask is ",last_neb_atom
-
- if (nattgtrms<=0 .or. nattgtfit <= 0) then
- write(6,'(/2x,a)') 'NEB requires use of tgtfitmask and tgtrmsmask'
- call mexit(6,1)
- endif
- endif
-
- ! dotgtmd may be false here even if doing tgtmd
- ! this is so belly info is read properly? following existing KONST code
-
- dotgtmd=.false.
- konst = .false.
- belly = ibelly > 0
- ngrp = 0
- if(belly) then
- ! inserted here to fix the bug that coords are not available
- ! yet when distance based selection (<,>) is requested
-#ifdef LES
- call getcor(nr,x(lcrd),x(lvel),x(lforce),ntx,box,irest,t,temp0les,.FALSE.,solvph)
-#else
- call getcor(nr,x(lcrd),x(lvel),x(lforce),ntx,box,irest,t,temp0,.FALSE.,solvph)
-#endif
- write(6,9418)
- if( len_trim(bellymask) <= 0 ) then
- call rgroup(natom,natbel,nres,ngrp,ix(i02),ih(m02), &
- ih(m04),ih(m06),ih(m08),ix(ibellygp), &
- jgroup,indx,irespw,npdec, &
- x(l60),x(lcrdr),konst,dotgtmd,belly,idecomp,5,.true.)
- else
- call atommask( natom, nres, 0, ih(m04), ih(m06), &
- ix(i02), ih(m02), x(lcrd), bellymask, ix(ibellygp) )
- natbel = sum(ix(ibellygp:ibellygp+natom-1))
- write(6,'(a,a,a,i5,a)') ' Mask ', &
- bellymask(1:len_trim(bellymask)), ' matches ',natbel,' atoms'
- end if
- end if
- call setvar(ix,belly)
-
- ! see if the user has input a noshakemask string, and process it:
- natnos = 0
- if( len_trim(noshakemask) > 0 ) then
- call atommask( natom, nres, 0, ih(m04), ih(m06), &
- ix(i02), ih(m02), x(lcrd), noshakemask, noshakegp )
- natnos = sum(noshakegp(1:natom))
- write(6,*)
- write(6,'(a,a,a,i5,a)') 'Noshake mask ', &
- noshakemask(1:len_trim(noshakemask)), ' matches ',natnos,' atoms'
- call setnoshake(ix,noshakegp,ntc,num_noshake)
- if( ntf > 1 ) then
- write(6,'(a)') ' Setting ntf to 1'
- ntf = 1
- end if
- end if
-
- ! GMS ------------------------------------
- ! Check for 'iwrap_mask', and process it.
- ! ----------------------------------------
- n_iwrap_mask_atoms = 0
- if( len_trim(iwrap_mask) > 0 .and. iwrap == 2) then
- call atommask( natom, nres, 0, ih(m04), ih(m06), &
- ix(i02), ih(m02), x(lcrd), iwrap_mask, iwrap_maskgp )
- ! iwrap_maskgp is a natom long integer array, with elements:
- ! 0 --> atom is not in iwrap_mask
- ! 1 --> atom is in iwrap_mask
- n_iwrap_mask_atoms = sum(iwrap_maskgp(1:natom))
- write(6,*)
- write(6,'(a,a,a,i5,a)') 'Wrap mask ', &
- iwrap_mask(1:len_trim(iwrap_mask)), ' matches ',n_iwrap_mask_atoms,' atoms:'
- ! Set an array to store the atom numbers of the atoms
- ! in the iwrap_mask
- allocate(iwrap_mask_atoms(n_iwrap_mask_atoms), stat=ier)
- REQUIRE(ier == 0)
-
- j = 0
- do i=1,natom
- if( iwrap_maskgp(i)>0 ) then
- j = j+1
- iwrap_mask_atoms(j) = i
- end if
- end do
-
- write(6,'(10i5)') (iwrap_mask_atoms(i),i=1,n_iwrap_mask_atoms)
- end if
-
-#ifdef MPI /* SOFT CORE */
- ! lower charges if a crgmask is set
- if ( len_trim(crgmask) > 0 ) then
- call atommask( natom, nres, 0, ih(m04), ih(m06), &
- ix(i02), ih(m02), x(lcrd), crgmask, crggp )
- write(6,'(a,a,a,i5,a)') 'Zero-Charge Mask ',crgmask(1:len_trim(crgmask)), ' matches ',sum(crggp(1:natom)),' atoms'
- call remove_charges(crggp, natom, x(l15))
- end if
-#endif
-
- konst = .false.
- belly = .false.
- if(idecomp > 0) then
- write(6,9428)
- call rgroup(natom,ntmp,nres,ngrp,ix(i02),ih(m02), &
- ih(m04),ih(m06),ih(m08),ix(ibellygp), &
- jgroup,indx,irespw,npdec, &
- x(l60),x(lcrdr),konst,dotgtmd,belly,idecomp,5,.true.)
- end if
-
- if( ibelly > 0 .and. (igb > 0 .or. ipb /= 0) ) then
-
- ! ---here, the only allowable belly has just the first
- ! NATBEL atoms in the moving part. Check to see that this
- ! requirement is satisfied:
-
- do i=natbel+1,natom
- if( ix(ibellygp+i-1) /= 0 ) then
- write(6,*) 'When igb>0, the moving part must be at the'
- write(6,*) ' start of the molecule. This does not seem'
- write(6,*) ' to be the case here.'
- write(6,*) 'natbel,i,igroup(i) = ' &
- ,natbel,i,ix(ibellygp+i-1)
- call mexit(6,1)
- end if
- end do
- end if
-
-
- ! ----- CALCULATE THE SQUARE OF THE BOND PARAMETERS FOR SHAKE
- ! THE PARAMETERS ARE PUT SEQUENTIALLY IN THE ARRAY CONP -----
-
- do i=1,nbonh + nbona + nbper
- j = ix(iicbh+i-1)
- x(l50+i-1) = req(j)**2
- end do
-
-#ifdef MPI
- if( icfe /= 0 ) then
-
- ! use the masses of the prmtop file for the first group for both groups:
- ! [only the master nodes communicate here, since non-master nodes
- ! have not yet allocated space]
- ! This leads to problems for dual topology runs, and is therefore skipped
- ! if ifsc is set to one, the masses from both prmtop files are used
- if (ifsc == 0) then
- call mpi_bcast(x(lmass),natom,MPI_DOUBLE_PRECISION,0,commmaster,ierr)
- call mpi_bcast(x(lwinv),natom,MPI_DOUBLE_PRECISION,0,commmaster,ierr)
- call mpi_bcast(x(l75),natom,MPI_DOUBLE_PRECISION,0,commmaster,ierr)
- end if
- tmass = sum(x(lmass:lmass+natom-1))
- tmassinv = 1.d0/tmass
-
- ! next, do a minimal sanity check that the SHAKE parameters are
- ! consistent on the two processors:
-
- ! For Softcore this might be allowed
- ! Put a better check here later
- if( ntc == 2 .and. ifsc == 0) then
- partner = ieor(masterrank,1)
- call mpi_sendrecv( nbonh, 1, MPI_INTEGER, partner, 5, &
- nbonh_c, 1, MPI_INTEGER, partner, 5, &
- commmaster, ist, ierr )
- call mpi_sendrecv( num_noshake, 1, MPI_INTEGER, partner, 5, &
- num_noshake_c, 1, MPI_INTEGER, partner, 5, &
- commmaster, ist, ierr )
- if (qmmm_nml%ifqnt .and. qmmm_nml%qmshake == 0) then
- ! qtw - if qmshake=0, we need to check the QM atoms
- call mpi_sendrecv( &
- qmmm_struct%nquant, 1, MPI_INTEGER, partner, 5, &
- nquant_c, 1, MPI_INTEGER, partner, 5, &
- commmaster, ist, ierr)
- call mpi_sendrecv( &
- qmmm_struct%noshake_overlap, 1, MPI_INTEGER,partner, 5, &
- noshake_overlap_c, 1, MPI_INTEGER, partner, 5, &
- commmaster, ist, ierr)
- if ( (qmmm_struct%nquant-qmmm_struct%noshake_overlap) /= &
- (nquant_c-noshake_overlap_c) ) then
- call sander_bomb('mdread2', &
- 'QMMM: NOSHAKE lists are not match in two groups!', &
- 'try noshakemask in cntrl to match the noshake list')
- end if
- else if( nbonh - num_noshake /= nbonh_c - num_noshake_c ) then
- write(6,*) 'SHAKE lists are not compatible in the two groups!'
- call mexit(6,1)
- end if
- else if( ntc == 3 ) then
- write(6,*) 'ntc = 3 is not compatible with icfe>0'
- call mexit(6,1)
- end if
-
- end if
-#endif
-
- if ( iamoeba /= 1 )then
- if( igb == 0 .and. ipb == 0 ) &
- call init_extra_pts( &
- ix(iibh),ix(ijbh),ix(iicbh), &
- ix(iiba),ix(ijba),ix(iicba), &
- ix(i24),ix(i26),ix(i28),ix(i30), &
- ix(i32),ix(i34),ix(i36),ix(i38), &
- ix(i40),ix(i42),ix(i44),ix(i46),ix(i48), &
- ix(i50),ix(i52),ix(i54),ix(i56),ix(i58), &
- ih(m06),ix,x,ix(i08),ix(i10), &
- nspm,ix(i70),x(l75),tmass,tmassinv,x(lmass),x(lwinv),req)
- endif
-
- ! DEBUG input; force checking
- call load_debug(5)
-
- return
- ! -------------------------------------------------------------------------
- ! Standard format statements:
-
- 9328 format(/80('-')/,' 2. CONTROL DATA FOR THE RUN',/80('-')/)
- 9408 format(/4x,'LOADING THE CONSTRAINED ATOMS AS GROUPS',/)
- 9409 format(/4x,'LOADING THE TARGETED MD ATOMS AS GROUPS',/)
- 9418 format(/4x,'LOADING THE BELLY ATOMS AS GROUPS',/)
- 9428 format(/4x,'LOADING THE DECOMP ATOMS AS GROUPS',/)
- 9008 format(a80)
-end subroutine mdread2
-
-
-!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-!+ Emit defined preprocessor names, ie, flags.
-subroutine printflags()
-
- implicit none
- integer max_line_length
- parameter ( max_line_length = 80 )
-
- character(len=max_line_length) line ! output string of active flags
- integer n ! len(line)
-
- line = '| Flags:'
- n = 8
-
-#ifdef ISTAR2
- call printflags2(' ISTAR2',7,n,line,.false.)
-#endif
-#ifdef MPI
- call printflags2(' MPI',4,n,line,.false.)
-# ifdef USE_MPI_IN_PLACE
- call printflags2(' USE_MPI_IN_PLACE',17,n,line,.false.)
-# endif
-#endif
-#ifdef LES
- call printflags2(' LES',4,n,line,.false.)
-#endif
-#ifdef NMODE
- call printflags2(' NMODE',6,n,line,.false.)
-#endif
-#ifdef HAS_10_12
- call printflags2(' HAS_10_12',10,n,line,.false.)
-#endif
-#ifdef DNA_SHIFT
- call printflags2(' DNA_SHIFT',10,n,line,.false.)
-#endif
-#ifdef MMTSB
- call printflags2(' MMTSB',6,n,line,.false.)
-#endif
-
-#ifdef noVIRIAL
- call printflags2(' noVIRIAL',9,n,line,.false.)
-#endif
-
- call printflags2(' ',1,n,line,.true.)
- return
-end subroutine printflags
-
-
-!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-!+ Primitive pre-Fortran90 implementation of printflags.
-subroutine printflags2(flag,flag_len,line_len,line,last)
-
- implicit none
- integer max_line_length
- parameter ( max_line_length = 80 )
-
- character(*) flag ! flag name with blank prefix, intent(in)
- integer flag_len ! len(flag), intent(in)
- integer line_len ! len(line), intent(inout)
- character(len=max_line_length) line ! intent(inout)
- logical last ! is this the last flag ?, intent(in)
-
- if (line_len + flag_len > max_line_length) then
- write( 6,'(a)') line
- ! begin another line
- line = '| Flags:'
- line_len=8
- end if
- line=line(1:line_len) // flag(1:flag_len)
- line_len=line_len+flag_len
- if(last)write( 6,'(a)') line
- return
-end subroutine printflags2
-
-!-------------------------------------------------
-! --- FLOAT_LEGAL_RANGE ---
-!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-!+ Check the range of a float; abort on illegal values.
-subroutine float_legal_range(string,param,lo,hi)
- implicit none
- _REAL_ param,lo,hi
- character(len=*)string
-
- if ( param < lo .or. param > hi )then
- write(6,59)
- write(6,60)string,param
- write(6,61)
- write(6,62)lo,hi
- write(6,63)
- call mexit(6,1)
- end if
- 59 format(/,1x,'Ewald PARAMETER RANGE CHECKING: ')
- 60 format(1x,'parameter ',a,' has value ',e12.5)
- 61 format(1x,'This is outside the legal range')
- 62 format(1x,'Lower limit: ',e12.5,' Upper limit: ',e12.5)
- 63 format(1x,'Check ew_legal.h')
- return
-end subroutine float_legal_range
-
-!-------------------------------------------------
-! --- INT_LEGAL_RANGE ---
-!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-!+ Check the range of an integer; abort on illegal values.
-subroutine int_legal_range(string,param,lo,hi)
- implicit none
- integer param,lo,hi
- character(len=*)string
-
- if ( param < lo .or. param > hi )then
- write(6,59)
- write(6,60)string,param
- write(6,61)
- write(6,62)lo,hi
- write(6,63)
- call mexit(6,1)
- end if
- 59 format(/,1x,'PARAMETER RANGE CHECKING: ')
- 60 format(1x,'parameter ',a,' has value ',i8)
- 61 format(1x,'This is outside the legal range')
- 62 format(1x,'Lower limit: ',i8,' Upper limit: ',i8)
- 63 format(1x,'The limits may be adjustable; search in the .h files ')
- return
-end subroutine int_legal_range
-
-!-------------------------------------------------
-! --- OPT_LEGAL_RANGE ---
-!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-!+ Check the range of an integer option; abort on illegal values.
-subroutine opt_legal_range(string,param,lo,hi)
- implicit none
- integer param,lo,hi
- character(len=*)string
-
- if ( param < lo .or. param > hi )then
- write(6,59)
- write(6,60)string,param
- write(6,61)
- write(6,62)lo,hi
- write(6,63)
- call mexit(6,1)
- end if
- 59 format(/,1x,'Ewald OPTION CHECKING: ')
- 60 format(1x,'option ',a,' has value ',i5)
- 61 format(1x,'This is outside the legal range')
- 62 format(1x,'Lower limit: ',i5,' Upper limit: ',i5)
- 63 format(1x,'Check the manual')
- return
-end subroutine opt_legal_range
-#endif /*ifndef PBSA*/
-
-!-------------------------------------------------
-! --- SANDER_BOMB ---
-!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-!+ Print an error message and quit
-subroutine sander_bomb(routine,string1,string2)
- implicit none
- character(len=*) routine,string1,string2
-
- write(6, '(1x,2a)') &
- 'SANDER BOMB in subroutine ', routine
- write(6, '(1x,a)') string1
- write(6, '(1x,a)') string2
- call mexit(6,1)
-end subroutine sander_bomb
-!-------------------------------------------------
-
-!-------------------------------------------------
-! --- remove_charges ---
-!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-!+ Zero charges on some atoms
-subroutine remove_charges(crggp,natom,charge)
- use constants, only: INV_AMBER_ELECTROSTATIC
- implicit none
- integer natom, crggp(*),i
- _REAL_ charge(*), charge_removed
-
- charge_removed = 0.d0
- do i=1,natom
- if (crggp(i)==1) then
- charge_removed = charge_removed + charge(i) * INV_AMBER_ELECTROSTATIC
- write (6,'(a,f12.4,a,i5)') 'Removing charge of ', charge(i) * INV_AMBER_ELECTROSTATIC,' from atom ',i
- charge(i)=0
- end if
- end do
- write(6, '(a,f12.4,a)') 'Total charge of ',charge_removed,' removed'
- RETURN
-end subroutine remove_charges
-!-------------------------------------------------
diff --git a/patches/amber14.diff/AmberTools/src/sander/mdread.F90.preplumed b/patches/amber14.diff/AmberTools/src/sander/mdread.F90.preplumed
deleted file mode 100644
index d920d10eef47eadf587040da530f1689d3bc930d..0000000000000000000000000000000000000000
--- a/patches/amber14.diff/AmberTools/src/sander/mdread.F90.preplumed
+++ /dev/null
@@ -1,3847 +0,0 @@
-#include "copyright.h"
-#include "../include/dprec.fh"
-#include "ncsu-config.h"
-#include "../include/assert.fh"
-#ifndef PBSA
-!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-!+ Open input files and read cntrl namelist.
-subroutine mdread1()
-
- use file_io_dat
- use lmod_driver, only : read_lmod_namelist
- use qmmm_module, only : qmmm_nml,qmmm_struct, qm_gb
- use constants, only : RETIRED_INPUT_OPTION, zero, one, two, three, seven, &
- eight, NO_INPUT_VALUE_FLOAT, NO_INPUT_VALUE
- use constantph, only : mccycles
- use amoeba_mdin, only: AMOEBA_read_mdin, iamoeba
- use nose_hoover_module, only: nchain ! APJ
- use lscivr_vars, only: ilscivr, icorf_lsc
- use pimd_vars, only: ipimd,itimass
- use neb_vars, only: ineb
- use cmd_vars, only: restart_cmd, eq_cmd, adiab_param
- use stack, only: lastist,lastrst
- use nmr, only: echoin
- use crg_reloc, only: ifcr, cropt, crcut, crskin, crin, crprintcharges
- use sgld, only : isgld, isgsta,isgend,fixcom, &
- tsgavg,sgft,sgff,sgfd,tempsg,treflf,tsgavp
- use amd_mod, only: iamd,iamdlag,EthreshD,alphaD,EthreshP,alphaP, &
- w_amd,EthreshD_w,alphaD_w,EthreshP_w,alphaP_w
- use scaledMD_mod, only: scaledMD,scaledMD_lambda
- use nbips, only: ips,teips,tvips,teaips,tvaips,raips,mipsx,mipsy,mipsz, &
- mipso,gridips,dvbips
- use emap,only: temap,gammamap
-#ifdef DSSP
- use dssp, only: idssp
-#endif /* DSSP */
-
- use emil_mod, only : emil_do_calc
- use mdin_emil_dat_mod, only : error_hdr
-
-#if !defined(DISABLE_NCSU) && defined(MPI)
- use ncsu_sander_hooks, only : ncsu_on_mdread1 => on_mdread1
-#endif /* ! DISABLE_NCSU && MPI */
-#ifdef _XRAY
- use xray_interface_module, only: xray_active, xray_read_mdin
-#endif /* _XRAY */
-#ifdef MPI /* SOFT CORE */
- use softcore, only : scalpha,scbeta,ifsc,scmask,logdvdl,dvdl_norest,dynlmb, &
- sceeorder, tishake, emil_sc
- use mbar, only : ifmbar, bar_intervall, bar_l_min, bar_l_max, bar_l_incr
- use remd, only : rem
-#endif /* MPI */
- ! Parameter for LIE module
- use linear_response, only: ilrt, lrt_interval, lrtmask
-#ifdef RISMSANDER
- use sander_rism_interface, only: rismprm,xvvfile, guvfile, huvfile, cuvfile,&
- uuvfile, asympfile, quvFile, chgDistFile
-#endif /*RISMSANDER*/
-#ifdef APBS
- use apbs
-#endif /* APBS */
- use sebomd_module, only: read_sebomd_namelist, sebomd_namelist_default
- implicit none
-# include "box.h"
-# include "def_time.h"
-# include "ew_cntrl.h"
-# include "ew_pme_recip.h"
-# include "../include/md.h"
-# include "../include/memory.h"
-# include "mmtsb.h"
-# include "nmr.h"
-# include "tgtmd.h"
-# include "multitmd.h"
-# include "ew_erfc_spline.h"
-#ifdef LES
-# include "les.h"
-#else
- _REAL_ temp0les
-#endif
-
- character(len=4) watdef(4),watnam,owtnm,hwtnm1,hwtnm2
-
- _REAL_ dele
- integer ierr
- integer ifind
- integer imcdo
- integer itotst
- integer jn
- integer inerr
- logical mdin_cntrl, mdin_lmod, mdin_qmmm ! true if namelists are in mdin
- logical mdin_sebomd
- integer :: ifqnt ! local here --> put into qmmm_nml%ifqnt after read here
- integer mxgrp
- integer iemap
- character(len=8) date
- character(len=10) time
- character(len=512) :: char_tmp_512
- _REAL_ dtemp ! retired
- _REAL_ dxm ! retired
- _REAL_ heat ! retired
- _REAL_ timlim ! retired
-
-#ifdef RISMSANDER
- integer irism
-#endif /*RISMSANDER*/
-
- namelist /cntrl/ irest,ibelly, &
- ntx,ntxo,ntcx,ig,tempi, &
- ntb,ntt,nchain,temp0,tautp, &
- ntp,pres0,comp,taup,barostat,mcbarint, &
- nscm,nstlim,t,dt, &
- ntc,ntcc,nconp,tol,ntf,ntn,nsnb, &
- cut,dielc, &
- ntpr,ntwx,ntwv,ntwe,ntwf,ntave,ntpp,ioutfm, &
- ntr,nrc,ntrx,taur,nmropt, &
- ivcap,cutcap,xcap,ycap,zcap,fcap, &
- xlorth,ylorth,zlorth,xorth,yorth,zorth,forth, &
- imin,drms,dele,dx0, &
- pencut,ipnlty,iscale,scalm,noeskp, &
- maxcyc,ncyc,ntmin,vlimit, &
- mxsub,ipol,jfastw,watnam,owtnm,hwtnm1,hwtnm2, iesp, &
- skmin, skmax, vv,vfac, tmode, ips, &
- mipsx,mipsy,mipsz,mipso,gridips,raips,dvbips, &
- iamd,iamdlag,EthreshD,alphaD,EthreshP,alphaP, &
- w_amd,EthreshD_w,alphaD_w,EthreshP_w,alphaP_w, &
- scaledMD,scaledMD_lambda, &
- iemap,gammamap, &
- isgld,isgsta,isgend,fixcom,tsgavg,sgft,sgff,sgfd,tempsg,treflf,tsgavp,&
- jar, iamoeba, &
- numexchg, repcrd, numwatkeep, hybridgb, &
- ntwprt,tausw, &
- ntwr,iyammp,imcdo, &
- igb,alpb,Arad,rgbmax,saltcon,offset,gbsa,vrand, &
- surften,iwrap,nrespa,nrespai,gamma_ln,extdiel,intdiel, &
- cut_inner,icfe,clambda,klambda, rbornstat,lastrst,lastist, &
- itgtmd,tgtrmsd,tgtmdfrc,tgtfitmask,tgtrmsmask, dec_verbose, &
- idecomp,temp0les,restraintmask,restraint_wt,bellymask, &
- noshakemask,crgmask, iwrap_mask,mmtsb_switch,mmtsb_iterations, &
- rdt,icnstph,solvph,ntcnstph,ntrelax, mccycles, &
- ifqnt,ievb, ipimd, itimass, ineb,profile_mpi, ilscivr, icorf_lsc, &
- ipb, inp, &
- gbneckscale, &
- gbalphaH,gbbetaH,gbgammaH, &
- gbalphaC,gbbetaC,gbgammaC, &
- gbalphaN,gbbetaN,gbgammaN, &
- gbalphaOS,gbbetaOS,gbgammaOS, &
- gbalphaP,gbbetaP,gbgammaP, &
- Sh,Sc,Sn,So,Ss,Sp, &
- lj1264, &
- ifcr, cropt, crcut, crskin, crin, crprintcharges, &
- csurften, ninterface, gamma_ten, &
-#ifdef MPI /* SOFT CORE */
- scalpha, scbeta, ifsc, scmask, logdvdl, dvdl_norest, dynlmb, &
- sceeorder, &
- ifmbar, bar_intervall, bar_l_min, bar_l_max, bar_l_incr, tishake, &
- emil_sc, &
-#endif
- ilrt, lrt_interval, lrtmask, &
-#ifdef DSSP
- idssp, &
-#endif
-#ifdef RISMSANDER
- irism,&
-#endif /*RISMSANDER*/
- emil_do_calc, &
- restart_cmd, eq_cmd, adiab_param, &
- vdwmodel, & ! mjhsieh - the model used for van der Waals
- dtemp, heat, timlim !all retired
-
- ! Define default water residue name and the names of water oxygen & hydrogens
-
- data watdef/'WAT ','O ','H1 ','H2 '/
-
- ! ----- READ THE CONTROL DATA AND OPEN DIFFERENT FILES -----
-
- if (mdout /= "stdout" ) &
- call amopen(6,mdout,owrite,'F','W')
- call amopen(5,mdin,'O','F','R')
- write(6,9308)
- call date_and_time( DATE=date, TIME=time )
- write(6,'(12(a))') '| Run on ', date(5:6), '/', date(7:8), '/', &
- date(1:4), ' at ', time(1:2), ':', time(3:4), ':', time(5:6)
-
- ! Write the path of the current executable and working directory
- call get_command_argument(0, char_tmp_512)
- write(6,'(/,a,a)') '| Executable path: ', trim(char_tmp_512)
- call getcwd(char_tmp_512)
- write(6,'(a,a)') '| Working directory: ', trim(char_tmp_512)
-! Write the hostname if we can get it from environment variable
-! Note: get_environment_variable is part of the F2003 standard but seems
-! to be supported by GNU, Intel, IBM and Portland (2010+) compilers
- call get_environment_variable("HOSTNAME", char_tmp_512, inerr)
- if (inerr .eq. 0) then
- write(6,'(a,a,/)') '| Hostname: Unknown'
- else
- write(6,'(a,a,/)') '| Hostname: ', trim(char_tmp_512)
- end if
-
- if (owrite /= 'N') write(6, '(2x,a)') '[-O]verwriting output'
-
- ! Echo the file assignments to the user:
-
- write(6,9700) 'MDIN' ,mdin(1:70) , 'MDOUT' ,mdout(1:70) , &
- 'INPCRD' ,inpcrd(1:70), 'PARM' ,parm(1:70) , &
- 'RESTRT',restrt(1:70) , 'REFC' ,refc(1:70) , &
- 'MDVEL' ,mdvel(1:70) , 'MDFRC' ,mdfrc(1:70) , &
- 'MDEN' ,mden(1:70) , &
- 'MDCRD' ,mdcrd(1:70) , 'MDINFO' ,mdinfo(1:70), &
- 'MTMD' ,mtmd(1:70) , 'INPDIP', inpdip(1:70), &
- 'RSTDIP', rstdip(1:70), 'INPTRAJ', inptraj(1:70)
-# ifdef MPI
- write(6,9702) 'REMLOG', trim(remlog), &
- 'REMTYPE', trim(remtype), &
- 'REMSTRIP', trim(remstripcoord), &
- 'SAVEENE', trim(saveenefile), &
- 'CLUSTERINF', trim(clusterinfofile), &
- 'RESERVOIR', trim(reservoirname), &
- 'REMDDIM', trim(remd_dimension_file)
-# endif
-#ifdef RISMSANDER
- if(len_trim(xvvfile) > 0)&
- write(6,9701) 'Xvv',trim(xvvfile)
- if(len_trim(guvfile) > 0)&
- write(6,9701) 'Guv',trim(Guvfile)
- if(len_trim(huvfile) > 0)&
- write(6,9701) 'Huv',trim(Huvfile)
- if(len_trim(cuvfile) > 0)&
- write(6,9701) 'Cuv',trim(Cuvfile)
- if(len_trim(uuvfile) > 0)&
- write(6,9701) 'Uuv',trim(Uuvfile)
- if(len_trim(asympfile) > 0)&
- write(6,9701) 'Asymptotics',trim(asympfile)
- if(len_trim(quvfile) > 0)&
- write(6,9701) 'Quv',trim(Quvfile)
- if(len_trim(chgDistfile) > 0)&
- write(6,9701) 'ChgDist',trim(chgDistfile)
-#endif /*RISMSANDER*/
-
- ! Echo the input file to the user:
- call echoin(5,6)
- ! ----- READ DATA CHARACTERIZING THE MD-RUN -----
- read(5,'(a80)') title
- ! ----read input in namelist format, first setting up defaults
-
- dtemp = RETIRED_INPUT_OPTION
- dxm = RETIRED_INPUT_OPTION
- heat = RETIRED_INPUT_OPTION
- timlim = RETIRED_INPUT_OPTION
- irest = 0
- ibelly = 0
- ipol = RETIRED_INPUT_OPTION
- iesp = 0
- ntx = 1
- ntxo = NO_INPUT_VALUE
- ig = 71277
- tempi = ZERO
- ntb = NO_INPUT_VALUE
- ntt = 0
- nchain = 1
- temp0 = 300.0d0
-#ifdef LES
- ! alternate temp for LES copies, if negative then use single bath
- ! single bath not the same as 2 baths with same target T
- temp0les = -ONE
- rdt = ZERO
-#endif
- ipimd =0
- itimass = 0 ! Default = no TI w.r.t. mass.
- ineb =0
-
- tautp = ONE
- ntp = 0
- barostat = 1
- mcbarint = 100
- pres0 = ONE
- comp = 44.6d0
- taup = ONE
- npscal = 1
- nscm = 1000
- nstlim = 1
- t = ZERO
- dt = 0.001d0
- ntc = 1
- tol = 0.00001
- ntf = 1
- nsnb = 25
- cut = NO_INPUT_VALUE_FLOAT
- dielc = ONE
- ntpr = 50
- ntwr = 500
- ntwx = 0
- ntwv = 0
- ntwf = 0
- ntwe = 0
- ipb = 0
- inp = 2
-
-#ifdef RISMSANDER
- irism = 0
-#endif /*RISMSANDER*/
-
- ntave = 0
- ioutfm = 0
- ntr = 0
- ntrx = 1
- ivcap = 0
- natcap = 0
- fcap = 1.5d0
- cutcap = 0.0d0
- xcap = 0.0d0
- ycap = 0.0d0
- zcap = 0.0d0
- forth = 1.5d0
- xlorth = -1.0d0
- ylorth = -1.0d0
- zlorth = -1.0d0
- xorth = 47114711.0d0
- yorth = 47114711.0d0
- zorth = 47114711.0d0
- numexchg = 0
- repcrd = 1
- lj1264 = 0
-
- profile_mpi = 0 !whether to write profile_mpi timing file - default = 0 (NO).
-
- ! number of waters to keep for hybrid model,
- ! numwatkeep: the number of closest
- ! waters to keep. close is defined as close to non-water.
- ! for simulations with ions, ions should be stripped too
- ! or at least ignored in the "closest" calculation. this
- ! is not currently done.
-
- ! if it stays at -1 then we keep all waters
- ! 0 would mean to strip them all
-
- numwatkeep=-1
-
- ! hybridgb: gb model to use with hybrid REMD.
- hybridgb=0
-
- ! carlos targeted MD, like ntr
-
- itgtmd=0
- tgtrmsd=0.
- tgtmdfrc=0.
- tgtfitmask=''
- tgtrmsmask=''
-
- pencut = 0.1d0
- taumet = 0.0001d0
- omega = 500.0d0
- ipnlty = 1
- scalm = 100.0d0
- iscale = 0
- noeskp = 1
- nmropt = 0
- jar = 0
- tausw = 0.1d0
- imin = 0
- isftrp = 0
- rwell = ONE
- maxcyc = 1
- ncyc = 10
- ntmin = 1
- dx0 = 0.01d0
- drms = 1.0d-4
- vlimit = 20.0d0
- mxsub = 1
- jfastw = 0
- watnam = ' '
- owtnm = ' '
- hwtnm1 = ' '
- hwtnm2 = ' '
- ntwprt = 0
- igb = 0
- alpb = 0
- Arad = 15.0d0
- rgbmax = 25.d0
- saltcon = ZERO
-
- ! default offset depends on igb value, and users need to
- ! be able to modify it, so we need to set a dummy value. if it's still the
- ! dummy after we read the namelist, we set the default based on igb. if not,
- ! we leave it at what the user set.
- ! best solution would be to create a GB namelist.
- offset = -999999.d0
- gbneckscale = -999999.d0
-
- iyammp = 0
- imcdo = -1
- gbsa = 0
- vrand=1000
- surften = 0.005d0
- iwrap = 0
- nrespa = 1
- nrespai = 1
- irespa = 1
- gamma_ln = ZERO
- extdiel = 78.5d0
- intdiel = ONE
- gbgamma = ZERO
- gbbeta = ZERO
- gbalpha = ONE
-
- !Hai Nguyen: set default parameters for igb = 8
- ! NOTE THAT NONE OF THESE ARE USED UNLESS IGB=8, SO USERS SHOULD NOT EVEN SET
- ! THEM
- gbalphaH = 0.788440d0
- gbbetaH = 0.798699d0
- gbgammaH = 0.437334d0
- gbalphaC = 0.733756d0
- gbbetaC = 0.506378d0
- gbgammaC = 0.205844d0
- gbalphaN = 0.503364d0
- gbbetaN = 0.316828d0
- gbgammaN = 0.192915d0
- gbalphaOS = 0.867814d0
- gbbetaOS = 0.876635d0
- gbgammaOS = 0.387882d0
- gbalphaP = 1.0d0 !P parameters are not optimized yet
- gbbetaP = 0.8d0 !P parameters are not optimized yet
- gbgammaP = 4.85d0 !P parameters are not optimized yet
- !scaling parameters below will only be used for igb=8.
- ! the actual code does not use these variables, it uses X(l96)
- ! if igb=8, we will use these to set the X(l96) array.
- Sh = 1.425952d0
- Sc = 1.058554d0
- Sn = 0.733599d0
- So = 1.061039d0
- Ss = -0.703469d0
- Sp = 0.5d0 !P parameters are not optimized yet
- !End Hai Nguyen
-
- iconstreff = 0
- cut_inner = EIGHT
- icfe = 0
- clambda = ZERO
- klambda = 1
- ievb = 0
- rbornstat = 0
- idecomp = 0
- ! added a flag to control output of BDC/SDC synonymous with MMPBSA.py's
- ! version of the same variable.
- dec_verbose = 3
- lastrst = 1
- lastist = 1
- restraintmask=''
- restraint_wt = ZERO
- bellymask=''
- noshakemask=''
- iwrap_mask='' ! GMS: mask to wrap around if iwrap == 2
- crgmask=''
- mmtsb_switch = mmtsb_off ! MMTSB Replica Exchange Off by Default
- mmtsb_iterations = 100 ! MMTSB Replica Exchange Frequency in Iterations
-
- icnstph = 0
- solvph = SEVEN
- ntcnstph = 10
- ntrelax = 500 ! how long to let waters relax
- mccycles = 1 ! How many cycles of Monte Carlo steps to run
- skmin = 50 !used by neb calculation
- skmax = 100 !used by neb calculation
- vv = 0 !velocity verlet -- off if vv/=1
- vfac = 0 !velocity verlet scaling factor, 0 by default
- tmode = 1 !default tangent mode for NEB calculation
-
- ifqnt = NO_INPUT_VALUE
-
- ifcr = 0 ! no charge relocation
- cropt = 0 ! 1-4 EEL is calculated with the original charges
- crcut = 3.0
- crskin = 2.0
- crin = ''
- crprintcharges = 0
-
- ips = 0 ! no isotropic periodic sum
- raips=-1.0d0 ! automatically determined
- mipsx=-1 ! number of grids in x direction, <0 for automatically determined
- mipsy=-1 ! number of grids in y direction, <0 for automatically determined
- mipsz=-1 ! number of grids in z direction, <0 for automatically determined
- mipso=4 ! default 4th order b-spline
- gridips=2 ! grid size. used to determine grid number if not defined
- dvbips=1.0d-8 ! Volume change tolerance. aips will be done when change more than dvbips
-
- iamd = 0 ! No accelerated MD used
- iamdlag = 0 !frequency of boosting in steps
- EthreshD = 0.d0
- alphaD = 0.d0
- EthreshP = 0.d0
- alphaP = 0.d0
- w_amd = 0 ! windowed amd
- EthreshD_w = 0.d0
- alphaD_w = 0.d0
- EthreshP_w = 0.d0
- alphaP_w = 0.d0
-
- scaledMD = 0 ! No scaled MD used
- scaledMD_lambda = 0.d0
-
- iemap=0 ! no emap constraint
- gammamap=1 ! default friction constant for map motion, 1/ps
- isgld = 0 ! no self-guiding
- isgsta=1 ! Begining index of SGLD range
- isgend=0 ! Ending index of SGLD range
- fixcom=-1 ! fix center of mass in SGLD simulation
- tsgavg=0.2d0 ! Local averaging time of SGLD simulation
- sgft=-1.0d3 ! Guiding factor of SGLD simulation
- sgff=-1.0d3 ! Guiding factor of SGLD simulation
- sgfd=-1.0d3 ! Guiding factor of SGLD simulation
- tempsg=0.0d0 ! Guiding temperature of SGLD simulation
- treflf=0.0d0 ! Reference low frequency temperature of SGLD simulation
- tsgavp=2.0d0 ! Convergency time of SGLD simulation
-
- ! Check to see if "cntrl" namelist has been defined.
- mdin_cntrl=.false.
- mdin_qmmm = .false.
- mdin_ewald=.false.
- mdin_pb=.false.
-#ifdef APBS
- mdin_apbs = .false.
-#endif /* APBS */
- mdin_lmod=.false.
- mdin_amoeba=.false.
- mdin_sebomd=.false.
- iamoeba = 0
-#ifdef MPI /* SOFT CORE */
- scalpha=0.5
- scbeta=12.0
- sceeorder=2
- ifsc=0
- logdvdl=0
- dvdl_norest=0
- dynlmb=0.0
- ifmbar=0
- bar_intervall=100
- bar_l_min=0.1
- bar_l_max=0.9
- bar_l_incr=0.1
- tishake = 0
- emil_sc = 0
-#endif
- ilrt = 0
- lrt_interval = 50
- lrtmask=''
-#ifdef DSSP
- idssp = 0
-#endif
- emil_do_calc = 0
-
-! Constant Surface Tension
- csurften = 0 !constant surface tension off (valid options are 0,1,2,3)
- gamma_ten = 0.0d0 !0.0 dyne/cm - default used in charmm. Ignored for csurften=0
- ninterface = 2 !Number of interfaces in the surface tension (Must be greater than 2)
-
- call nmlsrc('cntrl',5,ifind)
- if (ifind /= 0) mdin_cntrl=.true.
-
- call nmlsrc('ewald',5,ifind)
- if (ifind /= 0) mdin_ewald=.true.
-
- call nmlsrc('pb',5,ifind)
- if (ifind /= 0) mdin_pb=.true.
-
- call nmlsrc('qmmm', 5, ifind)
- if (ifind /= 0) mdin_qmmm = .true.
-
-#ifdef APBS
- call nmlsrc('apbs',5,ifind)
- if (ifind /= 0) mdin_apbs=.true.
-#endif /* APBS */
-
- call nmlsrc('lmod',5,ifind)
- if (ifind /= 0) mdin_lmod=.true.
-
- call nmlsrc('amoeba',5,ifind)
- if (ifind /= 0) mdin_amoeba=.true.
-
- call nmlsrc('sebomd',5,ifind)
- if (ifind /= 0) mdin_sebomd=.true.
-
-#ifdef _XRAY
- call nmlsrc('xray',5,ifind)
- xray_active = (ifind /= 0)
-#endif
-
- rewind 5
- if ( mdin_cntrl ) then
- read(5,nml=cntrl,err=999)
- else
- write(6, '(1x,a,/)') 'Could not find cntrl namelist'
- call mexit(6,1)
- end if
-
- if ( igb == 10 .and. ipb == 0 ) ipb = 2
- if ( igb == 0 .and. ipb /= 0 ) igb = 10
-
- if (ifqnt == NO_INPUT_VALUE) then
- ifqnt = 0 ! default value
- if (mdin_qmmm) then
- write(6, '(1x,a,/)') &
- '| WARNING qmmm namelist found, but ifqnt was not set! QMMM NOT &
- &active.'
- end if
- end if
-
- ! Now that we've read the input file, set up the defaults for variables
- ! whose values depend on other input values (ntb, cut)
- if (ntb == NO_INPUT_VALUE) then
- if (ntp > 0) then
- ntb = 2
- else if (igb > 0) then
- ntb = 0
- else
- ntb = 1
- end if
- end if
-
- if (ntxo == NO_INPUT_VALUE) then
-#ifdef MPI
- if (rem < 0) then
- ntxo = 2
- else
- ntxo = 1
- end if
-#else
- ntxo = 1
-#endif
- end if
-
- if (cut == NO_INPUT_VALUE_FLOAT) then
- if (igb == 0) then
- cut = EIGHT
- else
- cut = 9999.d0
- end if
- end if
-
-#ifdef RISMSANDER
- !force igb=6 to get vacuum electrostatics. This must be done ASAP to ensure SANDER's
- !electrostatics are initialized properly
- rismprm%irism=irism
- if(irism/=0) then
- write(6,'(a)') "|3D-RISM Forcing igb=6"
- igb=6
- end if
-#endif /*RISMSANDER*/
-
-
- if (ifqnt>0) then
- qmmm_nml%ifqnt = .true.
- if (saltcon /= 0.0d0) then
- qm_gb%saltcon_on = .true.
- else
- qm_gb%saltcon_on = .false.
- end if
- if (alpb == 1) then
- qm_gb%alpb_on = .true.
- else
- qm_gb%alpb_on = .false.
- end if
- if (igb == 10 .or. ipb /= 0) then
- write(6, '(1x,a,/)') 'QMMM is not compatible with Poisson Boltzmann (igb=10 or ipb/=0).'
- call mexit(6,1)
- end if
- else
- qmmm_nml%ifqnt = .false.
- end if
-
- if ( mdin_lmod ) then
- rewind 5
- call read_lmod_namelist()
- end if
-
- !--------------------------------------------------------------------
- ! --- vars have been read ---
- !--------------------------------------------------------------------
-
- write(6,9309)
-
- ! emit warnings for retired cntrl namelist variables
-
- if ( dtemp /= RETIRED_INPUT_OPTION ) then
- write(6,'(/,a,/,a,/,a)') 'Warning: dtemp has been retired.', &
- ' Check the Retired Namelist Variables Appendix in the manual.'
- end if
- if ( dxm /= RETIRED_INPUT_OPTION ) then
- write(6,'(/,a,/,a,/,a)') 'Warning: dxm has been retired.', &
- ' Check the Retired Namelist Variables Appendix in the manual.'
- ! ' The step length will be unlimited.'
- end if
- if ( heat /= RETIRED_INPUT_OPTION ) then
- write(6,'(/,a,/,a,/,a)') 'Warning: heat has been retired.', &
- ' Check the Retired Namelist Variables Appendix in the manual.'
- end if
-
- if ( timlim /= RETIRED_INPUT_OPTION ) then
- write(6,'(/,a,/,a,/,a)') 'Warning: timlim has been retired.', &
- ' Check the Retired Namelist Variables Appendix in the manual.'
- end if
-
-! Constant surface tension valid options
- if (csurften > 0) then
- if (csurften < 0 .or. csurften > 3) then
- write(6,'(/2x,a)') &
- 'Invalid csurften value. csurften must be between 0 and 3'
- call mexit(6,1)
- end if
- if (ntb /= 2) then
- write(6,'(/2x,a)') &
- 'ntb invalid. ntb must be 2 for constant surface tension.'
- call mexit(6,1)
- end if
- if (ntp < 2) then
- write(6,'(/2x,a)') &
- 'ntp invalid. ntp must be 2 or 3 for constant surface tension.'
- call mexit(6,1)
- end if
- if (ninterface < 2) then
- write(6,'(/2x,a)') &
- 'ninterface must be greater than 2 for constant surface tension.'
- call mexit(6,1)
- end if
-
- if (iamoeba > 0 ) then
- write(6,'(/2x,a)') &
- 'Constant Surface Tension is not compatible with Amoeba Runs.'
- call mexit(6,1)
- end if
-
- if (ipimd > 0 ) then
- write(6,'(/2x,a)') &
- 'Constant Surface Tension is not compatible with PIMD Runs.'
- call mexit(6,1)
- end if
-
- end if
-
-! MC Barostat valid options. Some of these may work, but disable them until they
-! are fully tested.
-
- if (ntp > 0 .and. barostat == 2) then
- inerr = 0
- if (ievb /= 0) then
- write(6, '(/2x,a)') 'AMOEBA is not compatible with the MC Barostat'
- inerr = 1
- end if
- if (ipimd /= 0) then
- write(6, '(/2x,a)') 'PIMD is not compatible with the MC Barostat'
- inerr = 1
- end if
- if (icfe /= 0) then
- write(6, '(/2x,a)') 'TI is not compatible with the MC Barostat'
- inerr = 1
- end if
-#ifdef LES
- write(6, '(/2x,a)') 'LES is not compatible with the MC Barostat'
- inerr = 1
-#endif
- ! Any others? Hopefully most or all of the above can be made compatible.
- if (inerr == 1) &
- call mexit(6, 1)
- end if
-
- call printflags()
-
- !--------------------------------------------------------------------
- ! If user has requested ewald electrostatics, read some more input
- !--------------------------------------------------------------------
-
- if( igb == 0 .and. ipb == 0 ) call load_ewald_info(parm,inpcrd,ntp)
-
- !--------------------------------------------------------------------
- ! parameters for IPS and for SGLD:
- ! ips=1 3D IPS for electrostatic and Lennard-Jones potentials
- ! ips=2 3D IPS for electrostatic potential only
- ! ips=3 3D IPS for Lennard-Jones potential only
- ! ips=4 3D IPS/DFFT for electrostatic and Lennard-Jones potentials
- ! ips=5 3D IPS/DFFT for electrostatic potential only
- ! ips=6 3D IPS/DFFT for Lennard-Jones potential only
- !--------------------------------------------------------------------
-
- teips=.false.
- tvips=.false.
- teaips=.false.
- tvaips=.false.
- if((ips-4)*(ips-6) == 0 )tvaips =.true.
- if ( (ips-4)*(ips-5) == 0 )teaips =.true.
- if( tvaips.OR.( (ips -1)*(ips-3) == 0 ))tvips =.true.
- if( teaips.OR.((ips -1)*(ips-2) == 0 ))teips =.true.
- if( teips ) then
- use_pme = 0
- eedmeth = 6
- end if
- if( tvips ) then
- vdwmeth = 2
- if(use_pme/=0.and.tvaips)then
- mipsx=nfft1 ! number of grids in x direction, <0 for automatically determined
- mipsy=nfft2 ! number of grids in y direction, <0 for automatically determined
- mipsz=nfft3 ! number of grids in z direction, <0 for automatically determined
- mipso=order ! default 6th order b-spline
- endif
- end if
- temap=iemap>0
- ishake = 0
- if (ntc > 1) ishake = 1
-
- !--------------------------------------------------------------------
- ! Set up some parameters for AMD simulations:
- ! AMD initialization
- ! iamd=0 no boost is used, 1 boost on the total energy,
- ! 2 boost on the dohedrals, 3 boost on dihedrals and total energy
- !--------------------------------------------------------------------
- if(iamd.gt.0)then
- if(iamd.eq.1)then !only total potential energy will be boosted
- EthreshD=0.d0
- alphaD=0.d0
- else if(iamd.eq.2)then !only dihedral energy will be boosted
- EthreshP=0.d0
- alphaP=0.d0
- endif
- if(w_amd.gt.0)then
- if(iamd.eq.1)then !only total potential energy will be boosted
- EthreshD_w=0.d0
- alphaD_w=0.d0
- else if(iamd.eq.2)then !only dihedral energy will be boosted
- EthreshP_w=0.d0
- alphaP_w=0.d0
- endif
- write(6,'(a,i3)')'| Using Windowed Accelerated MD (wAMD) &
- &LOWERING BARRIERS to enhance sampling w_amd =', w_amd
- write(6,'(a,2f22.12)')'| AMD boost to total energy: EthreshP,alphaP',&
- EthreshP, alphaP
- write(6,'(a,2f22.12)')'| AMD boost to dihedrals: EthreshD,alphaD',&
- EthreshD,alphaD
- write(6,'(a,2f22.12)')'| AMD extra parameters boost to total energy: &
- &EthreshP_w,alphaP_w', EthreshP_w, alphaP_w
- write(6,'(a,2f22.12)')'| AMD extra parameters boost to dihedrals: &
- &EthreshD_w,alphaD_w', EthreshD_w, alphaD_w
- else
- write(6,'(a,i3)')'| Using Accelerated MD (AMD) RASING VALLEYS to &
- &enhance sampling iamd =',iamd
- write(6,'(a,2f22.12)')'| AMD boost to total energy: EthreshP,alphaP', &
- EthreshP, alphaP
- write(6,'(a,2f22.12)')'| AMD boost to dihedrals: EthreshD,alphaD', &
- EthreshD, alphaD
- endif
- endif
-
-
- !--------------------------------------------------------------------
- ! Set up some parameters for scaledMD simulations:
- ! scaledMD initialization
- ! scaledMD=0 no scaling is used, 1 scale the potential energy
- !--------------------------------------------------------------------
- if(scaledMD.gt.0)then
- write(6,'(a,i3)')'| Using Scaled MD to enhance sampling scaledMD =',&
- scaledMD
- write(6,'(a,f22.12)')'| scaledMD scaling factor lambda: ',scaledMD_lambda
- endif
-
-
-
-
- !--------------------------------------------------------------------
- ! Set up some parameters for GB simulations:
- !--------------------------------------------------------------------
- !Hai Nguyen: update offset = 0.09d0 for igb /= 8
- !I add this step because I want to use different offset value as default value
- !for igb = 8
-
- if ( igb == 8 ) then
- if (offset == -999999.d0) then
- offset = 0.195141d0 !set to default for igb=8
- end if
- if (gbneckscale == -999999.d0) then
- gbneckscale = 0.826836d0
- end if
- else
- ! not igb=8, use old defaults
- if (offset == -999999.d0) then
- offset = 0.09d0
- end if
- if (gbneckscale == -999999.d0) then
- gbneckscale = 0.361825d0
- end if
- endif
-
- if( igb == 2 .or. hybridgb == 2 ) then
- ! --- use our best guesses for Onufriev/Case GB (GB^OBC I)
-
- gbgamma = 2.90912499999d0 ! (the "99999" to force roundoff on print)
- gbbeta = ZERO
- gbalpha = 0.8d0
- end if
-
- if( igb == 5 .or. hybridgb == 5 ) then
-
- ! --- use our second best guesses for Onufriev/Case GB (GB^OBC II)
-
- gbgamma = 4.850d0
- gbbeta = 0.8d0
- gbalpha = ONE
- end if
-
- if( igb == 7 ) then
-
- ! --- use parameters for Mongan et al. CFA GBNECK
-
- gbgamma = 2.50798245d0
- gbbeta = 1.90792938d0
- gbalpha = 1.09511284d0
- end if
-
- !--------------------------------------------------------------------
- ! If user has requested PB electrostatics, read some more input
- !--------------------------------------------------------------------
-
- if ( igb == 10 .or. ipb /= 0 ) then
-#ifdef MPI
- write(6,'(a)') "PBSA currently doesn't work with MPI inside SANDER."
- call mexit(6,1)
-#endif /*MPI*/
- call pb_read
- end if
-
-#ifdef APBS
- if ( mdin_apbs ) then
- call apbs_read
- end if
-#endif /* APBS */
-
-#ifdef _XRAY
- call xray_read_mdin(mdin_lun=5)
-#endif
-
- call sebomd_namelist_default
- if (mdin_sebomd) then
- rewind 5
- call read_sebomd_namelist
- endif
-
- if( iamoeba == 1 ) then
- if( mdin_amoeba ) then
- call AMOEBA_read_mdin(5)
- else
- write(6,*) ' iamoeba is set but the &amoeba namelist was not found'
- call mexit(6,1)
- end if
- end if
-
- ! -------------------------------------------------------------------
- ! If the user has requested NMR restraints, do a cursory read of the
- ! restraints file(s) now to determine the amount of memory necessary
- ! for these restraints:
- ! -------------------------------------------------------------------
-
- if (jar == 1 ) nmropt = 1
- intreq = 0
- irlreq = 0
- if (nmropt > 0) then
- mxgrp = 0
- itotst = 1
-
- ! Set ITOTST to 0 if IMIN equals 1 (i.e. if minimization, not dynamics)
- ! This will cause any "time-averaged" requests to be over-ridden.
-
- if (imin == 1) then
- itotst = 0
- end if
- ! CALL AMOPEN(31,NMR,'O','F','R')
- call restlx(5,itotst,mxgrp,dt,6,ierr)
- ! CLOSE(31)
- end if
-
- ! -------------------------------------------------------------------
- ! If EMIL was requested, make sure it was compiled in, and validate.
- ! -------------------------------------------------------------------
- if( emil_do_calc .gt. 0 ) then
-#ifdef EMIL
- if( ntc .ne. 1 ) then
- write (6, '(a,a)') error_hdr, 'emil_do_calc == 1,'
- write (6, '(a)') ' and ntc != 1.'
- write (6, '(a)') ' Current thinking is that SHAKE and '
- write (6, '(a)') ' EMIL do not mix well, consider setting ntc = 1, ntf = 1,'
- write (6, '(a)') ' and dt = 0.001.'
- call mexit(6,1)
- end if
-#else
- write (6, '(a,a)') error_hdr, 'emil_do_calc = 1,'
- write (6, '(a)') ' but AMBER was compiled with EMIL switched out.'
- write (6, '(a)') ' Run $AMBERHOME/configure --help for more info.'
- call mexit(6,1)
-#endif
- end if
-
-
- ! Set the definition of the water molecule. The default definition is in
- ! WATDEF(4).
-
- read(watdef(1),'(A4)') iwtnm
- read(watdef(2),'(A4)') iowtnm
- read(watdef(3),'(A4)') ihwtnm(1)
- read(watdef(4),'(A4)') ihwtnm(2)
- if (watnam /= ' ') read(watnam,'(A4)') iwtnm
- if (owtnm /= ' ') read(owtnm, '(A4)') iowtnm
- if (hwtnm1 /= ' ') read(hwtnm1,'(A4)') ihwtnm(1)
- if (hwtnm2 /= ' ') read(hwtnm2,'(A4)') ihwtnm(2)
-
-#if !defined(DISABLE_NCSU) && defined(MPI)
- call ncsu_on_mdread1()
-#endif
-
- return
- 999 continue ! bad cntrl read
- write(6,*) 'error in reading namelist cntrl'
- call mexit(6,1)
-
- ! --- input file polar opts read err trapping:
-
- 9308 format(/10x,55('-'),/10x, &
- 'Amber 14 SANDER 2014', &
- /10x,55('-')/)
- 9309 format(/80('-')/' 1. RESOURCE USE: ',/80('-')/)
- 9700 format(/,'File Assignments:',/,15('|',a6,': ',a,/))
- 9701 format('|',a6,': ',a)
- 9702 format(7('|',a10,': ',a,/))
-end subroutine mdread1
-#endif /*ifndef PBSA*/
-
-#ifndef PBSA
-!======================================================================
-! MDREAD2
-!======================================================================
-
-!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-!+ Initialize to defaults and print the inputable variables.
-subroutine mdread2(x,ix,ih,ipairs)
-
- use molecule, only: n_iwrap_mask_atoms, iwrap_mask_atoms
- use lmod_driver, only : LMOD_NTMIN_LMOD, LMOD_NTMIN_XMIN, write_lmod_namelist
- use decomp, only : jgroup, indx, irespw
- use findmask
- use qmmm_module, only : qmmm_nml,qmmm_struct, qm2_struct, qm2_rij_eqns, qm_gb, qmmm_vsolv
- use qmmm_vsolv_module, only : print
- use constants, only : ZERO, ONE, TWO
- use parms, only: req
- use nbips, only: ips
- use amd_mod, only: iamd,iamdlag,EthreshD,alphaD,EthreshP,alphaP, &
- w_amd,EthreshD_w,alphaD_w,EthreshP_w,alphaP_w
- use scaledMD_mod, only: scaledMD
- use nblist, only: a,b,c,alpha,beta,gamma,nbflag,skinnb,sphere,nbtell,cutoffnb
- use amoeba_mdin, only : iamoeba,beeman_integrator
- use amoeba_runmd, only : AM_RUNMD_get_coords
- use nose_hoover_module, only: nchain ! APJ
- use pimd_vars, only: ipimd, itimass
- use neb_vars, only: last_neb_atom, ineb
- use cmd_vars, only: restart_cmd, eq_cmd, adiab_param
- use constantph, only: cnstphread, cnstph_zero, cph_igb, mccycles
- use file_io_dat
- use sander_lib, only: upper
-
- use emap,only: temap,emap_options
-
- use qmmm_module, only: get_atomic_number
-
- use sebomd_module, only: sebomd_obj, sebomd_write_info, sebomd_write_options
-
-#ifdef APBS
- use apbs
-#endif /* APBS */
-#ifdef EMIL
- use emil_mod, only : emil_do_calc
- use mdin_emil_dat_mod, only : error_hdr, init_emil_dat
-#endif /* EMIL */
-#ifdef _XRAY
- use xray_interface_module, only: xray_write_options
-#endif /* _XRAY */
-#if defined(LES) && defined(MPI)
- use evb_pimd, only: evb_pimd_init
-#endif /* LES && MPI */
-#ifdef MPI /* SOFT CORE */
- use softcore, only : ifsc, scmask, scalpha, scbeta, dvdl_norest, &
- sceeorder, logdvdl, dynlmb, tishake
- use mbar, only : ifmbar, bar_intervall, bar_l_min, bar_l_max, bar_l_incr
-! REMD
- use remd, only : rem, rremd
-#endif
- use crg_reloc, only: ifcr, cropt, crcut, crskin, crprintcharges
- use linear_response, only: ilrt, lrt_interval, lrtmask
-! SGLD
- use sgld, only : isgld
-
- implicit none
- _REAL_ x(*)
-# include "../include/memory.h"
- integer ix(lasti),ipairs(*)
- character(len=4) ih(*)
- integer nbond
- integer atom1,atom2
- integer ntmp
- logical belly,konst
- character(len=1) atsymb,atsymb2
- character(len=2) atype
- integer atomicnumber, hybridization
- integer ngrp,inerr,nr,iaci,ir,i,mxresat,j
- integer noshakegp( natom ), natnos
- integer iwrap_maskgp( natom ) , ier
- logical errFlag
- integer crggp( natom )
- _REAL_ dummy,rvdw,dcharge,emtmd
- logical newstyle
-
-#ifdef MPI
- ! =========================== AMBER/MPI ===========================
-#ifdef MPI_DOUBLE_PRECISION
-# undef MPI_DOUBLE_PRECISION
-#endif
- include 'mpif.h'
-# include "parallel.h"
- integer ist(MPI_STATUS_SIZE), partner, ierr, nbonh_c, num_noshake_c
- integer nquant_c, noshake_overlap_c
-#ifdef CRAY_PVP
-# define MPI_DOUBLE_PRECISION MPI_REAL8
-#endif
- ! ========================= END AMBER/MPI =========================
-#endif
-# include "../include/md.h"
-# include "box.h"
-# include "mmtsb.h"
-# include "nmr.h"
-# include "extra_pts.h"
-# include "ew_cntrl.h"
-# include "ew_pme_recip.h"
-# include "ew_erfc_spline.h"
-# include "ew_mpole.h"
-# include "ew_legal.h"
-# include "def_time.h"
-# include "tgtmd.h"
-# include "multitmd.h"
-#ifdef LES
-# include "les.h"
-#endif
-
- ! -------------------------------------------------------------------
- ! --- set up resat array, containing string identifying
- ! residue for each atom
- ! -------------------------------------------------------------------
-
- mxresat = min( natom, matom )
- ir = 0
- do i=1,mxresat
- if (i >= ix(ir+i02)) ir=ir+1
- write(resat(i),'(a4,1x,a4,i4)') ih(m04+i-1), &
- ih(ir+m02-1),ir
- ! ---null terminator:
- resat(i)(14:14) = char(0)
- end do
- close(unit=8)
-
- ! -------------------------------------------------------------------
- ! ----- SET THE DEFAULT VALUES FOR SOME VARIABLES -----
- ! -------------------------------------------------------------------
-
- nrp = natom
-
- if (ifbox == 1) write(6, '(/5x,''BOX TYPE: RECTILINEAR'')')
- if (ifbox == 2) write(6, '(/5x,''BOX TYPE: TRUNCATED OCTAHEDRON'')')
- if (ifbox == 3) write(6, '(/5x,''BOX TYPE: GENERAL'')')
-
- ! For 0< ipimd <= 3, no removal of COM motion
- if (ipimd>0.and.ipimd<=3) then
- nscm = 0
- ndfmin = 0
- endif
-
- if (ntr.eq.1) &
- nscm = 0
-
- nsolut = nrp
- if ( nscm > 0 .and. ntb == 0 ) then
- ndfmin = 6 ! both translation and rotation com motion removed
- if (nsolut == 1) ndfmin = 3
- if (nsolut == 2) ndfmin = 5
- else if ( nscm > 0 ) then
- ndfmin = 3 ! just translation com will be removed
- else
- ndfmin = 0
- end if
- if (ibelly > 0) then ! No COM Motion Removal, ever.
- nscm = 0
- ndfmin = 0
-
- !Do not allow ntt=3 with ibelly=1 - this does not make sense and will cause
- !issues.
- if (ntt==3) then
- call sander_bomb("mdread2","ibelly=1 with ntt=3 is not a valid option.", &
- "Either use a different thermostat or avoid using ibelly.")
- end if
- end if
- if(nscm <= 0) nscm = 0
- if(gamma_ln > 0.0d0)ndfmin=0 ! No COM motion removal for LD simulation
- if(ntt == 4)ndfmin=0 ! No COM motion removal for Nose'-Hoover simulation
- init = 3
- if (irest > 0) init = 4
- if (dielc <= ZERO ) dielc = ONE
- if (tautp <= ZERO ) tautp = 0.2d0
- if (taup <= ZERO ) taup = 0.2d0
-
- ! ----- RESET THE CAP IF NEEDED -----
-
- ! ivcap == 0: Cap will be in effect if it is in the prmtop file (ifcap = 1)
-
- if(ivcap == 1) then
- ! Cap will be in effect even if not in prmtop file
- ! requires additional information in sander.in file as in the case of ivcap == 3, 4, or 5
- ifcap = 2
- else if(ivcap == 2) then
- ! Inactivate cap
- ifcap = 0
- else if(ivcap == 3) then
- ! Sphere -> not yet implemented
- ifcap = 3
- else if(ivcap == 4) then
- ! Orthorhombus
- ifcap = 4
- else if(ivcap == 5) then
- ! Shell of waters around solute
- ifcap = 5
- end if
-
- !Support for random seed using time of day in microsecs
- if( ig==-1 ) then
- !Turn on NO_NTT3_SYNC when ig=-1. This means the code no
- !longer synchronized the random numbers between streams when
- !running in parallel giving better scaling.
- no_ntt3_sync = 1
- call microsec(ig)
-#ifdef MPI
- write (6, '(a,i8,a)') "Note: ig = -1. Setting random seed to ", ig ," based on wallclock &
- &time in microseconds"
- write (6, '(a)') " and disabling the synchronization of random &
- &numbers between tasks"
- write (6, '(a)') " to improve performance."
-#else
- write (6, '(a,i8,a)') "Note: ig = -1. Setting random seed to ", ig ," based on wallclock &
- &time in microseconds."
-#endif
- end if
-
-#ifdef MPI
- !For some runs using multisander where the coordinates of the two 'replicas' need to be identical,
- !for example TI, it is critical that the random number stream is synchronized between all replicas.
- !Only use the IG value from worldrank=0. Ok to broadcast between the various sander masters since
- !they all call mdread2.
- !Also needs to be synchronized for adaptive QM/MM (qmmm_nml%vsolv > 1)
- if ( (icfe > 0) .or. (qmmm_nml%vsolv > 1) ) then
- ! no_ntt3_sync currently does not work with softcore TI simulations
- ! see sc_lngdyn in softcore.F90
- ! AWG: I think I also need to set no_ntt3_sync=0 ???
- if ( (ifsc > 0) .or. (qmmm_nml%vsolv > 1) ) no_ntt3_sync = 0
- call mpi_bcast(ig, 1, MPI_INTEGER, 0, commmaster, ierr)
- end if
-#endif
-
- ! -------------------------------------------------------------------
- ! ----- PRINT DATA CHARACTERIZING THE RUN -----
- ! -------------------------------------------------------------------
-
- nr = nrp
- write(6,9328)
- write(6,9008) title
- write(6,'(/a)') 'General flags:'
- write(6,'(5x,2(a,i8))') 'imin =',imin,', nmropt =',nmropt
-
- ! Error Checking for REMD
-#ifdef MPI
- if (rem/=0) then
- ! Make sure that the number of replicas is even so
- ! that they all have partners in the exchange step
- if (mod(numgroup,2).ne.0) then
- write (6,'(a)') "==================================="
- write (6,'(a)') "REMD requires an even # of replicas"
- write (6,'(a)') "==================================="
- call mexit (6,1)
- endif
-
- write(6,'(/a)') 'Replica exchange'
- write(6,'(5x,4(a,i8))') 'numexchg=',numexchg,', rem=',rem
-
- ! REPCRD option temporarily disabled
- if (repcrd == 0) write(6,'(a)') &
- "REMD WARNING: repcrd disabled. Only replica &
- &trajectories/output can be written."
-
- ! Check for correct number of exchanges
- if (numexchg <= 0) then
- write(6,'(a)') "REMD ERROR: numexchg must be > 0, "
- call mexit(6,1)
- endif
-
- ! RXSGLD
- if (isgld > 0 .and. rem < 0) then
- write(6, '(a)') 'Multi-D REMD and replica-exchange SGLD are not &
- &supported yet!'
- call mexit(6, 1)
- end if
-
- ! Hybrid GB
- if (numwatkeep >= 0) then
- write(6,'(5x,4(a,i8))') 'numwatkeep=',numwatkeep,', hybridgb=',hybridgb
- ! Check that user specified GB model for hybrid REMD
- if (hybridgb /= 2 .and. hybridgb /= 5 .and. hybridgb /= 1) then
- write(6,'(a)') "HYBRID REMD ERROR: hybridgb must be 1, 2, or 5."
- call mexit(6,1)
- endif
- else
- !Check that user did not specify GB model if no hybrid run.
- if (hybridgb /= 0) then
- write(6,'(a)') &
- "HYBRID REMD ERROR: numwatkeep must be >= 0 when hybridgb is set."
- call mexit(6,1)
- endif
- endif
- ! RREMD
- if (rremd>0) then
- write(6,'(5x,4(a,i8))') "rremd=",rremd
- endif
-
- ! ntp > 0 not allowed for remd
- if (ntp > 0) then
- write(6,'(a,i1)') "ERROR: ntp > 0 not allowed for rem > 0, ntp=", ntp
- call mexit(6,1)
- endif
-
- ! M-REMD (rem < 0) requires netcdf output.
- if (rem < 0 .and. ioutfm .ne. 1) then
- write(6,'(a)') "ERROR: Multi-D REMD (rem < 0) requires NetCDF &
- &trajectories (ioutfm=1)"
- call mexit(6,1)
- endif
-
-# ifdef LES
- ! DAN ROE: Temporarily disable LES REMD until it is verified with new
- ! REMD code
- if (rem==2) then
- write (6,*) "******* LES REM (rem==2) temporarily disabled. Stop. *******"
- call mexit(6,1)
- endif
-
- if (rem==2 .and. igb/=1) then
- write (6,*) ' partial REM (rem=2) only works with igb=1'
- call mexit(6,1)
- endif
-# else
- if (rem==2) then
- write(6,*) '******* For rem ==2, partial REM'
- write(6,*) 'use sander.LES with topology created by addles'
- call mexit(6,1)
- endif
-# endif
-
- endif ! rem>0
-
-#else /* _NO_ MPI */
- ! Check if user set numexchg with no MPI
- if (numexchg>0) write(6,'(a)') &
- "WARNING: numexchg > 0 - for REMD run please recompile sander for &
- ¶llel runs."
-
- ! Check if user set numwatkeep or hybridgb with no MPI - not sensible.
- if (numwatkeep>=0) write(6,'(a)') &
- "WARNING: numwatkeep >= 0 - for hybrid REMD run please recompile &
- &sander for parallel runs."
-
- if (hybridgb>0) write(6,'(a)') &
- "WARNING: hybridgb > 0 - for hybrid REMD run please recompile &
- &sander for parallel runs."
-#endif /* MPI */
- ! End error checking for REMD
-
- write(6,'(/a)') 'Nature and format of input:'
- write(6,'(5x,4(a,i8))') 'ntx =',ntx,', irest =',irest, &
- ', ntrx =',ntrx
-
- write(6,'(/a)') 'Nature and format of output:'
- write(6,'(5x,4(a,i8))') 'ntxo =',ntxo,', ntpr =',ntpr, &
- ', ntrx =',ntrx,', ntwr =',ntwr
- write(6,'(5x,5(a,i8))') 'iwrap =',iwrap,', ntwx =',ntwx, &
- ', ntwv =',ntwv,', ntwe =',ntwe
- write(6,'(5x,3(a,i8),a,i7)') 'ioutfm =',ioutfm, &
- ', ntwprt =',ntwprt, &
- ', idecomp =',idecomp,', rbornstat=',rbornstat
- if (ntwf > 0) &
- write(6,'(5x, a,i8)') 'ntwf =',ntwf
- write(6,'(/a)') 'Potential function:'
- write(6,'(5x,5(a,i8))') 'ntf =',ntf,', ntb =',ntb, &
- ', igb =',igb,', nsnb =',nsnb
- write(6,'(5x,3(a,i8))') 'ipol =',ipol,', gbsa =',gbsa, &
- ', iesp =',iesp
- write(6,'(5x,3(a,f10.5))') 'dielc =',dielc, &
- ', cut =',cut,', intdiel =',intdiel
-
- ! charge relocation
- if ( ifcr /= 0 ) then
- write(6,'(/a)') 'Charge relocation:'
- write(6,'(5x,2(a,i8))') 'cropt =', cropt, &
- ', crprintcharges=', crprintcharges
- write(6,'(5x,2(a,f10.5))') 'crcut =', crcut, ', crskin =', crskin
- end if
-
- if (( igb /= 0 .and. igb /= 10 .and. ipb == 0 .and. igb /= 8) &
- .or.hybridgb>0.or.icnstph>1) then
- write(6,'(5x,3(a,f10.5))') 'saltcon =',saltcon, &
- ', offset =',offset,', gbalpha= ',gbalpha
- write(6,'(5x,3(a,f10.5))') 'gbbeta =',gbbeta, &
- ', gbgamma =',gbgamma,', surften =',surften
- write(6,'(5x,3(a,f10.5))') 'rdt =',rdt, ', rgbmax =',rgbmax, &
- ' extdiel =',extdiel
- write(6,'(5x,3(a,i8))') 'alpb = ',alpb
- end if
-
- !Hai Nguyen: print output for igb=8
- if ( igb == 8 ) then
- write(6,'(5x,3(a,f10.5))') 'saltcon =',saltcon, &
- ', offset =',offset,', surften =',surften
- write(6,'(5x,3(a,f10.5))') 'rdt =',rdt, ', rgbmax =',rgbmax, &
- ' extdiel =',extdiel
- write(6,'(5x,3(a,i8))') 'alpb = ',alpb
- write(6,'(5x,3(a,f10.5))') 'gbalphaH =',gbalphaH, &
- ', gbbetaH =',gbbetaH,', gbgammaH = ',gbgammaH
- write(6,'(5x,3(a,f10.5))') 'gbalphaC =',gbalphaC, &
- ', gbbetaC =',gbbetaC,', gbgammaC = ',gbgammaC
- write(6,'(5x,3(a,f10.5))') 'gbalphaN =',gbalphaN, &
- ', gbbetaN =',gbbetaN,', gbgammaN = ',gbgammaN
- write(6,'(5x,3(a,f10.5))') 'gbalphaOS =',gbalphaOS, &
- ', gbbetaOS =',gbbetaOS,', gbgammaOS = ',gbgammaOS
- write(6,'(5x,3(a,f10.5))') 'gbalphaP =',gbalphaP, &
- ', gbbetaP =',gbbetaP,', gbgammaP = ',gbgammaP
- end if
-
-
- if( alpb /= 0 ) then
- write(6,'(5x,3(a,f10.5))') 'Arad =', Arad
- end if
-
- write(6,'(/a)') 'Frozen or restrained atoms:'
- write(6,'(5x,4(a,i8))') 'ibelly =',ibelly,', ntr =',ntr
- if( ntr == 1 ) write(6,'(5x,a,f10.5)') 'restraint_wt =', restraint_wt
-
- if( imin /= 0 ) then
- if( ipimd > 0 ) then
- write(6,'(/a)') 'pimd cannot be used in energy minimization'
- stop
- end if
-
- write(6,'(/a)') 'Energy minimization:'
- ! print inputable variables applicable to all minimization methods.
- write(6,'(5x,4(a,i8))') 'maxcyc =',maxcyc,', ncyc =',ncyc, &
- ', ntmin =',ntmin
- write(6,'(5x,2(a,f10.5))') 'dx0 =',dx0, ', drms =',drms
-
- ! Input flag ntmin determines the method of minimization
- select case ( ntmin )
- case ( 0, 1, 2 )
- ! no specific output
- case ( LMOD_NTMIN_XMIN, LMOD_NTMIN_LMOD )
- call write_lmod_namelist( )
- case default
- ! invalid ntmin
- write(6,'(/2x,a,i3,a)') 'Error: Invalid NTMIN (',ntmin,').'
- stop
- end select
- else
- write(6,'(/a)') 'Molecular dynamics:'
- write(6,'(5x,4(a,i10))') 'nstlim =',nstlim,', nscm =',nscm, &
- ', nrespa =',nrespa
- write(6,'(5x,3(a,f10.5))') 't =',t, &
- ', dt =',dt,', vlimit =',vlimit
-
- if ( ntt == 0 .and. tempi > 0.0d0 .and. irest == 0 ) then
- write(6,'(/a)') 'Initial temperature generation:'
- write(6,'(5x,a,i8)') 'ig =',ig
- write(6,'(5x,a,f10.5)') 'tempi =',tempi
- else if( ntt == 1 ) then
- write(6,'(/a)') 'Berendsen (weak-coupling) temperature regulation:'
- write(6,'(5x,3(a,f10.5))') 'temp0 =',temp0, &
- ', tempi =',tempi,', tautp =', tautp
-#ifdef LES
- write(6,'(5x,3(a,f10.5))') 'temp0LES =',temp0les
-#endif
- else if( ntt == 2 ) then
- write(6,'(/a)') 'Anderson (strong collision) temperature regulation:'
- write(6,'(5x,4(a,i8))') 'ig =',ig, ', vrand =',vrand
- write(6,'(5x,3(a,f10.5))') 'temp0 =',temp0, ', tempi =',tempi
- else if( ntt == 3 ) then
- write(6,'(/a)') 'Langevin dynamics temperature regulation:'
- write(6,'(5x,4(a,i8))') 'ig =',ig
- write(6,'(5x,3(a,f10.5))') 'temp0 =',temp0, &
- ', tempi =',tempi,', gamma_ln=', gamma_ln
- else if( ntt == 4 ) then
- write(6,'(/a)') 'Nose-Hoover chains'
- write(6,'(5x,(a,f10.5))') 'gamma_ln=', gamma_ln
- write(6,'(5x,(a,i8))') 'number of oscillators=', nchain
- else if( ntt == 5 ) then ! APJ
- write(6,'(/a)') 'Nose-Hoover chains Langevin' ! APJ
- write(6,'(5x,4(a,i8))') 'ig =',ig ! APJ
- write(6,'(5x,(a,f10.5))') 'gamma_ln=', gamma_ln ! APJ
- write(6,'(5x,(a,i8))') 'number of oscillators=', nchain ! APJ
- else if( ntt == 6 ) then ! APJ
- write(6,'(/a)') 'Adaptive Langevin temperature regulation:' ! APJ
- write(6,'(5x,4(a,i8))') 'ig =',ig ! APJ
- write(6,'(5x,3(a,f10.5))') 'temp0 =',temp0, & ! APJ
- ', tempi =',tempi,', gamma_ln=', gamma_ln ! APJ
- else if( ntt == 7 ) then ! APJ
- write(6,'(/a)') 'Adaptive Nose-Hoover chains' ! APJ
- write(6,'(5x,(a,f10.5))') 'gamma_ln=', gamma_ln ! APJ
- write(6,'(5x,(a,i8))') 'number of oscillators=', nchain ! APJ
- else if( ntt == 8 ) then ! APJ
- write(6,'(/a)') 'Adaptive Nose-Hoover chains Langevin' ! APJ
- write(6,'(5x,4(a,i8))') 'ig =',ig ! APJ
- write(6,'(5x,(a,f10.5))') 'gamma_ln=', gamma_ln ! APJ
- write(6,'(5x,(a,i8))') 'number of oscillators=', nchain ! APJ
- end if
-
- if( ntp /= 0 ) then
- write(6,'(/a)') 'Pressure regulation:'
- write(6,'(5x,4(a,i8))') 'ntp =',ntp
- write(6,'(5x,3(a,f10.5))') 'pres0 =',pres0, &
- ', comp =',comp,', taup =',taup
- if (barostat == 2) then
- write(6, '(5x,a)') 'Monte-Carlo Barostat:'
- write(6, '(5x,a,i8)') 'mcbarint =', mcbarint
- end if
- end if
-
- if (csurften /= 0) then
- write(6,'(/a)') 'Constant surface tension:'
- write(6,'(5x,a,i8)') 'csurften =', csurften
- write(6,'(5x,a,f10.5,a,i8)') 'gamma_ten =', gamma_ten, ' ninterface =', ninterface
- end if
-
- end if
-
- if( ntc /= 1 ) then
- write(6,'(/a)') 'SHAKE:'
- write(6,'(5x,4(a,i8))') 'ntc =',ntc,', jfastw =',jfastw
- write(6,'(5x,3(a,f10.5))') 'tol =',tol
- end if
-
- if( ifcap == 1 .or. ifcap == 2 .or. ifcap == 3 ) then
- write(6,'(/a)') 'Water cap:'
- write(6,'(5x,2(a,i8))') 'ivcap =',ivcap,', natcap =',natcap
- write(6,'(5x,2(a,f10.5))') 'fcap =',fcap, ', cutcap =',cutcap
- write(6,'(5x,3(a,f10.5))') 'xcap =',xcap, ', ycap =',ycap, &
- ', zcap =',zcap
- else if( ifcap == 4 ) then
- write(6,'(/a)') 'Orthorhombus:'
- write(6,'(5x,1(a,i8))') 'ivcap =',ivcap
- write(6,'(5x,1(a,f10.5))') 'forth =',forth
- write(6,'(5x,3(a,f10.5))') 'xlorth =',xlorth,', ylorth =',ylorth, &
- ', zlorth =',zlorth
- write(6,'(5x,3(a,f10.5))') 'xorth =',xorth, ', yorth =',yorth, &
- ', zorth =',zorth
- else if( ifcap == 5 ) then
- write(6,'(/a)') 'Water shell:'
- write(6,'(5x,(a,i8,a,f10.5))') 'ivcap =',ivcap,', cutcap =',cutcap
- endif
-
- if( nmropt > 0 ) then
- write(6,'(/a)') 'NMR refinement options:'
- write(6,'(5x,4(a,i8))')'iscale =',iscale,', noeskp =',noeskp, &
- ', ipnlty =',ipnlty,', mxsub =',mxsub
- write(6,'(5x,3(a,f10.5))') 'scalm =',scalm, &
- ', pencut =',pencut,', tausw =',tausw
- end if
-
- if( numextra > 0 ) then
- write(6,'(/a)') 'Extra-points options:'
- write(6,'(5x,4(a,i8))') 'frameon =',frameon, &
- ', chngmask=',chngmask
- end if
-
- if( ipol > 0 ) then
- write(6,'(/a)') 'Polarizable options:'
- write(6,'(5x,4(a,i8))') 'indmeth =',indmeth, &
- ', maxiter =',maxiter,', irstdip =',irstdip, &
- ', scaldip =',scaldip
- write(6,'(5x,3(a,f10.5))') &
- 'diptau =',diptau,', dipmass =',dipmass
- if ( ipol > 1 ) then
- write(6,'(5x,3(a,f10.5))') &
- 'Default Thole coefficient = ',dipdamp
- end if
- end if
-
-#ifdef MPI /* SOFT CORE */
- if( icfe /= 0 .or. ifsc/=0) then
- write(6,'(/a)') 'Free energy options:'
- write(6,'(5x,a,i8,a,i8,a,i8)') 'icfe =', icfe , ', ifsc =', ifsc, ', klambda =', klambda
- write(6,'(5x,a,f8.4,a,f8.4,a,f8.4)') 'clambda =', clambda, ', scalpha =', scalpha, ', scbeta =', scbeta
- write(6,'(5x,a,i8,a,i8)') 'sceeorder =', sceeorder, ' dvdl_norest =', dvdl_norest
- write(6,'(5x,a,f8.4,a,i8)') 'dynlmb =', dynlmb, ' logdvdl =', logdvdl
- end if
- if ( ifmbar /= 0 ) then
- write (6,'(/a)') 'FEP MBAR options:'
- write(6,'(5x,a,i8,a,i8)') 'ifmbar =', ifmbar, ', bar_intervall = ', bar_intervall
- write(6,'(5x,a,f6.4,a,f6.4,a,f6.4)') 'bar_l_min =', bar_l_min, ', bar_l_max =', bar_l_max, ', bar_l_incr =', bar_l_incr
- end if
-#endif
-
- if (ilrt /= 0) then
- write (6,*)
- write (6,'(a,i4,a,i4)') ' Linear Response Theory: ilrt =', ilrt, ' lrt_interval =', lrt_interval
- write (6,*)
- end if
-
- ! Options for TI w.r.t. mass.
- select case (itimass)
- case (0) ! Default: no TI wrt. mass.
- case (1,2) ! 1 = use virial est., 2 = use thermodynamic est.
- write(6,'(/a)') 'Isotope effects (thermodynamic integration w.r.t. mass):'
- write(6,'(5x,4(a,i8))') 'itimass =',itimass
- write(6,'(5x,3(a,f10.5))') 'clambda =',clambda
- if (icfe /= 0) then
- write(6,'(/2x,a,i2,a,i2,a)') 'Error: Cannot do TI w.r.t. both potential (icfe =', &
- icfe, ') and mass (itimass =', itimass, ').'
- stop
- endif
- if (ipimd == 0) then
- write(6,'(/2x,a)') 'Error (IPIMD=0): TI w.r.t. mass requires a PIMD run.'
- stop
- endif
- case default ! Invalid itimass
- write(6,'(/2x,a,i2,a)') 'Error: Invalid ITIMASS (', itimass, ' ).'
- stop
- end select
-
-!KFW
-! call mpi_bcast ( ievb, 1, MPI_INTEGER, 0, commworld, ierr )
-! call mpi_barrier ( commworld, ierr )
-
-! if( ievb == 1 ) then
-!KFW write(6,'(/a)') 'EVB options:'
-!KFW write(6,'(5x,3(a,f10.5))') 'V11 =',v11,', V22 =', v22, &
-!KFW ', V12 =', v12
-!kfw write(6,'(5x,3(a,f10.5))') 'kevb =',kevb,', evbt =', evbt
-! end if
-
- if( itgtmd == 1 ) then
- write(6,'(/a)') 'Targeted molecular dynamics:'
- write(6,'(5x,3(a,f10.5))') 'tgtrmsd =',tgtrmsd, &
- ', tgtmdfrc=',tgtmdfrc
- end if
-
- if( icnstph /= 0) then
- write(6, '(/a)') 'Constant pH options:'
- if ( icnstph .ne. 1 ) &
- write(6, '(5x,a,i8)') 'icnstph =', icnstph
- write(6, '(5x,a,i8)') 'ntcnstph =', ntcnstph
- write(6, '(5x,a,f10.5)') 'solvph =', solvph
- if ( icnstph .ne. 1 ) &
- write(6,'(5x,2(a,i8))') 'ntrelax =', ntrelax, ' mccycles =', mccycles
- end if
- if( icnstph /= 2) then
- ntrelax = 0 ! needed for proper behavior of timing
- end if
-
- if( ntb > 0 ) then
- write(6,'(/a)') 'Ewald parameters:'
- write(6,'(5x,4(a,i8))') 'verbose =',verbose, &
- ', ew_type =',ew_type,', nbflag =',nbflag, &
- ', use_pme =',use_pme
- write(6,'(5x,4(a,i8))') 'vdwmeth =',vdwmeth, &
- ', eedmeth =',eedmeth,', netfrc =',netfrc
- write(6, 9002) a, b, c
- write(6, 9003) alpha, beta, gamma
- write(6, 9004) nfft1, nfft2, nfft3
- write(6, 9006) cutoffnb, dsum_tol
- write(6, 9007) ew_coeff
- write(6, 9005) order
- 9002 format (5x,'Box X =',f9.3,3x,'Box Y =',f9.3,3x,'Box Z =',f9.3)
- 9003 format (5x,'Alpha =',f9.3,3x,'Beta =',f9.3,3x,'Gamma =',f9.3)
- 9004 format (5x,'NFFT1 =',i5 ,7x,'NFFT2 =',i5 ,7x,'NFFT3 =',i5)
- 9005 format (5x,'Interpolation order =',i5)
- 9006 format (5x,'Cutoff=',f9.3,3x,'Tol =',e9.3)
- 9007 format (5x,'Ewald Coefficient =',f9.5)
- end if
-
- if( mmtsb_switch /= mmtsb_off ) then
- call mmtsb_print_banner()
- call mmtsb_init( temp0, clambda )
- end if
-
-!---- QMMM Options ----
-
- if( qmmm_nml%ifqnt ) then
- write(6, '(/a)') 'QMMM options:'
- write(6, '(5x," ifqnt = True nquant = ",i8)') &
- qmmm_struct%nquant
- write(6, '(5x," qmgb = ",i8," qmcharge = ",i8," adjust_q = ",i8)') &
- qmmm_nml%qmgb, qmmm_nml%qmcharge, qmmm_nml%adjust_q
- write(6, '(5x," spin = ",i8," qmcut = ",f8.4, " qmshake = ",i8)') qmmm_nml%spin, &
- qmmm_nml%qmcut, qmmm_nml%qmshake
- write(6, '(5x," qmmm_int = ",i8)') qmmm_nml%qmmm_int
- write(6, '(5x,"lnk_atomic_no = ",i8," lnk_dis = ",f8.4," lnk_method = ",i8)') &
- qmmm_nml%lnk_atomic_no,qmmm_nml%lnk_dis, qmmm_nml%lnk_method
- if ( qmmm_nml%qmtheory%PM3 ) then
- write(6, '(5x," qm_theory = PM3")',ADVANCE='NO')
- else if ( qmmm_nml%qmtheory%AM1 ) then
- write(6, '(5x," qm_theory = AM1")',ADVANCE='NO')
- else if ( qmmm_nml%qmtheory%AM1D ) then
- write(6, '(5x," qm_theory = AM1/d")',ADVANCE='NO')
- else if ( qmmm_nml%qmtheory%MNDO ) then
- write(6, '(5x," qm_theory = MNDO")',ADVANCE='NO')
- else if ( qmmm_nml%qmtheory%MNDOD ) then
- write(6, '(5x," qm_theory = MNDO/d")',ADVANCE='NO')
- else if ( qmmm_nml%qmtheory%PDDGPM3 ) then
- write(6, '(5x," qm_theory = PDDGPM3")',ADVANCE='NO')
- else if ( qmmm_nml%qmtheory%PDDGMNDO ) then
- write(6, '(5x," qm_theory =PDDGMNDO")',ADVANCE='NO')
- else if ( qmmm_nml%qmtheory%PM3CARB1 ) then
- write(6, '(5x," qm_theory =PM3CARB1")',ADVANCE='NO')
- else if ( qmmm_nml%qmtheory%DFTB ) then
- write(6, '(5x," qm_theory = DFTB")',ADVANCE='NO')
- else if ( qmmm_nml%qmtheory%RM1 ) then
- write(6, '(5x," qm_theory = RM1")',ADVANCE='NO')
- else if ( qmmm_nml%qmtheory%PDDGPM3_08 ) then
- write(6, '(5x," qm_theory = PDDGPM3_08")',ADVANCE='NO')
- else if ( qmmm_nml%qmtheory%PM6 ) then
- write(6, '(5x," qm_theory = PM6")',ADVANCE='NO')
- else if ( qmmm_nml%qmtheory%PM3ZNB ) then
- write(6, '(5x," qm_theory = PM3/ZnB")',ADVANCE='NO')
- else if ( qmmm_nml%qmtheory%PM3MAIS ) then
- write(6, '(5x," qm_theory = PM3-MAIS")',ADVANCE='NO')
- else if ( qmmm_nml%qmtheory%EXTERN ) then
- write(6, '(5x," qm_theory = EXTERN")',ADVANCE='NO')
- else
- write(6, '(5x," qm_theory = UNKNOWN!")',ADVANCE='NO')
- end if
- write (6, '(" verbosity = ",i8)') qmmm_nml%verbosity
- if (qmmm_nml%qmqm_analyt) then
- write(6, '(5x," qmqmdx = Analytical")')
- else
- write(6, '(5x," qmqmdx = Numerical")')
- end if
- !AWG: if EXTERN in use, skip printing of options that do not apply
- EXTERN: if ( .not. qmmm_nml%qmtheory%EXTERN ) then
- if (qmmm_nml%tight_p_conv) then
- write(6, '(5x," tight_p_conv = True (converge density to SCFCRT)")')
- else
- write(6, '(5x," tight_p_conv = False (converge density to 0.05xSqrt[SCFCRT])")')
- end if
- write(6, '(5x," scfconv = ",e9.3," itrmax = ",i8)') qmmm_nml%scfconv, qmmm_nml%itrmax
- if (qmmm_nml%printcharges) then
- write(6, '(5x," printcharges = True ")',ADVANCE='NO')
- else
- write(6, '(5x," printcharges = False")',ADVANCE='NO')
- end if
- select case (qmmm_nml%printdipole)
- case (1)
- write(6, '(5x," printdipole = QM ")',ADVANCE='NO')
- case (2)
- write(6, '(5x," printdipole = QM+MM")',ADVANCE='NO')
- case default
- write(6, '(5x," printdipole = False")',ADVANCE='NO')
- end select
- if (qmmm_nml%peptide_corr) then
- write(6, '(5x," peptide_corr = True")')
- else
- write(6, '(5x," peptide_corr = False")')
- end if
- if (qmmm_nml%qmmmrij_incore) then
- write(6, '(4x,"qmmmrij_incore = True ")')
- else
- write(6, '(4x,"qmmmrij_incore = False")')
- end if
- if (qmmm_nml%qmqm_erep_incore) then
- write(6, '(2x,"qmqm_erep_incore = True ")')
- else
- write(6, '(2x,"qmqm_erep_incore = False")')
- end if
- if (qmmm_nml%allow_pseudo_diag) then
- write(6, '(7x,"pseudo_diag = True ")',ADVANCE='NO')
- write(6, '("pseudo_diag_criteria = ",f8.4)') qmmm_nml%pseudo_diag_criteria
- else
- write(6, '(7x,"pseudo_diag = False")')
- end if
- write(6, '(6x,"diag_routine = ",i8)') qmmm_nml%diag_routine
- end if EXTERN
- !If ntb=0 or use_pme =0 then we can't do qm_ewald so overide what the user may
- !have put in the namelist and set the value to false.
- if (qmmm_nml%qm_ewald>0) then
- if (qmmm_nml%qm_pme) then
- write(6, '(10x,"qm_ewald = ",i8, " qm_pme = True ")') qmmm_nml%qm_ewald
- else
- write(6, '(10x,"qm_ewald = ",i8, " qm_pme = False ")') qmmm_nml%qm_ewald
- end if
- write(6, '(10x," kmaxqx = ",i4," kmaxqy = ",i4," kmaxqz = ",i4," ksqmaxq = ",i4)') &
- qmmm_nml%kmaxqx, qmmm_nml%kmaxqy, qmmm_nml%kmaxqz, qmmm_nml%ksqmaxq
- else
- write(6, '(10x,"qm_ewald = ",i8, " qm_pme = False ")') qmmm_nml%qm_ewald
- end if
- !Print the fock matrix prediction params if it is in use.
- if (qmmm_nml%fock_predict>0) then
- write(6, '(6x,"fock_predict = ",i4)') qmmm_nml%fock_predict
- write(6, '(6x," fockp_d1 = ",f8.4," fockp_d2 = ",f8.4)') qmmm_nml%fockp_d1, qmmm_nml%fockp_d2
- write(6, '(6x," fockp_d2 = ",f8.4," fockp_d4 = ",f8.4)') qmmm_nml%fockp_d3, qmmm_nml%fockp_d4
- end if
-
- if (qmmm_nml%qmmm_switch) then
- write(6, '(7x,"qmmm_switch = True",3x,"r_switch_lo =",f8.4,3x,"r_switch_hi =",f8.4)') &
- & qmmm_nml%r_switch_lo, qmmm_nml%r_switch_hi
- !else
- ! write(6, '(7x,"qmmm_switch = False")')
- end if
-
- if (qmmm_nml%printdipole==2) then
- write(6, '("|",2x,"INFO: To compute MM dipole WAT residues will be stripped")')
- end if
- end if
-
- if (qmmm_nml%vsolv > 0) then
- call print(qmmm_vsolv)
- end if
-
-!---- SEBOMD options ----
-
- if (sebomd_obj%do_sebomd) then
- call sebomd_write_info()
- call sebomd_write_options()
- endif
-
-#ifdef _XRAY
-!---- XRAY Options ----
- call xray_write_options()
-#endif
-
-! ----EMAP Options-----
- if(temap)call emap_options(5)
-! ---------------------
-
-#ifdef EMIL
-! ----EMIL Options-----
- if(emil_do_calc.gt.0)call init_emil_dat(5, 6)
-! ---------------------
-#endif
-
-
-#ifdef MPI
-! --- MPI TIMING OPTIONS ---
- write(6, '(/a)') '| MPI Timing options:'
- write(6, '("|",5x," profile_mpi = ",i8)') profile_mpi
-! Sanity check for profile_mpi
- call int_legal_range('profile_mpi',profile_mpi,0,1)
-! --------------------------
-#endif
-
- cut = cut*cut
- cut_inner = cut_inner*cut_inner
-
- !------------------------------------------------------------------------
- ! If user has requested generalized born electrostatics, set up variables
- !------------------------------------------------------------------------
-
- if( igb == 0 .and. gbsa > 0 ) then
- write(0,*) 'GB/SA calculation is performed only when igb>0'
- call mexit( 6,1 )
- end if
- if( gbsa == 2 .and. &
- ((imin == 0 .and. nstlim > 1) .or. &
- (imin == 1 .and. maxcyc > 1)) ) then
- write(0,*) 'GBSA=2 only works for single point energy calc'
- call mexit( 6,1 )
- end if
-#ifdef APBS
- if( igb /= 0 .and. igb /= 10 .and. ipb == 0 .and. .not. mdin_apbs) then
-#else
- if (( igb /= 0 .and. igb /= 10 .and. ipb == 0 ).or.hybridgb>0.or.icnstph>1) then
-#endif /* APBS */
-#ifdef LES
- write(6,*) 'igb=1,5,7 are working with LES, no SA term included'
-#endif
- ! igb7 uses special S_x screening params.
- ! overwrite the tinker values read from the prmtop
- if (igb == 7) then
- do i=1,natom
- if(ix(i100) .eq. 1) then
- atomicnumber = ix(i100+i)
- else
- call get_atomic_number(ih(m04+i-1), x(lmass+i-1), &
- atomicnumber, errFlag)
-#ifdef LES
- if(errFlag) then
- call get_atomic_number(ih(m04+i-1), &
- x(lmass+i-1)*lesfac((lestyp(i)-1)*nlesty+lestyp(i)), &
- atomicnumber, errFlag)
- end if
-#endif
- end if
-
- if (atomicnumber .eq. 6) then
- x(l96+i-1) = 4.84353823306d-1
- else if (atomicnumber .eq. 1) then
- x(l96+i-1) = 1.09085413633d0
- else if (atomicnumber .eq. 7) then
- x(l96+i-1) = 7.00147318409d-1
- else if (atomicnumber .eq. 8) then
- x(l96+i-1) = 1.06557401132d0
- else if (atomicnumber .eq. 16) then
- x(l96+i-1) = 6.02256336067d-1
- else if (atomicnumber .eq. 15) then
- x(l96+i-1) = 5d-1
- else
- x(l96+i-1) = 5d-1
- end if
- end do
- end if
-
- ! Hai Nguyen: changing S_x screening params for igb = 8
- ! overwrite the tinker values read from the prmtop
-
- if (igb == 8) then
- do i=1,natom
- if (ix(i100) .eq. 1) then
- atomicnumber = ix(i100+i)
- else
- call get_atomic_number(ih(m04+i-1), x(lmass+i-1), &
- atomicnumber, errFlag)
-#ifdef LES
- if(errFlag) then
- call get_atomic_number(ih(m04+i-1), &
- x(lmass+i-1)*lesfac((lestyp(i)-1)*nlesty+lestyp(i)), &
- atomicnumber, errFlag)
- end if
-#endif
- end if
-
- if (atomicnumber .eq. 6) then
- x(l96+i-1) = Sc
- else if (atomicnumber .eq. 1) then
- x(l96+i-1) = Sh
- else if (atomicnumber .eq. 7) then
- x(l96+i-1) = Sn
- else if (atomicnumber .eq. 8) then
- x(l96+i-1) = So
- else if (atomicnumber .eq. 16) then
- x(l96+i-1) = Ss
- else if (atomicnumber .eq. 15) then
- x(l96+i-1) = Sp ! Hai Nguyen: We still don't have an optimized Sp parameter
- else
- !for atom type Cl,Br,...
- !These parameters are also not optimized.
- x(l96+i-1) = 5d-1
- end if
- end do
- end if
-
-
- ! Hai Nguyen: set up for igb == 2, 5, 7, 8
- ! Put gb parameters in arrays
- if ( igb == 2 .or. igb == 5 .or. igb == 7 .or. &
- hybridgb == 2 .or. hybridgb == 5) then
- do i=1,natom
- x(l2402+i-1) = gbalpha
- x(l2403+i-1) = gbbeta
- x(l2404+i-1) = gbgamma
- end do
- end if
-
- !Hai Nguyen: IGB = 8
- if ( igb == 8 ) then
- do i=1,natom
- if (ix(i100) .eq. 1) then
- atomicnumber = ix(i100+i)
- else
- call get_atomic_number(ih(m04+i-1), x(lmass+i-1), &
- atomicnumber, errFlag)
-#ifdef LES
- if(errFlag) then
- call get_atomic_number(ih(m04+i-1), &
- x(lmass+i-1)*lesfac((lestyp(i)-1)*nlesty+lestyp(i)), &
- atomicnumber, errFlag)
- end if
-#endif
- end if
-
- if (atomicnumber .eq. 1) then
- x(l2402+i-1) = gbalphaH
- x(l2403+i-1) = gbbetaH
- x(l2404+i-1) = gbgammaH
- else if (atomicnumber .eq. 6) then
- x(l2402+i-1) = gbalphaC
- x(l2403+i-1) = gbbetaC
- x(l2404+i-1) = gbgammaC
- else if (atomicnumber .eq. 7) then
- x(l2402+i-1) = gbalphaN
- x(l2403+i-1) = gbbetaN
- x(l2404+i-1) = gbgammaN
- else if (atomicnumber .eq. 8) then
- x(l2402+i-1) = gbalphaOS
- x(l2403+i-1) = gbbetaOS
- x(l2404+i-1) = gbgammaOS
- else if (atomicnumber .eq. 16) then
- x(l2402+i-1) = gbalphaOS
- x(l2403+i-1) = gbbetaOS
- x(l2404+i-1) = gbgammaOS
- else if (atomicnumber .eq. 15) then
- x(l2402+i-1) = gbalphaP
- x(l2403+i-1) = gbbetaP
- x(l2404+i-1) = gbgammaP
- else
- !use GBOBC set for other atom types
- x(l2402+i-1) = 1.0d0
- x(l2403+i-1) = 0.8d0
- x(l2404+i-1) = 4.85d0
- end if
- end do
- end if ! end Hai Nguyen section
-
- ! put fs(i)*(rborn(i) - offset) into the "fs" array
-
- fsmax = 0.d0
- do i=1,natom
- x(l96-1+i) = x(l96-1+i)*( x(l97-1+i) - offset )
- fsmax = max( fsmax, x(l96-1+i) )
- if (rbornstat == 1) then
- x(l186-1+i) = 0.d0
- x(l187-1+i) = 999.d0
- x(l188-1+i) = 0.d0
- x(l189-1+i) = 0.d0
- end if
- end do
-
- ! ---------------------------------------------------------------------
- ! ---get Debye-Huckel kappa (A**-1) from salt concentration (M), assuming:
- ! T = 298.15, epsext=78.5,
-
- kappa = sqrt( 0.10806d0 * saltcon )
-
- ! ---scale kappa by 0.73 to account(?) for lack of ion exclusions:
-
- kappa = 0.73d0* kappa
-
- !Set kappa for qmmm if needed
- qm_gb%kappa = kappa
- ! ---------------------------------------------------------------------
-
- if ( gbsa == 1 ) then
-
- ! --- assign parameters for calculating SASA according to the
- ! LCPO method ---
-
- do i=1,natom
- ix(i80+i-1)=0
- end do
-
- ! --- get the number of bonded neighbors for each atom:
-
- do i=1,nbona
- atom1=ix(iiba+i-1)/3+1
- atom2=ix(ijba+i-1)/3+1
- ix(i80+atom1-1)=ix(i80+atom1-1)+1
- ix(i80+atom2-1)=ix(i80+atom2-1)+1
- end do
-
- do i=1,natom
- ix(i80-i)=ix(i80+i-1)
- end do
-
- do i=1,nbonh
- atom1=ix(iibh+i-1)/3+1
- atom2=ix(ijbh+i-1)/3+1
- ix(i80-atom1)=ix(i80-atom1)+1
- ix(i80-atom2)=ix(i80-atom2)+1
- end do
-
-
- ! --- construct parameters for SA calculation; note that the
- ! radii stored in L165 are augmented by 1.4 Ang.
-
- do i=1,natom
- write(atype,'(a2)') ih(m06+i-1)
- call upper(atype)
- if (ix(i100) .eq. 1) then
- atomicnumber = ix(i100+i)
- else
- call get_atomic_number(ih(m04+i-1), x(lmass+i-1), &
- atomicnumber, errFlag)
-#ifdef LES
- if(errFlag) then
- call get_atomic_number(ih(m04+i-1), &
- x(lmass+i-1)*lesfac((lestyp(i)-1)*nlesty+lestyp(i)), &
- atomicnumber, errFlag)
- end if
-#endif
- end if
- hybridization = ix(i80-i)
- nbond=ix(i80+i-1)
- if (atomicnumber .eq. 6) then
- if (hybridization .eq. 4) then
- if (nbond == 1) then
- x(l165-1+i) = 1.70d0 + 1.4d0
- x(l170-1+i) = 0.77887d0
- x(l175-1+i) = -0.28063d0
- x(l180-1+i) = -0.0012968d0
- x(l185-1+i) = 0.00039328d0
- else if (nbond == 2) then
- x(l165-1+i) = 1.70d0 + 1.4d0
- x(l170-1+i) = 0.56482d0
- x(l175-1+i) = -0.19608d0
- x(l180-1+i) = -0.0010219d0
- x(l185-1+i) = 0.0002658d0
- else if (nbond == 3) then
- x(l165-1+i) = 1.70d0 + 1.4d0
- x(l170-1+i) = 0.23348d0
- x(l175-1+i) = -0.072627d0
- x(l180-1+i) = -0.00020079d0
- x(l185-1+i) = 0.00007967d0
- else if (nbond == 4) then
- x(l165-1+i) = 1.70d0 + 1.4d0
- x(l170-1+i) = 0.00000d0
- x(l175-1+i) = 0.00000d0
- x(l180-1+i) = 0.00000d0
- x(l185-1+i) = 0.00000d0
- else
- write(6,*) 'Unusual nbond for CT:', i, nbond, &
- ' Using default carbon LCPO parameters'
- x(l165-1+i) = 1.70d0 + 1.4d0
- x(l170-1+i) = 0.77887d0
- x(l175-1+i) = -0.28063d0
- x(l180-1+i) = -0.0012968d0
- x(l185-1+i) = 0.00039328d0
- end if
- else
- if (nbond == 2) then
- x(l165-1+i) = 1.70d0 + 1.4d0
- x(l170-1+i) = 0.51245d0
- x(l175-1+i) = -0.15966d0
- x(l180-1+i) = -0.00019781d0
- x(l185-1+i) = 0.00016392d0
- else if (nbond == 3) then
- x(l165-1+i) = 1.70d0 + 1.4d0
- x(l170-1+i) = 0.070344d0
- x(l175-1+i) = -0.019015d0
- x(l180-1+i) = -0.000022009d0
- x(l185-1+i) = 0.000016875d0
- else
- write(6,*) 'Unusual nbond for C :', i, nbond, &
- ' Using default carbon LCPO parameters'
- x(l165-1+i) = 1.70d0 + 1.4d0
- x(l170-1+i) = 0.77887d0
- x(l175-1+i) = -0.28063d0
- x(l180-1+i) = -0.0012968d0
- x(l185-1+i) = 0.00039328d0
- end if
- end if
- else if (atomicnumber .eq. 8) then
- if (atype == 'O ') then
- x(l165-1+i) = 1.60d0 + 1.4d0
- x(l170-1+i) = 0.68563d0
- x(l175-1+i) = -0.1868d0
- x(l180-1+i) = -0.00135573d0
- x(l185-1+i) = 0.00023743d0
- else if (atype == 'O2') then
- x(l165-1+i) = 1.60d0 + 1.4d0
- x(l170-1+i) = 0.88857d0
- x(l175-1+i) = -0.33421d0
- x(l180-1+i) = -0.0018683d0
- x(l185-1+i) = 0.00049372d0
- else
- if (nbond == 1) then
- x(l165-1+i) = 1.60d0 + 1.4d0
- x(l170-1+i) = 0.77914d0
- x(l175-1+i) = -0.25262d0
- x(l180-1+i) = -0.0016056d0
- x(l185-1+i) = 0.00035071d0
- else if (nbond == 2) then
- x(l165-1+i) = 1.60d0 + 1.4d0
- x(l170-1+i) = 0.49392d0
- x(l175-1+i) = -0.16038d0
- x(l180-1+i) = -0.00015512d0
- x(l185-1+i) = 0.00016453d0
- else
- write(6,*) 'Unusual nbond for O:', i, nbond, &
- ' Using default oxygen LCPO parameters'
- x(l165-1+i) = 1.60d0 + 1.4d0
- x(l170-1+i) = 0.77914d0
- x(l175-1+i) = -0.25262d0
- x(l180-1+i) = -0.0016056d0
- x(l185-1+i) = 0.00035071d0
- end if
- end if
- else if(atomicnumber .eq. 7) then
- if (atype == 'N3') then
- if (nbond == 1) then
- x(l165-1+i) = 1.65d0 + 1.4d0
- x(l170-1+i) = 0.078602d0
- x(l175-1+i) = -0.29198d0
- x(l180-1+i) = -0.0006537d0
- x(l185-1+i) = 0.00036247d0
- else if (nbond == 2) then
- x(l165-1+i) = 1.65d0 + 1.4d0
- x(l170-1+i) = 0.22599d0
- x(l175-1+i) = -0.036648d0
- x(l180-1+i) = -0.0012297d0
- x(l185-1+i) = 0.000080038d0
- else if (nbond == 3) then
- x(l165-1+i) = 1.65d0 + 1.4d0
- x(l170-1+i) = 0.051481d0
- x(l175-1+i) = -0.012603d0
- x(l180-1+i) = -0.00032006d0
- x(l185-1+i) = 0.000024774d0
- else
- write(6,*) 'Unusual nbond for N3:', i, nbond, &
- ' Using default nitrogen LCPO parameters'
- x(l165-1+i) = 1.65d0 + 1.4d0
- x(l170-1+i) = 0.078602d0
- x(l175-1+i) = -0.29198d0
- x(l180-1+i) = -0.0006537d0
- x(l185-1+i) = 0.00036247d0
- end if
- else
- if (nbond == 1) then
- x(l165-1+i) = 1.65d0 + 1.4d0
- x(l170-1+i) = 0.73511d0
- x(l175-1+i) = -0.22116d0
- x(l180-1+i) = -0.00089148d0
- x(l185-1+i) = 0.0002523d0
- else if (nbond == 2) then
- x(l165-1+i) = 1.65d0 + 1.4d0
- x(l170-1+i) = 0.41102d0
- x(l175-1+i) = -0.12254d0
- x(l180-1+i) = -0.000075448d0
- x(l185-1+i) = 0.00011804d0
- else if (nbond == 3) then
- x(l165-1+i) = 1.65d0 + 1.4d0
- x(l170-1+i) = 0.062577d0
- x(l175-1+i) = -0.017874d0
- x(l180-1+i) = -0.00008312d0
- x(l185-1+i) = 0.000019849d0
- else
- write(6,*) 'Unusual nbond for N:', i, nbond, &
- ' Using default nitrogen LCPO parameters'
- x(l165-1+i) = 1.65d0 + 1.4d0
- x(l170-1+i) = 0.078602d0
- x(l175-1+i) = -0.29198d0
- x(l180-1+i) = -0.0006537d0
- x(l185-1+i) = 0.00036247d0
- end if
- end if
- else if(atomicnumber .eq. 16) then
- if (atype == 'SH') then
- x(l165-1+i) = 1.90d0 + 1.4d0
- x(l170-1+i) = 0.7722d0
- x(l175-1+i) = -0.26393d0
- x(l180-1+i) = 0.0010629d0
- x(l185-1+i) = 0.0002179d0
- else
- x(l165-1+i) = 1.90d0 + 1.4d0
- x(l170-1+i) = 0.54581d0
- x(l175-1+i) = -0.19477d0
- x(l180-1+i) = -0.0012873d0
- x(l185-1+i) = 0.00029247d0
- end if
- else if (atomicnumber .eq. 15) then
- if (nbond == 3) then
- x(l165-1+i) = 1.90d0 + 1.4d0
- x(l170-1+i) = 0.3865d0
- x(l175-1+i) = -0.18249d0
- x(l180-1+i) = -0.0036598d0
- x(l185-1+i) = 0.0004264d0
- else if (nbond == 4) then
- x(l165-1+i) = 1.90d0 + 1.4d0
- x(l170-1+i) = 0.03873d0
- x(l175-1+i) = -0.0089339d0
- x(l180-1+i) = 0.0000083582d0
- x(l185-1+i) = 0.0000030381d0
- else
- write(6,*) 'Unusual nbond for P:', i, nbond, &
- ' Using default phosphorus LCPO parameters'
- x(l165-1+i) = 1.90d0 + 1.4d0
- x(l170-1+i) = 0.3865d0
- x(l175-1+i) = -0.18249d0
- x(l180-1+i) = -0.0036598d0
- x(l185-1+i) = 0.0004264d0
- end if
- else if (atype(1:1) == 'Z') then
- x(l165-1+i) = 0.00000d0 + 1.4d0
- x(l170-1+i) = 0.00000d0
- x(l175-1+i) = 0.00000d0
- x(l180-1+i) = 0.00000d0
- x(l185-1+i) = 0.00000d0
- else if (atomicnumber .eq. 1) then
- x(l165-1+i) = 0.00000d0 + 1.4d0
- x(l170-1+i) = 0.00000d0
- x(l175-1+i) = 0.00000d0
- x(l180-1+i) = 0.00000d0
- x(l185-1+i) = 0.00000d0
- else if (atype == 'MG') then
- ! Mg radius = 0.99A: ref. 21 in J. Chem. Phys. 1997, 107, 5422
- ! Mg radius = 1.18A: ref. 30 in J. Chem. Phys. 1997, 107, 5422
- ! Mg radius = 1.45A: Aqvist 1992
- x(l165-1+i) = 1.18d0 + 1.4d0
- ! The following values were taken from O.sp3 with two bonded
- ! neighbors -> O has the smallest van der Waals radius
- ! compared to all other elements which had been parametrized
- x(l170-1+i) = 0.49392d0
- x(l175-1+i) = -0.16038d0
- x(l180-1+i) = -0.00015512d0
- x(l185-1+i) = 0.00016453d0
- else if (atype == 'F') then
- x(l165-1+i) = 1.47d0 + 1.4d0
- x(l170-1+i) = 0.68563d0
- x(l175-1+i) = -0.1868d0
- x(l180-1+i) = -0.00135573d0
- x(l185-1+i) = 0.00023743d0
- else
- ! write( 0,* ) 'bad atom type: ',atype
- ! call mexit( 6,1 )
- x(l165-1+i) = 1.70 + 1.4;
- x(l170-1+i) = 0.51245;
- x(l175-1+i) = -0.15966;
- x(l180-1+i) = -0.00019781;
- x(l185-1+i) = 0.00016392;
- write(6,'(a,a)') 'Using carbon SA parms for atom type', atype
- end if
- end do ! i=1,natom
- !
- else if ( gbsa == 2 ) then
-
- ! --- assign parameters for calculating SASA according to the
- ! ICOSA method; the radii are augmented by 1.4 A ---
-
- do i=1,natom
- write(atype,'(a2)') ih(m06+i-1)
- if(ix(i100) .eq. 1) then
- atomicnumber = ix(i100+i)
- else
- call get_atomic_number(ih(m04+i-1), x(lmass+i-1), &
- atomicnumber, errFlag)
-#ifdef LES
- if(errFlag) then
- call get_atomic_number(ih(m04+i-1), &
- x(lmass+i-1)*lesfac((lestyp(i)-1)*nlesty+lestyp(i)), &
- atomicnumber, errFlag)
- end if
-#endif
- end if
- if (atomicnumber .eq. 7) then
- x(L165-1+i) = 1.55d0 + 1.4d0
- else if (atomicnumber .eq. 6) then
- x(L165-1+i) = 1.70d0 + 1.4d0
- else if (atomicnumber .eq. 1) then
- x(L165-1+i) = 1.20d0 + 1.4d0
- else if (atomicnumber .eq. 8) then
- x(L165-1+i) = 1.50d0 + 1.4d0
- else if (atomicnumber .eq. 15) then
- x(L165-1+i) = 1.80d0 + 1.4d0
- else if (atomicnumber .eq. 16) then
- x(L165-1+i) = 1.80d0 + 1.4d0
- else if (atomicnumber .eq. 17) then
- ! Cl radius
- x(L165-1+i) = 1.70d0 + 1.4d0
- else if (atomicnumber .eq. 9) then
- ! F radius
- x(L165-1+i) = 1.50d0 + 1.4d0
- else if (atomicnumber .eq. 35) then
- ! Br radius
- ! Bondi, J. Phys. Chem. 1964, 68, 441.
- x(L165-1+i) = 1.85d0 + 1.4d0
- else if (atomicnumber .eq. 20) then
- ! Ca radius
- ! Calculated from Aqvist, J. Phys. Chem. 1990, 94, 8021.
- x(L165-1+i) = 1.33d0 + 1.4d0
- else if (atomicnumber .eq. 11) then
- ! Na radius
- ! Calculated from Aqvist, J. Phys. Chem. 1990, 94, 8021.
- x(L165-1+i) = 1.87d0 + 1.4d0
- else if (atomicnumber .eq. 30) then
- ! Zn radius
- ! Hoops, Anderson, Merz, JACS 1991, 113, 8262.
- x(L165-1+i) = 1.10d0 + 1.4d0
- else if (atomicnumber .eq. 12) then
- ! Mg radius = 0.99A: ref. 21 in J. Chem. Phys. 1997, 107, 5422
- ! Mg radius = 1.18A: ref. 30 in J. Chem. Phys. 1997, 107, 5422
- ! Mg radius = 1.45A: Aqvist 1992
- x(L165-1+i) = 1.18d0 + 1.4d0
- else
- write( 0,* ) 'bad atom type: ',atype
- call mexit( 6,1 )
- end if
-
- ! dummy LCPO values:
- x(L170-1+i) = 0.0d0
- x(L175-1+i) = 0.0d0
- x(L180-1+i) = 0.0d0
- x(L185-1+i) = 0.0d0
- ! write(6,*) i,' ',atype,x(L165-1+i)
- end do ! i=1,natom
-
- end if ! ( gbsa == 1 )
-
- end if ! ( igb /= 0 .and. igb /= 10 .and. ipb == 0 )
-
- !-----------------------------------
- ! If a LRT calculation is requested,
- ! setup the icosa-SASA parameters
- ! this code is copied from above
- !-----------------------------------
-
- if ( ilrt /= 0 ) then
- ! --- assign parameters for calculating SASA according to the
- ! ICOSA method; the radii are augmented by 1.4 A ---
- do i=1,natom
- write(atype,'(a2)') ih(m06+i-1)
- if(ix(i100) .eq. 1) then
- atomicnumber = ix(i100+i)
- else
- call get_atomic_number(ih(m04+i-1), x(lmass+i-1), &
- atomicnumber, errFlag)
-#ifdef LES
- if(errFlag) then
- call get_atomic_number(ih(m04+i-1), &
- x(lmass+i-1)*lesfac((lestyp(i)-1)*nlesty+lestyp(i)), &
- atomicnumber, errFlag)
- end if
-#endif
- end if
- if (atomicnumber .eq. 7) then
- x(L165-1+i) = 1.55d0 + 1.4d0
- else if (atomicnumber .eq. 6) then
- x(L165-1+i) = 1.70d0 + 1.4d0
- else if (atomicnumber .eq. 1 .or. &
- ! added for lone pairs
- atype == 'EP') then
- x(L165-1+i) = 1.20d0 + 1.4d0
- else if (atomicnumber .eq. 8) then
- x(L165-1+i) = 1.50d0 + 1.4d0
- else if (atomicnumber .eq. 15) then
- x(L165-1+i) = 1.80d0 + 1.4d0
- else if (atomicnumber .eq. 16) then
- x(L165-1+i) = 1.80d0 + 1.4d0
- else if (atomicnumber .eq. 12) then
- ! Mg radius = 0.99A: ref. 21 in J. Chem. Phys. 1997, 107, 5422
- ! Mg radius = 1.18A: ref. 30 in J. Chem. Phys. 1997, 107, 5422
- ! Mg radius = 1.45A: Aqvist 1992
- x(L165-1+i) = 1.18d0 + 1.4d0
- else
- write( 0,* ) 'bad atom type: ',atype,' cannot perform SASA calculation'
- call mexit( 6,1 )
- end if ! atype(1:1) == 'N'
- x(L170-1+i) = 0.0d0
- x(L175-1+i) = 0.0d0
- x(L180-1+i) = 0.0d0
- x(L185-1+i) = 0.0d0
- !write(6,*) i,' ',atype,x(L165-1+i)
- end do ! i=1,natom
-
- end if ! ( ilrt /= 0 )
-
- !------------------------------------------------------------------------
- ! If user has requested Poisson-Boltzmann electrostatics, set up variables
- !------------------------------------------------------------------------
-
- if ( igb == 10 .or. ipb /= 0 ) then
- call pb_init(ifcap,natom,nres,ntypes,nbonh,nbona,ix(i02),ix(i04),ix(i06),ix(i08),ix(i10),&
- ix(iibh),ix(ijbh),ix(iiba),ix(ijba),ix(ibellygp),ih(m02),ih(m04),ih(m06),x(l15),x(l97))
- end if ! ( igb == 10 .or. ipb /= 0 )
-
- if (icnstph /= 0) then
- ! Initialize all constant pH data to 0 and read it in
- call cnstph_zero()
- call cnstphread(x(l15))
-
- ! Fill proposed charges array from current charges
- do i=1,natom
- x(l190-1+i) = x(l15-1+i)
- end do
-
- ! If we're doing explicit CpH, fill gbv* arrays
- if ( icnstph .gt. 1 .and. cph_igb == 2 .or. cph_igb == 5) then
- do i=1,natom
- x(l2402+i-1) = gbalpha
- x(l2403+i-1) = gbbeta
- x(l2404+i-1) = gbgamma
- end do
- end if
- end if
-
-! +---------------------------------------------------------------+
-! | Read EVB input file |
-! +---------------------------------------------------------------+
-
- if( ievb /= 0 ) then
-#ifdef MPI
- call evb_input
- call evb_init
-# if defined(LES)
-!KFW call evb_pimd_init
-# endif
-#else
- write(6,'(/2x,a)') 'Setting ievb>0 requires compilation with MPI'
- call mexit(6,1)
-#endif
- endif
-
- if( iyammp /= 0 ) write( 6, '(a)' ) ' Using yammp non-bonded potential'
-
- ! -------------------------------------------------------------------
- !
- ! -- add check to see if the space in nmr.h is likely to be
- ! too small for this run:
- ! [Note: this check does *not* indicate if MXTAU and MXP are
- ! too small. There is no easy way to ensure this, since
- ! the experimental intensities are read in a namelist
- ! command: if too many intensities are input, the read
- ! statment may cause a coredump before returning control
- ! to the main program. Be careful. sigh....]
-
- if (natom > matom .and. nmropt > 1) then
- write(6,*) 'WARNING: MATOM in nmr.h is smaller than the ', &
- natom,' atoms in this molecule.'
- write(6,*) 'Printout of NMR violations may be compromised.'
- end if
-
- ! -------------------------------------------------------------------
- ! --- checks on bogus data ---
- ! -------------------------------------------------------------------
-
- inerr = 0
-
- if( icfe < 0 .or. icfe > 1 ) then
- write(6,*) 'icfe must be 0 or 1 (icfe=2 is no longer supported)'
- inerr = 1
- end if
- if( icfe /= 0 .and. numgroup /= 2 ) then
- write(6,*) 'numgroup must be 2 if icfe is set'
- inerr = 1
- end if
- if (ievb>0) then
-#ifdef MPI
-!KFW if( numgroup /= 2 ) then
-!KFW write(6,*) 'numgroup must be 2 if ievb is set'
-!KFW inerr = 1
-!KFW end if
-#else
- write(6,'(/2x,a)') 'Setting ievb>0 requires compilation with MPI'
- inerr = 1
-#endif
- end if
-#ifdef PUPIL_SUPPORT
- ! BPR: PUPIL does not work with GB (or, I suppose, PB) for the
- ! time being. It is known to either crash or produce bogus
- ! results.
- if (igb > 0 .or. ipb /= 0) then
- write(6,'(a)') 'Cannot use implicit solvation (GB or PB) with PUPIL'
- inerr = 1
- end if
-#endif /*PUPIL_SUPPORT*/
- if( (igb > 0 .or. ipb /= 0) .and. numextra > 0) then
- write(6,'(a)') 'Cannot use igb>0 with extra-point force fields'
- inerr = 1
- end if
-
-!AMD validation
- if(iamd.gt.0)then
- if (EthreshD .eq. 0.d0 .and. alphaD .eq. 0.d0 .and. EthreshP .eq. 0.d0 .and. alphaP .eq. 0.d0) then
- write(6,'(a,i3)')'| AMD error all main parameters are 0.0 for Accelerated MD (AMD) or Windowed Accelerated MD (wAMD) '
- inerr = 1
- endif
- if(w_amd.gt.0)then
- if (EthreshD_w .eq. 0.d0 .and. alphaD_w .eq. 0.d0 .and. EthreshP_w .eq. 0.d0 .and. alphaP_w .eq. 0.d0) then
- write(6,'(a,i3)')'| AMD error all extra parameters are 0.0 for Windowed Accelerated MD (wAMD) LOWERING BARRIERS'
- inerr = 1
- endif
- endif
- endif
- if (iamd .gt. 0 .and. iamoeba ==1) then
- write(6,*)'amoeba is incompatible with AMD for now'
- inerr=1
- end if
-
- if (ips < 0 .or. ips > 6) then
- write(6,'(/2x,a,i3,a)') 'IPS (',ips,') must be between 0 and 6'
- inerr = 1
- end if
- if (ips /= 0 .and. ipol > 0 ) then
- write(6,'(/2x,a)') 'IPS and IPOL are inconsistent options'
- inerr = 1
- endif
- if (ips /= 0 .and. lj1264 /= 0) then
- write(6, '(/2x,a)') 'IPS and the LJ 12-6-4 potential are incompatible'
- inerr = 1
- endif
- if ( (igb > 0 .or. ipb /= 0) .and. ips > 0 ) then
- write(6,'(/2x,a,i3,a,i3,a)') 'IGB (',igb,') and ips (',ips, &
- ') cannot both be turned on'
- inerr = 1
- end if
- if (igb /= 0 .and. igb /= 1 .and. igb /= 2 .and. igb /= 5 &
- .and. igb /= 6 .and. igb /= 7 .and. igb /= 8 .and. igb /= 10) then
- write(6,'(/2x,a,i3,a)') 'IGB (',igb,') must be 0,1,2,5,6,7,8 or 10.'
- inerr = 1
- end if
- if (alpb /= 0 .and. alpb /= 1 ) then
- write(6,'(/2x,a,i3,a)') 'ALPB (',alpb,') must be 0 or 1.'
- inerr = 1
- end if
- if (alpb /= 0 .and. igb /= 1 .and. igb /= 2 .and. igb /= 5 .and. igb /=7 ) then
- write(6,'(/2x,a,i3,a)') 'IGB (',igb,') must be 1,2,5, or 7 if ALPB > 0.'
- inerr = 1
- end if
-
- if (jar < 0 .or. jar > 1) then
- write(6,'(/2x,a,i3,a)') 'JAR (',jar,') must be 0 or 1'
- inerr = 1
- end if
-
-#ifdef LES
- if( igb /= 0 .and. igb /= 1 .and. igb /= 5 .and. igb /=7 ) then
- write(6,'(/,a)') 'Error: LES is only compatible with IGB > 0,1,5,7'
- inerr = 1
- end if
- if( alpb /= 0) then
- write(6,'(/,a)') 'Error: LES is not compatible with ALPB'
- inerr = 1
- end if
- if( gbsa > 0 ) then
- write(6,'(/,a)') 'Error: LES is not compatible with GBSA > 0'
- inerr = 1
- end if
- if( qmmm_nml%ifqnt ) then
- write(6,'(/,a)') 'Error: LES is not compatible with QM/MM'
- inerr = 1
- end if
- if( ipol > 0 ) then
- write(6,'(/,a)') 'Error: LES is not compatible with IPOL > 0'
- inerr = 1
- end if
- if (temp0les >= 0.d0 .and. iscale > 0 ) then
- write (6,'(/,a)') 'Error: iscale cannot be used with temp0les'
- inerr = 1
- end if
-#endif
- if (irest /= 0 .and. irest /= 1) then
- write(6,'(/2x,a,i3,a)') 'IREST (',irest,') must be 0 or 1.'
- inerr = 1
- end if
- if (ibelly /= 0 .and. ibelly /= 1) then
- write(6,'(/2x,a,i3,a)') 'IBELLY (',ibelly,') must be 0 or 1.'
- inerr = 1
- end if
- if (imin < 0) then
- write(6,'(/2x,a,i3,a)') 'IMIN (',imin,') must be >= 0.'
- inerr = 1
- end if
- if (imin == 5) then
- if (ifbox /= 0 .and. ntb == 2) then
- write(6,'(/2x,a)') 'WARNING: IMIN=5 with changing periodic boundaries (NTB=2) can result in'
- write(6,'(/2x,a)') ' odd energies being calculated. Use with caution.'
- endif
-#ifdef MPI
- if (sandersize > 1 .and. ntb == 2) then
- write(6,'(/2x,a)') 'ERROR: IMIN=5 and NTB=2 cannot be run with multiple processors.'
- inerr = 1
- endif
-#endif
- end if
-
-
- if (iscale > mxvar) then
- write(6,9501) iscale,mxvar
- 9501 format('ERROR: ISCALE (',i5,') exceeds MXVAR (',i5, &
- '). See nmr.h')
- inerr = 1
- end if
- if (ntx < 1 .or. ntx > 7) then
- write(6,'(/2x,a,i3,a)') 'NTX (',ntx,') must be in 1..7'
- inerr = 1
- end if
-
- if (ntb /= 0 .and. ntb /= 1 .and. ntb /= 2) then
- write(6,'(/2x,a,i3,a)') 'NTB (',ntb,') must be 0, 1 or 2.'
- inerr = 1
- end if
- if (ntb == 0 .and. iwrap > 0) then
- write(6,'(/2x,a)') 'Error: IWRAP > 0 cannot be used without a periodic box.'
- inerr = 1
- end if
-
- if (ntt < 0 .or. ntt > 8) then ! APJ
- write(6,'(/2x,a,i3,a)') 'NTT (',ntt,') must be between 0 and 8.' ! APJ
- inerr = 1
- end if
- if (ntt == 1 .and. tautp < dt) then
- write(6, '(/2x,a,f6.2,a)') 'TAUTP (',tautp,') < DT (step size)'
- inerr = 1
- end if
- if( ntt < 3 .or. ntt > 8 ) then ! APJ
- if( gamma_ln > 0.d0 ) then
- write(6,'(a)') 'ntt must be 3 to 8 if gamma_ln > 0' ! APJ
- inerr = 1
- end if
- end if
-
- if ( ntt==3 .or. ntt==6 ) nchain = 0 !APJ: Langevin, Adaptive-Langevin must have chain set to zero. ! APJ
-
- if (ntt == 3 .or. ntt == 4) then
- if ( ntb == 2) then
- !Require gamma_ln > 0.0d0 for ntt=3 and ntb=2 - strange things happen
- !if you run NPT with NTT=3 and gamma_ln = 0.
- if ( gamma_ln <= 0.0d0 ) then
- write(6,'(a)') 'gamma_ln must be > 0 for ntt=3 .or. 4 with ntb=2.'
- inerr = 1
- end if
- end if
- end if
-
- if (ntp /= 0 .and. ntp /= 1 .and. ntp /= 2 .and. ntp /= 3) then
- write(6,'(/2x,a,i3,a)') 'NTP (',ntp,') must be 0, 1, 2, or 3.'
- inerr = 1
- end if
- if (ntp == 3 .and. csurften < 1) then
- write(6,'(/2x,a)') 'csurften must be greater than 0 for ntp=3.'
- inerr = 1
- end if
- if (ntp > 0 .and. taup < dt .and. barostat == 1) then
- write(6, '(/2x,a,f6.2,a)') 'TAUP (',taup,') < DT (step size)'
- inerr = 1
- end if
- if (npscal < 0 .or. npscal > 1) then
- write(6,'(/2x,a,i3,a)') 'NPSCAL (',npscal,') must be 0 or 1.'
- inerr = 1
- end if
- if (ntp > 0) then
- if (barostat /= 1 .and. barostat /= 2) then
- write(6, '(/2x,a,i3,a)') 'BAROSTAT (', barostat, ') must be 1 or 2'
- inerr = 1
- end if
- if (barostat == 2) then
- if (mcbarint <= 0) then
- write(6, '(/2x,a,i3,a)') 'MCBARINT (',mcbarint,') must be positive'
- inerr = 1
- end if
- if (mcbarint >= nstlim) then
- write(6, '(a)') 'WARNING: mcbarint is greater than the number of &
- &steps. This is effectively constant volume.'
- end if
- end if
- end if
-
- if (ntc < 1 .or. ntc > 4) then
- write(6,'(/2x,a,i3,a)') 'NTC (',ntc,') must be 1,2,3 or 4.'
- inerr = 1
- end if
- if (jfastw < 0 .or. jfastw > 4) then
- write(6,'(/2x,a,i3,a)') 'JFASTW (',jfastw,') must be 0->4.'
- inerr = 1
- end if
-
- if (ntf < 1 .or. ntf > 8) then
- write(6,'(/2x,a,i3,a)') 'NTF (',ntf,') must be in 1..8.'
- inerr = 1
- end if
-
- if (ioutfm /= 0 .and. ioutfm /= 1) then
- write(6,'(/2x,a,i3,a)') 'IOUTFM (',ioutfm,') must be 0 or 1.'
- inerr = 1
- end if
-
- if (ntpr < 0) then
- write(6,'(/2x,a,i3,a)') 'NTPR (',ntpr,') must be >= 0.'
- inerr = 1
- end if
- if (ntwx < 0) then
- write(6,'(/2x,a,i3,a)') 'NTWX (',ntwx,') must be >= 0.'
- inerr = 1
- end if
- if (ntwv < -1) then
- write(6,'(/2x,a,i3,a)') 'NTWV (',ntwv,') must be >= -1.'
- inerr = 1
- end if
- if (ntwf < -1) then
- write(6, '(/2x,a,i3,a)') 'NTWF (',ntwf,') must be >= -1.'
- inerr = 1
- end if
- if (ntwv == -1 .and. ioutfm /= 1) then
- write (6, '(/2x,a)') 'IOUTFM must be 1 for NTWV == -1.'
- inerr = 1
- end if
- if (ntwf == -1 .and. ioutfm /= 1) then
- write(6, '(/2x,a)') 'IOUTFM must be 1 for NTWF == -1.'
- inerr = 1
- end if
- if (ntwv == -1 .and. ntwx == 0) then
- write (6, '(/2x,a)') 'NTWX must be > 0 for NTWV == -1.'
- inerr = 1
- end if
- if (ntwe < 0) then
- write(6,'(/2x,a,i3,a)') 'NTWE (',ntwe,') must be >= 0.'
- inerr = 1
- end if
- if (ntave < 0) then
- write(6,'(/2x,a,i3,a)') 'NTAVE (',ntave,') must be >= 0.'
- inerr = 1
- end if
- if (ntr /= 0 .and. ntr /= 1) then
- write(6,'(/2x,a,i3,a)') 'NTR (',ntr,') must be 0 or 1.'
- inerr = 1
- end if
- if (ntrx /= 0 .and. ntrx /= 1) then
- write(6,'(/2x,a,i3,a)') 'NTRX (',ntrx,') must be 0 or 1.'
- inerr = 1
- end if
- if (nmropt < 0 .or. nmropt > 2) then
- write(6,'(/2x,a,i3,a)') 'NMROPT (',nmropt,') must be in 0..2.'
- inerr = 1
- end if
-
- if (idecomp < 0 .or. idecomp > 4) then
- write(6,'(/2x,a)') 'IDECOMP must be 0..4'
- inerr = 1
- end if
-
- ! check settings related to ivcap
-
- if(ivcap == 3 .or. ivcap == 4) then
- write(6,'(/2x,a)') 'IVCAP == 3 and IVCAP == 4 currently not implemented'
- inerr = 1
- endif
- if (ivcap < 0 .and. ivcap > 5) then
- write(6,'(/2x,a)') 'IVCAP must be 0 ... 5'
- inerr = 1
- end if
- if ((ivcap == 1 .or. ivcap == 5) .and. igb /= 10 .and. ipb == 0) then
- write(6,'(/2x,a)') 'IVCAP == 1,5 only works with Poisson Boltzmann (igb=10 or ipb/=0)'
- inerr = 1
- end if
- if((ivcap == 1 .or. ivcap == 3 .or. ivcap == 5 ) .and. cutcap <= 0.0d0) then
- write(6,'(/2x,a)') 'For IVCAP == 1,3, or 5, cutcap must be > 0.0'
- inerr = 1
- endif
- if (ivcap == 4 .and. &
- (xlorth < ZERO .or. ylorth < ZERO .or. zlorth < ZERO .or. &
-! give magic numbers a name srb aug 2007 !
- xorth > 47114710.0d0 .or. &
-! give magic numbers a name !
- yorth > 47114710.0d0 .or. &
-! give magic numbers a name !
- zorth > 47114710.0d0)) then
- write(6,'(/2x,a)') &
- 'For IVCAP == 4, xlorth, ylorth, zlorth, xorth, yorth, zorth must be set'
- inerr = 1
- end if
- if ((ivcap == 3 .or. ivcap == 4) .and. ibelly == 0) then
- write(6,'(/2x,a,a)') &
- 'For IVCAP == 3 or 4, ibelly must be 1 and all atoms', &
- ' not in the spherical or orthorhombic region must be set NOT moving'
- inerr = 1
- end if
- if (ivcap == 5 .and. (imin /= 1 .or. maxcyc > 1)) then
- write(6,'(/2x,a,a)') &
- 'IVCAP == 5 only works for single-point energy calculation'
- inerr = 1
- end if
-
- ! check if ifbox variable from prmtop file matches actual angles:
-
- if ( igb == 0 .and. ipb == 0 .and. ntb /= 0 ) then
- if ( ifbox == 1 ) then
- if ( abs(alpha - 90.0d0) > 1.d-5 .or. &
- abs(beta - 90.0d0) > 1.d-5 .or. &
- abs(gamma - 90.0d0) > 1.d-5 ) then
- ifbox =3
- write(6,'(a)') ' Setting ifbox to 3 for non-orthogonal unit cell'
- end if
- end if
-
- if ( ifbox == 2 ) then
- if ( abs(alpha - 109.4712190d0) > 1.d-5 .or. &
- abs(beta - 109.4712190d0) > 1.d-5 .or. &
- abs(gamma - 109.4712190d0) > 1.d-5 ) then
- write(6,'(/2x,a)') &
- 'Error: ifbox=2 in prmtop but angles are not correct'
- inerr = 1
- end if
- end if
- end if
-
- ! checks for targeted MD
- if (itgtmd /= 0 .and. itgtmd > 2) then
- write(6,'(/2x,a,i3,a)') 'ITGTMD (',itgtmd,') must be 0, 1 or 2.'
- inerr = 1
- end if
- if (itgtmd == 1 .and. ntr == 1) then
- if (len_trim(tgtfitmask) > 0 .or. len_trim(tgtrmsmask) <= 0) then
- write(6,'(/2x,a)') 'ITGTMD: tgtrmsmask (and not tgtfitmask) ' // &
- 'should be specified if NTR=1'
- inerr = 1
- end if
- end if
- ! skip this test until fallback to rgroup() is supported
- !if (itgtmd == 1 .and. ntr == 0) then
- ! if (len_trim(tgtfitmask) == 0 .and. len_trim(tgtrmsmask) == 0) then
- ! write(6,'(/2x,a)') &
- ! 'ITGTMD: both tgtfitmask and tgtrmsmask should be specified if NTR=0'
- ! inerr = 1
- ! end if
- !end if
-
- ! -- consistency checking
-
- if (imin > 0.and.nrespa > 1) then
- write(6,'(/2x,a)') 'For minimization, set nrespa,nrespai=1'
- inerr = 1
- end if
- if (ntp > 0 .and. nrespa > 1) then
- write(6,'(/2x,a)') 'nrespa must be 1 if ntp>0'
- inerr = 1
- end if
- if (ntx < 4.and.init /= 3) then
- write(6,'(/2x,a)') 'NTX / IREST inconsistency'
- inerr = 1
- end if
- if (ntb == 2 .and. ntp == 0) then
- write(6,'(/2x,a)') 'NTB set but no NTP option (must be 1 or 2)'
- inerr = 1
- end if
- if (ntp /= 0 .and. ntb /= 2) then
- write(6,'(/,a,a)')' NTP > 0 but not constant pressure P.B.C.', &
- ' (NTB = 2) must be used'
- inerr = 1
- end if
- if (ntb /= 0 .and. ifbox == 0 .and. ntp /= 0) then
- write(6,'(/,a)') ' (NTB /= 0 and NTP /= 0) but IFBOX == 0'
- write(6,'(/,a)') ' This combination is not supported'
- inerr = 1
- end if
- if (ntb /= 0 .and. &
- ( box(1) < 1.d0 .or. &
- box(2) < 1.d0 .or. &
- box(3) < 1.d0 ) ) then
- write(6,'(/,a,3f10.3)') ' BOX is too small: ',box(1),box(2),box(3)
- inerr = 1
- else if (ntb /= 0 .and. &
- (sqrt(cut) >= box(1)*0.5d0 .or. &
- sqrt(cut) >= box(2)*0.5d0 .or. &
- sqrt(cut) >= box(3)*0.5d0) ) then
- write(6,'(/,a)') ' CUT must be < half smallest box dimension'
- inerr = 1
- end if
- if (ntb /= 0 .and. (igb > 0 .or. ipb /= 0) ) then
- write(6,'(/,a)') ' igb>0 is only compatible with ntb=0'
- inerr = 1
- end if
-#ifdef APBS
- if ( ntb == 0 .and. sqrt(cut) < 8.05 .and. igb /= 10 .and. ipb == 0 .and. &
- .not. mdin_apbs) then
-#else
- if ( ntb == 0 .and. sqrt(cut) < 8.05 .and. igb /= 10 .and. ipb == 0 ) then
-#endif /* APBS */
- write(6,'(/,a,f8.2)') ' unreasonably small cut for non-periodic run: ', &
- sqrt(cut)
- inerr = 1
- end if
- if ( rgbmax < 5.d0*fsmax ) then
- write(6,'(/,a,f8.2)') ' rgbmax must be at least ', 5.d0*fsmax
- inerr = 1
- end if
- if (icfe /= 0 .and. indmeth == 3 ) then
- write(6,'(/,a)') ' indmeth=3 cannot be used with icfe>0'
- inerr = 1
- end if
- if (icfe /= 0 .and. ibelly /= 0 ) then
- write(6,'(/,a)') ' ibelly cannot be used with icfe'
- inerr = 1
- end if
-#ifdef MPI /* SOFT CORE */
- if (icfe /= 0 .and. dvdl_norest /= 0 ) then
- write(6,'(/,a)') 'dvdl_norest must == 0!'
- write(6,'(/,a)') 'The dvdl_norest option is deprecated.'
- write(6,'(/,a)') 'Restraint energies are seperated, &
- &and do not contribute to dvdl.'
- inerr = 1
- end if
-#endif
- ! Modification done by Ilyas Yildirim
- if (icfe == 1 .and. (klambda < 1 .or. klambda > 6)) then
- write(6,'(/,a)') ' klambda must be between 1 and 6'
- inerr = 1
- end if
- ! End of modification done by Ilyas Yildirim
-
- if (clambda < 0.d0 .or. clambda > 1.d0 ) then
- write(6,'(/,a)') ' clambda must be between 0 and 1'
- inerr = 1
- end if
-
- if (icfe /= 0 .and. (idecomp == 3 .or. idecomp == 4)) then
- write(6,'(/,a)') ' Pairwise decomposition for thermodynamic integration not implemented'
- inerr = 1
- end if
- if (icfe /= 0 .and. idecomp /= 0 .and. ipol > 0) then
- write(6,'(/,a)') ' IPOL is incompatible with IDECOMP and ICFE'
- inerr = 1
- end if
-
-#ifdef MPI /* SOFT CORE */
- if (ifsc /= 0) then
- if (ifsc == 2) then
- write (6,'(/,a)') 'The ifsc=2 option is no longer supported. &
- &Internal energies of the soft core region.'
- write (6,'(a)') 'are now handled implicitly and setting ifsc=2 &
- &is no longer needed'
- inerr = 1
- end if
- if (icfe /= 1 .and. ifsc==1) then
- write (6,'(/,a)') ' Softcore potential requires a standard TI run, set icfe to 1'
- inerr = 1
- end if
- if ( igb > 0 .or. ipb /= 0 ) then
- write (6,'(/,a)') ' Softcore potential is incompatible with GB (for now)'
- inerr = 1
- end if
- if ( ntf > 1 ) then
- write (6,'(/,a)') ' Softcore potentials require ntf=1 because SHAKE &
- &constraints on some bonds might be removed'
- inerr = 1
- end if
- if (clambda > 0.995 .or. clambda < 0.005) then
- write (6,'(/,a)') ' Softcore potentials cannot be used with clambda < 0.005 or > 0.995'
- inerr = 1
- end if
- if (klambda /= 1) then
- write (6,'(/,a)') ' Softcore potential requires linear mixing, set klambda to 1'
- inerr = 1
- end if
- if (imin == 1 .and. ntmin /= 2) then
- write (6,'(/,a)') ' Minimizations with ifsc=1 require the steepest descent algorithm.'
- write (6,'(/,a)') ' Set ntmin to 2 and restart'
- inerr = 1
- end if
- end if
- if (ifmbar /= 0) then
- if (icfe /= 1) then
- write (6,'(/,a)') ' MBAR requires a standard TI run, set icfe to 1'
- inerr = 1
- end if
- if (ifsc /=0 .and. (bar_l_max > 0.995 .or. bar_l_min < 0.005) ) then
- write (6,'(/,a)') ' Softcore potentials cannot be used with &
- &bar_l_min < 0.005 or bar_l_max > 0.995'
- inerr = 1
- end if
- if (klambda /= 1) then
- write (6,'(/,a)') ' MBAR requires linear mixing, set klambda to 1'
- inerr = 1
- end if
- end if
-#endif
-
- if (ilrt /= 0 .and. lrtmask == '') then
- write (6,'(a)') 'Linear Response Theory activated, but lrtmask is not set'
- inerr = 1
- end if
-
- if (idecomp > 0 .and. (ntr > 0 .or. ibelly > 0)) then
- write(6,'(/,a)') 'IDECOMP is not compatible with NTR or IBELLY'
- inerr = 1
- end if
- if (icnstph /= 0) then
-
- if ( icnstph < 0 ) then
- write(6, '(/,a)') 'icnstph must be greater than 0'
- inerr = 1
- end if
- if ( igb == 0 .and. ipb == 0 .and. icnstph == 1 ) then
- write(6, '(/,a)') 'Constant pH using icnstph = 1 requires &
- &GB implicit solvent'
- inerr = 1
- end if
- if ( ntb .eq. 0 .and. icnstph .gt. 1 ) then
- write(6, '(/,a)') 'Constant pH using icnstph = 2 requires &
- &periodic boundary conditions'
- inerr = 1
- end if
- if (icfe /= 0) then
- write(6, '(/,a)') &
- 'Constant pH and thermodynamic integration are incompatable'
- inerr = 1
- end if
-
- if (ntcnstph <= 0) then
- write(6, '(/,a)') 'ntcnstph must be a positive integer.'
- inerr = 1
- end if
-
- if (icnstph > 1 .and. mccycles <= 0) then
- write(6, '(/,a)') 'mccycles must be a positive integer.'
- inerr = 1
- end if
-
- end if ! icnstph
-
-#ifdef noVIRIAL
- if( ntp > 0 .and. barostat == 1 ) then
- write(6,'(/,a)') 'Error: Berendsen barostat is incompatible with noVIRIAL'
- inerr = 1
- end if
-#endif
-
- !-----------------------------------------------------
- ! ----sanity checks for Ewald
- !-----------------------------------------------------
-
- if( igb == 0 .and. ipb == 0 ) then
- call float_legal_range('skinnb: (nonbond list skin) ', &
- skinnb,skinlo,skinhi)
-
- ! --- Will check on sanity of settings after coords are read in
- ! and the extent of the system is determined.
-
- if(periodic == 1)then
- call float_legal_range('skinnb+cutoffnb: (nonbond list cut) ', &
- skinnb+cutoffnb,zero,sphere)
- end if
- if (ntb==0 .and. use_pme/=0) then
- write(6,'(/,a)') &
- 'Using PME with a non-periodic simulation does not make sense. Set either ntb>0 of use_pme=0.'
- inerr = 1
- end if
- call float_legal_range('a: (unit cell size) ',a,boxlo,boxhi)
- call float_legal_range('b: (unit cell size) ',b,boxlo,boxhi)
- call float_legal_range('c: (unit cell size) ',c,boxlo,boxhi)
- call float_legal_range('alpha: (unit cell angle) ', &
- alpha,anglo,anghi)
- call float_legal_range('beta: (unit cell angle) ', &
- beta,anglo,anghi)
- call float_legal_range('gamma: (unit cell angle) ', &
- gamma,anglo,anghi)
- call int_legal_range('order: (interpolation order) ', &
- order,orderlo,orderhi)
- call opt_legal_range('verbose: ',verbose,0,4)
- call opt_legal_range('netfrc: ',netfrc,0,1)
- call opt_legal_range('nbflag: ',nbflag,0,1)
- call opt_legal_range('nbtell: ',nbtell,0,2)
- call opt_legal_range('ew_type: ',ew_type,0,1)
- call opt_legal_range('vdwmeth: ',vdwmeth,0,2)
- call opt_legal_range('eedmeth: ',eedmeth,1,6)
- call opt_legal_range('ee_type: ',ee_type,1,2)
- call opt_legal_range('maxiter: ',maxiter,1,50)
- call opt_legal_range('indmeth: ',indmeth,0,3)
- call opt_legal_range('fix_quad: ',fix_quad,0,1)
- call float_legal_range('eedtbdns: (erfc table density) ', &
- eedtbdns,denslo,denshi)
- end if ! ( igb == 0 .and. ipb == 0 )
-
- if( ntb==2 .and. ipimd==1) then
- write(6,*) 'primitive PIMD is incompatible with NTP ensemble'
- inerr=1
- endif
-
- if( ntb==2 .and. ipimd==3 ) then
- write(6,*) 'CMD is incompatible with NTP ensemble'
- inerr=1
- endif
-
- if( ipimd==3 .and. adiab_param>=1.0 ) then
- write(6,*) 'For CMD adiab_param must be <=1'
- inerr=1
- endif
-
- if( ntb==2 .and. ipimd==4 ) then
- write(6,*) 'RPMD is incompatible with NTP ensemble'
- inerr=1
- endif
-
- if( ntt/=0 .and. ipimd==4 ) then
- write(6,*) 'RPMD is incompatible with NVT ensemble'
- inerr=1
- endif
-
- if( ntt/=4 .and. ipimd==2 ) then
- write(6,*) 'NMPIMD requires Nose-Hoover chains (ntt=4)'
- inerr=1
- endif
-
- if( ntt/=4 .and. ipimd==3 ) then
- write(6,*) 'CMD requires Nose-Hoover chains (ntt=4)'
- inerr=1
- endif
-
-#if !defined(MPI)
- if( ineb > 0 ) then
- write(6,*) 'NEB requires MPI'
- inerr=1
- endif
-#endif
-
-#ifdef LES
- if( ineb > 0 ) then
- write(6,*) 'NEB no longer works with LES: use multiple groups and a groupfile instead'
- inerr=1
- endif
-#endif
-
- if( ineb > 0 .and. ipimd > 0 ) then
- write(6,*) 'ineb>0 and ipimd>0 are incompatible options'
- inerr=1
- endif
-
- if( iamoeba == 1 )then
-#ifdef LES
- write(6,*)'amoeba is incompatible with LES'
- inerr=1
-#endif
-
- if( ntc > 1 ) then
- write(6,*) 'SHAKE (ntc>1) and amoeba are incompatible options'
- inerr=1
- end if
- if( ntp > 1 .and. beeman_integrator > 0 ) then
- write(6,*) 'ntp>1 is not consistent with the beeman integrator'
- inerr=1
- end if
- if ( igb /= 0 ) then
- write (6,'(/,a)') 'amoeba (iamoeba=1) is incompatible with GB (igb>0)'
- inerr=1
- end if
- if ( ipb /= 0 ) then
- write (6,'(/,a)') 'amoeba (iamoeba=1) is incompatible with PB (ipb>0)'
- inerr=1
- end if
-#ifdef MPI
- if (numtasks > 1) then
- write(6, '(/,a)') 'amoeba (iamoeba=1) cannot be run in parallel in &
- &sander'
- inerr=1
- end if
-#endif
-
- end if
-
- ! ---WARNINGS:
-
- if ( ibelly == 1 .and. igb == 0 .and. ipb == 0 .and. ntb /= 0 ) then
- write(6,'(/,a,/,a,/,a)') &
- 'Warning: Although EWALD will work with belly', &
- '(for equilibration), it is not strictly correct!'
- end if
-
- if (inerr == 1) then
- write(6, '(/,a)') ' *** input error(s)'
- call mexit(6,1)
- end if
-
- ! Load the restrained atoms (ntr=1) or the belly atoms (ibelly=1)
- ! or atoms for targeted md (itgtmd=1). Selections are read from
- ! &cntrl variables or, if these are not defined, it falls back to
- ! the old group input format.
-
- if(mtmd /= 'mtmd') then
- itgtmd = 2
- ntr = 0
- emtmd = 0.0d0
- end if
- konst = ntr > 0
- dotgtmd = itgtmd > 0
- belly = .false.
- natc = 0
- ngrp = 0
- natbel = 0
- nattgtfit = 0 ! number of atoms for tgtmd fitting (=overlap)
- nattgtrms = 0 ! number of atoms for tgtmd rmsd calculation
- nrc = 0
- if(konst.or.dotgtmd) then
-
- ! inserted here to fix the bug that coords are not available
- ! yet when distance based selection (<,>) is requested
-#ifdef LES
- call getcor(nr,x(lcrd),x(lvel),x(lforce),ntx,box,irest,t,temp0les,.FALSE.,solvph)
-#else
- call AMOEBA_check_newstyle_inpcrd(inpcrd,newstyle)
- if ( newstyle )then
- call AM_RUNMD_get_coords(natom,t,irest,ntb,x(lcrd),x(lvel))
- else
- if( irest == 1 .and. beeman_integrator > 0 ) then
- write(6,*) 'Cannot do a beeman_integrator restart with old-style coordinates'
- call mexit(6,1)
- end if
- call getcor(nr,x(lcrd),x(lvel),x(lforce),ntx,box,irest,t,temp0,.FALSE.,solvph)
- endif
-#endif
-
- if(itgtmd == 2) then
- call mtmdcall(emtmd,x(lmtmd01),ix(imtmd02),x(lcrd),x(lforce),ih(m04),ih(m02),ix(i02),&
- ih(m06),x(lmass),natom,nres,'READ')
- else
- ! DRR - Open and close calls are now in rdrest
- !if (ntrx <= 0) then
- ! call amopen(10,refc,'O','U','R')
- !else
- ! call amopen(10,refc,'O','F','R')
- !end if
- ! these messages should be written after "5. REFERENCE..." ?
- if (konst) write(6,9408)
- if (dotgtmd) write(6,9409)
-
- call rdrest(natom,ntrx,refc,x(lcrdr))
- !close(10)
-
-
-
-
- ! VH - tgtmd change: preferably call atommask() instead of rgroup()
- if (konst) then
- if( len_trim(restraintmask) <= 0 ) then
- call rgroup(natom,natc,nres,ngrp,ix(i02),ih(m02), &
- ih(m04),ih(m06),ih(m08),ix(icnstrgp),jgroup,indx,irespw,npdec, &
- x(l60),x(lcrdr),konst,dotgtmd,belly,idecomp,5,.true.)
- else
- call atommask( natom, nres, 0, ih(m04), ih(m06), &
- ix(i02), ih(m02), x(lcrd), restraintmask, ix(icnstrgp) )
-
- ! for now, emulate the "GATHER ALL THE CONSTRAINED ATOMS TOGETHER"
- ! section of rgroup(); later, the various masks should be done
- ! differently, i.e. without the "gather", as in the following:
- ! x(l60:l60+natom-1) = restraint_wt
- ! natc = sum(ix(icnstrgp:icnstrgp+natom-1))
-
- natc = 0
- do i=1,natom
- if( ix(icnstrgp-1+i) <= 0 ) cycle
- natc = natc + 1
- ix(icnstrgp-1+natc) = i
- x(l60-1+natc) = restraint_wt
- end do
- write(6,'(a,a,a,i5,a)') ' Mask ', &
- restraintmask(1:len_trim(restraintmask)), ' matches ',natc,' atoms'
- end if
- end if
- nrc = natc
-
- if (itgtmd == 1) then
- if (len_trim(tgtfitmask) <= 0 .and. len_trim(tgtrmsmask) <= 0) then
- ! the following if-endif can be deleted when we stop
- ! supporting rgroup()
- if (konst) then
- ! cannot do both ntr and tgtmd together using old group format
- write(6,'(/2x,a)') 'NTR must be 0 for targeted MD (TGTMD=1)'
- call mexit(6,1)
- else ! the following only for backward compatibility
- call rgroup(natom,natc,nres,ngrp,ix(i02),ih(m02), &
- ih(m04),ih(m06),ih(m08),ix(icnstrgp), &
- jgroup,indx,irespw,npdec, &
- x(l60),x(lcrdr),konst,dotgtmd,belly,idecomp,5,.true.)
- ! tgtmd atoms are now stored in nattgt, igroup -> icnstrgp
- nattgtfit = natc
- nattgtrms = natc
- do i=1,nattgtfit
- ix(itgtfitgp-1+i) = ix(icnstrgp-1+i)
- ix(itgtrmsgp-1+i) = ix(icnstrgp-1+i)
- end do
- end if
- else
- if (ntr == 0) then ! read tgtfitmask only if ntr=1
- ! read in atom group for tgtmd fitting (=overlap region)
- call atommask( natom, nres, 0, ih(m04), ih(m06), &
- ix(i02), ih(m02), x(lcrd), tgtfitmask, ix(itgtfitgp) )
- ! see comments above (for ntr) for the following reduction cycle
- nattgtfit = 0
- do i=1,natom
- if( ix(itgtfitgp-1+i) <= 0 ) cycle
- nattgtfit = nattgtfit + 1
- ix(itgtfitgp-1+nattgtfit) = i
- end do
- write(6,'(a,a,a,i5,a)') &
- ' Mask "', tgtfitmask(1:len_trim(tgtfitmask)-1), &
- '" matches ',nattgtfit,' atoms'
- end if
- ! read in atom group for tgtmd rmsd calculation
- call atommask( natom, nres, 0, ih(m04), ih(m06), &
- ix(i02), ih(m02), x(lcrd), tgtrmsmask, ix(itgtrmsgp) )
- nattgtrms = 0
- do i=1,natom
- if( ix(itgtrmsgp-1+i) <= 0 ) cycle
- nattgtrms = nattgtrms + 1
- ix(itgtrmsgp-1+nattgtrms) = i
- end do
- write(6,'(a,a,a,i5,a)') &
- ' Mask "', tgtrmsmask(1:len_trim(tgtrmsmask)-1), &
- '" matches ',nattgtrms,' atoms'
- end if
- end if
-
- end if ! (itgtmd == 2)
-
- end if ! (konst.or.dotgtmd)
-
- if (ineb>0) then
- ! carlos: read in fitmask and rmsmask info for NEB, just as done for tgtmd
- ! init last_neb_atom, which is used to determine the limits for the
- ! communication of neighbor coordinates (to reduce size for explicit
- ! water)
- last_neb_atom = 0
-
- if (ntr /= 0) then
- write(6,'(/2x,a)') 'cannot use NEB with ntr restraints'
-! CARLOS: WHY NOT? SHOULD BE OK.
-! potential for user error is restrained region overlaps with NEB region. would
-! blow up.
- call mexit(6,1)
- else
- ! read in atom group for fitting (=overlap region)
- call atommask( natom, nres, 0, ih(m04), ih(m06), &
- ix(i02), ih(m02), x(lcrd), tgtfitmask, ix(itgtfitgp) )
- ! see comments above (for ntr) for the following reduction cycle
- nattgtfit = 0
- do i=1,natom
- if( ix(itgtfitgp-1+i) <= 0 ) cycle
- nattgtfit = nattgtfit + 1
- ix(itgtfitgp-1+nattgtfit) = i
- if (i.gt.last_neb_atom) last_neb_atom = i
- end do
- write(6,'(a)') "The following selection will be used for NEB structure fitting"
- write(6,'(a,a,a,i5,a)') &
- ' Mask "', tgtfitmask(1:len_trim(tgtfitmask)-1), &
- '" matches ',nattgtfit,' atoms'
- end if
- ! read in atom group for tgtmd rmsd calculation
- call atommask( natom, nres, 0, ih(m04), ih(m06), &
- ix(i02), ih(m02), x(lcrd), tgtrmsmask, ix(itgtrmsgp) )
- nattgtrms = 0
- do i=1,natom
- if( ix(itgtrmsgp-1+i) <= 0 ) cycle
- nattgtrms = nattgtrms + 1
- ix(itgtrmsgp-1+nattgtrms) = i
- if (i.gt.last_neb_atom) last_neb_atom = i
- end do
- write(6,'(a)') "The following selection will be used for NEB force application"
- write(6,'(a,a,a,i5,a)') &
- ' Mask "', tgtrmsmask(1:len_trim(tgtrmsmask)-1), &
- '" matches ',nattgtrms,' atoms'
- write(6,'(/2x,a,i6)') "Last atom in NEB fitmask or rmsmask is ",last_neb_atom
-
- if (nattgtrms<=0 .or. nattgtfit <= 0) then
- write(6,'(/2x,a)') 'NEB requires use of tgtfitmask and tgtrmsmask'
- call mexit(6,1)
- endif
- endif
-
- ! dotgtmd may be false here even if doing tgtmd
- ! this is so belly info is read properly? following existing KONST code
-
- dotgtmd=.false.
- konst = .false.
- belly = ibelly > 0
- ngrp = 0
- if(belly) then
- ! inserted here to fix the bug that coords are not available
- ! yet when distance based selection (<,>) is requested
-#ifdef LES
- call getcor(nr,x(lcrd),x(lvel),x(lforce),ntx,box,irest,t,temp0les,.FALSE.,solvph)
-#else
- call getcor(nr,x(lcrd),x(lvel),x(lforce),ntx,box,irest,t,temp0,.FALSE.,solvph)
-#endif
- write(6,9418)
- if( len_trim(bellymask) <= 0 ) then
- call rgroup(natom,natbel,nres,ngrp,ix(i02),ih(m02), &
- ih(m04),ih(m06),ih(m08),ix(ibellygp), &
- jgroup,indx,irespw,npdec, &
- x(l60),x(lcrdr),konst,dotgtmd,belly,idecomp,5,.true.)
- else
- call atommask( natom, nres, 0, ih(m04), ih(m06), &
- ix(i02), ih(m02), x(lcrd), bellymask, ix(ibellygp) )
- natbel = sum(ix(ibellygp:ibellygp+natom-1))
- write(6,'(a,a,a,i5,a)') ' Mask ', &
- bellymask(1:len_trim(bellymask)), ' matches ',natbel,' atoms'
- end if
- end if
- call setvar(ix,belly)
-
- ! see if the user has input a noshakemask string, and process it:
- natnos = 0
- if( len_trim(noshakemask) > 0 ) then
- call atommask( natom, nres, 0, ih(m04), ih(m06), &
- ix(i02), ih(m02), x(lcrd), noshakemask, noshakegp )
- natnos = sum(noshakegp(1:natom))
- write(6,*)
- write(6,'(a,a,a,i5,a)') 'Noshake mask ', &
- noshakemask(1:len_trim(noshakemask)), ' matches ',natnos,' atoms'
- call setnoshake(ix,noshakegp,ntc,num_noshake)
- if( ntf > 1 ) then
- write(6,'(a)') ' Setting ntf to 1'
- ntf = 1
- end if
- end if
-
- ! GMS ------------------------------------
- ! Check for 'iwrap_mask', and process it.
- ! ----------------------------------------
- n_iwrap_mask_atoms = 0
- if( len_trim(iwrap_mask) > 0 .and. iwrap == 2) then
- call atommask( natom, nres, 0, ih(m04), ih(m06), &
- ix(i02), ih(m02), x(lcrd), iwrap_mask, iwrap_maskgp )
- ! iwrap_maskgp is a natom long integer array, with elements:
- ! 0 --> atom is not in iwrap_mask
- ! 1 --> atom is in iwrap_mask
- n_iwrap_mask_atoms = sum(iwrap_maskgp(1:natom))
- write(6,*)
- write(6,'(a,a,a,i5,a)') 'Wrap mask ', &
- iwrap_mask(1:len_trim(iwrap_mask)), ' matches ',n_iwrap_mask_atoms,' atoms:'
- ! Set an array to store the atom numbers of the atoms
- ! in the iwrap_mask
- allocate(iwrap_mask_atoms(n_iwrap_mask_atoms), stat=ier)
- REQUIRE(ier == 0)
-
- j = 0
- do i=1,natom
- if( iwrap_maskgp(i)>0 ) then
- j = j+1
- iwrap_mask_atoms(j) = i
- end if
- end do
-
- write(6,'(10i5)') (iwrap_mask_atoms(i),i=1,n_iwrap_mask_atoms)
- end if
-
-#ifdef MPI /* SOFT CORE */
- ! lower charges if a crgmask is set
- if ( len_trim(crgmask) > 0 ) then
- call atommask( natom, nres, 0, ih(m04), ih(m06), &
- ix(i02), ih(m02), x(lcrd), crgmask, crggp )
- write(6,'(a,a,a,i5,a)') 'Zero-Charge Mask ',crgmask(1:len_trim(crgmask)), ' matches ',sum(crggp(1:natom)),' atoms'
- call remove_charges(crggp, natom, x(l15))
- end if
-#endif
-
- konst = .false.
- belly = .false.
- if(idecomp > 0) then
- write(6,9428)
- call rgroup(natom,ntmp,nres,ngrp,ix(i02),ih(m02), &
- ih(m04),ih(m06),ih(m08),ix(ibellygp), &
- jgroup,indx,irespw,npdec, &
- x(l60),x(lcrdr),konst,dotgtmd,belly,idecomp,5,.true.)
- end if
-
- if( ibelly > 0 .and. (igb > 0 .or. ipb /= 0) ) then
-
- ! ---here, the only allowable belly has just the first
- ! NATBEL atoms in the moving part. Check to see that this
- ! requirement is satisfied:
-
- do i=natbel+1,natom
- if( ix(ibellygp+i-1) /= 0 ) then
- write(6,*) 'When igb>0, the moving part must be at the'
- write(6,*) ' start of the molecule. This does not seem'
- write(6,*) ' to be the case here.'
- write(6,*) 'natbel,i,igroup(i) = ' &
- ,natbel,i,ix(ibellygp+i-1)
- call mexit(6,1)
- end if
- end do
- end if
-
-
- ! ----- CALCULATE THE SQUARE OF THE BOND PARAMETERS FOR SHAKE
- ! THE PARAMETERS ARE PUT SEQUENTIALLY IN THE ARRAY CONP -----
-
- do i=1,nbonh + nbona + nbper
- j = ix(iicbh+i-1)
- x(l50+i-1) = req(j)**2
- end do
-
-#ifdef MPI
- if( icfe /= 0 ) then
-
- ! use the masses of the prmtop file for the first group for both groups:
- ! [only the master nodes communicate here, since non-master nodes
- ! have not yet allocated space]
- ! This leads to problems for dual topology runs, and is therefore skipped
- ! if ifsc is set to one, the masses from both prmtop files are used
- if (ifsc == 0) then
- call mpi_bcast(x(lmass),natom,MPI_DOUBLE_PRECISION,0,commmaster,ierr)
- call mpi_bcast(x(lwinv),natom,MPI_DOUBLE_PRECISION,0,commmaster,ierr)
- call mpi_bcast(x(l75),natom,MPI_DOUBLE_PRECISION,0,commmaster,ierr)
- end if
- tmass = sum(x(lmass:lmass+natom-1))
- tmassinv = 1.d0/tmass
-
- ! next, do a minimal sanity check that the SHAKE parameters are
- ! consistent on the two processors:
-
- ! For Softcore this might be allowed
- ! Put a better check here later
- if( ntc == 2 .and. ifsc == 0) then
- partner = ieor(masterrank,1)
- call mpi_sendrecv( nbonh, 1, MPI_INTEGER, partner, 5, &
- nbonh_c, 1, MPI_INTEGER, partner, 5, &
- commmaster, ist, ierr )
- call mpi_sendrecv( num_noshake, 1, MPI_INTEGER, partner, 5, &
- num_noshake_c, 1, MPI_INTEGER, partner, 5, &
- commmaster, ist, ierr )
- if (qmmm_nml%ifqnt .and. qmmm_nml%qmshake == 0) then
- ! qtw - if qmshake=0, we need to check the QM atoms
- call mpi_sendrecv( &
- qmmm_struct%nquant, 1, MPI_INTEGER, partner, 5, &
- nquant_c, 1, MPI_INTEGER, partner, 5, &
- commmaster, ist, ierr)
- call mpi_sendrecv( &
- qmmm_struct%noshake_overlap, 1, MPI_INTEGER,partner, 5, &
- noshake_overlap_c, 1, MPI_INTEGER, partner, 5, &
- commmaster, ist, ierr)
- if ( (qmmm_struct%nquant-qmmm_struct%noshake_overlap) /= &
- (nquant_c-noshake_overlap_c) ) then
- call sander_bomb('mdread2', &
- 'QMMM: NOSHAKE lists are not match in two groups!', &
- 'try noshakemask in cntrl to match the noshake list')
- end if
- else if( nbonh - num_noshake /= nbonh_c - num_noshake_c ) then
- write(6,*) 'SHAKE lists are not compatible in the two groups!'
- call mexit(6,1)
- end if
- else if( ntc == 3 ) then
- write(6,*) 'ntc = 3 is not compatible with icfe>0'
- call mexit(6,1)
- end if
-
- end if
-#endif
-
- if ( iamoeba /= 1 )then
- if( igb == 0 .and. ipb == 0 ) &
- call init_extra_pts( &
- ix(iibh),ix(ijbh),ix(iicbh), &
- ix(iiba),ix(ijba),ix(iicba), &
- ix(i24),ix(i26),ix(i28),ix(i30), &
- ix(i32),ix(i34),ix(i36),ix(i38), &
- ix(i40),ix(i42),ix(i44),ix(i46),ix(i48), &
- ix(i50),ix(i52),ix(i54),ix(i56),ix(i58), &
- ih(m06),ix,x,ix(i08),ix(i10), &
- nspm,ix(i70),x(l75),tmass,tmassinv,x(lmass),x(lwinv),req)
- endif
-
- ! DEBUG input; force checking
- call load_debug(5)
-
- return
- ! -------------------------------------------------------------------------
- ! Standard format statements:
-
- 9328 format(/80('-')/,' 2. CONTROL DATA FOR THE RUN',/80('-')/)
- 9408 format(/4x,'LOADING THE CONSTRAINED ATOMS AS GROUPS',/)
- 9409 format(/4x,'LOADING THE TARGETED MD ATOMS AS GROUPS',/)
- 9418 format(/4x,'LOADING THE BELLY ATOMS AS GROUPS',/)
- 9428 format(/4x,'LOADING THE DECOMP ATOMS AS GROUPS',/)
- 9008 format(a80)
-end subroutine mdread2
-
-
-!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-!+ Emit defined preprocessor names, ie, flags.
-subroutine printflags()
-
- implicit none
- integer max_line_length
- parameter ( max_line_length = 80 )
-
- character(len=max_line_length) line ! output string of active flags
- integer n ! len(line)
-
- line = '| Flags:'
- n = 8
-
-#ifdef ISTAR2
- call printflags2(' ISTAR2',7,n,line,.false.)
-#endif
-#ifdef MPI
- call printflags2(' MPI',4,n,line,.false.)
-# ifdef USE_MPI_IN_PLACE
- call printflags2(' USE_MPI_IN_PLACE',17,n,line,.false.)
-# endif
-#endif
-#ifdef LES
- call printflags2(' LES',4,n,line,.false.)
-#endif
-#ifdef NMODE
- call printflags2(' NMODE',6,n,line,.false.)
-#endif
-#ifdef HAS_10_12
- call printflags2(' HAS_10_12',10,n,line,.false.)
-#endif
-#ifdef DNA_SHIFT
- call printflags2(' DNA_SHIFT',10,n,line,.false.)
-#endif
-#ifdef MMTSB
- call printflags2(' MMTSB',6,n,line,.false.)
-#endif
-
-#ifdef noVIRIAL
- call printflags2(' noVIRIAL',9,n,line,.false.)
-#endif
-
- call printflags2(' ',1,n,line,.true.)
- return
-end subroutine printflags
-
-
-!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-!+ Primitive pre-Fortran90 implementation of printflags.
-subroutine printflags2(flag,flag_len,line_len,line,last)
-
- implicit none
- integer max_line_length
- parameter ( max_line_length = 80 )
-
- character(*) flag ! flag name with blank prefix, intent(in)
- integer flag_len ! len(flag), intent(in)
- integer line_len ! len(line), intent(inout)
- character(len=max_line_length) line ! intent(inout)
- logical last ! is this the last flag ?, intent(in)
-
- if (line_len + flag_len > max_line_length) then
- write( 6,'(a)') line
- ! begin another line
- line = '| Flags:'
- line_len=8
- end if
- line=line(1:line_len) // flag(1:flag_len)
- line_len=line_len+flag_len
- if(last)write( 6,'(a)') line
- return
-end subroutine printflags2
-
-!-------------------------------------------------
-! --- FLOAT_LEGAL_RANGE ---
-!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-!+ Check the range of a float; abort on illegal values.
-subroutine float_legal_range(string,param,lo,hi)
- implicit none
- _REAL_ param,lo,hi
- character(len=*)string
-
- if ( param < lo .or. param > hi )then
- write(6,59)
- write(6,60)string,param
- write(6,61)
- write(6,62)lo,hi
- write(6,63)
- call mexit(6,1)
- end if
- 59 format(/,1x,'Ewald PARAMETER RANGE CHECKING: ')
- 60 format(1x,'parameter ',a,' has value ',e12.5)
- 61 format(1x,'This is outside the legal range')
- 62 format(1x,'Lower limit: ',e12.5,' Upper limit: ',e12.5)
- 63 format(1x,'Check ew_legal.h')
- return
-end subroutine float_legal_range
-
-!-------------------------------------------------
-! --- INT_LEGAL_RANGE ---
-!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-!+ Check the range of an integer; abort on illegal values.
-subroutine int_legal_range(string,param,lo,hi)
- implicit none
- integer param,lo,hi
- character(len=*)string
-
- if ( param < lo .or. param > hi )then
- write(6,59)
- write(6,60)string,param
- write(6,61)
- write(6,62)lo,hi
- write(6,63)
- call mexit(6,1)
- end if
- 59 format(/,1x,'PARAMETER RANGE CHECKING: ')
- 60 format(1x,'parameter ',a,' has value ',i8)
- 61 format(1x,'This is outside the legal range')
- 62 format(1x,'Lower limit: ',i8,' Upper limit: ',i8)
- 63 format(1x,'The limits may be adjustable; search in the .h files ')
- return
-end subroutine int_legal_range
-
-!-------------------------------------------------
-! --- OPT_LEGAL_RANGE ---
-!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-!+ Check the range of an integer option; abort on illegal values.
-subroutine opt_legal_range(string,param,lo,hi)
- implicit none
- integer param,lo,hi
- character(len=*)string
-
- if ( param < lo .or. param > hi )then
- write(6,59)
- write(6,60)string,param
- write(6,61)
- write(6,62)lo,hi
- write(6,63)
- call mexit(6,1)
- end if
- 59 format(/,1x,'Ewald OPTION CHECKING: ')
- 60 format(1x,'option ',a,' has value ',i5)
- 61 format(1x,'This is outside the legal range')
- 62 format(1x,'Lower limit: ',i5,' Upper limit: ',i5)
- 63 format(1x,'Check the manual')
- return
-end subroutine opt_legal_range
-#endif /*ifndef PBSA*/
-
-!-------------------------------------------------
-! --- SANDER_BOMB ---
-!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-!+ Print an error message and quit
-subroutine sander_bomb(routine,string1,string2)
- implicit none
- character(len=*) routine,string1,string2
-
- write(6, '(1x,2a)') &
- 'SANDER BOMB in subroutine ', routine
- write(6, '(1x,a)') string1
- write(6, '(1x,a)') string2
- call mexit(6,1)
-end subroutine sander_bomb
-!-------------------------------------------------
-
-!-------------------------------------------------
-! --- remove_charges ---
-!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-!+ Zero charges on some atoms
-subroutine remove_charges(crggp,natom,charge)
- use constants, only: INV_AMBER_ELECTROSTATIC
- implicit none
- integer natom, crggp(*),i
- _REAL_ charge(*), charge_removed
-
- charge_removed = 0.d0
- do i=1,natom
- if (crggp(i)==1) then
- charge_removed = charge_removed + charge(i) * INV_AMBER_ELECTROSTATIC
- write (6,'(a,f12.4,a,i5)') 'Removing charge of ', charge(i) * INV_AMBER_ELECTROSTATIC,' from atom ',i
- charge(i)=0
- end if
- end do
- write(6, '(a,f12.4,a)') 'Total charge of ',charge_removed,' removed'
- RETURN
-end subroutine remove_charges
-!-------------------------------------------------
diff --git a/patches/amber14.diff/AmberTools/src/sander/runmd.F90 b/patches/amber14.diff/AmberTools/src/sander/runmd.F90
deleted file mode 100644
index 636fb881eac4c946d6778b65636f5abdf19457bc..0000000000000000000000000000000000000000
--- a/patches/amber14.diff/AmberTools/src/sander/runmd.F90
+++ /dev/null
@@ -1,5450 +0,0 @@
-! <compile=optimized>
-#include "copyright.h"
-#include "../include/dprec.fh"
-#include "../include/assert.fh"
-#include "ncsu-config.h"
-
-!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-!+ driver routine for molecular dynamics
-subroutine runmd(xx,ix,ih,ipairs,x,winv,amass,f, &
- v,vold,xr,xc,conp,skip,nsp,tma,erstop, qsetup)
-
- ! Runmd operates in kcal/mol units for energy, amu for masses,
- ! and angstroms for distances. To convert the input time parameters
- ! from picoseconds to internal units, multiply by 20.455
- ! (which is 10.0*sqrt(4.184)).
-
- use state
-
-#if !defined(DISABLE_NCSU) && defined(NCSU_ENABLE_BBMD)
- use ncsu_sander_hooks, only : ncsu_on_mdstep => on_mdstep
-#endif
-
- use molecule, only: n_iwrap_mask_atoms, iwrap_mask_atoms
- use cmd_vars, only: activate, file_pos_cmd, file_vel_cmd, file_nrg_cmd, &
- nstep_cmd, t_cmd, eq_cmd, restart_cmd, &
- etot_cmd, eke_cmd, temp_cmd
-
- use pimd_vars, only: ipimd, nbead, natomCL, &
- bnd_vir, Eimp_virial, equal_part, Epot_deriv, &
- tau_vol, Epot_spring, NMPIMD, CMD, cartpos, cartvel, &
- itimass, real_mass
-
- use neb_vars, only: ineb, neb_nbead
-
- use lscivr_vars, only: ilscivr, ndof_lsc, natom_lsc, mass_lsc, v2_lsc, &
- ilsc, x_lsc, f_lsc, dx_lsc
-
- use nose_hoover_module, only : thermo_lnv, x_lnv, x_lnv_old, v_lnv, &
- f_lnv_p, f_lnv_v, c2_lnv, mass_lnv, &
- Thermostat_init
-
-#ifdef RISMSANDER
- use sander_rism_interface, only: rismprm,rism_3d, RISM_NONE, RISM_FULL, RISM_INTERP, &
- rism_calc_type, rism_solvdist_thermo_calc, mylcm
-#endif
-
- use full_pimd_vars, only: totener,totenert,totenert2,mybeadid
-
- use qmmm_module, only : qmmm_nml,qmmm_struct, qmmm_mpi, qm2_struct, &
- qmmm_vsolv
- use file_io_dat
- use constants, only : third, ten_to_minus3, plumed, plumedfile
- use trace
- use stack
- use decomp, only : nat, nrs, decpr, jgroup, indx, irespw, &
-#ifdef MPI
- ! -- ti decomp
- collect_dec, &
-#endif
- checkdec, printdec
- use fastwt
- use bintraj, only: end_binary_frame
- use nblist,only: fill_tranvec,volume,oldrecip,ucell
-
- use nose_hoover_module, only: Thermostat_switch, &
- Thermostat_integrate_1, Thermostat_integrate_2, & ! APJ
- Thermostat_hamiltonian, & ! APJ
- Adaptive_Thermostat_integrate, & ! APJ
- Adaptive_Thermostat_hamiltonian, & ! APJ
- file_nhc, nchain, thermo, nthermo, Econserved ! APJ
-
-#ifdef MPI
- use evb_parm, only: evb_dyn, nbias
- use evb_data, only: evb_frc, evb_vel0, evb_bias, evb_nrg, evb_nrg_ave &
- , evb_nrg_rms, evb_nrg_tmp, evb_nrg_old, evb_nrg_tmp2 &
- , evb_nrg_old2
- use wigner, only: rflux
- use remd, only : rem, mdloop, remd_ekmh, repnum, stagid, my_remd_data, &
- hybrid_remd_ene, next_rem_method
-# ifdef LES
- use evb_pimd, only: evb_pimd_dealloc
- use miller, only: i_qi
-# endif
- use softcore, only: ifsc, sc_dvdl, sc_tot_dvdl, sc_tot_dvdl_partner, &
- sc_dvdl_ee, sc_tot_dvdl_ee, sc_tot_dvdl_partner_ee, &
- extra_atoms, mix_temp_scaling, sc_pscale, &
- adj_dvdl_stat, sc_mix_velocities, &
- sc_nomix_frc, sc_sync_x, sc_print_energies, &
- calc_softcore_ekin, &
- sc_ener, sc_ener_ave, sc_ener_rms, sc_lngdyn, &
- sc_ener_tmp, sc_ener_tmp2, sc_ener_old, sc_ener_old2, &
- sc_mix_position, sc_print_dvdl_values, &
- sc_degrees_o_freedom, dynlmb, sc_change_clambda, ti_ene_cnt, &
- sc_compare
- use mbar, only : ifmbar, bar_intervall, calc_mbar_energies, &
- bar_collect_cont, do_mbar
-#endif
-
- use amoeba_mdin, only: iamoeba
- use amoeba_runmd, only: AM_RUNMD_scale_cell
- use constantph, only: cnstphinit, cnstphwrite, cnstphupdatepairs, &
- cnstphbeginstep, cnstphendstep, chrgdat, &
- cnstph_explicitmd, cnstphwriterestart, cphfirst_sol
- use emap, only:temap,emap_move
- use barostats, only : mcbar_trial, mcbar_summary
-#ifdef EMIL
- use emil_mod, only : emil_do_calc, emil_calc_AMBER, &
- emil_save_pme, emil_save_gb, &
- emil_init, emil_step
-#endif
- use memory_module, only: coordinate, velocity, mass
-
-! Self-Guided molecular/Langevin Dynamics (SGLD)
- use sgld, only : isgld, isgsta,isgend,trxsgld, &
- sgenergy,sgldw,sgmdw,sgfshake, sg_fix_degree_count
-
- !AWG adaptive QM/MM
- use qmmm_adaptive_module, only: adaptive_qmmm
-
- use crg_reloc, only: ifcr, crprintcharges, cr_print_charge
-
- use abfqmmm_module, only: abfqmmm_param, abfqmmm_combine_forces ! lam81
-!AMD
- use amd_mod
-
-!scaledMD
- use scaledMD_mod
-
-!SEBOMD
- use sebomd_module, only : sebomd_obj, sebomd_gradient_write, sebomd_hessian_compute
-
-! Variable Descriptions
-!
-! Passed variables
-! xx : global real array. See locmem.f for structure/pointers
-! ix : global integer array. See locmem.f for structure/pointers
-! ih : global hollerith array. See locmem.f for structure/pointers
-! ipairs : ?? Global pairlist ?? --add description (JMS 11/2010)
-! x : global position array *
-! winv : array with inverse masses *
-! amass : mass array *
-! f : force array, used to hold old coordinates temporarily, too
-! v : velocity array
-! vold : old velocity array, from the previous step
-! xr : coordinates with respect to COM of molecule
-! conp : bond parameters for SHAKE
-! skip : logical skip array for SHAKE (and QM/MM too, I think)
-! nsp : submolecule index array (?)
-! tma : submolecular weight array (?)
-! erstop : should we stop in error (?)
-! qsetup : Not quite sure what this does, if anything anymore.
-!
-! Local variables
-! factt : degree-of-freedom correction factor for temperature scaling
-! nr : local copy of nrp, number of atoms
-! nr3 : 3 * nr, used for runtime efficiency
-!
-! Common memory variables
-! nrp : number of atoms, adjusted for LES copies
-
- implicit none
- character(kind=1,len=5) :: routine="runmd"
- integer ipairs(*), ix(*)
- _REAL_ xx(*)
- character(len=4) ih(*)
- _REAL_ combination, rem_val
-
-#ifdef MPI
-# include "parallel.h"
- include 'mpif.h'
-# ifdef LES
- _REAL_ :: fbead(3,natomCL), xbead(3,natomCL)
- integer :: mm, n
-# endif
- _REAL_ mpitmp(8) !Use for temporary packing of mpi messages.
- integer ist(MPI_STATUS_SIZE), partner, ierr
-#else
- ! mdloop and REM is always 0 in serial
- integer, parameter :: mdloop = 0, rem = 0
-#endif
-
-! The following variables are needed since nstep and nstlim
-! behave differently in a REMD run.
-! In certain places where output is required, total_nstep and total_nstlim
-! take the place of nstep and nstlim. This allows replica runs to output
-! less often than every exchange.
-! They are the absolute step # of the REMD or MD simulation.
- integer total_nstep, total_nstlim
-
-#include "../include/md.h"
-#include "box.h"
-#include "nmr.h"
-#include "tgtmd.h"
-#include "multitmd.h"
-#include "../include/memory.h"
-#include "extra.h"
-#include "ew_frc.h"
-#include "ew_cntrl.h"
-#include "ew_mpole.h"
-#include "def_time.h"
-#include "extra_pts.h"
-#if defined(LES)
-# include "les.h"
-#endif
-#include "../pbsa/pb_md.h"
-#include "../lib/random.h"
-
-! additional variables for PIMD output
- _REAL_ :: xcmd(3*natomCL),vcmd(3*natomCL)
- integer :: ncmd
- ! for const press PIMD
- _REAL_ tmpvir(3,3),atomvir
-
- _REAL_ sgsta_rndfp, sgend_rndfp, ignore_solvent
- _REAL_ sysx,sysy,sysz,sysrange(3,2)
- logical mv_flag
-
-#ifdef MMTSB
-# include "mmtsb.h"
- logical is_done_mmtsb ! MMTSB replica exchange calculation completed
- _REAL_ lambda_mmtsb ! MMTSB replica exchange new lambda
- _REAL_ pert_pe_mmtsb ! MMTSB lambda replica exchange perturbed PE
- _REAL_ temp_mmtsb ! MMTSB replica exchange new temperature
- _REAL_ unpert_pe_mmtsb ! MMTSB lambda replica exchange unperturbed PE
-#endif
-
- _REAL_ , dimension(1) :: shkh
- integer, dimension(1) :: ifstwr2
- integer :: nshkh
-
- integer idx, iatom, iatomCL,m
- _REAL_ Ekin2_tot,tmp ! APJ
- integer :: idim, ithermo
- _REAL_ :: E_nhc, exp1, exp2, v_sum
-
- logical ivscm
- logical qspatial
- character(len=6)fnam
-
- logical resetvelo
- integer nshak
- _REAL_ ekgs,eold3,eold4,etot_save,ekpbs
-
- logical do_list_update
- logical skip(*),belly,lout,loutfm,erstop,vlim,onstep
- _REAL_ x(*),winv(*),amass(*),f(*),v(*),vold(*), &
- xr(*),xc(*),conp(*)
- type(state_rec) :: ener ! energy values per time step
- type(state_rec) :: enert ! energy values tallied over the time steps
- type(state_rec) :: enert2 ! energy values squared tallied over the time steps
- type(state_rec) :: enert_old, enert2_old
- type(state_rec) :: enert_tmp, enert2_tmp
- type(state_rec) :: ecopy, edvdl
- type(state_rec) :: edvdl_r
- _REAL_ rmu(3),fac(3),onefac(3),clfac, etot_start
- _REAL_ tma(*)
-
- _REAL_ tspan,atempdrop,fln,scaltp,scaltpo
- _REAL_ vel,vel2,vcmx,vcmy,vcmz,vmax,vx,vy,vz
- _REAL_ winf,aamass,rterm,ekmh,ekph,ekpht,wfac,rsd,ekav
- _REAL_ fit,fiti,fit2,vscalt
- logical is_langevin ! Is this a Langevin dynamics simulation
- _REAL_ gammai,c_implic,c_explic,c_ave,sdfac,ekins0
- _REAL_ dtx,dtxinv,dt5,factt,ekin0,ekinp0,dtcp,dttp
- _REAL_ rndf,rndfs,rndfp,boltz2,pconv,tempsu
- _REAL_ xcm(3),acm(3),ocm(3),vcm(3),ekcm,ekrot
- _REAL_ emtmd
-
-! Variables and parameters for constant surface tension:
- _REAL_, parameter :: ten_conv = 100.0d0 !ten_conv - converts
- !dyne/cm to bar angstroms
- _REAL_ :: pres0x
- _REAL_ :: pres0y
- _REAL_ :: pres0z
- _REAL_ :: gamma_ten_int
- _REAL_ :: press_tan_ave
-
- integer nsp(*)
- integer idumar(4)
- integer l_temp
- integer i,j,im,i3,nitp,nits, iskip_start,iskip_end ! APJ
- integer nstep,nrep,nrek,nren,iend,istart3,iend3
- integer nrx,nr,nr3,ntcmt,izero,istart
- logical ixdump,ivdump,itdump,ifdump
- logical qsetup
- _REAL_, allocatable, dimension(:) :: for ! lam81
-#ifdef RISMSANDER
- logical irismdump
- _REAL_ cm(3),angvel(3),r(3),rxv(3),proj(3),moi,erot
-#endif
-
- integer nvalid, nvalidi
- _REAL_ eke,eket
- _REAL_ extent
-
- _REAL_ xcen,ycen,zcen,extents(3,2)
- _REAL_, allocatable, dimension(:) :: frcti
- integer ier
-
- _REAL_ small
- data small/1.0d-7/
- data nren/51/
-
- !--- VARIABLES FOR DIPOLE PRINTING ---
- integer prndipngrp
- integer prndipfind
- character(len=4) prndiptest
-
- _REAL_,parameter :: pressure_constant = 6.85695d+4
- ! variables used in constant pressure PIMD
- _REAL_ :: Nkt,centvir,pressure, aa, arg2, poly, e2, e4, e6, e8
- ! variable used in CMD
- real(8) :: tmp_eke_cmd !Use for temporary packing of mpi messages.
-
- _REAL_ :: box_center(3)
-
-! for adaptive qm/mm runs
-
- _REAL_ :: adqmmm_first_energy, etotcorr, tadc
- integer :: nstepadc
- logical :: flag_first_energy = .true.
-
- _REAL_ :: xold(3*natom)
- _REAL_ :: corrected_energy
- _REAL_ :: kinetic_E_save(2)
- integer :: aqmmm_flag
-
-! variables for plumed
- _REAL_ :: plumed_box(3,3),plumed_virial(3,3), plumed_kbt
- integer :: plumed_version,plumed_stopflag,plumed_ms
- _REAL_ :: plumed_energyUnits,plumed_timeUnits,plumed_lengthUnits,plumed_chargeUnits
-
- !==========================================================================
-
- call trace_enter( 'runmd' )
-
- ! ----- INITIALIZE SOME VARIABLES -----
-
-#ifdef MPI
- if( master ) then
- ! If remd, runmd will be called many times, so we dont want to open every
- ! time. For normal md, mdloop will just be 0.
- if (mdloop.eq.0) call amopen(7,mdinfo,'U','F',facc)
- endif
-
- if (rem < 3) then
- rem_val = temp0
- else if (rem == 4) then
- rem_val = solvph
- else
- rem_val = 0.d0
- end if
-#else
- if( master ) call amopen(7,mdinfo,'U','F','W')
-#endif
- vlim = vlimit > small
- ntcmt = 0
- izero = 0
- belly = ibelly > 0
- lout = .true.
- loutfm = ioutfm <= 0
- nr = nrp
- nr3 = 3*nr
- ekmh = 0.d0
-
- aqmmm_flag = 0
-
-#ifdef LES
- ekmhles = 0.d0
-#endif
- do_list_update=.false.
-#ifdef MPI
- if ( mpi_orig ) then
- istart = 1
- iend = natom
- else
- istart = iparpt(mytaskid) + 1
- iend = iparpt(mytaskid+1)
- end if
-#else
- istart = 1
- iend = nr
-#endif
- istart3 = 3*istart -2
- iend3 = 3*iend
-
-#ifdef MPI
- if( icfe /= 0 ) then
- allocate( frcti( nr3+3*extra_atoms ), stat = ier )
- REQUIRE( ier == 0 )
- end if
-#endif
-
- ! If NTWPRT.NE.0, only print the atoms up to this value
- nrx = nr3
- if (ntwprt > 0) nrx = ntwprt*3
-
- if (.not. allocated(for)) allocate(for(nr3)) ! lam81
-
- if(abfqmmm_param%abfqmmm == 1) then ! lam81
-#ifdef MPI
- call xdist(v, xx(lfrctmp), natom) ! lam81
-#endif
- if(abfqmmm_param%system == 1) then ! lam81
- if(abfqmmm_param%qmstep == 1) abfqmmm_param%v(1:nr3+iscale) = v(1:nr3+iscale) ! lam81
- v(1:nr3+iscale) = 0.d0 ! lam81
- t = t+dt ! lam81
- if(abfqmmm_param%maxqmstep == 0) t = 0 ! lam81
- else ! lam81
- v(1:nr3+iscale) = abfqmmm_param%v(1:nr3+iscale) ! lam81
- endif ! lam81
- endif ! lam81
-
- ! Cleanup the velocity if belly run
- if(belly) call bellyf(nr,ix(ibellygp),v)
-
- !=======================================================================
- ! Determine system degrees of freedom (for T scaling, reporting)
-
- ! Call DEGCNT to get the actual number of degrees of freedom for the
- ! solute and solvent. This call returns the correct numbers for belly
- ! simulations and simulations with separate solute/solvent scaling -- dap
- ! "IDUMAR" is dummy array. Used since this routine was also used w/ GIBBS.
-
-#ifdef LES
- ! return LES and non-LES degrees,
- ! since separate solvent coupling no longer used
- ! large changes to degcnt were made
- ! cnum is now passed (LES copy number of each atom)
- call degcnt(ibelly,nr,ix(ibellygp),nsolut,nbonh,nbona,0, &
- ix(iibh),ix(ijbh),ix(iiba),ix(ijba),idumar, &
- idumar,ntc,idumar,0,0,0, &
- idumar,rndfp,rndfles,cnum,temp0les)
-
- ! RNDFP = # degrees of freedom for solute
- ! RNDFS = # degrees of freedom for solvent
- ! RNDF = total number of degrees of freedom.
- ! RNDFLES = # degrees of freedom for LES groups
-
- ! temp0les was init to negative number to signify not to use a LES bath
- ! just do standard code (meaning use solute/solvent baths)
- ! any positive (or zero) means to use LES bath with that target
-
- ! degcnt returns rndfs or rndfles in the rndfles variable
- ! depending on whether a LES bath was specified
- ! do this instead of duplicating call with rndfs or rndfles
-
- if (temp0les < 0.d0) then
- rndfs=rndfles
- rndfles=0.d0
- else
- rndfs=0.d0
- end if
-
- if (master) then
- write (6,'(a,f8.0)') &
- "# degrees of freedom in non-LES region: ",rndfp
- write (6,'(a,f8.0)') &
- "# degrees of freedom in LES region: ",rndfles
- end if
-
- ! modify RNDFP to reflect NDFMIN (set in mdread)
-
- rndfp = rndfp - ndfmin
-
- if (temp0les < 0.d0) then
- rndf = rndfp+rndfs
- else
- rndf = rndfp+rndfles
- end if
-
-#else
-
- call degcnt(ibelly,nr,ix(ibellygp),nsolut,nbonh,nbona,0, &
- ix(iibh),ix(ijbh),ix(iiba),ix(ijba),idumar, &
- idumar,ntc,idumar,0,0,0, &
- idumar,rndfp,rndfs)
-
- ! RNDFP = # degrees of freedom for solute
- ! RNDFS = # degrees of freedom for solvent
- ! RNDF = total number of degrees of freedom.
-
-#ifdef MPI
- if (mdloop .eq. 0 .and. master) then
-#else
- if (master) then
-#endif
- if (abfqmmm_param%abfqmmm /= 1 .or. (abfqmmm_param%qmstep == 1 .and. abfqmmm_param%system == 1)) then ! lam81
- write (6,'(a,f8.0)') &
- "| # of SOLUTE degrees of freedom (RNDFP): ",rndfp
- write (6,'(a,f8.0)') &
- "| # of SOLVENT degrees of freedom (RNDFS): ",rndfs
- end if ! lam81
- end if
- ! qtw - substract the number of overlapping noshake QM atoms in noshakemask
- rndfp = rndfp - qmmm_struct%noshake_overlap
- ! modify RNDFP to reflect NDFMIN (set in mdread) and num_noshake
- rndfp = rndfp - ndfmin + num_noshake
- rndf = rndfp + rndfs
-#ifdef MPI
- if (mdloop .eq. 0 .and. master) then
-#else
- if (master) then
-#endif
- if (abfqmmm_param%abfqmmm /= 1 .or. (abfqmmm_param%qmstep == 1 .and. abfqmmm_param%system == 1)) then ! lam81
- if (qmmm_nml%ifqnt) then
- write (6,'(a,i6)') &
- "| QMSHAKE_NOSHAKEMASK_OVERLAP = ", qmmm_struct%noshake_overlap
- endif
- write (6,'(a,f8.0,a,i6,a,f8.0)') &
- "| NDFMIN = ",rndfp, " NUM_NOSHAKE = ",num_noshake, " CORRECTED RNDFP = ", rndfp
- write (6,'(a,f8.0)') &
- "| TOTAL # of degrees of freedom (RNDF) = ", rndf
- end if ! lam81
- end if
-
-#endif
-
- call fix_degree_count(rndf) ! correct for extra points
-! Warning - NOTE that rndfp, rndfs are uncorrected in an extra points context!
-
-#ifndef LES
- if (isgld > 0) then
- ! number of degrees of freedom in the SGLD part
- if (isgsta == 1) then
- sgsta_rndfp = 0
- else
- call degcnt(ibelly,nr,ix(ibellygp),isgsta-1,nbonh,nbona,0, &
- ix(iibh),ix(ijbh),ix(iiba),ix(ijba),idumar, &
- idumar,ntc,idumar,0,0,0,idumar,sgsta_rndfp,ignore_solvent)
- end if
- if (isgend == nr) then
- sgend_rndfp = rndf
- else
- call degcnt(ibelly,nr,ix(ibellygp),isgend,nbonh,nbona,0, &
- ix(iibh),ix(ijbh),ix(iiba),ix(ijba),idumar, &
- idumar,ntc,idumar,0,0,0,idumar,sgend_rndfp,ignore_solvent)
- end if
-! Warning - NOTE that the solute ndf outputs above from degcnt are uncorrected
-! for qmmm_struct%noshake_overlap, num_noshake, and extra points;
-! also ndfmin is not always being handled.
- call sg_fix_degree_count(sgsta_rndfp, sgend_rndfp, ndfmin, rndf)
- end if
-#endif
-
-#ifdef MPI /* SOFT CORE */
- if (ifsc /=0 ) call sc_degrees_o_freedom(ndfmin)
-#endif
-
- ! End of degrees of freedom setup
- !=======================================================================
-
- boltz2 = 8.31441d-3 * 0.5d0
- pconv = 1.6604345d+04 ! factor to convert the pressure kcal/mole to bar
-
- ! ---convert to kcal/mol units
-
- boltz2 = boltz2/4.184d0 ! k-sub-B/2
- dtx = dt*20.455d+00
- dtxinv = 1.0d0 / dtx
- dt5 = dtx * 0.5d0
- pconv = pconv*4.184d0
-
- ! FAC() are #deg freedom * kboltz / 2
- ! multiply by T to get expected kinetic energy
- ! FAC(1) is for total system
-
- fac(1) = boltz2*rndf
- fac(2) = boltz2*rndfp
-
- if(rndfp < 0.1d0) fac(2) = 1.d-6
-
-#ifdef LES
- ! replaced solvent variables with LES ones
- ! since separate solvent coupling no longer used
- ! ASSUME SAME COUPLING CONSTANT FOR BOTH BATHS, just different target T
-
- ! will also have to accumulate LES and non-LES kinetic energies separately
-
- if (temp0les < 0.d0) then
- fac(3) = boltz2*rndfs
- if(rndfs < 0.1d0) fac(3) = 1.d-6
- else
- fac(3) = boltz2*rndfles
- if(rndfles < 0.1d0) fac(3) = 1.d-6
- end if
-#else
- fac(3) = boltz2*rndfs
- if(rndfs < 0.1d0) fac(3) = 1.d-6
-#endif
- if ( ipimd==CMD ) then
- if ( eq_cmd ) then
- fac(1) = boltz2 * dble( 3*natomCL )
- else
- fac(1) = boltz2 * dble( 3*(natomCL-1) )
- endif
- endif
- onefac(1) = 1.0d0/fac(1)
- onefac(2) = 1.0d0/fac(2)
- onefac(3) = 1.0d0/fac(3)
- factt = rndf/(rndf+ndfmin)
-
- ! these are "desired" kinetic energies based on
- ! # degrees freedom and target temperature
- ! they will be used for calculating the velocity scaling factor
-
- ekinp0 = fac(2)*temp0
-#ifdef LES
-
- ! modified for LES temperature
-
- ekins0=0.d0
- ekinles0=0.d0
- if (temp0les < 0.d0) then
- ekins0 = fac(3) * temp0
- ekin0 = fac(1) * temp0
- if (master) &
- write (6,*) "Single temperature bath for LES and non-LES"
- else
- ekinles0 = fac(3)*temp0les
- ekin0 = ekinp0 + ekinles0
- if (master) then
- write (6,*) "LES particles coupled to separate bath"
- write (6,'(a,f8.2)')" LES target temperature: ",temp0les
- write (6,'(a,f8.2)')" LES target kinetic energy: ",ekinles0
- write (6,'(a,f8.2)')"non-LES target temperature: ",temp0
- write (6,'(a,f8.2)')"non-LES target kinetic energy: ",ekinp0
- end if
- end if
-#else
- ekins0 = fac(3)*temp0
- ekin0 = fac(1)*temp0
-#endif
-
-#ifdef LES
- if(abfqmmm_param%abfqmmm /= 1) then ! lam81
- if ( ntt==4 ) call nose_hoover_init_LES(amass,v,f) ! APJ
- else ! lam81
- if ( ntt==4 .and. abfqmmm_param%qmstep == 1 .and. abfqmmm_param%system == 1 ) & ! lam81
- call nose_hoover_init_LES(amass,abfqmmm_param%v,abfqmmm_param%f) ! lam81
- endif ! lam81
-#else
- if(abfqmmm_param%abfqmmm /= 1) then ! lam81
- if ( ntt>=4 .and. ntt<=8 ) call nose_hoover_init(amass,v,f) ! APJ
- else ! lam81
- if ( ntt>=4 .and. ntt<=8 .and. abfqmmm_param%qmstep == 1 .and. abfqmmm_param%system == 1 ) & ! lam81
- call nose_hoover_init(amass,abfqmmm_param%v,abfqmmm_param%f) ! lam81
- endif
-#endif
-
- ! Langevin dynamics setup:
-
- is_langevin = gamma_ln > 0.0d0
- gammai = gamma_ln/20.455d0
- c_implic = 1.d0/(1.d0+gammai*dt5)
- c_explic = 1.d0 - gammai*dt5
- c_ave = 1.d0+gammai*dt5
- sdfac = sqrt( 4.d0*gammai*boltz2*temp0/dtx )
-#ifdef LES
- if( temp0les < 0.d0 ) then
- sdfacles = sqrt( 4.d0*gammai*boltz2*temp0/dtx )
- else
- sdfacles = sqrt( 4.d0*gammai*boltz2*temp0les/dtx )
- endif
-#endif
- if (is_langevin .and. ifbox==0) then
- call get_position(nr,x,sysx,sysy,sysz,sysrange,0)
-#ifdef MPI /* SOFT CORE */
- if (ifsc == 1) call sc_mix_position(sysx,sysy,sysz,clambda)
-#endif
- end if
-
- ! Constant pH setup
- !
- if (icnstph /= 0 .and. mdloop .eq. 0) &
- call cnstphinit(x, ig)
-
- if (ntt == 1) dttp = dt/tautp
- if (ntp > 0) dtcp = comp * 1.0d-06 * dt / taup
-
- ! Constant surface tension setup:
-
- if (csurften > 0) then
-
- ! Set pres0 in direction of surface tension.
- ! The reference pressure is held constant in on direction dependent
- ! on what the surface tension direction is set to.
- if (csurften .eq. 1) then ! pres0 in the x direction
- pres0x = pres0
-
- else if (csurften .eq. 2) then ! pres0 in the y direction
- pres0y = pres0
-
- !else if (csurften .eq. 3) then ! pres0 in the z direction
- else
- pres0z = pres0
-
- end if
-
- ! Multiply surface tension by the number of interfaces
- gamma_ten_int = dble(ninterface) * gamma_ten
-
- end if
-
- nrek = 4
- nrep = 15
-
- nvalid = 0
- nvalidi = 0
- nstep = 0
- total_nstep = 0
-#ifdef MPI
- ! For REMD, total_nstep is the number of steps * the number of exchanges
- ! we've already attempted
- if (rem /= 0) &
- total_nstep = (mdloop - 1) * nstlim
-#endif
- fit = 0.d0
- fiti = 0.d0
- fit2 = 0.d0
-
- ! Zero all elements of these sequence types
- ener = null_state_rec
- enert = null_state_rec
- enert2 = null_state_rec
- enert_old = null_state_rec
- enert2_old = null_state_rec
- edvdl = null_state_rec
- edvdl_r = null_state_rec
- ! for PIMD/NMPIMD/CMD/RPMD:
- totenert = null_state_rec
- totenert2 = null_state_rec
-
- ener%kin%pres_scale_solt = 1.d0
- ener%kin%pres_scale_solv = 1.d0
- ener%box(1:3) = box(1:3)
-
-
- ener%cmt(1:4) = 0.d0
- nitp = 0
- nits = 0
-
-! init PLUMED
- if(plumed.eq.1) then
- call plumed_f_gcreate()
-#ifdef DPREC
- call plumed_f_gcmd("setRealPrecision"//char(0),8)
-#else
- call plumed_f_gcmd("setRealPrecision"//char(0),4)
-#endif
- call plumed_f_gcmd("getApiVersion"//char(0),plumed_version)
- if(plumed_version>1)then
- plumed_kbt=2.0*temp0*boltz2
- call plumed_f_gcmd("setKbT"//char(0),plumed_kbt)
- endif
- plumed_energyUnits=4.184
- plumed_lengthUnits=0.1
- plumed_timeUnits=1.0
- plumed_chargeUnits=1.0/18.2223
- call plumed_f_gcmd("setMDEnergyUnits"//char(0),plumed_energyUnits)
- call plumed_f_gcmd("setMDLengthUnits"//char(0),plumed_lengthUnits)
- call plumed_f_gcmd("setMDTimeUnits"//char(0),plumed_timeUnits)
- if(plumed_version>3)then
- call plumed_f_gcmd("setMDChargeUnits"//char(0),plumed_chargeUnits)
- endif
- call plumed_f_gcmd("setPlumedDat"//char(0),trim(adjustl(plumedfile))//char(0))
- call plumed_f_gcmd("setNatoms"//char(0),nr)
- call plumed_f_gcmd("setMDEngine"//char(0),"amber")
- call plumed_f_gcmd("setTimestep"//char(0),dt)
-# ifdef MPI
- call plumed_f_gcmd("setMPIFComm"//char(0),commsander)
- if(numgroup>1)then
- call plumed_f_gcmd("GREX setMPIFIntracomm"//char(0),commsander)
- if(master) then
- call plumed_f_gcmd("GREX setMPIFIntercomm"//char(0),commmaster)
- endif
- call plumed_f_gcmd("GREX init"//char(0),0)
- endif
-# endif
- call plumed_f_gcmd("init"//char(0),0);
-
-
-! if(ifbox/=0 .and. ifbox/=1 .and. ifbox/=2) then
-! write (6,*) "!!!!! PLUMED ERROR: Only orthorhombic and truncted octahedron cells are supported in this release."
-! write (6,*) "!!!!! ABORTING RUN"
-! stop
-! endif
-! call init_metadyn(nr,dt,amass,xx(l15),ifbox,0,trim(adjustl(plumedfile))//char(0))
- continue
- endif
- ! end init PLUMED
-
-
-
- !=======================================================================
- ! ----- MAKE A FIRST DYNAMICS STEP -----
- !=======================================================================
- ! init = 3: general startup if not continuing a previous run
-
- if( ipimd.eq.NMPIMD .or. ipimd.eq.CMD) then
- call trans_pos_cart_to_nmode( x )
- end if
-
- if( init == 3 .or. nstlim == 0 .or. (abfqmmm_param%abfqmmm == 1 .and. abfqmmm_param%system == 1) ) then ! lam81
- if (ntp > 0 .and. iamoeba==0 .and. ipimd==0) then
- xr(1:nr3) = x(1:nr3)
-
- ! ----- CALCULATE THE CENTER OF MASS ENERGY AND THE COORDINATES
- ! OF THE SUB-MOLECULES WITH RESPECT TO ITS OWN CENTER OF
- ! MASS -----
- call ekcmr(nspm,nsp,tma,ener%cmt,xr,v,amass,1,nr)
- end if
-
- ! ----- CALCULATE THE FORCE -----
-
- ! --- set irespa to get full energies calculated on step "0":
- irespa = 0
- iprint = 1
-
- if(ipimd==NMPIMD .or. ipimd==CMD) then
- call trans_pos_nmode_to_cart(x,cartpos)
- call force(xx,ix,ih,ipairs,cartpos,f,ener,ener%vir, &
- xx(l96),xx(l97),xx(l98),xx(l99), qsetup, &
- do_list_update,nstep)
-#if defined(MPI) && defined(LES)
- if ( ievb == 1 .and. i_qi > 0) then
- call evb_umb ( f, cartpos, real_mass, natom, istart3, iend3 )
-! 03132009 if( i_qi == 2 ) call qi_corrf_les ( cartpos, amass )
- if( i_qi == 2 ) call qi_corrf_les ( cartpos, real_mass )
- evb_nrg(1) = evb_frc%evb_nrg
- evb_nrg(2) = evb_vel0%evb_nrg
- if( nbias > 0 ) evb_nrg(3) = sum( evb_bias%nrg_bias(:) )
- endif
-#endif
-
- call trans_frc_cart_to_nmode(f)
- i3 = 3*(istart-1)
-
-#if defined(MPI) && defined(LES)
- if ( ievb /= 0 .and. i_qi == 0 ) then
- call evb_umb ( f, x, real_mass, natom, istart3, iend3 )
- evb_nrg(1) = evb_frc%evb_nrg
- evb_nrg(2) = evb_vel0%evb_nrg
- if( nbias > 0 ) evb_nrg(3) = sum( evb_bias%nrg_bias(:) )
- endif
-#endif
-
- else if ( ilscivr == 1 )then
- ! prepare the Hessian Matrix of the potential for the LSC-IVR
- ! at this point, x is the position a bead at equilibrium
- ! initialize the LSC-IVR variables
- natom_lsc = natom
- ndof_lsc = natom * 3
-
- call lsc_init
- do ilsc = 1, natom_lsc
- mass_lsc(3*ilsc-2) = amass(ilsc)
- mass_lsc(3*ilsc-1) = amass(ilsc)
- mass_lsc(3*ilsc ) = amass(ilsc)
- end do
- v2_lsc = 0.0d0
- do ilsc = 1, ndof_lsc
- ! ith vector of the Hesian matrix
- x_lsc = 0.0d0
- x_lsc(1:ndof_lsc) = x(1:ndof_lsc)
- x_lsc(ilsc) = x(ilsc) + dx_lsc
- call force(xx,ix,ih,ipairs,x_lsc,f_lsc,ener,ener%vir, &
- xx(l96),xx(l97),xx(l98),xx(l99), qsetup, &
- do_list_update,nstep)
-
-#ifdef MPI
- call xdist( f_lsc, xx(lfrctmp), natom )
-#endif
- v2_lsc(1:ndof_lsc,ilsc) = f_lsc(1:ndof_lsc)
- enddo
-
- call force(xx,ix,ih,ipairs,x,f,ener,ener%vir, &
- xx(l96),xx(l97),xx(l98),xx(l99), qsetup, &
- do_list_update,nstep)
-
-#ifdef MPI
- call xdist(f, xx(lfrctmp), natom)
-#endif
- ! 2nd derivative of the potential:
- do ilsc = 1, ndof_lsc
- v2_lsc(1:ndof_lsc,ilsc) = &
- ( f(1:ndof_lsc) - v2_lsc(1:ndof_lsc,ilsc) )/dx_lsc
- end do
-
- ! get the iniital position of the momentum:
- call lsc_xp(x,v)
-
- else
-
- ! -- ti decomp
- if(idecomp > 0) then
- decpr = .false.
- if(mod(nstep+1,ntpr) == 0) decpr = .true.
- end if
- call force(xx,ix,ih,ipairs,x,f,ener,ener%vir, &
- xx(l96),xx(l97),xx(l98),xx(l99), qsetup, &
- do_list_update,nstep)
-#ifdef MPI
- if ( ievb /= 0 ) then
-#ifdef LES
- call evb_umb_primitive ( f, x, real_mass, natom, istart, iend )
-#else
- call evb_umb_primitive ( f, x, amass, natom, istart, iend )
-#endif
- evb_nrg(1) = evb_frc%evb_nrg
- evb_nrg(2) = evb_vel0%evb_nrg
- if( nbias > 0 ) evb_nrg(3) = sum( evb_bias%nrg_bias(:) )
- endif
-#endif
-
- endif
-
- if (sebomd_obj%do_sebomd) then
- ! computes hessian matrix if necessary
- if (sebomd_obj%ntwh /= 0) then
- ! don't output atomic charges
- sebomd_obj%iflagch_old = sebomd_obj%iflagch
- sebomd_obj%iflagch = 0
- call sebomd_gradient_write(f,3*natom)
- call sebomd_hessian_compute(xx,ix,ih,ipairs,x,f,ener, &
- qsetup, do_list_update, nstep)
- sebomd_obj%iflagch = sebomd_obj%iflagch_old
- endif
- endif
-
-
- if (icnstph /= 0 .and. master .and. &
- ((rem /= 0 .and. mdloop > 0) .or. rem == 0)) call cnstphwrite(rem)
-
- for(1:nr3) = f(1:nr3) ! lam81
-#ifdef MPI
- call xdist(for,xx(lfrctmp),natom) ! lam81
-#endif
-
- if(abfqmmm_param%abfqmmm == 1) then ! lam81
-
- if(abfqmmm_param%system == 1) abfqmmm_param%f1(1:nr3) = for(1:nr3) ! lam81
-
- if(abfqmmm_param%system == 2) then ! lam81
- abfqmmm_param%f2(1:nr3) = for(1:nr3) ! lam81
- call abfqmmm_combine_forces() ! lam81
- for(1:nr3) = abfqmmm_param%f(1:nr3) ! lam81
- f(1:nr3) = abfqmmm_param%f(1:nr3) ! lam81
- end if ! lam81
-
- end if ! lam81
-
- ! This FORCE call does not count as a "step". CALL NMRDCP to decrement
- ! local NMR step counter and MTMDUNSTEP to decrease the local MTMD step
- ! counter
- call nmrdcp
- call mtmdunstep
-
- !PLUMED force added
- plumed_stopflag=0
- if(plumed.eq.1) then
- call plumed_f_gcmd("setStep"//char(0),nstep)
- call plumed_f_gcmd("setPositions"//char(0),x)
- call plumed_f_gcmd("setMasses"//char(0),amass)
- call plumed_f_gcmd("setCharges"//char(0),xx(l15))
- call plumed_f_gcmd("setEnergy"//char(0),ener%pot)
- call plumed_f_gcmd("setForces"//char(0),f)
- call plumed_f_gcmd("setStopFlag"//char(0),plumed_stopflag)
- plumed_box=0.0
- if(ifbox==0) then
- continue
- else if(ifbox==1) then
- plumed_box(1,1)=box(1)
- plumed_box(2,2)=box(2)
- plumed_box(3,3)=box(3)
- else if(ifbox==2) then
-! truncated octahedron, corresponding to a bcc lattice
-! in AMBER convention, box(1) is the length of the lattice vector
-! a is defined so as the bcc lattice is (a/2,a/2,a/2) (-a/2,-a/2,a/2) (a/2,-a/2,-a/2)
- plumed_box(1,1)=sqrt(1.0/3.0)*box(1)
- plumed_box(2,1)=sqrt(1.0/3.0)*box(1)
- plumed_box(3,1)=sqrt(1.0/3.0)*box(1)
- plumed_box(1,2)=-sqrt(1.0/3.0)*box(1)
- plumed_box(2,2)=-sqrt(1.0/3.0)*box(1)
- plumed_box(3,2)=sqrt(1.0/3.0)*box(1)
- plumed_box(1,3)=sqrt(1.0/3.0)*box(1)
- plumed_box(2,3)=-sqrt(1.0/3.0)*box(1)
- plumed_box(3,3)=-sqrt(1.0/3.0)*box(1)
- else
- write (6,*) "!!!!! PLUMED ERROR: Only orthorhombic and truncted octahedron cells are supported in this release."
- write (6,*) "!!!!! ABORTING RUN"
- stop
- endif
- plumed_virial=0.0
- plumed_virial(1,1)=2.0*ener%vir(1)
- plumed_virial(2,2)=2.0*ener%vir(2)
- plumed_virial(3,3)=2.0*ener%vir(3)
- call plumed_f_gcmd("setVirial"//char(0),plumed_virial)
- call plumed_f_gcmd("setBox"//char(0),plumed_box)
- call plumed_f_gcmd("calc"//char(0),0);
-#ifdef MPI
-! this is required since PLUMED only updates virial on master processor
-#ifdef DPREC
- call mpi_bcast(plumed_virial,9,MPI_DOUBLE_PRECISION,0,commsander,ierr)
-#else
- call mpi_bcast(plumed_virial,9,MPI_REAL,0,commsander,ierr)
-#endif
-#endif
- ener%vir(1)=0.5*plumed_virial(1,1)
- ener%vir(2)=0.5*plumed_virial(2,2)
- ener%vir(3)=0.5*plumed_virial(3,3)
- end if
-
- !PLUMED end
-
-
-#ifdef MPI /* SOFT CORE */
- ! If softcore potentials are used, collect their dvdl contributions:
- if ( ifsc /= 0 ) then
- call mpi_reduce(sc_dvdl, sc_tot_dvdl, 1, MPI_DOUBLE_PRECISION, &
- MPI_SUM, 0, commsander, ierr)
- sc_dvdl=0.0d0 ! zero for next step
- call mpi_reduce(sc_dvdl_ee, sc_tot_dvdl_ee, 1, MPI_DOUBLE_PRECISION, &
- MPI_SUM, 0, commsander, ierr)
- sc_dvdl_ee=0.0d0 ! zero for next step
- call mpi_reduce(sc_ener, sc_ener_tmp, ti_ene_cnt, MPI_DOUBLE_PRECISION, &
- MPI_SUM, 0, commsander, ierr)
- sc_ener(1:ti_ene_cnt) = sc_ener_tmp(1:ti_ene_cnt)
- end if
- if ( ifsc == 2 ) then
- ! If this is a perturb to nothing run, scale forces and calculate dvdl
- call sc_nomix_frc(f,nr3,ener)
- if( numtasks>1 ) then
- call mpi_bcast(f,nr3,MPI_DOUBLE_PRECISION,0,commsander,ierr)
- call mpi_bcast(ener,state_rec_len,MPI_DOUBLE_PRECISION,0,commsander,ierr)
- end if
- end if
-
- if( icfe /= 0 )then
- ! ---free energies using thermodynamic integration (icfe /= 0)
-
- if( master ) then
- ! --- first, send the forces and energy to your partner:
- partner = ieor(masterrank,1)
- call mpi_sendrecv( f, nr3, MPI_DOUBLE_PRECISION, partner, 5, &
- frcti, nr3+3*extra_atoms, MPI_DOUBLE_PRECISION, &
- partner, 5, commmaster, ist, ierr )
- call mpi_sendrecv( ener, state_rec_len, MPI_DOUBLE_PRECISION, partner, 5, &
- ecopy, state_rec_len, MPI_DOUBLE_PRECISION, partner, 5, &
- commmaster, ist, ierr)
- ! exchange sc-dvdl contributions between masters
- call mpi_sendrecv( sc_tot_dvdl, 1, MPI_DOUBLE_PRECISION, partner, &
- 5, sc_tot_dvdl_partner, 1, &
- MPI_DOUBLE_PRECISION, partner, 5, &
- commmaster, ist, ierr )
- call mpi_sendrecv( sc_tot_dvdl_ee, 1, MPI_DOUBLE_PRECISION, partner, &
- 5, sc_tot_dvdl_partner_ee, 1, &
- MPI_DOUBLE_PRECISION, partner, 5, &
- commmaster, ist, ierr )
- if( masterrank==0 ) then
- call mix_frcti(frcti,ecopy,f,ener,nr3,clambda,klambda)
- else
- call mix_frcti(f,ener,frcti,ecopy,nr3,clambda,klambda)
- end if
- end if
-
- if( numtasks>1 ) then
- call mpi_bcast(f,nr3,MPI_DOUBLE_PRECISION,0,commsander,ierr)
- call mpi_bcast(ener,state_rec_len,MPI_DOUBLE_PRECISION,0,commsander,ierr)
- end if
-
- end if
-
-#endif /* MPI SOFT CORE */
-
- irespa = 1
-
- ! Reset quantities depending on TEMP0 and TAUTP (which may have been
- ! changed by MODWT during FORCE call).
- ! Recalculate target kinetic energies.
-
- ekinp0 = fac(2) * temp0
-
-#ifdef LES
-
- ! modified for LES temperature, not solvent
-
- ekins0 = 0.d0
- ekinles0 = 0.d0
- if (temp0les < 0.d0) then
- ekins0 = fac(3) * temp0
- ekin0 = fac(1) * temp0
- else
- ekinles0 = fac(3) * temp0les
- ekin0 = ekinp0 + ekinles0
- end if
-#else
- ekins0 = fac(3) * temp0
- ekin0 = fac(1) * temp0
-#endif
-
- if (ntt == 1) dttp = dt / tautp
-
- if (ntp > 0) then
- ener%volume = volume
- ener%density = tmass / (0.602204d0*volume)
-
- if( iamoeba == 0 ) then
- ener%cmt(4) = 0.d0
- ener%vir(4) = 0.d0
- ener%pres(4) = 0.d0
- do m = 1,3
- ener%cmt(m) = ener%cmt(m) * 0.5d0
- ener%cmt(4) = ener%cmt(4) + ener%cmt(m)
- ener%vir(4) = ener%vir(4) + ener%vir(m)
- ener%pres(m) = (pconv+pconv) * (ener%cmt(m)-ener%vir(m)) / volume
- ener%pres(4) = ener%pres(4) + ener%pres(m)
- end do
- ener%pres(4) = ener%pres(4) / 3.d0
- end if
- end if
-
- ntnb = 0
- i3 = 0
- tempsu = 0.0d0
-
-#ifdef LES
- ! added LES tempsu (actual LES sum of m*v**2 )
- tempsules = 0.0d0
-#endif
- eke_cmd = 0.d0
- do j = 1,nrp
- winf = winv(j) * dt5
- aamass = amass(j)
- do m = 1,3
- i3 = i3+1
- rterm = v(i3)*v(i3) * aamass
-#ifdef LES
- if (temp0les < 0.d0) then
- tempsu = tempsu + rterm
- if (ipimd.eq.CMD.and.(cnum(j).eq.0.or.cnum(j).eq.1)) then
- eke_cmd = eke_cmd + aamass*v(i3)*v(i3)
- endif
- else
- if (cnum(j) == 0) then
- tempsu = tempsu + rterm
- else
- tempsules = tempsules + rterm
- end if
- end if
-#else
- if(ipimd.eq.CMD.and.mybeadid==1) then
- eke_cmd = eke_cmd + aamass*v(i3)*v(i3)
- end if
- tempsu = tempsu + rterm
-#endif
- if(ipimd.ne.NMPIMD.and.ipimd.ne.CMD) v(i3) = v(i3) - f(i3) * winf
- if (vlim) v(i3) = sign(min(abs(v(i3)),vlimit),v(i3))
- end do
- end do
-
-#ifdef MPI /* SOFT CORE */
- if ( ifsc /= 0 ) then
- call calc_softcore_ekin(amass,v,v,istart,iend)
- sc_ener(13) = sc_ener(6) + sc_ener(12)
- end if
-#endif
-
- do im=1,iscale
- v(nr3+im) = v(nr3+im) - f(nr3+im) * dt5 / scalm
- tempsu = tempsu + scalm * v(nr3+im)*v(nr3+im)
- end do
- ener%kin%solt = tempsu * 0.5d0
-
-#ifdef LES
-
- ! added for LES temperature using old solvent variable for ener(4)
-
- if (temp0les < 0.d0) then
- ener%kin%solv = 0.d0
- ener%kin%tot = ener%kin%solt
- ! for CMD:
- if( ipimd > 0 ) then
- ener%kin%solv = equal_part + Epot_deriv ! "virial" estimate of KE
- ener%tot = ener%kin%solv + ener%pot%tot
- else
- ener%tot = ener%kin%tot + ener%pot%tot
- endif
- if (ipimd.eq.CMD) then
- ener%kin%tot = eke_cmd*0.5d0
- ener%kin%solv = ener%kin%tot
- endif
- else
- ener%kin%solv = tempsules * 0.5d0
- ener%kin%tot = ener%kin%solt + ener%kin%solv
- end if
-#else
- ! for better output for parallel PIMD/NMPIM/CMD/RPMD
- if (ipimd>0) then
- ener%tot = 0.d0
- ener%kin%tot = 0.d0
- ener%kin%solt = 0.d0
- ener%kin%solv = 0.d0
- ener%volume = 0.d0
- endif
- ener%kin%tot = ener%kin%solt
- ener%tot = ener%kin%tot+ener%pot%tot
-
-#endif
-
- if(ntt == 1) then
-#ifdef LES
- if (temp0les >= 0.d0) then
- ekmh = max(ener%kin%solt,fac(2)*10.d0)
- ekmhles = max(ener%kin%solv,fac(3)*10.d0)
- else
- ekmh = max(ener%kin%solt,fac(1)*10.d0)
- end if
-#else
- ekmh = max(ener%kin%solt,fac(1)*10.d0)
-#endif
- end if
-
- end if ! ( init == 3 )
-
- !-------------------------------------------------------------------------
- ! init = 4: continuation of a previous trajectory
- ! this code also done for init=3
- !
- ! Note: if the last printed energy from the previous trajectory was
- ! at time "t", then the restrt file has velocities at time
- ! t + 0.5dt, and coordinates at time t + dt
- !-------------------------------------------------------------------------
-
- ! -------------------------------------------------------------------
- ekmh = 0.0d0
-#ifdef LES
- ekmhles = 0.0d0
-#endif
-
- i3 = 0
- do j = 1,nrp
- aamass = amass(j)
- do m = 1,3
- i3 = i3+1
- rterm = v(i3)*v(i3) * aamass
-# ifdef LES
- ! use copy number, not solute/solvent
- if (temp0les < 0.d0) then
- ! 1 bath
- ekmh = ekmh + rterm
- else
- if (cnum(j) == 0) then
- ekmh = ekmh + rterm
- else
- ekmhles = ekmhles + rterm
- end if
- end if
-# else
- ekmh = ekmh + rterm
-# endif
- end do
- end do
-
-#ifdef MPI /* SOFT CORE */
- if ( ifsc /= 0 ) then
- call calc_softcore_ekin(amass,v,v,istart,iend)
- sc_ener(13) = sc_ener(6) + sc_ener(12)
- end if
-#endif
-
- do im=1,iscale
- ekmh = ekmh + scalm*v(nr3+im)*v(nr3+im)
- end do
- ekmh = ekmh * 0.5d0
-#ifdef LES
- ekmhles = ekmhles * 0.5d0
-#endif
-
- do i=1,nr3+iscale
- vold(i) = v(i)
- end do
-
-#ifdef EMIL
- !--Setup the emil calculation if required
- if ( emil_do_calc .gt. 0 ) then
- call emil_init( natom, nstep, 1.0/(temp0 * 2 * boltz2 ), &
- mass, xx(lcrd), f, v, ener%box)
- end if
-#endif
-
- if (abfqmmm_param%abfqmmm == 1) then ! lam81
- nstep=abfqmmm_param%qmstep ! lam81
- if(abfqmmm_param%maxqmstep == 0) nstep = 0 ! lam81
- end if ! lam81
-
- if (init /= 4 .or. nstlim == 0 .or. (abfqmmm_param%abfqmmm == 1 .and. abfqmmm_param%system == 1)) then ! lam81
-
- !-------------------------------------------------------------------
- ! PRINT THE INITIAL ENERGIES AND TEMPERATURES
- !-------------------------------------------------------------------
-#ifdef RISMSANDER
- if ( rismprm%irism == 1 .and. rismprm%write_thermo==1 &
- .and. nstep <= 0 .and. facc /= 'A') then
- if( rism_calc_type(0) == RISM_FULL)&
- call rism_solvdist_thermo_calc(.false.,0)
- end if
-#endif /*RISMSANDER*/
-
- if ( (nstep <= 0 .and. master .and. facc /= 'A') .or. & ! lam81
- (master .and. abfqmmm_param%abfqmmm == 1 .and. mod(abfqmmm_param%qmstep,ntpr) == 0) ) then ! lam81
-
- if (isgld > 0) call sgenergy(ener)
- rewind(7)
-#ifdef LES
- if (.not.ipimd.gt.0) &
- ener%tot = ener%kin%tot+ener%pot%tot
-#endif /* LES */
- if(abfqmmm_param%abfqmmm /= 1 .or. abfqmmm_param%system == 1 .or. nstep == 0) & ! lam81
- call prntmd(nstep,nitp,nits,t,ener,onefac,7,.false.)
-#ifdef MPI /* SOFT CORE */
- if (ifsc /= 0) call sc_print_energies(6, sc_ener)
- if (ifsc /= 0) call sc_print_energies(7, sc_ener)
-#endif
- if ( ifcr > 0 .and. crprintcharges > 0 ) then
- call cr_print_charge( xx(l15), nstep )
- end if
-
- !--- BEGIN DIPOLE PRINTING CODE ---
- ! See code further on for comments-explanations
- call nmlsrc('dipoles',5,prndipfind)
- if(prndipfind /= 0 ) then
- write(6,*) '------------------------------- DIPOLE &
- &INFO ----------------------------------'
- write(6,9018) nstep,t
- read (5,'(a)') prndiptest
- call rgroup(natom,natc,nres,prndipngrp,ix(i02),ih(m02), &
- ih(m04),ih(m06),ih(m08),ix(icnstrgp), &
- jgroup,indx,irespw,npdec, &
- xx(l60),xx(lcrdr),0,0,0,idecomp,5,.false.)
- rewind(5)
- if(prndipngrp > 0) then
- call printdip(prndipngrp,ix(icnstrgp),xx(lcrd), &
- xx(l15),xx(linddip),xx(Lmass), natom)
- end if
- write(6,*) '----------------------------- END DIPOLE &
- &INFO --------------------------------'
- end if
- !--- END DIPOLE PRINTING CODE ---
-
- if (nmropt > 0) then
- call nmrptx(6)
- end if
- call amflsh(7)
- end if
-
- if (abfqmmm_param%abfqmmm == 1 .and. abfqmmm_param%system == 1) then ! lam81
- deallocate(for, stat=ier) ! lam81
- REQUIRE(ier==0) ! lam81
- return ! lam81
- end if ! lam81
- if (nstlim == 0) then ! lam81
- if(abfqmmm_param%abfqmmm == 1) v(1:nr3) = abfqmmm_param%v(1:nr3) ! lam81
-#ifdef MPI
- call xdist(x, xx(lfrctmp), natom) ! lam81
- call xdist(v, xx(lfrctmp), natom) ! lam81
-
- if(master) then ! lam81
-#endif
- if(ntwr>0) call mdwrit(nstep,nrp,nr,nres,ntxo,ntr,ntb, & ! lam81
- x,v,xx(lcrdr),box,t,temp0) ! lam81
- if(ntwx>0) call corpac(x,1,nrx,MDCRD_UNIT,loutfm) ! lam81
- if(ntwv>0) call corpac(v,1,nrx,MDVEL_UNIT,loutfm) ! lam81
- if(ntwf>0) call corpac(for,1,nrx,MDFRC_UNIT,loutfm) ! lam81
- if(ntwe>0) call mdeng(15,nstep,t,ener,onefac,ntp,csurften) ! lam81
-#ifdef MPI
- end if ! lam81
-#endif
- return ! lam81
- end if ! lam81
- init = 4
- end if
-
-
- if(ntp > 0 .and. ipimd > 0 ) then
- REQUIRE(ipimd.eq.NMPIMD)
-#ifdef LES
- call part_setup_cnst_press_pimd(Nkt,tau_vol)
-#else
- call full_setup_cnst_press_pimd(Nkt,tau_vol)
-#endif
- e2 = 1.0/ (2.0*3.0)
- e4 = e2 / (4.0*5.0)
- e6 = e4 / (6.0*7.0)
- e8 = e6 / (8.0*9.0)
- x_lnv = log( box(1)*box(2)*box(3) ) / 3
- end if
-
- ! For CMD.
- if ( ipimd==CMD ) then
-
- if ( .not.eq_cmd ) then
-
- ! De-activate thermostat for path-centroid.
-#ifdef LES
- do iatom = 1, natom
- do idim = 1, 3
- if ( cnum(iatom)==0 .or. cnum(iatom)==1 ) then
- activate = .false.
- else
- activate = .true.
- end if
- call Thermostat_switch(thermo(idim,iatom),activate)
- enddo
- enddo
- if ( .not.restart_cmd ) then
- ! Scale path-centroid velocity and set total momentum equal to zero.
- call part_scale_vel_centroid(v,amass,istart,iend)
- nstep_cmd = 0
- t_cmd = 0.d0
- else
- t_cmd = t
- nstep_cmd = int( t / dt )
- end if
-#else
- if ( mybeadid.eq.1 ) then
- activate = .false.
- else
- activate = .true.
- end if
- do iatom = 1, natom
- do idim = 1, 3
- call Thermostat_switch(thermo(idim,iatom),activate)
- enddo
- enddo
- if ( .not.restart_cmd ) then
- ! Scale path-centroid velocity and set total momentum equal to zero.
- call full_scale_vel_centroid(v,amass,istart,iend)
- nstep_cmd = 0
- t_cmd = 0.d0
- else
- nstep_cmd = nstep
- t_cmd = t
- end if
-#endif /* LES */
-
- else
-
- nstep_cmd = nstep
- t_cmd = t
-
- end if
-
- end if ! ipimd.eq.CMD and adiab_param<1.d0
-
-#ifdef MPI
- ! If this is a replica run and we are on exchange > 1, restore the
- ! old ekmh value since it was reset after we left runmd last time.
- ! DAN ROE: Only for ntt==1??
- if (rem /= 0 .and. mdloop >= 1) then
- ekmh = remd_ekmh
- endif
-#endif
-
-
- !=======================================================================
- ! ----- MAIN LOOP FOR PERFORMING THE DYNAMICS STEP -----
- ! (at this point, the coordinates are a half-step "ahead"
- ! of the velocities; the variable EKMH holds the kinetic
- ! energy at these "-1/2" velocities, which are stored in
- ! the array VOLD.)
- !=======================================================================
-
- 260 continue
- onstep = mod(irespa,nrespa) == 0
-
- ! Constant pH setup
- if (icnstph /= 0 .and. &
- ((rem /= 0 .and. mdloop > 0) .or. rem == 0)) then
-
- if (ntnb == 1) then ! rebuild pairlist
- call cnstphupdatepairs(x)
- end if
-
- if (mod(irespa+nstlim*mdloop,ntcnstph) == 0) then
- if (icnstph .eq. 1) then
- call cnstphbeginstep(xx(l190))
- else
- call cnstph_explicitmd( xx,ix,ih,ipairs,x,winv,amass,f,v,vold, &
- xr,xc,conp,skip,nsp,tma,erstop,qsetup, &
- do_list_update,rem)
- end if
- end if
-
- end if
-
-! x+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++x
-! | EVB reactive flux |
-! +:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::+
-! | Driver for coordinating backward and forward propagation as |
-! | well as for enforcing stopping criteria |
-! +---------------------------------------------------------------+
-
-#if defined(MPI)
- if( ievb /= 0 .and. trim( adjustl( evb_dyn) ) == "react_flux" ) then
- REQUIRE( ipimd.eq.0 .or. ipimd.eq.NMPIMD )
- call react_flux ( x, v, f, winv, tempi * factt, dt5, dtx &
- , nr, nstep, nstlim )
- endif
-#endif
-
- !---------------------------------------------------------------
- ! ---Step 1a: do some setup for pressure calculations:
- !---------------------------------------------------------------
-
- if (ntp > 0 .and. iamoeba == 0 .and. ipimd==0) then
- ener%cmt(1:3) = 0.d0
- xr(1:nr3) = x(1:nr3)
-
- ! ----- CALCULATE THE CENTER OF MASS ENERGY AND THE COORDINATES
- ! OF THE SUB-MOLECULES WITH RESPECT TO ITS OWN CENTER OF
- ! MASS -----
-
- call timer_start(TIME_EKCMR)
- call ekcmr(nspm,nsp,tma,ener%cmt,xr,v,amass,istart,iend)
-#ifdef MPI
- call trace_mpi('mpi_allreduce', &
- 3,'MPI_DOUBLE_PRECISION',mpi_sum)
-# ifdef USE_MPI_IN_PLACE
- call mpi_allreduce(MPI_IN_PLACE,ener%cmt,3, &
- MPI_DOUBLE_PRECISION,mpi_sum,commsander,ierr)
-# else
- call mpi_allreduce(ener%cmt,mpitmp,3, &
- MPI_DOUBLE_PRECISION,mpi_sum,commsander,ierr)
- ener%cmt(1:3) = mpitmp(1:3)
-# endif
-#endif
- call timer_stop(TIME_EKCMR)
- end if
-
- ! If we're using the MC barostat, go ahead and do the trial move now
- if (ntp > 0 .and. barostat == 2 .and. mod(total_nstep+1, mcbarint) == 0) &
- call mcbar_trial(xx, ix, ih, ipairs, x, xc, f, ener%vir, xx(l96), &
- xx(l97), xx(l98), xx(l99), qsetup, do_list_update, &
- nstep, nsp, amass)
-
- !--------------------------------------------------------------
- ! ---Step 1b: Get the forces for the current coordinates:
- !--------------------------------------------------------------
-
- npbstep = nstep
- iprint = 0
- if( nstep == 0 .or. nstep+1 == nstlim ) iprint = 1
-
- if (sebomd_obj%do_sebomd) then
- ! write down atomic charges and density matrix if needed
- sebomd_obj%iflagch = 0
- if (sebomd_obj%ntwc /= 0) then
- if (mod(nstep+1,sebomd_obj%ntwc) == 0) sebomd_obj%iflagch = 1
- endif
-! sebomd_obj%pdmx = 0
-! if (sebomd_obj%pdump /= 0) then
-! if (mod(nstep+1,ntwr) == 0) sebomd_obj%pdmx = 1
-! if (nstep+1 == nstlim) sebomd_obj%pdmx = 1
-! endif
- endif
-
-#ifdef MPI
- ! set do_mbar for the force contributions
- if (ifmbar /= 0) then
- do_mbar = .false.
- if ( mod(nstep+1,bar_intervall) == 0) then
- do_mbar = .true.
- end if
- end if
-#endif
-
- if ( ipimd==NMPIMD .or. ipimd==CMD) then
- call trans_pos_nmode_to_cart(x,cartpos)
- call force(xx,ix,ih,ipairs,cartpos,f,ener,ener%vir, &
- xx(l96),xx(l97),xx(l98),xx(l99), qsetup, &
- do_list_update,nstep)
-
-#if defined(MPI) && defined(LES)
- if ( ievb == 1 .and. i_qi > 0) then
- call evb_umb ( f, cartpos, real_mass, natom, istart3, iend3 )
-! 03132009 if( i_qi == 2 ) call qi_corrf_les ( cartpos, amass )
- if( i_qi == 2 ) call qi_corrf_les ( cartpos, real_mass )
- evb_nrg(1) = evb_frc%evb_nrg
- evb_nrg(2) = evb_vel0%evb_nrg
- if( nbias > 0 ) evb_nrg(3) = sum( evb_bias%nrg_bias(:) )
- endif
-#endif
-
- call trans_frc_cart_to_nmode(f)
-
-#if defined(MPI) && defined(LES)
- if ( ievb /= 0 .and. i_qi == 0 ) then
- call evb_umb ( f, x, real_mass, natom, istart3, iend3 )
- evb_nrg(1) = evb_frc%evb_nrg
- evb_nrg(2) = evb_vel0%evb_nrg
- if( nbias > 0 ) evb_nrg(3) = sum( evb_bias%nrg_bias(:) )
- endif
-
-#endif
-
- else
- ! -- ti decomp
- if(idecomp > 0) then
- decpr = .false.
- if(mod(nstep+1,ntpr) == 0) decpr = .true.
- end if
- call force(xx,ix,ih,ipairs,x,f,ener,ener%vir, &
- xx(l96),xx(l97),xx(l98),xx(l99), qsetup, &
- do_list_update,nstep)
-#if defined(MPI)
- if ( ievb /= 0 ) then
-#ifdef LES
- call evb_umb_primitive ( f, x, real_mass, natom, istart, iend )
-#else
- call evb_umb_primitive ( f, x, amass, natom, istart, iend )
-#endif
- evb_nrg(1) = evb_frc%evb_nrg
- evb_nrg(2) = evb_vel0%evb_nrg
- if( nbias > 0 ) evb_nrg(3) = sum( evb_bias%nrg_bias(:) )
- endif
-#endif
-
- endif
-
- if (sebomd_obj%do_sebomd) then
- ! computes hessian matrix if necessary
- if (sebomd_obj%ntwh /= 0 .and. mod(nstep+1,sebomd_obj%ntwh) == 0) then
- ! don't output atomic charges
- sebomd_obj%iflagch_old = sebomd_obj%iflagch
- sebomd_obj%iflagch = 0
- call sebomd_gradient_write(f,3*natom)
- call sebomd_hessian_compute(xx,ix,ih,ipairs,x,f,ener, &
- qsetup, do_list_update, nstep)
- sebomd_obj%iflagch = sebomd_obj%iflagch_old
- endif
- endif
-
- for(1:nr3) = f(1:nr3) ! lam81
-#ifdef MPI
- call xdist(for,xx(lfrctmp),natom) ! lam81
-#endif
-
- if(abfqmmm_param%abfqmmm == 1) then ! lam81
- abfqmmm_param%f2(1:nr3) = for(1:nr3) ! lam81
- call abfqmmm_combine_forces() ! lam81
-#ifdef MPI
- call mpi_bcast(abfqmmm_param%f, 3*natom, mpi_double_precision, 0, commsander, ierr) ! lam81
-#endif
- for(1:nr3) = abfqmmm_param%f(1:nr3) ! lam81
- f(1:nr3) = abfqmmm_param%f(1:nr3) ! lam81
- end if ! lam81
-
- ! Constant pH transition evaluation for GB CpHMD (not explicit CpHMD)
- if ((icnstph == 1) .and. (mod(irespa+mdloop*nstlim,ntcnstph) == 0)) then
- call cnstphendstep(xx(l190), xx(l15), ener%pot%dvdl, temp0, solvph)
- if (master) call cnstphwrite(rem)
- end if
-
- !PLUMED force added
- if(plumed.eq.1) then
- plumed_stopflag=0
- call plumed_f_gcmd("setStep"//char(0),nstep)
- call plumed_f_gcmd("setPositions"//char(0),x)
- call plumed_f_gcmd("setMasses"//char(0),amass)
- call plumed_f_gcmd("setCharges"//char(0),xx(l15))
- call plumed_f_gcmd("setEnergy"//char(0),ener%pot)
- call plumed_f_gcmd("setForces"//char(0),f)
- call plumed_f_gcmd("setStopFlag"//char(0),plumed_stopflag)
- plumed_box=0.0
- if(ifbox==0) then
- continue
- else if(ifbox==1) then
- plumed_box(1,1)=box(1)
- plumed_box(2,2)=box(2)
- plumed_box(3,3)=box(3)
- else if(ifbox==2) then
-! truncated octahedron, corresponding to a bcc lattice
-! in AMBER convention, box(1) is the length of the lattice vector
-! a is defined so as the bcc lattice is (a/2,a/2,a/2) (-a/2,-a/2,a/2) (a/2,-a/2,-a/2)
- plumed_box(1,1)=sqrt(1.0/3.0)*box(1)
- plumed_box(2,1)=sqrt(1.0/3.0)*box(1)
- plumed_box(3,1)=sqrt(1.0/3.0)*box(1)
- plumed_box(1,2)=-sqrt(1.0/3.0)*box(1)
- plumed_box(2,2)=-sqrt(1.0/3.0)*box(1)
- plumed_box(3,2)=sqrt(1.0/3.0)*box(1)
- plumed_box(1,3)=sqrt(1.0/3.0)*box(1)
- plumed_box(2,3)=-sqrt(1.0/3.0)*box(1)
- plumed_box(3,3)=-sqrt(1.0/3.0)*box(1)
- else
- write (6,*) "!!!!! PLUMED ERROR: Only orthorhombic and truncted octahedron cells are supported in this release."
- write (6,*) "!!!!! ABORTING RUN"
- stop
- endif
- plumed_virial=0.0
-! It's not completely clear where the factor 2.0 comes from
-! Anyway, I was able to match a change in press of 1000 bar with
-! a corresponding SLOPE=66.02 added to VOLUME CV in PLUMED
-! GB
- plumed_virial(1,1)=2.0*ener%vir(1)
- plumed_virial(2,2)=2.0*ener%vir(2)
- plumed_virial(3,3)=2.0*ener%vir(3)
- call plumed_f_gcmd("setVirial"//char(0),plumed_virial)
- call plumed_f_gcmd("setBox"//char(0),plumed_box)
- call plumed_f_gcmd("calc"//char(0),0);
-#ifdef MPI
-! this is required since PLUMED only updates virial on master processor
-#ifdef DPREC
- call mpi_bcast(plumed_virial,9,MPI_DOUBLE_PRECISION,0,commsander,ierr)
-#else
- call mpi_bcast(plumed_virial,9,MPI_REAL,0,commsander,ierr)
-#endif
-#endif
- ener%vir(1)=0.5*plumed_virial(1,1)
- ener%vir(2)=0.5*plumed_virial(2,2)
- ener%vir(3)=0.5*plumed_virial(3,3)
- end if
-
- !PLUMED end
-
-
-#ifdef MPI
- ! If softcore potentials are used, collect their dvdl contributions:
- if ( ifsc /= 0 ) then
- call mpi_reduce(sc_dvdl, sc_tot_dvdl, 1, MPI_DOUBLE_PRECISION, &
- MPI_SUM, 0, commsander, ierr)
- sc_dvdl=0.0d0 ! zero for next step
- call mpi_reduce(sc_dvdl_ee, sc_tot_dvdl_ee, 1, MPI_DOUBLE_PRECISION, &
- MPI_SUM, 0, commsander, ierr)
- sc_dvdl_ee=0.0d0 ! zero for next step
- call mpi_reduce(sc_ener, sc_ener_tmp, ti_ene_cnt, MPI_DOUBLE_PRECISION, &
- MPI_SUM, 0, commsander, ierr)
- sc_ener(1:ti_ene_cnt) = sc_ener_tmp(1:ti_ene_cnt)
- end if
- if ( ifsc == 2 ) then
- ! If this is a perturb to nothing run, scale forces and calculate dvdl
- call sc_nomix_frc(f,nr3,ener)
-
- if( numtasks>1 ) then
- call mpi_bcast(f,nr3,MPI_DOUBLE_PRECISION,0,commsander,ierr)
- call mpi_bcast(ener,state_rec_len,MPI_DOUBLE_PRECISION,0,commsander,ierr)
- end if
- end if
-
- if (ifmbar /=0 .and. do_mbar) then
- call bar_collect_cont()
- end if
-
- if ( icfe /= 0 )then
-
- ! --- free energies using thermodynamic integration (icfe /= 0)
-
- ! --- first, send the forces, energy, and virial to your partner:
-
- if( master ) then
- partner = ieor(masterrank,1)
- call mpi_sendrecv( f, nr3, MPI_DOUBLE_PRECISION, partner, 5, &
- frcti, nr3+3*extra_atoms, MPI_DOUBLE_PRECISION, partner, 5, &
- commmaster, ist, ierr )
- call mpi_sendrecv( ener, state_rec_len, MPI_DOUBLE_PRECISION, partner, 5, &
- ecopy, state_rec_len, MPI_DOUBLE_PRECISION, partner, 5, &
- commmaster, ist, ierr)
-
- ! exchange sc-dvdl contributions between masters:
- call mpi_sendrecv( sc_tot_dvdl, 1, MPI_DOUBLE_PRECISION, partner, 5, &
- sc_tot_dvdl_partner, 1, MPI_DOUBLE_PRECISION, partner, 5, &
- commmaster, ist, ierr )
- call mpi_sendrecv( sc_tot_dvdl_ee, 1, MPI_DOUBLE_PRECISION, partner, 5, &
- sc_tot_dvdl_partner_ee, 1, MPI_DOUBLE_PRECISION, partner, 5, &
- commmaster, ist, ierr )
-
- ! ---- collect statistics for free energy calculations:
-
- if( onstep ) then
- if( masterrank==0 ) then
- if( klambda == 1 ) then
- edvdl = edvdl - ener + ecopy
- edvdl_r = edvdl_r - ener + ecopy
- else
- clfac = klambda*(1.d0 - clambda)**(klambda-1)
- edvdl = edvdl - (ener - ecopy)*clfac
- edvdl_r = edvdl_r - (ener - ecopy)*clfac
- end if
- else
- if( klambda == 1 ) then
- edvdl = edvdl + ener - ecopy
- edvdl_r = edvdl_r + ener - ecopy
- else
- clfac = klambda*(1.d0 - clambda)**(klambda-1)
- edvdl = edvdl + (ener - ecopy)*clfac
- edvdl_r = edvdl_r + (ener - ecopy)*clfac
- end if
- end if
- ! This includes the sc-dvdl contribution into the vdw-part
- ! and potential energy parts of the dvdl-statistics
- if (ifsc == 1) then
- call adj_dvdl_stat(edvdl, edvdl_r)
- end if
- end if
-
- ! Do energy collection for MBAR FEP runs
- if (ifmbar /= 0 .and. do_mbar) then
- call calc_mbar_energies(ener%pot%tot, ecopy%pot%tot)
- end if
-
- if( masterrank==0 ) then
- call mix_frcti(frcti,ecopy,f,ener,nr3,clambda,klambda)
- else
- call mix_frcti(f,ener,frcti,ecopy,nr3,clambda,klambda)
- endif
- endif
-
- if( numtasks>1 ) then
- call mpi_bcast(f,nr3,MPI_DOUBLE_PRECISION,0,commsander,ierr)
- call mpi_bcast(ener,state_rec_len,MPI_DOUBLE_PRECISION,0,commsander,ierr)
- end if
-
- end if ! ( icfe /= 0 )
-
-#endif /* MPI */
-
-#ifdef EMIL
- ! Call the EMIL absolute free energy calculation.
- if ( emil_do_calc .gt. 0 ) then
-
- call emil_step(natom, nstep, 1.0 / (temp0 * 2 * boltz2),&
- mass, xx(lcrd), f, v, ener%pot, ener%pot, ener%box)
- end if
-#endif
-
-
-
- ! Reset quantities depending on TEMP0 and TAUTP (which may have been
- ! changed by MODWT during FORCE call).
- ekinp0 = fac(2)*temp0
-
-#ifdef LES
- ! TEMP0LES may have changed too
-
- ekinles0=0.d0
- ekins0=0.d0
- if (temp0les >= 0.d0) then
- ekinles0 = fac(3)*temp0les
- ekin0 = ekinp0 + ekinles0
- else
- ekins0 = fac(3)*temp0
- ekin0 = fac(1)*temp0
- end if
-#else
- ekins0 = fac(3)*temp0
- ekin0 = fac(1)*temp0
-#endif
-
- if (ntt == 1) dttp = dt/tautp
-
- ! Pressure coupling:
- if (ntp > 0.and.ipimd>0) then
- REQUIRE(ipimd.eq.NMPIMD)
- centvir=0.0
-
-#ifdef LES
- do iatom=istart,iend
- if(cnum(iatom).eq.0.or.cnum(iatom).eq.1) then
- centvir=centvir-x(3*iatom-2)*f(3*iatom-2)
- centvir=centvir-x(3*iatom-1)*f(3*iatom-1)
- centvir=centvir-x(3*iatom )*f(3*iatom)
- end if
- end do
-#else
- if(mybeadid.eq.1) then
- do iatom=istart,iend
- centvir=centvir-x(3*iatom-2)*f(3*iatom-2)
- centvir=centvir-x(3*iatom-1)*f(3*iatom-1)
- centvir=centvir-x(3*iatom )*f(3*iatom)
- end do
- end if
-#endif /* LES */
-
- if(iamoeba.eq.1) then
- atomvir=sum(ener%vir(1:3))
-#ifdef MPI
-# ifdef USE_MPI_IN_PLACE
- call mpi_allreduce(MPI_IN_PLACE,centvir,1,MPI_DOUBLE_PRECISION, &
- mpi_sum,commworld,ierr)
- call mpi_allreduce(MPI_IN_PLACE,atomvir,1,MPI_DOUBLE_PRECISION, &
- mpi_sum,commworld,ierr)
-# else
- call mpi_allreduce(centvir,mpitmp,1,MPI_DOUBLE_PRECISION, &
- mpi_sum,commworld,ierr)
- centvir=mpitmp(1)
- tmp=0.0
- call mpi_allreduce(atomvir,tmp,1,MPI_DOUBLE_PRECISION, &
- mpi_sum,commworld,ierr)
- atomvir=tmp
-# endif
-#endif
- else
-#ifdef MPI
-# ifdef USE_MPI_IN_PLACE
- call mpi_allreduce(MPI_IN_PLACE,centvir,1,MPI_DOUBLE_PRECISION, &
- mpi_sum,commworld,ierr)
- call mpi_allreduce(MPI_IN_PLACE,bnd_vir,9,MPI_DOUBLE_PRECISION, &
- mpi_sum,commworld,ierr)
- call mpi_allreduce(MPI_IN_PLACE,e14vir,9,MPI_DOUBLE_PRECISION, &
- mpi_sum,commworld,ierr)
-# ifndef LES
- if (master) &
- call mpi_allreduce(MPI_IN_PLACE,atvir,9,MPI_DOUBLE_PRECISION, &
- mpi_sum,commmaster,ierr)
-# endif
-# else
- call mpi_allreduce(centvir,tmp,1,MPI_DOUBLE_PRECISION, &
- mpi_sum,commworld,ierr)
- centvir=tmp
- tmpvir=0.0
- call mpi_allreduce(bnd_vir,tmpvir,9,MPI_DOUBLE_PRECISION, &
- mpi_sum,commworld,ierr)
- bnd_vir=tmpvir
-
-# ifndef LES
- if (master) then
- tmpvir=0.0
- call mpi_allreduce(e14vir,tmpvir,9,MPI_DOUBLE_PRECISION, &
- mpi_sum,commmaster,ierr)
- e14vir=tmpvir
-
- tmpvir=0.0
- call mpi_allreduce(atvir,tmpvir,9,MPI_DOUBLE_PRECISION, &
- mpi_sum,commmaster,ierr)
- atvir=tmpvir
- endif
-# else
- tmpvir=0.0
- call mpi_allreduce(e14vir,tmpvir,9,MPI_DOUBLE_PRECISION, &
- mpi_sum,commworld,ierr)
- e14vir=tmpvir
-# endif
-# endif
- call mpi_bcast(atvir,9,MPI_DOUBLE_PRECISION,0,commsander,ierr)
- call mpi_bcast(e14vir,9,MPI_DOUBLE_PRECISION,0,commsander,ierr)
-#endif
- atomvir=0.0
- atomvir=atomvir+atvir(1,1)+bnd_vir(1,1)+e14vir(1,1)
- atomvir=atomvir+atvir(2,2)+bnd_vir(2,2)+e14vir(2,2)
- atomvir=atomvir+atvir(3,3)+bnd_vir(3,3)+e14vir(3,3)
- end if
- pressure = (Nkt*3.0-centvir-(atomvir-Eimp_virial))/(3.0*volume)
- f_lnv_p = (pressure-pres0/pconv)*volume*3.0
- end if
-
-
- if (ntp > 0) then
- ener%volume = volume
- ener%density = tmass / (0.602204d0*volume)
- if( iamoeba == 0 .and. ipimd==0 ) then
- ener%cmt(4) = 0.d0
- ener%vir(4) = 0.d0
- ener%pres(4) = 0.d0
- do m = 1,3
- ener%cmt(m) = ener%cmt(m)*0.5d0
- ener%cmt(4) = ener%cmt(4)+ener%cmt(m)
- ener%vir(4) = ener%vir(4)+ener%vir(m)
- ener%pres(m) = (pconv+pconv)*(ener%cmt(m)-ener%vir(m))/volume
- ener%pres(4) = ener%pres(4)+ener%pres(m)
- end do
- ener%pres(4) = ener%pres(4)/3.d0
-
- ! Constant surface tension output:
-
- if (csurften > 0) then
-
- if (csurften == 1) then ! Surface tension in the x direction
- ener%surface_ten = &
- box(1) * (ener%pres(1) - 0.5d0 * &
- (ener%pres(2) + ener%pres(3))) / (ninterface * ten_conv)
-
- else if (csurften .eq. 2) then ! Surface tension in the y direction
- ener%surface_ten = &
- box(2) * (ener%pres(2) - 0.5d0 * &
- (ener%pres(1) + ener%pres(3))) / (ninterface * ten_conv)
-
- else ! if (csurften .eq. 3) ! Surface tension in the z direction
- ener%surface_ten = &
- box(3) * (ener%pres(3) - 0.5d0 * &
- (ener%pres(1) + ener%pres(2))) / (ninterface * ten_conv)
-
- end if
-
- end if
-
- end if
- end if
-
-#ifdef MPI
-! ------====== REMD ======------
-! If rem /= 0 and mdloop == 0, this is the first sander call and we don't want to
-! actually do any MD or change the initial coordinates.
-! Exit here since we only wanted to get the potential energy for the first
-! subrem exchange probability calc.
- if (rem /= 0 .and. mdloop == 0) then
-# ifdef VERBOSE_REMD
- if (master) write (6,'(a,i3)') &
- 'REMD: Exiting runmd after getting initial energies for replica',repnum
-# endif
- goto 480 ! Go to the end of the runmd loop.
- endif ! (rem /= 0 and mdloop == 0)
-
- !REB Do adaptive QMMM
- if ( qmmm_nml%vsolv > 1 ) then
- ! mix forces for adaptive QM/MM and
- ! calculate adaptive energy if requested
- ! note: nstep is zero during first call; this is the energy/force calculation
- ! with the starting geometry / velocities
- call adaptive_qmmm(nstep,natom,x,xold,f,ener%pot%tot, ntpr, ntwx, &
- xx, ix, ih, ipairs, qsetup, do_list_update, &
- corrected_energy, aqmmm_flag)
-
-! ALTERNATIVE APPROACH:
-! if (ad_qmmm%calc_wbk) then
-! call ad_qmmm_check_matching_partitions()
-! if (ad_qmmm%mismatch) then
-! call force()
-! end if
-! call ad_qmmm_energy()
-! end if
-
-! test
- i3 = 3*(istart-1)
- do j=istart,iend
- do idim = 1, 3
- xold(i3+idim)=x(i3+idim)
- enddo
- i3 = i3 + 3
- enddo
-! test
- endif
-
-#endif
-
- !----------------------------------------------------------------
- ! ---Step 1c: do randomization of velocities, if needed:
- !----------------------------------------------------------------
- ! ---Assign new random velocities every Vrand steps, if ntt=2
-
- resetvelo=.false.
- if (vrand /= 0 .and. ntt == 2) then
- if (mod((nstep+1),vrand) == 0) resetvelo=.true.
- end if
-
-#ifdef MMTSB
- if ( mmtsb_switch == mmtsb_temp_rex .and. mmtsb_is_exchanged ) &
- resetvelo = .true.
-#endif
-
- if (resetvelo) then
- ! DAN ROE: Why are only the masters doing this? Even if the velocities
- ! are broadcast to the child processes, the wont the different # of random
- ! calls put the randomg num generators out of sync, or do we not care?
-
- if (master) then
- write (6,'(a,i8)') 'Setting new random velocities at step ', &
- nstep + 1
- call setvel(nr,v,winv,temp0*factt,init,iscale,scalm)
-
-#ifdef MPI /* SOFT CORE */
- ! Make sure all common atoms have the same v (that of V0) in TI runs:
- if (icfe /=0 .and. ifsc /=0) call sc_sync_x(v,nr3)
-#endif
-
-#ifdef LES
-
- ! newvel call is fixed for the dual target temperatures
-
- if (temp0les >= 0.d0.and.temp0 /= temp0les) then
- vscalt = sqrt (temp0les/temp0)
- do j=1,natom
- if(cnum(j) > 0) then
- i3 = 3*(j-1)
- v(i3+1) = v(i3+1) * vscalt
- v(i3+2) = v(i3+2) * vscalt
- v(i3+3) = v(i3+3) * vscalt
- endif
- end do
- end if
-#endif
- if (ibelly > 0) call bellyf(nr,ix(ibellygp),v)
- end if
-# ifdef MPI
- call trace_mpi('mpi_bcast',3*natom,'MPI_DOUBLE_PRECISION',0)
- call mpi_bcast(v, 3*natom, MPI_DOUBLE_PRECISION, 0, commsander, ierr)
-# endif
-
- ! At this point in the code, the velocities lag the positions
- ! by half a timestep. If we intend for the velocities to be drawn
- ! from a Maxwell distribution at the timepoint where the positions and
- ! velocities are synchronized, we have to correct these newly
- ! redrawn velocities by backing them up half a step using the
- ! current force.
- ! Note that this fix only works for Newtonian dynamics.
- if( gammai==0.d0.and.(ipimd.ne.NMPIMD.or.ipimd.ne.CMD)) then
- i3 = 3*(istart-1)
- do j=istart,iend
- wfac = winv(j) * dt5
- v(i3+1) = v(i3+1) - f(i3+1)*wfac
- v(i3+2) = v(i3+2) - f(i3+2)*wfac
- v(i3+3) = v(i3+3) - f(i3+3)*wfac
- i3 = i3+3
- end do
- end if
-
- end if ! (resetvelo)
-
- call timer_start(TIME_VERLET)
-
- !-----------------------------------------------------
- ! ---Step 2: Do the velocity update:
- !-----------------------------------------------------
-
- !step 2a: apply quenched MD if needed. This is useful in NEB>0
- if (vv==1) call quench(f,v)
-
- ! Car-Parrinello on dipoles: note that the (small?) kinetic energy
- ! of the dipoles is included in the epol energy
-! M_WJ
-! if ( induced == 1 .and. indmeth == 3 ) call cp_dips(natom,xx(lpol),xx,dt)
- if ( induced > 0 .and. indmeth == 3 ) call cp_dips(natom,xx(lpol),xx,dt)
-
-
-
-! i3 = 3*(istart-1) !! Add Brownian noise for testing. ! APJ
-! do j=istart,iend ! APJ
-! do idim=1,3 ! APJ
-! call gauss( 0.d0, sqrt(0.1d0*boltz2*temp0)/dtx,fln ) ! APJ
-! f(i3+idim) = f(i3+idim) + fln ! APJ
-! enddo ! APJ
-! i3 = i3+3 ! APJ
-! end do ! APJ
-
-
- ! Nose'-Hoover thermostat (1st step).
- if ( ntt == 4 ) then
-
- Ekin2_tot = 0.d0
- i3 = 3*(istart-1)
- do j=istart,iend
- wfac = dtx/amass(j)
- do idim = 1, 3
-#ifdef LES
- if( ntp>0.and.ipimd.eq.NMPIMD .and. &
- (cnum(j).eq.0.or.cnum(j).eq.1) ) then
-#else
- if(ntp>0.and.ipimd.eq.NMPIMD.and.mybeadid.eq.1) then
-#endif
- exp1 = exp(-dt5*thermo(idim,j)%v(1)-dt5*v_lnv*c2_lnv)
- Ekin2_tot = Ekin2_tot + amass(j)*v(i3+idim)*v(i3+idim)
- else
- exp1 = exp( -dt5 * thermo(idim,j)%v(1) )
- end if
- exp2 = exp1*exp1
- vold(i3+idim)=v(i3+idim)
- v(i3+idim) = v(i3+idim) * exp2 + f(i3+idim) * wfac * exp1
- end do
- i3 = i3+3
- end do
-
- if(ntp>0.and.ipimd.eq.NMPIMD) then
-#ifdef MPI
-# ifdef USE_MPI_IN_PLACE
- call mpi_allreduce(MPI_IN_PLACE,Ekin2_tot,1,MPI_DOUBLE_PRECISION, &
- mpi_sum,commworld,ierr)
-# else
- call mpi_allreduce(Ekin2_tot,mpitmp,1,MPI_DOUBLE_PRECISION, &
- mpi_sum,commworld,ierr)
- Ekin2_tot=mpitmp(1)
-# endif
-#endif
- f_lnv_v = Ekin2_tot*(c2_lnv-1)
- tmp = exp(-dt5*thermo_lnv%v(1))
- v_lnv = tmp*(tmp*v_lnv+dtx*(f_lnv_v+f_lnv_p)/mass_lnv)
- end if
-
- call Thermostat_integrate_1(nchain,thermo,nthermo,dtx,ntp)
-
- else if ( ntt>4 .and. ntt<=8 ) then ! APJ
-
- Ekin2_tot = 0.d0
- i3 = 3*(istart-1)
- do j=istart,iend
- wfac = dtx/amass(j)
- do idim = 1, 3
-#ifdef LES
- if( ntp>0.and.ipimd.eq.NMPIMD .and. &
- (cnum(j).eq.0.or.cnum(j).eq.1) ) then
-#else
- if(ntp>0.and.ipimd.eq.NMPIMD.and.mybeadid.eq.1) then
-#endif
- Ekin2_tot = Ekin2_tot + amass(j)*v(i3+idim)*v(i3+idim)
- !exp1 = exp(-dt5*thermo(idim,j)%v(1)-dt5*v_lnv*c2_lnv) ! APJ
- exp1 = exp(-dt5*v_lnv*c2_lnv) ! APJ
- else
- !exp1 = exp( -dt5 * thermo(idim,j)%v(1) ) ! APJ
- exp1 = 1.d0 ! APJ
- end if
- exp2 = exp1*exp1
- vold(i3+idim)=v(i3+idim)
- !v(i3+idim) = v(i3+idim) * exp2 + f(i3+idim) * wfac * exp1 ! APJ
- v(i3+idim)=v(i3+idim)*exp2 ! APJ
- f(i3+idim)=f(i3+idim)*exp1 ! APJ
- end do
- i3 = i3+3
- end do
-
- if(ntp>0.and.ipimd.eq.NMPIMD) then
-#ifdef MPI
-# ifdef USE_MPI_IN_PLACE
- call mpi_allreduce(MPI_IN_PLACE,Ekin2_tot,1,MPI_DOUBLE_PRECISION, &
- mpi_sum,commworld,ierr)
-# else
- call mpi_allreduce(Ekin2_tot,mpitmp,1,MPI_DOUBLE_PRECISION, &
- mpi_sum,commworld,ierr)
- Ekin2_tot=mpitmp(1)
-# endif
-#endif
- f_lnv_v = Ekin2_tot*(c2_lnv-1)
- !tmp = exp(-dt5*thermo_lnv%v(1)) ! APJ
- !v_lnv = tmp*(tmp*v_lnv+dtx*(f_lnv_v+f_lnv_p)/mass_lnv) ! APJ
- end if
-
- if (abfqmmm_param%abfqmmm == 1) then ! lam81
-#ifdef MPI
- call xdist(v, xx(lfrctmp), natom) ! lam81
- call xdist(f, xx(lfrctmp), natom) ! lam81
-#endif
- abfqmmm_param%v(1:nr3+iscale)=v(1:nr3+iscale) ! lam81
- abfqmmm_param%f(1:nr3+iscale)=f(1:nr3+iscale) ! lam81
- end if ! lam81
- call Adaptive_Thermostat_integrate(nchain,thermo,nthermo,dtx,ntp,1) ! APJ
- if (abfqmmm_param%abfqmmm == 1) then ! lam81
- v(1:nr3+iscale)=abfqmmm_param%v(1:nr3+iscale) ! lam81
-#ifdef MPI
- call xdist(v, xx(lfrctmp), natom) ! lam81
-#endif
- abfqmmm_param%v(1:nr3+iscale)=v(1:nr3+iscale) ! lam81
- end if ! lam81
-
-
- else if( gammai == 0.d0 ) then
-
- ! ---Newtonian dynamics:
-
- ! Applying guiding force effect:
- if (isgld > 0) then
- call sgmdw(natom,istart,iend,ntp,dtx,ener,amass,winv,x,f,v)
- end if
-
- i3 = 3*(istart-1)
- do j=istart,iend
- wfac = winv(j) * dtx
- v(i3+1) = v(i3+1) + f(i3+1)*wfac
- v(i3+2) = v(i3+2) + f(i3+2)*wfac
- v(i3+3) = v(i3+3) + f(i3+3)*wfac
- i3 = i3+3
- end do
-
- else if (isgld > 0) then
- ! Using SGLD algorithm:
- call sgldw(natom,istart,iend,ntp,dtx,temp0,ener,amass,winv,x,f,v)
- else ! gamma_ln .ne. 0, which also implies ntt=3 (see mdread.f)
-
- ! ---simple model for Langevin dynamics, basically taken from
- ! Loncharich, Brooks and Pastor, Biopolymers 32:523-535 (1992),
- ! Eq. 11. (Note that the first term on the rhs of Eq. 11b
- ! should not be there.)
-
- ! Update Langevin parameters, since temp0 might have changed:
- sdfac = sqrt( 4.d0*gammai*boltz2*temp0/dtx )
-# ifdef LES
- sdfacles = sqrt( 4.d0*gammai*boltz2*temp0les/dtx )
-# endif
-
-
-#ifdef MPI /* SOFT CORE */
- if (ifsc == 1) then
- call sc_lngdyn(winv,amass,v,f,sdfac,c_explic,c_implic, &
- istart, iend, nr, dtx)
- else
-#endif
-
-
- if (no_ntt3_sync == 1) then ! APJ
- !We don't worry about synchronizing the random number stream ! APJ
- !across processors. ! APJ
- iskip_start = 0 ! APJ
- iskip_end = 0 ! APJ
- else ! APJ
- ! In order to generate the same sequence of pseudorandom numbers that ! APJ
- ! you would using a single processor you have to go through the atoms ! APJ
- ! in order: skip those that have are being used on other processors ! APJ
- iskip_start = 3*(istart-1) ! APJ
- iskip_end = 3*(nr-iend) ! APJ
-#ifndef LES
- ! Always sync random number stream for PIMD ! APJ
- ! (AWG: not sure if this is required) ! APJ
- if (ipimd>0) then ! APJ
- iskip_start = iskip_start + 3*nr*(mybeadid-1) ! APJ
- iskip_end = iskip_end + 3*nr*(nbead-mybeadid) ! APJ
- end if ! APJ
-#endif
- endif ! APJ
-
- do j=1,iskip_start ! APJ
- ! Skip some random numbers ! APJ
- call gauss( 0.d0, 1.d0, fln ) ! APJ
- end do ! APJ
-
- ! Do Langevin step ! APJ
- i3 = 3*(istart-1) ! APJ
- do j=istart,iend ! APJ
-
- wfac = winv(j) * dtx ! APJ
- aamass = amass(j) ! APJ
-# ifdef LES
- if (temp0les >= 0 .and. temp0 /= temp0les .and. cnum(j) /= 0 ) then ! APJ
- rsd =sdfacles*sqrt(aamass) ! APJ
- else ! APJ
- rsd = sdfac*sqrt(aamass) ! APJ
- endif ! APJ
-# else
- rsd = sdfac*sqrt(aamass) ! APJ
-# endif
- call gauss( 0.d0, rsd, fln ) ! APJ
- v(i3+1) = (v(i3+1)*c_explic + (f(i3+1)+fln)*wfac) * c_implic ! APJ
- call gauss( 0.d0, rsd, fln ) ! APJ
- v(i3+2) = (v(i3+2)*c_explic + (f(i3+2)+fln)*wfac) * c_implic ! APJ
- call gauss( 0.d0, rsd, fln ) ! APJ
- v(i3+3) = (v(i3+3)*c_explic + (f(i3+3)+fln)*wfac) * c_implic ! APJ
-
- i3 = i3 + 3 ! APJ
- end do ! APJ
-
- do j=1,iskip_end ! APJ
- ! Skip some random numbers ! APJ
- call gauss( 0.d0, 1.d0, fln ) ! APJ
- end do ! APJ
-
-
-#ifdef MPI /* SOFT CORE */
- end if ! for (ifsc==1) call sc_lngdyn
-#endif
- end if ! ( gammai == 0.d0 )
-
- ! Update EMAP rigid domains
- if(temap) call emap_move()
-
- ! --- consider vlimit
-
- if (vlim.and.ipimd==0) then
- vmax = 0.0d0
- do i=istart3,iend3
- vmax = max(vmax,abs(v(i)))
- v(i) = sign(min(abs(v(i)),vlimit),v(i))
- end do
-
- ! Only violations on the master node are actually reported
- ! to avoid both MPI communication and non-master writes.
- if (vmax > vlimit) then
- if (master) then
- write(6,'(a,i6,a,f10.4)') 'vlimit exceeded for step ',nstep, &
- '; vmax = ',vmax
- end if
- end if
- end if
-
- do im=1,iscale
- v(nr3+im) = (v(nr3+im) + f(nr3+im)*dtx/scalm)
- end do
-
- ! We do the force dump here if requested, since the 'old' positions are about
- ! to be dumped into the force array...
-
- if (master) then
- ifdump = .false. ! Write forces this step?
- if (ntwf>0) ifdump = mod(total_nstep+1,ntwf) == 0 ! forces
- if (ntwf == -1 .and. mod(total_nstep+1,ntwx) == 0) &
- ifdump = .true. !Combined crdfrc file
- if (abfqmmm_param%abfqmmm == 1) ifdump = .false. ! lam81
-#ifdef MPI
- ! For adaptive QM/MM, only the master does a dump.
- if ( qmmm_nml%vsolv > 1 ) then
- if ( nodeid /= 0 ) then
- ifdump = .false.
- end if
- end if
-
- if (ifdump) then
- call xdist(f, xx(lfrctmp), natom)
- end if
-#endif
- ! Force archive:
- if (ifdump) then
-
-#ifdef MPI
- ! Write out current replica#, exchange#, step#, and mytargettemp
- ! If mdloop==0 this is a normal md run (since REMD never calls corpac
- ! when mdloop==0) and we don't want the REMD header.
- if (mdloop>0.and.loutfm) then
- if (trxsgld) then
- write (MDFRC_UNIT,'(a,4(1x,i8))') "RXSGLD ", repnum, mdloop, &
- total_nstep+1, stagid
- else
- write (MDFRC_UNIT,'(a,3(1x,i8),1x,f8.3)') "REMD ", repnum, mdloop, &
- total_nstep+1, my_remd_data%mytargettemp
- end if
- end if
-#endif
-
- ! ipimd forces will probably not be right if some type of
- ! transformation is necessary. This is from the vel dump code -- keep
- ! it here as a holder in case somebody wants to fix it.
-! if(ipimd.eq.NMPIMD.or.ipimd.eq.CMD) then
-! call corpac(cartvel,1,nrx,MDVEL_UNIT,loutfm)
-! else
- call corpac(f,1,nrx,MDFRC_UNIT,loutfm)
-! endif
- end if
-
- else ! slaves need to participate in force distribution
- ifdump = .false. ! Write forces this step?
- if (ntwf>0) ifdump = mod(total_nstep+1,ntwf) == 0 ! forces
- if (ntwf == -1 .and. mod(total_nstep+1,ntwx) == 0) &
- ifdump = .true. !Combined crdfrc file
- if (abfqmmm_param%abfqmmm == 1) ifdump = .false. ! lam81
-#ifdef MPI
- if (ifdump) call xdist(f, xx(lfrctmp), natom)
-#endif
- end if ! master
- !-------------------------------------------------------------------
- ! Step 3: update the positions, putting the "old" positions into F:
- !-------------------------------------------------------------------
-
-# ifdef LES
- if(ntp>0.and.ipimd.eq.NMPIMD) then
- aa = exp(dt5*v_lnv)
- arg2 = v_lnv*dt5*v_lnv*dt5
- poly = 1.0d0+arg2*(e2+arg2*(e4+arg2*(e6+arg2*e8)))
- endif
-
- i3 = 3*(istart-1)
- do j=istart,iend
- if(ntp>0.and.ipimd.eq.NMPIMD.and.(cnum(j).eq.0.or.cnum(j).eq.1)) then
- do idim = 1, 3
- f(i3+idim)=x(i3+idim)
- x(i3+idim)=aa*(x(i3+idim)*aa+v(i3+idim)*poly*dtx)
- enddo
- else
- do idim = 1, 3
- f(i3+idim) = x(i3+idim)
- x(i3+idim) = x(i3+idim)+v(i3+idim)*dtx
- enddo
- endif
- i3 = i3 + 3
- enddo
-
-# else
-
- if(ntp>0.and.ipimd.eq.NMPIMD.and.mybeadid==1) then
- aa = exp(dt5*v_lnv)
- arg2 = v_lnv*dt5*v_lnv*dt5
- poly = 1.0d0+arg2*(e2+arg2*(e4+arg2*(e6+arg2*e8)))
- do i3=istart3,iend3
- f(i3)=x(i3)
- x(i3)=aa*(x(i3)*aa+v(i3)*poly*dtx)
- end do
- else
- do i3 = istart3, iend3
- f(i3) = x(i3)
- x(i3) = x(i3) + v(i3)*dtx
- end do
- end if
-
-# endif /* LES */
-
- !Nose'-Hoover thermostat (2nd step).
- if ( ntt==4 ) then
- call Thermostat_integrate_2(nchain,thermo,nthermo,dtx,ntp)
- E_nhc = Thermostat_hamiltonian(nchain,thermo,nthermo)
- else if ( ntt>=4 .and. ntt<=8 ) then ! APJ
- if(abfqmmm_param%abfqmmm == 1) then ! lam81
-#ifdef MPI
- call xdist(v, xx(lfrctmp), natom) ! lam81
-#endif
- abfqmmm_param%v(1:nr3+iscale)=v(1:nr3+iscale) ! lam81
- end if ! lam81
- call Adaptive_Thermostat_integrate(nchain,thermo,nthermo,dtx,ntp,2) ! APJ
- if (abfqmmm_param%abfqmmm == 1) then ! lam81
- v(1:nr3+iscale)=abfqmmm_param%v(1:nr3+iscale) ! lam81
-#ifdef MPI
- call xdist(v, xx(lfrctmp), natom) ! lam81
-#endif
- abfqmmm_param%v(1:nr3+iscale)=v(1:nr3+iscale) ! lam81
- end if ! lam81
- E_nhc = Adaptive_Thermostat_hamiltonian(nchain,thermo,nthermo)
- end if
-
- do i = 1,iscale
- f(nr3+i) = x(nr3+i)
- x(nr3+i) = x(nr3+i)+v(nr3+i)*dtx
- end do
-
- call timer_stop(TIME_VERLET)
-
- if (ntc /= 1) then
-
- !-------------------------------------------------------------------
- ! Step 4a: if shake is being used, update the new positions to fix
- ! the bond lengths.
- !-------------------------------------------------------------------
-
- call timer_start(TIME_SHAKE)
- if (isgld > 0) call sgfshake(istart,iend,dtx,amass,x,.false.)
- qspatial=.false.
- call shake(nrp,nbonh,nbona,0,ix(iibh),ix(ijbh),ix(ibellygp), &
- winv,conp,skip,f,x,nitp,belly,ix(iifstwt),ix(noshake), &
- shkh,qspatial)
- call quick3(f,x,ix(iifstwr),natom,nres,ix(i02))
- if(nitp == 0) then
- erstop = .true.
- goto 480
- end if
- ! Including constraint forces in self-guiding force calculation
- if (isgld > 0) call sgfshake(istart,iend,dtx,amass,x,.true.)
-
- ! Need to synchronize coordinates for linearly scaled atoms after shake
-#ifdef MPI
- if( icfe /= 0 ) then
- call timer_barrier( commsander )
- call timer_stop_start(TIME_SHAKE,TIME_DISTCRD)
- if ( .not. mpi_orig .and. numtasks > 1 ) then
- call xdist(x, xx(lfrctmp), natom)
- end if
- ! In dual-topology this is done within softcore.f
- if (ifsc /= 1) then
- if( master ) call mpi_bcast(x,nr3,MPI_DOUBLE_PRECISION, &
- 0,commmaster,ierr)
- else
- if( master ) call sc_sync_x(x,nr3)
- end if
- if( numtasks>1 ) call mpi_bcast(x,nr3,MPI_DOUBLE_PRECISION, &
- 0,commsander,ierr)
- call timer_stop_start(TIME_DISTCRD,TIME_SHAKE)
- end if
-#endif /* MPI */
- !-----------------------------------------------------------------
- ! Step 4b: Now fix the velocities and calculate KE
- !-----------------------------------------------------------------
-
- ! ---re-estimate the velocities from differences in positions:
-
- if( .not.(ipimd==NMPIMD.and.ipimd==CMD.and.mybeadid.ne.1) ) then
- v(istart3:iend3) = (x(istart3:iend3)-f(istart3:iend3)) * dtxinv
- end if
-
- call timer_stop(TIME_SHAKE)
- end if
- call timer_start(TIME_VERLET)
-
- if(ineb>0.and.(mybeadid==1.or.mybeadid==neb_nbead) ) then
- x(1:3*natom)=f(1:3*natom)
- ! CARLOS: NEB- remove velocities but ONLY for the end beads so V doesn't
- ! accumulate if high forces
- v(1:3*natom)=0.d0
-
- end if
-
- if( ntt == 1 .or. onstep ) then
-
- !-----------------------------------------------------------------
- ! Step 4c: get the KE, either for averaging or for Berendsen:
- !-----------------------------------------------------------------
-
- eke = 0.d0
- ekph = 0.d0
- ekpbs = 0.d0
-#ifdef LES
- ekeles = 0.d0
- ekphles = 0.d0
-#endif
- eke_cmd = 0.d0
-
- if (gammai == 0.0d0) then
- i3 = 3*(istart-1)
- do j=istart,iend
- aamass = amass(j)
- do m = 1,3
- i3 = i3+1
-#ifdef LES
- if (temp0les < 0.d0) then
- eke = eke + aamass*0.25d0*(v(i3)+vold(i3))**2
- ekph = ekph + aamass*v(i3)**2
- if(ipimd.eq.CMD.and.(cnum(j).eq.0.or.cnum(j).eq.1)) then
- eke_cmd = eke_cmd + aamass*0.25d0*(v(i3)+vold(i3))**2
- endif
- else
- if (cnum(j) == 0) then
- eke = eke + aamass*0.25d0*(v(i3)+vold(i3))**2
- ekph = ekph + aamass*v(i3)**2
- else
- ekeles = ekeles + aamass*0.25d0*(v(i3)+vold(i3))**2
- ekphles = ekphles + aamass*v(i3)**2
- end if
- end if
-
-#else
- eke = eke + aamass*0.25d0*(v(i3)+vold(i3))**2
-
- if(mybeadid==1) then
- eke_cmd = eke_cmd + aamass*0.25d0*(v(i3)+vold(i3))**2
- end if
- ! try pseudo KE from Eq. 4.7b of Pastor, Brooks & Szabo,
- ! Mol. Phys. 65, 1409-1419 (1988):
-
- ekpbs = ekpbs + aamass*v(i3)*vold(i3)
- ekph = ekph + aamass*v(i3)**2
-
-#endif
- end do
- end do
-
- else
-
- i3 = 3*(istart-1)
- do j=istart,iend
- aamass = amass(j)
- do m = 1,3
- i3 = i3+1
-#ifdef LES
- if (temp0les < 0.d0) then
- eke = eke + aamass*0.25d0*c_ave*(v(i3)+vold(i3))**2
- else
- if (cnum(j) == 0) then
- eke = eke + aamass*0.25d0*c_ave*(v(i3)+vold(i3))**2
- else
- ekeles = ekeles + aamass*0.25d0*c_ave*(v(i3)+vold(i3))**2
- end if
- end if
-#else
- eke = eke + aamass*0.25d0*c_ave*(v(i3)+vold(i3))**2
-
-#endif
- end do
-
- end do
-
- end if ! (if gammai == 0.0d0)
-
-#ifdef MPI
-
- ! --- sum up the partial kinetic energies:
-
- if ( ipimd.eq.CMD ) then
- call mpi_reduce(eke_cmd,tmp_eke_cmd,1,MPI_DOUBLE_PRECISION, &
- mpi_sum,0,commsander,ierr)
- eke_cmd = tmp_eke_cmd
- endif
-
-# ifdef LES
- !if ( ipimd.eq.CMD ) then
- ! call mpi_reduce(eke_cmd,tmp_eke_cmd,1,MPI_DOUBLE_PRECISION, &
- ! mpi_sum,0,commsander,ierr)
- ! eke_cmd = tmp_eke_cmd
- !endif
- if ( .not. mpi_orig .and. numtasks > 1 ) then
- if ( temp0les < 0 ) then
- mpitmp(1) = eke
- mpitmp(2) = ekph
-# ifdef USE_MPI_IN_PLACE
- call mpi_allreduce(MPI_IN_PLACE,mpitmp,2, &
- MPI_DOUBLE_PRECISION,mpi_sum,commsander,ierr)
- eke = mpitmp(1)
- ekph = mpitmp(2)
-# else
- call mpi_allreduce(mpitmp,mpitmp(3),2, &
- MPI_DOUBLE_PRECISION,mpi_sum,commsander,ierr)
- eke = mpitmp(3)
- ekph = mpitmp(4)
-# endif
- else
- mpitmp(1) = eke
- mpitmp(2) = ekph
- mpitmp(3) = ekeles
- mpitmp(4) = ekphles
-# ifdef USE_MPI_IN_PLACE
- call mpi_allreduce(MPI_IN_PLACE,mpitmp,4, &
- MPI_DOUBLE_PRECISION,mpi_sum,commsander,ierr)
- eke = mpitmp(1)
- ekph = mpitmp(2)
- ekeles = mpitmp(3)
- ekphles = mpitmp(4)
-# else
- call mpi_allreduce(mpitmp,mpitmp(5),4, &
- MPI_DOUBLE_PRECISION,mpi_sum,commsander,ierr)
- eke = mpitmp(5)
- ekph = mpitmp(6)
- ekeles = mpitmp(7)
- ekphles = mpitmp(8)
-# endif
- endif
- end if
-# else
-
- if ( .not. mpi_orig .and. numtasks > 1 ) then
- call trace_mpi('mpi_allreduce', &
- 1,'MPI_DOUBLE_PRECISION',mpi_sum)
- mpitmp(1) = eke
- mpitmp(2) = ekph
- mpitmp(3) = ekpbs
-# ifdef USE_MPI_IN_PLACE
- call mpi_allreduce(MPI_IN_PLACE,mpitmp,3, &
- MPI_DOUBLE_PRECISION,mpi_sum,commsander,ierr)
- eke = mpitmp(1)
- ekph = mpitmp(2)
- ekpbs = mpitmp(3)
-
-# else
-
- call mpi_allreduce(mpitmp,mpitmp(4),3, &
- MPI_DOUBLE_PRECISION,mpi_sum,commsander,ierr)
- eke = mpitmp(4)
- ekph = mpitmp(5)
- ekpbs = mpitmp(6)
-
-# endif
- end if
-# endif
-
- ! Calculate Ekin of the softcore part of the system
- if (ifsc /= 0 ) then
- call calc_softcore_ekin(amass,v,vold,istart,iend)
- sc_ener(13) = sc_ener(6) + sc_ener(12)
- end if
-#endif
-
- ! --- all processors handle the "extra" variables:
-
- do im=1,iscale
- eke = eke + scalm*0.25d0*(v(nr3+im)+vold(nr3+im))**2
- ekpbs = ekpbs + scalm*v(nr3+im)*vold(nr3+im)
- ekph = ekph + scalm*v(nr3+im)**2
- end do
-
- eke = eke * 0.5d0
- ekph = ekph * 0.5d0
- ekpbs = ekpbs * 0.5d0
-#ifdef LES
- ekeles = ekeles * 0.5d0
- ekphles = ekphles * 0.5d0
-#endif
-
- if( ntt == 1 ) then
-#ifdef LES
-
- if (temp0les < 0.d0) then
- scaltp = sqrt(1.d0 + 2.d0*dttp*(ekin0-eke)/(ekmh+ekph))
- else
- scaltp = sqrt(1.d0+2.d0*dttp*(ekinp0-eke)/(ekmh+ekph))
- scaltles = sqrt(1.d0+2.d0*dttp*(ekinles0-ekeles)/(ekmhles+ekphles))
- end if
-#else
-
- ! --- following is from T.E. Cheatham, III and B.R. Brooks,
- ! Theor. Chem. Acc. 99:279, 1998.
-
- scaltp = sqrt(1.d0 + 2.d0*dttp*(ekin0-eke)/(ekmh+ekph))
-
- ! --- following is the "old" (amber7 and before) method:
-
- ! scaltpo = sqrt(1.d0 + dttp*(ekin0/ekph - 1.d0))
- ! write(6,*) 'scaltp: ',2.d0*dttp*(ekin0-eke)/(ekmh+ekph), &
- ! dttp*(ekin0/ekmh - 1.d0)
-
- ! following line reverts to the "old" behavior:
- ! scaltp = scaltpo
-
-#endif
-
-#ifdef MPI /* SOFT CORE */
- if (icfe /= 0) then
- if (ifsc == 1) then
- if (master) then
- ! Linearly combine the scaling factors from both processes
- ! the combined factor is broadcast to all nodes
- ! the subroutine also correctly scales the softcore atom v's
- call mix_temp_scaling(scaltp,clambda,v)
- end if
- call mpi_bcast(scaltp,1,MPI_DOUBLE_PRECISION,0,commsander,ierr)
- end if
- end if
-#endif
-
- do j = istart,iend
- i3=(j-1)*3+1
-#ifdef LES
- if (temp0les > 0.d0 .and. cnum(j) /= 0 ) then
- v(i3 ) = v(i3 )*scaltles
- v(i3+1) = v(i3+1)*scaltles
- v(i3+2) = v(i3+2)*scaltles
- else
- v(i3 ) = v(i3 ) *scaltp
- v(i3+1) = v(i3+1) *scaltp
- v(i3+2) = v(i3+2) *scaltp
- end if
-#else
- v(i3 ) = v(i3 ) *scaltp
- v(i3+1) = v(i3+1) *scaltp
- v(i3+2) = v(i3+2) *scaltp
-#endif
- end do
- do im=1,iscale
- v(nr3+im) = v(nr3+im)*scaltp
- end do
- end if ! (ntt == 1 )
-
- end if ! ( ntt == 1 .or. onstep; end of step 4c )
-
- !-----------------------------------------------------------------
- ! Step 5: several tasks related to dumping of trajectory information
- !-----------------------------------------------------------------
-
- itdump = .false. ! Write coordinates this step?
- ivdump = .false. ! Write velocities this step?
- ifdump = .false. ! Write forces this step? lam81
- ixdump = .false. ! Write restart this step?
- ifdump = .false. ! Write forces this step?
- ivscm = .false. ! Do com removal this step?
-#ifdef RISMSANDER
- irismdump = .false. ! Write RISM files this step?
-#endif
-
- ! --- Determine if trajectory, velocity, or restart
- ! writing is imminent, or if the center of mass
- ! motion will be removed.
- ! These require xdist of velocities or dipoles in parallel runs:
- !
- ! Modified so that when running REMD, writing can occur less often
- ! than exchanges (e.g. ntwx > nstlim)
- ! DAN ROE: Added two new variables, total_nstep and total_nstlim.
- ! For non-REMD runs, total_nstep=nstep+1 and total_nstlim=nstlim
- ! just like before.
- ! For REMD runs, total_nstep=(mdloop-1)*nstlim+nstep+1, where
- ! mdloop is the current exchange - this is the current
- ! replica exchange MD step. total_nstlim=numexchg*nstlim, which is
- ! the maximum number of REMD steps.
- total_nstep=nstep+1
- total_nstlim=nstlim
- if(abfqmmm_param%abfqmmm == 1) total_nstep=abfqmmm_param%qmstep ! lam81
-
-#ifdef MPI
- if (rem /= 0) then
- total_nstep = (mdloop - 1) * nstlim + nstep + 1
- total_nstlim = nstlim * numexchg
- endif
-#endif
- if (ntwx>0) itdump = mod(total_nstep,ntwx) == 0 ! Trajectory coords
- if (ntwv>0) ivdump = mod(total_nstep,ntwv) == 0 ! Velocity
- if (ntwf>0) ifdump = mod(total_nstep,ntwf) == 0 ! Force
- if( ntwr /= 0 ) then
- if ( mod(total_nstep, ntwr ) == 0 ) ixdump = .true. ! Restart
- endif
- if( total_nstep >= total_nstlim ) ixdump = .true. ! Final restart
- if ( nscm > 0 ) then
- if( mod(total_nstep,nscm) == 0 ) ivscm =.true. ! C.o.M. removal
- end if
- if (ntwv == -1 .and. itdump) ivdump = .true. !Combined crdvel file
-
-#ifdef MPI
- ! adaptive QM/MM via multisander
- ! all groups have identical coords and velocities
- ! only master of first group needs to dump results
- ! We have to leave the dump values for all threads in the group, though
- ! since for dumping the coords, these are broadcast within the group
- ! (see call to xdist() below)
- if ( qmmm_nml%vsolv > 1 ) then
- if ( nodeid /= 0 ) then
- ixdump = .false.
- itdump = .false.
- ivdump = .false.
- end if
- end if
-#endif
-
-#ifdef RISMSANDER
- if(rismprm%irism ==1)then
- if(rismprm%ntwrism > 0 )then
- irismdump = mod(nstep+1,rismprm%ntwrism) == 0
- if( nstep+1 >= nstlim ) then !! do we want to do this?
- irismdump = .true.
- end if
- end if
- end if
-#endif
-
-
-#ifdef MPI
-
- !-----------------------------------------------------------------
- ! --- now distribute the coordinates, and if necessary, dipoles and vel:
- !-----------------------------------------------------------------
-
- call timer_barrier( commsander )
- call timer_stop_start(TIME_VERLET,TIME_DISTCRD)
- if ( .not. mpi_orig .and. numtasks > 1 ) then
- call xdist(x, xx(lfrctmp), natom)
- end if
- ! dac/knut change: force the coordinates to be the same on both masters.
- ! For certain compilers, addition may not be strictly commutative, so
- ! the forces on group 0 may be different by roundoff from the forces on
- ! group 1. This can lead to divergent trajectories. The interval at
- ! which they are resynchronized is hard-wired here to 20, which seems to
- ! work fine in our tests.
- ! jwk change: coordinates are synchronized when shake is enabled above
- if( icfe /= 0 .and. mod(nstep+1,20) == 0 .and. ntc == 1 ) then
-
- ! In dual-topology this is done within softcore.f
- if (ifsc /= 1) then
- if( master ) call mpi_bcast(x,nr3,MPI_DOUBLE_PRECISION, &
- 0,commmaster,ierr)
- else
- if( master ) then
- call sc_compare(x,nr3,'CRD') ! first, check if coordinates have desynced
- if (numtasks==1 ) call sc_compare(v,nr3,'VEL') ! do the same for velocities
- call sc_sync_x(x,nr3) ! then resync them
- end if
- end if
- if( numtasks>1 ) call mpi_bcast(x,nr3,MPI_DOUBLE_PRECISION, &
- 0,commsander,ierr)
- end if
- call timer_stop(TIME_DISTCRD)
-
-#endif /* MPI */
-
- ! ----fix lone pair positions:
- if( numextra > 0 )call local_to_global(x,xx,ix)
-
-#ifdef MPI
- if ( .not. mpi_orig .and. numtasks > 1 ) then
- call timer_start(TIME_DISTCRD)
-
- ! ---Here we provide every processor a full copy of the velocities
- ! for removal of center of mass motion, or for archiving.
- ! (Note: this is actually over-kill: for example, only the master
- ! node really needs the velocities for archiving. But the extra
- ! overhead of doing it this way is probably small in most cases.)
-
- if( ivdump .or. ivscm .or. ixdump ) then
- call xdist(v, xx(lfrctmp), natom)
- endif
-
-! M-WJ
-! if( ixdump .and. (induced == 1 .and. indmeth == 3 ) )then
- if( ixdump .and. (induced > 0 .and. indmeth == 3 ) )then
-!
- call xdist(xx(ldipvel), xx(lfrctmp), natom)
- call xdist(xx(linddip), xx(lfrctmp), natom)
- end if
- call timer_stop(TIME_DISTCRD)
- end if
- call timer_start(TIME_VERLET)
-
- ! ========================= END AMBER/MPI =========================
-#endif /* MPI */
-
- !-------------------------------------------------------------------
- ! Step 6: zero COM velocity if requested; used for preventing
- ! ewald "block of ice flying thru space" phenomenon, or accumulation
- ! of rotational momentum in vacuum simulations
- !-------------------------------------------------------------------
-
- if (ivscm) then
- if (mod(nstep,nsnb) == 0) ntnb = 1
- if( ifbox == 0 ) then
- if (is_langevin) then
- ! Get current center of the system
- call get_position(nr,x,vcmx,vcmy,vcmz,sysrange,0)
-
-#ifdef MMPI /* SOFT CORE */
- if (ifsc == 1) call sc_mix_position(vcmx,vcmy,vcmz,clambda)
-#endif
- ! Center the system to the original center
- call re_position(nr,ntr,x,xc, &
- vcmx,vcmy,vcmz,sysx,sysy,sysz,sysrange,mv_flag,0)
- else
- ! ---Non-periodic simulation: remove both translation and rotation.
- ! Back the coords up 1/2 step, so that the correspond to the
- ! velocities; temporarily store in the F() array:
- f(1:nr3) = x(1:nr3) - v(1:nr3)*dt5
- ! --- now compute the com motion, remove it, and recompute (just
- ! to check that it is really gone.....)
- call cenmas(nr,f,v,amass,ekcm,xcm,vcm,acm,ekrot,ocm,4)
- call stopcm(nr,f,v,xcm,vcm,ocm, .true.)
- call cenmas(nr,f,v,amass,ekcm,xcm,vcm,acm,ekrot,ocm,4)
- end if
- else
- if (.not. is_langevin) then
- ! ---Periodic simulation: just remove the translational velocity:
- vcmx = 0.d0
- vcmy = 0.d0
- vcmz = 0.d0
- j = 1
- do i = 1, 3*natom,3
- aamass = amass(j)
- vcmx = vcmx + aamass * v(i)
- vcmy = vcmy + aamass * v(i+1)
- vcmz = vcmz + aamass * v(i+2)
- j = j + 1
- end do
- vcmx = vcmx * tmassinv
- vcmy = vcmy * tmassinv
- vcmz = vcmz * tmassinv
- vel2 = vcmx*vcmx + vcmy*vcmy + vcmz*vcmz
- atempdrop = 0.5d0 * tmass * vel2 * onefac(1) !onefac(1) = 1.0d0/fac(1)
- vel = sqrt(vel2)
- if ( master ) write (6,'(a,f15.6,f9.2,a)') &
- 'check COM velocity, temp: ',vel,atempdrop, '(Removed)'
- do i = 1, 3*natom, 3
- v(i) = v(i) - vcmx
- v(i+1) = v(i+1) - vcmy
- v(i+2) = v(i+2) - vcmz
- end do
-
-#ifdef MPI /* SOFT CORE */
- if (icfe==1) then
- if (ifsc==1) then
- if (master) then
- call sc_mix_velocities(v,nr3,clambda)
- end if
- call mpi_bcast(v,nr3,MPI_DOUBLE_PRECISION,0,commsander,ierr)
- end if
- end if
-#endif
- end if ! (.not. is_langevin)
- end if ! ( ifbox == 0 )
- end if ! (ivscm)
-
- ! Also zero out the non-moving velocities if a belly is active:
- if (belly) call bellyf(nr,ix(ibellygp),v)
-
- !-----------------------------------------------------------------
- ! --- put current velocities into VOLD
- !-----------------------------------------------------------------
-
- vold(istart3:iend3) = v(istart3:iend3)
- do im=1,iscale
- vold(nr3+im) = v(nr3+im)
- end do
-
- !-------------------------------------------------------------------
- ! Step 7: scale coordinates if NPT with Berendsen barostat:
- !-------------------------------------------------------------------
- if( ntp > 0 .and. ipimd > 0 .and. barostat == 1 ) then
- x_lnv_old = x_lnv
- x_lnv = x_lnv_old + v_lnv * dtx
- rmu(1:3) = exp( ( x_lnv - x_lnv_old ) )
- box(1:3) = box(1:3) * rmu(1:3)
- volume = box(1) * box(2) * box(3)
- ener%box(1:3) = box(1:3)
- ! only for NMPIMD in sander.LES
- ! (in sander.MPI volume, pressure and density printed in pimdout)
-#ifdef LES
- ener%volume = volume
-#else
- ener%volume = 0.
- totener%volume = volume
-#endif
- call redo_ucell(rmu)
- call fill_tranvec()
- call ew_pscale(natom,x,amass,nspm,nsp,2)
- end if
-
- if( iamoeba == 0 .and. barostat == 1 ) then
-
- ! ntp = 1, isotropic pressure coupling
-
- if (ntp == 1) then
- rmu(1) = (1.d0-dtcp*(pres0-ener%pres(4)))**third
- rmu(2) = rmu(1)
- rmu(3) = rmu(1)
-
-
- ! ntp = 2, anisotropic pressure scaling
-
- else if (ntp == 2) then
-
- if (csurften > 0) then
-
- ! Constant surface tension adjusts the tangential pressures
- ! See Zhang, Feller, Brooks, Pastor. J. Chem. Phys. 1995
-
- if (csurften == 1) then ! For surface tension in the x direction
- pres0y = pres0x - gamma_ten_int * ten_conv / box(1)
- pres0z = pres0y
-
- else if (csurften == 2) then ! For surface tension in the y direction
- pres0x = pres0y - gamma_ten_int * ten_conv / box(2)
- pres0z = pres0x
-
- !else if (csurften == 3) then ! For surface tension in the z !direction
- else
- pres0x = pres0z - gamma_ten_int * ten_conv / box(3)
- pres0y = pres0x
-
- end if
-
- rmu(1) = (1.d0 - dtcp * (pres0x - ener%pres(1)))**third
- rmu(2) = (1.d0 - dtcp * (pres0y - ener%pres(2)))**third
- rmu(3) = (1.d0 - dtcp * (pres0z - ener%pres(3)))**third
-
- else
-
- rmu(1) = (1.d0-dtcp*(pres0-ener%pres(1)))**third
- rmu(2) = (1.d0-dtcp*(pres0-ener%pres(2)))**third
- rmu(3) = (1.d0-dtcp*(pres0-ener%pres(3)))**third
-
- end if
-
- ! ntp = 3, semiisotropic pressure coupling
- ! (currently only for csurften>0, constant surface tension)
-
- !else if (ntp > 2) then
- else
-
- if (csurften > 0) then
-
- if (csurften == 1) then ! For surface tension in the x direction
- pres0y = pres0x - gamma_ten_int * ten_conv / box(1)
- pres0z = pres0y
- press_tan_ave = (ener%pres(2) + ener%pres(3))/2
- rmu(1) = (1.d0 - dtcp * (pres0x - ener%pres(1)))**third
- rmu(2) = (1.d0 - dtcp * (pres0y - press_tan_ave))**third
- rmu(3) = (1.d0 - dtcp * (pres0z - press_tan_ave))**third
-
- else if (csurften == 2) then ! For surface tension in the y direction
- pres0x = pres0y - gamma_ten_int * ten_conv / box(2)
- pres0z = pres0x
- press_tan_ave = (ener%pres(1) + ener%pres(3))/2
- rmu(1) = (1.d0 - dtcp * (pres0x - press_tan_ave))**third
- rmu(2) = (1.d0 - dtcp * (pres0y - ener%pres(2)))**third
- rmu(3) = (1.d0 - dtcp * (pres0z - press_tan_ave))**third
-
- !else if (csurften == 3) then ! For surface tension in the z !direction
- else
- pres0x = pres0z - gamma_ten_int * ten_conv / box(3)
- pres0y = pres0x
- press_tan_ave = (ener%pres(1) + ener%pres(2))/2
- rmu(1) = (1.d0 - dtcp * (pres0x - press_tan_ave))**third
- rmu(2) = (1.d0 - dtcp * (pres0y - press_tan_ave))**third
- rmu(3) = (1.d0 - dtcp * (pres0z - ener%pres(3)))**third
-
- end if
- end if
- ! Add semiisotropic pressure scaling in any direction with no constant
- ! surface tension here
- end if
-
- if (ntp > 0) then
- box(1:3) = box(1:3)*rmu(1:3)
- ener%box(1:3) = box(1:3)
-
- ! WARNING!! This is not correct for non-orthogonal boxes if
- ! NTP > 1 (i.e. non-isotropic scaling). Currently general cell
- ! updates which allow cell angles to change are not implemented.
- ! The viral tensor computed for ewald is the general Nose Klein,
- ! however the cell response needs a more general treatment.
-
- call redo_ucell(rmu)
- ! keep tranvec up to date, rather than recomputing each MD step.
- call fill_tranvec() ! tranvec is dependent on only ucell
-
-#ifdef MPI /* SOFT CORE */
- ! if softcore potentials and the dual topology approach are used
- ! C.O.M. scaling has to be changed to account for different masses
- ! of the same molecule in V0 and V1. This is quite inefficient and is
- ! therefore done in a separate routine in softcore.f
- ! only both masters actually do the computation for ifsc==1
- ! the scaled coordinates are then broadcast to the nodes
- if (icfe /= 0 .and. ifsc == 1) then
- if (master) then
- call sc_pscale(natom,x,amass,nspm,nsp,oldrecip,ucell)
- end if
- call mpi_bcast(x,nr3,MPI_DOUBLE_PRECISION,0,commsander,ierr)
- else
-#endif
- call ew_pscale(natom,x,amass,nspm,nsp,npscal)
-#ifdef MPI /* SOFT CORE */
- end if
-#endif
- if (ntr > 0 .and. nrc > 0) &
- call ew_pscale(natom,xc,amass,nspm,nsp,npscal)
- endif
- if (ipimd==NMPIMD.and.ntp>0) then
- ener%cmt(4) = 0.d0
- ener%vir(4) = 0.d0
- ener%pres(4) = pressure*pconv
- endif
- else if (barostat == 1) then
- if (ntp>0) then
- if (ipimd==0) then ! for classical AMOEBA
- ener%cmt(4) = eke ! for printing in prntmd()
- ener%vir(4) = ener%vir(1) + ener%vir(2) + ener%vir(3)
- ener%pres(4) = (pressure_constant/volume)*(2.d0*eke - ener%vir(4)) / 3.d0
- elseif (ipimd==NMPIMD) then ! for NMPIMD AMOEBA
- ener%cmt(4) = 0.d0
- ener%vir(4) = 0.d0
- ener%pres(4) = pressure*pconv
- endif
- call AM_RUNMD_scale_cell(natom,ener%pres(4),dt,pres0,taup,x)
- call fill_tranvec()
- end if
- end if
-
-#ifdef LES
- ener%kin%solt = eke
- ener%kin%solv = ekeles
- ener%kin%tot = ener%kin%solt + ener%kin%solv
- if (ntt == 1 .and. onstep) then
- if ( temp0les < 0 ) then
- ekmh = max(ekph,fac(1)*10.d0)
- else
- ekmh = max(ekph,fac(2)*10.d0)
- ekmhles = max(ekphles,fac(3)*10.d0)
- endif
- end if
-
- if( ipimd > 0 ) then
- ener%kin%solv = equal_part + Epot_deriv ! "virial" estimate of KE
- ener%tot = ener%kin%solv + ener%pot%tot
- endif
-#else
- if( ipimd > 0 ) then
- ! use a "virial" estimator for the KE, rather than one derived from the
- ! bead velocities:
- totener%kin%solv = equal_part + Epot_deriv
- else
- ener%kin%solv = ekpbs + ener%pot%tot
- ! Pastor, Brooks, Szabo conserved quantity
- ! for harmonic oscillator: Eq. 4.7b of Mol.
- ! Phys. 65:1409-1419, 1988
- endif
- ener%kin%solt = eke
- ener%kin%tot = ener%kin%solt
- if (ntt == 1 .and. onstep) then
- ekmh = max(ekph,fac(1)*10.d0)
- end if
-#endif
-
- ! ---if velocities were reset, the KE is not accurate; fudge it
- ! here to keep the same total energy as on the previous step.
- ! Note that this only affects printout and averages for Etot
- ! and KE -- it has no effect on the trajectory, or on any averages
- ! of potential energy terms.
-
- if( resetvelo ) ener%kin%tot = etot_save - ener%pot%tot
-
- ! --- total energy is sum of KE + PE:
-
- if( ipimd > 0 ) then
- totener%tot = totener%kin%solv + totener%pot%tot
- etot_save = totener%kin%tot + totener%pot%tot
- if (ipimd==CMD) then
- etot_cmd = eke_cmd*0.5 + ener%pot%tot
-
- totener%tot= etot_cmd
-
- ener%tot = etot_cmd
- ener%kin%tot = eke_cmd*0.5
- ener%kin%solv = ener%kin%tot
- endif
- else
- ener%tot = ener%kin%tot + ener%pot%tot
- etot_save = ener%tot
- end if
-
- !-------------------------------------------------------------------
- ! Step 8: update the step counter and the integration time:
- !-------------------------------------------------------------------
-
- if(abfqmmm_param%abfqmmm /= 1) then ! lam81
- nstep = nstep+1
- t = t+dt
- end if ! lam81
-
- !For CMD
- if ( ipimd==CMD ) then
- nstep_cmd = nstep_cmd + 1
- t_cmd = t_cmd + dt
- end if
-
- ! ---full energies are only calculated every nrespa steps
- ! nvalid is the number of steps where all energies are calculated
-
- if (onstep .or. aqmmm_flag > 0) then
- nvalid = nvalid + 1
- ! Update all elements of these sequence types
- enert = enert + ener
- enert2 = enert2 + (ener*ener)
-#ifdef MPI
- if( ievb /= 0 ) then
- evb_nrg_ave(:) = evb_nrg_ave(:) + evb_nrg(:)
- evb_nrg_rms(:) = evb_nrg_rms(:) + evb_nrg(:)**2
- endif
- if ( ifsc /= 0 ) then
- sc_ener_ave(1:ti_ene_cnt) = sc_ener_ave(1:ti_ene_cnt) + sc_ener(1:ti_ene_cnt)
- sc_ener_rms(1:ti_ene_cnt) = sc_ener_rms(1:ti_ene_cnt) + sc_ener(1:ti_ene_cnt)**2
- end if
-#endif
- if( nvalid == 1 ) etot_start = ener%tot
-
-#ifndef LES
- if ( ipimd>0 .or. ineb>0 ) then
-# ifdef MPI
- if (master) call mpi_reduce(ener%kin%tot,totener%kin%tot,1,MPI_DOUBLE_PRECISION, &
- mpi_sum,0,commmaster,ierr)
-
-# endif
- endif
-
- ! Passing of dvdl=dV/dl for TI w.r.t. mass
- ! Note that ener(39) (in runmd and mix_frcti) =
- ! = ener(17) = ene(21) (in force). All denote dvdl.
- ! Note, ener() is now historical, MJW Feb 2010
- if (ipimd>0 .and. itimass>0) totener%pot%dvdl = ener%pot%dvdl
-
- if(ipimd.eq.NMPIMD.and.ntp>0) then
- totener%pres(4) = pressure * pconv
- totener%density = tmass / (0.602204d0*volume)
- endif
- if(ipimd.eq.CMD) then
- totener%kin%tot = eke_cmd*0.5d0
- totener%kin%solv = totener%kin%tot
- totener%tot = totener%kin%tot + totener%pot%tot
- endif
- totenert = totenert + totener
- totenert2 = totenert2 + (totener*totener)
-
-#endif /* LES */
-
- kinetic_E_save(2) = kinetic_E_save(1)
- kinetic_E_save(1) = ener%kin%tot
-
- end if
-
- ! added for rbornstat
-!!FIX: TL - do we need to put in rismnrespa here?
- if (mod(irespa,nrespai) == 0 .or. irespa < 2) nvalidi = nvalidi + 1
-
- ntnb = 0
- if (mod(nstep,nsnb) == 0) ntnb = 1
-
- ! Since nstep has been incremented, total_nstep is now equal to
- ! (mdloop-1)*nstlim+nstep for REMD and nstep for MD.
- lout = mod(total_nstep,ntpr) == 0 .and. onstep
-
- irespa = irespa + 1
-
- ! reset pb-related flags
-#ifdef MPI
- if(mytaskid == 0)then
-#endif
- if ( igb == 10 .or. ipb /= 0 ) then
- if ( mod(nstep,npbgrid) == 0 .and. nstep /= nstlim ) pbgrid = .true.
- if ( mod(nstep,ntpr) == 0 .or. nstep == nstlim ) pbprint = .true.
- if ( mod(nstep,nsnbr) == 0 .and. nstep /= nstlim ) ntnbr = 1
- if ( mod(nstep,nsnba) == 0 .and. nstep /= nstlim ) ntnba = 1
- end if
-#ifdef MPI
- endif
-#endif
-
- !-------------------------------------------------------------------
- ! Step 9: output from this step if required:
- !-------------------------------------------------------------------
-
-#ifdef RISMSANDER
- !some 3D-RISM files require all processes to participate in output
- !due to the distributed memory
- ! RISM archive:
- if(rismprm%irism==1)then
-!!$ if(irismdump)&
-!!$ call rism_writeSolvDistF(rism_3d,nstep)
- ! combined thermodynamics and distribution output
- ! Execute if we need to do either
- if(irismdump .or. (rism_calc_type(nstep) == RISM_FULL &
- .and. rismprm%write_thermo==1 .and. lout))&
- call rism_solvdist_thermo_calc(irismdump,nstep)
- endif
-#endif
-
- ! ...only the master needs to do the output
- if (ixdump) then
- if(ipimd.eq.NMPIMD.or.ipimd.eq.CMD) then
- call trans_pos_nmode_to_cart(x,cartpos)
- call trans_vel_nmode_to_cart(v,cartvel)
- endif
- endif
-
- if (itdump) then
- if(ipimd.eq.NMPIMD.or.ipimd.eq.CMD) then
- call trans_pos_nmode_to_cart(x,cartpos)
- endif
-!AMD Flush amdlog file
- if(iamd.gt.0)then
-# ifdef MPI
- if (worldrank.eq.0) &
-# endif
- call write_amd_weights(ntwx,total_nstep)
- end if
-!scaledMD Flush scaledMDlog file
- if(scaledMD.gt.0)then
-# ifdef MPI
- if (worldrank.eq.0) &
-# endif
- call write_scaledMD_log(ntwx,total_nstep)
- end if
-
- endif
-
- if (ivdump) then
- if(ipimd.eq.NMPIMD.or.ipimd.eq.CMD) then
- call trans_vel_nmode_to_cart(v,cartvel)
- endif
- endif
-
-
- if (master) then
-
- ! -- restrt:
-
- if (ixdump) then
-
- ! NOTE - This assumes that if numextra > 0, then velocities are
- ! found in the array v...
- if (numextra > 0) call zero_extra_pnts_vec(v,ix)
-
- if( iwrap == 0 ) then
- nr = nrp
-#ifdef LES
- if(ipimd.eq.NMPIMD.or.ipimd.eq.CMD) then
- call mdwrit(nstep,nrp,nr,nres,ntxo,ntr,ntb, &
- cartpos,cartvel,xx(lcrdr),box,t,temp0)
- else
- call mdwrit(nstep,nrp,nr,nres,ntxo,ntr,ntb, &
- x,v,xx(lcrdr),box,t,temp0les)
- endif
-#else
- if(ipimd.eq.NMPIMD.or.ipimd.eq.CMD) then
- call mdwrit(nstep,nrp,nr,nres,ntxo,ntr,ntb, &
- cartpos,cartvel,xx(lcrdr),box,t,rem_val)
- else
- call mdwrit(nstep,nrp,nr,nres,ntxo,ntr,ntb, &
- x,v,xx(lcrdr),box,t,rem_val)
- endif
-#endif
- else if (iwrap == 1) then
-
- ! --- use temp. array to hold coords. so that the master's values
- ! are always identical to those on all other nodes:
-
- call get_stack(l_temp,nr3,routine)
- if(.not. rstack_ok)then
- deallocate(r_stack)
- allocate(r_stack(1:lastrst),stat=alloc_ier)
- call reassign_rstack(routine)
- endif
- REQUIRE(rstack_ok)
- if(ipimd.eq.NMPIMD.or.ipimd.eq.CMD) then
- do iatom=1,natom
- do m=1,3
- r_stack(l_temp+3*(iatom-1)+m-1)=cartpos(m,iatom)
- end do
- end do
- else
- do m=1,nr3
- r_stack(l_temp+m-1) = x(m)
- end do
- end if
-
- call wrap_molecules(nspm,nsp,r_stack(l_temp))
- if(ifbox == 2) call wrap_to(nspm,nsp,r_stack(l_temp),box)
- nr = nrp
-#ifdef LES
- call mdwrit(nstep,nrp,nr,nres,ntxo,ntr,ntb, &
- r_stack(l_temp),v,xx(lcrdr),box,t,temp0les)
-#else
- call mdwrit(nstep,nrp,nr,nres,ntxo,ntr,ntb, &
- r_stack(l_temp),v,xx(lcrdr),box,t,rem_val)
-#endif
- call free_stack(l_temp,routine)
- else if (iwrap == 2) then
- ! GMS ------------------------------------------
- ! We are wrapping around a pre-determined mask
- ! Need to center it on the mask COM first, then
- ! wrap it normally as it happens on the iwrap=1
- ! case.
- ! GMS ------------------------------------------
- call get_stack(l_temp,nr3,routine)
- if(.not. rstack_ok)then
- deallocate(r_stack)
- allocate(r_stack(1:lastrst),stat=alloc_ier)
- call reassign_rstack(routine)
- endif
- REQUIRE(rstack_ok)
- if(ipimd.eq.NMPIMD.or.ipimd.eq.CMD) then
- do iatom=1,natom
- do m=1,3
- r_stack(l_temp+3*(iatom-1)+m-1)=cartpos(m,iatom)
- end do
- end do
- else
- do m=1,nr3
- r_stack(l_temp+m-1) = x(m)
- end do
- end if
- nr = nrp
-
- ! Now, wrap the coordinates around the iwrap_mask:
- call iwrap2(n_iwrap_mask_atoms,iwrap_mask_atoms,r_stack(l_temp), &
- box_center)
-#ifdef LES
- call mdwrit(nstep,nrp,nr,nres,ntxo,ntr,ntb, &
- r_stack(l_temp),v,xx(lcrdr),box,t,temp0les)
-#else
- call mdwrit(nstep,nrp,nr,nres,ntxo,ntr,ntb, &
- r_stack(l_temp),v,xx(lcrdr),box,t,rem_val)
-#endif
- call free_stack(l_temp,routine)
- end if ! ( iwrap == 0 )
-
-! M-WJ
-! if( igb == 0 .and. induced == 1 .and. indmeth == 3) &
- if( igb == 0 .and. ipb == 0 .and. induced > 0 .and. indmeth == 3) &
-!
- call wrt_dips(xx(linddip),xx(ldipvel),nr,t,title)
-
- if (icnstph /= 0 .and. ((rem /= 0 .and. mdloop > 0) .or. rem == 0)) then
- call cnstphwriterestart(chrgdat)
- end if
-
- end if ! (ixdump)
-
- ! -- Coordinate archive:
- ! For formatted writes and replica exchange, write out a header line.
-
- if (itdump) then
-#ifdef MPI
- ! Write out current replica#, exchange#, step#, and mytargettemp
- ! If mdloop==0 this is a normal md run (since REMD never calls corpac
- ! when mdloop==0) and we don't want the REMD header.
- ! total_nstep is set in step 5.
- if (mdloop > 0 .and. loutfm) then
- if (trxsgld) then
- write (MDCRD_UNIT,'(a,4(1x,i8))') "RXSGLD ", repnum, mdloop, &
- total_nstep, stagid
- else
- write (MDCRD_UNIT,'(a,3(1x,i8),1x,f8.3)') "REMD ", repnum, mdloop, &
- total_nstep, my_remd_data%mytargettemp
- end if
- end if
-#endif
-
- if( iwrap == 0 ) then
- if(ipimd.eq.NMPIMD.or.ipimd.eq.CMD) then
- call corpac(cartpos,1,nrx,MDCRD_UNIT,loutfm)
- else
- call corpac(x,1,nrx,MDCRD_UNIT,loutfm)
- endif
- if(ntb > 0) call corpac(box,1,3,MDCRD_UNIT,loutfm)
- else if (iwrap == 1) then
- call get_stack(l_temp,nr3,routine)
- if(.not. rstack_ok)then
- deallocate(r_stack)
- allocate(r_stack(1:lastrst),stat=alloc_ier)
- call reassign_rstack(routine)
- endif
- REQUIRE(rstack_ok)
- if(ipimd.eq.NMPIMD.or.ipimd.eq.CMD) then
- do iatom=1,natom
- do m=1,3
- r_stack(l_temp+3*(iatom-1)+m-1) = cartpos(m,iatom)
- end do
- end do
- else
- do m=1,nr3
- r_stack(l_temp+m-1) = x(m)
- end do
- endif
-
- call wrap_molecules(nspm,nsp,r_stack(l_temp))
- if (ifbox == 2) call wrap_to(nspm,nsp,r_stack(l_temp),box)
-
- call corpac(r_stack(l_temp),1,nrx,MDCRD_UNIT,loutfm)
- call corpac(box,1,3,MDCRD_UNIT,loutfm)
- call free_stack(l_temp,routine)
- else if (iwrap == 2) then
- ! GMS ------------------------------------------
- ! We are wrapping around a pre-determined mask
- ! Need to center it on the mask COM first, then
- ! wrap it normally as it happens on the iwrap=1
- ! case.
- ! GMS ------------------------------------------
- call get_stack(l_temp,nr3,routine)
- if(.not. rstack_ok)then
- deallocate(r_stack)
- allocate(r_stack(1:lastrst),stat=alloc_ier)
- call reassign_rstack(routine)
- endif
- REQUIRE(rstack_ok)
- if(ipimd.eq.NMPIMD.or.ipimd.eq.CMD) then
- do iatom=1,natom
- do m=1,3
- r_stack(l_temp+3*(iatom-1)+m-1) = cartpos(m,iatom)
- end do
- end do
- else
- do m=1,nr3
- r_stack(l_temp+m-1) = x(m)
- end do
- endif
-
- call iwrap2(n_iwrap_mask_atoms,iwrap_mask_atoms, r_stack(l_temp), &
- box_center)
-
- call corpac(r_stack(l_temp),1,nrx,MDCRD_UNIT,loutfm)
- call corpac(box,1,3,MDCRD_UNIT,loutfm)
- call free_stack(l_temp,routine)
-
-
- end if ! if (iwrap == 0) ...
-
-
- !GMS: If using variable QM solvent, try to write a new pdb file
- ! with the QM coordinates for this step. This is done here
- ! to keep the PDB file in sync with the mdcrd file, which
- ! makes it easier to check later.
- if (qmmm_nml%vsolv > 0 .and. qmmm_nml%verbosity == 0) &
- call qm_print_coords(nstep,.false.)
- end if ! (itdump)
-
- ! Velocity archive:
-
- if (ivdump) then
-
- ! NOTE - This assumes that if numextra > 0, then velocities are
- ! found in the array v...
- if (numextra > 0) call zero_extra_pnts_vec(v,ix)
-
-#ifdef MPI
- ! Write out current replica#, exchange#, step#, and mytargettemp
- ! If mdloop==0 this is a normal md run (since REMD never calls corpac
- ! when mdloop==0) and we don't want the REMD header.
- if (mdloop>0.and.loutfm) then
- if (trxsgld) then
- write (MDVEL_UNIT,'(a,4(1x,i8))') "RXSGLD ", repnum, mdloop, &
- total_nstep, stagid
- else
- write (MDVEL_UNIT,'(a,3(1x,i8),1x,f8.3)') "REMD ", repnum, mdloop, &
- total_nstep, my_remd_data%mytargettemp
- end if
- end if
-#endif
-
- if(ipimd.eq.NMPIMD.or.ipimd.eq.CMD) then
- call corpac(cartvel,1,nrx,MDVEL_UNIT,loutfm)
- else
- call corpac(v,1,nrx,MDVEL_UNIT,loutfm)
- endif
- end if
- ! Force archive lam81
- if (ifdump .and. (abfqmmm_param%abfqmmm == 1)) call corpac(for,1,nrx,MDFRC_UNIT,loutfm) ! lam81
-
- ! Energy archive:
- ! (total_nstep set in Step 5.)
- if (ntwe > 0) then
- if (mod(total_nstep,ntwe) == 0.and.onstep) &
- call mdeng(15,nstep,t,ener,onefac,ntp,csurften)
- end if
-
- if (ioutfm > 0) then
- if (itdump) call end_binary_frame(MDCRD_UNIT)
- if (ivdump .and. ntwv>0 ) call end_binary_frame(MDVEL_UNIT)
- if (ifdump .and. ntwf>0 ) call end_binary_frame(MDFRC_UNIT)
- end if
-
-#ifdef MPI
- if( ievb /= 0 ) call out_evb ( nstep )
-#endif
-
- ! General printed output:
-
- if (lout) then
- if (facc /= 'A') rewind(7)
-
- ! Conserved quantity for Nose'-Hoover based thermostats. ! APJ
- if (ipimd.eq.0 .and. ntt > 4 .and. ntt <= 8 ) then ! APJ
- Econserved = ener%kin%tot + ener%pot%tot + E_nhc ! APJ
- if( ntp>0 ) Econserved = Econserved + pres0 / pconv * volume ! APJ
-# ifdef MPI
- if ( worldrank.eq.0 ) & ! APJ
-# endif
- write(file_nhc,'(I10,F14.4)') nstep, Econserved ! APJ
- endif ! APJ
-#ifdef LES
- if (ipimd>0.and.ntt==4) then
- Econserved = ener%kin%tot + ener%pot%tot + E_nhc
- Econserved = Econserved + Epot_spring
- if( ntp>0 ) Econserved = Econserved + pres0 / pconv * volume
- write(file_nhc,'(I10,F14.4)') nstep, Econserved
- endif
- if ( ipimd.eq.CMD ) then
- ener%kin%tot = eke_cmd*0.5d0
- ener%kin%solv = ener%kin%tot
- ener%tot = ener%kin%tot + ener%pot%tot
-
- end if
-#else
- if ( ipimd>0 ) then
- ener%tot = 0.d0
- ener%kin%tot = 0.d0
- ! Conserved quantity for Nose'-Hoover thermostat.
- if ( ntt==4 ) then
- Econserved = totener%kin%tot + totener%pot%tot + E_nhc
- Econserved = Econserved + Epot_spring
- if ( ntp>0 ) Econserved=Econserved+pres0/pconv*volume
-# ifdef MPI
- if ( worldrank.eq.0 ) &
-# endif
- write(file_nhc,'(I10,F14.4)') nstep, Econserved
- endif
-# ifdef MPI
- if(worldrank.eq.0) &
-# endif
- call pimd_report(nstep,t,pimd_unit,totener,onefac)
- end if
-#endif /* LES */
- call prntmd(total_nstep,nitp,nits,t,ener,onefac,7,.false.)
-
-# ifdef MPI
- ! print corrected energy for adaptive qm/mm runs
- ! note: nstep has already been increased here
- ! (it was not increased when adaptive_qmmm() was called above)
- if ( qmmm_nml%vsolv > 1 ) then
-
- if ( masterrank == 0 ) then
-
- if (aqmmm_flag > 0 .and. nstep > aqmmm_flag) then
-
- etotcorr = corrected_energy + kinetic_E_save(aqmmm_flag)
- nstepadc = nstep - aqmmm_flag + 1
- tadc = t - dt * (dble( aqmmm_flag - 1) )
-
- write(6,'(a)')' Adaptive QM/MM energies:'
- write(6,'(x,a,i5,x,a,f11.4,x,2(a,f15.4,x))') &
- 'adQMMM STEP=', nstepadc, &
- 'TIME(PS)=', tadc, &
- 'ETC=', etotcorr, &
- 'EPC=', corrected_energy
-
- ! print total energy for adaptive qm/mm into a separate file
- ! when qmmm_vsolv%verbosity > 0
- ! set reference energy to zero only for energy dumping purposes
- if (flag_first_energy) then
- flag_first_energy = .false.
- adqmmm_first_energy = etotcorr
- etotcorr = 0.0d0
- else
- etotcorr = etotcorr - adqmmm_first_energy
- end if
-
- if (qmmm_vsolv%verbosity > 0) then
- open(80,file='adqmmm_tot_energy.dat',position='append')
- write(80,'(i9,5x,f11.4,5x,f15.4)') nstepadc, tadc, etotcorr
- close(80)
- end if
-
- end if
- end if
- end if
-# endif
-
-#ifdef MPI /* SOFT CORE */
- if (ifsc /= 0) call sc_print_energies(6, sc_ener)
- if (ifsc /= 0) call sc_print_energies(7, sc_ener)
-#endif
- if ( ifcr > 0 .and. crprintcharges > 0 ) then
- call cr_print_charge( xx(l15), total_nstep )
- end if
-
- ! Output for CMD.
-#ifdef LES
- if (ipimd.eq.CMD) then
-
- ncmd = 0
- do iatom = 1, natom
- if ( cnum(iatom)==0 .or. cnum(iatom)==1 ) then
- xcmd(ncmd+1) = x(3*iatom-2)
- xcmd(ncmd+2) = x(3*iatom-1)
- xcmd(ncmd+3) = x(3*iatom)
- vcmd(ncmd+1) = v(3*iatom-2)
- vcmd(ncmd+2) = v(3*iatom-1)
- vcmd(ncmd+3) = v(3*iatom)
- ncmd = ncmd+3
- endif
- enddo
- write(file_pos_cmd,'(10f8.3)') xcmd(1:ncmd)
- write(file_vel_cmd,'(10f8.3)') vcmd(1:ncmd)
- write(file_pos_cmd,'(10f8.3)') box(1:3)
-
- eke_cmd = eke_cmd * 0.5d0
- etot_cmd = eke_cmd + ener%pot%tot
-
- if (eq_cmd) then
- temp_cmd = eke_cmd/boltz2/dble(3*natomCL)
- else
- temp_cmd = eke_cmd/boltz2/dble(3*(natomCL-1))
- endif
-
- endif
-#else
- if (ipimd.eq.CMD.and.mybeadid.eq.1) then
- write(file_pos_cmd,'(10f8.3)') x(1:3*natom)
- write(file_vel_cmd,'(10f8.3)') v(1:3*natom)
- write(file_pos_cmd,'(10f8.3)') box(1:3)
-
- eke_cmd = eke_cmd * 0.5d0
- etot_cmd = eke_cmd + totener%pot%tot
-
- if (eq_cmd) then
- temp_cmd = eke_cmd/boltz2/dble(3*natom)
- else
- temp_cmd = eke_cmd/boltz2/dble(3*(natom-1))
- endif
- end if
-#endif /* LES */
-
- !--- Print QMMM Muliken Charges if needed ---
- if (qmmm_nml%ifqnt) then
- if (qmmm_nml%printcharges .and. qmmm_mpi%commqmmm_master) then
- call qm2_print_charges(nstep,qmmm_nml%dftb_chg,qmmm_struct%nquant_nlink, &
- qm2_struct%scf_mchg,qmmm_struct%iqm_atomic_numbers)
- end if
- end if
- if (qmmm_nml%printdipole /= 0) then
- call qmmm_dipole(x,xx(Lmass),ix(i02),ih(m02),nres)
- end if
-
- !--- BEGIN DIPOLE PRINTING CODE ---
-
- ! RCW 2nd Dec 2003 - also output dipole information if
- ! the dipoles namelist has been specified and corresponding
- ! groups defined.
-
- ! Check input unit 5 for namelist dipoles
- ! We expect to find &dipoles followed by a group
- ! specification of the dipoles to output.
- call nmlsrc('dipoles',5,prndipfind)
-
- if(prndipfind /= 0 ) then
- !We calculate the dipoles
- write(6,*) '------------------------------- DIPOLE INFO ----------------------------------'
- write(6,9018) nstep,t
- 9018 format(/1x, 'NSTEP =',i7,1x,'TIME(PS) =',f10.3)
-
- !Get the groups for the dipoles - Ideally we only really want
- !to call this the once but for the time being I will call it
- !every time
-
- read (5,'(a)') prndiptest
-
- call rgroup(natom,natc,nres,prndipngrp,ix(i02),ih(m02), &
- ih(m04),ih(m06),ih(m08),ix(icnstrgp), &
- jgroup,indx,irespw,npdec, &
- xx(l60),xx(lcrdr),0,0,0,idecomp,5,.false.)
-
- ! Need to rewind input file after rgroup so it is available
- ! when we next loop through
-
- rewind(5)
-
- if(prndipngrp > 0) then
- !prndipngrp - holds number of groups specified + 1
- !ix(icnstrgp) - holds map of group membership for each atom
- !x(lcrd) - X,Y,Z coords of atoms - (3,*)
- !x(l15) - Partial Charges
- !x(linddip) - induced dipoles X,Y,Z for each atom (3,*)
- !x(Lmass) - Mass of each atom
- call printdip(prndipngrp,ix(icnstrgp),xx(lcrd), &
- xx(l15),xx(linddip),xx(Lmass), natom)
- end if
- write(6,*) '----------------------------- END DIPOLE INFO --------------------------------'
- end if
- !--- END DIPOLE PRINTING CODE ---
-
- if (nmropt > 0) then
- call nmrptx(6)
- end if
- if (itgtmd == 2) then
- emtmd = 0.0d0
- call mtmdcall(emtmd,xx(lmtmd01),ix(imtmd02),x,f,ih(m04),ih(m02),ix(i02),&
- ih(m06),xx(lmass),natom,nres,'PRNT')
- end if
- call amflsh(7)
- end if
-
- ! Output running averages:
- ! DAN ROE: total_nstep==Total nstep REMD/MD, set in step 5
- if ( ntave > 0 )then
- if ( mod(total_nstep,ntave) == 0 .and. onstep )then
- write(6,542)
-#ifdef RISMSANDER
- if(rismprm%irism==1)then
- tspan = ntave/mylcm(nrespa,rismprm%rismnrespa)
- else
- tspan = ntave/nrespa
- end if
-#else
- tspan = ntave/nrespa
-#endif
-
- ! Update all elements of these sequence types
- enert_tmp = enert - enert_old
- enert2_tmp = enert2 - enert2_old
- enert_old = enert
- enert2_old = enert2
- enert_tmp = enert_tmp/tspan
- enert2_tmp = enert2_tmp/tspan - &
- enert_tmp*enert_tmp
- call zero_neg_values_state(enert2_tmp)
- enert2_tmp = sqrt(enert2_tmp)
-
-#ifdef MPI
- if( ievb /= 0 ) then
- evb_nrg_tmp (:) = evb_nrg_ave(:) - evb_nrg_old (:)
- evb_nrg_tmp2(:) = evb_nrg_rms(:) - evb_nrg_old2(:)
- evb_nrg_old (:) = evb_nrg_ave(:)
- evb_nrg_old2(:) = evb_nrg_rms(:)
- evb_nrg_tmp (:) = evb_nrg_tmp (:) / tspan
- evb_nrg_tmp2(:) = evb_nrg_tmp2(:) / tspan - evb_nrg_tmp(:)**2
- evb_nrg_tmp2(:) = max( evb_nrg_tmp2(:), 0.0d0 )
- evb_nrg_tmp2(:) = sqrt( evb_nrg_tmp2(:) )
- endif
- if ( ifsc /= 0 ) then
- do m = 1,ti_ene_cnt
- sc_ener_tmp(m) = sc_ener_ave(m)-sc_ener_old(m)
- sc_ener_tmp2(m) = sc_ener_rms(m)-sc_ener_old2(m)
- sc_ener_old(m) = sc_ener_ave(m)
- sc_ener_old2(m) = sc_ener_rms(m)
- sc_ener_tmp(m) = sc_ener_tmp(m)/tspan
- sc_ener_tmp2(m) = sc_ener_tmp2(m)/tspan - sc_ener_tmp(m)**2
- if (sc_ener_tmp2(m) < 0.0d0) sc_ener_tmp2(m) = 0.0d0
- sc_ener_tmp2(m) = sqrt(sc_ener_tmp2(m))
- end do
- end if
- if( ievb /= 0 ) evb_frc%evb_ave = .true.
-#endif
-#ifdef RISMSANDER
- if(rismprm%irism==1)then
- write(6,540) ntave/mylcm(nrespa,rismprm%rismnrespa)!nrespa
- else
- write(6,540) ntave/nrespa
- end if
-#else
- write(6,540) ntave/nrespa
-#endif
- call prntmd(total_nstep,izero,izero,t,enert_tmp,onefac,0,.false.)
-#ifdef MPI
- if (ifsc /= 0) call sc_print_energies(6, sc_ener_tmp)
- if( ievb /= 0 ) evb_frc%evb_rms = .true.
-#endif
- write(6,550)
- call prntmd(total_nstep,izero,izero,t,enert2_tmp,onefac,0,.true.)
-#ifdef MPI /* SOFT CORE */
- if (ifsc /= 0) call sc_print_energies(6, sc_ener_tmp2)
-#endif
- if( icfe > 0 ) then
-#ifdef RISMSANDER
- if(rismprm%irism==1)then
- write(6,541) ntave/mylcm(nrespa,rismprm%rismnrespa)!nrespa
- else
- write(6,541) ntave/nrespa
- end if
-#else
- write(6,541) ntave/nrespa
-#endif
- edvdl_r = edvdl_r/tspan
- edvdl_r%pot%dvdl = enert_tmp%pot%dvdl ! fix for DV/DL output
- edvdl_r%virvsene = 0.d0 ! virvsene should not but included here
- call prntmd(total_nstep,izero,izero,t,edvdl_r,onefac,0,.false.)
- edvdl_r = null_state_rec
-
- end if
- write(6,542)
- end if
- end if ! ( ntave > 0 )
-
- ! --- end masters output ---
-
- end if ! (master)
-
-#ifdef MPI /* SOFT CORE */
- if (ntave > 0 .and. icfe > 0 .and. dynlmb > 0) then
- if ( mod(nstep,ntave) == 0 .and. onstep ) then
- ! For runs with dynamically changing lambda, raise lambda here
- ! and flush all buffers for the next averages
- clambda = clambda + dynlmb
- call sc_change_clambda(clambda)
- if (master) then
- sc_ener(1:ti_ene_cnt) = 0.0d0
- sc_ener_ave(1:ti_ene_cnt) = 0.0d0
- sc_ener_rms(1:ti_ene_cnt) = 0.0d0
- sc_ener_old(1:ti_ene_cnt) = 0.0d0
- sc_ener_old2(1:ti_ene_cnt) = 0.0d0
- enert = null_state_rec
- enert2 = null_state_rec
- enert_old = null_state_rec
- enert2_old = null_state_rec
- write (6,*)
- write (6,'(a,f12.4,a,f12.4)') &
- 'Dynamically changing lambda: Increased clambda by ', &
- dynlmb, ' to ', clambda
- write (6,*)
- end if
- end if
- end if
-#endif
-
- !=======================================================================
-
- ! ---major cycle back to new step unless we have reached our limit:
-
-#ifdef MMTSB
- if ( mmtsb_switch /= mmtsb_off ) then
- if ( mod( nstep, mmtsb_iterations ) == 0 ) then
- write(6,'(a,i8)') &
- 'MMTSB Replica Exchange iterations completed at NSTEP = ', &
- nstep
- ! apparently 23 is the magic number for potential energy.
- ! ener%pot%tot is the new 23 ;) MJW
- write(6,'(a,f12.4)') &
- 'MMTSB Replica Exchange potential energy = ', ener%pot%tot
- ! write coordinates; preferred format is pdb, but can't do that
- ! so write a restart file; server will post process with ambpdb.
-# ifdef LES
- call mdwrit(nstep,nrp,nr,nres,ntxo,ntr,ntb, x,v, &
- xx(lcrdr),box,t,temp0les)
-# else
- call mdwrit(nstep,nrp,nr,nres,ntxo,ntr,ntb, x,v, &
- xx(lcrdr),box,t,rem_val)
-# endif
- ! Chop up trajectory files for later continuous temp splicing.
- call close_dump_files
- ! contact server
- if ( mmtsb_switch == mmtsb_temp_rex ) then
- call mmtsb_newtemp( ener%pot%tot, temp_mmtsb, is_done_mmtsb )
- else if ( mmtsb_switch == mmtsb_lambda_rex ) then
- ! currently temp_mmtsb is ignored, but multidimensional soon
- call mmtsb_newlambda( unpert_pe_mmtsb, pert_pe_mmtsb, &
- lambda_mmtsb, temp_mmtsb, is_done_mmtsb )
- end if
- call open_dump_files
- if ( is_done_mmtsb ) then
- goto 480
- end if
-
- ! in the future we may want amber based tracking of exchanges
- ! perhaps we can use the Simmerling group's code ?
- if ( mmtsb_switch == mmtsb_temp_rex ) then
- if ( abs( temp_mmtsb - temp0 ) <= TEN_TO_MINUS3 ) then
- ! no exchange, continue at the same reference temp.
- mmtsb_is_exchanged = .false.
- write(6,'(a,i8,a,f12.4)') &
- 'MMTSB Replica Exchange temperature unchanged'
- else
- ! exchange temp via changing the reference temp.
- ! the velocities will be randomly reset at the new temp via
- ! the resetvelo variable.
- mmtsb_is_exchanged = .true.
- write(6,'(a,f8.2,a,f8.2)') &
- 'MMTSB Replica Exchange temperature change from ', &
- temp0, ' to ', temp_mmtsb
- temp0 = temp_mmtsb
- end if
- else if ( mmtsb_switch == mmtsb_lambda_rex ) then
- if ( abs( lambda_mmtsb - clambda ) <= TEN_TO_MINUS3 ) then
- ! no exchange, continue at the same lambda
- mmtsb_is_exchanged = .false.
- write(6,'(a,i8,a,f12.4)') &
- 'MMTSB Replica Exchange lambda unchanged'
- else
- ! exchange lambda
- ! the velocities will be randomly reset via
- ! the resetvelo variable.
- mmtsb_is_exchanged = .true.
- write(6,'(a,f8.2,a,f8.2)') &
- 'MMTSB Replica Exchange lambda change from ', &
- clambda, ' to ', lambda_mmtsb
- clambda = lambda_mmtsb
- end if
- end if ! ( mmtsb_switch == mmtsb_temp_rex )
- else
- ! not a replica exchange update iteration.
- mmtsb_is_exchanged = .false.
- end if ! ( mod( nstep, mmtsb_iterations ) == 0 )
- end if ! ( mmtsb_switch /= mmtsb_off )
-#endif
-
-
- call trace_integer( 'end of step', nstep )
- call trace_output_mpi_tally( )
- call timer_stop(TIME_VERLET)
-#if !defined(DISABLE_NCSU) && defined(NCSU_ENABLE_BBMD)
- call ncsu_on_mdstep(ener%pot%tot, v, ekmh)
-#endif /* !defined(DISABLE_NCSU) && defined(NCSU_ENABLE_BBMD) */
-
-#if defined(RISMSANDER) && defined(RISM_DEBUG)
- if(rismprm%irism == 1) then
-!!$ write(6,*) "END OF STEP",natom
-! call calc_cm(x,cm,amass,natom)
- angvel=0
- do m=1,natom
- r = x((m-1)*3+1:(m-1)*3+3)-cm
-!!$ write(6,*) m,v((m-1)*3+1:(m-1)*3+3)
- call cross(r,v((m-1)*3+1:(m-1)*3+3),rxv)
- angvel = angvel + rxv/sum(r**2)
- end do
- moi=0
- erot=0
- do m=1,natom
- r = x((m-1)*3+1:(m-1)*3+3)-cm
- call cross(r,v((m-1)*3+1:(m-1)*3+3),rxv)
- proj = sum(r*angvel)/sum(angvel**2)*angvel
-!!$ write(6,*) "angvel ",angvel
-!!$ write(6,*) "r ",r,sum((r)**2)
-!!$ write(6,*) "proj",proj
-!!$ write(6,*) "r-proj",r-proj,sum((r-proj)**2)
- moi=moi+amass(m)*sum((r-proj)**2)
- erot = erot + .5*amass(m)*sum((r-proj)**2)*sum((rxv/sum(r**2))**2)
- end do
-!!$ write(6,*) moi
-!!$ do m=1,3
-!!$ write(6,*) m,sum(v(m:3*natom:3))
-!!$ write(6,*) m,sum(amass(1:natom)*v(m:3*natom:3))
-!!$ write(6,*) m,angvel(m),sum(angvel**2)
-!!$ end do
-!!$ write(6,*) "EROT", 0.5*moi*sum(angvel**2), erot
-!!$ write(6,*) "EROT", erot
-!!$ call mexit(6,1)
- end if
-#endif /*RISMSANDER && RISM_DEBUG*/
-
- if(abfqmmm_param%abfqmmm == 1) then ! lam81
-#ifdef MPI
- call xdist(v, xx(lfrctmp), natom) ! lam81
-#endif
- abfqmmm_param%v(1:nr3+iscale) = v(1:nr3+iscale) ! lam81
- deallocate(for, stat=ier) ! lam81
- return ! lam81
- end if ! lam81
-
- if (plumed.eq.1 .and. plumed_stopflag/=0) goto 480
-
- if (nstep < nstlim) goto 260
- 480 continue
-
-#ifdef MPI
-! ------====== REMD Post-Dynamics ======------
- if(next_rem_method == 1) then
- remd_ekmh=ekmh
-
- ! ---=== HYBRID REMD ===---
- if (numwatkeep>=0) then
- ! This is a hybrid REMD run. Get energy of stripped system for next
- ! exchange.
- call hybrid_remd_ene(xx,ix,ih,ipairs,qsetup, &
- numwatkeep,hybridgb,igb,ntr,nspm,t,temp0, &
- ntb,cut, &
- ener,ener%vir,do_list_update,nstep, &
- nitp,nits,onefac,loutfm )
- else ! numwatkeep>=0
- ! The positions are currently one step ahead of the energy ener%pot%tot,
- ! since force was called prior to the position propagation. Thus, call
- ! force one more time to update ener%pot%tot to reflect the current
- ! coordinates.
- call force(xx,ix,ih,ipairs,x,f,ener,ener%vir, &
- xx(l96),xx(l97),xx(l98),xx(l99), qsetup, &
- do_list_update,nstep)
- endif ! numwatkeep>=0
-
- ! Set myeptot, mytemp, and mytargettemp
-! if (mdloop>0) mytemp = ener%kin%tot * onefac(1)
- my_remd_data%mytemp = ener%kin%tot * onefac(1)
- my_remd_data%myeptot = ener%pot%tot
-
-
- my_remd_data%mytargettemp = temp0
-# ifdef VERBOSE_REMD
- if (master) write(6,'(a,f15.4,2(a,f6.2))') &
- "REMD: myEptot= ",my_remd_data%myeptot," myTargetTemp= ", &
- my_remd_data%mytargettemp," mytemp= ",my_remd_data%mytemp
-# endif
-# ifdef LES
- else if(next_rem_method == 2 ) then
- my_remd_data%mytemp = ener%kin%solv * onefac(3)
- my_remd_data%myeptot = ener%eptot
- my_remd_data%mytargettemp = temp0les
-# endif
- else if (next_rem_method == 3) then
- remd_ekmh = ekmh
- if (mdloop > 0) my_remd_data%mytemp = ener%kin%tot * onefac(1)
- my_remd_data%mytargettemp = temp0
-! Call force here to bring all energies up-to-date
- call force(xx,ix,ih,ipairs,x,f,ener,ener%vir,xx(l96),xx(l97),xx(l98), &
- xx(l99),qsetup,do_list_update)
-
- my_remd_data%myeptot = ener%pot%tot
-
-! Call nmrdcp to decrement the NMR counter, since this should not count as
-! a real step (JMS 2/12). This is OK, since the counter got incremented at
-! the _very_ end of nmrcal, so we haven't already printed an unwanted value
- if (nmropt /= 0) call nmrdcp
-! Call xdist such that master has all the velocities(DSD 09/12)
- call xdist(v, xx(lfrctmp), natom)
-
- else if (next_rem_method == 4) then
- remd_ekmh = ekmh
-
- endif ! rem == 1
-! ------====== END REMD Post-Dynamics ======------
-#endif /* MPI */
-
- !=======================================================================
- ! ----- PRINT AVERAGES -----
- !=======================================================================
-
-# ifdef MPI
- ! -- ti decomp
- if (icfe /= 0 .and. idecomp /= 0) then
- if( idecomp == 1 .or. idecomp == 2 ) then
- call collect_dec(nrs)
- !else if( idecomp == 3 .or. idecomp == 4 ) then
- ! call collect_dec(npdec*npdec)
- end if
- end if
-
- ! Turn off avg. for REMD. and explicit solvent CpHMD, since it's not
- ! accumulated correctly in that case for each compiler
- if (master.and.rem == 0) then
-# else
- if (master) then
-# endif /*MPI*/
- tspan = nvalid
- if (nvalid > 0) then
-
- ! Update all elements of these sequence types
- enert = enert/tspan
- enert2 = enert2/tspan - enert*enert
- call zero_neg_values_state(enert2)
- enert2 = sqrt(enert2)
- edvdl = edvdl/tspan
-
- ! for PIMD/NMPIMD/CMD/RPMD averages
- if (ipimd>0) then
- totenert = totenert/tspan
- totenert2 = totenert2/tspan - (totenert*totenert)
- call zero_neg_values_state(totenert2)
- totenert2 = sqrt(totenert2)
- endif
-
-#ifdef MPI
- if( ievb /= 0 ) then
- evb_nrg_ave(:) = evb_nrg_ave(:) / tspan
- evb_nrg_rms(:) = evb_nrg_rms(:) / tspan - evb_nrg_ave(:)**2
- evb_nrg_rms(:) = max( evb_nrg_rms(:), 0.0d0 )
- evb_nrg_rms(:) = sqrt( evb_nrg_rms(:) )
- endif
- if ( ifsc /= 0 ) then
- do m = 1,ti_ene_cnt
- sc_ener_ave(m) = sc_ener_ave(m)/tspan
- sc_ener_rms(m) = sc_ener_rms(m)/tspan - sc_ener_ave(m)**2
- if(sc_ener_rms(m) < 0.0d0) sc_ener_rms(m) = 0.0d0
- sc_ener_rms(m) = sqrt(sc_ener_rms(m))
- end do
- end if
- if( ievb /= 0 ) evb_frc%evb_ave = .true.
-#endif
- write(6,540) nvalid
- call prntmd(total_nstep,izero,izero,t,enert,onefac,0,.false.)
-#ifdef MPI /* SOFT CORE */
- if (ifsc /= 0) call sc_print_energies(6, sc_ener_ave)
- if( ievb /= 0 ) evb_frc%evb_rms = .true.
- if ( ipimd > 0 .and. worldrank==0 ) then
- write(pimd_unit,540) nvalid
- call pimd_report(nstep,t,pimd_unit,totenert,onefac)
- write(pimd_unit,550)
- call pimd_report(nstep,t,pimd_unit,totenert2,onefac)
- endif
-#endif
- if (nmropt > 0) call nmrptx(6)
- write(6,550)
- call prntmd(total_nstep,izero,izero,t,enert2,onefac,0,.true.)
-
-#ifdef MPI
- if (ifsc /= 0) call sc_print_energies(6, sc_ener_rms)
- if (ifsc /= 0) call sc_print_dvdl_values()
-
- if( icfe > 0 ) then
- write(6,541) nvalid
- edvdl%pot%dvdl = enert%pot%dvdl ! fix for DV/DL output
- edvdl%virvsene = 0.d0 ! virvsene should not but included here
- call prntmd(total_nstep,izero,izero,t,edvdl,onefac,0,.false.)
- ! -- ti decomp
- if(worldrank == 0 .and. idecomp /= 0) then
- call checkdec(idecomp)
- if(idecomp == 1 .or. idecomp == 2) call printdec(ix)
- end if
- end if
-#endif
-
- if (nmropt >= 1) then
- write(6,500)
- if (iredir(7) /= 0) call pcshift(-1,x,f)
- call ndvptx(x,f,ih(m04),ih(m02),ix(i02),nres,xx(l95), &
- natom, xx(lwinv),ntb,xx(lnmr01),ix(inmr02),6)
- end if
-
- ! Print Born radii statistics
-
- if ((rbornstat == 1).and.(igb /= 0 .or. ipb /= 0)) then
-
- ! Born radii stats collected every nrespai step not nrespa step
- tspan = nvalidi
-
- write(6,580) nstep
- write(6,590)
- do m = 1,natom
- xx(l188-1+m) = xx(l188-1+m)/tspan
- xx(l189-1+m) = xx(l189-1+m)/tspan - &
- xx(l188-1+m)*xx(l188-1+m)
- xx(l189-1+m) = sqrt(xx(l189-1+m))
- write(6,600) m, xx(l186-1+m), xx(l187-1+m), &
- xx(l188-1+m), xx(l189-1+m)
- end do
- end if
-
- enert%kin%tot = enert%kin%tot*onefac(1)
- enert2%kin%tot = enert2%kin%tot*onefac(1)
- enert%kin%solt = enert%kin%solt*onefac(2)
- enert2%kin%solt = enert2%kin%solt*onefac(2)
- enert%kin%solv = enert%kin%solv*onefac(3)
- enert2%kin%solv = enert2%kin%solv*onefac(3)
-
- temp = enert%kin%tot
- end if ! (nvalid > 0)
-
- if (ntp > 0 .and. barostat == 2) call mcbar_summary
-
- end if ! (master)
-
-#ifdef MPI
- if( ievb /= 0 ) then
- call evb_dealloc
-#if defined(LES)
- if( master ) call evb_pimd_dealloc
-#endif
- endif
-#endif
-
- if( icfe /= 0 ) then
- deallocate( frcti, stat = ier )
- REQUIRE( ier == 0 )
- end if
-
- if (plumed.eq.1) then
- call plumed_f_gfinalize()
- end if
-
- 500 format(/,' NMR restraints on final step:'/)
- 540 format(/5x,' A V E R A G E S O V E R ',i7,' S T E P S',/)
- 541 format(/5x,' DV/DL, AVERAGES OVER ',i7,' STEPS',/)
- 542 format('|',79('='))
- 550 format(/5x,' R M S F L U C T U A T I O N S',/)
- 580 format('STATISTICS OF EFFECTIVE BORN RADII OVER ',i7,' STEPS')
- 590 format('ATOMNUM MAX RAD MIN RAD AVE RAD FLUCT')
- 600 format(i4,2x,4f12.4)
- call trace_exit( 'runmd' )
- return
-end subroutine runmd
-
-!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-!+ Stripped-down runmd routine for running relaxation dynamics on a given mask
-subroutine relaxmd(xx,ix,ih,ipairs,x,winv,amass,f, &
- v,vold,xr,xc,conp,skip,nsp,tma,erstop, qsetup, &
- relax_nstlim, mobile_atoms, increment_nmropt)
-
- ! Runmd operates in kcal/mol units for energy, amu for masses,
- ! and angstroms for distances. To convert the input time parameters
- ! from picoseconds to internal units, multiply by 20.455
- ! (which is 10.0*sqrt(4.184)).
-
- use bintraj, only: end_binary_frame
- use barostats, only : mcbar_trial
- use constants, only : third, ten_to_minus3
- use crg_reloc, only: ifcr, crprintcharges, cr_print_charge
- use fastwt
- use file_io_dat
- use molecule, only: n_iwrap_mask_atoms, iwrap_mask_atoms
- use nblist,only: fill_tranvec,volume,oldrecip,ucell
- use qmmm_module, only : qmmm_nml,qmmm_struct, qmmm_mpi, qm2_struct, &
- qmmm_vsolv
- use stack
- use state
- use trace
-
-! Variable Descriptions
-!
-! Passed variables
-! xx : global real array. See locmem.f for structure/pointers
-! ix : global integer array. See locmem.f for structure/pointers
-! ih : global hollerith array. See locmem.f for structure/pointers
-! ipairs : ?? Global pairlist ?? --add description (JMS 11/2010)
-! x : global position array *
-! winv : array with inverse masses *
-! amass : mass array *
-! f : force array, used to hold old coordinates temporarily, too
-! v : velocity array
-! vold : old velocity array, from the previous step
-! xr : coordinates with respect to COM of molecule
-! conp : bond parameters for SHAKE
-! skip : logical skip array for SHAKE (and QM/MM too, I think)
-! nsp : submolecule index array (?)
-! tma : submolecular weight array (?)
-! erstop : should we stop in error (?)
-! qsetup : Not quite sure what this does, if anything anymore.
-! mobile_atoms: bellymask-style array with 1s for moving atoms and 0s for
-! frozen atoms
-! relax_nstlim: Number of relaxation dynamics steps to run
-! increment_nmropt: Do we allow the nmropt counter to increment?
-!
-! Local variables
-! factt : degree-of-freedom correction factor for temperature scaling
-! nr : local copy of nrp, number of atoms
-! nr3 : 3 * nr, used for runtime efficiency
-!
-! Common memory variables
-! nrp : number of atoms, adjusted for LES copies
-
- implicit none
- character(kind=1,len=7) :: routine="relaxmd"
- integer ipairs(*), ix(*), relax_nstlim
- integer, intent(in) :: mobile_atoms(*)
- logical, intent(in) :: increment_nmropt
- _REAL_ xx(*)
- character(len=4) ih(*)
- _REAL_ combination
-
-#ifdef MPI
-# include "parallel.h"
- include 'mpif.h'
- _REAL_ mpitmp(8) !Use for temporary packing of mpi messages.
- integer ist(MPI_STATUS_SIZE), partner, ierr
-#else
- ! mdloop and REM is always 0 in serial
- integer, parameter :: mdloop = 0, rem = 0
-#endif
-
-#include "../include/md.h"
-#include "box.h"
-#include "nmr.h"
-#include "../include/memory.h"
-#include "extra.h"
-#include "ew_frc.h"
-#include "ew_cntrl.h"
-#include "ew_mpole.h"
-#include "def_time.h"
-#include "extra_pts.h"
-#include "../lib/random.h"
-
- _REAL_ sysx,sysy,sysz,sysrange(3,2)
- logical mv_flag
-
- _REAL_ , dimension(1) :: shkh
- integer, dimension(1) :: ifstwr2
- integer :: nshkh
-
- integer idx, iatom, iatomCL,m
- _REAL_ Ekin2_tot,tmp,f_lnv
- integer :: idim, ithermo
- _REAL_ :: E_nhc, exp1, exp2, v_sum
-
- logical ivscm
- logical qspatial
- character(len=6)fnam
-
- logical resetvelo
- integer nshak
- _REAL_ ekgs,eold3,eold4,etot_save,ekpbs
-
- logical do_list_update
- logical skip(*),lout,loutfm,erstop,vlim,onstep
- _REAL_ x(*),winv(*),amass(*),f(*),v(*),vold(*), &
- xr(*),xc(*),conp(*)
- type(state_rec) :: ener
- type(state_rec) :: ecopy, edvdl
- type(state_rec) :: edvdl_r
- _REAL_ rmu(3),fac(3),onefac(3),clfac, etot_start
- _REAL_ tma(*)
-
- _REAL_ tspan,atempdrop,fln,scaltp,scaltpo
- _REAL_ vel,vel2,vcmx,vcmy,vcmz,vmax,vx,vy,vz
- _REAL_ winf,aamass,rterm,ekmh,ekph,ekpht,wfac,rsd,ekav
- _REAL_ fit,fiti,fit2,vscalt
- logical is_langevin ! Is this a Langevin dynamics simulation
- _REAL_ gammai,c_implic,c_explic,c_ave,sdfac,ekins0
- _REAL_ dtx,dtxinv,dt5,factt,ekin0,ekinp0,dtcp,dttp
- _REAL_ rndf,rndfs,rndfp,boltz2,pconv,tempsu
- _REAL_ xcm(3),acm(3),ocm(3),vcm(3),ekcm,ekrot
- _REAL_ emtmd
-
-! Variables and parameters for constant surface tension:
- _REAL_, parameter :: ten_conv = 100.0d0 !ten_conv - converts
- !dyne/cm to bar angstroms
- _REAL_ :: pres0x
- _REAL_ :: pres0y
- _REAL_ :: pres0z
- _REAL_ :: gamma_ten_int
- _REAL_ :: press_tan_ave
-
- integer nsp(*)
- integer idumar(4)
- integer l_temp
- integer i,j,im,i3,nitp,nits
- integer nstep,nrep,nrek,nren,iend,istart3,iend3
- integer nrx,nr,nr3,ntcmt,izero,istart
- logical qsetup
-
- integer nvalid, nvalidi
- _REAL_ eke,eket
- _REAL_ extent
-
- _REAL_ xcen,ycen,zcen,extents(3,2)
- _REAL_, allocatable, dimension(:) :: frcti
- integer ier
-
- _REAL_ small
- data small/1.0d-7/
- data nren/51/
-
- !--- VARIABLES FOR DIPOLE PRINTING ---
- integer prndipngrp
- integer prndipfind
- character(len=4) prndiptest
-
- _REAL_,parameter :: pressure_constant = 6.85695d+4
- ! variables used in constant pressure PIMD
- _REAL_ :: Nkt,centvir,pressure, aa, arg2, poly, e2, e4, e6, e8
- ! variable used in CMD
- real(8) :: tmp_eke_cmd !Use for temporary packing of mpi messages.
-
- _REAL_ :: box_center(3)
-
- !==========================================================================
-
- call trace_enter( 'relaxmd' )
-
- ! ----- INITIALIZE SOME VARIABLES -----
-
- vlim = vlimit > small
- ntcmt = 0
- izero = 0
- lout = .true.
- loutfm = ioutfm <= 0
- nr = natom
- nr3 = 3*nr
- ekmh = 0.d0
- onstep = .true.
-
- do_list_update=.false.
-#ifdef MPI
- istart = iparpt(mytaskid) + 1
- iend = iparpt(mytaskid+1)
-#else
- istart = 1
- iend = nr
-#endif
- istart3 = 3*istart -2
- iend3 = 3*iend
-
- ! If NTWPRT.NE.0, only print the atoms up to this value
- nrx = nr3
- if (ntwprt > 0) nrx = ntwprt*3
-
- !=======================================================================
- ! Determine system degrees of freedom (for T scaling, reporting)
-
- ! Call DEGCNT to get the actual number of degrees of freedom for the
- ! solute and solvent. The 'belly' atoms are just the mobile ones
-
- call degcnt(1,nr,mobile_atoms,nsolut,nbonh,nbona,0, &
- ix(iibh),ix(ijbh),ix(iiba),ix(ijba),idumar, &
- idumar,ntc,idumar,0,0,0, &
- idumar,rndfp,rndfs)
-
- ! RNDFP = # degrees of freedom for solute
- ! RNDFS = # degrees of freedom for solvent
- ! RNDF = total number of degrees of freedom.
-
- ! qtw - substract the number of overlapping noshake QM atoms in noshakemask
- rndfp = rndfp - qmmm_struct%noshake_overlap
- ! modify RNDFP to reflect NDFMIN (set in mdread) and num_noshake
- rndfp = rndfp - ndfmin + num_noshake
- rndf = rndfp+rndfs
-
- call fix_degree_count(rndf) ! correct for extra points
-
- ! End of degrees of freedom stuff
- !=======================================================================
-
- boltz2 = 8.31441d-3 * 0.5d0
- pconv = 1.6604345d+04 ! factor to convert the pressure kcal/mole to bar
-
- ! ---convert to kcal/mol units
-
- boltz2 = boltz2/4.184d0 ! k-sub-B/2
- dtx = dt*20.455d+00
- dtxinv = 1.0d0 / dtx
- dt5 = dtx * 0.5d0
- pconv = pconv*4.184d0
-
- ! FAC() are #deg freedom * kboltz / 2
- ! multiply by T to get expected kinetic energy
- ! FAC(1) is for total system
-
- fac(1) = boltz2*rndf
- fac(2) = boltz2*rndfp
-
- if(rndfp < 0.1d0) fac(2) = 1.d-6
-
- fac(3) = boltz2*rndfs
- if(rndfs < 0.1d0) fac(3) = 1.d-6
- onefac(1) = 1.0d0/fac(1)
- onefac(2) = 1.0d0/fac(2)
- onefac(3) = 1.0d0/fac(3)
- factt = rndf/(rndf+ndfmin)
-
- ! these are "desired" kinetic energies based on
- ! # degrees freedom and target temperature
- ! they will be used for calculating the velocity scaling factor
-
- ekinp0 = fac(2)*temp0
- ekins0 = fac(3)*temp0
- ekin0 = fac(1)*temp0
-
- ! Langevin dynamics setup:
-
- is_langevin = gamma_ln > 0.0d0
- gammai = gamma_ln/20.455d0
- c_implic = 1.d0/(1.d0+gammai*dt5)
- c_explic = 1.d0 - gammai*dt5
- c_ave = 1.d0+gammai*dt5
- sdfac = sqrt( 4.d0*gammai*boltz2*temp0/dtx )
- if (is_langevin .and. ifbox==0) then
- call get_position(nr,x,sysx,sysy,sysz,sysrange,0)
- end if
- if (ntt == 1) dttp = dt/tautp
- if (ntp > 0) dtcp = comp * 1.0d-06 * dt / taup
-
- ! Constant surface tension setup:
-
- if (csurften > 0) then
-
- ! Set pres0 in direction of surface tension.
- ! The reference pressure is held constant in on direction dependent
- ! on what the surface tension direction is set to.
- if (csurften .eq. 1) then ! pres0 in the x direction
- pres0x = pres0
-
- else if (csurften .eq. 2) then ! pres0 in the y direction
- pres0y = pres0
-
- !else if (csurften .eq. 3) then ! pres0 in the z direction
- else
- pres0z = pres0
-
- end if
-
- ! Multiply surface tension by the number of interfaces
- gamma_ten_int = dble(ninterface) * gamma_ten
-
- end if
-
- nrek = 4
- nrep = 15
-
- nvalid = 0
- nvalidi = 0
- nstep = 0
- fit = 0.d0
- fiti = 0.d0
- fit2 = 0.d0
-
- ener = null_state_rec ! Zeros all elements
- ener%kin%pres_scale_solt = 1.d0
- ener%kin%pres_scale_solv = 1.d0
- ener%box(1:3) = box(1:3)
- ener%cmt(1:4) = 0.d0
- nitp = 0
- nits = 0
-
- ekmh = 0.0d0
-
- i3 = 0
- do j = 1,nrp
- aamass = amass(j)
- do m = 1,3
- i3 = i3+1
- rterm = v(i3)*v(i3) * aamass
- ekmh = ekmh + rterm
- end do
- end do
-
- do im=1,iscale
- ekmh = ekmh + scalm*v(nr3+im)*v(nr3+im)
- end do
- ekmh = ekmh * 0.5d0
- do i=1,nr3+iscale
- vold(i) = v(i)
- end do
-
- !=======================================================================
- ! ----- MAIN LOOP FOR PERFORMING THE DYNAMICS STEP -----
- ! (at this point, the coordinates are a half-step "ahead"
- ! of the velocities; the variable EKMH holds the kinetic
- ! energy at these "-1/2" velocities, which are stored in
- ! the array VOLD.)
- !=======================================================================
-
- 260 continue
-
- !---------------------------------------------------------------
- ! ---Step 1a: do some setup for pressure calculations:
- !---------------------------------------------------------------
-
- if (ntp > 0) then
- ener%cmt(1:3) = 0.d0
- xr(1:nr3) = x(1:nr3)
-
- ! ----- CALCULATE THE CENTER OF MASS ENERGY AND THE COORDINATES
- ! OF THE SUB-MOLECULES WITH RESPECT TO ITS OWN CENTER OF
- ! MASS -----
-
- call timer_start(TIME_EKCMR)
- call ekcmr(nspm,nsp,tma,ener%cmt,xr,v,amass,istart,iend)
-#ifdef MPI
- call trace_mpi('mpi_allreduce', &
- 3,'MPI_DOUBLE_PRECISION',mpi_sum)
-# ifdef USE_MPI_IN_PLACE
- call mpi_allreduce(MPI_IN_PLACE,ener%cmt,3, &
- MPI_DOUBLE_PRECISION,mpi_sum,commsander,ierr)
-# else
- call mpi_allreduce(ener%cmt,mpitmp,3, &
- MPI_DOUBLE_PRECISION,mpi_sum,commsander,ierr)
- ener%cmt(1:3) = mpitmp(1:3)
-# endif
-#endif
- call timer_stop(TIME_EKCMR)
- end if
-
- ! If we're using the MC barostat, go ahead and do the trial move now
- if (ntp > 0 .and. barostat == 2 .and. mod(nstep+1, mcbarint) == 0) &
- call mcbar_trial(xx, ix, ih, ipairs, x, xc, f, ener%vir, xx(l96), &
- xx(l97), xx(l98), xx(l99), qsetup, do_list_update, nstep, nsp, &
- amass)
-
- !--------------------------------------------------------------
- ! ---Step 1b: Get the forces for the current coordinates:
- !--------------------------------------------------------------
-
- iprint = 0
- if( nstep == 0 .or. nstep+1 == relax_nstlim ) iprint = 1
-
- call force(xx,ix,ih,ipairs,x,f,ener,ener%vir, &
- xx(l96),xx(l97),xx(l98),xx(l99), qsetup, &
- do_list_update,nstep)
-
- ! If we don't want to increment the NMROPT counter, decrement it here.
- if (.not. increment_nmropt) &
- call nmrdcp
-
- ! Reset quantities depending on TEMP0 and TAUTP (which may have been
- ! changed by MODWT during FORCE call).
- ekinp0 = fac(2)*temp0
- ekins0 = fac(3)*temp0
- ekin0 = fac(1)*temp0
-
- if (ntt == 1) dttp = dt/tautp
-
- if (ntp > 0) then
- ener%volume = volume
- ener%density = tmass / (0.602204d0*volume)
- ener%cmt(4) = 0.d0
- ener%vir(4) = 0.d0
- ener%pres(4) = 0.d0
- do m = 1,3
- ener%cmt(m) = ener%cmt(m)*0.5d0
- ener%cmt(4) = ener%cmt(4)+ener%cmt(m)
- ener%vir(4) = ener%vir(4)+ener%vir(m)
- ener%pres(m) = (pconv+pconv)*(ener%cmt(m)-ener%vir(m))/volume
- ener%pres(4) = ener%pres(4)+ener%pres(m)
- end do
- ener%pres(4) = ener%pres(4)/3.d0
-
- ! Constant surface tension output:
-
- if (csurften > 0) then
-
- if (csurften == 1) then ! Surface tension in the x direction
- ener%surface_ten = &
- box(1) * (ener%pres(1) - 0.5d0 * &
- (ener%pres(2) + ener%pres(3))) / (ninterface * ten_conv)
-
- else if (csurften .eq. 2) then ! Surface tension in the y direction
- ener%surface_ten = &
- box(2) * (ener%pres(2) - 0.5d0 * &
- (ener%pres(1) + ener%pres(3))) / (ninterface * ten_conv)
-
- else ! if (csurften .eq. 3) then ! Surface tension in the z direction
- ener%surface_ten = &
- box(3) * (ener%pres(3) - 0.5d0 * &
- (ener%pres(1) + ener%pres(2))) / (ninterface * ten_conv )
-
- end if
-
- end if
-
- end if
-
- !----------------------------------------------------------------
- ! ---Step 1c: do randomization of velocities, if needed:
- !----------------------------------------------------------------
- ! ---Assign new random velocities every Vrand steps, if ntt=2
-
- resetvelo=.false.
- if (vrand /= 0 .and. ntt == 2) then
- if (mod((nstep+1),vrand) == 0) resetvelo=.true.
- end if
-
- if (resetvelo) then
- ! DAN ROE: Why are only the masters doing this? Even if the velocities
- ! are broadcast to the child processes, the wont the different # of random
- ! calls put the randomg num generators out of sync, or do we not care?
-
- if (master) then
-! write (6,'(a,i8)') 'Setting new random velocities at step ', &
-! nstep + 1
- call setvel(nr,v,winv,temp0*factt,init,iscale,scalm)
- end if
-
-# ifdef MPI
- call trace_mpi('mpi_bcast',3*natom,'MPI_DOUBLE_PRECISION',0)
- call mpi_bcast(v, 3*natom, MPI_DOUBLE_PRECISION, 0, commsander, ierr)
-# endif
-
- ! At this point in the code, the velocities lag the positions
- ! by half a timestep. If we intend for the velocities to be drawn
- ! from a Maxwell distribution at the timepoint where the positions and
- ! velocities are synchronized, we have to correct these newly
- ! redrawn velocities by backing them up half a step using the
- ! current force.
- ! Note that this fix only works for Newtonian dynamics.
- if( gammai==0.d0 ) then
- i3 = 3*(istart-1)
- do j=istart,iend
- wfac = winv(j) * dt5
- v(i3+1) = v(i3+1) - f(i3+1)*wfac
- v(i3+2) = v(i3+2) - f(i3+2)*wfac
- v(i3+3) = v(i3+3) - f(i3+3)*wfac
- i3 = i3+3
- end do
- end if
-
- end if ! (resetvelo)
-
- call timer_start(TIME_VERLET)
-
- !-----------------------------------------------------
- ! ---Step 2: Do the velocity update:
- !-----------------------------------------------------
-
- !step 2a: apply quenched MD if needed. This is useful in NEB>0
- if (vv==1) call quench(f,v)
-
- if( gammai == 0.d0 ) then
-
- ! ---Newtonian dynamics:
-
- i3 = 3*(istart-1)
- do j=istart,iend
- wfac = winv(j) * dtx
- v(i3+1) = v(i3+1) + f(i3+1)*wfac
- v(i3+2) = v(i3+2) + f(i3+2)*wfac
- v(i3+3) = v(i3+3) + f(i3+3)*wfac
- i3 = i3+3
- end do
-
- else ! gamma_ln .ne. 0, which also implies ntt=3 (see mdread.f)
-
- ! ---simple model for Langevin dynamics, basically taken from
- ! Loncharich, Brooks and Pastor, Biopolymers 32:523-535 (1992),
- ! Eq. 11. (Note that the first term on the rhs of Eq. 11b
- ! should not be there.)
-
- ! Update Langevin parameters, since temp0 might have changed:
- sdfac = sqrt( 4.d0*gammai*boltz2*temp0/dtx )
-
- i3 = 3*(istart-1)
-
- if (no_ntt3_sync == 1) then
- !We don't worry about synchronizing the random number stream
- !across processors.
- do j=istart,iend
-
- wfac = winv(j) * dtx
- aamass = amass(j)
- rsd = sdfac*sqrt(aamass)
- call gauss( 0.d0, rsd, fln )
- v(i3+1) = (v(i3+1)*c_explic + (f(i3+1)+fln)*wfac) * c_implic
- call gauss( 0.d0, rsd, fln )
- v(i3+2) = (v(i3+2)*c_explic + (f(i3+2)+fln)*wfac) * c_implic
- call gauss( 0.d0, rsd, fln )
- v(i3+3) = (v(i3+3)*c_explic + (f(i3+3)+fln)*wfac) * c_implic
- i3 = i3+3
- end do
-
- else
-
- do j=1,nr
- if( j<istart .or. j>iend ) then
- ! In order to generate the same sequence of pseudorandom numbers that
- ! you would using a single processor you have to go through the atoms
- ! in order. The unused results are thrown away
- call gauss( 0.d0, 1.d0, fln )
- call gauss( 0.d0, 1.d0, fln )
- call gauss( 0.d0, 1.d0, fln )
- cycle
- end if
-
- wfac = winv(j) * dtx
- aamass = amass(j)
- rsd = sdfac*sqrt(aamass)
- call gauss( 0.d0, rsd, fln )
- v(i3+1) = (v(i3+1)*c_explic + (f(i3+1)+fln)*wfac) * c_implic
- call gauss( 0.d0, rsd, fln )
- v(i3+2) = (v(i3+2)*c_explic + (f(i3+2)+fln)*wfac) * c_implic
- call gauss( 0.d0, rsd, fln )
- v(i3+3) = (v(i3+3)*c_explic + (f(i3+3)+fln)*wfac) * c_implic
- i3 = i3+3
- end do
- end if ! no_ntt3_sync
-
- end if ! ( gammai == 0.d0 )
-
- if (vlim) then
- vmax = 0.0d0
- do i=istart3,iend3
- vmax = max(vmax,abs(v(i)))
- v(i) = sign(min(abs(v(i)),vlimit),v(i))
- end do
-
- ! Only violations on the master node are actually reported
- ! to avoid both MPI communication and non-master writes.
- if (vmax > vlimit) then
- if (master) then
- write(6,'(a,i6,a,f10.4)') 'vlimit exceeded for step ',nstep, &
- '; vmax = ',vmax
- end if
- end if
- end if
-
- do im=1,iscale
- v(nr3+im) = (v(nr3+im) + f(nr3+im)*dtx/scalm)
- end do
-
- !-------------------------------------------------------------------
- ! Step 3: update the positions, putting the "old" positions into F:
- !-------------------------------------------------------------------
-
- i = istart - 1
- do i3 = istart3, iend3, 3
- f(i3 ) = x(i3 )
- f(i3+1) = x(i3+1)
- f(i3+2) = x(i3+2)
- if (mobile_atoms(i) == 1) then
- x(i3 ) = x(i3 ) + v(i3 )*dtx
- x(i3+1) = x(i3+1) + v(i3+1)*dtx
- x(i3+2) = x(i3+2) + v(i3+2)*dtx
- end if
- i = i + 1
- end do
-
- do i = 1,iscale
- f(nr3+i) = x(nr3+i)
- x(nr3+i) = x(nr3+i)+v(nr3+i)*dtx
- end do
-
- call timer_stop(TIME_VERLET)
-
- if (ntc /= 1) then
-
- !-------------------------------------------------------------------
- ! Step 4a: if shake is being used, update the new positions to fix
- ! the bond lengths.
- !-------------------------------------------------------------------
-
- call timer_start(TIME_SHAKE)
- qspatial=.false.
- call shake(nrp,nbonh,nbona,0,ix(iibh),ix(ijbh),ix(ibellygp), &
- winv,conp,skip,f,x,nitp,.false.,ix(iifstwt),ix(noshake), &
- shkh,qspatial)
- call quick3(f,x,ix(iifstwr),natom,nres,ix(i02))
- if(nitp == 0) then
- erstop = .true.
- goto 480
- end if
-
- !-----------------------------------------------------------------
- ! Step 4b: Now fix the velocities and calculate KE
- !-----------------------------------------------------------------
-
- ! ---re-estimate the velocities from differences in positions:
-
- v(istart3:iend3) = (x(istart3:iend3)-f(istart3:iend3)) * dtxinv
-
- call timer_stop(TIME_SHAKE)
- end if
- call timer_start(TIME_VERLET)
-
- if( ntt == 1 .or. onstep ) then
-
- !-----------------------------------------------------------------
- ! Step 4c: get the KE, either for averaging or for Berendsen:
- !-----------------------------------------------------------------
-
- eke = 0.d0
- ekph = 0.d0
- ekpbs = 0.d0
-
- if (gammai == 0.0d0) then
- i3 = 3*(istart-1)
- do j=istart,iend
- aamass = amass(j)
- do m = 1,3
- i3 = i3+1
- eke = eke + aamass*0.25d0*(v(i3)+vold(i3))**2
-
- ! try pseudo KE from Eq. 4.7b of Pastor, Brooks & Szabo,
- ! Mol. Phys. 65, 1409-1419 (1988):
-
- ekpbs = ekpbs + aamass*v(i3)*vold(i3)
- ekph = ekph + aamass*v(i3)**2
-
- end do
- end do
-
- else
-
- i3 = 3*(istart-1)
- do j=istart,iend
- aamass = amass(j)
- do m = 1,3
- i3 = i3+1
- eke = eke + aamass*0.25d0*c_ave*(v(i3)+vold(i3))**2
- end do
-
- end do
-
- end if ! (if gammai == 0.0d0)
-
-#ifdef MPI
- ! --- sum up the partial kinetic energies:
-
- if ( numtasks > 1 ) then
- call trace_mpi('mpi_allreduce', &
- 1,'MPI_DOUBLE_PRECISION',mpi_sum)
- mpitmp(1) = eke
- mpitmp(2) = ekph
- mpitmp(3) = ekpbs
-# ifdef USE_MPI_IN_PLACE
- call mpi_allreduce(MPI_IN_PLACE,mpitmp,3, &
- MPI_DOUBLE_PRECISION,mpi_sum,commsander,ierr)
- eke = mpitmp(1)
- ekph = mpitmp(2)
- ekpbs = mpitmp(3)
-
-# else /* USE_MPI_IN_PLACE */
-
- call mpi_allreduce(mpitmp,mpitmp(4),3, &
- MPI_DOUBLE_PRECISION,mpi_sum,commsander,ierr)
- eke = mpitmp(4)
- ekph = mpitmp(5)
- ekpbs = mpitmp(6)
-
-# endif /* USE_MPI_IN_PLACE */
- end if
-#endif /* MPI */
-
- ! --- all processors handle the "extra" variables:
-
- do im=1,iscale
- eke = eke + scalm*0.25d0*(v(nr3+im)+vold(nr3+im))**2
- ekpbs = ekpbs + scalm*v(nr3+im)*vold(nr3+im)
- ekph = ekph + scalm*v(nr3+im)**2
- end do
-
- eke = eke * 0.5d0
- ekph = ekph * 0.5d0
- ekpbs = ekpbs * 0.5d0
- if( ntt == 1 ) then
-
- ! --- following is from T.E. Cheatham, III and B.R. Brooks,
- ! Theor. Chem. Acc. 99:279, 1998.
-
- scaltp = sqrt(1.d0 + 2.d0*dttp*(ekin0-eke)/(ekmh+ekph))
-
- ! --- following is the "old" (amber7 and before) method:
-
- ! scaltpo = sqrt(1.d0 + dttp*(ekin0/ekph - 1.d0))
- ! write(6,*) 'scaltp: ',2.d0*dttp*(ekin0-eke)/(ekmh+ekph), &
- ! dttp*(ekin0/ekmh - 1.d0)
-
- ! following line reverts to the "old" behavior:
- ! scaltp = scaltpo
-
- do j = istart,iend
- i3=(j-1)*3+1
- v(i3 ) = v(i3 ) *scaltp
- v(i3+1) = v(i3+1) *scaltp
- v(i3+2) = v(i3+2) *scaltp
- end do
- do im=1,iscale
- v(nr3+im) = v(nr3+im)*scaltp
- end do
- end if ! (ntt == 1 )
-
- end if ! ( ntt == 1 .or. onstep; end of step 4c )
-
- !-----------------------------------------------------------------
- ! Step 5: several tasks related to dumping of trajectory information
- !-----------------------------------------------------------------
-
- ! --- Determine if trajectory, velocity, or restart
- ! writing is imminent, or if the center of mass
- ! motion will be removed.
- ! These require xdist of velocities or dipoles in parallel runs:
- !
- ! Modified so that when running REMD, writing can occur less often
- ! than exchanges (e.g. ntwx > nstlim)
- ! DAN ROE: Added two new variables, total_nstep and total_nstlim.
- ! For non-REMD runs, total_nstep=nstep+1 and total_nstlim=nstlim
- ! just like before.
- ! For REMD runs, total_nstep=(mdloop-1)*nstlim+nstep+1, where
- ! mdloop is the current exchange - this is the current
- ! replica exchange MD step. total_nstlim=numexchg*nstlim, which is
- ! the maximum number of REMD steps.
-
-#ifdef MPI
-
- !-----------------------------------------------------------------
- ! --- now distribute the coordinates, and if necessary, dipoles and vel:
- !-----------------------------------------------------------------
-
- call timer_barrier( commsander )
- call timer_stop_start(TIME_VERLET,TIME_DISTCRD)
- if ( numtasks > 1 ) then
- call xdist(x, xx(lfrctmp), natom)
- end if
- call timer_stop(TIME_DISTCRD)
-
-#endif /* MPI */
-
- ! ----fix lone pair positions:
- if( numextra > 0 )call local_to_global(x,xx,ix)
-
-#ifdef MPI
- call timer_start(TIME_VERLET)
- ! ========================= END AMBER/MPI =========================
-#endif /* MPI */
-
- !-------------------------------------------------------------------
- ! Step 6: zero COM velocity if requested; used for preventing
- ! ewald "block of ice flying thru space" phenomenon, or accumulation
- ! of rotational momentum in vacuum simulations
- !-------------------------------------------------------------------
-
- !-----------------------------------------------------------------
- ! --- put current velocities into VOLD
- !-----------------------------------------------------------------
-
- vold(istart3:iend3) = v(istart3:iend3)
- do im=1,iscale
- vold(nr3+im) = v(nr3+im)
- end do
-
- !-------------------------------------------------------------------
- ! Step 7: scale coordinates if constant pressure run:
- !-------------------------------------------------------------------
-
- ! ntp = 1, isotropic pressure coupling
-
- if (ntp == 1) then
- rmu(1) = (1.d0-dtcp*(pres0-ener%pres(4)))**third
- rmu(2) = rmu(1)
- rmu(3) = rmu(1)
-
-
- ! ntp = 2, anisotropic pressure scaling
-
- else if (ntp == 2) then
-
- if (csurften > 0) then
-
- ! Constant surface tension adjusts the tangential pressures
- ! See Zhang, Feller, Brooks, Pastor. J. Chem. Phys. 1995
-
- if (csurften == 1) then ! For surface tension in the x direction
- pres0y = pres0x - gamma_ten_int * ten_conv / box(1)
- pres0z = pres0y
-
- else if (csurften == 2) then ! For surface tension in the y direction
- pres0x = pres0y - gamma_ten_int * ten_conv / box(2)
- pres0z = pres0x
-
- !else if (csurften == 3) then ! For surface tension in the z !direction
- else
- pres0x = pres0z - gamma_ten_int * ten_conv / box(3)
- pres0y = pres0x
-
- end if
-
- rmu(1) = (1.d0 - dtcp * (pres0x - ener%pres(1)))**third
- rmu(2) = (1.d0 - dtcp * (pres0y - ener%pres(2)))**third
- rmu(3) = (1.d0 - dtcp * (pres0z - ener%pres(3)))**third
-
- else
-
- rmu(1) = (1.d0-dtcp*(pres0-ener%pres(1)))**third
- rmu(2) = (1.d0-dtcp*(pres0-ener%pres(2)))**third
- rmu(3) = (1.d0-dtcp*(pres0-ener%pres(3)))**third
-
- end if
-
- ! ntp = 3, semiisotropic pressure coupling
- ! (currently only for csurften>0, constant surface tension)
-
- !else if (ntp > 2) then
- else
-
- if (csurften > 0) then
-
- if (csurften == 1) then ! For surface tension in the x direction
- pres0y = pres0x - gamma_ten_int * ten_conv / box(1)
- pres0z = pres0y
- press_tan_ave = (ener%pres(2) + ener%pres(3))/2
- rmu(1) = (1.d0 - dtcp * (pres0x - ener%pres(1)))**third
- rmu(2) = (1.d0 - dtcp * (pres0y - press_tan_ave))**third
- rmu(3) = (1.d0 - dtcp * (pres0z - press_tan_ave))**third
-
- else if (csurften == 2) then ! For surface tension in the y direction
- pres0x = pres0y - gamma_ten_int * ten_conv / box(2)
- pres0z = pres0x
- press_tan_ave = (ener%pres(1) + ener%pres(3))/2
- rmu(1) = (1.d0 - dtcp * (pres0x - press_tan_ave))**third
- rmu(2) = (1.d0 - dtcp * (pres0y - ener%pres(2)))**third
- rmu(3) = (1.d0 - dtcp * (pres0z - press_tan_ave))**third
-
- !else if (csurften == 3) then ! For surface tension in the z !direction
- else
- pres0x = pres0z - gamma_ten_int * ten_conv / box(3)
- pres0y = pres0x
- press_tan_ave = (ener%pres(1) + ener%pres(2))/2
- rmu(1) = (1.d0 - dtcp * (pres0x - press_tan_ave))**third
- rmu(2) = (1.d0 - dtcp * (pres0y - press_tan_ave))**third
- rmu(3) = (1.d0 - dtcp * (pres0z - ener%pres(3)))**third
-
- end if ! csurften == 1
- end if ! csurften > 0
- ! Add semiisotropic pressure scaling in any direction with no constant
- ! surface tension here
- end if
-
- if (ntp > 0) then
- box(1:3) = box(1:3)*rmu(1:3)
- ener%box(1:3) = box(1:3)
-
- ! WARNING!! This is not correct for non-orthogonal boxes if
- ! NTP > 1 (i.e. non-isotropic scaling). Currently general cell
- ! updates which allow cell angles to change are not implemented.
- ! The viral tensor computed for ewald is the general Nose Klein,
- ! however the cell response needs a more general treatment.
-
- call redo_ucell(rmu)
- ! keep tranvec up to date, rather than recomputing each MD step.
- call fill_tranvec() ! tranvec is dependent on only ucell
-
- call ew_pscale(natom,x,amass,nspm,nsp,npscal)
- if (ntr > 0 .and. nrc > 0) &
- call ew_pscale(natom,xc,amass,nspm,nsp,npscal)
- endif
-
- ener%kin%solv = ekpbs + ener%pot%tot
- ! Pastor, Brooks, Szabo conserved quantity
- ! for harmonic oscillator: Eq. 4.7b of Mol.
- ! Phys. 65:1409-1419, 1988
- ener%kin%solt = eke
- ener%kin%tot = ener%kin%solt
- if (ntt == 1 .and. onstep) then
- ekmh = max(ekph,fac(1)*10.d0)
- end if
-
- ! ---if velocities were reset, the KE is not accurate; fudge it
- ! here to keep the same total energy as on the previous step.
- ! Note that this only affects printout and averages for Etot
- ! and KE -- it has no effect on the trajectory, or on any averages
- ! of potential energy terms.
-
- if( resetvelo ) ener%kin%tot = etot_save - ener%pot%tot
-
- ! --- total energy is sum of KE + PE:
-
- ener%tot = ener%kin%tot + ener%pot%tot
- etot_save = ener%tot
-
- !-------------------------------------------------------------------
- ! Step 8: update the step counter and the integration time:
- !-------------------------------------------------------------------
-
- nstep = nstep+1
-
- ! ---full energies are only calculated every nrespa steps
- ! nvalid is the number of steps where all energies are calculated
-
- ntnb = 0
- if (mod(nstep,nsnb) == 0) ntnb = 1
-
-#if 0
-! DEBUG code -- this will print out every frame of the relaxation dynamics to
-! the trajectory if uncommented
-
- if (master) then
-
- ! -- Coordinate archive:
- if (.true.) then
- if( iwrap == 0 ) then
- call corpac(x,1,nrx,MDCRD_UNIT,loutfm)
- if(ntb > 0) call corpac(box,1,3,MDCRD_UNIT,loutfm)
- else if (iwrap == 1) then
- call get_stack(l_temp,nr3,routine)
- if(.not. rstack_ok)then
- deallocate(r_stack)
- allocate(r_stack(1:lastrst),stat=alloc_ier)
- call reassign_rstack(routine)
- endif
- REQUIRE(rstack_ok)
- do m=1,nr3
- r_stack(l_temp+m-1) = x(m)
- end do
-
- call wrap_molecules(nspm,nsp,r_stack(l_temp))
- if (ifbox == 2) call wrap_to(nspm,nsp,r_stack(l_temp),box)
-
- call corpac(r_stack(l_temp),1,nrx,MDCRD_UNIT,loutfm)
- call corpac(box,1,3,MDCRD_UNIT,loutfm)
- call free_stack(l_temp,routine)
- end if ! if (iwrap == 0) ...
-
-
- !GMS: If using variable QM solvent, try to write a new pdb file
- ! with the QM coordinates for this step. This is done here
- ! to keep the PDB file in sync with the mdcrd file, which
- ! makes it easier to check later.
- if (qmmm_nml%vsolv > 0 .and. qmmm_nml%verbosity == 0) &
- call qm_print_coords(nstep,.false.)
- end if ! (itdump)
-
- if (ioutfm > 0) then
- if (.true.) call end_binary_frame(MDCRD_UNIT)
- end if
-
- end if ! (master)
-#endif /* 0 */
-
- !=======================================================================
-
- ! ---major cycle back to new step unless we have reached our limit:
-
- call trace_integer( 'end of step', nstep )
- call trace_output_mpi_tally( )
- call timer_stop(TIME_VERLET)
-
- if (nstep < relax_nstlim) goto 260
- 480 continue
-
-end subroutine relaxmd
-
-!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-!+ Enter description for quench here.
-subroutine quench(f,v)
- implicit none
-
-#include "../include/md.h"
-!need access to vv - temp verlet scaling
-#include "../include/memory.h"
-!need access to natom
-
- _REAL_ f(*),v(*),dotproduct,force
- !f is the forces and v is the velocity
-
- integer index
- dotproduct = 0.d0
- force = 0.d0
-
- do index=1,3*natom
- force = force + f(index)**2
- dotproduct = dotproduct + v(index)*f(index)
- enddo
-
- if (force/=0.0d0) then
- force = 1.0d0/sqrt(force)
- dotproduct = dotproduct*force
- end if
-
- if (dotproduct>0.0d0) then
- v(1:3*natom) = dotproduct*f(1:3*natom)*force
- else
- !v(1:3*natom) = 0.0d0
- v(1:3*natom) = vfac*dotproduct*f(1:3*natom)*force
- end if
-
-end subroutine quench
diff --git a/patches/amber14.diff/AmberTools/src/sander/runmd.F90.preplumed b/patches/amber14.diff/AmberTools/src/sander/runmd.F90.preplumed
deleted file mode 100644
index 476dd425da998baf64b080141bef04e76821f585..0000000000000000000000000000000000000000
--- a/patches/amber14.diff/AmberTools/src/sander/runmd.F90.preplumed
+++ /dev/null
@@ -1,5268 +0,0 @@
-! <compile=optimized>
-#include "copyright.h"
-#include "../include/dprec.fh"
-#include "../include/assert.fh"
-#include "ncsu-config.h"
-
-!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-!+ driver routine for molecular dynamics
-subroutine runmd(xx,ix,ih,ipairs,x,winv,amass,f, &
- v,vold,xr,xc,conp,skip,nsp,tma,erstop, qsetup)
-
- ! Runmd operates in kcal/mol units for energy, amu for masses,
- ! and angstroms for distances. To convert the input time parameters
- ! from picoseconds to internal units, multiply by 20.455
- ! (which is 10.0*sqrt(4.184)).
-
- use state
-
-#if !defined(DISABLE_NCSU) && defined(NCSU_ENABLE_BBMD)
- use ncsu_sander_hooks, only : ncsu_on_mdstep => on_mdstep
-#endif
-
- use molecule, only: n_iwrap_mask_atoms, iwrap_mask_atoms
- use cmd_vars, only: activate, file_pos_cmd, file_vel_cmd, file_nrg_cmd, &
- nstep_cmd, t_cmd, eq_cmd, restart_cmd, &
- etot_cmd, eke_cmd, temp_cmd
-
- use pimd_vars, only: ipimd, nbead, natomCL, &
- bnd_vir, Eimp_virial, equal_part, Epot_deriv, &
- tau_vol, Epot_spring, NMPIMD, CMD, cartpos, cartvel, &
- itimass, real_mass
-
- use neb_vars, only: ineb, neb_nbead
-
- use lscivr_vars, only: ilscivr, ndof_lsc, natom_lsc, mass_lsc, v2_lsc, &
- ilsc, x_lsc, f_lsc, dx_lsc
-
- use nose_hoover_module, only : thermo_lnv, x_lnv, x_lnv_old, v_lnv, &
- f_lnv_p, f_lnv_v, c2_lnv, mass_lnv, &
- Thermostat_init
-
-#ifdef RISMSANDER
- use sander_rism_interface, only: rismprm,rism_3d, RISM_NONE, RISM_FULL, RISM_INTERP, &
- rism_calc_type, rism_solvdist_thermo_calc, mylcm
-#endif
-
- use full_pimd_vars, only: totener,totenert,totenert2,mybeadid
-
- use qmmm_module, only : qmmm_nml,qmmm_struct, qmmm_mpi, qm2_struct, &
- qmmm_vsolv
- use file_io_dat
- use constants, only : third, ten_to_minus3
- use trace
- use stack
- use decomp, only : nat, nrs, decpr, jgroup, indx, irespw, &
-#ifdef MPI
- ! -- ti decomp
- collect_dec, &
-#endif
- checkdec, printdec
- use fastwt
- use bintraj, only: end_binary_frame
- use nblist,only: fill_tranvec,volume,oldrecip,ucell
-
- use nose_hoover_module, only: Thermostat_switch, &
- Thermostat_integrate_1, Thermostat_integrate_2, & ! APJ
- Thermostat_hamiltonian, & ! APJ
- Adaptive_Thermostat_integrate, & ! APJ
- Adaptive_Thermostat_hamiltonian, & ! APJ
- file_nhc, nchain, thermo, nthermo, Econserved ! APJ
-
-#ifdef MPI
- use evb_parm, only: evb_dyn, nbias
- use evb_data, only: evb_frc, evb_vel0, evb_bias, evb_nrg, evb_nrg_ave &
- , evb_nrg_rms, evb_nrg_tmp, evb_nrg_old, evb_nrg_tmp2 &
- , evb_nrg_old2
- use wigner, only: rflux
- use remd, only : rem, mdloop, remd_ekmh, repnum, stagid, my_remd_data, &
- hybrid_remd_ene, next_rem_method
-# ifdef LES
- use evb_pimd, only: evb_pimd_dealloc
- use miller, only: i_qi
-# endif
- use softcore, only: ifsc, sc_dvdl, sc_tot_dvdl, sc_tot_dvdl_partner, &
- sc_dvdl_ee, sc_tot_dvdl_ee, sc_tot_dvdl_partner_ee, &
- extra_atoms, mix_temp_scaling, sc_pscale, &
- adj_dvdl_stat, sc_mix_velocities, &
- sc_nomix_frc, sc_sync_x, sc_print_energies, &
- calc_softcore_ekin, &
- sc_ener, sc_ener_ave, sc_ener_rms, sc_lngdyn, &
- sc_ener_tmp, sc_ener_tmp2, sc_ener_old, sc_ener_old2, &
- sc_mix_position, sc_print_dvdl_values, &
- sc_degrees_o_freedom, dynlmb, sc_change_clambda, ti_ene_cnt, &
- sc_compare
- use mbar, only : ifmbar, bar_intervall, calc_mbar_energies, &
- bar_collect_cont, do_mbar
-#endif
-
- use amoeba_mdin, only: iamoeba
- use amoeba_runmd, only: AM_RUNMD_scale_cell
- use constantph, only: cnstphinit, cnstphwrite, cnstphupdatepairs, &
- cnstphbeginstep, cnstphendstep, chrgdat, &
- cnstph_explicitmd, cnstphwriterestart, cphfirst_sol
- use emap, only:temap,emap_move
- use barostats, only : mcbar_trial, mcbar_summary
-#ifdef EMIL
- use emil_mod, only : emil_do_calc, emil_calc_AMBER, &
- emil_save_pme, emil_save_gb, &
- emil_init, emil_step
-#endif
- use memory_module, only: coordinate, velocity, mass
-
-! Self-Guided molecular/Langevin Dynamics (SGLD)
- use sgld, only : isgld, isgsta,isgend,trxsgld, &
- sgenergy,sgldw,sgmdw,sgfshake, sg_fix_degree_count
-
- !AWG adaptive QM/MM
- use qmmm_adaptive_module, only: adaptive_qmmm
-
- use crg_reloc, only: ifcr, crprintcharges, cr_print_charge
-
- use abfqmmm_module, only: abfqmmm_param, abfqmmm_combine_forces ! lam81
-!AMD
- use amd_mod
-
-!scaledMD
- use scaledMD_mod
-
-!SEBOMD
- use sebomd_module, only : sebomd_obj, sebomd_gradient_write, sebomd_hessian_compute
-
-! Variable Descriptions
-!
-! Passed variables
-! xx : global real array. See locmem.f for structure/pointers
-! ix : global integer array. See locmem.f for structure/pointers
-! ih : global hollerith array. See locmem.f for structure/pointers
-! ipairs : ?? Global pairlist ?? --add description (JMS 11/2010)
-! x : global position array *
-! winv : array with inverse masses *
-! amass : mass array *
-! f : force array, used to hold old coordinates temporarily, too
-! v : velocity array
-! vold : old velocity array, from the previous step
-! xr : coordinates with respect to COM of molecule
-! conp : bond parameters for SHAKE
-! skip : logical skip array for SHAKE (and QM/MM too, I think)
-! nsp : submolecule index array (?)
-! tma : submolecular weight array (?)
-! erstop : should we stop in error (?)
-! qsetup : Not quite sure what this does, if anything anymore.
-!
-! Local variables
-! factt : degree-of-freedom correction factor for temperature scaling
-! nr : local copy of nrp, number of atoms
-! nr3 : 3 * nr, used for runtime efficiency
-!
-! Common memory variables
-! nrp : number of atoms, adjusted for LES copies
-
- implicit none
- character(kind=1,len=5) :: routine="runmd"
- integer ipairs(*), ix(*)
- _REAL_ xx(*)
- character(len=4) ih(*)
- _REAL_ combination, rem_val
-
-#ifdef MPI
-# include "parallel.h"
- include 'mpif.h'
-# ifdef LES
- _REAL_ :: fbead(3,natomCL), xbead(3,natomCL)
- integer :: mm, n
-# endif
- _REAL_ mpitmp(8) !Use for temporary packing of mpi messages.
- integer ist(MPI_STATUS_SIZE), partner, ierr
-#else
- ! mdloop and REM is always 0 in serial
- integer, parameter :: mdloop = 0, rem = 0
-#endif
-
-! The following variables are needed since nstep and nstlim
-! behave differently in a REMD run.
-! In certain places where output is required, total_nstep and total_nstlim
-! take the place of nstep and nstlim. This allows replica runs to output
-! less often than every exchange.
-! They are the absolute step # of the REMD or MD simulation.
- integer total_nstep, total_nstlim
-
-#include "../include/md.h"
-#include "box.h"
-#include "nmr.h"
-#include "tgtmd.h"
-#include "multitmd.h"
-#include "../include/memory.h"
-#include "extra.h"
-#include "ew_frc.h"
-#include "ew_cntrl.h"
-#include "ew_mpole.h"
-#include "def_time.h"
-#include "extra_pts.h"
-#if defined(LES)
-# include "les.h"
-#endif
-#include "../pbsa/pb_md.h"
-#include "../lib/random.h"
-
-! additional variables for PIMD output
- _REAL_ :: xcmd(3*natomCL),vcmd(3*natomCL)
- integer :: ncmd
- ! for const press PIMD
- _REAL_ tmpvir(3,3),atomvir
-
- _REAL_ sgsta_rndfp, sgend_rndfp, ignore_solvent
- _REAL_ sysx,sysy,sysz,sysrange(3,2)
- logical mv_flag
-
-#ifdef MMTSB
-# include "mmtsb.h"
- logical is_done_mmtsb ! MMTSB replica exchange calculation completed
- _REAL_ lambda_mmtsb ! MMTSB replica exchange new lambda
- _REAL_ pert_pe_mmtsb ! MMTSB lambda replica exchange perturbed PE
- _REAL_ temp_mmtsb ! MMTSB replica exchange new temperature
- _REAL_ unpert_pe_mmtsb ! MMTSB lambda replica exchange unperturbed PE
-#endif
-
- _REAL_ , dimension(1) :: shkh
- integer, dimension(1) :: ifstwr2
- integer :: nshkh
-
- integer idx, iatom, iatomCL,m
- _REAL_ Ekin2_tot,tmp ! APJ
- integer :: idim, ithermo
- _REAL_ :: E_nhc, exp1, exp2, v_sum
-
- logical ivscm
- logical qspatial
- character(len=6)fnam
-
- logical resetvelo
- integer nshak
- _REAL_ ekgs,eold3,eold4,etot_save,ekpbs
-
- logical do_list_update
- logical skip(*),belly,lout,loutfm,erstop,vlim,onstep
- _REAL_ x(*),winv(*),amass(*),f(*),v(*),vold(*), &
- xr(*),xc(*),conp(*)
- type(state_rec) :: ener ! energy values per time step
- type(state_rec) :: enert ! energy values tallied over the time steps
- type(state_rec) :: enert2 ! energy values squared tallied over the time steps
- type(state_rec) :: enert_old, enert2_old
- type(state_rec) :: enert_tmp, enert2_tmp
- type(state_rec) :: ecopy, edvdl
- type(state_rec) :: edvdl_r
- _REAL_ rmu(3),fac(3),onefac(3),clfac, etot_start
- _REAL_ tma(*)
-
- _REAL_ tspan,atempdrop,fln,scaltp,scaltpo
- _REAL_ vel,vel2,vcmx,vcmy,vcmz,vmax,vx,vy,vz
- _REAL_ winf,aamass,rterm,ekmh,ekph,ekpht,wfac,rsd,ekav
- _REAL_ fit,fiti,fit2,vscalt
- logical is_langevin ! Is this a Langevin dynamics simulation
- _REAL_ gammai,c_implic,c_explic,c_ave,sdfac,ekins0
- _REAL_ dtx,dtxinv,dt5,factt,ekin0,ekinp0,dtcp,dttp
- _REAL_ rndf,rndfs,rndfp,boltz2,pconv,tempsu
- _REAL_ xcm(3),acm(3),ocm(3),vcm(3),ekcm,ekrot
- _REAL_ emtmd
-
-! Variables and parameters for constant surface tension:
- _REAL_, parameter :: ten_conv = 100.0d0 !ten_conv - converts
- !dyne/cm to bar angstroms
- _REAL_ :: pres0x
- _REAL_ :: pres0y
- _REAL_ :: pres0z
- _REAL_ :: gamma_ten_int
- _REAL_ :: press_tan_ave
-
- integer nsp(*)
- integer idumar(4)
- integer l_temp
- integer i,j,im,i3,nitp,nits, iskip_start,iskip_end ! APJ
- integer nstep,nrep,nrek,nren,iend,istart3,iend3
- integer nrx,nr,nr3,ntcmt,izero,istart
- logical ixdump,ivdump,itdump,ifdump
- logical qsetup
- _REAL_, allocatable, dimension(:) :: for ! lam81
-#ifdef RISMSANDER
- logical irismdump
- _REAL_ cm(3),angvel(3),r(3),rxv(3),proj(3),moi,erot
-#endif
-
- integer nvalid, nvalidi
- _REAL_ eke,eket
- _REAL_ extent
-
- _REAL_ xcen,ycen,zcen,extents(3,2)
- _REAL_, allocatable, dimension(:) :: frcti
- integer ier
-
- _REAL_ small
- data small/1.0d-7/
- data nren/51/
-
- !--- VARIABLES FOR DIPOLE PRINTING ---
- integer prndipngrp
- integer prndipfind
- character(len=4) prndiptest
-
- _REAL_,parameter :: pressure_constant = 6.85695d+4
- ! variables used in constant pressure PIMD
- _REAL_ :: Nkt,centvir,pressure, aa, arg2, poly, e2, e4, e6, e8
- ! variable used in CMD
- real(8) :: tmp_eke_cmd !Use for temporary packing of mpi messages.
-
- _REAL_ :: box_center(3)
-
-! for adaptive qm/mm runs
-
- _REAL_ :: adqmmm_first_energy, etotcorr, tadc
- integer :: nstepadc
- logical :: flag_first_energy = .true.
-
- _REAL_ :: xold(3*natom)
- _REAL_ :: corrected_energy
- _REAL_ :: kinetic_E_save(2)
- integer :: aqmmm_flag
-
- !==========================================================================
-
- call trace_enter( 'runmd' )
-
- ! ----- INITIALIZE SOME VARIABLES -----
-
-#ifdef MPI
- if( master ) then
- ! If remd, runmd will be called many times, so we dont want to open every
- ! time. For normal md, mdloop will just be 0.
- if (mdloop.eq.0) call amopen(7,mdinfo,'U','F',facc)
- endif
-
- if (rem < 3) then
- rem_val = temp0
- else if (rem == 4) then
- rem_val = solvph
- else
- rem_val = 0.d0
- end if
-#else
- if( master ) call amopen(7,mdinfo,'U','F','W')
-#endif
- vlim = vlimit > small
- ntcmt = 0
- izero = 0
- belly = ibelly > 0
- lout = .true.
- loutfm = ioutfm <= 0
- nr = nrp
- nr3 = 3*nr
- ekmh = 0.d0
-
- aqmmm_flag = 0
-
-#ifdef LES
- ekmhles = 0.d0
-#endif
- do_list_update=.false.
-#ifdef MPI
- if ( mpi_orig ) then
- istart = 1
- iend = natom
- else
- istart = iparpt(mytaskid) + 1
- iend = iparpt(mytaskid+1)
- end if
-#else
- istart = 1
- iend = nr
-#endif
- istart3 = 3*istart -2
- iend3 = 3*iend
-
-#ifdef MPI
- if( icfe /= 0 ) then
- allocate( frcti( nr3+3*extra_atoms ), stat = ier )
- REQUIRE( ier == 0 )
- end if
-#endif
-
- ! If NTWPRT.NE.0, only print the atoms up to this value
- nrx = nr3
- if (ntwprt > 0) nrx = ntwprt*3
-
- if (.not. allocated(for)) allocate(for(nr3)) ! lam81
-
- if(abfqmmm_param%abfqmmm == 1) then ! lam81
-#ifdef MPI
- call xdist(v, xx(lfrctmp), natom) ! lam81
-#endif
- if(abfqmmm_param%system == 1) then ! lam81
- if(abfqmmm_param%qmstep == 1) abfqmmm_param%v(1:nr3+iscale) = v(1:nr3+iscale) ! lam81
- v(1:nr3+iscale) = 0.d0 ! lam81
- t = t+dt ! lam81
- if(abfqmmm_param%maxqmstep == 0) t = 0 ! lam81
- else ! lam81
- v(1:nr3+iscale) = abfqmmm_param%v(1:nr3+iscale) ! lam81
- endif ! lam81
- endif ! lam81
-
- ! Cleanup the velocity if belly run
- if(belly) call bellyf(nr,ix(ibellygp),v)
-
- !=======================================================================
- ! Determine system degrees of freedom (for T scaling, reporting)
-
- ! Call DEGCNT to get the actual number of degrees of freedom for the
- ! solute and solvent. This call returns the correct numbers for belly
- ! simulations and simulations with separate solute/solvent scaling -- dap
- ! "IDUMAR" is dummy array. Used since this routine was also used w/ GIBBS.
-
-#ifdef LES
- ! return LES and non-LES degrees,
- ! since separate solvent coupling no longer used
- ! large changes to degcnt were made
- ! cnum is now passed (LES copy number of each atom)
- call degcnt(ibelly,nr,ix(ibellygp),nsolut,nbonh,nbona,0, &
- ix(iibh),ix(ijbh),ix(iiba),ix(ijba),idumar, &
- idumar,ntc,idumar,0,0,0, &
- idumar,rndfp,rndfles,cnum,temp0les)
-
- ! RNDFP = # degrees of freedom for solute
- ! RNDFS = # degrees of freedom for solvent
- ! RNDF = total number of degrees of freedom.
- ! RNDFLES = # degrees of freedom for LES groups
-
- ! temp0les was init to negative number to signify not to use a LES bath
- ! just do standard code (meaning use solute/solvent baths)
- ! any positive (or zero) means to use LES bath with that target
-
- ! degcnt returns rndfs or rndfles in the rndfles variable
- ! depending on whether a LES bath was specified
- ! do this instead of duplicating call with rndfs or rndfles
-
- if (temp0les < 0.d0) then
- rndfs=rndfles
- rndfles=0.d0
- else
- rndfs=0.d0
- end if
-
- if (master) then
- write (6,'(a,f8.0)') &
- "# degrees of freedom in non-LES region: ",rndfp
- write (6,'(a,f8.0)') &
- "# degrees of freedom in LES region: ",rndfles
- end if
-
- ! modify RNDFP to reflect NDFMIN (set in mdread)
-
- rndfp = rndfp - ndfmin
-
- if (temp0les < 0.d0) then
- rndf = rndfp+rndfs
- else
- rndf = rndfp+rndfles
- end if
-
-#else
-
- call degcnt(ibelly,nr,ix(ibellygp),nsolut,nbonh,nbona,0, &
- ix(iibh),ix(ijbh),ix(iiba),ix(ijba),idumar, &
- idumar,ntc,idumar,0,0,0, &
- idumar,rndfp,rndfs)
-
- ! RNDFP = # degrees of freedom for solute
- ! RNDFS = # degrees of freedom for solvent
- ! RNDF = total number of degrees of freedom.
-
-#ifdef MPI
- if (mdloop .eq. 0 .and. master) then
-#else
- if (master) then
-#endif
- if (abfqmmm_param%abfqmmm /= 1 .or. (abfqmmm_param%qmstep == 1 .and. abfqmmm_param%system == 1)) then ! lam81
- write (6,'(a,f8.0)') &
- "| # of SOLUTE degrees of freedom (RNDFP): ",rndfp
- write (6,'(a,f8.0)') &
- "| # of SOLVENT degrees of freedom (RNDFS): ",rndfs
- end if ! lam81
- end if
- ! qtw - substract the number of overlapping noshake QM atoms in noshakemask
- rndfp = rndfp - qmmm_struct%noshake_overlap
- ! modify RNDFP to reflect NDFMIN (set in mdread) and num_noshake
- rndfp = rndfp - ndfmin + num_noshake
- rndf = rndfp + rndfs
-#ifdef MPI
- if (mdloop .eq. 0 .and. master) then
-#else
- if (master) then
-#endif
- if (abfqmmm_param%abfqmmm /= 1 .or. (abfqmmm_param%qmstep == 1 .and. abfqmmm_param%system == 1)) then ! lam81
- if (qmmm_nml%ifqnt) then
- write (6,'(a,i6)') &
- "| QMSHAKE_NOSHAKEMASK_OVERLAP = ", qmmm_struct%noshake_overlap
- endif
- write (6,'(a,f8.0,a,i6,a,f8.0)') &
- "| NDFMIN = ",rndfp, " NUM_NOSHAKE = ",num_noshake, " CORRECTED RNDFP = ", rndfp
- write (6,'(a,f8.0)') &
- "| TOTAL # of degrees of freedom (RNDF) = ", rndf
- end if ! lam81
- end if
-
-#endif
-
- call fix_degree_count(rndf) ! correct for extra points
-! Warning - NOTE that rndfp, rndfs are uncorrected in an extra points context!
-
-#ifndef LES
- if (isgld > 0) then
- ! number of degrees of freedom in the SGLD part
- if (isgsta == 1) then
- sgsta_rndfp = 0
- else
- call degcnt(ibelly,nr,ix(ibellygp),isgsta-1,nbonh,nbona,0, &
- ix(iibh),ix(ijbh),ix(iiba),ix(ijba),idumar, &
- idumar,ntc,idumar,0,0,0,idumar,sgsta_rndfp,ignore_solvent)
- end if
- if (isgend == nr) then
- sgend_rndfp = rndf
- else
- call degcnt(ibelly,nr,ix(ibellygp),isgend,nbonh,nbona,0, &
- ix(iibh),ix(ijbh),ix(iiba),ix(ijba),idumar, &
- idumar,ntc,idumar,0,0,0,idumar,sgend_rndfp,ignore_solvent)
- end if
-! Warning - NOTE that the solute ndf outputs above from degcnt are uncorrected
-! for qmmm_struct%noshake_overlap, num_noshake, and extra points;
-! also ndfmin is not always being handled.
- call sg_fix_degree_count(sgsta_rndfp, sgend_rndfp, ndfmin, rndf)
- end if
-#endif
-
-#ifdef MPI /* SOFT CORE */
- if (ifsc /=0 ) call sc_degrees_o_freedom(ndfmin)
-#endif
-
- ! End of degrees of freedom setup
- !=======================================================================
-
- boltz2 = 8.31441d-3 * 0.5d0
- pconv = 1.6604345d+04 ! factor to convert the pressure kcal/mole to bar
-
- ! ---convert to kcal/mol units
-
- boltz2 = boltz2/4.184d0 ! k-sub-B/2
- dtx = dt*20.455d+00
- dtxinv = 1.0d0 / dtx
- dt5 = dtx * 0.5d0
- pconv = pconv*4.184d0
-
- ! FAC() are #deg freedom * kboltz / 2
- ! multiply by T to get expected kinetic energy
- ! FAC(1) is for total system
-
- fac(1) = boltz2*rndf
- fac(2) = boltz2*rndfp
-
- if(rndfp < 0.1d0) fac(2) = 1.d-6
-
-#ifdef LES
- ! replaced solvent variables with LES ones
- ! since separate solvent coupling no longer used
- ! ASSUME SAME COUPLING CONSTANT FOR BOTH BATHS, just different target T
-
- ! will also have to accumulate LES and non-LES kinetic energies separately
-
- if (temp0les < 0.d0) then
- fac(3) = boltz2*rndfs
- if(rndfs < 0.1d0) fac(3) = 1.d-6
- else
- fac(3) = boltz2*rndfles
- if(rndfles < 0.1d0) fac(3) = 1.d-6
- end if
-#else
- fac(3) = boltz2*rndfs
- if(rndfs < 0.1d0) fac(3) = 1.d-6
-#endif
- if ( ipimd==CMD ) then
- if ( eq_cmd ) then
- fac(1) = boltz2 * dble( 3*natomCL )
- else
- fac(1) = boltz2 * dble( 3*(natomCL-1) )
- endif
- endif
- onefac(1) = 1.0d0/fac(1)
- onefac(2) = 1.0d0/fac(2)
- onefac(3) = 1.0d0/fac(3)
- factt = rndf/(rndf+ndfmin)
-
- ! these are "desired" kinetic energies based on
- ! # degrees freedom and target temperature
- ! they will be used for calculating the velocity scaling factor
-
- ekinp0 = fac(2)*temp0
-#ifdef LES
-
- ! modified for LES temperature
-
- ekins0=0.d0
- ekinles0=0.d0
- if (temp0les < 0.d0) then
- ekins0 = fac(3) * temp0
- ekin0 = fac(1) * temp0
- if (master) &
- write (6,*) "Single temperature bath for LES and non-LES"
- else
- ekinles0 = fac(3)*temp0les
- ekin0 = ekinp0 + ekinles0
- if (master) then
- write (6,*) "LES particles coupled to separate bath"
- write (6,'(a,f8.2)')" LES target temperature: ",temp0les
- write (6,'(a,f8.2)')" LES target kinetic energy: ",ekinles0
- write (6,'(a,f8.2)')"non-LES target temperature: ",temp0
- write (6,'(a,f8.2)')"non-LES target kinetic energy: ",ekinp0
- end if
- end if
-#else
- ekins0 = fac(3)*temp0
- ekin0 = fac(1)*temp0
-#endif
-
-#ifdef LES
- if(abfqmmm_param%abfqmmm /= 1) then ! lam81
- if ( ntt==4 ) call nose_hoover_init_LES(amass,v,f) ! APJ
- else ! lam81
- if ( ntt==4 .and. abfqmmm_param%qmstep == 1 .and. abfqmmm_param%system == 1 ) & ! lam81
- call nose_hoover_init_LES(amass,abfqmmm_param%v,abfqmmm_param%f) ! lam81
- endif ! lam81
-#else
- if(abfqmmm_param%abfqmmm /= 1) then ! lam81
- if ( ntt>=4 .and. ntt<=8 ) call nose_hoover_init(amass,v,f) ! APJ
- else ! lam81
- if ( ntt>=4 .and. ntt<=8 .and. abfqmmm_param%qmstep == 1 .and. abfqmmm_param%system == 1 ) & ! lam81
- call nose_hoover_init(amass,abfqmmm_param%v,abfqmmm_param%f) ! lam81
- endif
-#endif
-
- ! Langevin dynamics setup:
-
- is_langevin = gamma_ln > 0.0d0
- gammai = gamma_ln/20.455d0
- c_implic = 1.d0/(1.d0+gammai*dt5)
- c_explic = 1.d0 - gammai*dt5
- c_ave = 1.d0+gammai*dt5
- sdfac = sqrt( 4.d0*gammai*boltz2*temp0/dtx )
-#ifdef LES
- if( temp0les < 0.d0 ) then
- sdfacles = sqrt( 4.d0*gammai*boltz2*temp0/dtx )
- else
- sdfacles = sqrt( 4.d0*gammai*boltz2*temp0les/dtx )
- endif
-#endif
- if (is_langevin .and. ifbox==0) then
- call get_position(nr,x,sysx,sysy,sysz,sysrange,0)
-#ifdef MPI /* SOFT CORE */
- if (ifsc == 1) call sc_mix_position(sysx,sysy,sysz,clambda)
-#endif
- end if
-
- ! Constant pH setup
- !
- if (icnstph /= 0 .and. mdloop .eq. 0) &
- call cnstphinit(x, ig)
-
- if (ntt == 1) dttp = dt/tautp
- if (ntp > 0) dtcp = comp * 1.0d-06 * dt / taup
-
- ! Constant surface tension setup:
-
- if (csurften > 0) then
-
- ! Set pres0 in direction of surface tension.
- ! The reference pressure is held constant in on direction dependent
- ! on what the surface tension direction is set to.
- if (csurften .eq. 1) then ! pres0 in the x direction
- pres0x = pres0
-
- else if (csurften .eq. 2) then ! pres0 in the y direction
- pres0y = pres0
-
- !else if (csurften .eq. 3) then ! pres0 in the z direction
- else
- pres0z = pres0
-
- end if
-
- ! Multiply surface tension by the number of interfaces
- gamma_ten_int = dble(ninterface) * gamma_ten
-
- end if
-
- nrek = 4
- nrep = 15
-
- nvalid = 0
- nvalidi = 0
- nstep = 0
- total_nstep = 0
-#ifdef MPI
- ! For REMD, total_nstep is the number of steps * the number of exchanges
- ! we've already attempted
- if (rem /= 0) &
- total_nstep = (mdloop - 1) * nstlim
-#endif
- fit = 0.d0
- fiti = 0.d0
- fit2 = 0.d0
-
- ! Zero all elements of these sequence types
- ener = null_state_rec
- enert = null_state_rec
- enert2 = null_state_rec
- enert_old = null_state_rec
- enert2_old = null_state_rec
- edvdl = null_state_rec
- edvdl_r = null_state_rec
- ! for PIMD/NMPIMD/CMD/RPMD:
- totenert = null_state_rec
- totenert2 = null_state_rec
-
- ener%kin%pres_scale_solt = 1.d0
- ener%kin%pres_scale_solv = 1.d0
- ener%box(1:3) = box(1:3)
-
-
- ener%cmt(1:4) = 0.d0
- nitp = 0
- nits = 0
-
-
- !=======================================================================
- ! ----- MAKE A FIRST DYNAMICS STEP -----
- !=======================================================================
- ! init = 3: general startup if not continuing a previous run
-
- if( ipimd.eq.NMPIMD .or. ipimd.eq.CMD) then
- call trans_pos_cart_to_nmode( x )
- end if
-
- if( init == 3 .or. nstlim == 0 .or. (abfqmmm_param%abfqmmm == 1 .and. abfqmmm_param%system == 1) ) then ! lam81
- if (ntp > 0 .and. iamoeba==0 .and. ipimd==0) then
- xr(1:nr3) = x(1:nr3)
-
- ! ----- CALCULATE THE CENTER OF MASS ENERGY AND THE COORDINATES
- ! OF THE SUB-MOLECULES WITH RESPECT TO ITS OWN CENTER OF
- ! MASS -----
- call ekcmr(nspm,nsp,tma,ener%cmt,xr,v,amass,1,nr)
- end if
-
- ! ----- CALCULATE THE FORCE -----
-
- ! --- set irespa to get full energies calculated on step "0":
- irespa = 0
- iprint = 1
-
- if(ipimd==NMPIMD .or. ipimd==CMD) then
- call trans_pos_nmode_to_cart(x,cartpos)
- call force(xx,ix,ih,ipairs,cartpos,f,ener,ener%vir, &
- xx(l96),xx(l97),xx(l98),xx(l99), qsetup, &
- do_list_update,nstep)
-#if defined(MPI) && defined(LES)
- if ( ievb == 1 .and. i_qi > 0) then
- call evb_umb ( f, cartpos, real_mass, natom, istart3, iend3 )
-! 03132009 if( i_qi == 2 ) call qi_corrf_les ( cartpos, amass )
- if( i_qi == 2 ) call qi_corrf_les ( cartpos, real_mass )
- evb_nrg(1) = evb_frc%evb_nrg
- evb_nrg(2) = evb_vel0%evb_nrg
- if( nbias > 0 ) evb_nrg(3) = sum( evb_bias%nrg_bias(:) )
- endif
-#endif
-
- call trans_frc_cart_to_nmode(f)
- i3 = 3*(istart-1)
-
-#if defined(MPI) && defined(LES)
- if ( ievb /= 0 .and. i_qi == 0 ) then
- call evb_umb ( f, x, real_mass, natom, istart3, iend3 )
- evb_nrg(1) = evb_frc%evb_nrg
- evb_nrg(2) = evb_vel0%evb_nrg
- if( nbias > 0 ) evb_nrg(3) = sum( evb_bias%nrg_bias(:) )
- endif
-#endif
-
- else if ( ilscivr == 1 )then
- ! prepare the Hessian Matrix of the potential for the LSC-IVR
- ! at this point, x is the position a bead at equilibrium
- ! initialize the LSC-IVR variables
- natom_lsc = natom
- ndof_lsc = natom * 3
-
- call lsc_init
- do ilsc = 1, natom_lsc
- mass_lsc(3*ilsc-2) = amass(ilsc)
- mass_lsc(3*ilsc-1) = amass(ilsc)
- mass_lsc(3*ilsc ) = amass(ilsc)
- end do
- v2_lsc = 0.0d0
- do ilsc = 1, ndof_lsc
- ! ith vector of the Hesian matrix
- x_lsc = 0.0d0
- x_lsc(1:ndof_lsc) = x(1:ndof_lsc)
- x_lsc(ilsc) = x(ilsc) + dx_lsc
- call force(xx,ix,ih,ipairs,x_lsc,f_lsc,ener,ener%vir, &
- xx(l96),xx(l97),xx(l98),xx(l99), qsetup, &
- do_list_update,nstep)
-
-#ifdef MPI
- call xdist( f_lsc, xx(lfrctmp), natom )
-#endif
- v2_lsc(1:ndof_lsc,ilsc) = f_lsc(1:ndof_lsc)
- enddo
-
- call force(xx,ix,ih,ipairs,x,f,ener,ener%vir, &
- xx(l96),xx(l97),xx(l98),xx(l99), qsetup, &
- do_list_update,nstep)
-
-#ifdef MPI
- call xdist(f, xx(lfrctmp), natom)
-#endif
- ! 2nd derivative of the potential:
- do ilsc = 1, ndof_lsc
- v2_lsc(1:ndof_lsc,ilsc) = &
- ( f(1:ndof_lsc) - v2_lsc(1:ndof_lsc,ilsc) )/dx_lsc
- end do
-
- ! get the iniital position of the momentum:
- call lsc_xp(x,v)
-
- else
-
- ! -- ti decomp
- if(idecomp > 0) then
- decpr = .false.
- if(mod(nstep+1,ntpr) == 0) decpr = .true.
- end if
- call force(xx,ix,ih,ipairs,x,f,ener,ener%vir, &
- xx(l96),xx(l97),xx(l98),xx(l99), qsetup, &
- do_list_update,nstep)
-#ifdef MPI
- if ( ievb /= 0 ) then
-#ifdef LES
- call evb_umb_primitive ( f, x, real_mass, natom, istart, iend )
-#else
- call evb_umb_primitive ( f, x, amass, natom, istart, iend )
-#endif
- evb_nrg(1) = evb_frc%evb_nrg
- evb_nrg(2) = evb_vel0%evb_nrg
- if( nbias > 0 ) evb_nrg(3) = sum( evb_bias%nrg_bias(:) )
- endif
-#endif
-
- endif
-
- if (sebomd_obj%do_sebomd) then
- ! computes hessian matrix if necessary
- if (sebomd_obj%ntwh /= 0) then
- ! don't output atomic charges
- sebomd_obj%iflagch_old = sebomd_obj%iflagch
- sebomd_obj%iflagch = 0
- call sebomd_gradient_write(f,3*natom)
- call sebomd_hessian_compute(xx,ix,ih,ipairs,x,f,ener, &
- qsetup, do_list_update, nstep)
- sebomd_obj%iflagch = sebomd_obj%iflagch_old
- endif
- endif
-
-
- if (icnstph /= 0 .and. master .and. &
- ((rem /= 0 .and. mdloop > 0) .or. rem == 0)) call cnstphwrite(rem)
-
- for(1:nr3) = f(1:nr3) ! lam81
-#ifdef MPI
- call xdist(for,xx(lfrctmp),natom) ! lam81
-#endif
-
- if(abfqmmm_param%abfqmmm == 1) then ! lam81
-
- if(abfqmmm_param%system == 1) abfqmmm_param%f1(1:nr3) = for(1:nr3) ! lam81
-
- if(abfqmmm_param%system == 2) then ! lam81
- abfqmmm_param%f2(1:nr3) = for(1:nr3) ! lam81
- call abfqmmm_combine_forces() ! lam81
- for(1:nr3) = abfqmmm_param%f(1:nr3) ! lam81
- f(1:nr3) = abfqmmm_param%f(1:nr3) ! lam81
- end if ! lam81
-
- end if ! lam81
-
- ! This FORCE call does not count as a "step". CALL NMRDCP to decrement
- ! local NMR step counter and MTMDUNSTEP to decrease the local MTMD step
- ! counter
- call nmrdcp
- call mtmdunstep
-
-#ifdef MPI /* SOFT CORE */
- ! If softcore potentials are used, collect their dvdl contributions:
- if ( ifsc /= 0 ) then
- call mpi_reduce(sc_dvdl, sc_tot_dvdl, 1, MPI_DOUBLE_PRECISION, &
- MPI_SUM, 0, commsander, ierr)
- sc_dvdl=0.0d0 ! zero for next step
- call mpi_reduce(sc_dvdl_ee, sc_tot_dvdl_ee, 1, MPI_DOUBLE_PRECISION, &
- MPI_SUM, 0, commsander, ierr)
- sc_dvdl_ee=0.0d0 ! zero for next step
- call mpi_reduce(sc_ener, sc_ener_tmp, ti_ene_cnt, MPI_DOUBLE_PRECISION, &
- MPI_SUM, 0, commsander, ierr)
- sc_ener(1:ti_ene_cnt) = sc_ener_tmp(1:ti_ene_cnt)
- end if
- if ( ifsc == 2 ) then
- ! If this is a perturb to nothing run, scale forces and calculate dvdl
- call sc_nomix_frc(f,nr3,ener)
- if( numtasks>1 ) then
- call mpi_bcast(f,nr3,MPI_DOUBLE_PRECISION,0,commsander,ierr)
- call mpi_bcast(ener,state_rec_len,MPI_DOUBLE_PRECISION,0,commsander,ierr)
- end if
- end if
-
- if( icfe /= 0 )then
- ! ---free energies using thermodynamic integration (icfe /= 0)
-
- if( master ) then
- ! --- first, send the forces and energy to your partner:
- partner = ieor(masterrank,1)
- call mpi_sendrecv( f, nr3, MPI_DOUBLE_PRECISION, partner, 5, &
- frcti, nr3+3*extra_atoms, MPI_DOUBLE_PRECISION, &
- partner, 5, commmaster, ist, ierr )
- call mpi_sendrecv( ener, state_rec_len, MPI_DOUBLE_PRECISION, partner, 5, &
- ecopy, state_rec_len, MPI_DOUBLE_PRECISION, partner, 5, &
- commmaster, ist, ierr)
- ! exchange sc-dvdl contributions between masters
- call mpi_sendrecv( sc_tot_dvdl, 1, MPI_DOUBLE_PRECISION, partner, &
- 5, sc_tot_dvdl_partner, 1, &
- MPI_DOUBLE_PRECISION, partner, 5, &
- commmaster, ist, ierr )
- call mpi_sendrecv( sc_tot_dvdl_ee, 1, MPI_DOUBLE_PRECISION, partner, &
- 5, sc_tot_dvdl_partner_ee, 1, &
- MPI_DOUBLE_PRECISION, partner, 5, &
- commmaster, ist, ierr )
- if( masterrank==0 ) then
- call mix_frcti(frcti,ecopy,f,ener,nr3,clambda,klambda)
- else
- call mix_frcti(f,ener,frcti,ecopy,nr3,clambda,klambda)
- end if
- end if
-
- if( numtasks>1 ) then
- call mpi_bcast(f,nr3,MPI_DOUBLE_PRECISION,0,commsander,ierr)
- call mpi_bcast(ener,state_rec_len,MPI_DOUBLE_PRECISION,0,commsander,ierr)
- end if
-
- end if
-
-#endif /* MPI SOFT CORE */
-
- irespa = 1
-
- ! Reset quantities depending on TEMP0 and TAUTP (which may have been
- ! changed by MODWT during FORCE call).
- ! Recalculate target kinetic energies.
-
- ekinp0 = fac(2) * temp0
-
-#ifdef LES
-
- ! modified for LES temperature, not solvent
-
- ekins0 = 0.d0
- ekinles0 = 0.d0
- if (temp0les < 0.d0) then
- ekins0 = fac(3) * temp0
- ekin0 = fac(1) * temp0
- else
- ekinles0 = fac(3) * temp0les
- ekin0 = ekinp0 + ekinles0
- end if
-#else
- ekins0 = fac(3) * temp0
- ekin0 = fac(1) * temp0
-#endif
-
- if (ntt == 1) dttp = dt / tautp
-
- if (ntp > 0) then
- ener%volume = volume
- ener%density = tmass / (0.602204d0*volume)
-
- if( iamoeba == 0 ) then
- ener%cmt(4) = 0.d0
- ener%vir(4) = 0.d0
- ener%pres(4) = 0.d0
- do m = 1,3
- ener%cmt(m) = ener%cmt(m) * 0.5d0
- ener%cmt(4) = ener%cmt(4) + ener%cmt(m)
- ener%vir(4) = ener%vir(4) + ener%vir(m)
- ener%pres(m) = (pconv+pconv) * (ener%cmt(m)-ener%vir(m)) / volume
- ener%pres(4) = ener%pres(4) + ener%pres(m)
- end do
- ener%pres(4) = ener%pres(4) / 3.d0
- end if
- end if
-
- ntnb = 0
- i3 = 0
- tempsu = 0.0d0
-
-#ifdef LES
- ! added LES tempsu (actual LES sum of m*v**2 )
- tempsules = 0.0d0
-#endif
- eke_cmd = 0.d0
- do j = 1,nrp
- winf = winv(j) * dt5
- aamass = amass(j)
- do m = 1,3
- i3 = i3+1
- rterm = v(i3)*v(i3) * aamass
-#ifdef LES
- if (temp0les < 0.d0) then
- tempsu = tempsu + rterm
- if (ipimd.eq.CMD.and.(cnum(j).eq.0.or.cnum(j).eq.1)) then
- eke_cmd = eke_cmd + aamass*v(i3)*v(i3)
- endif
- else
- if (cnum(j) == 0) then
- tempsu = tempsu + rterm
- else
- tempsules = tempsules + rterm
- end if
- end if
-#else
- if(ipimd.eq.CMD.and.mybeadid==1) then
- eke_cmd = eke_cmd + aamass*v(i3)*v(i3)
- end if
- tempsu = tempsu + rterm
-#endif
- if(ipimd.ne.NMPIMD.and.ipimd.ne.CMD) v(i3) = v(i3) - f(i3) * winf
- if (vlim) v(i3) = sign(min(abs(v(i3)),vlimit),v(i3))
- end do
- end do
-
-#ifdef MPI /* SOFT CORE */
- if ( ifsc /= 0 ) then
- call calc_softcore_ekin(amass,v,v,istart,iend)
- sc_ener(13) = sc_ener(6) + sc_ener(12)
- end if
-#endif
-
- do im=1,iscale
- v(nr3+im) = v(nr3+im) - f(nr3+im) * dt5 / scalm
- tempsu = tempsu + scalm * v(nr3+im)*v(nr3+im)
- end do
- ener%kin%solt = tempsu * 0.5d0
-
-#ifdef LES
-
- ! added for LES temperature using old solvent variable for ener(4)
-
- if (temp0les < 0.d0) then
- ener%kin%solv = 0.d0
- ener%kin%tot = ener%kin%solt
- ! for CMD:
- if( ipimd > 0 ) then
- ener%kin%solv = equal_part + Epot_deriv ! "virial" estimate of KE
- ener%tot = ener%kin%solv + ener%pot%tot
- else
- ener%tot = ener%kin%tot + ener%pot%tot
- endif
- if (ipimd.eq.CMD) then
- ener%kin%tot = eke_cmd*0.5d0
- ener%kin%solv = ener%kin%tot
- endif
- else
- ener%kin%solv = tempsules * 0.5d0
- ener%kin%tot = ener%kin%solt + ener%kin%solv
- end if
-#else
- ! for better output for parallel PIMD/NMPIM/CMD/RPMD
- if (ipimd>0) then
- ener%tot = 0.d0
- ener%kin%tot = 0.d0
- ener%kin%solt = 0.d0
- ener%kin%solv = 0.d0
- ener%volume = 0.d0
- endif
- ener%kin%tot = ener%kin%solt
- ener%tot = ener%kin%tot+ener%pot%tot
-
-#endif
-
- if(ntt == 1) then
-#ifdef LES
- if (temp0les >= 0.d0) then
- ekmh = max(ener%kin%solt,fac(2)*10.d0)
- ekmhles = max(ener%kin%solv,fac(3)*10.d0)
- else
- ekmh = max(ener%kin%solt,fac(1)*10.d0)
- end if
-#else
- ekmh = max(ener%kin%solt,fac(1)*10.d0)
-#endif
- end if
-
- end if ! ( init == 3 )
-
- !-------------------------------------------------------------------------
- ! init = 4: continuation of a previous trajectory
- ! this code also done for init=3
- !
- ! Note: if the last printed energy from the previous trajectory was
- ! at time "t", then the restrt file has velocities at time
- ! t + 0.5dt, and coordinates at time t + dt
- !-------------------------------------------------------------------------
-
- ! -------------------------------------------------------------------
- ekmh = 0.0d0
-#ifdef LES
- ekmhles = 0.0d0
-#endif
-
- i3 = 0
- do j = 1,nrp
- aamass = amass(j)
- do m = 1,3
- i3 = i3+1
- rterm = v(i3)*v(i3) * aamass
-# ifdef LES
- ! use copy number, not solute/solvent
- if (temp0les < 0.d0) then
- ! 1 bath
- ekmh = ekmh + rterm
- else
- if (cnum(j) == 0) then
- ekmh = ekmh + rterm
- else
- ekmhles = ekmhles + rterm
- end if
- end if
-# else
- ekmh = ekmh + rterm
-# endif
- end do
- end do
-
-#ifdef MPI /* SOFT CORE */
- if ( ifsc /= 0 ) then
- call calc_softcore_ekin(amass,v,v,istart,iend)
- sc_ener(13) = sc_ener(6) + sc_ener(12)
- end if
-#endif
-
- do im=1,iscale
- ekmh = ekmh + scalm*v(nr3+im)*v(nr3+im)
- end do
- ekmh = ekmh * 0.5d0
-#ifdef LES
- ekmhles = ekmhles * 0.5d0
-#endif
-
- do i=1,nr3+iscale
- vold(i) = v(i)
- end do
-
-#ifdef EMIL
- !--Setup the emil calculation if required
- if ( emil_do_calc .gt. 0 ) then
- call emil_init( natom, nstep, 1.0/(temp0 * 2 * boltz2 ), &
- mass, xx(lcrd), f, v, ener%box)
- end if
-#endif
-
- if (abfqmmm_param%abfqmmm == 1) then ! lam81
- nstep=abfqmmm_param%qmstep ! lam81
- if(abfqmmm_param%maxqmstep == 0) nstep = 0 ! lam81
- end if ! lam81
-
- if (init /= 4 .or. nstlim == 0 .or. (abfqmmm_param%abfqmmm == 1 .and. abfqmmm_param%system == 1)) then ! lam81
-
- !-------------------------------------------------------------------
- ! PRINT THE INITIAL ENERGIES AND TEMPERATURES
- !-------------------------------------------------------------------
-#ifdef RISMSANDER
- if ( rismprm%irism == 1 .and. rismprm%write_thermo==1 &
- .and. nstep <= 0 .and. facc /= 'A') then
- if( rism_calc_type(0) == RISM_FULL)&
- call rism_solvdist_thermo_calc(.false.,0)
- end if
-#endif /*RISMSANDER*/
-
- if ( (nstep <= 0 .and. master .and. facc /= 'A') .or. & ! lam81
- (master .and. abfqmmm_param%abfqmmm == 1 .and. mod(abfqmmm_param%qmstep,ntpr) == 0) ) then ! lam81
-
- if (isgld > 0) call sgenergy(ener)
- rewind(7)
-#ifdef LES
- if (.not.ipimd.gt.0) &
- ener%tot = ener%kin%tot+ener%pot%tot
-#endif /* LES */
- if(abfqmmm_param%abfqmmm /= 1 .or. abfqmmm_param%system == 1 .or. nstep == 0) & ! lam81
- call prntmd(nstep,nitp,nits,t,ener,onefac,7,.false.)
-#ifdef MPI /* SOFT CORE */
- if (ifsc /= 0) call sc_print_energies(6, sc_ener)
- if (ifsc /= 0) call sc_print_energies(7, sc_ener)
-#endif
- if ( ifcr > 0 .and. crprintcharges > 0 ) then
- call cr_print_charge( xx(l15), nstep )
- end if
-
- !--- BEGIN DIPOLE PRINTING CODE ---
- ! See code further on for comments-explanations
- call nmlsrc('dipoles',5,prndipfind)
- if(prndipfind /= 0 ) then
- write(6,*) '------------------------------- DIPOLE &
- &INFO ----------------------------------'
- write(6,9018) nstep,t
- read (5,'(a)') prndiptest
- call rgroup(natom,natc,nres,prndipngrp,ix(i02),ih(m02), &
- ih(m04),ih(m06),ih(m08),ix(icnstrgp), &
- jgroup,indx,irespw,npdec, &
- xx(l60),xx(lcrdr),0,0,0,idecomp,5,.false.)
- rewind(5)
- if(prndipngrp > 0) then
- call printdip(prndipngrp,ix(icnstrgp),xx(lcrd), &
- xx(l15),xx(linddip),xx(Lmass), natom)
- end if
- write(6,*) '----------------------------- END DIPOLE &
- &INFO --------------------------------'
- end if
- !--- END DIPOLE PRINTING CODE ---
-
- if (nmropt > 0) then
- call nmrptx(6)
- end if
- call amflsh(7)
- end if
-
- if (abfqmmm_param%abfqmmm == 1 .and. abfqmmm_param%system == 1) then ! lam81
- deallocate(for, stat=ier) ! lam81
- REQUIRE(ier==0) ! lam81
- return ! lam81
- end if ! lam81
- if (nstlim == 0) then ! lam81
- if(abfqmmm_param%abfqmmm == 1) v(1:nr3) = abfqmmm_param%v(1:nr3) ! lam81
-#ifdef MPI
- call xdist(x, xx(lfrctmp), natom) ! lam81
- call xdist(v, xx(lfrctmp), natom) ! lam81
-
- if(master) then ! lam81
-#endif
- if(ntwr>0) call mdwrit(nstep,nrp,nr,nres,ntxo,ntr,ntb, & ! lam81
- x,v,xx(lcrdr),box,t,temp0) ! lam81
- if(ntwx>0) call corpac(x,1,nrx,MDCRD_UNIT,loutfm) ! lam81
- if(ntwv>0) call corpac(v,1,nrx,MDVEL_UNIT,loutfm) ! lam81
- if(ntwf>0) call corpac(for,1,nrx,MDFRC_UNIT,loutfm) ! lam81
- if(ntwe>0) call mdeng(15,nstep,t,ener,onefac,ntp,csurften) ! lam81
-#ifdef MPI
- end if ! lam81
-#endif
- return ! lam81
- end if ! lam81
- init = 4
- end if
-
-
- if(ntp > 0 .and. ipimd > 0 ) then
- REQUIRE(ipimd.eq.NMPIMD)
-#ifdef LES
- call part_setup_cnst_press_pimd(Nkt,tau_vol)
-#else
- call full_setup_cnst_press_pimd(Nkt,tau_vol)
-#endif
- e2 = 1.0/ (2.0*3.0)
- e4 = e2 / (4.0*5.0)
- e6 = e4 / (6.0*7.0)
- e8 = e6 / (8.0*9.0)
- x_lnv = log( box(1)*box(2)*box(3) ) / 3
- end if
-
- ! For CMD.
- if ( ipimd==CMD ) then
-
- if ( .not.eq_cmd ) then
-
- ! De-activate thermostat for path-centroid.
-#ifdef LES
- do iatom = 1, natom
- do idim = 1, 3
- if ( cnum(iatom)==0 .or. cnum(iatom)==1 ) then
- activate = .false.
- else
- activate = .true.
- end if
- call Thermostat_switch(thermo(idim,iatom),activate)
- enddo
- enddo
- if ( .not.restart_cmd ) then
- ! Scale path-centroid velocity and set total momentum equal to zero.
- call part_scale_vel_centroid(v,amass,istart,iend)
- nstep_cmd = 0
- t_cmd = 0.d0
- else
- t_cmd = t
- nstep_cmd = int( t / dt )
- end if
-#else
- if ( mybeadid.eq.1 ) then
- activate = .false.
- else
- activate = .true.
- end if
- do iatom = 1, natom
- do idim = 1, 3
- call Thermostat_switch(thermo(idim,iatom),activate)
- enddo
- enddo
- if ( .not.restart_cmd ) then
- ! Scale path-centroid velocity and set total momentum equal to zero.
- call full_scale_vel_centroid(v,amass,istart,iend)
- nstep_cmd = 0
- t_cmd = 0.d0
- else
- nstep_cmd = nstep
- t_cmd = t
- end if
-#endif /* LES */
-
- else
-
- nstep_cmd = nstep
- t_cmd = t
-
- end if
-
- end if ! ipimd.eq.CMD and adiab_param<1.d0
-
-#ifdef MPI
- ! If this is a replica run and we are on exchange > 1, restore the
- ! old ekmh value since it was reset after we left runmd last time.
- ! DAN ROE: Only for ntt==1??
- if (rem /= 0 .and. mdloop >= 1) then
- ekmh = remd_ekmh
- endif
-#endif
-
-
- !=======================================================================
- ! ----- MAIN LOOP FOR PERFORMING THE DYNAMICS STEP -----
- ! (at this point, the coordinates are a half-step "ahead"
- ! of the velocities; the variable EKMH holds the kinetic
- ! energy at these "-1/2" velocities, which are stored in
- ! the array VOLD.)
- !=======================================================================
-
- 260 continue
- onstep = mod(irespa,nrespa) == 0
-
- ! Constant pH setup
- if (icnstph /= 0 .and. &
- ((rem /= 0 .and. mdloop > 0) .or. rem == 0)) then
-
- if (ntnb == 1) then ! rebuild pairlist
- call cnstphupdatepairs(x)
- end if
-
- if (mod(irespa+nstlim*mdloop,ntcnstph) == 0) then
- if (icnstph .eq. 1) then
- call cnstphbeginstep(xx(l190))
- else
- call cnstph_explicitmd( xx,ix,ih,ipairs,x,winv,amass,f,v,vold, &
- xr,xc,conp,skip,nsp,tma,erstop,qsetup, &
- do_list_update,rem)
- end if
- end if
-
- end if
-
-! x+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++x
-! | EVB reactive flux |
-! +:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::+
-! | Driver for coordinating backward and forward propagation as |
-! | well as for enforcing stopping criteria |
-! +---------------------------------------------------------------+
-
-#if defined(MPI)
- if( ievb /= 0 .and. trim( adjustl( evb_dyn) ) == "react_flux" ) then
- REQUIRE( ipimd.eq.0 .or. ipimd.eq.NMPIMD )
- call react_flux ( x, v, f, winv, tempi * factt, dt5, dtx &
- , nr, nstep, nstlim )
- endif
-#endif
-
- !---------------------------------------------------------------
- ! ---Step 1a: do some setup for pressure calculations:
- !---------------------------------------------------------------
-
- if (ntp > 0 .and. iamoeba == 0 .and. ipimd==0) then
- ener%cmt(1:3) = 0.d0
- xr(1:nr3) = x(1:nr3)
-
- ! ----- CALCULATE THE CENTER OF MASS ENERGY AND THE COORDINATES
- ! OF THE SUB-MOLECULES WITH RESPECT TO ITS OWN CENTER OF
- ! MASS -----
-
- call timer_start(TIME_EKCMR)
- call ekcmr(nspm,nsp,tma,ener%cmt,xr,v,amass,istart,iend)
-#ifdef MPI
- call trace_mpi('mpi_allreduce', &
- 3,'MPI_DOUBLE_PRECISION',mpi_sum)
-# ifdef USE_MPI_IN_PLACE
- call mpi_allreduce(MPI_IN_PLACE,ener%cmt,3, &
- MPI_DOUBLE_PRECISION,mpi_sum,commsander,ierr)
-# else
- call mpi_allreduce(ener%cmt,mpitmp,3, &
- MPI_DOUBLE_PRECISION,mpi_sum,commsander,ierr)
- ener%cmt(1:3) = mpitmp(1:3)
-# endif
-#endif
- call timer_stop(TIME_EKCMR)
- end if
-
- ! If we're using the MC barostat, go ahead and do the trial move now
- if (ntp > 0 .and. barostat == 2 .and. mod(total_nstep+1, mcbarint) == 0) &
- call mcbar_trial(xx, ix, ih, ipairs, x, xc, f, ener%vir, xx(l96), &
- xx(l97), xx(l98), xx(l99), qsetup, do_list_update, &
- nstep, nsp, amass)
-
- !--------------------------------------------------------------
- ! ---Step 1b: Get the forces for the current coordinates:
- !--------------------------------------------------------------
-
- npbstep = nstep
- iprint = 0
- if( nstep == 0 .or. nstep+1 == nstlim ) iprint = 1
-
- if (sebomd_obj%do_sebomd) then
- ! write down atomic charges and density matrix if needed
- sebomd_obj%iflagch = 0
- if (sebomd_obj%ntwc /= 0) then
- if (mod(nstep+1,sebomd_obj%ntwc) == 0) sebomd_obj%iflagch = 1
- endif
-! sebomd_obj%pdmx = 0
-! if (sebomd_obj%pdump /= 0) then
-! if (mod(nstep+1,ntwr) == 0) sebomd_obj%pdmx = 1
-! if (nstep+1 == nstlim) sebomd_obj%pdmx = 1
-! endif
- endif
-
-#ifdef MPI
- ! set do_mbar for the force contributions
- if (ifmbar /= 0) then
- do_mbar = .false.
- if ( mod(nstep+1,bar_intervall) == 0) then
- do_mbar = .true.
- end if
- end if
-#endif
-
- if ( ipimd==NMPIMD .or. ipimd==CMD) then
- call trans_pos_nmode_to_cart(x,cartpos)
- call force(xx,ix,ih,ipairs,cartpos,f,ener,ener%vir, &
- xx(l96),xx(l97),xx(l98),xx(l99), qsetup, &
- do_list_update,nstep)
-
-#if defined(MPI) && defined(LES)
- if ( ievb == 1 .and. i_qi > 0) then
- call evb_umb ( f, cartpos, real_mass, natom, istart3, iend3 )
-! 03132009 if( i_qi == 2 ) call qi_corrf_les ( cartpos, amass )
- if( i_qi == 2 ) call qi_corrf_les ( cartpos, real_mass )
- evb_nrg(1) = evb_frc%evb_nrg
- evb_nrg(2) = evb_vel0%evb_nrg
- if( nbias > 0 ) evb_nrg(3) = sum( evb_bias%nrg_bias(:) )
- endif
-#endif
-
- call trans_frc_cart_to_nmode(f)
-
-#if defined(MPI) && defined(LES)
- if ( ievb /= 0 .and. i_qi == 0 ) then
- call evb_umb ( f, x, real_mass, natom, istart3, iend3 )
- evb_nrg(1) = evb_frc%evb_nrg
- evb_nrg(2) = evb_vel0%evb_nrg
- if( nbias > 0 ) evb_nrg(3) = sum( evb_bias%nrg_bias(:) )
- endif
-
-#endif
-
- else
- ! -- ti decomp
- if(idecomp > 0) then
- decpr = .false.
- if(mod(nstep+1,ntpr) == 0) decpr = .true.
- end if
- call force(xx,ix,ih,ipairs,x,f,ener,ener%vir, &
- xx(l96),xx(l97),xx(l98),xx(l99), qsetup, &
- do_list_update,nstep)
-#if defined(MPI)
- if ( ievb /= 0 ) then
-#ifdef LES
- call evb_umb_primitive ( f, x, real_mass, natom, istart, iend )
-#else
- call evb_umb_primitive ( f, x, amass, natom, istart, iend )
-#endif
- evb_nrg(1) = evb_frc%evb_nrg
- evb_nrg(2) = evb_vel0%evb_nrg
- if( nbias > 0 ) evb_nrg(3) = sum( evb_bias%nrg_bias(:) )
- endif
-#endif
-
- endif
-
- if (sebomd_obj%do_sebomd) then
- ! computes hessian matrix if necessary
- if (sebomd_obj%ntwh /= 0 .and. mod(nstep+1,sebomd_obj%ntwh) == 0) then
- ! don't output atomic charges
- sebomd_obj%iflagch_old = sebomd_obj%iflagch
- sebomd_obj%iflagch = 0
- call sebomd_gradient_write(f,3*natom)
- call sebomd_hessian_compute(xx,ix,ih,ipairs,x,f,ener, &
- qsetup, do_list_update, nstep)
- sebomd_obj%iflagch = sebomd_obj%iflagch_old
- endif
- endif
-
- for(1:nr3) = f(1:nr3) ! lam81
-#ifdef MPI
- call xdist(for,xx(lfrctmp),natom) ! lam81
-#endif
-
- if(abfqmmm_param%abfqmmm == 1) then ! lam81
- abfqmmm_param%f2(1:nr3) = for(1:nr3) ! lam81
- call abfqmmm_combine_forces() ! lam81
-#ifdef MPI
- call mpi_bcast(abfqmmm_param%f, 3*natom, mpi_double_precision, 0, commsander, ierr) ! lam81
-#endif
- for(1:nr3) = abfqmmm_param%f(1:nr3) ! lam81
- f(1:nr3) = abfqmmm_param%f(1:nr3) ! lam81
- end if ! lam81
-
- ! Constant pH transition evaluation for GB CpHMD (not explicit CpHMD)
- if ((icnstph == 1) .and. (mod(irespa+mdloop*nstlim,ntcnstph) == 0)) then
- call cnstphendstep(xx(l190), xx(l15), ener%pot%dvdl, temp0, solvph)
- if (master) call cnstphwrite(rem)
- end if
-
-#ifdef MPI
- ! If softcore potentials are used, collect their dvdl contributions:
- if ( ifsc /= 0 ) then
- call mpi_reduce(sc_dvdl, sc_tot_dvdl, 1, MPI_DOUBLE_PRECISION, &
- MPI_SUM, 0, commsander, ierr)
- sc_dvdl=0.0d0 ! zero for next step
- call mpi_reduce(sc_dvdl_ee, sc_tot_dvdl_ee, 1, MPI_DOUBLE_PRECISION, &
- MPI_SUM, 0, commsander, ierr)
- sc_dvdl_ee=0.0d0 ! zero for next step
- call mpi_reduce(sc_ener, sc_ener_tmp, ti_ene_cnt, MPI_DOUBLE_PRECISION, &
- MPI_SUM, 0, commsander, ierr)
- sc_ener(1:ti_ene_cnt) = sc_ener_tmp(1:ti_ene_cnt)
- end if
- if ( ifsc == 2 ) then
- ! If this is a perturb to nothing run, scale forces and calculate dvdl
- call sc_nomix_frc(f,nr3,ener)
-
- if( numtasks>1 ) then
- call mpi_bcast(f,nr3,MPI_DOUBLE_PRECISION,0,commsander,ierr)
- call mpi_bcast(ener,state_rec_len,MPI_DOUBLE_PRECISION,0,commsander,ierr)
- end if
- end if
-
- if (ifmbar /=0 .and. do_mbar) then
- call bar_collect_cont()
- end if
-
- if ( icfe /= 0 )then
-
- ! --- free energies using thermodynamic integration (icfe /= 0)
-
- ! --- first, send the forces, energy, and virial to your partner:
-
- if( master ) then
- partner = ieor(masterrank,1)
- call mpi_sendrecv( f, nr3, MPI_DOUBLE_PRECISION, partner, 5, &
- frcti, nr3+3*extra_atoms, MPI_DOUBLE_PRECISION, partner, 5, &
- commmaster, ist, ierr )
- call mpi_sendrecv( ener, state_rec_len, MPI_DOUBLE_PRECISION, partner, 5, &
- ecopy, state_rec_len, MPI_DOUBLE_PRECISION, partner, 5, &
- commmaster, ist, ierr)
-
- ! exchange sc-dvdl contributions between masters:
- call mpi_sendrecv( sc_tot_dvdl, 1, MPI_DOUBLE_PRECISION, partner, 5, &
- sc_tot_dvdl_partner, 1, MPI_DOUBLE_PRECISION, partner, 5, &
- commmaster, ist, ierr )
- call mpi_sendrecv( sc_tot_dvdl_ee, 1, MPI_DOUBLE_PRECISION, partner, 5, &
- sc_tot_dvdl_partner_ee, 1, MPI_DOUBLE_PRECISION, partner, 5, &
- commmaster, ist, ierr )
-
- ! ---- collect statistics for free energy calculations:
-
- if( onstep ) then
- if( masterrank==0 ) then
- if( klambda == 1 ) then
- edvdl = edvdl - ener + ecopy
- edvdl_r = edvdl_r - ener + ecopy
- else
- clfac = klambda*(1.d0 - clambda)**(klambda-1)
- edvdl = edvdl - (ener - ecopy)*clfac
- edvdl_r = edvdl_r - (ener - ecopy)*clfac
- end if
- else
- if( klambda == 1 ) then
- edvdl = edvdl + ener - ecopy
- edvdl_r = edvdl_r + ener - ecopy
- else
- clfac = klambda*(1.d0 - clambda)**(klambda-1)
- edvdl = edvdl + (ener - ecopy)*clfac
- edvdl_r = edvdl_r + (ener - ecopy)*clfac
- end if
- end if
- ! This includes the sc-dvdl contribution into the vdw-part
- ! and potential energy parts of the dvdl-statistics
- if (ifsc == 1) then
- call adj_dvdl_stat(edvdl, edvdl_r)
- end if
- end if
-
- ! Do energy collection for MBAR FEP runs
- if (ifmbar /= 0 .and. do_mbar) then
- call calc_mbar_energies(ener%pot%tot, ecopy%pot%tot)
- end if
-
- if( masterrank==0 ) then
- call mix_frcti(frcti,ecopy,f,ener,nr3,clambda,klambda)
- else
- call mix_frcti(f,ener,frcti,ecopy,nr3,clambda,klambda)
- endif
- endif
-
- if( numtasks>1 ) then
- call mpi_bcast(f,nr3,MPI_DOUBLE_PRECISION,0,commsander,ierr)
- call mpi_bcast(ener,state_rec_len,MPI_DOUBLE_PRECISION,0,commsander,ierr)
- end if
-
- end if ! ( icfe /= 0 )
-
-#endif /* MPI */
-
-#ifdef EMIL
- ! Call the EMIL absolute free energy calculation.
- if ( emil_do_calc .gt. 0 ) then
-
- call emil_step(natom, nstep, 1.0 / (temp0 * 2 * boltz2),&
- mass, xx(lcrd), f, v, ener%pot, ener%pot, ener%box)
- end if
-#endif
-
-
-
- ! Reset quantities depending on TEMP0 and TAUTP (which may have been
- ! changed by MODWT during FORCE call).
- ekinp0 = fac(2)*temp0
-
-#ifdef LES
- ! TEMP0LES may have changed too
-
- ekinles0=0.d0
- ekins0=0.d0
- if (temp0les >= 0.d0) then
- ekinles0 = fac(3)*temp0les
- ekin0 = ekinp0 + ekinles0
- else
- ekins0 = fac(3)*temp0
- ekin0 = fac(1)*temp0
- end if
-#else
- ekins0 = fac(3)*temp0
- ekin0 = fac(1)*temp0
-#endif
-
- if (ntt == 1) dttp = dt/tautp
-
- ! Pressure coupling:
- if (ntp > 0.and.ipimd>0) then
- REQUIRE(ipimd.eq.NMPIMD)
- centvir=0.0
-
-#ifdef LES
- do iatom=istart,iend
- if(cnum(iatom).eq.0.or.cnum(iatom).eq.1) then
- centvir=centvir-x(3*iatom-2)*f(3*iatom-2)
- centvir=centvir-x(3*iatom-1)*f(3*iatom-1)
- centvir=centvir-x(3*iatom )*f(3*iatom)
- end if
- end do
-#else
- if(mybeadid.eq.1) then
- do iatom=istart,iend
- centvir=centvir-x(3*iatom-2)*f(3*iatom-2)
- centvir=centvir-x(3*iatom-1)*f(3*iatom-1)
- centvir=centvir-x(3*iatom )*f(3*iatom)
- end do
- end if
-#endif /* LES */
-
- if(iamoeba.eq.1) then
- atomvir=sum(ener%vir(1:3))
-#ifdef MPI
-# ifdef USE_MPI_IN_PLACE
- call mpi_allreduce(MPI_IN_PLACE,centvir,1,MPI_DOUBLE_PRECISION, &
- mpi_sum,commworld,ierr)
- call mpi_allreduce(MPI_IN_PLACE,atomvir,1,MPI_DOUBLE_PRECISION, &
- mpi_sum,commworld,ierr)
-# else
- call mpi_allreduce(centvir,mpitmp,1,MPI_DOUBLE_PRECISION, &
- mpi_sum,commworld,ierr)
- centvir=mpitmp(1)
- tmp=0.0
- call mpi_allreduce(atomvir,tmp,1,MPI_DOUBLE_PRECISION, &
- mpi_sum,commworld,ierr)
- atomvir=tmp
-# endif
-#endif
- else
-#ifdef MPI
-# ifdef USE_MPI_IN_PLACE
- call mpi_allreduce(MPI_IN_PLACE,centvir,1,MPI_DOUBLE_PRECISION, &
- mpi_sum,commworld,ierr)
- call mpi_allreduce(MPI_IN_PLACE,bnd_vir,9,MPI_DOUBLE_PRECISION, &
- mpi_sum,commworld,ierr)
- call mpi_allreduce(MPI_IN_PLACE,e14vir,9,MPI_DOUBLE_PRECISION, &
- mpi_sum,commworld,ierr)
-# ifndef LES
- if (master) &
- call mpi_allreduce(MPI_IN_PLACE,atvir,9,MPI_DOUBLE_PRECISION, &
- mpi_sum,commmaster,ierr)
-# endif
-# else
- call mpi_allreduce(centvir,tmp,1,MPI_DOUBLE_PRECISION, &
- mpi_sum,commworld,ierr)
- centvir=tmp
- tmpvir=0.0
- call mpi_allreduce(bnd_vir,tmpvir,9,MPI_DOUBLE_PRECISION, &
- mpi_sum,commworld,ierr)
- bnd_vir=tmpvir
-
-# ifndef LES
- if (master) then
- tmpvir=0.0
- call mpi_allreduce(e14vir,tmpvir,9,MPI_DOUBLE_PRECISION, &
- mpi_sum,commmaster,ierr)
- e14vir=tmpvir
-
- tmpvir=0.0
- call mpi_allreduce(atvir,tmpvir,9,MPI_DOUBLE_PRECISION, &
- mpi_sum,commmaster,ierr)
- atvir=tmpvir
- endif
-# else
- tmpvir=0.0
- call mpi_allreduce(e14vir,tmpvir,9,MPI_DOUBLE_PRECISION, &
- mpi_sum,commworld,ierr)
- e14vir=tmpvir
-# endif
-# endif
- call mpi_bcast(atvir,9,MPI_DOUBLE_PRECISION,0,commsander,ierr)
- call mpi_bcast(e14vir,9,MPI_DOUBLE_PRECISION,0,commsander,ierr)
-#endif
- atomvir=0.0
- atomvir=atomvir+atvir(1,1)+bnd_vir(1,1)+e14vir(1,1)
- atomvir=atomvir+atvir(2,2)+bnd_vir(2,2)+e14vir(2,2)
- atomvir=atomvir+atvir(3,3)+bnd_vir(3,3)+e14vir(3,3)
- end if
- pressure = (Nkt*3.0-centvir-(atomvir-Eimp_virial))/(3.0*volume)
- f_lnv_p = (pressure-pres0/pconv)*volume*3.0
- end if
-
-
- if (ntp > 0) then
- ener%volume = volume
- ener%density = tmass / (0.602204d0*volume)
- if( iamoeba == 0 .and. ipimd==0 ) then
- ener%cmt(4) = 0.d0
- ener%vir(4) = 0.d0
- ener%pres(4) = 0.d0
- do m = 1,3
- ener%cmt(m) = ener%cmt(m)*0.5d0
- ener%cmt(4) = ener%cmt(4)+ener%cmt(m)
- ener%vir(4) = ener%vir(4)+ener%vir(m)
- ener%pres(m) = (pconv+pconv)*(ener%cmt(m)-ener%vir(m))/volume
- ener%pres(4) = ener%pres(4)+ener%pres(m)
- end do
- ener%pres(4) = ener%pres(4)/3.d0
-
- ! Constant surface tension output:
-
- if (csurften > 0) then
-
- if (csurften == 1) then ! Surface tension in the x direction
- ener%surface_ten = &
- box(1) * (ener%pres(1) - 0.5d0 * &
- (ener%pres(2) + ener%pres(3))) / (ninterface * ten_conv)
-
- else if (csurften .eq. 2) then ! Surface tension in the y direction
- ener%surface_ten = &
- box(2) * (ener%pres(2) - 0.5d0 * &
- (ener%pres(1) + ener%pres(3))) / (ninterface * ten_conv)
-
- else ! if (csurften .eq. 3) ! Surface tension in the z direction
- ener%surface_ten = &
- box(3) * (ener%pres(3) - 0.5d0 * &
- (ener%pres(1) + ener%pres(2))) / (ninterface * ten_conv)
-
- end if
-
- end if
-
- end if
- end if
-
-#ifdef MPI
-! ------====== REMD ======------
-! If rem /= 0 and mdloop == 0, this is the first sander call and we don't want to
-! actually do any MD or change the initial coordinates.
-! Exit here since we only wanted to get the potential energy for the first
-! subrem exchange probability calc.
- if (rem /= 0 .and. mdloop == 0) then
-# ifdef VERBOSE_REMD
- if (master) write (6,'(a,i3)') &
- 'REMD: Exiting runmd after getting initial energies for replica',repnum
-# endif
- goto 480 ! Go to the end of the runmd loop.
- endif ! (rem /= 0 and mdloop == 0)
-
- !REB Do adaptive QMMM
- if ( qmmm_nml%vsolv > 1 ) then
- ! mix forces for adaptive QM/MM and
- ! calculate adaptive energy if requested
- ! note: nstep is zero during first call; this is the energy/force calculation
- ! with the starting geometry / velocities
- call adaptive_qmmm(nstep,natom,x,xold,f,ener%pot%tot, ntpr, ntwx, &
- xx, ix, ih, ipairs, qsetup, do_list_update, &
- corrected_energy, aqmmm_flag)
-
-! ALTERNATIVE APPROACH:
-! if (ad_qmmm%calc_wbk) then
-! call ad_qmmm_check_matching_partitions()
-! if (ad_qmmm%mismatch) then
-! call force()
-! end if
-! call ad_qmmm_energy()
-! end if
-
-! test
- i3 = 3*(istart-1)
- do j=istart,iend
- do idim = 1, 3
- xold(i3+idim)=x(i3+idim)
- enddo
- i3 = i3 + 3
- enddo
-! test
- endif
-
-#endif
-
- !----------------------------------------------------------------
- ! ---Step 1c: do randomization of velocities, if needed:
- !----------------------------------------------------------------
- ! ---Assign new random velocities every Vrand steps, if ntt=2
-
- resetvelo=.false.
- if (vrand /= 0 .and. ntt == 2) then
- if (mod((nstep+1),vrand) == 0) resetvelo=.true.
- end if
-
-#ifdef MMTSB
- if ( mmtsb_switch == mmtsb_temp_rex .and. mmtsb_is_exchanged ) &
- resetvelo = .true.
-#endif
-
- if (resetvelo) then
- ! DAN ROE: Why are only the masters doing this? Even if the velocities
- ! are broadcast to the child processes, the wont the different # of random
- ! calls put the randomg num generators out of sync, or do we not care?
-
- if (master) then
- write (6,'(a,i8)') 'Setting new random velocities at step ', &
- nstep + 1
- call setvel(nr,v,winv,temp0*factt,init,iscale,scalm)
-
-#ifdef MPI /* SOFT CORE */
- ! Make sure all common atoms have the same v (that of V0) in TI runs:
- if (icfe /=0 .and. ifsc /=0) call sc_sync_x(v,nr3)
-#endif
-
-#ifdef LES
-
- ! newvel call is fixed for the dual target temperatures
-
- if (temp0les >= 0.d0.and.temp0 /= temp0les) then
- vscalt = sqrt (temp0les/temp0)
- do j=1,natom
- if(cnum(j) > 0) then
- i3 = 3*(j-1)
- v(i3+1) = v(i3+1) * vscalt
- v(i3+2) = v(i3+2) * vscalt
- v(i3+3) = v(i3+3) * vscalt
- endif
- end do
- end if
-#endif
- if (ibelly > 0) call bellyf(nr,ix(ibellygp),v)
- end if
-# ifdef MPI
- call trace_mpi('mpi_bcast',3*natom,'MPI_DOUBLE_PRECISION',0)
- call mpi_bcast(v, 3*natom, MPI_DOUBLE_PRECISION, 0, commsander, ierr)
-# endif
-
- ! At this point in the code, the velocities lag the positions
- ! by half a timestep. If we intend for the velocities to be drawn
- ! from a Maxwell distribution at the timepoint where the positions and
- ! velocities are synchronized, we have to correct these newly
- ! redrawn velocities by backing them up half a step using the
- ! current force.
- ! Note that this fix only works for Newtonian dynamics.
- if( gammai==0.d0.and.(ipimd.ne.NMPIMD.or.ipimd.ne.CMD)) then
- i3 = 3*(istart-1)
- do j=istart,iend
- wfac = winv(j) * dt5
- v(i3+1) = v(i3+1) - f(i3+1)*wfac
- v(i3+2) = v(i3+2) - f(i3+2)*wfac
- v(i3+3) = v(i3+3) - f(i3+3)*wfac
- i3 = i3+3
- end do
- end if
-
- end if ! (resetvelo)
-
- call timer_start(TIME_VERLET)
-
- !-----------------------------------------------------
- ! ---Step 2: Do the velocity update:
- !-----------------------------------------------------
-
- !step 2a: apply quenched MD if needed. This is useful in NEB>0
- if (vv==1) call quench(f,v)
-
- ! Car-Parrinello on dipoles: note that the (small?) kinetic energy
- ! of the dipoles is included in the epol energy
-! M_WJ
-! if ( induced == 1 .and. indmeth == 3 ) call cp_dips(natom,xx(lpol),xx,dt)
- if ( induced > 0 .and. indmeth == 3 ) call cp_dips(natom,xx(lpol),xx,dt)
-
-
-
-! i3 = 3*(istart-1) !! Add Brownian noise for testing. ! APJ
-! do j=istart,iend ! APJ
-! do idim=1,3 ! APJ
-! call gauss( 0.d0, sqrt(0.1d0*boltz2*temp0)/dtx,fln ) ! APJ
-! f(i3+idim) = f(i3+idim) + fln ! APJ
-! enddo ! APJ
-! i3 = i3+3 ! APJ
-! end do ! APJ
-
-
- ! Nose'-Hoover thermostat (1st step).
- if ( ntt == 4 ) then
-
- Ekin2_tot = 0.d0
- i3 = 3*(istart-1)
- do j=istart,iend
- wfac = dtx/amass(j)
- do idim = 1, 3
-#ifdef LES
- if( ntp>0.and.ipimd.eq.NMPIMD .and. &
- (cnum(j).eq.0.or.cnum(j).eq.1) ) then
-#else
- if(ntp>0.and.ipimd.eq.NMPIMD.and.mybeadid.eq.1) then
-#endif
- exp1 = exp(-dt5*thermo(idim,j)%v(1)-dt5*v_lnv*c2_lnv)
- Ekin2_tot = Ekin2_tot + amass(j)*v(i3+idim)*v(i3+idim)
- else
- exp1 = exp( -dt5 * thermo(idim,j)%v(1) )
- end if
- exp2 = exp1*exp1
- vold(i3+idim)=v(i3+idim)
- v(i3+idim) = v(i3+idim) * exp2 + f(i3+idim) * wfac * exp1
- end do
- i3 = i3+3
- end do
-
- if(ntp>0.and.ipimd.eq.NMPIMD) then
-#ifdef MPI
-# ifdef USE_MPI_IN_PLACE
- call mpi_allreduce(MPI_IN_PLACE,Ekin2_tot,1,MPI_DOUBLE_PRECISION, &
- mpi_sum,commworld,ierr)
-# else
- call mpi_allreduce(Ekin2_tot,mpitmp,1,MPI_DOUBLE_PRECISION, &
- mpi_sum,commworld,ierr)
- Ekin2_tot=mpitmp(1)
-# endif
-#endif
- f_lnv_v = Ekin2_tot*(c2_lnv-1)
- tmp = exp(-dt5*thermo_lnv%v(1))
- v_lnv = tmp*(tmp*v_lnv+dtx*(f_lnv_v+f_lnv_p)/mass_lnv)
- end if
-
- call Thermostat_integrate_1(nchain,thermo,nthermo,dtx,ntp)
-
- else if ( ntt>4 .and. ntt<=8 ) then ! APJ
-
- Ekin2_tot = 0.d0
- i3 = 3*(istart-1)
- do j=istart,iend
- wfac = dtx/amass(j)
- do idim = 1, 3
-#ifdef LES
- if( ntp>0.and.ipimd.eq.NMPIMD .and. &
- (cnum(j).eq.0.or.cnum(j).eq.1) ) then
-#else
- if(ntp>0.and.ipimd.eq.NMPIMD.and.mybeadid.eq.1) then
-#endif
- Ekin2_tot = Ekin2_tot + amass(j)*v(i3+idim)*v(i3+idim)
- !exp1 = exp(-dt5*thermo(idim,j)%v(1)-dt5*v_lnv*c2_lnv) ! APJ
- exp1 = exp(-dt5*v_lnv*c2_lnv) ! APJ
- else
- !exp1 = exp( -dt5 * thermo(idim,j)%v(1) ) ! APJ
- exp1 = 1.d0 ! APJ
- end if
- exp2 = exp1*exp1
- vold(i3+idim)=v(i3+idim)
- !v(i3+idim) = v(i3+idim) * exp2 + f(i3+idim) * wfac * exp1 ! APJ
- v(i3+idim)=v(i3+idim)*exp2 ! APJ
- f(i3+idim)=f(i3+idim)*exp1 ! APJ
- end do
- i3 = i3+3
- end do
-
- if(ntp>0.and.ipimd.eq.NMPIMD) then
-#ifdef MPI
-# ifdef USE_MPI_IN_PLACE
- call mpi_allreduce(MPI_IN_PLACE,Ekin2_tot,1,MPI_DOUBLE_PRECISION, &
- mpi_sum,commworld,ierr)
-# else
- call mpi_allreduce(Ekin2_tot,mpitmp,1,MPI_DOUBLE_PRECISION, &
- mpi_sum,commworld,ierr)
- Ekin2_tot=mpitmp(1)
-# endif
-#endif
- f_lnv_v = Ekin2_tot*(c2_lnv-1)
- !tmp = exp(-dt5*thermo_lnv%v(1)) ! APJ
- !v_lnv = tmp*(tmp*v_lnv+dtx*(f_lnv_v+f_lnv_p)/mass_lnv) ! APJ
- end if
-
- if (abfqmmm_param%abfqmmm == 1) then ! lam81
-#ifdef MPI
- call xdist(v, xx(lfrctmp), natom) ! lam81
- call xdist(f, xx(lfrctmp), natom) ! lam81
-#endif
- abfqmmm_param%v(1:nr3+iscale)=v(1:nr3+iscale) ! lam81
- abfqmmm_param%f(1:nr3+iscale)=f(1:nr3+iscale) ! lam81
- end if ! lam81
- call Adaptive_Thermostat_integrate(nchain,thermo,nthermo,dtx,ntp,1) ! APJ
- if (abfqmmm_param%abfqmmm == 1) then ! lam81
- v(1:nr3+iscale)=abfqmmm_param%v(1:nr3+iscale) ! lam81
-#ifdef MPI
- call xdist(v, xx(lfrctmp), natom) ! lam81
-#endif
- abfqmmm_param%v(1:nr3+iscale)=v(1:nr3+iscale) ! lam81
- end if ! lam81
-
-
- else if( gammai == 0.d0 ) then
-
- ! ---Newtonian dynamics:
-
- ! Applying guiding force effect:
- if (isgld > 0) then
- call sgmdw(natom,istart,iend,ntp,dtx,ener,amass,winv,x,f,v)
- end if
-
- i3 = 3*(istart-1)
- do j=istart,iend
- wfac = winv(j) * dtx
- v(i3+1) = v(i3+1) + f(i3+1)*wfac
- v(i3+2) = v(i3+2) + f(i3+2)*wfac
- v(i3+3) = v(i3+3) + f(i3+3)*wfac
- i3 = i3+3
- end do
-
- else if (isgld > 0) then
- ! Using SGLD algorithm:
- call sgldw(natom,istart,iend,ntp,dtx,temp0,ener,amass,winv,x,f,v)
- else ! gamma_ln .ne. 0, which also implies ntt=3 (see mdread.f)
-
- ! ---simple model for Langevin dynamics, basically taken from
- ! Loncharich, Brooks and Pastor, Biopolymers 32:523-535 (1992),
- ! Eq. 11. (Note that the first term on the rhs of Eq. 11b
- ! should not be there.)
-
- ! Update Langevin parameters, since temp0 might have changed:
- sdfac = sqrt( 4.d0*gammai*boltz2*temp0/dtx )
-# ifdef LES
- sdfacles = sqrt( 4.d0*gammai*boltz2*temp0les/dtx )
-# endif
-
-
-#ifdef MPI /* SOFT CORE */
- if (ifsc == 1) then
- call sc_lngdyn(winv,amass,v,f,sdfac,c_explic,c_implic, &
- istart, iend, nr, dtx)
- else
-#endif
-
-
- if (no_ntt3_sync == 1) then ! APJ
- !We don't worry about synchronizing the random number stream ! APJ
- !across processors. ! APJ
- iskip_start = 0 ! APJ
- iskip_end = 0 ! APJ
- else ! APJ
- ! In order to generate the same sequence of pseudorandom numbers that ! APJ
- ! you would using a single processor you have to go through the atoms ! APJ
- ! in order: skip those that have are being used on other processors ! APJ
- iskip_start = 3*(istart-1) ! APJ
- iskip_end = 3*(nr-iend) ! APJ
-#ifndef LES
- ! Always sync random number stream for PIMD ! APJ
- ! (AWG: not sure if this is required) ! APJ
- if (ipimd>0) then ! APJ
- iskip_start = iskip_start + 3*nr*(mybeadid-1) ! APJ
- iskip_end = iskip_end + 3*nr*(nbead-mybeadid) ! APJ
- end if ! APJ
-#endif
- endif ! APJ
-
- do j=1,iskip_start ! APJ
- ! Skip some random numbers ! APJ
- call gauss( 0.d0, 1.d0, fln ) ! APJ
- end do ! APJ
-
- ! Do Langevin step ! APJ
- i3 = 3*(istart-1) ! APJ
- do j=istart,iend ! APJ
-
- wfac = winv(j) * dtx ! APJ
- aamass = amass(j) ! APJ
-# ifdef LES
- if (temp0les >= 0 .and. temp0 /= temp0les .and. cnum(j) /= 0 ) then ! APJ
- rsd =sdfacles*sqrt(aamass) ! APJ
- else ! APJ
- rsd = sdfac*sqrt(aamass) ! APJ
- endif ! APJ
-# else
- rsd = sdfac*sqrt(aamass) ! APJ
-# endif
- call gauss( 0.d0, rsd, fln ) ! APJ
- v(i3+1) = (v(i3+1)*c_explic + (f(i3+1)+fln)*wfac) * c_implic ! APJ
- call gauss( 0.d0, rsd, fln ) ! APJ
- v(i3+2) = (v(i3+2)*c_explic + (f(i3+2)+fln)*wfac) * c_implic ! APJ
- call gauss( 0.d0, rsd, fln ) ! APJ
- v(i3+3) = (v(i3+3)*c_explic + (f(i3+3)+fln)*wfac) * c_implic ! APJ
-
- i3 = i3 + 3 ! APJ
- end do ! APJ
-
- do j=1,iskip_end ! APJ
- ! Skip some random numbers ! APJ
- call gauss( 0.d0, 1.d0, fln ) ! APJ
- end do ! APJ
-
-
-#ifdef MPI /* SOFT CORE */
- end if ! for (ifsc==1) call sc_lngdyn
-#endif
- end if ! ( gammai == 0.d0 )
-
- ! Update EMAP rigid domains
- if(temap) call emap_move()
-
- ! --- consider vlimit
-
- if (vlim.and.ipimd==0) then
- vmax = 0.0d0
- do i=istart3,iend3
- vmax = max(vmax,abs(v(i)))
- v(i) = sign(min(abs(v(i)),vlimit),v(i))
- end do
-
- ! Only violations on the master node are actually reported
- ! to avoid both MPI communication and non-master writes.
- if (vmax > vlimit) then
- if (master) then
- write(6,'(a,i6,a,f10.4)') 'vlimit exceeded for step ',nstep, &
- '; vmax = ',vmax
- end if
- end if
- end if
-
- do im=1,iscale
- v(nr3+im) = (v(nr3+im) + f(nr3+im)*dtx/scalm)
- end do
-
- ! We do the force dump here if requested, since the 'old' positions are about
- ! to be dumped into the force array...
-
- if (master) then
- ifdump = .false. ! Write forces this step?
- if (ntwf>0) ifdump = mod(total_nstep+1,ntwf) == 0 ! forces
- if (ntwf == -1 .and. mod(total_nstep+1,ntwx) == 0) &
- ifdump = .true. !Combined crdfrc file
- if (abfqmmm_param%abfqmmm == 1) ifdump = .false. ! lam81
-#ifdef MPI
- ! For adaptive QM/MM, only the master does a dump.
- if ( qmmm_nml%vsolv > 1 ) then
- if ( nodeid /= 0 ) then
- ifdump = .false.
- end if
- end if
-
- if (ifdump) then
- call xdist(f, xx(lfrctmp), natom)
- end if
-#endif
- ! Force archive:
- if (ifdump) then
-
-#ifdef MPI
- ! Write out current replica#, exchange#, step#, and mytargettemp
- ! If mdloop==0 this is a normal md run (since REMD never calls corpac
- ! when mdloop==0) and we don't want the REMD header.
- if (mdloop>0.and.loutfm) then
- if (trxsgld) then
- write (MDFRC_UNIT,'(a,4(1x,i8))') "RXSGLD ", repnum, mdloop, &
- total_nstep+1, stagid
- else
- write (MDFRC_UNIT,'(a,3(1x,i8),1x,f8.3)') "REMD ", repnum, mdloop, &
- total_nstep+1, my_remd_data%mytargettemp
- end if
- end if
-#endif
-
- ! ipimd forces will probably not be right if some type of
- ! transformation is necessary. This is from the vel dump code -- keep
- ! it here as a holder in case somebody wants to fix it.
-! if(ipimd.eq.NMPIMD.or.ipimd.eq.CMD) then
-! call corpac(cartvel,1,nrx,MDVEL_UNIT,loutfm)
-! else
- call corpac(f,1,nrx,MDFRC_UNIT,loutfm)
-! endif
- end if
-
- else ! slaves need to participate in force distribution
- ifdump = .false. ! Write forces this step?
- if (ntwf>0) ifdump = mod(total_nstep+1,ntwf) == 0 ! forces
- if (ntwf == -1 .and. mod(total_nstep+1,ntwx) == 0) &
- ifdump = .true. !Combined crdfrc file
- if (abfqmmm_param%abfqmmm == 1) ifdump = .false. ! lam81
-#ifdef MPI
- if (ifdump) call xdist(f, xx(lfrctmp), natom)
-#endif
- end if ! master
- !-------------------------------------------------------------------
- ! Step 3: update the positions, putting the "old" positions into F:
- !-------------------------------------------------------------------
-
-# ifdef LES
- if(ntp>0.and.ipimd.eq.NMPIMD) then
- aa = exp(dt5*v_lnv)
- arg2 = v_lnv*dt5*v_lnv*dt5
- poly = 1.0d0+arg2*(e2+arg2*(e4+arg2*(e6+arg2*e8)))
- endif
-
- i3 = 3*(istart-1)
- do j=istart,iend
- if(ntp>0.and.ipimd.eq.NMPIMD.and.(cnum(j).eq.0.or.cnum(j).eq.1)) then
- do idim = 1, 3
- f(i3+idim)=x(i3+idim)
- x(i3+idim)=aa*(x(i3+idim)*aa+v(i3+idim)*poly*dtx)
- enddo
- else
- do idim = 1, 3
- f(i3+idim) = x(i3+idim)
- x(i3+idim) = x(i3+idim)+v(i3+idim)*dtx
- enddo
- endif
- i3 = i3 + 3
- enddo
-
-# else
-
- if(ntp>0.and.ipimd.eq.NMPIMD.and.mybeadid==1) then
- aa = exp(dt5*v_lnv)
- arg2 = v_lnv*dt5*v_lnv*dt5
- poly = 1.0d0+arg2*(e2+arg2*(e4+arg2*(e6+arg2*e8)))
- do i3=istart3,iend3
- f(i3)=x(i3)
- x(i3)=aa*(x(i3)*aa+v(i3)*poly*dtx)
- end do
- else
- do i3 = istart3, iend3
- f(i3) = x(i3)
- x(i3) = x(i3) + v(i3)*dtx
- end do
- end if
-
-# endif /* LES */
-
- !Nose'-Hoover thermostat (2nd step).
- if ( ntt==4 ) then
- call Thermostat_integrate_2(nchain,thermo,nthermo,dtx,ntp)
- E_nhc = Thermostat_hamiltonian(nchain,thermo,nthermo)
- else if ( ntt>=4 .and. ntt<=8 ) then ! APJ
- if(abfqmmm_param%abfqmmm == 1) then ! lam81
-#ifdef MPI
- call xdist(v, xx(lfrctmp), natom) ! lam81
-#endif
- abfqmmm_param%v(1:nr3+iscale)=v(1:nr3+iscale) ! lam81
- end if ! lam81
- call Adaptive_Thermostat_integrate(nchain,thermo,nthermo,dtx,ntp,2) ! APJ
- if (abfqmmm_param%abfqmmm == 1) then ! lam81
- v(1:nr3+iscale)=abfqmmm_param%v(1:nr3+iscale) ! lam81
-#ifdef MPI
- call xdist(v, xx(lfrctmp), natom) ! lam81
-#endif
- abfqmmm_param%v(1:nr3+iscale)=v(1:nr3+iscale) ! lam81
- end if ! lam81
- E_nhc = Adaptive_Thermostat_hamiltonian(nchain,thermo,nthermo)
- end if
-
- do i = 1,iscale
- f(nr3+i) = x(nr3+i)
- x(nr3+i) = x(nr3+i)+v(nr3+i)*dtx
- end do
-
- call timer_stop(TIME_VERLET)
-
- if (ntc /= 1) then
-
- !-------------------------------------------------------------------
- ! Step 4a: if shake is being used, update the new positions to fix
- ! the bond lengths.
- !-------------------------------------------------------------------
-
- call timer_start(TIME_SHAKE)
- if (isgld > 0) call sgfshake(istart,iend,dtx,amass,x,.false.)
- qspatial=.false.
- call shake(nrp,nbonh,nbona,0,ix(iibh),ix(ijbh),ix(ibellygp), &
- winv,conp,skip,f,x,nitp,belly,ix(iifstwt),ix(noshake), &
- shkh,qspatial)
- call quick3(f,x,ix(iifstwr),natom,nres,ix(i02))
- if(nitp == 0) then
- erstop = .true.
- goto 480
- end if
- ! Including constraint forces in self-guiding force calculation
- if (isgld > 0) call sgfshake(istart,iend,dtx,amass,x,.true.)
-
- ! Need to synchronize coordinates for linearly scaled atoms after shake
-#ifdef MPI
- if( icfe /= 0 ) then
- call timer_barrier( commsander )
- call timer_stop_start(TIME_SHAKE,TIME_DISTCRD)
- if ( .not. mpi_orig .and. numtasks > 1 ) then
- call xdist(x, xx(lfrctmp), natom)
- end if
- ! In dual-topology this is done within softcore.f
- if (ifsc /= 1) then
- if( master ) call mpi_bcast(x,nr3,MPI_DOUBLE_PRECISION, &
- 0,commmaster,ierr)
- else
- if( master ) call sc_sync_x(x,nr3)
- end if
- if( numtasks>1 ) call mpi_bcast(x,nr3,MPI_DOUBLE_PRECISION, &
- 0,commsander,ierr)
- call timer_stop_start(TIME_DISTCRD,TIME_SHAKE)
- end if
-#endif /* MPI */
- !-----------------------------------------------------------------
- ! Step 4b: Now fix the velocities and calculate KE
- !-----------------------------------------------------------------
-
- ! ---re-estimate the velocities from differences in positions:
-
- if( .not.(ipimd==NMPIMD.and.ipimd==CMD.and.mybeadid.ne.1) ) then
- v(istart3:iend3) = (x(istart3:iend3)-f(istart3:iend3)) * dtxinv
- end if
-
- call timer_stop(TIME_SHAKE)
- end if
- call timer_start(TIME_VERLET)
-
- if(ineb>0.and.(mybeadid==1.or.mybeadid==neb_nbead) ) then
- x(1:3*natom)=f(1:3*natom)
- ! CARLOS: NEB- remove velocities but ONLY for the end beads so V doesn't
- ! accumulate if high forces
- v(1:3*natom)=0.d0
-
- end if
-
- if( ntt == 1 .or. onstep ) then
-
- !-----------------------------------------------------------------
- ! Step 4c: get the KE, either for averaging or for Berendsen:
- !-----------------------------------------------------------------
-
- eke = 0.d0
- ekph = 0.d0
- ekpbs = 0.d0
-#ifdef LES
- ekeles = 0.d0
- ekphles = 0.d0
-#endif
- eke_cmd = 0.d0
-
- if (gammai == 0.0d0) then
- i3 = 3*(istart-1)
- do j=istart,iend
- aamass = amass(j)
- do m = 1,3
- i3 = i3+1
-#ifdef LES
- if (temp0les < 0.d0) then
- eke = eke + aamass*0.25d0*(v(i3)+vold(i3))**2
- ekph = ekph + aamass*v(i3)**2
- if(ipimd.eq.CMD.and.(cnum(j).eq.0.or.cnum(j).eq.1)) then
- eke_cmd = eke_cmd + aamass*0.25d0*(v(i3)+vold(i3))**2
- endif
- else
- if (cnum(j) == 0) then
- eke = eke + aamass*0.25d0*(v(i3)+vold(i3))**2
- ekph = ekph + aamass*v(i3)**2
- else
- ekeles = ekeles + aamass*0.25d0*(v(i3)+vold(i3))**2
- ekphles = ekphles + aamass*v(i3)**2
- end if
- end if
-
-#else
- eke = eke + aamass*0.25d0*(v(i3)+vold(i3))**2
-
- if(mybeadid==1) then
- eke_cmd = eke_cmd + aamass*0.25d0*(v(i3)+vold(i3))**2
- end if
- ! try pseudo KE from Eq. 4.7b of Pastor, Brooks & Szabo,
- ! Mol. Phys. 65, 1409-1419 (1988):
-
- ekpbs = ekpbs + aamass*v(i3)*vold(i3)
- ekph = ekph + aamass*v(i3)**2
-
-#endif
- end do
- end do
-
- else
-
- i3 = 3*(istart-1)
- do j=istart,iend
- aamass = amass(j)
- do m = 1,3
- i3 = i3+1
-#ifdef LES
- if (temp0les < 0.d0) then
- eke = eke + aamass*0.25d0*c_ave*(v(i3)+vold(i3))**2
- else
- if (cnum(j) == 0) then
- eke = eke + aamass*0.25d0*c_ave*(v(i3)+vold(i3))**2
- else
- ekeles = ekeles + aamass*0.25d0*c_ave*(v(i3)+vold(i3))**2
- end if
- end if
-#else
- eke = eke + aamass*0.25d0*c_ave*(v(i3)+vold(i3))**2
-
-#endif
- end do
-
- end do
-
- end if ! (if gammai == 0.0d0)
-
-#ifdef MPI
-
- ! --- sum up the partial kinetic energies:
-
- if ( ipimd.eq.CMD ) then
- call mpi_reduce(eke_cmd,tmp_eke_cmd,1,MPI_DOUBLE_PRECISION, &
- mpi_sum,0,commsander,ierr)
- eke_cmd = tmp_eke_cmd
- endif
-
-# ifdef LES
- !if ( ipimd.eq.CMD ) then
- ! call mpi_reduce(eke_cmd,tmp_eke_cmd,1,MPI_DOUBLE_PRECISION, &
- ! mpi_sum,0,commsander,ierr)
- ! eke_cmd = tmp_eke_cmd
- !endif
- if ( .not. mpi_orig .and. numtasks > 1 ) then
- if ( temp0les < 0 ) then
- mpitmp(1) = eke
- mpitmp(2) = ekph
-# ifdef USE_MPI_IN_PLACE
- call mpi_allreduce(MPI_IN_PLACE,mpitmp,2, &
- MPI_DOUBLE_PRECISION,mpi_sum,commsander,ierr)
- eke = mpitmp(1)
- ekph = mpitmp(2)
-# else
- call mpi_allreduce(mpitmp,mpitmp(3),2, &
- MPI_DOUBLE_PRECISION,mpi_sum,commsander,ierr)
- eke = mpitmp(3)
- ekph = mpitmp(4)
-# endif
- else
- mpitmp(1) = eke
- mpitmp(2) = ekph
- mpitmp(3) = ekeles
- mpitmp(4) = ekphles
-# ifdef USE_MPI_IN_PLACE
- call mpi_allreduce(MPI_IN_PLACE,mpitmp,4, &
- MPI_DOUBLE_PRECISION,mpi_sum,commsander,ierr)
- eke = mpitmp(1)
- ekph = mpitmp(2)
- ekeles = mpitmp(3)
- ekphles = mpitmp(4)
-# else
- call mpi_allreduce(mpitmp,mpitmp(5),4, &
- MPI_DOUBLE_PRECISION,mpi_sum,commsander,ierr)
- eke = mpitmp(5)
- ekph = mpitmp(6)
- ekeles = mpitmp(7)
- ekphles = mpitmp(8)
-# endif
- endif
- end if
-# else
-
- if ( .not. mpi_orig .and. numtasks > 1 ) then
- call trace_mpi('mpi_allreduce', &
- 1,'MPI_DOUBLE_PRECISION',mpi_sum)
- mpitmp(1) = eke
- mpitmp(2) = ekph
- mpitmp(3) = ekpbs
-# ifdef USE_MPI_IN_PLACE
- call mpi_allreduce(MPI_IN_PLACE,mpitmp,3, &
- MPI_DOUBLE_PRECISION,mpi_sum,commsander,ierr)
- eke = mpitmp(1)
- ekph = mpitmp(2)
- ekpbs = mpitmp(3)
-
-# else
-
- call mpi_allreduce(mpitmp,mpitmp(4),3, &
- MPI_DOUBLE_PRECISION,mpi_sum,commsander,ierr)
- eke = mpitmp(4)
- ekph = mpitmp(5)
- ekpbs = mpitmp(6)
-
-# endif
- end if
-# endif
-
- ! Calculate Ekin of the softcore part of the system
- if (ifsc /= 0 ) then
- call calc_softcore_ekin(amass,v,vold,istart,iend)
- sc_ener(13) = sc_ener(6) + sc_ener(12)
- end if
-#endif
-
- ! --- all processors handle the "extra" variables:
-
- do im=1,iscale
- eke = eke + scalm*0.25d0*(v(nr3+im)+vold(nr3+im))**2
- ekpbs = ekpbs + scalm*v(nr3+im)*vold(nr3+im)
- ekph = ekph + scalm*v(nr3+im)**2
- end do
-
- eke = eke * 0.5d0
- ekph = ekph * 0.5d0
- ekpbs = ekpbs * 0.5d0
-#ifdef LES
- ekeles = ekeles * 0.5d0
- ekphles = ekphles * 0.5d0
-#endif
-
- if( ntt == 1 ) then
-#ifdef LES
-
- if (temp0les < 0.d0) then
- scaltp = sqrt(1.d0 + 2.d0*dttp*(ekin0-eke)/(ekmh+ekph))
- else
- scaltp = sqrt(1.d0+2.d0*dttp*(ekinp0-eke)/(ekmh+ekph))
- scaltles = sqrt(1.d0+2.d0*dttp*(ekinles0-ekeles)/(ekmhles+ekphles))
- end if
-#else
-
- ! --- following is from T.E. Cheatham, III and B.R. Brooks,
- ! Theor. Chem. Acc. 99:279, 1998.
-
- scaltp = sqrt(1.d0 + 2.d0*dttp*(ekin0-eke)/(ekmh+ekph))
-
- ! --- following is the "old" (amber7 and before) method:
-
- ! scaltpo = sqrt(1.d0 + dttp*(ekin0/ekph - 1.d0))
- ! write(6,*) 'scaltp: ',2.d0*dttp*(ekin0-eke)/(ekmh+ekph), &
- ! dttp*(ekin0/ekmh - 1.d0)
-
- ! following line reverts to the "old" behavior:
- ! scaltp = scaltpo
-
-#endif
-
-#ifdef MPI /* SOFT CORE */
- if (icfe /= 0) then
- if (ifsc == 1) then
- if (master) then
- ! Linearly combine the scaling factors from both processes
- ! the combined factor is broadcast to all nodes
- ! the subroutine also correctly scales the softcore atom v's
- call mix_temp_scaling(scaltp,clambda,v)
- end if
- call mpi_bcast(scaltp,1,MPI_DOUBLE_PRECISION,0,commsander,ierr)
- end if
- end if
-#endif
-
- do j = istart,iend
- i3=(j-1)*3+1
-#ifdef LES
- if (temp0les > 0.d0 .and. cnum(j) /= 0 ) then
- v(i3 ) = v(i3 )*scaltles
- v(i3+1) = v(i3+1)*scaltles
- v(i3+2) = v(i3+2)*scaltles
- else
- v(i3 ) = v(i3 ) *scaltp
- v(i3+1) = v(i3+1) *scaltp
- v(i3+2) = v(i3+2) *scaltp
- end if
-#else
- v(i3 ) = v(i3 ) *scaltp
- v(i3+1) = v(i3+1) *scaltp
- v(i3+2) = v(i3+2) *scaltp
-#endif
- end do
- do im=1,iscale
- v(nr3+im) = v(nr3+im)*scaltp
- end do
- end if ! (ntt == 1 )
-
- end if ! ( ntt == 1 .or. onstep; end of step 4c )
-
- !-----------------------------------------------------------------
- ! Step 5: several tasks related to dumping of trajectory information
- !-----------------------------------------------------------------
-
- itdump = .false. ! Write coordinates this step?
- ivdump = .false. ! Write velocities this step?
- ifdump = .false. ! Write forces this step? lam81
- ixdump = .false. ! Write restart this step?
- ifdump = .false. ! Write forces this step?
- ivscm = .false. ! Do com removal this step?
-#ifdef RISMSANDER
- irismdump = .false. ! Write RISM files this step?
-#endif
-
- ! --- Determine if trajectory, velocity, or restart
- ! writing is imminent, or if the center of mass
- ! motion will be removed.
- ! These require xdist of velocities or dipoles in parallel runs:
- !
- ! Modified so that when running REMD, writing can occur less often
- ! than exchanges (e.g. ntwx > nstlim)
- ! DAN ROE: Added two new variables, total_nstep and total_nstlim.
- ! For non-REMD runs, total_nstep=nstep+1 and total_nstlim=nstlim
- ! just like before.
- ! For REMD runs, total_nstep=(mdloop-1)*nstlim+nstep+1, where
- ! mdloop is the current exchange - this is the current
- ! replica exchange MD step. total_nstlim=numexchg*nstlim, which is
- ! the maximum number of REMD steps.
- total_nstep=nstep+1
- total_nstlim=nstlim
- if(abfqmmm_param%abfqmmm == 1) total_nstep=abfqmmm_param%qmstep ! lam81
-
-#ifdef MPI
- if (rem /= 0) then
- total_nstep = (mdloop - 1) * nstlim + nstep + 1
- total_nstlim = nstlim * numexchg
- endif
-#endif
- if (ntwx>0) itdump = mod(total_nstep,ntwx) == 0 ! Trajectory coords
- if (ntwv>0) ivdump = mod(total_nstep,ntwv) == 0 ! Velocity
- if (ntwf>0) ifdump = mod(total_nstep,ntwf) == 0 ! Force
- if( ntwr /= 0 ) then
- if ( mod(total_nstep, ntwr ) == 0 ) ixdump = .true. ! Restart
- endif
- if( total_nstep >= total_nstlim ) ixdump = .true. ! Final restart
- if ( nscm > 0 ) then
- if( mod(total_nstep,nscm) == 0 ) ivscm =.true. ! C.o.M. removal
- end if
- if (ntwv == -1 .and. itdump) ivdump = .true. !Combined crdvel file
-
-#ifdef MPI
- ! adaptive QM/MM via multisander
- ! all groups have identical coords and velocities
- ! only master of first group needs to dump results
- ! We have to leave the dump values for all threads in the group, though
- ! since for dumping the coords, these are broadcast within the group
- ! (see call to xdist() below)
- if ( qmmm_nml%vsolv > 1 ) then
- if ( nodeid /= 0 ) then
- ixdump = .false.
- itdump = .false.
- ivdump = .false.
- end if
- end if
-#endif
-
-#ifdef RISMSANDER
- if(rismprm%irism ==1)then
- if(rismprm%ntwrism > 0 )then
- irismdump = mod(nstep+1,rismprm%ntwrism) == 0
- if( nstep+1 >= nstlim ) then !! do we want to do this?
- irismdump = .true.
- end if
- end if
- end if
-#endif
-
-
-#ifdef MPI
-
- !-----------------------------------------------------------------
- ! --- now distribute the coordinates, and if necessary, dipoles and vel:
- !-----------------------------------------------------------------
-
- call timer_barrier( commsander )
- call timer_stop_start(TIME_VERLET,TIME_DISTCRD)
- if ( .not. mpi_orig .and. numtasks > 1 ) then
- call xdist(x, xx(lfrctmp), natom)
- end if
- ! dac/knut change: force the coordinates to be the same on both masters.
- ! For certain compilers, addition may not be strictly commutative, so
- ! the forces on group 0 may be different by roundoff from the forces on
- ! group 1. This can lead to divergent trajectories. The interval at
- ! which they are resynchronized is hard-wired here to 20, which seems to
- ! work fine in our tests.
- ! jwk change: coordinates are synchronized when shake is enabled above
- if( icfe /= 0 .and. mod(nstep+1,20) == 0 .and. ntc == 1 ) then
-
- ! In dual-topology this is done within softcore.f
- if (ifsc /= 1) then
- if( master ) call mpi_bcast(x,nr3,MPI_DOUBLE_PRECISION, &
- 0,commmaster,ierr)
- else
- if( master ) then
- call sc_compare(x,nr3,'CRD') ! first, check if coordinates have desynced
- if (numtasks==1 ) call sc_compare(v,nr3,'VEL') ! do the same for velocities
- call sc_sync_x(x,nr3) ! then resync them
- end if
- end if
- if( numtasks>1 ) call mpi_bcast(x,nr3,MPI_DOUBLE_PRECISION, &
- 0,commsander,ierr)
- end if
- call timer_stop(TIME_DISTCRD)
-
-#endif /* MPI */
-
- ! ----fix lone pair positions:
- if( numextra > 0 )call local_to_global(x,xx,ix)
-
-#ifdef MPI
- if ( .not. mpi_orig .and. numtasks > 1 ) then
- call timer_start(TIME_DISTCRD)
-
- ! ---Here we provide every processor a full copy of the velocities
- ! for removal of center of mass motion, or for archiving.
- ! (Note: this is actually over-kill: for example, only the master
- ! node really needs the velocities for archiving. But the extra
- ! overhead of doing it this way is probably small in most cases.)
-
- if( ivdump .or. ivscm .or. ixdump ) then
- call xdist(v, xx(lfrctmp), natom)
- endif
-
-! M-WJ
-! if( ixdump .and. (induced == 1 .and. indmeth == 3 ) )then
- if( ixdump .and. (induced > 0 .and. indmeth == 3 ) )then
-!
- call xdist(xx(ldipvel), xx(lfrctmp), natom)
- call xdist(xx(linddip), xx(lfrctmp), natom)
- end if
- call timer_stop(TIME_DISTCRD)
- end if
- call timer_start(TIME_VERLET)
-
- ! ========================= END AMBER/MPI =========================
-#endif /* MPI */
-
- !-------------------------------------------------------------------
- ! Step 6: zero COM velocity if requested; used for preventing
- ! ewald "block of ice flying thru space" phenomenon, or accumulation
- ! of rotational momentum in vacuum simulations
- !-------------------------------------------------------------------
-
- if (ivscm) then
- if (mod(nstep,nsnb) == 0) ntnb = 1
- if( ifbox == 0 ) then
- if (is_langevin) then
- ! Get current center of the system
- call get_position(nr,x,vcmx,vcmy,vcmz,sysrange,0)
-
-#ifdef MMPI /* SOFT CORE */
- if (ifsc == 1) call sc_mix_position(vcmx,vcmy,vcmz,clambda)
-#endif
- ! Center the system to the original center
- call re_position(nr,ntr,x,xc, &
- vcmx,vcmy,vcmz,sysx,sysy,sysz,sysrange,mv_flag,0)
- else
- ! ---Non-periodic simulation: remove both translation and rotation.
- ! Back the coords up 1/2 step, so that the correspond to the
- ! velocities; temporarily store in the F() array:
- f(1:nr3) = x(1:nr3) - v(1:nr3)*dt5
- ! --- now compute the com motion, remove it, and recompute (just
- ! to check that it is really gone.....)
- call cenmas(nr,f,v,amass,ekcm,xcm,vcm,acm,ekrot,ocm,4)
- call stopcm(nr,f,v,xcm,vcm,ocm, .true.)
- call cenmas(nr,f,v,amass,ekcm,xcm,vcm,acm,ekrot,ocm,4)
- end if
- else
- if (.not. is_langevin) then
- ! ---Periodic simulation: just remove the translational velocity:
- vcmx = 0.d0
- vcmy = 0.d0
- vcmz = 0.d0
- j = 1
- do i = 1, 3*natom,3
- aamass = amass(j)
- vcmx = vcmx + aamass * v(i)
- vcmy = vcmy + aamass * v(i+1)
- vcmz = vcmz + aamass * v(i+2)
- j = j + 1
- end do
- vcmx = vcmx * tmassinv
- vcmy = vcmy * tmassinv
- vcmz = vcmz * tmassinv
- vel2 = vcmx*vcmx + vcmy*vcmy + vcmz*vcmz
- atempdrop = 0.5d0 * tmass * vel2 * onefac(1) !onefac(1) = 1.0d0/fac(1)
- vel = sqrt(vel2)
- if ( master ) write (6,'(a,f15.6,f9.2,a)') &
- 'check COM velocity, temp: ',vel,atempdrop, '(Removed)'
- do i = 1, 3*natom, 3
- v(i) = v(i) - vcmx
- v(i+1) = v(i+1) - vcmy
- v(i+2) = v(i+2) - vcmz
- end do
-
-#ifdef MPI /* SOFT CORE */
- if (icfe==1) then
- if (ifsc==1) then
- if (master) then
- call sc_mix_velocities(v,nr3,clambda)
- end if
- call mpi_bcast(v,nr3,MPI_DOUBLE_PRECISION,0,commsander,ierr)
- end if
- end if
-#endif
- end if ! (.not. is_langevin)
- end if ! ( ifbox == 0 )
- end if ! (ivscm)
-
- ! Also zero out the non-moving velocities if a belly is active:
- if (belly) call bellyf(nr,ix(ibellygp),v)
-
- !-----------------------------------------------------------------
- ! --- put current velocities into VOLD
- !-----------------------------------------------------------------
-
- vold(istart3:iend3) = v(istart3:iend3)
- do im=1,iscale
- vold(nr3+im) = v(nr3+im)
- end do
-
- !-------------------------------------------------------------------
- ! Step 7: scale coordinates if NPT with Berendsen barostat:
- !-------------------------------------------------------------------
- if( ntp > 0 .and. ipimd > 0 .and. barostat == 1 ) then
- x_lnv_old = x_lnv
- x_lnv = x_lnv_old + v_lnv * dtx
- rmu(1:3) = exp( ( x_lnv - x_lnv_old ) )
- box(1:3) = box(1:3) * rmu(1:3)
- volume = box(1) * box(2) * box(3)
- ener%box(1:3) = box(1:3)
- ! only for NMPIMD in sander.LES
- ! (in sander.MPI volume, pressure and density printed in pimdout)
-#ifdef LES
- ener%volume = volume
-#else
- ener%volume = 0.
- totener%volume = volume
-#endif
- call redo_ucell(rmu)
- call fill_tranvec()
- call ew_pscale(natom,x,amass,nspm,nsp,2)
- end if
-
- if( iamoeba == 0 .and. barostat == 1 ) then
-
- ! ntp = 1, isotropic pressure coupling
-
- if (ntp == 1) then
- rmu(1) = (1.d0-dtcp*(pres0-ener%pres(4)))**third
- rmu(2) = rmu(1)
- rmu(3) = rmu(1)
-
-
- ! ntp = 2, anisotropic pressure scaling
-
- else if (ntp == 2) then
-
- if (csurften > 0) then
-
- ! Constant surface tension adjusts the tangential pressures
- ! See Zhang, Feller, Brooks, Pastor. J. Chem. Phys. 1995
-
- if (csurften == 1) then ! For surface tension in the x direction
- pres0y = pres0x - gamma_ten_int * ten_conv / box(1)
- pres0z = pres0y
-
- else if (csurften == 2) then ! For surface tension in the y direction
- pres0x = pres0y - gamma_ten_int * ten_conv / box(2)
- pres0z = pres0x
-
- !else if (csurften == 3) then ! For surface tension in the z !direction
- else
- pres0x = pres0z - gamma_ten_int * ten_conv / box(3)
- pres0y = pres0x
-
- end if
-
- rmu(1) = (1.d0 - dtcp * (pres0x - ener%pres(1)))**third
- rmu(2) = (1.d0 - dtcp * (pres0y - ener%pres(2)))**third
- rmu(3) = (1.d0 - dtcp * (pres0z - ener%pres(3)))**third
-
- else
-
- rmu(1) = (1.d0-dtcp*(pres0-ener%pres(1)))**third
- rmu(2) = (1.d0-dtcp*(pres0-ener%pres(2)))**third
- rmu(3) = (1.d0-dtcp*(pres0-ener%pres(3)))**third
-
- end if
-
- ! ntp = 3, semiisotropic pressure coupling
- ! (currently only for csurften>0, constant surface tension)
-
- !else if (ntp > 2) then
- else
-
- if (csurften > 0) then
-
- if (csurften == 1) then ! For surface tension in the x direction
- pres0y = pres0x - gamma_ten_int * ten_conv / box(1)
- pres0z = pres0y
- press_tan_ave = (ener%pres(2) + ener%pres(3))/2
- rmu(1) = (1.d0 - dtcp * (pres0x - ener%pres(1)))**third
- rmu(2) = (1.d0 - dtcp * (pres0y - press_tan_ave))**third
- rmu(3) = (1.d0 - dtcp * (pres0z - press_tan_ave))**third
-
- else if (csurften == 2) then ! For surface tension in the y direction
- pres0x = pres0y - gamma_ten_int * ten_conv / box(2)
- pres0z = pres0x
- press_tan_ave = (ener%pres(1) + ener%pres(3))/2
- rmu(1) = (1.d0 - dtcp * (pres0x - press_tan_ave))**third
- rmu(2) = (1.d0 - dtcp * (pres0y - ener%pres(2)))**third
- rmu(3) = (1.d0 - dtcp * (pres0z - press_tan_ave))**third
-
- !else if (csurften == 3) then ! For surface tension in the z !direction
- else
- pres0x = pres0z - gamma_ten_int * ten_conv / box(3)
- pres0y = pres0x
- press_tan_ave = (ener%pres(1) + ener%pres(2))/2
- rmu(1) = (1.d0 - dtcp * (pres0x - press_tan_ave))**third
- rmu(2) = (1.d0 - dtcp * (pres0y - press_tan_ave))**third
- rmu(3) = (1.d0 - dtcp * (pres0z - ener%pres(3)))**third
-
- end if
- end if
- ! Add semiisotropic pressure scaling in any direction with no constant
- ! surface tension here
- end if
-
- if (ntp > 0) then
- box(1:3) = box(1:3)*rmu(1:3)
- ener%box(1:3) = box(1:3)
-
- ! WARNING!! This is not correct for non-orthogonal boxes if
- ! NTP > 1 (i.e. non-isotropic scaling). Currently general cell
- ! updates which allow cell angles to change are not implemented.
- ! The viral tensor computed for ewald is the general Nose Klein,
- ! however the cell response needs a more general treatment.
-
- call redo_ucell(rmu)
- ! keep tranvec up to date, rather than recomputing each MD step.
- call fill_tranvec() ! tranvec is dependent on only ucell
-
-#ifdef MPI /* SOFT CORE */
- ! if softcore potentials and the dual topology approach are used
- ! C.O.M. scaling has to be changed to account for different masses
- ! of the same molecule in V0 and V1. This is quite inefficient and is
- ! therefore done in a separate routine in softcore.f
- ! only both masters actually do the computation for ifsc==1
- ! the scaled coordinates are then broadcast to the nodes
- if (icfe /= 0 .and. ifsc == 1) then
- if (master) then
- call sc_pscale(natom,x,amass,nspm,nsp,oldrecip,ucell)
- end if
- call mpi_bcast(x,nr3,MPI_DOUBLE_PRECISION,0,commsander,ierr)
- else
-#endif
- call ew_pscale(natom,x,amass,nspm,nsp,npscal)
-#ifdef MPI /* SOFT CORE */
- end if
-#endif
- if (ntr > 0 .and. nrc > 0) &
- call ew_pscale(natom,xc,amass,nspm,nsp,npscal)
- endif
- if (ipimd==NMPIMD.and.ntp>0) then
- ener%cmt(4) = 0.d0
- ener%vir(4) = 0.d0
- ener%pres(4) = pressure*pconv
- endif
- else if (barostat == 1) then
- if (ntp>0) then
- if (ipimd==0) then ! for classical AMOEBA
- ener%cmt(4) = eke ! for printing in prntmd()
- ener%vir(4) = ener%vir(1) + ener%vir(2) + ener%vir(3)
- ener%pres(4) = (pressure_constant/volume)*(2.d0*eke - ener%vir(4)) / 3.d0
- elseif (ipimd==NMPIMD) then ! for NMPIMD AMOEBA
- ener%cmt(4) = 0.d0
- ener%vir(4) = 0.d0
- ener%pres(4) = pressure*pconv
- endif
- call AM_RUNMD_scale_cell(natom,ener%pres(4),dt,pres0,taup,x)
- call fill_tranvec()
- end if
- end if
-
-#ifdef LES
- ener%kin%solt = eke
- ener%kin%solv = ekeles
- ener%kin%tot = ener%kin%solt + ener%kin%solv
- if (ntt == 1 .and. onstep) then
- if ( temp0les < 0 ) then
- ekmh = max(ekph,fac(1)*10.d0)
- else
- ekmh = max(ekph,fac(2)*10.d0)
- ekmhles = max(ekphles,fac(3)*10.d0)
- endif
- end if
-
- if( ipimd > 0 ) then
- ener%kin%solv = equal_part + Epot_deriv ! "virial" estimate of KE
- ener%tot = ener%kin%solv + ener%pot%tot
- endif
-#else
- if( ipimd > 0 ) then
- ! use a "virial" estimator for the KE, rather than one derived from the
- ! bead velocities:
- totener%kin%solv = equal_part + Epot_deriv
- else
- ener%kin%solv = ekpbs + ener%pot%tot
- ! Pastor, Brooks, Szabo conserved quantity
- ! for harmonic oscillator: Eq. 4.7b of Mol.
- ! Phys. 65:1409-1419, 1988
- endif
- ener%kin%solt = eke
- ener%kin%tot = ener%kin%solt
- if (ntt == 1 .and. onstep) then
- ekmh = max(ekph,fac(1)*10.d0)
- end if
-#endif
-
- ! ---if velocities were reset, the KE is not accurate; fudge it
- ! here to keep the same total energy as on the previous step.
- ! Note that this only affects printout and averages for Etot
- ! and KE -- it has no effect on the trajectory, or on any averages
- ! of potential energy terms.
-
- if( resetvelo ) ener%kin%tot = etot_save - ener%pot%tot
-
- ! --- total energy is sum of KE + PE:
-
- if( ipimd > 0 ) then
- totener%tot = totener%kin%solv + totener%pot%tot
- etot_save = totener%kin%tot + totener%pot%tot
- if (ipimd==CMD) then
- etot_cmd = eke_cmd*0.5 + ener%pot%tot
-
- totener%tot= etot_cmd
-
- ener%tot = etot_cmd
- ener%kin%tot = eke_cmd*0.5
- ener%kin%solv = ener%kin%tot
- endif
- else
- ener%tot = ener%kin%tot + ener%pot%tot
- etot_save = ener%tot
- end if
-
- !-------------------------------------------------------------------
- ! Step 8: update the step counter and the integration time:
- !-------------------------------------------------------------------
-
- if(abfqmmm_param%abfqmmm /= 1) then ! lam81
- nstep = nstep+1
- t = t+dt
- end if ! lam81
-
- !For CMD
- if ( ipimd==CMD ) then
- nstep_cmd = nstep_cmd + 1
- t_cmd = t_cmd + dt
- end if
-
- ! ---full energies are only calculated every nrespa steps
- ! nvalid is the number of steps where all energies are calculated
-
- if (onstep .or. aqmmm_flag > 0) then
- nvalid = nvalid + 1
- ! Update all elements of these sequence types
- enert = enert + ener
- enert2 = enert2 + (ener*ener)
-#ifdef MPI
- if( ievb /= 0 ) then
- evb_nrg_ave(:) = evb_nrg_ave(:) + evb_nrg(:)
- evb_nrg_rms(:) = evb_nrg_rms(:) + evb_nrg(:)**2
- endif
- if ( ifsc /= 0 ) then
- sc_ener_ave(1:ti_ene_cnt) = sc_ener_ave(1:ti_ene_cnt) + sc_ener(1:ti_ene_cnt)
- sc_ener_rms(1:ti_ene_cnt) = sc_ener_rms(1:ti_ene_cnt) + sc_ener(1:ti_ene_cnt)**2
- end if
-#endif
- if( nvalid == 1 ) etot_start = ener%tot
-
-#ifndef LES
- if ( ipimd>0 .or. ineb>0 ) then
-# ifdef MPI
- if (master) call mpi_reduce(ener%kin%tot,totener%kin%tot,1,MPI_DOUBLE_PRECISION, &
- mpi_sum,0,commmaster,ierr)
-
-# endif
- endif
-
- ! Passing of dvdl=dV/dl for TI w.r.t. mass
- ! Note that ener(39) (in runmd and mix_frcti) =
- ! = ener(17) = ene(21) (in force). All denote dvdl.
- ! Note, ener() is now historical, MJW Feb 2010
- if (ipimd>0 .and. itimass>0) totener%pot%dvdl = ener%pot%dvdl
-
- if(ipimd.eq.NMPIMD.and.ntp>0) then
- totener%pres(4) = pressure * pconv
- totener%density = tmass / (0.602204d0*volume)
- endif
- if(ipimd.eq.CMD) then
- totener%kin%tot = eke_cmd*0.5d0
- totener%kin%solv = totener%kin%tot
- totener%tot = totener%kin%tot + totener%pot%tot
- endif
- totenert = totenert + totener
- totenert2 = totenert2 + (totener*totener)
-
-#endif /* LES */
-
- kinetic_E_save(2) = kinetic_E_save(1)
- kinetic_E_save(1) = ener%kin%tot
-
- end if
-
- ! added for rbornstat
-!!FIX: TL - do we need to put in rismnrespa here?
- if (mod(irespa,nrespai) == 0 .or. irespa < 2) nvalidi = nvalidi + 1
-
- ntnb = 0
- if (mod(nstep,nsnb) == 0) ntnb = 1
-
- ! Since nstep has been incremented, total_nstep is now equal to
- ! (mdloop-1)*nstlim+nstep for REMD and nstep for MD.
- lout = mod(total_nstep,ntpr) == 0 .and. onstep
-
- irespa = irespa + 1
-
- ! reset pb-related flags
-#ifdef MPI
- if(mytaskid == 0)then
-#endif
- if ( igb == 10 .or. ipb /= 0 ) then
- if ( mod(nstep,npbgrid) == 0 .and. nstep /= nstlim ) pbgrid = .true.
- if ( mod(nstep,ntpr) == 0 .or. nstep == nstlim ) pbprint = .true.
- if ( mod(nstep,nsnbr) == 0 .and. nstep /= nstlim ) ntnbr = 1
- if ( mod(nstep,nsnba) == 0 .and. nstep /= nstlim ) ntnba = 1
- end if
-#ifdef MPI
- endif
-#endif
-
- !-------------------------------------------------------------------
- ! Step 9: output from this step if required:
- !-------------------------------------------------------------------
-
-#ifdef RISMSANDER
- !some 3D-RISM files require all processes to participate in output
- !due to the distributed memory
- ! RISM archive:
- if(rismprm%irism==1)then
-!!$ if(irismdump)&
-!!$ call rism_writeSolvDistF(rism_3d,nstep)
- ! combined thermodynamics and distribution output
- ! Execute if we need to do either
- if(irismdump .or. (rism_calc_type(nstep) == RISM_FULL &
- .and. rismprm%write_thermo==1 .and. lout))&
- call rism_solvdist_thermo_calc(irismdump,nstep)
- endif
-#endif
-
- ! ...only the master needs to do the output
- if (ixdump) then
- if(ipimd.eq.NMPIMD.or.ipimd.eq.CMD) then
- call trans_pos_nmode_to_cart(x,cartpos)
- call trans_vel_nmode_to_cart(v,cartvel)
- endif
- endif
-
- if (itdump) then
- if(ipimd.eq.NMPIMD.or.ipimd.eq.CMD) then
- call trans_pos_nmode_to_cart(x,cartpos)
- endif
-!AMD Flush amdlog file
- if(iamd.gt.0)then
-# ifdef MPI
- if (worldrank.eq.0) &
-# endif
- call write_amd_weights(ntwx,total_nstep)
- end if
-!scaledMD Flush scaledMDlog file
- if(scaledMD.gt.0)then
-# ifdef MPI
- if (worldrank.eq.0) &
-# endif
- call write_scaledMD_log(ntwx,total_nstep)
- end if
-
- endif
-
- if (ivdump) then
- if(ipimd.eq.NMPIMD.or.ipimd.eq.CMD) then
- call trans_vel_nmode_to_cart(v,cartvel)
- endif
- endif
-
-
- if (master) then
-
- ! -- restrt:
-
- if (ixdump) then
-
- ! NOTE - This assumes that if numextra > 0, then velocities are
- ! found in the array v...
- if (numextra > 0) call zero_extra_pnts_vec(v,ix)
-
- if( iwrap == 0 ) then
- nr = nrp
-#ifdef LES
- if(ipimd.eq.NMPIMD.or.ipimd.eq.CMD) then
- call mdwrit(nstep,nrp,nr,nres,ntxo,ntr,ntb, &
- cartpos,cartvel,xx(lcrdr),box,t,temp0)
- else
- call mdwrit(nstep,nrp,nr,nres,ntxo,ntr,ntb, &
- x,v,xx(lcrdr),box,t,temp0les)
- endif
-#else
- if(ipimd.eq.NMPIMD.or.ipimd.eq.CMD) then
- call mdwrit(nstep,nrp,nr,nres,ntxo,ntr,ntb, &
- cartpos,cartvel,xx(lcrdr),box,t,rem_val)
- else
- call mdwrit(nstep,nrp,nr,nres,ntxo,ntr,ntb, &
- x,v,xx(lcrdr),box,t,rem_val)
- endif
-#endif
- else if (iwrap == 1) then
-
- ! --- use temp. array to hold coords. so that the master's values
- ! are always identical to those on all other nodes:
-
- call get_stack(l_temp,nr3,routine)
- if(.not. rstack_ok)then
- deallocate(r_stack)
- allocate(r_stack(1:lastrst),stat=alloc_ier)
- call reassign_rstack(routine)
- endif
- REQUIRE(rstack_ok)
- if(ipimd.eq.NMPIMD.or.ipimd.eq.CMD) then
- do iatom=1,natom
- do m=1,3
- r_stack(l_temp+3*(iatom-1)+m-1)=cartpos(m,iatom)
- end do
- end do
- else
- do m=1,nr3
- r_stack(l_temp+m-1) = x(m)
- end do
- end if
-
- call wrap_molecules(nspm,nsp,r_stack(l_temp))
- if(ifbox == 2) call wrap_to(nspm,nsp,r_stack(l_temp),box)
- nr = nrp
-#ifdef LES
- call mdwrit(nstep,nrp,nr,nres,ntxo,ntr,ntb, &
- r_stack(l_temp),v,xx(lcrdr),box,t,temp0les)
-#else
- call mdwrit(nstep,nrp,nr,nres,ntxo,ntr,ntb, &
- r_stack(l_temp),v,xx(lcrdr),box,t,rem_val)
-#endif
- call free_stack(l_temp,routine)
- else if (iwrap == 2) then
- ! GMS ------------------------------------------
- ! We are wrapping around a pre-determined mask
- ! Need to center it on the mask COM first, then
- ! wrap it normally as it happens on the iwrap=1
- ! case.
- ! GMS ------------------------------------------
- call get_stack(l_temp,nr3,routine)
- if(.not. rstack_ok)then
- deallocate(r_stack)
- allocate(r_stack(1:lastrst),stat=alloc_ier)
- call reassign_rstack(routine)
- endif
- REQUIRE(rstack_ok)
- if(ipimd.eq.NMPIMD.or.ipimd.eq.CMD) then
- do iatom=1,natom
- do m=1,3
- r_stack(l_temp+3*(iatom-1)+m-1)=cartpos(m,iatom)
- end do
- end do
- else
- do m=1,nr3
- r_stack(l_temp+m-1) = x(m)
- end do
- end if
- nr = nrp
-
- ! Now, wrap the coordinates around the iwrap_mask:
- call iwrap2(n_iwrap_mask_atoms,iwrap_mask_atoms,r_stack(l_temp), &
- box_center)
-#ifdef LES
- call mdwrit(nstep,nrp,nr,nres,ntxo,ntr,ntb, &
- r_stack(l_temp),v,xx(lcrdr),box,t,temp0les)
-#else
- call mdwrit(nstep,nrp,nr,nres,ntxo,ntr,ntb, &
- r_stack(l_temp),v,xx(lcrdr),box,t,rem_val)
-#endif
- call free_stack(l_temp,routine)
- end if ! ( iwrap == 0 )
-
-! M-WJ
-! if( igb == 0 .and. induced == 1 .and. indmeth == 3) &
- if( igb == 0 .and. ipb == 0 .and. induced > 0 .and. indmeth == 3) &
-!
- call wrt_dips(xx(linddip),xx(ldipvel),nr,t,title)
-
- if (icnstph /= 0 .and. ((rem /= 0 .and. mdloop > 0) .or. rem == 0)) then
- call cnstphwriterestart(chrgdat)
- end if
-
- end if ! (ixdump)
-
- ! -- Coordinate archive:
- ! For formatted writes and replica exchange, write out a header line.
-
- if (itdump) then
-#ifdef MPI
- ! Write out current replica#, exchange#, step#, and mytargettemp
- ! If mdloop==0 this is a normal md run (since REMD never calls corpac
- ! when mdloop==0) and we don't want the REMD header.
- ! total_nstep is set in step 5.
- if (mdloop > 0 .and. loutfm) then
- if (trxsgld) then
- write (MDCRD_UNIT,'(a,4(1x,i8))') "RXSGLD ", repnum, mdloop, &
- total_nstep, stagid
- else
- write (MDCRD_UNIT,'(a,3(1x,i8),1x,f8.3)') "REMD ", repnum, mdloop, &
- total_nstep, my_remd_data%mytargettemp
- end if
- end if
-#endif
-
- if( iwrap == 0 ) then
- if(ipimd.eq.NMPIMD.or.ipimd.eq.CMD) then
- call corpac(cartpos,1,nrx,MDCRD_UNIT,loutfm)
- else
- call corpac(x,1,nrx,MDCRD_UNIT,loutfm)
- endif
- if(ntb > 0) call corpac(box,1,3,MDCRD_UNIT,loutfm)
- else if (iwrap == 1) then
- call get_stack(l_temp,nr3,routine)
- if(.not. rstack_ok)then
- deallocate(r_stack)
- allocate(r_stack(1:lastrst),stat=alloc_ier)
- call reassign_rstack(routine)
- endif
- REQUIRE(rstack_ok)
- if(ipimd.eq.NMPIMD.or.ipimd.eq.CMD) then
- do iatom=1,natom
- do m=1,3
- r_stack(l_temp+3*(iatom-1)+m-1) = cartpos(m,iatom)
- end do
- end do
- else
- do m=1,nr3
- r_stack(l_temp+m-1) = x(m)
- end do
- endif
-
- call wrap_molecules(nspm,nsp,r_stack(l_temp))
- if (ifbox == 2) call wrap_to(nspm,nsp,r_stack(l_temp),box)
-
- call corpac(r_stack(l_temp),1,nrx,MDCRD_UNIT,loutfm)
- call corpac(box,1,3,MDCRD_UNIT,loutfm)
- call free_stack(l_temp,routine)
- else if (iwrap == 2) then
- ! GMS ------------------------------------------
- ! We are wrapping around a pre-determined mask
- ! Need to center it on the mask COM first, then
- ! wrap it normally as it happens on the iwrap=1
- ! case.
- ! GMS ------------------------------------------
- call get_stack(l_temp,nr3,routine)
- if(.not. rstack_ok)then
- deallocate(r_stack)
- allocate(r_stack(1:lastrst),stat=alloc_ier)
- call reassign_rstack(routine)
- endif
- REQUIRE(rstack_ok)
- if(ipimd.eq.NMPIMD.or.ipimd.eq.CMD) then
- do iatom=1,natom
- do m=1,3
- r_stack(l_temp+3*(iatom-1)+m-1) = cartpos(m,iatom)
- end do
- end do
- else
- do m=1,nr3
- r_stack(l_temp+m-1) = x(m)
- end do
- endif
-
- call iwrap2(n_iwrap_mask_atoms,iwrap_mask_atoms, r_stack(l_temp), &
- box_center)
-
- call corpac(r_stack(l_temp),1,nrx,MDCRD_UNIT,loutfm)
- call corpac(box,1,3,MDCRD_UNIT,loutfm)
- call free_stack(l_temp,routine)
-
-
- end if ! if (iwrap == 0) ...
-
-
- !GMS: If using variable QM solvent, try to write a new pdb file
- ! with the QM coordinates for this step. This is done here
- ! to keep the PDB file in sync with the mdcrd file, which
- ! makes it easier to check later.
- if (qmmm_nml%vsolv > 0 .and. qmmm_nml%verbosity == 0) &
- call qm_print_coords(nstep,.false.)
- end if ! (itdump)
-
- ! Velocity archive:
-
- if (ivdump) then
-
- ! NOTE - This assumes that if numextra > 0, then velocities are
- ! found in the array v...
- if (numextra > 0) call zero_extra_pnts_vec(v,ix)
-
-#ifdef MPI
- ! Write out current replica#, exchange#, step#, and mytargettemp
- ! If mdloop==0 this is a normal md run (since REMD never calls corpac
- ! when mdloop==0) and we don't want the REMD header.
- if (mdloop>0.and.loutfm) then
- if (trxsgld) then
- write (MDVEL_UNIT,'(a,4(1x,i8))') "RXSGLD ", repnum, mdloop, &
- total_nstep, stagid
- else
- write (MDVEL_UNIT,'(a,3(1x,i8),1x,f8.3)') "REMD ", repnum, mdloop, &
- total_nstep, my_remd_data%mytargettemp
- end if
- end if
-#endif
-
- if(ipimd.eq.NMPIMD.or.ipimd.eq.CMD) then
- call corpac(cartvel,1,nrx,MDVEL_UNIT,loutfm)
- else
- call corpac(v,1,nrx,MDVEL_UNIT,loutfm)
- endif
- end if
- ! Force archive lam81
- if (ifdump .and. (abfqmmm_param%abfqmmm == 1)) call corpac(for,1,nrx,MDFRC_UNIT,loutfm) ! lam81
-
- ! Energy archive:
- ! (total_nstep set in Step 5.)
- if (ntwe > 0) then
- if (mod(total_nstep,ntwe) == 0.and.onstep) &
- call mdeng(15,nstep,t,ener,onefac,ntp,csurften)
- end if
-
- if (ioutfm > 0) then
- if (itdump) call end_binary_frame(MDCRD_UNIT)
- if (ivdump .and. ntwv>0 ) call end_binary_frame(MDVEL_UNIT)
- if (ifdump .and. ntwf>0 ) call end_binary_frame(MDFRC_UNIT)
- end if
-
-#ifdef MPI
- if( ievb /= 0 ) call out_evb ( nstep )
-#endif
-
- ! General printed output:
-
- if (lout) then
- if (facc /= 'A') rewind(7)
-
- ! Conserved quantity for Nose'-Hoover based thermostats. ! APJ
- if (ipimd.eq.0 .and. ntt > 4 .and. ntt <= 8 ) then ! APJ
- Econserved = ener%kin%tot + ener%pot%tot + E_nhc ! APJ
- if( ntp>0 ) Econserved = Econserved + pres0 / pconv * volume ! APJ
-# ifdef MPI
- if ( worldrank.eq.0 ) & ! APJ
-# endif
- write(file_nhc,'(I10,F14.4)') nstep, Econserved ! APJ
- endif ! APJ
-#ifdef LES
- if (ipimd>0.and.ntt==4) then
- Econserved = ener%kin%tot + ener%pot%tot + E_nhc
- Econserved = Econserved + Epot_spring
- if( ntp>0 ) Econserved = Econserved + pres0 / pconv * volume
- write(file_nhc,'(I10,F14.4)') nstep, Econserved
- endif
- if ( ipimd.eq.CMD ) then
- ener%kin%tot = eke_cmd*0.5d0
- ener%kin%solv = ener%kin%tot
- ener%tot = ener%kin%tot + ener%pot%tot
-
- end if
-#else
- if ( ipimd>0 ) then
- ener%tot = 0.d0
- ener%kin%tot = 0.d0
- ! Conserved quantity for Nose'-Hoover thermostat.
- if ( ntt==4 ) then
- Econserved = totener%kin%tot + totener%pot%tot + E_nhc
- Econserved = Econserved + Epot_spring
- if ( ntp>0 ) Econserved=Econserved+pres0/pconv*volume
-# ifdef MPI
- if ( worldrank.eq.0 ) &
-# endif
- write(file_nhc,'(I10,F14.4)') nstep, Econserved
- endif
-# ifdef MPI
- if(worldrank.eq.0) &
-# endif
- call pimd_report(nstep,t,pimd_unit,totener,onefac)
- end if
-#endif /* LES */
- call prntmd(total_nstep,nitp,nits,t,ener,onefac,7,.false.)
-
-# ifdef MPI
- ! print corrected energy for adaptive qm/mm runs
- ! note: nstep has already been increased here
- ! (it was not increased when adaptive_qmmm() was called above)
- if ( qmmm_nml%vsolv > 1 ) then
-
- if ( masterrank == 0 ) then
-
- if (aqmmm_flag > 0 .and. nstep > aqmmm_flag) then
-
- etotcorr = corrected_energy + kinetic_E_save(aqmmm_flag)
- nstepadc = nstep - aqmmm_flag + 1
- tadc = t - dt * (dble( aqmmm_flag - 1) )
-
- write(6,'(a)')' Adaptive QM/MM energies:'
- write(6,'(x,a,i5,x,a,f11.4,x,2(a,f15.4,x))') &
- 'adQMMM STEP=', nstepadc, &
- 'TIME(PS)=', tadc, &
- 'ETC=', etotcorr, &
- 'EPC=', corrected_energy
-
- ! print total energy for adaptive qm/mm into a separate file
- ! when qmmm_vsolv%verbosity > 0
- ! set reference energy to zero only for energy dumping purposes
- if (flag_first_energy) then
- flag_first_energy = .false.
- adqmmm_first_energy = etotcorr
- etotcorr = 0.0d0
- else
- etotcorr = etotcorr - adqmmm_first_energy
- end if
-
- if (qmmm_vsolv%verbosity > 0) then
- open(80,file='adqmmm_tot_energy.dat',position='append')
- write(80,'(i9,5x,f11.4,5x,f15.4)') nstepadc, tadc, etotcorr
- close(80)
- end if
-
- end if
- end if
- end if
-# endif
-
-#ifdef MPI /* SOFT CORE */
- if (ifsc /= 0) call sc_print_energies(6, sc_ener)
- if (ifsc /= 0) call sc_print_energies(7, sc_ener)
-#endif
- if ( ifcr > 0 .and. crprintcharges > 0 ) then
- call cr_print_charge( xx(l15), total_nstep )
- end if
-
- ! Output for CMD.
-#ifdef LES
- if (ipimd.eq.CMD) then
-
- ncmd = 0
- do iatom = 1, natom
- if ( cnum(iatom)==0 .or. cnum(iatom)==1 ) then
- xcmd(ncmd+1) = x(3*iatom-2)
- xcmd(ncmd+2) = x(3*iatom-1)
- xcmd(ncmd+3) = x(3*iatom)
- vcmd(ncmd+1) = v(3*iatom-2)
- vcmd(ncmd+2) = v(3*iatom-1)
- vcmd(ncmd+3) = v(3*iatom)
- ncmd = ncmd+3
- endif
- enddo
- write(file_pos_cmd,'(10f8.3)') xcmd(1:ncmd)
- write(file_vel_cmd,'(10f8.3)') vcmd(1:ncmd)
- write(file_pos_cmd,'(10f8.3)') box(1:3)
-
- eke_cmd = eke_cmd * 0.5d0
- etot_cmd = eke_cmd + ener%pot%tot
-
- if (eq_cmd) then
- temp_cmd = eke_cmd/boltz2/dble(3*natomCL)
- else
- temp_cmd = eke_cmd/boltz2/dble(3*(natomCL-1))
- endif
-
- endif
-#else
- if (ipimd.eq.CMD.and.mybeadid.eq.1) then
- write(file_pos_cmd,'(10f8.3)') x(1:3*natom)
- write(file_vel_cmd,'(10f8.3)') v(1:3*natom)
- write(file_pos_cmd,'(10f8.3)') box(1:3)
-
- eke_cmd = eke_cmd * 0.5d0
- etot_cmd = eke_cmd + totener%pot%tot
-
- if (eq_cmd) then
- temp_cmd = eke_cmd/boltz2/dble(3*natom)
- else
- temp_cmd = eke_cmd/boltz2/dble(3*(natom-1))
- endif
- end if
-#endif /* LES */
-
- !--- Print QMMM Muliken Charges if needed ---
- if (qmmm_nml%ifqnt) then
- if (qmmm_nml%printcharges .and. qmmm_mpi%commqmmm_master) then
- call qm2_print_charges(nstep,qmmm_nml%dftb_chg,qmmm_struct%nquant_nlink, &
- qm2_struct%scf_mchg,qmmm_struct%iqm_atomic_numbers)
- end if
- end if
- if (qmmm_nml%printdipole /= 0) then
- call qmmm_dipole(x,xx(Lmass),ix(i02),ih(m02),nres)
- end if
-
- !--- BEGIN DIPOLE PRINTING CODE ---
-
- ! RCW 2nd Dec 2003 - also output dipole information if
- ! the dipoles namelist has been specified and corresponding
- ! groups defined.
-
- ! Check input unit 5 for namelist dipoles
- ! We expect to find &dipoles followed by a group
- ! specification of the dipoles to output.
- call nmlsrc('dipoles',5,prndipfind)
-
- if(prndipfind /= 0 ) then
- !We calculate the dipoles
- write(6,*) '------------------------------- DIPOLE INFO ----------------------------------'
- write(6,9018) nstep,t
- 9018 format(/1x, 'NSTEP =',i7,1x,'TIME(PS) =',f10.3)
-
- !Get the groups for the dipoles - Ideally we only really want
- !to call this the once but for the time being I will call it
- !every time
-
- read (5,'(a)') prndiptest
-
- call rgroup(natom,natc,nres,prndipngrp,ix(i02),ih(m02), &
- ih(m04),ih(m06),ih(m08),ix(icnstrgp), &
- jgroup,indx,irespw,npdec, &
- xx(l60),xx(lcrdr),0,0,0,idecomp,5,.false.)
-
- ! Need to rewind input file after rgroup so it is available
- ! when we next loop through
-
- rewind(5)
-
- if(prndipngrp > 0) then
- !prndipngrp - holds number of groups specified + 1
- !ix(icnstrgp) - holds map of group membership for each atom
- !x(lcrd) - X,Y,Z coords of atoms - (3,*)
- !x(l15) - Partial Charges
- !x(linddip) - induced dipoles X,Y,Z for each atom (3,*)
- !x(Lmass) - Mass of each atom
- call printdip(prndipngrp,ix(icnstrgp),xx(lcrd), &
- xx(l15),xx(linddip),xx(Lmass), natom)
- end if
- write(6,*) '----------------------------- END DIPOLE INFO --------------------------------'
- end if
- !--- END DIPOLE PRINTING CODE ---
-
- if (nmropt > 0) then
- call nmrptx(6)
- end if
- if (itgtmd == 2) then
- emtmd = 0.0d0
- call mtmdcall(emtmd,xx(lmtmd01),ix(imtmd02),x,f,ih(m04),ih(m02),ix(i02),&
- ih(m06),xx(lmass),natom,nres,'PRNT')
- end if
- call amflsh(7)
- end if
-
- ! Output running averages:
- ! DAN ROE: total_nstep==Total nstep REMD/MD, set in step 5
- if ( ntave > 0 )then
- if ( mod(total_nstep,ntave) == 0 .and. onstep )then
- write(6,542)
-#ifdef RISMSANDER
- if(rismprm%irism==1)then
- tspan = ntave/mylcm(nrespa,rismprm%rismnrespa)
- else
- tspan = ntave/nrespa
- end if
-#else
- tspan = ntave/nrespa
-#endif
-
- ! Update all elements of these sequence types
- enert_tmp = enert - enert_old
- enert2_tmp = enert2 - enert2_old
- enert_old = enert
- enert2_old = enert2
- enert_tmp = enert_tmp/tspan
- enert2_tmp = enert2_tmp/tspan - &
- enert_tmp*enert_tmp
- call zero_neg_values_state(enert2_tmp)
- enert2_tmp = sqrt(enert2_tmp)
-
-#ifdef MPI
- if( ievb /= 0 ) then
- evb_nrg_tmp (:) = evb_nrg_ave(:) - evb_nrg_old (:)
- evb_nrg_tmp2(:) = evb_nrg_rms(:) - evb_nrg_old2(:)
- evb_nrg_old (:) = evb_nrg_ave(:)
- evb_nrg_old2(:) = evb_nrg_rms(:)
- evb_nrg_tmp (:) = evb_nrg_tmp (:) / tspan
- evb_nrg_tmp2(:) = evb_nrg_tmp2(:) / tspan - evb_nrg_tmp(:)**2
- evb_nrg_tmp2(:) = max( evb_nrg_tmp2(:), 0.0d0 )
- evb_nrg_tmp2(:) = sqrt( evb_nrg_tmp2(:) )
- endif
- if ( ifsc /= 0 ) then
- do m = 1,ti_ene_cnt
- sc_ener_tmp(m) = sc_ener_ave(m)-sc_ener_old(m)
- sc_ener_tmp2(m) = sc_ener_rms(m)-sc_ener_old2(m)
- sc_ener_old(m) = sc_ener_ave(m)
- sc_ener_old2(m) = sc_ener_rms(m)
- sc_ener_tmp(m) = sc_ener_tmp(m)/tspan
- sc_ener_tmp2(m) = sc_ener_tmp2(m)/tspan - sc_ener_tmp(m)**2
- if (sc_ener_tmp2(m) < 0.0d0) sc_ener_tmp2(m) = 0.0d0
- sc_ener_tmp2(m) = sqrt(sc_ener_tmp2(m))
- end do
- end if
- if( ievb /= 0 ) evb_frc%evb_ave = .true.
-#endif
-#ifdef RISMSANDER
- if(rismprm%irism==1)then
- write(6,540) ntave/mylcm(nrespa,rismprm%rismnrespa)!nrespa
- else
- write(6,540) ntave/nrespa
- end if
-#else
- write(6,540) ntave/nrespa
-#endif
- call prntmd(total_nstep,izero,izero,t,enert_tmp,onefac,0,.false.)
-#ifdef MPI
- if (ifsc /= 0) call sc_print_energies(6, sc_ener_tmp)
- if( ievb /= 0 ) evb_frc%evb_rms = .true.
-#endif
- write(6,550)
- call prntmd(total_nstep,izero,izero,t,enert2_tmp,onefac,0,.true.)
-#ifdef MPI /* SOFT CORE */
- if (ifsc /= 0) call sc_print_energies(6, sc_ener_tmp2)
-#endif
- if( icfe > 0 ) then
-#ifdef RISMSANDER
- if(rismprm%irism==1)then
- write(6,541) ntave/mylcm(nrespa,rismprm%rismnrespa)!nrespa
- else
- write(6,541) ntave/nrespa
- end if
-#else
- write(6,541) ntave/nrespa
-#endif
- edvdl_r = edvdl_r/tspan
- edvdl_r%pot%dvdl = enert_tmp%pot%dvdl ! fix for DV/DL output
- edvdl_r%virvsene = 0.d0 ! virvsene should not but included here
- call prntmd(total_nstep,izero,izero,t,edvdl_r,onefac,0,.false.)
- edvdl_r = null_state_rec
-
- end if
- write(6,542)
- end if
- end if ! ( ntave > 0 )
-
- ! --- end masters output ---
-
- end if ! (master)
-
-#ifdef MPI /* SOFT CORE */
- if (ntave > 0 .and. icfe > 0 .and. dynlmb > 0) then
- if ( mod(nstep,ntave) == 0 .and. onstep ) then
- ! For runs with dynamically changing lambda, raise lambda here
- ! and flush all buffers for the next averages
- clambda = clambda + dynlmb
- call sc_change_clambda(clambda)
- if (master) then
- sc_ener(1:ti_ene_cnt) = 0.0d0
- sc_ener_ave(1:ti_ene_cnt) = 0.0d0
- sc_ener_rms(1:ti_ene_cnt) = 0.0d0
- sc_ener_old(1:ti_ene_cnt) = 0.0d0
- sc_ener_old2(1:ti_ene_cnt) = 0.0d0
- enert = null_state_rec
- enert2 = null_state_rec
- enert_old = null_state_rec
- enert2_old = null_state_rec
- write (6,*)
- write (6,'(a,f12.4,a,f12.4)') &
- 'Dynamically changing lambda: Increased clambda by ', &
- dynlmb, ' to ', clambda
- write (6,*)
- end if
- end if
- end if
-#endif
-
- !=======================================================================
-
- ! ---major cycle back to new step unless we have reached our limit:
-
-#ifdef MMTSB
- if ( mmtsb_switch /= mmtsb_off ) then
- if ( mod( nstep, mmtsb_iterations ) == 0 ) then
- write(6,'(a,i8)') &
- 'MMTSB Replica Exchange iterations completed at NSTEP = ', &
- nstep
- ! apparently 23 is the magic number for potential energy.
- ! ener%pot%tot is the new 23 ;) MJW
- write(6,'(a,f12.4)') &
- 'MMTSB Replica Exchange potential energy = ', ener%pot%tot
- ! write coordinates; preferred format is pdb, but can't do that
- ! so write a restart file; server will post process with ambpdb.
-# ifdef LES
- call mdwrit(nstep,nrp,nr,nres,ntxo,ntr,ntb, x,v, &
- xx(lcrdr),box,t,temp0les)
-# else
- call mdwrit(nstep,nrp,nr,nres,ntxo,ntr,ntb, x,v, &
- xx(lcrdr),box,t,rem_val)
-# endif
- ! Chop up trajectory files for later continuous temp splicing.
- call close_dump_files
- ! contact server
- if ( mmtsb_switch == mmtsb_temp_rex ) then
- call mmtsb_newtemp( ener%pot%tot, temp_mmtsb, is_done_mmtsb )
- else if ( mmtsb_switch == mmtsb_lambda_rex ) then
- ! currently temp_mmtsb is ignored, but multidimensional soon
- call mmtsb_newlambda( unpert_pe_mmtsb, pert_pe_mmtsb, &
- lambda_mmtsb, temp_mmtsb, is_done_mmtsb )
- end if
- call open_dump_files
- if ( is_done_mmtsb ) then
- goto 480
- end if
-
- ! in the future we may want amber based tracking of exchanges
- ! perhaps we can use the Simmerling group's code ?
- if ( mmtsb_switch == mmtsb_temp_rex ) then
- if ( abs( temp_mmtsb - temp0 ) <= TEN_TO_MINUS3 ) then
- ! no exchange, continue at the same reference temp.
- mmtsb_is_exchanged = .false.
- write(6,'(a,i8,a,f12.4)') &
- 'MMTSB Replica Exchange temperature unchanged'
- else
- ! exchange temp via changing the reference temp.
- ! the velocities will be randomly reset at the new temp via
- ! the resetvelo variable.
- mmtsb_is_exchanged = .true.
- write(6,'(a,f8.2,a,f8.2)') &
- 'MMTSB Replica Exchange temperature change from ', &
- temp0, ' to ', temp_mmtsb
- temp0 = temp_mmtsb
- end if
- else if ( mmtsb_switch == mmtsb_lambda_rex ) then
- if ( abs( lambda_mmtsb - clambda ) <= TEN_TO_MINUS3 ) then
- ! no exchange, continue at the same lambda
- mmtsb_is_exchanged = .false.
- write(6,'(a,i8,a,f12.4)') &
- 'MMTSB Replica Exchange lambda unchanged'
- else
- ! exchange lambda
- ! the velocities will be randomly reset via
- ! the resetvelo variable.
- mmtsb_is_exchanged = .true.
- write(6,'(a,f8.2,a,f8.2)') &
- 'MMTSB Replica Exchange lambda change from ', &
- clambda, ' to ', lambda_mmtsb
- clambda = lambda_mmtsb
- end if
- end if ! ( mmtsb_switch == mmtsb_temp_rex )
- else
- ! not a replica exchange update iteration.
- mmtsb_is_exchanged = .false.
- end if ! ( mod( nstep, mmtsb_iterations ) == 0 )
- end if ! ( mmtsb_switch /= mmtsb_off )
-#endif
-
-
- call trace_integer( 'end of step', nstep )
- call trace_output_mpi_tally( )
- call timer_stop(TIME_VERLET)
-#if !defined(DISABLE_NCSU) && defined(NCSU_ENABLE_BBMD)
- call ncsu_on_mdstep(ener%pot%tot, v, ekmh)
-#endif /* !defined(DISABLE_NCSU) && defined(NCSU_ENABLE_BBMD) */
-
-#if defined(RISMSANDER) && defined(RISM_DEBUG)
- if(rismprm%irism == 1) then
-!!$ write(6,*) "END OF STEP",natom
-! call calc_cm(x,cm,amass,natom)
- angvel=0
- do m=1,natom
- r = x((m-1)*3+1:(m-1)*3+3)-cm
-!!$ write(6,*) m,v((m-1)*3+1:(m-1)*3+3)
- call cross(r,v((m-1)*3+1:(m-1)*3+3),rxv)
- angvel = angvel + rxv/sum(r**2)
- end do
- moi=0
- erot=0
- do m=1,natom
- r = x((m-1)*3+1:(m-1)*3+3)-cm
- call cross(r,v((m-1)*3+1:(m-1)*3+3),rxv)
- proj = sum(r*angvel)/sum(angvel**2)*angvel
-!!$ write(6,*) "angvel ",angvel
-!!$ write(6,*) "r ",r,sum((r)**2)
-!!$ write(6,*) "proj",proj
-!!$ write(6,*) "r-proj",r-proj,sum((r-proj)**2)
- moi=moi+amass(m)*sum((r-proj)**2)
- erot = erot + .5*amass(m)*sum((r-proj)**2)*sum((rxv/sum(r**2))**2)
- end do
-!!$ write(6,*) moi
-!!$ do m=1,3
-!!$ write(6,*) m,sum(v(m:3*natom:3))
-!!$ write(6,*) m,sum(amass(1:natom)*v(m:3*natom:3))
-!!$ write(6,*) m,angvel(m),sum(angvel**2)
-!!$ end do
-!!$ write(6,*) "EROT", 0.5*moi*sum(angvel**2), erot
-!!$ write(6,*) "EROT", erot
-!!$ call mexit(6,1)
- end if
-#endif /*RISMSANDER && RISM_DEBUG*/
-
- if(abfqmmm_param%abfqmmm == 1) then ! lam81
-#ifdef MPI
- call xdist(v, xx(lfrctmp), natom) ! lam81
-#endif
- abfqmmm_param%v(1:nr3+iscale) = v(1:nr3+iscale) ! lam81
- deallocate(for, stat=ier) ! lam81
- return ! lam81
- end if ! lam81
-
- if (nstep < nstlim) goto 260
- 480 continue
-
-#ifdef MPI
-! ------====== REMD Post-Dynamics ======------
- if(next_rem_method == 1) then
- remd_ekmh=ekmh
-
- ! ---=== HYBRID REMD ===---
- if (numwatkeep>=0) then
- ! This is a hybrid REMD run. Get energy of stripped system for next
- ! exchange.
- call hybrid_remd_ene(xx,ix,ih,ipairs,qsetup, &
- numwatkeep,hybridgb,igb,ntr,nspm,t,temp0, &
- ntb,cut, &
- ener,ener%vir,do_list_update,nstep, &
- nitp,nits,onefac,loutfm )
- else ! numwatkeep>=0
- ! The positions are currently one step ahead of the energy ener%pot%tot,
- ! since force was called prior to the position propagation. Thus, call
- ! force one more time to update ener%pot%tot to reflect the current
- ! coordinates.
- call force(xx,ix,ih,ipairs,x,f,ener,ener%vir, &
- xx(l96),xx(l97),xx(l98),xx(l99), qsetup, &
- do_list_update,nstep)
- endif ! numwatkeep>=0
-
- ! Set myeptot, mytemp, and mytargettemp
-! if (mdloop>0) mytemp = ener%kin%tot * onefac(1)
- my_remd_data%mytemp = ener%kin%tot * onefac(1)
- my_remd_data%myeptot = ener%pot%tot
-
-
- my_remd_data%mytargettemp = temp0
-# ifdef VERBOSE_REMD
- if (master) write(6,'(a,f15.4,2(a,f6.2))') &
- "REMD: myEptot= ",my_remd_data%myeptot," myTargetTemp= ", &
- my_remd_data%mytargettemp," mytemp= ",my_remd_data%mytemp
-# endif
-# ifdef LES
- else if(next_rem_method == 2 ) then
- my_remd_data%mytemp = ener%kin%solv * onefac(3)
- my_remd_data%myeptot = ener%eptot
- my_remd_data%mytargettemp = temp0les
-# endif
- else if (next_rem_method == 3) then
- remd_ekmh = ekmh
- if (mdloop > 0) my_remd_data%mytemp = ener%kin%tot * onefac(1)
- my_remd_data%mytargettemp = temp0
-! Call force here to bring all energies up-to-date
- call force(xx,ix,ih,ipairs,x,f,ener,ener%vir,xx(l96),xx(l97),xx(l98), &
- xx(l99),qsetup,do_list_update)
-
- my_remd_data%myeptot = ener%pot%tot
-
-! Call nmrdcp to decrement the NMR counter, since this should not count as
-! a real step (JMS 2/12). This is OK, since the counter got incremented at
-! the _very_ end of nmrcal, so we haven't already printed an unwanted value
- if (nmropt /= 0) call nmrdcp
-! Call xdist such that master has all the velocities(DSD 09/12)
- call xdist(v, xx(lfrctmp), natom)
-
- else if (next_rem_method == 4) then
- remd_ekmh = ekmh
-
- endif ! rem == 1
-! ------====== END REMD Post-Dynamics ======------
-#endif /* MPI */
-
- !=======================================================================
- ! ----- PRINT AVERAGES -----
- !=======================================================================
-
-# ifdef MPI
- ! -- ti decomp
- if (icfe /= 0 .and. idecomp /= 0) then
- if( idecomp == 1 .or. idecomp == 2 ) then
- call collect_dec(nrs)
- !else if( idecomp == 3 .or. idecomp == 4 ) then
- ! call collect_dec(npdec*npdec)
- end if
- end if
-
- ! Turn off avg. for REMD. and explicit solvent CpHMD, since it's not
- ! accumulated correctly in that case for each compiler
- if (master.and.rem == 0) then
-# else
- if (master) then
-# endif /*MPI*/
- tspan = nvalid
- if (nvalid > 0) then
-
- ! Update all elements of these sequence types
- enert = enert/tspan
- enert2 = enert2/tspan - enert*enert
- call zero_neg_values_state(enert2)
- enert2 = sqrt(enert2)
- edvdl = edvdl/tspan
-
- ! for PIMD/NMPIMD/CMD/RPMD averages
- if (ipimd>0) then
- totenert = totenert/tspan
- totenert2 = totenert2/tspan - (totenert*totenert)
- call zero_neg_values_state(totenert2)
- totenert2 = sqrt(totenert2)
- endif
-
-#ifdef MPI
- if( ievb /= 0 ) then
- evb_nrg_ave(:) = evb_nrg_ave(:) / tspan
- evb_nrg_rms(:) = evb_nrg_rms(:) / tspan - evb_nrg_ave(:)**2
- evb_nrg_rms(:) = max( evb_nrg_rms(:), 0.0d0 )
- evb_nrg_rms(:) = sqrt( evb_nrg_rms(:) )
- endif
- if ( ifsc /= 0 ) then
- do m = 1,ti_ene_cnt
- sc_ener_ave(m) = sc_ener_ave(m)/tspan
- sc_ener_rms(m) = sc_ener_rms(m)/tspan - sc_ener_ave(m)**2
- if(sc_ener_rms(m) < 0.0d0) sc_ener_rms(m) = 0.0d0
- sc_ener_rms(m) = sqrt(sc_ener_rms(m))
- end do
- end if
- if( ievb /= 0 ) evb_frc%evb_ave = .true.
-#endif
- write(6,540) nvalid
- call prntmd(total_nstep,izero,izero,t,enert,onefac,0,.false.)
-#ifdef MPI /* SOFT CORE */
- if (ifsc /= 0) call sc_print_energies(6, sc_ener_ave)
- if( ievb /= 0 ) evb_frc%evb_rms = .true.
- if ( ipimd > 0 .and. worldrank==0 ) then
- write(pimd_unit,540) nvalid
- call pimd_report(nstep,t,pimd_unit,totenert,onefac)
- write(pimd_unit,550)
- call pimd_report(nstep,t,pimd_unit,totenert2,onefac)
- endif
-#endif
- if (nmropt > 0) call nmrptx(6)
- write(6,550)
- call prntmd(total_nstep,izero,izero,t,enert2,onefac,0,.true.)
-
-#ifdef MPI
- if (ifsc /= 0) call sc_print_energies(6, sc_ener_rms)
- if (ifsc /= 0) call sc_print_dvdl_values()
-
- if( icfe > 0 ) then
- write(6,541) nvalid
- edvdl%pot%dvdl = enert%pot%dvdl ! fix for DV/DL output
- edvdl%virvsene = 0.d0 ! virvsene should not but included here
- call prntmd(total_nstep,izero,izero,t,edvdl,onefac,0,.false.)
- ! -- ti decomp
- if(worldrank == 0 .and. idecomp /= 0) then
- call checkdec(idecomp)
- if(idecomp == 1 .or. idecomp == 2) call printdec(ix)
- end if
- end if
-#endif
-
- if (nmropt >= 1) then
- write(6,500)
- if (iredir(7) /= 0) call pcshift(-1,x,f)
- call ndvptx(x,f,ih(m04),ih(m02),ix(i02),nres,xx(l95), &
- natom, xx(lwinv),ntb,xx(lnmr01),ix(inmr02),6)
- end if
-
- ! Print Born radii statistics
-
- if ((rbornstat == 1).and.(igb /= 0 .or. ipb /= 0)) then
-
- ! Born radii stats collected every nrespai step not nrespa step
- tspan = nvalidi
-
- write(6,580) nstep
- write(6,590)
- do m = 1,natom
- xx(l188-1+m) = xx(l188-1+m)/tspan
- xx(l189-1+m) = xx(l189-1+m)/tspan - &
- xx(l188-1+m)*xx(l188-1+m)
- xx(l189-1+m) = sqrt(xx(l189-1+m))
- write(6,600) m, xx(l186-1+m), xx(l187-1+m), &
- xx(l188-1+m), xx(l189-1+m)
- end do
- end if
-
- enert%kin%tot = enert%kin%tot*onefac(1)
- enert2%kin%tot = enert2%kin%tot*onefac(1)
- enert%kin%solt = enert%kin%solt*onefac(2)
- enert2%kin%solt = enert2%kin%solt*onefac(2)
- enert%kin%solv = enert%kin%solv*onefac(3)
- enert2%kin%solv = enert2%kin%solv*onefac(3)
-
- temp = enert%kin%tot
- end if ! (nvalid > 0)
-
- if (ntp > 0 .and. barostat == 2) call mcbar_summary
-
- end if ! (master)
-
-#ifdef MPI
- if( ievb /= 0 ) then
- call evb_dealloc
-#if defined(LES)
- if( master ) call evb_pimd_dealloc
-#endif
- endif
-#endif
-
- if( icfe /= 0 ) then
- deallocate( frcti, stat = ier )
- REQUIRE( ier == 0 )
- end if
-
- 500 format(/,' NMR restraints on final step:'/)
- 540 format(/5x,' A V E R A G E S O V E R ',i7,' S T E P S',/)
- 541 format(/5x,' DV/DL, AVERAGES OVER ',i7,' STEPS',/)
- 542 format('|',79('='))
- 550 format(/5x,' R M S F L U C T U A T I O N S',/)
- 580 format('STATISTICS OF EFFECTIVE BORN RADII OVER ',i7,' STEPS')
- 590 format('ATOMNUM MAX RAD MIN RAD AVE RAD FLUCT')
- 600 format(i4,2x,4f12.4)
- call trace_exit( 'runmd' )
- return
-end subroutine runmd
-
-!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-!+ Stripped-down runmd routine for running relaxation dynamics on a given mask
-subroutine relaxmd(xx,ix,ih,ipairs,x,winv,amass,f, &
- v,vold,xr,xc,conp,skip,nsp,tma,erstop, qsetup, &
- relax_nstlim, mobile_atoms, increment_nmropt)
-
- ! Runmd operates in kcal/mol units for energy, amu for masses,
- ! and angstroms for distances. To convert the input time parameters
- ! from picoseconds to internal units, multiply by 20.455
- ! (which is 10.0*sqrt(4.184)).
-
- use bintraj, only: end_binary_frame
- use barostats, only : mcbar_trial
- use constants, only : third, ten_to_minus3
- use crg_reloc, only: ifcr, crprintcharges, cr_print_charge
- use fastwt
- use file_io_dat
- use molecule, only: n_iwrap_mask_atoms, iwrap_mask_atoms
- use nblist,only: fill_tranvec,volume,oldrecip,ucell
- use qmmm_module, only : qmmm_nml,qmmm_struct, qmmm_mpi, qm2_struct, &
- qmmm_vsolv
- use stack
- use state
- use trace
-
-! Variable Descriptions
-!
-! Passed variables
-! xx : global real array. See locmem.f for structure/pointers
-! ix : global integer array. See locmem.f for structure/pointers
-! ih : global hollerith array. See locmem.f for structure/pointers
-! ipairs : ?? Global pairlist ?? --add description (JMS 11/2010)
-! x : global position array *
-! winv : array with inverse masses *
-! amass : mass array *
-! f : force array, used to hold old coordinates temporarily, too
-! v : velocity array
-! vold : old velocity array, from the previous step
-! xr : coordinates with respect to COM of molecule
-! conp : bond parameters for SHAKE
-! skip : logical skip array for SHAKE (and QM/MM too, I think)
-! nsp : submolecule index array (?)
-! tma : submolecular weight array (?)
-! erstop : should we stop in error (?)
-! qsetup : Not quite sure what this does, if anything anymore.
-! mobile_atoms: bellymask-style array with 1s for moving atoms and 0s for
-! frozen atoms
-! relax_nstlim: Number of relaxation dynamics steps to run
-! increment_nmropt: Do we allow the nmropt counter to increment?
-!
-! Local variables
-! factt : degree-of-freedom correction factor for temperature scaling
-! nr : local copy of nrp, number of atoms
-! nr3 : 3 * nr, used for runtime efficiency
-!
-! Common memory variables
-! nrp : number of atoms, adjusted for LES copies
-
- implicit none
- character(kind=1,len=7) :: routine="relaxmd"
- integer ipairs(*), ix(*), relax_nstlim
- integer, intent(in) :: mobile_atoms(*)
- logical, intent(in) :: increment_nmropt
- _REAL_ xx(*)
- character(len=4) ih(*)
- _REAL_ combination
-
-#ifdef MPI
-# include "parallel.h"
- include 'mpif.h'
- _REAL_ mpitmp(8) !Use for temporary packing of mpi messages.
- integer ist(MPI_STATUS_SIZE), partner, ierr
-#else
- ! mdloop and REM is always 0 in serial
- integer, parameter :: mdloop = 0, rem = 0
-#endif
-
-#include "../include/md.h"
-#include "box.h"
-#include "nmr.h"
-#include "../include/memory.h"
-#include "extra.h"
-#include "ew_frc.h"
-#include "ew_cntrl.h"
-#include "ew_mpole.h"
-#include "def_time.h"
-#include "extra_pts.h"
-#include "../lib/random.h"
-
- _REAL_ sysx,sysy,sysz,sysrange(3,2)
- logical mv_flag
-
- _REAL_ , dimension(1) :: shkh
- integer, dimension(1) :: ifstwr2
- integer :: nshkh
-
- integer idx, iatom, iatomCL,m
- _REAL_ Ekin2_tot,tmp,f_lnv
- integer :: idim, ithermo
- _REAL_ :: E_nhc, exp1, exp2, v_sum
-
- logical ivscm
- logical qspatial
- character(len=6)fnam
-
- logical resetvelo
- integer nshak
- _REAL_ ekgs,eold3,eold4,etot_save,ekpbs
-
- logical do_list_update
- logical skip(*),lout,loutfm,erstop,vlim,onstep
- _REAL_ x(*),winv(*),amass(*),f(*),v(*),vold(*), &
- xr(*),xc(*),conp(*)
- type(state_rec) :: ener
- type(state_rec) :: ecopy, edvdl
- type(state_rec) :: edvdl_r
- _REAL_ rmu(3),fac(3),onefac(3),clfac, etot_start
- _REAL_ tma(*)
-
- _REAL_ tspan,atempdrop,fln,scaltp,scaltpo
- _REAL_ vel,vel2,vcmx,vcmy,vcmz,vmax,vx,vy,vz
- _REAL_ winf,aamass,rterm,ekmh,ekph,ekpht,wfac,rsd,ekav
- _REAL_ fit,fiti,fit2,vscalt
- logical is_langevin ! Is this a Langevin dynamics simulation
- _REAL_ gammai,c_implic,c_explic,c_ave,sdfac,ekins0
- _REAL_ dtx,dtxinv,dt5,factt,ekin0,ekinp0,dtcp,dttp
- _REAL_ rndf,rndfs,rndfp,boltz2,pconv,tempsu
- _REAL_ xcm(3),acm(3),ocm(3),vcm(3),ekcm,ekrot
- _REAL_ emtmd
-
-! Variables and parameters for constant surface tension:
- _REAL_, parameter :: ten_conv = 100.0d0 !ten_conv - converts
- !dyne/cm to bar angstroms
- _REAL_ :: pres0x
- _REAL_ :: pres0y
- _REAL_ :: pres0z
- _REAL_ :: gamma_ten_int
- _REAL_ :: press_tan_ave
-
- integer nsp(*)
- integer idumar(4)
- integer l_temp
- integer i,j,im,i3,nitp,nits
- integer nstep,nrep,nrek,nren,iend,istart3,iend3
- integer nrx,nr,nr3,ntcmt,izero,istart
- logical qsetup
-
- integer nvalid, nvalidi
- _REAL_ eke,eket
- _REAL_ extent
-
- _REAL_ xcen,ycen,zcen,extents(3,2)
- _REAL_, allocatable, dimension(:) :: frcti
- integer ier
-
- _REAL_ small
- data small/1.0d-7/
- data nren/51/
-
- !--- VARIABLES FOR DIPOLE PRINTING ---
- integer prndipngrp
- integer prndipfind
- character(len=4) prndiptest
-
- _REAL_,parameter :: pressure_constant = 6.85695d+4
- ! variables used in constant pressure PIMD
- _REAL_ :: Nkt,centvir,pressure, aa, arg2, poly, e2, e4, e6, e8
- ! variable used in CMD
- real(8) :: tmp_eke_cmd !Use for temporary packing of mpi messages.
-
- _REAL_ :: box_center(3)
-
- !==========================================================================
-
- call trace_enter( 'relaxmd' )
-
- ! ----- INITIALIZE SOME VARIABLES -----
-
- vlim = vlimit > small
- ntcmt = 0
- izero = 0
- lout = .true.
- loutfm = ioutfm <= 0
- nr = natom
- nr3 = 3*nr
- ekmh = 0.d0
- onstep = .true.
-
- do_list_update=.false.
-#ifdef MPI
- istart = iparpt(mytaskid) + 1
- iend = iparpt(mytaskid+1)
-#else
- istart = 1
- iend = nr
-#endif
- istart3 = 3*istart -2
- iend3 = 3*iend
-
- ! If NTWPRT.NE.0, only print the atoms up to this value
- nrx = nr3
- if (ntwprt > 0) nrx = ntwprt*3
-
- !=======================================================================
- ! Determine system degrees of freedom (for T scaling, reporting)
-
- ! Call DEGCNT to get the actual number of degrees of freedom for the
- ! solute and solvent. The 'belly' atoms are just the mobile ones
-
- call degcnt(1,nr,mobile_atoms,nsolut,nbonh,nbona,0, &
- ix(iibh),ix(ijbh),ix(iiba),ix(ijba),idumar, &
- idumar,ntc,idumar,0,0,0, &
- idumar,rndfp,rndfs)
-
- ! RNDFP = # degrees of freedom for solute
- ! RNDFS = # degrees of freedom for solvent
- ! RNDF = total number of degrees of freedom.
-
- ! qtw - substract the number of overlapping noshake QM atoms in noshakemask
- rndfp = rndfp - qmmm_struct%noshake_overlap
- ! modify RNDFP to reflect NDFMIN (set in mdread) and num_noshake
- rndfp = rndfp - ndfmin + num_noshake
- rndf = rndfp+rndfs
-
- call fix_degree_count(rndf) ! correct for extra points
-
- ! End of degrees of freedom stuff
- !=======================================================================
-
- boltz2 = 8.31441d-3 * 0.5d0
- pconv = 1.6604345d+04 ! factor to convert the pressure kcal/mole to bar
-
- ! ---convert to kcal/mol units
-
- boltz2 = boltz2/4.184d0 ! k-sub-B/2
- dtx = dt*20.455d+00
- dtxinv = 1.0d0 / dtx
- dt5 = dtx * 0.5d0
- pconv = pconv*4.184d0
-
- ! FAC() are #deg freedom * kboltz / 2
- ! multiply by T to get expected kinetic energy
- ! FAC(1) is for total system
-
- fac(1) = boltz2*rndf
- fac(2) = boltz2*rndfp
-
- if(rndfp < 0.1d0) fac(2) = 1.d-6
-
- fac(3) = boltz2*rndfs
- if(rndfs < 0.1d0) fac(3) = 1.d-6
- onefac(1) = 1.0d0/fac(1)
- onefac(2) = 1.0d0/fac(2)
- onefac(3) = 1.0d0/fac(3)
- factt = rndf/(rndf+ndfmin)
-
- ! these are "desired" kinetic energies based on
- ! # degrees freedom and target temperature
- ! they will be used for calculating the velocity scaling factor
-
- ekinp0 = fac(2)*temp0
- ekins0 = fac(3)*temp0
- ekin0 = fac(1)*temp0
-
- ! Langevin dynamics setup:
-
- is_langevin = gamma_ln > 0.0d0
- gammai = gamma_ln/20.455d0
- c_implic = 1.d0/(1.d0+gammai*dt5)
- c_explic = 1.d0 - gammai*dt5
- c_ave = 1.d0+gammai*dt5
- sdfac = sqrt( 4.d0*gammai*boltz2*temp0/dtx )
- if (is_langevin .and. ifbox==0) then
- call get_position(nr,x,sysx,sysy,sysz,sysrange,0)
- end if
- if (ntt == 1) dttp = dt/tautp
- if (ntp > 0) dtcp = comp * 1.0d-06 * dt / taup
-
- ! Constant surface tension setup:
-
- if (csurften > 0) then
-
- ! Set pres0 in direction of surface tension.
- ! The reference pressure is held constant in on direction dependent
- ! on what the surface tension direction is set to.
- if (csurften .eq. 1) then ! pres0 in the x direction
- pres0x = pres0
-
- else if (csurften .eq. 2) then ! pres0 in the y direction
- pres0y = pres0
-
- !else if (csurften .eq. 3) then ! pres0 in the z direction
- else
- pres0z = pres0
-
- end if
-
- ! Multiply surface tension by the number of interfaces
- gamma_ten_int = dble(ninterface) * gamma_ten
-
- end if
-
- nrek = 4
- nrep = 15
-
- nvalid = 0
- nvalidi = 0
- nstep = 0
- fit = 0.d0
- fiti = 0.d0
- fit2 = 0.d0
-
- ener = null_state_rec ! Zeros all elements
- ener%kin%pres_scale_solt = 1.d0
- ener%kin%pres_scale_solv = 1.d0
- ener%box(1:3) = box(1:3)
- ener%cmt(1:4) = 0.d0
- nitp = 0
- nits = 0
-
- ekmh = 0.0d0
-
- i3 = 0
- do j = 1,nrp
- aamass = amass(j)
- do m = 1,3
- i3 = i3+1
- rterm = v(i3)*v(i3) * aamass
- ekmh = ekmh + rterm
- end do
- end do
-
- do im=1,iscale
- ekmh = ekmh + scalm*v(nr3+im)*v(nr3+im)
- end do
- ekmh = ekmh * 0.5d0
- do i=1,nr3+iscale
- vold(i) = v(i)
- end do
-
- !=======================================================================
- ! ----- MAIN LOOP FOR PERFORMING THE DYNAMICS STEP -----
- ! (at this point, the coordinates are a half-step "ahead"
- ! of the velocities; the variable EKMH holds the kinetic
- ! energy at these "-1/2" velocities, which are stored in
- ! the array VOLD.)
- !=======================================================================
-
- 260 continue
-
- !---------------------------------------------------------------
- ! ---Step 1a: do some setup for pressure calculations:
- !---------------------------------------------------------------
-
- if (ntp > 0) then
- ener%cmt(1:3) = 0.d0
- xr(1:nr3) = x(1:nr3)
-
- ! ----- CALCULATE THE CENTER OF MASS ENERGY AND THE COORDINATES
- ! OF THE SUB-MOLECULES WITH RESPECT TO ITS OWN CENTER OF
- ! MASS -----
-
- call timer_start(TIME_EKCMR)
- call ekcmr(nspm,nsp,tma,ener%cmt,xr,v,amass,istart,iend)
-#ifdef MPI
- call trace_mpi('mpi_allreduce', &
- 3,'MPI_DOUBLE_PRECISION',mpi_sum)
-# ifdef USE_MPI_IN_PLACE
- call mpi_allreduce(MPI_IN_PLACE,ener%cmt,3, &
- MPI_DOUBLE_PRECISION,mpi_sum,commsander,ierr)
-# else
- call mpi_allreduce(ener%cmt,mpitmp,3, &
- MPI_DOUBLE_PRECISION,mpi_sum,commsander,ierr)
- ener%cmt(1:3) = mpitmp(1:3)
-# endif
-#endif
- call timer_stop(TIME_EKCMR)
- end if
-
- ! If we're using the MC barostat, go ahead and do the trial move now
- if (ntp > 0 .and. barostat == 2 .and. mod(nstep+1, mcbarint) == 0) &
- call mcbar_trial(xx, ix, ih, ipairs, x, xc, f, ener%vir, xx(l96), &
- xx(l97), xx(l98), xx(l99), qsetup, do_list_update, nstep, nsp, &
- amass)
-
- !--------------------------------------------------------------
- ! ---Step 1b: Get the forces for the current coordinates:
- !--------------------------------------------------------------
-
- iprint = 0
- if( nstep == 0 .or. nstep+1 == relax_nstlim ) iprint = 1
-
- call force(xx,ix,ih,ipairs,x,f,ener,ener%vir, &
- xx(l96),xx(l97),xx(l98),xx(l99), qsetup, &
- do_list_update,nstep)
-
- ! If we don't want to increment the NMROPT counter, decrement it here.
- if (.not. increment_nmropt) &
- call nmrdcp
-
- ! Reset quantities depending on TEMP0 and TAUTP (which may have been
- ! changed by MODWT during FORCE call).
- ekinp0 = fac(2)*temp0
- ekins0 = fac(3)*temp0
- ekin0 = fac(1)*temp0
-
- if (ntt == 1) dttp = dt/tautp
-
- if (ntp > 0) then
- ener%volume = volume
- ener%density = tmass / (0.602204d0*volume)
- ener%cmt(4) = 0.d0
- ener%vir(4) = 0.d0
- ener%pres(4) = 0.d0
- do m = 1,3
- ener%cmt(m) = ener%cmt(m)*0.5d0
- ener%cmt(4) = ener%cmt(4)+ener%cmt(m)
- ener%vir(4) = ener%vir(4)+ener%vir(m)
- ener%pres(m) = (pconv+pconv)*(ener%cmt(m)-ener%vir(m))/volume
- ener%pres(4) = ener%pres(4)+ener%pres(m)
- end do
- ener%pres(4) = ener%pres(4)/3.d0
-
- ! Constant surface tension output:
-
- if (csurften > 0) then
-
- if (csurften == 1) then ! Surface tension in the x direction
- ener%surface_ten = &
- box(1) * (ener%pres(1) - 0.5d0 * &
- (ener%pres(2) + ener%pres(3))) / (ninterface * ten_conv)
-
- else if (csurften .eq. 2) then ! Surface tension in the y direction
- ener%surface_ten = &
- box(2) * (ener%pres(2) - 0.5d0 * &
- (ener%pres(1) + ener%pres(3))) / (ninterface * ten_conv)
-
- else ! if (csurften .eq. 3) then ! Surface tension in the z direction
- ener%surface_ten = &
- box(3) * (ener%pres(3) - 0.5d0 * &
- (ener%pres(1) + ener%pres(2))) / (ninterface * ten_conv )
-
- end if
-
- end if
-
- end if
-
- !----------------------------------------------------------------
- ! ---Step 1c: do randomization of velocities, if needed:
- !----------------------------------------------------------------
- ! ---Assign new random velocities every Vrand steps, if ntt=2
-
- resetvelo=.false.
- if (vrand /= 0 .and. ntt == 2) then
- if (mod((nstep+1),vrand) == 0) resetvelo=.true.
- end if
-
- if (resetvelo) then
- ! DAN ROE: Why are only the masters doing this? Even if the velocities
- ! are broadcast to the child processes, the wont the different # of random
- ! calls put the randomg num generators out of sync, or do we not care?
-
- if (master) then
-! write (6,'(a,i8)') 'Setting new random velocities at step ', &
-! nstep + 1
- call setvel(nr,v,winv,temp0*factt,init,iscale,scalm)
- end if
-
-# ifdef MPI
- call trace_mpi('mpi_bcast',3*natom,'MPI_DOUBLE_PRECISION',0)
- call mpi_bcast(v, 3*natom, MPI_DOUBLE_PRECISION, 0, commsander, ierr)
-# endif
-
- ! At this point in the code, the velocities lag the positions
- ! by half a timestep. If we intend for the velocities to be drawn
- ! from a Maxwell distribution at the timepoint where the positions and
- ! velocities are synchronized, we have to correct these newly
- ! redrawn velocities by backing them up half a step using the
- ! current force.
- ! Note that this fix only works for Newtonian dynamics.
- if( gammai==0.d0 ) then
- i3 = 3*(istart-1)
- do j=istart,iend
- wfac = winv(j) * dt5
- v(i3+1) = v(i3+1) - f(i3+1)*wfac
- v(i3+2) = v(i3+2) - f(i3+2)*wfac
- v(i3+3) = v(i3+3) - f(i3+3)*wfac
- i3 = i3+3
- end do
- end if
-
- end if ! (resetvelo)
-
- call timer_start(TIME_VERLET)
-
- !-----------------------------------------------------
- ! ---Step 2: Do the velocity update:
- !-----------------------------------------------------
-
- !step 2a: apply quenched MD if needed. This is useful in NEB>0
- if (vv==1) call quench(f,v)
-
- if( gammai == 0.d0 ) then
-
- ! ---Newtonian dynamics:
-
- i3 = 3*(istart-1)
- do j=istart,iend
- wfac = winv(j) * dtx
- v(i3+1) = v(i3+1) + f(i3+1)*wfac
- v(i3+2) = v(i3+2) + f(i3+2)*wfac
- v(i3+3) = v(i3+3) + f(i3+3)*wfac
- i3 = i3+3
- end do
-
- else ! gamma_ln .ne. 0, which also implies ntt=3 (see mdread.f)
-
- ! ---simple model for Langevin dynamics, basically taken from
- ! Loncharich, Brooks and Pastor, Biopolymers 32:523-535 (1992),
- ! Eq. 11. (Note that the first term on the rhs of Eq. 11b
- ! should not be there.)
-
- ! Update Langevin parameters, since temp0 might have changed:
- sdfac = sqrt( 4.d0*gammai*boltz2*temp0/dtx )
-
- i3 = 3*(istart-1)
-
- if (no_ntt3_sync == 1) then
- !We don't worry about synchronizing the random number stream
- !across processors.
- do j=istart,iend
-
- wfac = winv(j) * dtx
- aamass = amass(j)
- rsd = sdfac*sqrt(aamass)
- call gauss( 0.d0, rsd, fln )
- v(i3+1) = (v(i3+1)*c_explic + (f(i3+1)+fln)*wfac) * c_implic
- call gauss( 0.d0, rsd, fln )
- v(i3+2) = (v(i3+2)*c_explic + (f(i3+2)+fln)*wfac) * c_implic
- call gauss( 0.d0, rsd, fln )
- v(i3+3) = (v(i3+3)*c_explic + (f(i3+3)+fln)*wfac) * c_implic
- i3 = i3+3
- end do
-
- else
-
- do j=1,nr
- if( j<istart .or. j>iend ) then
- ! In order to generate the same sequence of pseudorandom numbers that
- ! you would using a single processor you have to go through the atoms
- ! in order. The unused results are thrown away
- call gauss( 0.d0, 1.d0, fln )
- call gauss( 0.d0, 1.d0, fln )
- call gauss( 0.d0, 1.d0, fln )
- cycle
- end if
-
- wfac = winv(j) * dtx
- aamass = amass(j)
- rsd = sdfac*sqrt(aamass)
- call gauss( 0.d0, rsd, fln )
- v(i3+1) = (v(i3+1)*c_explic + (f(i3+1)+fln)*wfac) * c_implic
- call gauss( 0.d0, rsd, fln )
- v(i3+2) = (v(i3+2)*c_explic + (f(i3+2)+fln)*wfac) * c_implic
- call gauss( 0.d0, rsd, fln )
- v(i3+3) = (v(i3+3)*c_explic + (f(i3+3)+fln)*wfac) * c_implic
- i3 = i3+3
- end do
- end if ! no_ntt3_sync
-
- end if ! ( gammai == 0.d0 )
-
- if (vlim) then
- vmax = 0.0d0
- do i=istart3,iend3
- vmax = max(vmax,abs(v(i)))
- v(i) = sign(min(abs(v(i)),vlimit),v(i))
- end do
-
- ! Only violations on the master node are actually reported
- ! to avoid both MPI communication and non-master writes.
- if (vmax > vlimit) then
- if (master) then
- write(6,'(a,i6,a,f10.4)') 'vlimit exceeded for step ',nstep, &
- '; vmax = ',vmax
- end if
- end if
- end if
-
- do im=1,iscale
- v(nr3+im) = (v(nr3+im) + f(nr3+im)*dtx/scalm)
- end do
-
- !-------------------------------------------------------------------
- ! Step 3: update the positions, putting the "old" positions into F:
- !-------------------------------------------------------------------
-
- i = istart - 1
- do i3 = istart3, iend3, 3
- f(i3 ) = x(i3 )
- f(i3+1) = x(i3+1)
- f(i3+2) = x(i3+2)
- if (mobile_atoms(i) == 1) then
- x(i3 ) = x(i3 ) + v(i3 )*dtx
- x(i3+1) = x(i3+1) + v(i3+1)*dtx
- x(i3+2) = x(i3+2) + v(i3+2)*dtx
- end if
- i = i + 1
- end do
-
- do i = 1,iscale
- f(nr3+i) = x(nr3+i)
- x(nr3+i) = x(nr3+i)+v(nr3+i)*dtx
- end do
-
- call timer_stop(TIME_VERLET)
-
- if (ntc /= 1) then
-
- !-------------------------------------------------------------------
- ! Step 4a: if shake is being used, update the new positions to fix
- ! the bond lengths.
- !-------------------------------------------------------------------
-
- call timer_start(TIME_SHAKE)
- qspatial=.false.
- call shake(nrp,nbonh,nbona,0,ix(iibh),ix(ijbh),ix(ibellygp), &
- winv,conp,skip,f,x,nitp,.false.,ix(iifstwt),ix(noshake), &
- shkh,qspatial)
- call quick3(f,x,ix(iifstwr),natom,nres,ix(i02))
- if(nitp == 0) then
- erstop = .true.
- goto 480
- end if
-
- !-----------------------------------------------------------------
- ! Step 4b: Now fix the velocities and calculate KE
- !-----------------------------------------------------------------
-
- ! ---re-estimate the velocities from differences in positions:
-
- v(istart3:iend3) = (x(istart3:iend3)-f(istart3:iend3)) * dtxinv
-
- call timer_stop(TIME_SHAKE)
- end if
- call timer_start(TIME_VERLET)
-
- if( ntt == 1 .or. onstep ) then
-
- !-----------------------------------------------------------------
- ! Step 4c: get the KE, either for averaging or for Berendsen:
- !-----------------------------------------------------------------
-
- eke = 0.d0
- ekph = 0.d0
- ekpbs = 0.d0
-
- if (gammai == 0.0d0) then
- i3 = 3*(istart-1)
- do j=istart,iend
- aamass = amass(j)
- do m = 1,3
- i3 = i3+1
- eke = eke + aamass*0.25d0*(v(i3)+vold(i3))**2
-
- ! try pseudo KE from Eq. 4.7b of Pastor, Brooks & Szabo,
- ! Mol. Phys. 65, 1409-1419 (1988):
-
- ekpbs = ekpbs + aamass*v(i3)*vold(i3)
- ekph = ekph + aamass*v(i3)**2
-
- end do
- end do
-
- else
-
- i3 = 3*(istart-1)
- do j=istart,iend
- aamass = amass(j)
- do m = 1,3
- i3 = i3+1
- eke = eke + aamass*0.25d0*c_ave*(v(i3)+vold(i3))**2
- end do
-
- end do
-
- end if ! (if gammai == 0.0d0)
-
-#ifdef MPI
- ! --- sum up the partial kinetic energies:
-
- if ( numtasks > 1 ) then
- call trace_mpi('mpi_allreduce', &
- 1,'MPI_DOUBLE_PRECISION',mpi_sum)
- mpitmp(1) = eke
- mpitmp(2) = ekph
- mpitmp(3) = ekpbs
-# ifdef USE_MPI_IN_PLACE
- call mpi_allreduce(MPI_IN_PLACE,mpitmp,3, &
- MPI_DOUBLE_PRECISION,mpi_sum,commsander,ierr)
- eke = mpitmp(1)
- ekph = mpitmp(2)
- ekpbs = mpitmp(3)
-
-# else /* USE_MPI_IN_PLACE */
-
- call mpi_allreduce(mpitmp,mpitmp(4),3, &
- MPI_DOUBLE_PRECISION,mpi_sum,commsander,ierr)
- eke = mpitmp(4)
- ekph = mpitmp(5)
- ekpbs = mpitmp(6)
-
-# endif /* USE_MPI_IN_PLACE */
- end if
-#endif /* MPI */
-
- ! --- all processors handle the "extra" variables:
-
- do im=1,iscale
- eke = eke + scalm*0.25d0*(v(nr3+im)+vold(nr3+im))**2
- ekpbs = ekpbs + scalm*v(nr3+im)*vold(nr3+im)
- ekph = ekph + scalm*v(nr3+im)**2
- end do
-
- eke = eke * 0.5d0
- ekph = ekph * 0.5d0
- ekpbs = ekpbs * 0.5d0
- if( ntt == 1 ) then
-
- ! --- following is from T.E. Cheatham, III and B.R. Brooks,
- ! Theor. Chem. Acc. 99:279, 1998.
-
- scaltp = sqrt(1.d0 + 2.d0*dttp*(ekin0-eke)/(ekmh+ekph))
-
- ! --- following is the "old" (amber7 and before) method:
-
- ! scaltpo = sqrt(1.d0 + dttp*(ekin0/ekph - 1.d0))
- ! write(6,*) 'scaltp: ',2.d0*dttp*(ekin0-eke)/(ekmh+ekph), &
- ! dttp*(ekin0/ekmh - 1.d0)
-
- ! following line reverts to the "old" behavior:
- ! scaltp = scaltpo
-
- do j = istart,iend
- i3=(j-1)*3+1
- v(i3 ) = v(i3 ) *scaltp
- v(i3+1) = v(i3+1) *scaltp
- v(i3+2) = v(i3+2) *scaltp
- end do
- do im=1,iscale
- v(nr3+im) = v(nr3+im)*scaltp
- end do
- end if ! (ntt == 1 )
-
- end if ! ( ntt == 1 .or. onstep; end of step 4c )
-
- !-----------------------------------------------------------------
- ! Step 5: several tasks related to dumping of trajectory information
- !-----------------------------------------------------------------
-
- ! --- Determine if trajectory, velocity, or restart
- ! writing is imminent, or if the center of mass
- ! motion will be removed.
- ! These require xdist of velocities or dipoles in parallel runs:
- !
- ! Modified so that when running REMD, writing can occur less often
- ! than exchanges (e.g. ntwx > nstlim)
- ! DAN ROE: Added two new variables, total_nstep and total_nstlim.
- ! For non-REMD runs, total_nstep=nstep+1 and total_nstlim=nstlim
- ! just like before.
- ! For REMD runs, total_nstep=(mdloop-1)*nstlim+nstep+1, where
- ! mdloop is the current exchange - this is the current
- ! replica exchange MD step. total_nstlim=numexchg*nstlim, which is
- ! the maximum number of REMD steps.
-
-#ifdef MPI
-
- !-----------------------------------------------------------------
- ! --- now distribute the coordinates, and if necessary, dipoles and vel:
- !-----------------------------------------------------------------
-
- call timer_barrier( commsander )
- call timer_stop_start(TIME_VERLET,TIME_DISTCRD)
- if ( numtasks > 1 ) then
- call xdist(x, xx(lfrctmp), natom)
- end if
- call timer_stop(TIME_DISTCRD)
-
-#endif /* MPI */
-
- ! ----fix lone pair positions:
- if( numextra > 0 )call local_to_global(x,xx,ix)
-
-#ifdef MPI
- call timer_start(TIME_VERLET)
- ! ========================= END AMBER/MPI =========================
-#endif /* MPI */
-
- !-------------------------------------------------------------------
- ! Step 6: zero COM velocity if requested; used for preventing
- ! ewald "block of ice flying thru space" phenomenon, or accumulation
- ! of rotational momentum in vacuum simulations
- !-------------------------------------------------------------------
-
- !-----------------------------------------------------------------
- ! --- put current velocities into VOLD
- !-----------------------------------------------------------------
-
- vold(istart3:iend3) = v(istart3:iend3)
- do im=1,iscale
- vold(nr3+im) = v(nr3+im)
- end do
-
- !-------------------------------------------------------------------
- ! Step 7: scale coordinates if constant pressure run:
- !-------------------------------------------------------------------
-
- ! ntp = 1, isotropic pressure coupling
-
- if (ntp == 1) then
- rmu(1) = (1.d0-dtcp*(pres0-ener%pres(4)))**third
- rmu(2) = rmu(1)
- rmu(3) = rmu(1)
-
-
- ! ntp = 2, anisotropic pressure scaling
-
- else if (ntp == 2) then
-
- if (csurften > 0) then
-
- ! Constant surface tension adjusts the tangential pressures
- ! See Zhang, Feller, Brooks, Pastor. J. Chem. Phys. 1995
-
- if (csurften == 1) then ! For surface tension in the x direction
- pres0y = pres0x - gamma_ten_int * ten_conv / box(1)
- pres0z = pres0y
-
- else if (csurften == 2) then ! For surface tension in the y direction
- pres0x = pres0y - gamma_ten_int * ten_conv / box(2)
- pres0z = pres0x
-
- !else if (csurften == 3) then ! For surface tension in the z !direction
- else
- pres0x = pres0z - gamma_ten_int * ten_conv / box(3)
- pres0y = pres0x
-
- end if
-
- rmu(1) = (1.d0 - dtcp * (pres0x - ener%pres(1)))**third
- rmu(2) = (1.d0 - dtcp * (pres0y - ener%pres(2)))**third
- rmu(3) = (1.d0 - dtcp * (pres0z - ener%pres(3)))**third
-
- else
-
- rmu(1) = (1.d0-dtcp*(pres0-ener%pres(1)))**third
- rmu(2) = (1.d0-dtcp*(pres0-ener%pres(2)))**third
- rmu(3) = (1.d0-dtcp*(pres0-ener%pres(3)))**third
-
- end if
-
- ! ntp = 3, semiisotropic pressure coupling
- ! (currently only for csurften>0, constant surface tension)
-
- !else if (ntp > 2) then
- else
-
- if (csurften > 0) then
-
- if (csurften == 1) then ! For surface tension in the x direction
- pres0y = pres0x - gamma_ten_int * ten_conv / box(1)
- pres0z = pres0y
- press_tan_ave = (ener%pres(2) + ener%pres(3))/2
- rmu(1) = (1.d0 - dtcp * (pres0x - ener%pres(1)))**third
- rmu(2) = (1.d0 - dtcp * (pres0y - press_tan_ave))**third
- rmu(3) = (1.d0 - dtcp * (pres0z - press_tan_ave))**third
-
- else if (csurften == 2) then ! For surface tension in the y direction
- pres0x = pres0y - gamma_ten_int * ten_conv / box(2)
- pres0z = pres0x
- press_tan_ave = (ener%pres(1) + ener%pres(3))/2
- rmu(1) = (1.d0 - dtcp * (pres0x - press_tan_ave))**third
- rmu(2) = (1.d0 - dtcp * (pres0y - ener%pres(2)))**third
- rmu(3) = (1.d0 - dtcp * (pres0z - press_tan_ave))**third
-
- !else if (csurften == 3) then ! For surface tension in the z !direction
- else
- pres0x = pres0z - gamma_ten_int * ten_conv / box(3)
- pres0y = pres0x
- press_tan_ave = (ener%pres(1) + ener%pres(2))/2
- rmu(1) = (1.d0 - dtcp * (pres0x - press_tan_ave))**third
- rmu(2) = (1.d0 - dtcp * (pres0y - press_tan_ave))**third
- rmu(3) = (1.d0 - dtcp * (pres0z - ener%pres(3)))**third
-
- end if ! csurften == 1
- end if ! csurften > 0
- ! Add semiisotropic pressure scaling in any direction with no constant
- ! surface tension here
- end if
-
- if (ntp > 0) then
- box(1:3) = box(1:3)*rmu(1:3)
- ener%box(1:3) = box(1:3)
-
- ! WARNING!! This is not correct for non-orthogonal boxes if
- ! NTP > 1 (i.e. non-isotropic scaling). Currently general cell
- ! updates which allow cell angles to change are not implemented.
- ! The viral tensor computed for ewald is the general Nose Klein,
- ! however the cell response needs a more general treatment.
-
- call redo_ucell(rmu)
- ! keep tranvec up to date, rather than recomputing each MD step.
- call fill_tranvec() ! tranvec is dependent on only ucell
-
- call ew_pscale(natom,x,amass,nspm,nsp,npscal)
- if (ntr > 0 .and. nrc > 0) &
- call ew_pscale(natom,xc,amass,nspm,nsp,npscal)
- endif
-
- ener%kin%solv = ekpbs + ener%pot%tot
- ! Pastor, Brooks, Szabo conserved quantity
- ! for harmonic oscillator: Eq. 4.7b of Mol.
- ! Phys. 65:1409-1419, 1988
- ener%kin%solt = eke
- ener%kin%tot = ener%kin%solt
- if (ntt == 1 .and. onstep) then
- ekmh = max(ekph,fac(1)*10.d0)
- end if
-
- ! ---if velocities were reset, the KE is not accurate; fudge it
- ! here to keep the same total energy as on the previous step.
- ! Note that this only affects printout and averages for Etot
- ! and KE -- it has no effect on the trajectory, or on any averages
- ! of potential energy terms.
-
- if( resetvelo ) ener%kin%tot = etot_save - ener%pot%tot
-
- ! --- total energy is sum of KE + PE:
-
- ener%tot = ener%kin%tot + ener%pot%tot
- etot_save = ener%tot
-
- !-------------------------------------------------------------------
- ! Step 8: update the step counter and the integration time:
- !-------------------------------------------------------------------
-
- nstep = nstep+1
-
- ! ---full energies are only calculated every nrespa steps
- ! nvalid is the number of steps where all energies are calculated
-
- ntnb = 0
- if (mod(nstep,nsnb) == 0) ntnb = 1
-
-#if 0
-! DEBUG code -- this will print out every frame of the relaxation dynamics to
-! the trajectory if uncommented
-
- if (master) then
-
- ! -- Coordinate archive:
- if (.true.) then
- if( iwrap == 0 ) then
- call corpac(x,1,nrx,MDCRD_UNIT,loutfm)
- if(ntb > 0) call corpac(box,1,3,MDCRD_UNIT,loutfm)
- else if (iwrap == 1) then
- call get_stack(l_temp,nr3,routine)
- if(.not. rstack_ok)then
- deallocate(r_stack)
- allocate(r_stack(1:lastrst),stat=alloc_ier)
- call reassign_rstack(routine)
- endif
- REQUIRE(rstack_ok)
- do m=1,nr3
- r_stack(l_temp+m-1) = x(m)
- end do
-
- call wrap_molecules(nspm,nsp,r_stack(l_temp))
- if (ifbox == 2) call wrap_to(nspm,nsp,r_stack(l_temp),box)
-
- call corpac(r_stack(l_temp),1,nrx,MDCRD_UNIT,loutfm)
- call corpac(box,1,3,MDCRD_UNIT,loutfm)
- call free_stack(l_temp,routine)
- end if ! if (iwrap == 0) ...
-
-
- !GMS: If using variable QM solvent, try to write a new pdb file
- ! with the QM coordinates for this step. This is done here
- ! to keep the PDB file in sync with the mdcrd file, which
- ! makes it easier to check later.
- if (qmmm_nml%vsolv > 0 .and. qmmm_nml%verbosity == 0) &
- call qm_print_coords(nstep,.false.)
- end if ! (itdump)
-
- if (ioutfm > 0) then
- if (.true.) call end_binary_frame(MDCRD_UNIT)
- end if
-
- end if ! (master)
-#endif /* 0 */
-
- !=======================================================================
-
- ! ---major cycle back to new step unless we have reached our limit:
-
- call trace_integer( 'end of step', nstep )
- call trace_output_mpi_tally( )
- call timer_stop(TIME_VERLET)
-
- if (nstep < relax_nstlim) goto 260
- 480 continue
-
-end subroutine relaxmd
-
-!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-!+ Enter description for quench here.
-subroutine quench(f,v)
- implicit none
-
-#include "../include/md.h"
-!need access to vv - temp verlet scaling
-#include "../include/memory.h"
-!need access to natom
-
- _REAL_ f(*),v(*),dotproduct,force
- !f is the forces and v is the velocity
-
- integer index
- dotproduct = 0.d0
- force = 0.d0
-
- do index=1,3*natom
- force = force + f(index)**2
- dotproduct = dotproduct + v(index)*f(index)
- enddo
-
- if (force/=0.0d0) then
- force = 1.0d0/sqrt(force)
- dotproduct = dotproduct*force
- end if
-
- if (dotproduct>0.0d0) then
- v(1:3*natom) = dotproduct*f(1:3*natom)*force
- else
- !v(1:3*natom) = 0.0d0
- v(1:3*natom) = vfac*dotproduct*f(1:3*natom)*force
- end if
-
-end subroutine quench
diff --git a/patches/amber14.diff/AmberTools/src/sander/sander.F90 b/patches/amber14.diff/AmberTools/src/sander/sander.F90
deleted file mode 100644
index bd3eb4dc4f90286a8dd8af436dfce7c2f248c9ad..0000000000000000000000000000000000000000
--- a/patches/amber14.diff/AmberTools/src/sander/sander.F90
+++ /dev/null
@@ -1,1925 +0,0 @@
-#include "copyright.h"
-#include "../include/dprec.fh"
-#include "../include/assert.fh"
-#include "ncsu-config.h"
-
-!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-!+ The Molecular Dynamics/NMR Refinement/Modeling Module of the AMBER
-!-----------------------------------------------------------------------
-! --- SANDER ---
-!-----------------------------------------------------------------------
-
-subroutine sander()
-
- use state
-#ifndef DISABLE_NCSU
- use ncsu_sander_hooks, only : &
- ncsu_on_sander_init => on_sander_init, &
- ncsu_on_sander_exit => on_sander_exit
-#endif /* DISABLE_NCSU */
-
- use lmod_driver
- use constants, only : INV_AMBER_ELECTROSTATIC, plumed, plumedfile
- ! The main qmmm_struct contains all the QMMM variables and arrays
- use qmmm_module, only : qmmm_nml, qmmm_struct, deallocate_qmmm, qmmm_mpi, &
-#ifdef MPI
- qmmm_mpi_setup, &
-#endif
- qm2_struct, qmewald, qm_gb, qmmm_vsolv, qm2_params
-
- use qmmm_vsolv_module, only: qmmm_vsolv_store_parameters, new
-
- use qm2_extern_module, only: qm2_extern_finalize
- use sebomd_module, only : sebomd_obj, &
- sebomd_open_files, sebomd_close_files, &
-#ifdef MPI
- sebomd_bcast_obj, &
-#endif
- sebomd_setup
-
- use sebomd_arrays, only : init_sebomd_arrays, cleanup_sebomd_arrays
-
- use genborn
- use decomp, only : allocate_int_decomp, allocate_real_decomp, &
- deallocate_int_decomp, deallocate_real_decomp, &
-#ifdef MPI
- synchronize_dec, build_dec_mask, decmask, &
-#endif
- nat, nrs, jgroup, indx
- use fastwt
- use relax_mat
- use nmr, only: nmrrad, impnum
- use ew_recip, only: deallocate_m1m2m3,first_pme
- use parms
- use molecule, only : mol_info, n_iwrap_mask_atoms, iwrap_mask_atoms, &
- allocate_molecule, deallocate_molecule
- use nblist, only:cutoffnb,skinnb,nblist_allocate,nblist_deallocate, &
- nblist_allreal,nblist_allint, num_calls_nblist, first_list_flag
- use stack
- use amoeba_runmd, only : AM_RUNMD_get_coords,AM_RUNMD
- use amoeba_mdin, only : beeman_integrator,iamoeba,am_nbead
- use amoeba_interface, only : AMOEBA_deallocate,AMOEBA_readparm
-
-#ifdef RISMSANDER
- use sander_rism_interface, only: rismprm,rism_setparam, rism_init,rism_finalize
-#endif
-
-#ifdef PUPIL_SUPPORT
- use pupildata
-#endif /* PUPIL */
-
-#ifdef APBS
- use apbs
-#endif /* APBS */
-
-#ifdef _XRAY
- use xray_interface_module, only: xray_init, xray_read_parm, xray_fini
-#endif
-
-#ifdef MPI /* SOFT CORE */
- use softcore, only: setup_sc, cleanup_sc, ifsc, extra_atoms, sc_sync_x, &
- summarize_ti_changes, sc_check_perturbed_molecules, ti_check_neutral, tishake
- use mbar, only: setup_mbar, cleanup_mbar, ifmbar
-#endif
-
- ! for LIE calculations
- use linear_response, only: ilrt, setup_linear_response, &
- cleanup_linear_response
-
-#if defined(MPI)
- use evb_parm, only: xch_type
-# if defined(LES)
- use evb_pimd, only: evb_pimd_init, PE_slice, master_worldrank, jobs_per_node
-# endif
-! REMD
- use remd, only : rem, mdloop, repnum, remd1d_setup, remd_exchange, &
- remd_cleanup, hremd_exchange, ph_remd_exchange, &
- multid_remd_setup, multid_remd_exchange
- use bintraj, only: setup_remd_indices
-#else
-# define rem 0
-#endif /* MPI */
-
- use pimd_vars, only: ipimd
- use neb_vars, only: ineb
-
- use trajenemod, only: trajene
-
-!RCW+MJW CHARMM SUPPORT
- use charmm_mod, only : charmm_active, charmm_deallocate_arrays, &
- charmm_filter_out_qm_atoms
- use ff11_mod, only : cmap_active, deallocate_cmap_arrays
-
- use memory_module, only: x, ix, ih, memory_init
-
-! Self-Guided molecular/Langevin Dynamics (SGLD)
- use sgld, only : isgld,psgld
-
- use nbips, only: ipssys,ips
-
- use crg_reloc, only: ifcr, cr_backup_charge, cr_cleanup, cr_allocate, &
- cr_read_input, cr_check_input, cr_print_info
-
- use emap,only: temap,pemap,qemap
-
- use file_io_dat
- use constantph, only : cnstph_finalize
- use barostats, only : mcbar_setup
-
-!AMD
- use amd_mod
-!scaledMD
- use scaledMD_mod
-
- use abfqmmm_module ! lam81
-
- implicit none
-
- logical belly, erstop
- integer ier,ifind,jn,ncalls,xmin_iter
- character(len=4) itest
- logical ok
- logical newstyle
-# include "../include/memory.h"
-# include "nmr.h"
-# include "box.h"
-# include "../include/md.h"
-# include "extra.h"
-# include "tgtmd.h"
-# include "multitmd.h"
-# include "les.h"
-
-# include "parallel.h"
-#ifdef MPI
- ! =========================== AMBER/MPI ===========================
-# ifdef MPI_DOUBLE_PRECISION
-# undef MPI_DOUBLE_PRECISION
-# endif
- include 'mpif.h'
-# ifdef CRAY_PVP
-# define MPI_DOUBLE_PRECISION MPI_REAL8
-# endif
-# ifdef MPI_BUFFER_SIZE
- integer*4 mpibuf(mpi_buffer_size)
-# endif
-! REMD: loop is the current exchange. runmd is called numexchg times.
- integer loop
-
- integer nrank, istat
- _REAL_ ener(30),vir(4)
- integer ierr
- integer partner
-! ========================= END AMBER/MPI =========================
-#endif
-# include "ew_pme_recip.h"
-# include "ew_frc.h"
-# include "ew_erfc_spline.h"
-# include "ew_parallel.h"
-# include "ew_mpole.h"
-# include "ew_cntrl.h"
-# include "def_time.h"
-
- type(state_rec) :: ene
- integer native,nr3,nr
-
- ! nmrcal vars
- _REAL_ f,enmr,devdis,devang,devtor,devplpt,devpln,devgendis,ag,bg,cg
- ! Updated 9/2007 by Matthew Seetin to enable plane-point and plane-plane
- ! restraints
- _REAL_ emtmd
- integer numphi,nhb
-
- ! runmin/trajene var
- _REAL_ carrms
-
- ! dipole moment stuff
- integer ngrp
-
- character(len=8) initial_date, setup_end_date, final_date
- character(len=10) initial_time, setup_end_time, final_time
- integer nstlim_total ! for final time printout
-
- _REAL_ time0, time1
-
- integer idiff,i,j,istop,index,ierror,itemp
-
- integer, dimension(:), allocatable :: ipairs
- integer :: n_force_calls
- logical qsetup
- logical :: do_list_update=.false.
- _REAL_ :: box_center(3) ! lam81
-#ifdef MPI_DEBUGGER
- integer, volatile :: release_debug
-
- ! So only the master master thread has release_debug = 0
- release_debug = worldrank
-
- ! Lock us into an infinite loop while release_debug == 0 on any thread (only
- ! the master here). This allows you to connect a debugger to any running
- ! process without having to 'race' program execution. A debugger MUST be
- ! attached to the master thread (typically the thread with the lowest PID),
- ! and have release_debug set to NOT 0 (e.g., via "set release_debug=1").
- do
- if (release_debug .ne. 0) exit
- end do
-
- ! Prevent any other threads from progressing past this point until all
- ! threads you want to watch with a debugger are watched and all those
- ! threads are continued.
- call mpi_barrier(mpi_comm_world, ierr)
-#endif
-
- ! ---- HERE BEGIN THE EXECUTABLE STATEMENTS ----
-
- ! Initialize the cpu timer. Needed for machines where returned cpu times
- ! are relative.
- call date_and_time( initial_date, initial_time )
- call wallclock( time0 )
- call init_timers()
-
- ! Initialize the printing of ongoing time and performance summaries.
-! call print_ongoing_time_summary(0,0,0.0d0,7)
- call print_ongoing_time_summary(0,0,0.0d0,7,time0)
-
- ! BPR - original location of PUPIL interface. I moved it further down
- ! because, if it's here, it can't print stuff; write(6,...) statements
- ! assume mdread1() has already been invoked. However, moving this down
- ! may break other things.
-
- ! ==== Flag to tell list builder to print size of list on first call =======
- first_list_flag = .true.
- ! ==== Flag to tell recip space routines to allocate on first call =======
- first_pme = .true.
-
- ! ==== Initialise first_call flags for QMMM ====
- qmmm_struct%qm_mm_first_call = .true.
- qmmm_struct%fock_first_call = .true.
- qmmm_struct%fock2_2atm_first_call = .true.
- qmmm_struct%qm2_allocate_e_repul_first_call = .true.
- qmmm_struct%qm2_calc_rij_eqns_first_call = .true.
- qmmm_struct%qm2_scf_first_call = .true.
- qmmm_struct%zero_link_charges_first_call = .true.
- qmmm_struct%adj_mm_link_pair_crd_first_call = .true.
- qmmm_struct%num_qmmm_calls = 0
-
-#ifdef MPI
- ! Parallel initialization (setup is done in multisander.F90).
-
- ! Make PE 0 the master
- master = mytaskid == 0
- master_master = masterrank == 0
-
- if ( master .and. numtasks > MPI_MAX_PROCESSORS ) then
- write(0, '(a,i4,a,i4)') &
- 'Error: the number of processors must not be greater than ', &
- MPI_MAX_PROCESSORS, ', but is ', numtasks
- call mexit(6,1)
- end if
-# ifdef MPI_BUFFER_SIZE
- call mpi_buffer_attach(mpibuf, mpi_buffer_size*4, ierr)
-# endif
-#else /* not MPI follows */
- ! In the single-threaded version, the one process is master
- master = .true.
-#endif /* MPI */
-
- erstop = .false.
- qsetup = .true.
-
- ! --- generic packing scheme ---
-
- nwdvar = 1
- native = 32
-#ifdef ISTAR2
-
- ! --- Int*2 packing scheme ---
-
- nwdvar = 2
-#endif /*ISTAR2*/
- numpk = nwdvar
- nbit = native/numpk
-
- ! ----- Only the master node (only node when single-process)
- ! performs the initial setup and reading/writing -----
-
- call timer_start(TIME_TOTAL)
-
- call abfqmmm_init_param() ! lam81
-
- do while ( (abfqmmm_param%qmstep <= abfqmmm_param%maxqmstep) &
- .or. (abfqmmm_param%maxqmstep == 0 .and. abfqmmm_param%system == 2) ) ! lam81
-
- masterwork: if (master) then
-
- if (abfqmmm_param%abfqmmm == 0) then ! lam81
-
- ! ---- first, initial reads to determine memory sizes:
- call mdread1()
- call amopen(8,parm,'O','F','R')
- call rdparm1(8)
- if (mtmd /= 'mtmd' .or. itgtmd == 2) call mtmdlx(natom)
- ! --- now, we can allocate memory:
-
- call locmem()
- write(6,'(/,a,5x,a)') '|','Memory Use Allocated'
- write(6,'(a,5x,a,i14)') '|', 'Real ', lastr
- write(6,'(a,5x,a,i14)') '|', 'Hollerith ', lasth
- write(6,'(a,5x,a,i14)') '|', 'Integer ', lasti
- write(6,'(a,5x,a,i14)') '|', 'Max Pairs ', lastpr
-
- ! --- dynamic memory allocation:
-
- ! GMS:
- ! Allocate space for module molecule
- ! in the master node
- mol_info%natom = natom
- mol_info%nres = nres
- call allocate_molecule()
-
- ! Allocate all global arrays
- allocate( x(lastr), ix(lasti), ipairs(lastpr), ih(lasth), stat = ier )
- REQUIRE( ier == 0 )
- ix(1:lasti) = 0
-
- ! This sets up pointer arrays in MEMORY_MODULE to match array-offsets into
- ! the shared X, IX, and IH arrays. Eventually, LOCMEM code should be
- ! merged with MEMORY_MODULE to allocate individual allocatable arrays, but
- ! that will also require updating the MPI code to handle individual
- ! arrays.
- call memory_init()
-
- ! Allocate the parm arrays
- call allocate_parms()
-
- if ((igb /= 0 .and. igb /= 10 .and. ipb == 0) &
- .or.hybridgb>0.or.icnstph.gt.1) &
- call allocate_gb( natom, ncopy )
-
- if( idecomp > 0 ) then
-#ifdef MPI
- if (ifsc > 0) then
- call synchronize_dec(natom, nres)
- else
- nat = natom
- nrs = nres
- end if
-#else
- nat = natom
- nrs = nres
-#endif
- call allocate_int_decomp(natom, nres)
- else
- call allocate_int_decomp(1, 1)
- end if
-
- write(6,'(a,5x,a,i14)' ) '|', 'nblistReal', nblist_allreal
- write(6,'(a,5x,a,i14)' ) '|', 'nblist Int', nblist_allint
- write(6,'(a,5x,a,i14,a)') '|', ' Total ', &
- (8*(lastr+lastrst+nblist_allreal) &
- + 4*(lasth+lasti+lastpr+lastist+nblist_allint))/1024, &
- ' kbytes'
-
- ! --- finish reading the prmtop file and other user input:
- call rdparm2(x,ix,ih,ipairs,8)
-
- call AMOEBA_readparm(8,ntf,ntc,natom,x(lmass))! ntf,ntc get reset if amoeba prmtop
-#ifdef _XRAY
- call xray_read_parm(8,6)
-#endif
-
- end if ! lam81
-
- if (qmmm_nml%ifqnt .or. abfqmmm_param%abfqmmm == 1) then ! lam81
- if(abfqmmm_param%abfqmmm == 0) then ! lam81
- call sebomd_setup
- call read_qmmm_nm_and_alloc(igb, ih, ix, x, cut, use_pme, ntb, 0) ! lam81
- if (qmmm_nml%qmtheory%SEBOMD) then
- ! don't do QM/MM
- qmmm_nml%ifqnt= .false.
- sebomd_obj%do_sebomd = .true.
- end if
- end if ! lam81
- if(qmmm_struct%abfqmmm == 1 .and. abfqmmm_param%abfqmmm == 0) then ! lam81
- call abfqmmm_setup(natom,nres,ix(i02),ih(m04),ih(m02),x(lmass), & ! lam81
- nbonh,nbona,ix(iibh),ix(ijbh),ix(iiba),ix(ijba)) ! lam81
- nr=natom ! lam81
- call AMOEBA_check_newstyle_inpcrd(inpcrd,newstyle) ! lam81
- if (newstyle) then ! lam81
- call AM_RUNMD_get_coords(natom,t,irest,ntb,x(lcrd),x(lvel)) ! lam81
- else ! lam81
- call getcor(nr,x(lcrd),x(lvel),x(lforce),ntx,box,irest,t,temp0,.FALSE.) ! lam81
- end if ! lam81
- abfqmmm_param%maxqmstep = nstlim ! lam81
- end if ! lam81
- if(abfqmmm_param%abfqmmm == 1) then ! lam81
- if(abfqmmm_param%system == 1) then ! lam81
- call abfqmmm_update_qmatoms(x(lcrd)) ! lam81
- if(abfqmmm_param%ntwpdb < 0) then ! lam81
- call abfqmmm_write_pdb(x(lcrd),ix(i70)) ! lam81
- close(6) ! lam81
- call mexit(6,1) ! lam81
- end if ! lam81
- end if ! lma81
- call abfqmmm_select_system_qmatoms(natom) ! lam81
- if(qmmm_nml%ifqnt) then ! lam81
- call read_qmmm_nm_and_alloc(igb,ih,ix,x,cut,use_pme,ntb,abfqmmm_param%qmstep, & ! lam81
- abfqmmm_param%isqm,abfqmmm_param%abfcharge) ! lam81
- end if ! lam81
- endif ! lam81
- end if ! lam81
-
- if (abfqmmm_param%qmstep == 1 .and. abfqmmm_param%system == 1) then ! lam81
-
- call mdread2(x,ix,ih,ipairs)
-
- endif ! lam81
-
-#if defined(RISMSANDER)
- call rism_setparam(mdin,&
- commsander,&
- natom,ntypes,x(L15:L15+natom-1),&
- x(LMASS:LMASS+natom-1),cn1,cn2,&
- ix(i04:i04+ntypes**2-1), ix(i06:i06+natom-1))
-#endif /*RISMSANDER*/
-
- if ( ifcr /= 0 ) then
- call cr_read_input(natom)
- call cr_check_input( ips )
- !call cr_print_info(6)
- call cr_backup_charge( x(l15), natom )
- end if
-
- ! --- alloc memory for decomp module that needs info from mdread2
- if (idecomp == 1 .or. idecomp == 2) then
- call allocate_real_decomp(nrs)
-#ifdef MPI
- ! -- ti decomp
- if (ifsc > 0) then
- ! following lines don't really seem to make sense(?)
- ! partner = ieor(masterrank,1)
- ! if (nat == natom) then
- ! nrank = masterrank
- ! else
- ! nrank = partner
- ! end if
- call mpi_bcast(jgroup, nat, MPI_INTEGER, 0, commmaster, ierr)
- end if
-#endif
- else if( idecomp == 3 .or. idecomp == 4 ) then
- call allocate_real_decomp(npdec*npdec)
- end if
-
- ! ----- EVALUATE SOME CONSTANTS FROM MDREAD SETTINGS -----
-
- nr = nrp
- nr3 = 3*nr
- belly = ibelly > 0
-
- ! ========================= PUPIL INTERFACE =========================
-#ifdef PUPIL_SUPPORT
-
- ! I moved the PUPIL interface down here so that write() statements work
- ! as advertised. BPR 9/7/09
-
- ! Initialise the CORBA interface
- puperror = 0
- call fixport()
- call inicorbaintfcmd(puperror)
- if (puperror .ne. 0) then
- write(6,*) 'Error creating PUPIL CORBA interface.'
- call mexit(6,1)
- end if
- pupactive = .true.
- write(6,*) 'PUPIL CORBA interface initialized.'
-
- ! Allocation of memory and initialization
- pupStep = 0
- puperror = 0
- allocate (qcell (12 ),stat=puperror)
- allocate (pupmask (natom ),stat=puperror)
- allocate (pupqlist(natom ),stat=puperror)
- allocate (pupatm (natom ),stat=puperror)
- allocate (pupchg (natom ),stat=puperror)
- allocate (qfpup (natom*3),stat=puperror)
- allocate (qcdata (natom*9),stat=puperror)
- allocate (keyMM (natom ),stat=puperror)
- allocate (pupres (nres ),stat=puperror)
- allocate (keyres (nres ),stat=puperror)
-
- if (puperror /= 0) then
- write(6,*) 'Error allocating PUPIL interface memory.'
- call mexit(6,1)
- end if
-
- ! Initialise the "atomic numbers" and "quantum forces" vectors
- pupqatoms = 0
- iresPup = 1
- pupres(1) = 1
- do iPup=1,natom
- bs1 = (iPup-1)*3
- call get_atomic_number_pupil(ih(iPup+m06-1),x(lmass+iPup-1),pupatm(iPup))
- if (iresPup .lt. nres) then
- if (iPup .ge. ix(iresPup+i02)) then
- iresPup = iresPup + 1
- pupres(iresPup) = iPup
- end if
- end if
- write (strAux,"(A4,'.',A4)") trim(ih(iresPup+m02-1)),adjustl(ih(iPup+m04-1))
- keyres(iresPup) = trim(ih(iresPup+m02-1))
- keyMM(iPup) = trim(strAux)
-
- ! Retrieve the initial charges
- pupchg(iPup) = x(L15+iPup-1)
- !write(6,*) 'Atom num.',iPup,'Label,Mass,Atomic Num.', keyMM(iPup),x(lmass+iPup-1),pupatm(iPup), 'Charge', pupchg(iPup)
-
- do jPup=1,3
- qfpup(bs1+jPup) = 0.0d0
- end do
- end do
-
- write(6,*) 'Got all atomic numbers.'
-
- ! Initialise the PUPIL cell
- do iPup=1,12
- qcell(iPup) = 0.0d0
- end do
-
- ! Submit the KeyMM particles and their respective atomic numbers to PUPIL
- puperror = 0
- call putatomtypes(natom,puperror,pupatm,keyMM)
- if (puperror .ne. 0) then
- write(6,*) 'Error sending MM atom types to PUPIL.'
- call mexit(6,1)
- end if
-
- ! Submit the Residue Pointer vector to PUPIL
- write(6,"(a20,1x,i6,3x,a17,1x,i6)") 'Number of residues =', nres, 'Number of atoms =', natom
- !do iPup=1,nres
- ! write(6,*) 'Residue ',iPup,keyres(iPup),pupres(iPup)
- !end do
- puperror = 0
- call putresiduetypes(nres,puperror,pupres,keyres)
- if (puperror .ne. 0) then
- write(6,*) 'Error sending MM residue types to PUPIL.'
- call mexit(6,1)
- end if
-
- write(6,*) 'Sent system data to PUPIL.'
- write(*,*) 'PUPIL structure initialized.'
-#endif
- ! ========================= PUPIL INTERFACE =========================
-
- ! --- seed the random number generator ---
-
- ! DAN ROE: Note master node only here
- if (abfqmmm_param%qmstep == 1 .and. abfqmmm_param%system == 1) then ! lam81
-#ifdef MPI
- if (rem == 0) then
- call amrset(ig)
- else
- ! carlos: set random seed different for different replicas
- ! but keep same seed for cpus in the same replica since
- ! we want data from diff # cpus to match
- call amrset(ig + (17 * nodeid)) ! nodeid is in md.h and is repnum - 1
- end if
-#else
- call amrset(ig)
-#endif
-
- if (nbit < 32 .and. nr > 32767) then
- write(6, *) ' Too many atoms for 16 bit pairlist -'
- write(6, *) ' Recompile without ISTAR2'
- call mexit(6, 1)
- end if
-
- if (ntp > 0.and.iabs(ntb) /= 2) then
- write(6,*) 'Input of NTP/NTB inconsistent'
- call mexit(6, 1)
- end if
- end if ! lam81
-
- ! ----- READ COORDINATES AND VELOCITIES -----
-
- if (abfqmmm_param%qmstep == 1 .and. abfqmmm_param%system == 1) then ! lam81 <<< QMSTEP=1 BLOCK >>>
-
- call timer_start(TIME_RDCRD)
-#ifdef LES
- call getcor(nr,x(lcrd),x(lvel),x(lforce),ntx,box,irest,t,temp0les,.TRUE.,solvph)
-#else
- call AMOEBA_check_newstyle_inpcrd(inpcrd,newstyle)
- if (newstyle) then
- call AM_RUNMD_get_coords(natom,t,irest,ntb,x(lcrd),x(lvel))
- else
- call getcor(nr,x(lcrd),x(lvel),x(lforce),ntx,box,irest,t,temp0,.TRUE.,solvph)
- end if
-#endif
- if (iamoeba > 0) then
- natom = natom*am_nbead
- nrp = nrp*am_nbead
- nr = nr*am_nbead
- nr3 = nr3*am_nbead
- ncopy = am_nbead
- end if
-
- ! M-WJ
- !if( igb == 0 .and. induced == 1 ) call get_dips(x,nr)
-! WJM if is a polarizable model, reading input dipole information
- if (igb == 0 .and. ipb == 0 .and. induced > 0) call get_dips(x,nr)
-
-#ifdef APBS
- ! APBS initialization
- if (mdin_apbs) then
- ! in: natom, coords, charge and radii (from prmtop)
- ! out: pb charges and pb radii (via apbs_vars module)
- call apbs_init(natom, x(lcrd), x(l15), x(l97))
- end if
-#endif /* APBS */
-
-#ifdef _XRAY
- call xray_init()
-#endif
-
- ! ----- SET THE INITIAL VELOCITIES -----
-
- if (ntx <= 3) then
- call setvel(nr,x(lvel),x(lwinv),tempi,init,iscale,scalm)
- ! random numbers may have been "used up" in setting the intial
- ! velocities; re-set the generator so that all nodes are back in
- ! sync
-
- ! DAN ROE: Note master node only here
-#ifdef MPI
- if (rem == 0) call amrset(ig)
-#else
- call amrset(ig)
-#endif
-
- end if
- if (belly) call bellyf(natom,ix(ibellygp),x(lvel))
- call timer_stop(TIME_RDCRD)
-
- if(abfqmmm_param%abfqmmm == 1 .and. ntb > 0) then ! lam81
- call iwrap2(abfqmmm_param%n_user_qm, abfqmmm_param%user_qm, x(lcrd), box_center) ! lam81
- end if ! lam81
-
- ! --- If we are reading NMR restraints/weight changes,
- ! read them now:
-
- if (nmropt >= 1) then
- call nmrcal(x(lcrd),f,ih(m04),ih(m02),ix(i02),x(lwinv),enmr, &
- devdis,devang,devtor,devplpt,devpln,devgendis,temp0,tautp,cut,ntb,x(lnmr01), &
- ix(inmr02),x(l95),5,6,rk,tk,pk,cn1,cn2, &
- ag,bg,cg,numbnd,numang,numphi,nimprp, &
- nhb,natom,natom,ntypes,nres,rad,wel,radhb, &
- welhb,rwell,isftrp,tgtrmsd,temp0les,-1,'READ')
- ! Updated 9/2007 by Matthew Seetin to enable plane-point and plane-plane restraints
-
- ! --- Determine how many of the torsional parameters
- ! are impropers
- call impnum(ix(i46),ix(i56),ix(i48),ix(i58),nphih,nphia, &
- 0,nptra,nimprp)
- end if
-
- ! -- Set up info related to weight changes for the non-bonds:
-
- call nmrrad(rad,wel,cn1,cn2,ntypes,0,0.0d0)
- call decnvh(asol,bsol,nphb,radhb,welhb)
-
- if (iredir(4) > 0) call noeread(x,ix,ih)
- if (iredir(8) > 0) call alignread(natom, x(lcrd))
- if (iredir(9) > 0) call csaread
-
- end if ! lam81 <<< QMSTEP=1 BLOCK >>>
-
- !---------------------------------------------------------------
- ! --- Call FASTWAT, which will tag those bonds which are part
- ! of 3-point water molecules. Constraints will be effected
- ! for these waters using a fast analytic routine -- dap.
-
- call timer_start(TIME_FASTWT)
-
- call fastwat(ih(m04),nres,ix(i02),ih(m02), &
- nbonh,nbona,ix(iibh),ix(ijbh),ibelly,ix(ibellygp), &
- iwtnm,iowtnm,ihwtnm,jfastw,ix(iifstwt), &
- ix(iifstwr),ibgwat,ienwat,ibgion,ienion,iorwat, &
- 6,natom)
- call timer_stop(TIME_FASTWT)
-
- call getwds(ih(m04), nres , ix(i02) , ih(m02) , &
- nbonh , nbona , 0 , ix(iibh) , &
- ix(ijbh) , iwtnm , iowtnm , ihwtnm , &
- jfastw , ix(iicbh) , req , x(lwinv) , &
- rbtarg , ibelly , ix(ibellygp), 6 )
-
- ! Assign link atoms between quantum mechanical and molecular mechanical
- ! atoms if quantum atoms are present.
- ! After assigning the link atoms, delete all connectivity between the
- ! QM atoms.
- if(qmmm_nml%ifqnt) then
-
- call identify_link_atoms(nbona,ix(iiba),ix(ijba))
-
- ! Variable QM solvent:
- ! Store the original bond parameters since we will need to rebuild
- ! the QM region (delete bonded terms etc) repeatedly
- if ( qmmm_nml%vsolv > 0 ) then
- call new(qmmm_vsolv, nbonh, nbona, ntheth, ntheta, nphih, nphia)
- call qmmm_vsolv_store_parameters(qmmm_vsolv, numbnd, &
- ix(iibh), ix(ijbh), ix(iicbh), &
- ix(iiba), ix(ijba), ix(iicba), &
- ix(i24), ix(i26), ix(i28), ix(i30), &
- ix(i32), ix(i34), ix(i36), ix(i38), &
- ix(i40), ix(i42), ix(i44), ix(i46), ix(i48), &
- ix(i50), ix(i52), ix(i54), ix(i56), ix(i58))
- end if
-
- if( abfqmmm_param%abfqmmm == 1 ) then ! lam81
- if(abfqmmm_param%qmstep == 1 .and. abfqmmm_param%system == 1) then ! lam81
- call abfqmmm_allocate_arrays_of_parameters(numbnd, nbonh, nbona, ntheth, ntheta, nphih, nphia) ! lam81
- call abfqmmm_store_parameters(ix(iibh), ix(ijbh), ix(iicbh), & ! lam81
- ix(iiba), ix(ijba), ix(iicba), & ! lam81
- ix(i24), ix(i26), ix(i28), ix(i30), & ! lam81
- ix(i32), ix(i34), ix(i36), ix(i38), & ! lam81
- ix(i40), ix(i42), ix(i44), ix(i46), ix(i48), & ! lam81
- ix(i50), ix(i52), ix(i54), ix(i56), ix(i58), & ! lam81
- x(l15), rk, req) ! lam81
- else ! lam81
- call abfqmmm_set_parameters(numbnd, nbonh, nbona, ntheth, ntheta, nphih, nphia, & ! lam81
- ix(iibh), ix(ijbh), ix(iicbh), & ! lam81
- ix(iiba), ix(ijba), ix(iicba), & ! lam81
- ix(i24), ix(i26), ix(i28), ix(i30), & ! lam81
- ix(i32), ix(i34), ix(i36), ix(i38), & ! lam81
- ix(i40), ix(i42), ix(i44), ix(i46), ix(i48), & ! lam81
- ix(i50), ix(i52), ix(i54), ix(i56), ix(i58), & ! lam81
- x(l15), rk, req) ! lam81
-
- call init_extra_pts(ix(iibh),ix(ijbh),ix(iicbh), & ! lam81
- ix(iiba),ix(ijba),ix(iicba), & ! lam81
- ix(i24),ix(i26),ix(i28),ix(i30), & ! lam81
- ix(i32),ix(i34),ix(i36),ix(i38), & ! lam81
- ix(i40),ix(i42),ix(i44),ix(i46),ix(i48), & ! lam81
- ix(i50),ix(i52),ix(i54),ix(i56),ix(i58), & ! lam81
- ih(m06),ix,x,ix(i08),ix(i10), & ! lam81
- nspm,ix(i70),x(l75),tmass,tmassinv,x(lmass),x(lwinv),req) ! lam81
-
- end if ! lam81
- end if ! lam81
-
- ! Remove bonds between QM atoms from list (Hydrogen)
- if (nbonh .gt. 0) call setbon(nbonh,ix(iibh),ix(ijbh),ix(iicbh), &
- ix(ibellygp))
-
- ! Remove bonds between QM atoms from list (Heavy)
- if (nbona .gt. 0) call setbon(nbona,ix(iiba),ix(ijba),ix(iicba), &
- ix(ibellygp))
-
- ! Remove angles between QM atoms from list (Hydrogen)
- if (ntheth .gt. 0) call setang(ntheth,ix(i24),ix(i26),ix(i28),ix(i30), &
- ix(ibellygp))
-
- ! Remove angles between QM atoms from list (Heavy)
- if (ntheta .gt. 0) call setang(ntheta,ix(i32),ix(i34),ix(i36),ix(i38),&
- ix(ibellygp))
-
- ! Remove dihedrals between QM atoms from list (Hydrogen)
- if (nphih .gt. 0) call setdih(nphih,ix(i40),ix(i42),ix(i44),ix(i46), &
- ix(i48), ix(ibellygp))
-
- ! Remove dihedrals between QM atoms from list (Heavy)
- if (nphia .gt. 0) call setdih(nphia,ix(i50),ix(i52),ix(i54),ix(i56), &
- ix(i58), ix(ibellygp))
-
- ! Remove CHARMM energy terms from QM region
- call charmm_filter_out_qm_atoms()
-
- ! Now we should work out the type of each quantum atom present.
- ! This is used for our arrays of pre-computed parameters. It is
- ! essentially a re-basing of the atomic numbers and is done to save
- ! memory. Note: qm_assign_atom_types will allocate the qm_atom_type
- ! array for us. Only the master calls this routine. All other
- ! threads get this allocated and broadcast to them by the mpi setup
- ! routine.
- call qm_assign_atom_types
-
- ! Set default QMMM MPI parameters - for single cpu operation.
- ! These will get overwritten by qmmm_mpi_setup if MPI is on.
- qmmm_mpi%commqmmm_master = master
- qmmm_mpi%numthreads = 1
- qmmm_mpi%mytaskid = 0
- qmmm_mpi%natom_start = 1
- qmmm_mpi%natom_end = natom
- qmmm_mpi%nquant_nlink_start = 1
- qmmm_mpi%nquant_nlink_end = qmmm_struct%nquant_nlink
-
- ! Now we know how many link atoms we can allocate the scf_mchg array...
- allocate(qm2_struct%scf_mchg(qmmm_struct%nquant_nlink), stat = ier)
- REQUIRE(ier == 0) ! Deallocated in deallocate qmmm
-
- ! We can also allocate ewald_memory
- if (qmmm_nml%qm_ewald > 0 ) then
- call allocate_qmewald(natom)
- end if
- if (qmmm_nml%qmgb == 2 ) then ! lam81
- call allocate_qmgb(qmmm_struct%nquant_nlink)
- end if ! lam81
-
- allocate( qmmm_struct%dxyzqm(3, qmmm_struct%nquant_nlink), stat = ier )
- REQUIRE(ier == 0) ! Deallocated in deallocate qmmm
-
- else if(abfqmmm_param%abfqmmm == 1) then ! lam81
-
- call abfqmmm_set_parameters(numbnd, nbonh, nbona, ntheth, ntheta, nphih, nphia, & ! lam81
- ix(iibh), ix(ijbh), ix(iicbh), & ! lam81
- ix(iiba), ix(ijba), ix(iicba), & ! lam81
- ix(i24), ix(i26), ix(i28), ix(i30), & ! lam81
- ix(i32), ix(i34), ix(i36), ix(i38), & ! lam81
- ix(i40), ix(i42), ix(i44), ix(i46), ix(i48), & ! lam81
- ix(i50), ix(i52), ix(i54), ix(i56), ix(i58), & ! lam81
- x(l15), rk, req) ! lam81
-
- call init_extra_pts(ix(iibh),ix(ijbh),ix(iicbh), & ! lam81
- ix(iiba),ix(ijba),ix(iicba), & ! lam81
- ix(i24),ix(i26),ix(i28),ix(i30), & ! lam81
- ix(i32),ix(i34),ix(i36),ix(i38), & ! lam81
- ix(i40),ix(i42),ix(i44),ix(i46),ix(i48), & ! lam81
- ix(i50),ix(i52),ix(i54),ix(i56),ix(i58), & ! lam81
- ih(m06),ix,x,ix(i08),ix(i10), & ! lam81
- nspm,ix(i70),x(l75),tmass,tmassinv,x(lmass),x(lwinv),req) ! lam81
-
- end if !if (qmmm_nml%ifqnt)
-
- ! --- Open the data dumping files and position it depending
- ! on the type of run:
-
- if (abfqmmm_param%qmstep == 1 .and. abfqmmm_param%system == 1) then ! lam81
-#ifdef MPI
- ! adaptive QM/MM (qmmm_nml%vsolv=2) via multisander
- ! all groups have identical coords and velocities
- ! only master of first group needs to dump results
- if ( (qmmm_nml%vsolv < 2) .or. (worldrank == 0) ) then
-#endif
- call open_dump_files
-#ifdef MPI
- end if
-#endif
- end if ! lam81
- if (master) call amflsh(6)
-
- ! --- end of master process setup ---
- end if masterwork ! (master)
-
-# if defined(RISMSANDER)
- call rism_init(commsander)
-# endif /* RISMSANDER */
-
-#ifdef MPI
-
- call mpi_barrier(commsander,ierr)
- ! =========================== AMBER/MPI ===========================
-
- ! NOTE: in the current AMBER/MPI implementation, two means of
- ! running in parallel within sander are supported. The value
- ! of mpi_orig determines which approach is used.
- ! This is turned on when minimization (imin .ne. 0) is requested,
- ! and is otherwise off.
-
- ! When running the mpi_orig case, a variable notdone is now
- ! set by the master and determines when to exit the force()
- ! loop. When the master has finished calling force, the
- ! master changes notdone to 0 and broadcasts the data one more
- ! time to signal end of the loop. force() is modified so that
- ! in the mpi_orig case, an initial broadcast is done to receive
- ! the value from the master to decide whether to do the work or
- ! simply exit.
-
- ! ...set up initial data and send all needed data to other nodes,
- ! now that the master has it
-
- ! First, broadcast parameters in memory.h, so that all processors
- ! will know how much memory to allocate:
-
- call mpi_bcast(natom,BC_MEMORY,mpi_integer,0,commsander,ierr)
- ! -- ti decomp
- call mpi_bcast(idecomp,1,mpi_integer,0,commsander,ierr)
- call mpi_bcast(nat,1,mpi_integer,0,commsander,ierr)
- call mpi_bcast(nrs,1,mpi_integer,0,commsander,ierr)
-
- ! ----- Set up integer stack initial size --------------
- call mpi_bcast(lastist,1,mpi_integer,0,commsander,ierr)
- call mpi_bcast(lastrst,1,mpi_integer,0,commsander,ierr)
-
- call mpi_bcast(qmmm_struct%abfqmmm,1,mpi_integer,0,commsander,ierr) ! lam81
- call mpi_bcast(abfqmmm_param%abfqmmm,1,mpi_integer,0,commsander,ierr) ! lam81
- if(abfqmmm_param%abfqmmm == 1) then ! lam81
- call mpi_bcast(abfqmmm_param%natom,1,mpi_integer,0,commsander,ierr) ! lam81
- call mpi_bcast(abfqmmm_param%qmstep,1,mpi_integer,0,commsander,ierr) ! lam81
- call mpi_bcast(abfqmmm_param%maxqmstep,1,mpi_integer,0,commsander,ierr) ! lam81
- call mpi_bcast(abfqmmm_param%system,1,mpi_integer,0,commsander,ierr) ! lam81
- end if ! lam81
-
- if(abfqmmm_param%abfqmmm == 1) then ! lam81
- if(abfqmmm_param%qmstep == 1 .and. abfqmmm_param%system == 1) then ! lam81
- call mpi_bcast(abfqmmm_param%r_core_in,1,mpi_double_precision,0,commsander,ierr) ! lam81
- call mpi_bcast(abfqmmm_param%r_core_out,1,mpi_double_precision,0,commsander,ierr) ! lam81
- call mpi_bcast(abfqmmm_param%r_qm_in,1,mpi_double_precision,0,commsander,ierr) ! lam81
- call mpi_bcast(abfqmmm_param%r_qm_out,1,mpi_double_precision,0,commsander,ierr) ! lam81
- call mpi_bcast(abfqmmm_param%r_buffer_in,1,mpi_double_precision,0,commsander,ierr) ! lam81
- call mpi_bcast(abfqmmm_param%r_buffer_out,1,mpi_double_precision,0,commsander,ierr) ! lam81
- call mpi_bcast(abfqmmm_param%mom_cons_type,1,mpi_integer,0,commsander,ierr) ! lam81
- call mpi_bcast(abfqmmm_param%mom_cons_region,1,mpi_integer,0,commsander,ierr) ! lam81
- if (.not. master) then ! lam81
- allocate(abfqmmm_param%x(3*natom), stat=ier) ! lam81
- REQUIRE(ier==0) ! lam81
- allocate(abfqmmm_param%id(natom), stat=ier) ! lam81
- REQUIRE(ier==0) ! lam81
- allocate(abfqmmm_param%mass(natom), stat=ier) ! lam81
- REQUIRE(ier==0) ! lam81
- end if ! lam81
- allocate(abfqmmm_param%v(3*natom+iscale), stat=ier) ! lam81
- REQUIRE(ier==0) ! lam81
- allocate(abfqmmm_param%f(3*natom+iscale), stat=ier) ! lam81
- REQUIRE(ier==0) ! lam81
- allocate(abfqmmm_param%f1(3*natom+iscale), stat=ier) ! lam81
- REQUIRE(ier==0) ! lam81
- allocate(abfqmmm_param%f2(3*natom+iscale), stat=ier) ! lam81
- REQUIRE(ier==0) ! lam81
- end if ! lam81
- call mpi_bcast(abfqmmm_param%x,3*natom,mpi_double_precision,0,commsander,ierr) ! lam81
- call mpi_bcast(abfqmmm_param%id,natom,mpi_integer,0,commsander,ierr) ! lam81
- call mpi_bcast(abfqmmm_param%mass,natom,mpi_double_precision,0,commsander,ierr) ! lam81
- end if ! lam81
-
- if (abfqmmm_param%qmstep == 1 .and. abfqmmm_param%system == 1) then ! lam81
- call stack_setup()
- else ! lam81
- call deallocate_stacks ! lam81
- call stack_setup() ! lam81
- end if ! lam81
-
- call mpi_bcast(plumed,1,MPI_INTEGER,0,commsander,ierr)
- call mpi_bcast(plumedfile,256,MPI_CHARACTER,0,commsander,ierr)
-
- ! GMS: Broadcast parameters from module 'molecule'
- call mpi_bcast(mol_info%natom,1,mpi_integer,0,commsander,ierr)
- call mpi_bcast(mol_info%nres,1,mpi_integer,0,commsander,ierr)
- call mpi_barrier(commsander,ierr)
-
- ! ---allocate memory on the non-master nodes:
- if (.not. master) then
-
- if (abfqmmm_param%qmstep /= 1 .or. abfqmmm_param%system /= 1) then ! lam81
- deallocate(x,ix,ipairs,ih) ! lam81
- end if ! lam81
-
- allocate( x(1:lastr), stat = ier )
- REQUIRE( ier == 0 )
-
- allocate( ix(1:lasti), stat = ier )
- REQUIRE( ier == 0 )
-
- allocate( ipairs(1:lastpr), stat = ier )
- REQUIRE( ier == 0 )
-
- allocate( ih(1:lasth), stat = ier )
- REQUIRE( ier == 0 )
-
- ! GMS:
- ! Allocate space for molecule module
- ! arrays in the other nodes
- if (abfqmmm_param%qmstep == 1 .and. abfqmmm_param%system == 1) then ! lam81
- call allocate_molecule()
- else ! lam81
- call deallocate_molecule() ! lam81
- call allocate_molecule() ! lam81
- end if ! lam81
-
- ! --------------------------
-
- ! -- ti decomp
- if (idecomp > 0) then
- call allocate_int_decomp(natom, nres)
- if (idecomp == 1 .or. idecomp == 2) then
- call allocate_real_decomp(nrs)
- else if( idecomp == 3 .or. idecomp == 4 ) then
- call allocate_real_decomp(npdec*npdec)
- end if
- end if
- end if ! ( .not.master )
-
- !GMS: Broadcast arrays from module 'molecule'
- call mpi_bcast(mol_info%natom_res,mol_info%nres,MPI_INTEGER,0,commsander,ierr)
- call mpi_bcast(mol_info%atom_to_resid_map,mol_info%natom,MPI_INTEGER,0,commsander,ierr)
- call mpi_bcast(mol_info%atom_mass,mol_info%natom, MPI_DOUBLE_PRECISION, 0, commsander, ier)
-
- if(idecomp == 1 .or. idecomp == 2) then
- call mpi_bcast(jgroup,nat,MPI_INTEGER,0,commsander,ierr)
- end if
-
- if(icfe == 0 .and. (idecomp ==3 .or. idecomp == 4)) then
- call mpi_bcast(jgroup,natom,MPI_INTEGER,0,commsander,ierr)
- call mpi_bcast(indx,nres,MPI_INTEGER,0,commsander,ierr)
- end if
-
- call startup_groups(ierr)
- call startup(x,ix,ih)
-
-! +---------------------------------------------------------------------------+
-! | Broadcast EVB/PIMD inputs/parameters to all PEs |
-! +:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::+
-! | Note: The masters have all required EVB/PIMD inputs/parameters via call |
-! | to mdread2 ( evb_input, evb_init, evb_pimd_init ). For EVB/PIMD, all |
-! | PEs need the inputs/parameters ... so we perform this initialization |
-! | again for all PEs besides the masters. The alternative is to use |
-! | MPI_BCAST. |
-! +---------------------------------------------------------------------------+
-
- call mpi_bcast( ievb , 1, MPI_INTEGER, 0, commworld, ierr )
- call mpi_bcast( ipimd, 1, MPI_INTEGER, 0, commworld, ierr )
-
- ! KFW
- if (ievb /= 0) then
- call mpi_bcast(evbin, MAX_FN_LEN, MPI_CHARACTER, 0, commworld, ierr)
- if (.not. master) then
- call evb_input
- call evb_init
- end if
- end if
- ! KFW
-
-
-# if defined(LES)
- call mpi_bcast ( ncopy, 1, MPI_INTEGER, 0, commworld, ierr )
- call mpi_bcast ( cnum(1:natom), natom, MPI_INTEGER, 0, commworld, ierr )
- call mpi_bcast ( evbin, MAX_FN_LEN, MPI_CHARACTER, 0, commworld, ierr )
-# endif /* LES */
- if (ievb /= 0) then
-# if defined(LES)
- !call mpi_bcast ( mastersize, 1, MPI_INTEGER, 0, commworld, ierr )
- !call mpi_bcast ( jobs_per_node, 1, MPI_INTEGER, 0, commworld, ierr )
- !call mpi_bcast ( nsize, 1, MPI_INTEGER, 0, commworld, ierr )
- if (ipimd > 0 .and. .not. master) then
- call evb_input
- call evb_init
- !call evb_pimd_init
- end if
- call evb_pimd_init
- !call mpi_bcast ( master_worldrank, mastersize, MPI_INTEGER, 0, commworld, ierr )
- !call mpi_bcast ( PE_slice, jobs_per_node*nsize, MPI_INTEGER, 0, commworld, ierr )
-# endif /* LES */
- call evb_bcast
- call evb_alloc
- end if
-
-! +---------------------------------------------------------------------------+
-! | Obtain B vector for Schlegel's distributed Gaussian method |
-! +---------------------------------------------------------------------------+
-
- if (trim(adjustl(xch_type)) == "dist_gauss") call schlegel_dg
-
- if (ifsc /= 0) then
- ! multi-CPU minimization does not work with soft core !
- if (imin > 0 .and. numtasks > 1) then
- call sander_bomb('imin > 0 and numtasks > 1', &
- 'TI minimizations cannot be performed with > 2 CPUs','')
- end if
- call setup_sc(natom, nres, ih(m04), ih(m06), &
- ix(i02), ih(m02), x(lcrd), ntypes, clambda, nstlim)
- if (ntp > 0 .and. master) then
- ! Check which molecules are perturbed in NPT runs
- call sc_check_perturbed_molecules(nspm, ix(i70))
- end if
- ! -- ti decomp
- if (idecomp > 0) then
- if (sanderrank == 0) call build_dec_mask(natom)
- call mpi_bcast(decmask, natom, MPI_INTEGER, 0, commsander, ierr)
- end if
- ! Make sure all common atoms have the same v (that of V0) in TI runs
- if ( ifsc /= 2 ) then
- if (master) call sc_sync_x(x(lvel),nr3)
- !call mpi_barrier(commsander,ierr)
- if (numtasks > 1) then
- call mpi_bcast(nr3,1,MPI_INTEGER,0,commsander,ierr)
- call mpi_bcast(x(lvel),nr3,MPI_DOUBLE_PRECISION,0,commsander,ierr)
- end if
- end if
- if (tishake /= 0) call setnoshake_sc(ix,ntc,num_noshake,master)
- else
- extra_atoms=0
- end if
- if (ifmbar /= 0) then
- call setup_mbar(nstlim)
- end if
-
- if (.not. master .and. igb == 0 .and. ipb == 0) then
- if (abfqmmm_param%qmstep == 1 .and. abfqmmm_param%system == 1) then ! lam81
- call nblist_allocate(natom,ntypes,num_direct,numtasks)
- else ! lam81
- call nblist_deallocate ! lam81
- call nblist_allocate(natom,ntypes,num_direct,numtasks) ! lam81
- end if ! lam81
- end if
-
- ! --- Allocate memory for GB on the non-master nodes:
-
- if( .not.master ) then
-
- if ((igb /= 0 .and. igb /= 10 .and. ipb == 0) .or. hybridgb>0 .or. icnstph.gt.1) then ! lam81
- if (abfqmmm_param%qmstep == 1 .and. abfqmmm_param%system == 1) then ! lam81
- call allocate_gb( natom, ncopy )
- else ! lam81
- call deallocate_gb ! lam81
- call allocate_gb( natom, ncopy ) ! lam81
- end if ! lam81
- end if ! lam81
-
- end if ! ( .not.master )
-
- nr = nrp
- nr3 = 3*nr
- belly = ibelly > 0
-
- ! ---Do setup for QMMM in parallel if ifqnt is on - this is essentially
- ! everything in the QMMM namelist and a few other bits and pieces.
- ! ---Note, currently only master node knows if qmmm_nml%ifqnt is
- ! on so we need to broadcast this first and then make decisions based
- ! on this.
-
- call mpi_bcast(qmmm_nml%ifqnt, 1, mpi_logical, 0, commsander, ierror)
-
- if (qmmm_nml%ifqnt) then
- ! Broadcast all of the stuff in qmmm_nml and allocate the relevant
- ! arrays on all processors. This will also set up information for
- ! openmp on the master processor if it is in use.
- call qmmm_mpi_setup( master, natom )
- if (qmmm_nml%qm_ewald > 0 .and. .not. master) then
- call allocate_qmewald(natom)
- end if
- if (qmmm_nml%qmgb==2 .and. .not. master) then
- call allocate_qmgb(qmmm_struct%nquant_nlink)
- end if
-
- if (.not. master) then
- allocate( qmmm_struct%dxyzqm(3, qmmm_struct%nquant_nlink), stat = ier )
- REQUIRE(ier == 0) !Deallocated in deallocate qmmm
- end if
-
- end if
-
- ! --- END QMMM MPI SETUP ---
-
- ! DAN ROE: Note: all nodes are calling this. amrset(ig) has already been called
- ! by the master node (twice if initial velocities are set, ntx<=3).
- ! DAN ROE: REMD: Now need to call amrset on all child threads, masters have called
- ! it above before initial coord read
- if (abfqmmm_param%qmstep == 1 .and. abfqmmm_param%system == 1) then ! lam81
- if(rem == 0) then
- call amrset(ig+1)
- else
- if (.not. master) call amrset(ig + 17 * nodeid)
- endif
-
- if (nmropt >= 1) &
- call nmrcal(x(lcrd),f,ih(m04),ih(m02),ix(i02),x(lwinv),enmr, &
- devdis,devang,devtor,devplpt,devpln,devgendis,temp0,tautp,cut,ntb,x(lnmr01), &
- ix(inmr02),x(l95),5,6,rk,tk,pk,cn1,cn2, &
- ag,bg,cg,numbnd,numang,numphi,nimprp, &
- nhb,natom,natom,ntypes,nres,rad,wel,radhb, &
- welhb,rwell,isftrp,tgtrmsd,temp0les,-1,'MPI ')
- end if ! lam81
- ! Updated 9/2007 by Matthew Seetin to enable plane-point and plane-plane restraints
-
- call mpi_bcast(lmtmd01,1,mpi_integer,0, commsander,ierr)
- call mpi_bcast(imtmd02,1,mpi_integer,0, commsander,ierr)
-
- if (itgtmd == 2) call mtmdcall(emtmd,x(lmtmd01),ix(imtmd02),x(lcrd),x(lforce),&
- ih(m04),ih(m02),ix(i02),ih(m06),x(lmass),natom,nres,'MPI ')
-
-
- ! ---------------- Check system is neutral and print warning message ------
- ! ---------------- adjust charges for roundoff error. ------
- if( igb == 0 .and. ipb == 0 .and. iyammp == 0 ) then
- if ( icfe == 0 ) then
- call check_neutral(x(l15),natom)
- else
- call ti_check_neutral(x(l15),natom)
- end if
- end if
-
- ! tell all nodes if this is a SEBOMD run
- call mpi_bcast(sebomd_obj%do_sebomd, 1, MPI_LOGICAL, 0, commsander, ierr)
- if (sebomd_obj%do_sebomd) then
- ! transfer SEBOMD info to the nodes
- call sebomd_bcast_obj()
- ! open necessary files
- if (master) then
- call sebomd_open_files
- end if
- ! initialize SEBOMD arrays
- call init_sebomd_arrays(natom)
- end if
-
- ! ---------------- Old parallel for minimization ----------------------
-
- if (imin /= 0) then
- mpi_orig = .true.
- notdone = 1
- else
- mpi_orig = .false.
- end if
-
- if (mpi_orig .and. .not. master) then
-
- ! ...all nodes only do the force calculations (JV)
- ! Minimisation so only only master gets past the loop below
- ! hence need to zero QM charges on non-master threads here.
-
- if (qmmm_nml%ifqnt) then
- ! Apply charge correction if required.
- if (qmmm_nml%adjust_q>0) then
- call qmmm_adjust_q(qmmm_nml%adjust_q, natom, qmmm_struct%nquant, qmmm_struct%nquant_nlink, &
- qmmm_struct%nlink, x(L15), &
- qmmm_struct%iqmatoms, qmmm_nml%qmcharge, qmmm_struct%atom_mask, &
- qmmm_struct%mm_link_mask, master,x(LCRD), qmmm_nml%vsolv)
- end if
- ! At this point we can also fill the qmmm_struct%scaled_mm_charges
- ! array - we only need to do this once as the charges are constant
- ! during a run. Having a separate array of scaled charges saves us
- ! having to do it on every qmmm routine call. Do this BEFORE zeroing
- ! the QM charges since that routine take care of these values as well.
- do i = 1, natom
- qmmm_struct%scaled_mm_charges(i) = x(L15+(i-1)) * INV_AMBER_ELECTROSTATIC &
- * qmmm_nml%chg_lambda ! charge scaling factor for FEP
- end do
- ! Zero out the charges on the quantum mechanical atoms
- call qm_zero_charges(x(L15),qmmm_struct%scaled_mm_charges,.true.)
- if (qmmm_struct%nlink > 0 ) then
- ! We need to exclude all electrostatic
- ! interactions with MM link pairs, both QM-MM and MM-MM. Do this by
- ! zeroing the MM link pair charges in the main charge array.
- ! These charges are stored in qmmm_struct%mm_link_pair_resp_charges in case
- ! they are later needed.
- call qm_zero_mm_link_pair_main_chg(qmmm_struct%nlink,qmmm_struct%link_pairs,x(L15), &
- qmmm_struct%scaled_mm_charges,.true.)
- end if
-
- end if
-
- if (igb == 7 .or. igb == 8) call igb7_init(natom, ncopy, x(l97)) !x(l97) is rborn()
- !Hai Nguyen: add igb == 8 here
-
- if ( ifcr /= 0 ) call cr_allocate( master, natom )
-
- n_force_calls = 0
- do while( notdone == 1 )
- n_force_calls = n_force_calls+1
- call force(x,ix,ih,ipairs,x(lcrd),x(lforce),ene,vir, &
- x(l96), x(l97), x(l98), x(l99), qsetup, &
- do_list_update,n_force_calls)
- end do
-
- ! Deallocate and return
- goto 999
-
- end if
-
- ! ----------------------------------------------------------------------
-
- if (master) then
- if(abfqmmm_param%abfqmmm /=1) write(6, '(a,i4,a,/)') '| Running AMBER/MPI version on ',numtasks, ' nodes' ! lam81
- !BTREE is selected by default if cpu is a power of two.
- !The number of processes is required to be a power of two for Btree
- !Print a warning about inefficiency with cpus not being a power of 2.
- if (numtasks > 1 .and. logtwo(numtasks) <= 0) then
- if(abfqmmm_param%abfqmmm /=1) write(6, '(a,i4,a,/)') '| WARNING: The number of processors is not a power of 2' ! lam81
- if(abfqmmm_param%abfqmmm /=1) write(6, '(a,i4,a,/)') '| this may be inefficient on some systems.' ! lam81
- end if
- end if
- if (master .and. numgroup > 1) write(6, '(a,i4,a,i4,a,i4,a)') &
- '| MULTISANDER: ', numgroup, ' groups. ', &
- numtasks, ' processors out of ', worldsize, ' total.'
- if (master) call amflsh(6)
-
- ! ========================= END AMBER/MPI =========================
-#else
- if(abfqmmm_param%abfqmmm == 1) then ! lam81
- if(abfqmmm_param%qmstep == 1 .and. abfqmmm_param%system == 1) then ! lam81
- allocate(abfqmmm_param%v(3*natom+iscale), stat=ier) ! lam81
- REQUIRE(ier==0) ! lam81
- allocate(abfqmmm_param%f(3*natom+iscale), stat=ier) ! lam81
- REQUIRE(ier==0) ! lam81
- allocate(abfqmmm_param%f1(3*natom+iscale), stat=ier) ! lam81
- REQUIRE(ier==0) ! lam81
- allocate(abfqmmm_param%f2(3*natom+iscale), stat=ier) ! lam81
- REQUIRE(ier==0) ! lam81
- end if ! lam81
- end if ! lam81
-
- ! debug needs to copy charges at start and they can't change later
- ! ---------------- Check system is neutral and print warning message ------
- ! ---------------- adjust charges for roundoff error. ------
- if( igb == 0 .and. ipb == 0 .and. iyammp == 0 ) call check_neutral(x(l15),natom)
-
- if (abfqmmm_param%qmstep == 1 .and. abfqmmm_param%system == 1) then ! lam81
- call amrset(ig+1)
- end if ! lam81
-
- if (abfqmmm_param%qmstep == 1 .and. abfqmmm_param%system == 1) then ! lam81
- call stack_setup()
- else ! lam81
- call deallocate_stacks ! lam81
- call stack_setup() ! lam81
- end if ! lam81
-
- if (sebomd_obj%do_sebomd) then
- ! open necessary files
- call sebomd_open_files
- ! initialize SEBOMD arrays
- call init_sebomd_arrays(natom)
- endif
-
-#endif /* MPI */
-
-#ifdef OPENMP
-
- ! If -openmp was specified to configure_amber then -DOPENMP is defined and the
- ! threaded version of MKL will have been linked in. It is important here that
- ! we set the default number of openmp threads for MKL to be 1 to stop conflicts
- ! with threaded vectorization routines when running in parallel etc.
- ! Individual calls to MKL from routines that know what they are doing - e.g.
- ! QMMM calls to diagonalizers etc can increase this limit as long as they
- ! put it back afterwards.
- call omp_set_num_threads(1)
-
- ! If we are using openmp for matrix diagonalization print some information.
- if (qmmm_nml%ifqnt .and. master) call qm_print_omp_info()
-#endif
-
- ! allocate memory for crg relocation
- if (ifcr /= 0) call cr_allocate( master, natom )
-
- ! initialize LIE module if used
- if ( ilrt /= 0 ) then
- call setup_linear_response(natom,nres,ih(m04),ih(m06),ix(i02),ih(m02),x(lcrd),x(l15), &
- ntypes, ix(i04), ix(i06), cn1, cn2, master)
- end if
-
- call date_and_time( setup_end_date, setup_end_time )
-
- ! Initialize the printing of ongoing time and performance summaries.
- ! We do this quite late here to avoid including all the setup time.
- if (master) call print_ongoing_time_summary(0,0,0.0d0,7)
-
- ! ----------------------------------------------------------------------
- ! Now do the dynamics or minimization.
- ! ----------------------------------------------------------------------
-
- if (igb == 7 .or. igb == 8 ) call igb7_init(natom, ncopy, x(l97)) !x(l97) is rborn()
- !Hai Nguyen: add igb ==8 here
-
- if (qmmm_nml%ifqnt) then
- ! Apply charge correction if required.
- if (qmmm_nml%adjust_q>0) then
- call qmmm_adjust_q(qmmm_nml%adjust_q, natom, qmmm_struct%nquant, qmmm_struct%nquant_nlink, &
- qmmm_struct%nlink, x(L15), &
- qmmm_struct%iqmatoms, qmmm_nml%qmcharge, qmmm_struct%atom_mask, &
- qmmm_struct%mm_link_mask, master,x(LCRD), qmmm_nml%vsolv)
- end if
- ! At this point we can also fill the qmmm_struct%scaled_mm_charges
- ! array - we only need to do this once as the charges are constant
- ! during a run. Having a separate array of scaled charges saves us
- ! having to do it on every qmmm routine call. Do this BEFORE zeroing
- ! the QM charges since that routine take care of these values as well.
- do i = 1, natom
- qmmm_struct%scaled_mm_charges(i) = x(L15+(i-1)) * INV_AMBER_ELECTROSTATIC &
- * qmmm_nml%chg_lambda ! charge scaling factor for FEP
- end do
-
- ! Zeroing of QM charges MUST be done AFTER call to check_neutral.
- ! Zero out the charges on the quantum mechanical atoms.
- call qm_zero_charges(x(L15),qmmm_struct%scaled_mm_charges,.true.)
-
- if (qmmm_struct%nlink > 0) then
- ! We need to exclude all electrostatic
- ! interactions with MM link pairs, both QM-MM and MM-MM. Do this by
- ! zeroing the MM link pair charges in the main charge array.
- ! These charges are stored in qmmm_struct%mm_link_pair_resp_charges in case
- ! they are later needed.
- call qm_zero_mm_link_pair_main_chg(qmmm_struct%nlink,qmmm_struct%link_pairs,x(L15), &
- qmmm_struct%scaled_mm_charges,.true.)
- end if
-
- end if
-
- ! Use the debugf namelist to activate
- call debug_frc(x,ix,ih,ipairs,x(lcrd),x(lforce),cn1,cn2,qsetup)
-
- ! Prepare for SGLD simulation
- if (isgld > 0) call psgld(natom,x(lmass),x(lvel), rem)
-
- ! Prepare for EMAP constraints
- if (temap) call pemap(dt,temp0,x,ix,ih)
-
- ! Prepare for Isotropic periodic sum of nonbonded interaction
- if (ips .gt. 0) call ipssys(natom,ntypes,ntb,x(l15), &
- cut,cn1,cn2,ix(i04),ix(i06),x(lcrd))
-
- if (master .and. (.not. qmmm_nml%ifqnt) .and. (abfqmmm_param%abfqmmm /= 1)) & ! lam81
- write(6,'(/80(''-'')/,'' 4. RESULTS'',/80(''-'')/)')
-
- ! Set up the MC barostat if requested
- if (ntp > 0 .and. barostat == 2) call mcbar_setup(ig)
-
- ! Input flag imin determines the type of calculation: MD, minimization, ...
- select case (imin)
- case (0)
- ! --- Dynamics:
-
- call timer_start(TIME_RUNMD)
- ! Set up AMD
- if (iamd .gt. 0) then
- call amd_setup(ntwx)
- endif
-
- ! Set up scaledMD
- if (scaledMD .gt. 0) then
- call scaledMD_setup(ntwx)
- endif
-
- if (ipimd > 0) then
- call pimd_init(natom,x(lmass),x(lwinv),x(lvel),ipimd)
- end if
-
- if(ineb>0) call neb_init()
-
-#ifdef MPI
- ! ----===== REMD =====----
- ! If this is not a REMD run, runmd is called only once.
- ! If this is a REMD run, runmd is called 0 to numexchg times,
- ! where the 0th runmd is just for getting initial PEs (no dynamics).
- if (rem == 0) then
- ! Not a REMD run. runmd will be called once.
- loop = 0
- else if (rem > 0) then
- ! This is a REMD run. runmd will be called numexchg times.
- loop = numexchg
-
- ! Set up temptable, open remlog, etc.
- call remd1d_setup(numexchg, hybridgb, numwatkeep, &
- temp0, mxvar, natom, ig, solvph)
- else
- ! Multi-D REMD run
- loop = numexchg
- call multid_remd_setup(numexchg, hybridgb, numwatkeep, &
- temp0, mxvar, natom, ig, solvph, irest)
- ! Now set up REMD indices for traj/restart writes. Only do this on
- ! master since only master handles writes.
- if (master) call setup_remd_indices
- end if ! Replica run setup
-
- ! Loop over REMD exchanges
- do mdloop = 0, loop
-
- ! ----===== REMD EXCHANGE HANDLING =====----
- ! Note: mdloop==0 is just used to get initial energies for the
- ! first exchange.
- if (rem < 0 .and. mdloop > 0) then
- call multid_remd_exchange(x, ix, ih, ipairs, qsetup, &
- do_list_update, temp0, solvph)
- else if ((rem == 1 .or. rem == 2) .and. mdloop > 0) then
- call remd_exchange(1, rem, x(lcrd), x(lvel), x(lmass), &
- nr3, natom, nr, temp0)
- else if (rem == 3 .and. mdloop > 0) then
- call hremd_exchange(1, x, ix, ih, ipairs, qsetup, do_list_update)
- ! force was called inside hremd_exchange, so call nmrdcp
- ! to decrement the NMR counter, since this should not count
- ! as a real step. This is OK, since the counter got
- ! incremented at the _very_ end of nmrcal, so we haven't already
- ! printed an unwanted value (JMS 2/12)
- if (nmropt /= 0) call nmrdcp
- else if (rem == 4 .and. mdloop > 0) then
- call ph_remd_exchange(1, solvph)
- end if ! rem>0 and mdloop>0
-
- ! ----===== END REMD EXCHANGE HANDLING =====----
-
-#ifdef VERBOSE_REMD
- if (rem > 0 .and. mdloop .eq. 0 .and. master) &
- write (6,'(a,i4)') "REMD: Getting initial energy for replica ",repnum
-#endif /* VERBOSE_REMD */
-#endif /* MPI */
-
-#ifndef DISABLE_NCSU
- if(abfqmmm_param%qmstep == 1 .and. abfqmmm_param%system == 1) then ! lam81
- call ncsu_on_sander_init(ih, x(lmass), x(lcrd), rem)
- end if ! lam81
-#endif /* DISABLE_NCSU */
-
- if (beeman_integrator == 1) then
- call AM_RUNMD(ix,ih,ipairs, &
- x(lwinv),x(lmass),x, &
- x(lcrd),x(lvel),x(lforce),qsetup)
- else
- call runmd(x,ix,ih,ipairs, &
- x(lcrd),x(lwinv),x(lmass),x(lforce), &
- x(lvel),x(lvel2),x(l45),x(lcrdr), &
- x(l50),x(l95),ix(i70),x(l75), &
- erstop,qsetup)
- end if !beeman_integrator == 1
-
-#ifndef DISABLE_NCSU
- if(abfqmmm_param%qmstep == 1 .and. abfqmmm_param%system == 1) then ! lam81
- call ncsu_on_sander_exit()
- end if ! lam81
-#endif /* DISABLE_NCSU */
-
- ! ----===== END REMD =====----
-#ifdef MPI
- end do ! Loop over REMD exchanges (mdloop)
-
- ! Cleanup REMD files.
- if (rem /= 0) call remd_cleanup()
-
-#endif
-
- call timer_stop(TIME_RUNMD)
-
- if (master) call amflsh(6)
-
- if (erstop) then
- ! This error condition stems from subroutine shake;
- ! furthermore, it seems that erstop can never be true since shake
- ! can never return with its third last argument, niter, equal to 0.
- ! SRB, Sep 24, 2003
- if (master) then
- write(6, *) 'FATAL ERROR'
- end if
- call mexit(6,1)
- end if
-
- case (1)
-
- !--- Minimization:
-
- ! Input flag ntmin determines the method of minimization
- select case (ntmin)
- case (0, 1, 2)
- call runmin(x,ix,ih,ipairs,x(lcrd),x(lforce),x(lvel), &
- ix(iibh),ix(ijbh),x(l50),x(lwinv),ix(ibellygp), &
- x(l95),ene, carrms, qsetup)
- ! If a conventional minimisation is being done,
- ! the restart file is written inside the runmin routine.
- case (LMOD_NTMIN_XMIN)
- write(6,'(a)') ' LMOD XMIN Minimization.'
- write(6,'(a)') ''
- write(6,'(a)') ' Note: Owing to the behaviour of the XMIN algorithm,'
- write(6,'(a)') ' coordinates in the trajectory and intermediate'
- write(6,'(a)') ' restart files will not match up with energies'
- write(6,'(a)') ' in the mdout and mdinfo files. The final energy'
- write(6,'(a)') ' and final coordinates do match.'
- write(6,'(a)') ''
- xmin_iter = 0
- call run_xmin( x, ix, ih, ipairs, &
- x(lcrd), x(lforce), ene, qsetup, xmin_iter, ntpr )
- if (master) call minrit(0,nrp,ntxo,x(lcrd)) ! Write the restart file
- case (LMOD_NTMIN_LMOD)
- write(6,'(a)') ' LMOD LMOD Minimization.'
- write(6,'(a)') ''
- write(6,'(a)') ' Note: Owing to the behaviour of the XMIN algorithm,'
- write(6,'(a)') ' coordinates in the trajectory and intermediate'
- write(6,'(a)') ' restart files will not match up with energies'
- write(6,'(a)') ' in the mdout and mdinfo files. The final energy'
- write(6,'(a)') ' and final coordinates do match.'
- write(6,'(a)') ''
- call run_lmod( x, ix, ih, ipairs, &
- x(lcrd), x(lforce), ene, qsetup )
- if (master) call minrit(0,nrp,ntxo,x(lcrd)) ! Write the restart file
- case default
- ! invalid ntmin
- ! ntmin input validation occurs in mdread.f
- ASSERT( .false. )
- end select
-
-
- case (5)
- ! ---carlos modified for reading trajectories (trajene option)
-
- write (6,*) "POST-PROCESSING OF TRAJECTORY ENERGIES"
-
- ! ---read trajectories and calculate energies for each frame
-
- call trajene(x,ix,ih,ipairs,ene,ok,qsetup)
-
- if (.not. ok) then
- write (6,*) 'error in trajene()'
- call mexit(6,1)
- end if
-
- case default
- ! invalid imin
- ! imin input validation should be transferred to mdread.f
- write(6,'(/2x,a,i3,a)') 'Error: Invalid IMIN (',imin,').'
- ASSERT( .false. )
- end select
-
-#ifdef MPI /* SOFT CORE */
- if (master) then
- if (icfe /=0 .and. ifsc == 1) call summarize_ti_changes(natom,resat)
- end if
-#endif
-
- ! finish up EMAP
- if (temap) call qemap()
-
- if (abfqmmm_param%abfqmmm /= 1) then ! lam81
- exit ! lam81
- else ! lam81
-#ifdef MPI /* lam81 */
- call mpi_barrier(commsander,ierr) ! lam81
-#endif /* lam81 */
- if (abfqmmm_param%qmstep /= abfqmmm_param%maxqmstep .or. abfqmmm_param%system /= 2) then ! lam81
- if(qmmm_nml%ifqnt) call deallocate_qmmm(qmmm_nml, qmmm_struct, qmmm_vsolv, qm2_params) ! lam81
- end if ! lam81
- call deallocate_m1m2m3() ! lam81
- if (abfqmmm_param%system == 2 .and. master) then ! lam81
- call abfqmmm_write_idrst() ! lam81
- call abfqmmm_write_pdb(x(lcrd),ix(i70)) ! lam81
- end if ! lam81
- call abfqmmm_next_step() ! lam81
- end if ! lam81
-
- end do ! lam81
-
- if(abfqmmm_param%abfqmmm == 1) then ! lam81
- deallocate(abfqmmm_param%id, stat=ier) ! lam81
- REQUIRE( ier == 0 ) ! lam81
- deallocate(abfqmmm_param%v, stat=ier) ! lam81
- REQUIRE( ier == 0 ) ! lam81
- deallocate(abfqmmm_param%f, stat=ier) ! lam81
- REQUIRE( ier == 0 ) ! lam81
- deallocate(abfqmmm_param%f1, stat=ier) ! lam81
- REQUIRE( ier == 0 ) ! lam81
- deallocate(abfqmmm_param%f2, stat=ier) ! lam81
- REQUIRE( ier == 0 ) ! lam81
- if(master) then ! lam81
- deallocate(abfqmmm_param%isqm, stat=ier) ! lam81
- REQUIRE( ier == 0 ) ! lam81
- endif ! lam81
- end if ! lam81
-
- ! -- calc time spent running vs setup
- call timer_stop(TIME_TOTAL)
- call wallclock( time1 )
- call date_and_time( final_date, final_time )
- call profile_time( time1 - time0, num_calls_nblist, profile_mpi)
-
-#ifdef MPI
- ! =========================== AMBER/MPI ===========================
-
- ! Set and broadcast notdone in mpi_orig case to inform
- ! other nodes that we are finished calling force(). (tec3)
-
- if (mpi_orig) then
- notdone = 0
- call mpi_bcast(notdone,1,mpi_integer,0, commsander,ierr)
- end if
-
- ! ========================= END AMBER/MPI =========================
-#endif
-
-! ========================= PUPIL INTERFACE =========================
-#ifdef PUPIL_SUPPORT
- ! Finalize Corba Interface
- puperror = 0
- call killcorbaintfc(puperror)
- if (puperror /= 0) then
- write(6,*) 'Error ending PUPIL CORBA interface.'
- end if
- write(6,'(a)') 'PUPIL CORBA interface finalized.'
- pupactive = .false.
-#endif
-! ========================= PUPIL INTERFACE =========================
-
-#ifdef _XRAY
- !(out_lun,residue_pointer,residue_label,atom_name,coor,num_bonds,ibond,jbond)
- call xray_fini()
-#endif
-
- call amflsh(6)
- if (master) then
-#ifdef MPI
- ! adaptive QM/MM (qmmm_nml%vsolv=2) via multisander
- ! all groups have identical coords and velocities
- ! only master of first group needs to dump results
- if ( (qmmm_nml%vsolv < 2) .or. (worldrank == 0) ) then
-#endif
- call close_dump_files
-#ifdef MPI
- end if
-#endif
-
- if (icnstph /= 0) &
- call cnstph_finalize
- ! --- write out final times, taking REMD into account
-#ifdef MPI
- if (rem .ne. 0) then
- nstlim_total = nstlim * numexchg
- else
- nstlim_total = nstlim
- end if
-#else
- nstlim_total = nstlim
-#endif
- if (imin == 0) &
- call print_ongoing_time_summary(nstlim_total,nstlim_total,dt,6)
-
- write(6,'(12(a))') '| Job began at ', initial_time(1:2), &
- ':', initial_time(3:4), ':', initial_time(5:10), ' on ',&
- initial_date(5:6), '/', initial_date(7:8), '/', initial_date(1:4)
- write(6,'(12(a))') '| Setup done at ', setup_end_time(1:2), &
- ':', setup_end_time(3:4), ':', setup_end_time(5:10), ' on ', &
- setup_end_date(5:6), '/',setup_end_date(7:8),'/',setup_end_date(1:4)
- write(6,'(12(a))') '| Run done at ', final_time(1:2), &
- ':', final_time(3:4), ':', final_time(5:10), ' on ', &
- final_date(5:6), '/', final_date(7:8), '/', final_date(1:4)
- call nwallclock( ncalls )
- write(6, '(''|'',5x,''wallclock() was called'',I8,'' times'')') ncalls
- call amflsh(6)
-
- if (iesp > 0) then
- call esp(natom,x(lcrd),x(linddip))
- end if
- end if
- call amflsh(6)
-
- ! --- dynamic memory deallocation:
- 999 continue
-
- if(qmmm_nml%ifqnt .and. qmmm_nml%qmtheory%EXTERN .and. master) then
- call qm2_extern_finalize()
- endif
-
- if (qmmm_nml%ifqnt .and. .not. qmmm_struct%qm_mm_first_call) then
- ! If first_call is still true, this thread never really
- ! called the QMMM routine. E.g. more threads than PIMD replicates
- call deallocate_qmmm(qmmm_nml, qmmm_struct, qmmm_vsolv, qm2_params)
- end if
-
- if (ipimd > 0) call pimd_finalize(ipimd)
-
- if (ineb > 0) call neb_finalize()
-
- if (idecomp > 0) then
- call deallocate_real_decomp()
- call deallocate_int_decomp()
- end if
- if (master .and. idecomp == 0) call deallocate_int_decomp()
-
-#ifdef MPI /* SOFT CORE */
- if (ifsc /= 0) call cleanup_sc()
- if (ifmbar /= 0) call cleanup_mbar()
-#endif
-
- ! finalize LIE module if initiated above
- if ( ilrt /= 0 ) then
- call cleanup_linear_response(master)
- end if
-
-#ifdef RISMSANDER
- call rism_finalize()
-#endif
-
- if ( ifcr /= 0 ) call cr_cleanup()
-
- if (sebomd_obj%do_sebomd) then
- if (master) then
- call sebomd_close_files
- end if
- call cleanup_sebomd_arrays
- end if
-
- if (master .and. iwrap == 2) then
- deallocate(iwrap_mask_atoms, stat=ier)
- REQUIRE(ier == 0)
- end if
- call nblist_deallocate()
- call deallocate_stacks()
- if ((igb /= 0 .and. igb /= 10 .and. ipb == 0) .or. hybridgb > 0 .or. icnstph > 1) then
- call deallocate_gb()
- end if
- if (master) then
- if(igb == 10 .or. ipb /= 0) then
- call pb_free()
- end if
- end if
- deallocate(ih, stat = ier)
- REQUIRE(ier == 0)
- deallocate(ipairs, stat = ier)
- REQUIRE(ier == 0)
- deallocate(ix, stat = ier)
- REQUIRE(ier == 0)
- deallocate(x, stat = ier)
- REQUIRE(ier == 0)
- if(ntb > 0 .and. ifbox == 1 .and. ew_type == 0 .and. mpoltype == 0) &
- call deallocate_m1m2m3()
- call AMOEBA_deallocate
- ! GMS: -- Module molecule --
- call deallocate_molecule()
- ! --------------------------
-
- if (charmm_active) call charmm_deallocate_arrays()
- if (cmap_active) call deallocate_cmap_arrays()
-
- if (master.and.mdout /= 'stdout') close(6)
-
- return
-
-end subroutine sander
-
-!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-!+ Calculate the ElectroStatic Potential
-subroutine esp(natom,x,mom_ind)
-
- ! routine to calculate the ESP due to the induced moments (only)
- ! at the same spatial points as the reference QM.
- use constants, only : zero, BOHRS_TO_A, INV_AMBER_ELECTROSTATIC
- use file_io_dat
- implicit none
- integer natom
- _REAL_ x(3,*)
- _REAL_ mom_ind(3,*)
-
-# include "ew_mpole.h"
-
- integer dat_unit, new_unit, minus_new_unit
- parameter(dat_unit=30, new_unit=31, minus_new_unit=33)
-
- integer inat, nesp, idum
- _REAL_ xin, yin, zin
- integer jn, kn
- _REAL_ esp_qm, xb_esp, yb_esp, zb_esp
- _REAL_ x_esp, y_esp, z_esp
- _REAL_ e_x, e_y, e_z, e_q, esp_new
- _REAL_ dist, dist3
- integer iptr
-
- call amopen(dat_unit,"esp.dat",'O','F','R')
- call amopen(new_unit,"esp.induced",owrite,'F','W')
- call amopen(minus_new_unit,"esp.qm-induced",owrite,'F','W')
- read (dat_unit,'(3i5)')inat,nesp,idum
- write(6,'(t2,''inat = '',i5)')inat
- write(6,'(t2,''nesp = '',i5)')nesp
-
- write(new_unit,'(2i5)')inat,nesp
- write(minus_new_unit,'(2i5)')inat,nesp
-
- if (inat /= natom) then
- write(6,'(t2,''natom mismatch with esp file'')')
- call mexit(6,1)
- end if
-
- do jn = 1,inat
- read (dat_unit,'(17x,3e16.0)')xin,yin,zin
- write(new_unit,'(17x,3e16.7)')xin,yin,zin
- write(minus_new_unit,'(17x,3e16.7)')xin,yin,zin
- end do
-
- do jn = 1,nesp
- e_x = zero
- e_y = zero
- e_z = zero
- e_q = zero
- read(dat_unit,'(1x,4e16.0)')esp_qm,xb_esp,yb_esp,zb_esp
- x_esp = xb_esp * BOHRS_TO_A
- y_esp = yb_esp * BOHRS_TO_A
- z_esp = zb_esp * BOHRS_TO_A
-
- do kn = 1,natom
- dist = (sqrt((x(1,kn)-x_esp)**2 + &
- (x(2,kn)-y_esp)**2 + &
- (x(3,kn)-z_esp)**2))
- dist3 = dist**3
- e_x = e_x - mom_ind(1,kn )*(x(1,kn)-x_esp)/dist3
- e_y = e_y - mom_ind(2,kn )*(x(2,kn)-y_esp)/dist3
- e_z = e_z - mom_ind(3,kn )*(x(3,kn)-z_esp)/dist3
- end do
-
- e_x = e_x * BOHRS_TO_A * INV_AMBER_ELECTROSTATIC
- e_y = e_y * BOHRS_TO_A * INV_AMBER_ELECTROSTATIC
- e_z = e_z * BOHRS_TO_A * INV_AMBER_ELECTROSTATIC
- e_q = e_q * BOHRS_TO_A * INV_AMBER_ELECTROSTATIC
- esp_new = e_x + e_y + e_z
-
- write(new_unit, '(1x,4e16.7)')esp_new, &
- xb_esp,yb_esp,zb_esp
- write(minus_new_unit,'(1x,4e16.7)')esp_qm-esp_new, &
- xb_esp,yb_esp,zb_esp
- end do
-
- close(dat_unit)
- close(new_unit)
- close(minus_new_unit)
-
- return
-
-end subroutine esp
-
diff --git a/patches/amber14.diff/AmberTools/src/sander/sander.F90.preplumed b/patches/amber14.diff/AmberTools/src/sander/sander.F90.preplumed
deleted file mode 100644
index c4b7bf48f29651552934994e5f9c7fa4f9755d2c..0000000000000000000000000000000000000000
--- a/patches/amber14.diff/AmberTools/src/sander/sander.F90.preplumed
+++ /dev/null
@@ -1,1922 +0,0 @@
-#include "copyright.h"
-#include "../include/dprec.fh"
-#include "../include/assert.fh"
-#include "ncsu-config.h"
-
-!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-!+ The Molecular Dynamics/NMR Refinement/Modeling Module of the AMBER
-!-----------------------------------------------------------------------
-! --- SANDER ---
-!-----------------------------------------------------------------------
-
-subroutine sander()
-
- use state
-#ifndef DISABLE_NCSU
- use ncsu_sander_hooks, only : &
- ncsu_on_sander_init => on_sander_init, &
- ncsu_on_sander_exit => on_sander_exit
-#endif /* DISABLE_NCSU */
-
- use lmod_driver
- use constants, only : INV_AMBER_ELECTROSTATIC
- ! The main qmmm_struct contains all the QMMM variables and arrays
- use qmmm_module, only : qmmm_nml, qmmm_struct, deallocate_qmmm, qmmm_mpi, &
-#ifdef MPI
- qmmm_mpi_setup, &
-#endif
- qm2_struct, qmewald, qm_gb, qmmm_vsolv, qm2_params
-
- use qmmm_vsolv_module, only: qmmm_vsolv_store_parameters, new
-
- use qm2_extern_module, only: qm2_extern_finalize
- use sebomd_module, only : sebomd_obj, &
- sebomd_open_files, sebomd_close_files, &
-#ifdef MPI
- sebomd_bcast_obj, &
-#endif
- sebomd_setup
-
- use sebomd_arrays, only : init_sebomd_arrays, cleanup_sebomd_arrays
-
- use genborn
- use decomp, only : allocate_int_decomp, allocate_real_decomp, &
- deallocate_int_decomp, deallocate_real_decomp, &
-#ifdef MPI
- synchronize_dec, build_dec_mask, decmask, &
-#endif
- nat, nrs, jgroup, indx
- use fastwt
- use relax_mat
- use nmr, only: nmrrad, impnum
- use ew_recip, only: deallocate_m1m2m3,first_pme
- use parms
- use molecule, only : mol_info, n_iwrap_mask_atoms, iwrap_mask_atoms, &
- allocate_molecule, deallocate_molecule
- use nblist, only:cutoffnb,skinnb,nblist_allocate,nblist_deallocate, &
- nblist_allreal,nblist_allint, num_calls_nblist, first_list_flag
- use stack
- use amoeba_runmd, only : AM_RUNMD_get_coords,AM_RUNMD
- use amoeba_mdin, only : beeman_integrator,iamoeba,am_nbead
- use amoeba_interface, only : AMOEBA_deallocate,AMOEBA_readparm
-
-#ifdef RISMSANDER
- use sander_rism_interface, only: rismprm,rism_setparam, rism_init,rism_finalize
-#endif
-
-#ifdef PUPIL_SUPPORT
- use pupildata
-#endif /* PUPIL */
-
-#ifdef APBS
- use apbs
-#endif /* APBS */
-
-#ifdef _XRAY
- use xray_interface_module, only: xray_init, xray_read_parm, xray_fini
-#endif
-
-#ifdef MPI /* SOFT CORE */
- use softcore, only: setup_sc, cleanup_sc, ifsc, extra_atoms, sc_sync_x, &
- summarize_ti_changes, sc_check_perturbed_molecules, ti_check_neutral, tishake
- use mbar, only: setup_mbar, cleanup_mbar, ifmbar
-#endif
-
- ! for LIE calculations
- use linear_response, only: ilrt, setup_linear_response, &
- cleanup_linear_response
-
-#if defined(MPI)
- use evb_parm, only: xch_type
-# if defined(LES)
- use evb_pimd, only: evb_pimd_init, PE_slice, master_worldrank, jobs_per_node
-# endif
-! REMD
- use remd, only : rem, mdloop, repnum, remd1d_setup, remd_exchange, &
- remd_cleanup, hremd_exchange, ph_remd_exchange, &
- multid_remd_setup, multid_remd_exchange
- use bintraj, only: setup_remd_indices
-#else
-# define rem 0
-#endif /* MPI */
-
- use pimd_vars, only: ipimd
- use neb_vars, only: ineb
-
- use trajenemod, only: trajene
-
-!RCW+MJW CHARMM SUPPORT
- use charmm_mod, only : charmm_active, charmm_deallocate_arrays, &
- charmm_filter_out_qm_atoms
- use ff11_mod, only : cmap_active, deallocate_cmap_arrays
-
- use memory_module, only: x, ix, ih, memory_init
-
-! Self-Guided molecular/Langevin Dynamics (SGLD)
- use sgld, only : isgld,psgld
-
- use nbips, only: ipssys,ips
-
- use crg_reloc, only: ifcr, cr_backup_charge, cr_cleanup, cr_allocate, &
- cr_read_input, cr_check_input, cr_print_info
-
- use emap,only: temap,pemap,qemap
-
- use file_io_dat
- use constantph, only : cnstph_finalize
- use barostats, only : mcbar_setup
-
-!AMD
- use amd_mod
-!scaledMD
- use scaledMD_mod
-
- use abfqmmm_module ! lam81
-
- implicit none
-
- logical belly, erstop
- integer ier,ifind,jn,ncalls,xmin_iter
- character(len=4) itest
- logical ok
- logical newstyle
-# include "../include/memory.h"
-# include "nmr.h"
-# include "box.h"
-# include "../include/md.h"
-# include "extra.h"
-# include "tgtmd.h"
-# include "multitmd.h"
-# include "les.h"
-
-# include "parallel.h"
-#ifdef MPI
- ! =========================== AMBER/MPI ===========================
-# ifdef MPI_DOUBLE_PRECISION
-# undef MPI_DOUBLE_PRECISION
-# endif
- include 'mpif.h'
-# ifdef CRAY_PVP
-# define MPI_DOUBLE_PRECISION MPI_REAL8
-# endif
-# ifdef MPI_BUFFER_SIZE
- integer*4 mpibuf(mpi_buffer_size)
-# endif
-! REMD: loop is the current exchange. runmd is called numexchg times.
- integer loop
-
- integer nrank, istat
- _REAL_ ener(30),vir(4)
- integer ierr
- integer partner
-! ========================= END AMBER/MPI =========================
-#endif
-# include "ew_pme_recip.h"
-# include "ew_frc.h"
-# include "ew_erfc_spline.h"
-# include "ew_parallel.h"
-# include "ew_mpole.h"
-# include "ew_cntrl.h"
-# include "def_time.h"
-
- type(state_rec) :: ene
- integer native,nr3,nr
-
- ! nmrcal vars
- _REAL_ f,enmr,devdis,devang,devtor,devplpt,devpln,devgendis,ag,bg,cg
- ! Updated 9/2007 by Matthew Seetin to enable plane-point and plane-plane
- ! restraints
- _REAL_ emtmd
- integer numphi,nhb
-
- ! runmin/trajene var
- _REAL_ carrms
-
- ! dipole moment stuff
- integer ngrp
-
- character(len=8) initial_date, setup_end_date, final_date
- character(len=10) initial_time, setup_end_time, final_time
- integer nstlim_total ! for final time printout
-
- _REAL_ time0, time1
-
- integer idiff,i,j,istop,index,ierror,itemp
-
- integer, dimension(:), allocatable :: ipairs
- integer :: n_force_calls
- logical qsetup
- logical :: do_list_update=.false.
- _REAL_ :: box_center(3) ! lam81
-#ifdef MPI_DEBUGGER
- integer, volatile :: release_debug
-
- ! So only the master master thread has release_debug = 0
- release_debug = worldrank
-
- ! Lock us into an infinite loop while release_debug == 0 on any thread (only
- ! the master here). This allows you to connect a debugger to any running
- ! process without having to 'race' program execution. A debugger MUST be
- ! attached to the master thread (typically the thread with the lowest PID),
- ! and have release_debug set to NOT 0 (e.g., via "set release_debug=1").
- do
- if (release_debug .ne. 0) exit
- end do
-
- ! Prevent any other threads from progressing past this point until all
- ! threads you want to watch with a debugger are watched and all those
- ! threads are continued.
- call mpi_barrier(mpi_comm_world, ierr)
-#endif
-
- ! ---- HERE BEGIN THE EXECUTABLE STATEMENTS ----
-
- ! Initialize the cpu timer. Needed for machines where returned cpu times
- ! are relative.
- call date_and_time( initial_date, initial_time )
- call wallclock( time0 )
- call init_timers()
-
- ! Initialize the printing of ongoing time and performance summaries.
-! call print_ongoing_time_summary(0,0,0.0d0,7)
- call print_ongoing_time_summary(0,0,0.0d0,7,time0)
-
- ! BPR - original location of PUPIL interface. I moved it further down
- ! because, if it's here, it can't print stuff; write(6,...) statements
- ! assume mdread1() has already been invoked. However, moving this down
- ! may break other things.
-
- ! ==== Flag to tell list builder to print size of list on first call =======
- first_list_flag = .true.
- ! ==== Flag to tell recip space routines to allocate on first call =======
- first_pme = .true.
-
- ! ==== Initialise first_call flags for QMMM ====
- qmmm_struct%qm_mm_first_call = .true.
- qmmm_struct%fock_first_call = .true.
- qmmm_struct%fock2_2atm_first_call = .true.
- qmmm_struct%qm2_allocate_e_repul_first_call = .true.
- qmmm_struct%qm2_calc_rij_eqns_first_call = .true.
- qmmm_struct%qm2_scf_first_call = .true.
- qmmm_struct%zero_link_charges_first_call = .true.
- qmmm_struct%adj_mm_link_pair_crd_first_call = .true.
- qmmm_struct%num_qmmm_calls = 0
-
-#ifdef MPI
- ! Parallel initialization (setup is done in multisander.F90).
-
- ! Make PE 0 the master
- master = mytaskid == 0
- master_master = masterrank == 0
-
- if ( master .and. numtasks > MPI_MAX_PROCESSORS ) then
- write(0, '(a,i4,a,i4)') &
- 'Error: the number of processors must not be greater than ', &
- MPI_MAX_PROCESSORS, ', but is ', numtasks
- call mexit(6,1)
- end if
-# ifdef MPI_BUFFER_SIZE
- call mpi_buffer_attach(mpibuf, mpi_buffer_size*4, ierr)
-# endif
-#else /* not MPI follows */
- ! In the single-threaded version, the one process is master
- master = .true.
-#endif /* MPI */
-
- erstop = .false.
- qsetup = .true.
-
- ! --- generic packing scheme ---
-
- nwdvar = 1
- native = 32
-#ifdef ISTAR2
-
- ! --- Int*2 packing scheme ---
-
- nwdvar = 2
-#endif /*ISTAR2*/
- numpk = nwdvar
- nbit = native/numpk
-
- ! ----- Only the master node (only node when single-process)
- ! performs the initial setup and reading/writing -----
-
- call timer_start(TIME_TOTAL)
-
- call abfqmmm_init_param() ! lam81
-
- do while ( (abfqmmm_param%qmstep <= abfqmmm_param%maxqmstep) &
- .or. (abfqmmm_param%maxqmstep == 0 .and. abfqmmm_param%system == 2) ) ! lam81
-
- masterwork: if (master) then
-
- if (abfqmmm_param%abfqmmm == 0) then ! lam81
-
- ! ---- first, initial reads to determine memory sizes:
- call mdread1()
- call amopen(8,parm,'O','F','R')
- call rdparm1(8)
- if (mtmd /= 'mtmd' .or. itgtmd == 2) call mtmdlx(natom)
- ! --- now, we can allocate memory:
-
- call locmem()
- write(6,'(/,a,5x,a)') '|','Memory Use Allocated'
- write(6,'(a,5x,a,i14)') '|', 'Real ', lastr
- write(6,'(a,5x,a,i14)') '|', 'Hollerith ', lasth
- write(6,'(a,5x,a,i14)') '|', 'Integer ', lasti
- write(6,'(a,5x,a,i14)') '|', 'Max Pairs ', lastpr
-
- ! --- dynamic memory allocation:
-
- ! GMS:
- ! Allocate space for module molecule
- ! in the master node
- mol_info%natom = natom
- mol_info%nres = nres
- call allocate_molecule()
-
- ! Allocate all global arrays
- allocate( x(lastr), ix(lasti), ipairs(lastpr), ih(lasth), stat = ier )
- REQUIRE( ier == 0 )
- ix(1:lasti) = 0
-
- ! This sets up pointer arrays in MEMORY_MODULE to match array-offsets into
- ! the shared X, IX, and IH arrays. Eventually, LOCMEM code should be
- ! merged with MEMORY_MODULE to allocate individual allocatable arrays, but
- ! that will also require updating the MPI code to handle individual
- ! arrays.
- call memory_init()
-
- ! Allocate the parm arrays
- call allocate_parms()
-
- if ((igb /= 0 .and. igb /= 10 .and. ipb == 0) &
- .or.hybridgb>0.or.icnstph.gt.1) &
- call allocate_gb( natom, ncopy )
-
- if( idecomp > 0 ) then
-#ifdef MPI
- if (ifsc > 0) then
- call synchronize_dec(natom, nres)
- else
- nat = natom
- nrs = nres
- end if
-#else
- nat = natom
- nrs = nres
-#endif
- call allocate_int_decomp(natom, nres)
- else
- call allocate_int_decomp(1, 1)
- end if
-
- write(6,'(a,5x,a,i14)' ) '|', 'nblistReal', nblist_allreal
- write(6,'(a,5x,a,i14)' ) '|', 'nblist Int', nblist_allint
- write(6,'(a,5x,a,i14,a)') '|', ' Total ', &
- (8*(lastr+lastrst+nblist_allreal) &
- + 4*(lasth+lasti+lastpr+lastist+nblist_allint))/1024, &
- ' kbytes'
-
- ! --- finish reading the prmtop file and other user input:
- call rdparm2(x,ix,ih,ipairs,8)
-
- call AMOEBA_readparm(8,ntf,ntc,natom,x(lmass))! ntf,ntc get reset if amoeba prmtop
-#ifdef _XRAY
- call xray_read_parm(8,6)
-#endif
-
- end if ! lam81
-
- if (qmmm_nml%ifqnt .or. abfqmmm_param%abfqmmm == 1) then ! lam81
- if(abfqmmm_param%abfqmmm == 0) then ! lam81
- call sebomd_setup
- call read_qmmm_nm_and_alloc(igb, ih, ix, x, cut, use_pme, ntb, 0) ! lam81
- if (qmmm_nml%qmtheory%SEBOMD) then
- ! don't do QM/MM
- qmmm_nml%ifqnt= .false.
- sebomd_obj%do_sebomd = .true.
- end if
- end if ! lam81
- if(qmmm_struct%abfqmmm == 1 .and. abfqmmm_param%abfqmmm == 0) then ! lam81
- call abfqmmm_setup(natom,nres,ix(i02),ih(m04),ih(m02),x(lmass), & ! lam81
- nbonh,nbona,ix(iibh),ix(ijbh),ix(iiba),ix(ijba)) ! lam81
- nr=natom ! lam81
- call AMOEBA_check_newstyle_inpcrd(inpcrd,newstyle) ! lam81
- if (newstyle) then ! lam81
- call AM_RUNMD_get_coords(natom,t,irest,ntb,x(lcrd),x(lvel)) ! lam81
- else ! lam81
- call getcor(nr,x(lcrd),x(lvel),x(lforce),ntx,box,irest,t,temp0,.FALSE.) ! lam81
- end if ! lam81
- abfqmmm_param%maxqmstep = nstlim ! lam81
- end if ! lam81
- if(abfqmmm_param%abfqmmm == 1) then ! lam81
- if(abfqmmm_param%system == 1) then ! lam81
- call abfqmmm_update_qmatoms(x(lcrd)) ! lam81
- if(abfqmmm_param%ntwpdb < 0) then ! lam81
- call abfqmmm_write_pdb(x(lcrd),ix(i70)) ! lam81
- close(6) ! lam81
- call mexit(6,1) ! lam81
- end if ! lam81
- end if ! lma81
- call abfqmmm_select_system_qmatoms(natom) ! lam81
- if(qmmm_nml%ifqnt) then ! lam81
- call read_qmmm_nm_and_alloc(igb,ih,ix,x,cut,use_pme,ntb,abfqmmm_param%qmstep, & ! lam81
- abfqmmm_param%isqm,abfqmmm_param%abfcharge) ! lam81
- end if ! lam81
- endif ! lam81
- end if ! lam81
-
- if (abfqmmm_param%qmstep == 1 .and. abfqmmm_param%system == 1) then ! lam81
-
- call mdread2(x,ix,ih,ipairs)
-
- endif ! lam81
-
-#if defined(RISMSANDER)
- call rism_setparam(mdin,&
- commsander,&
- natom,ntypes,x(L15:L15+natom-1),&
- x(LMASS:LMASS+natom-1),cn1,cn2,&
- ix(i04:i04+ntypes**2-1), ix(i06:i06+natom-1))
-#endif /*RISMSANDER*/
-
- if ( ifcr /= 0 ) then
- call cr_read_input(natom)
- call cr_check_input( ips )
- !call cr_print_info(6)
- call cr_backup_charge( x(l15), natom )
- end if
-
- ! --- alloc memory for decomp module that needs info from mdread2
- if (idecomp == 1 .or. idecomp == 2) then
- call allocate_real_decomp(nrs)
-#ifdef MPI
- ! -- ti decomp
- if (ifsc > 0) then
- ! following lines don't really seem to make sense(?)
- ! partner = ieor(masterrank,1)
- ! if (nat == natom) then
- ! nrank = masterrank
- ! else
- ! nrank = partner
- ! end if
- call mpi_bcast(jgroup, nat, MPI_INTEGER, 0, commmaster, ierr)
- end if
-#endif
- else if( idecomp == 3 .or. idecomp == 4 ) then
- call allocate_real_decomp(npdec*npdec)
- end if
-
- ! ----- EVALUATE SOME CONSTANTS FROM MDREAD SETTINGS -----
-
- nr = nrp
- nr3 = 3*nr
- belly = ibelly > 0
-
- ! ========================= PUPIL INTERFACE =========================
-#ifdef PUPIL_SUPPORT
-
- ! I moved the PUPIL interface down here so that write() statements work
- ! as advertised. BPR 9/7/09
-
- ! Initialise the CORBA interface
- puperror = 0
- call fixport()
- call inicorbaintfcmd(puperror)
- if (puperror .ne. 0) then
- write(6,*) 'Error creating PUPIL CORBA interface.'
- call mexit(6,1)
- end if
- pupactive = .true.
- write(6,*) 'PUPIL CORBA interface initialized.'
-
- ! Allocation of memory and initialization
- pupStep = 0
- puperror = 0
- allocate (qcell (12 ),stat=puperror)
- allocate (pupmask (natom ),stat=puperror)
- allocate (pupqlist(natom ),stat=puperror)
- allocate (pupatm (natom ),stat=puperror)
- allocate (pupchg (natom ),stat=puperror)
- allocate (qfpup (natom*3),stat=puperror)
- allocate (qcdata (natom*9),stat=puperror)
- allocate (keyMM (natom ),stat=puperror)
- allocate (pupres (nres ),stat=puperror)
- allocate (keyres (nres ),stat=puperror)
-
- if (puperror /= 0) then
- write(6,*) 'Error allocating PUPIL interface memory.'
- call mexit(6,1)
- end if
-
- ! Initialise the "atomic numbers" and "quantum forces" vectors
- pupqatoms = 0
- iresPup = 1
- pupres(1) = 1
- do iPup=1,natom
- bs1 = (iPup-1)*3
- call get_atomic_number_pupil(ih(iPup+m06-1),x(lmass+iPup-1),pupatm(iPup))
- if (iresPup .lt. nres) then
- if (iPup .ge. ix(iresPup+i02)) then
- iresPup = iresPup + 1
- pupres(iresPup) = iPup
- end if
- end if
- write (strAux,"(A4,'.',A4)") trim(ih(iresPup+m02-1)),adjustl(ih(iPup+m04-1))
- keyres(iresPup) = trim(ih(iresPup+m02-1))
- keyMM(iPup) = trim(strAux)
-
- ! Retrieve the initial charges
- pupchg(iPup) = x(L15+iPup-1)
- !write(6,*) 'Atom num.',iPup,'Label,Mass,Atomic Num.', keyMM(iPup),x(lmass+iPup-1),pupatm(iPup), 'Charge', pupchg(iPup)
-
- do jPup=1,3
- qfpup(bs1+jPup) = 0.0d0
- end do
- end do
-
- write(6,*) 'Got all atomic numbers.'
-
- ! Initialise the PUPIL cell
- do iPup=1,12
- qcell(iPup) = 0.0d0
- end do
-
- ! Submit the KeyMM particles and their respective atomic numbers to PUPIL
- puperror = 0
- call putatomtypes(natom,puperror,pupatm,keyMM)
- if (puperror .ne. 0) then
- write(6,*) 'Error sending MM atom types to PUPIL.'
- call mexit(6,1)
- end if
-
- ! Submit the Residue Pointer vector to PUPIL
- write(6,"(a20,1x,i6,3x,a17,1x,i6)") 'Number of residues =', nres, 'Number of atoms =', natom
- !do iPup=1,nres
- ! write(6,*) 'Residue ',iPup,keyres(iPup),pupres(iPup)
- !end do
- puperror = 0
- call putresiduetypes(nres,puperror,pupres,keyres)
- if (puperror .ne. 0) then
- write(6,*) 'Error sending MM residue types to PUPIL.'
- call mexit(6,1)
- end if
-
- write(6,*) 'Sent system data to PUPIL.'
- write(*,*) 'PUPIL structure initialized.'
-#endif
- ! ========================= PUPIL INTERFACE =========================
-
- ! --- seed the random number generator ---
-
- ! DAN ROE: Note master node only here
- if (abfqmmm_param%qmstep == 1 .and. abfqmmm_param%system == 1) then ! lam81
-#ifdef MPI
- if (rem == 0) then
- call amrset(ig)
- else
- ! carlos: set random seed different for different replicas
- ! but keep same seed for cpus in the same replica since
- ! we want data from diff # cpus to match
- call amrset(ig + (17 * nodeid)) ! nodeid is in md.h and is repnum - 1
- end if
-#else
- call amrset(ig)
-#endif
-
- if (nbit < 32 .and. nr > 32767) then
- write(6, *) ' Too many atoms for 16 bit pairlist -'
- write(6, *) ' Recompile without ISTAR2'
- call mexit(6, 1)
- end if
-
- if (ntp > 0.and.iabs(ntb) /= 2) then
- write(6,*) 'Input of NTP/NTB inconsistent'
- call mexit(6, 1)
- end if
- end if ! lam81
-
- ! ----- READ COORDINATES AND VELOCITIES -----
-
- if (abfqmmm_param%qmstep == 1 .and. abfqmmm_param%system == 1) then ! lam81 <<< QMSTEP=1 BLOCK >>>
-
- call timer_start(TIME_RDCRD)
-#ifdef LES
- call getcor(nr,x(lcrd),x(lvel),x(lforce),ntx,box,irest,t,temp0les,.TRUE.,solvph)
-#else
- call AMOEBA_check_newstyle_inpcrd(inpcrd,newstyle)
- if (newstyle) then
- call AM_RUNMD_get_coords(natom,t,irest,ntb,x(lcrd),x(lvel))
- else
- call getcor(nr,x(lcrd),x(lvel),x(lforce),ntx,box,irest,t,temp0,.TRUE.,solvph)
- end if
-#endif
- if (iamoeba > 0) then
- natom = natom*am_nbead
- nrp = nrp*am_nbead
- nr = nr*am_nbead
- nr3 = nr3*am_nbead
- ncopy = am_nbead
- end if
-
- ! M-WJ
- !if( igb == 0 .and. induced == 1 ) call get_dips(x,nr)
-! WJM if is a polarizable model, reading input dipole information
- if (igb == 0 .and. ipb == 0 .and. induced > 0) call get_dips(x,nr)
-
-#ifdef APBS
- ! APBS initialization
- if (mdin_apbs) then
- ! in: natom, coords, charge and radii (from prmtop)
- ! out: pb charges and pb radii (via apbs_vars module)
- call apbs_init(natom, x(lcrd), x(l15), x(l97))
- end if
-#endif /* APBS */
-
-#ifdef _XRAY
- call xray_init()
-#endif
-
- ! ----- SET THE INITIAL VELOCITIES -----
-
- if (ntx <= 3) then
- call setvel(nr,x(lvel),x(lwinv),tempi,init,iscale,scalm)
- ! random numbers may have been "used up" in setting the intial
- ! velocities; re-set the generator so that all nodes are back in
- ! sync
-
- ! DAN ROE: Note master node only here
-#ifdef MPI
- if (rem == 0) call amrset(ig)
-#else
- call amrset(ig)
-#endif
-
- end if
- if (belly) call bellyf(natom,ix(ibellygp),x(lvel))
- call timer_stop(TIME_RDCRD)
-
- if(abfqmmm_param%abfqmmm == 1 .and. ntb > 0) then ! lam81
- call iwrap2(abfqmmm_param%n_user_qm, abfqmmm_param%user_qm, x(lcrd), box_center) ! lam81
- end if ! lam81
-
- ! --- If we are reading NMR restraints/weight changes,
- ! read them now:
-
- if (nmropt >= 1) then
- call nmrcal(x(lcrd),f,ih(m04),ih(m02),ix(i02),x(lwinv),enmr, &
- devdis,devang,devtor,devplpt,devpln,devgendis,temp0,tautp,cut,ntb,x(lnmr01), &
- ix(inmr02),x(l95),5,6,rk,tk,pk,cn1,cn2, &
- ag,bg,cg,numbnd,numang,numphi,nimprp, &
- nhb,natom,natom,ntypes,nres,rad,wel,radhb, &
- welhb,rwell,isftrp,tgtrmsd,temp0les,-1,'READ')
- ! Updated 9/2007 by Matthew Seetin to enable plane-point and plane-plane restraints
-
- ! --- Determine how many of the torsional parameters
- ! are impropers
- call impnum(ix(i46),ix(i56),ix(i48),ix(i58),nphih,nphia, &
- 0,nptra,nimprp)
- end if
-
- ! -- Set up info related to weight changes for the non-bonds:
-
- call nmrrad(rad,wel,cn1,cn2,ntypes,0,0.0d0)
- call decnvh(asol,bsol,nphb,radhb,welhb)
-
- if (iredir(4) > 0) call noeread(x,ix,ih)
- if (iredir(8) > 0) call alignread(natom, x(lcrd))
- if (iredir(9) > 0) call csaread
-
- end if ! lam81 <<< QMSTEP=1 BLOCK >>>
-
- !---------------------------------------------------------------
- ! --- Call FASTWAT, which will tag those bonds which are part
- ! of 3-point water molecules. Constraints will be effected
- ! for these waters using a fast analytic routine -- dap.
-
- call timer_start(TIME_FASTWT)
-
- call fastwat(ih(m04),nres,ix(i02),ih(m02), &
- nbonh,nbona,ix(iibh),ix(ijbh),ibelly,ix(ibellygp), &
- iwtnm,iowtnm,ihwtnm,jfastw,ix(iifstwt), &
- ix(iifstwr),ibgwat,ienwat,ibgion,ienion,iorwat, &
- 6,natom)
- call timer_stop(TIME_FASTWT)
-
- call getwds(ih(m04), nres , ix(i02) , ih(m02) , &
- nbonh , nbona , 0 , ix(iibh) , &
- ix(ijbh) , iwtnm , iowtnm , ihwtnm , &
- jfastw , ix(iicbh) , req , x(lwinv) , &
- rbtarg , ibelly , ix(ibellygp), 6 )
-
- ! Assign link atoms between quantum mechanical and molecular mechanical
- ! atoms if quantum atoms are present.
- ! After assigning the link atoms, delete all connectivity between the
- ! QM atoms.
- if(qmmm_nml%ifqnt) then
-
- call identify_link_atoms(nbona,ix(iiba),ix(ijba))
-
- ! Variable QM solvent:
- ! Store the original bond parameters since we will need to rebuild
- ! the QM region (delete bonded terms etc) repeatedly
- if ( qmmm_nml%vsolv > 0 ) then
- call new(qmmm_vsolv, nbonh, nbona, ntheth, ntheta, nphih, nphia)
- call qmmm_vsolv_store_parameters(qmmm_vsolv, numbnd, &
- ix(iibh), ix(ijbh), ix(iicbh), &
- ix(iiba), ix(ijba), ix(iicba), &
- ix(i24), ix(i26), ix(i28), ix(i30), &
- ix(i32), ix(i34), ix(i36), ix(i38), &
- ix(i40), ix(i42), ix(i44), ix(i46), ix(i48), &
- ix(i50), ix(i52), ix(i54), ix(i56), ix(i58))
- end if
-
- if( abfqmmm_param%abfqmmm == 1 ) then ! lam81
- if(abfqmmm_param%qmstep == 1 .and. abfqmmm_param%system == 1) then ! lam81
- call abfqmmm_allocate_arrays_of_parameters(numbnd, nbonh, nbona, ntheth, ntheta, nphih, nphia) ! lam81
- call abfqmmm_store_parameters(ix(iibh), ix(ijbh), ix(iicbh), & ! lam81
- ix(iiba), ix(ijba), ix(iicba), & ! lam81
- ix(i24), ix(i26), ix(i28), ix(i30), & ! lam81
- ix(i32), ix(i34), ix(i36), ix(i38), & ! lam81
- ix(i40), ix(i42), ix(i44), ix(i46), ix(i48), & ! lam81
- ix(i50), ix(i52), ix(i54), ix(i56), ix(i58), & ! lam81
- x(l15), rk, req) ! lam81
- else ! lam81
- call abfqmmm_set_parameters(numbnd, nbonh, nbona, ntheth, ntheta, nphih, nphia, & ! lam81
- ix(iibh), ix(ijbh), ix(iicbh), & ! lam81
- ix(iiba), ix(ijba), ix(iicba), & ! lam81
- ix(i24), ix(i26), ix(i28), ix(i30), & ! lam81
- ix(i32), ix(i34), ix(i36), ix(i38), & ! lam81
- ix(i40), ix(i42), ix(i44), ix(i46), ix(i48), & ! lam81
- ix(i50), ix(i52), ix(i54), ix(i56), ix(i58), & ! lam81
- x(l15), rk, req) ! lam81
-
- call init_extra_pts(ix(iibh),ix(ijbh),ix(iicbh), & ! lam81
- ix(iiba),ix(ijba),ix(iicba), & ! lam81
- ix(i24),ix(i26),ix(i28),ix(i30), & ! lam81
- ix(i32),ix(i34),ix(i36),ix(i38), & ! lam81
- ix(i40),ix(i42),ix(i44),ix(i46),ix(i48), & ! lam81
- ix(i50),ix(i52),ix(i54),ix(i56),ix(i58), & ! lam81
- ih(m06),ix,x,ix(i08),ix(i10), & ! lam81
- nspm,ix(i70),x(l75),tmass,tmassinv,x(lmass),x(lwinv),req) ! lam81
-
- end if ! lam81
- end if ! lam81
-
- ! Remove bonds between QM atoms from list (Hydrogen)
- if (nbonh .gt. 0) call setbon(nbonh,ix(iibh),ix(ijbh),ix(iicbh), &
- ix(ibellygp))
-
- ! Remove bonds between QM atoms from list (Heavy)
- if (nbona .gt. 0) call setbon(nbona,ix(iiba),ix(ijba),ix(iicba), &
- ix(ibellygp))
-
- ! Remove angles between QM atoms from list (Hydrogen)
- if (ntheth .gt. 0) call setang(ntheth,ix(i24),ix(i26),ix(i28),ix(i30), &
- ix(ibellygp))
-
- ! Remove angles between QM atoms from list (Heavy)
- if (ntheta .gt. 0) call setang(ntheta,ix(i32),ix(i34),ix(i36),ix(i38),&
- ix(ibellygp))
-
- ! Remove dihedrals between QM atoms from list (Hydrogen)
- if (nphih .gt. 0) call setdih(nphih,ix(i40),ix(i42),ix(i44),ix(i46), &
- ix(i48), ix(ibellygp))
-
- ! Remove dihedrals between QM atoms from list (Heavy)
- if (nphia .gt. 0) call setdih(nphia,ix(i50),ix(i52),ix(i54),ix(i56), &
- ix(i58), ix(ibellygp))
-
- ! Remove CHARMM energy terms from QM region
- call charmm_filter_out_qm_atoms()
-
- ! Now we should work out the type of each quantum atom present.
- ! This is used for our arrays of pre-computed parameters. It is
- ! essentially a re-basing of the atomic numbers and is done to save
- ! memory. Note: qm_assign_atom_types will allocate the qm_atom_type
- ! array for us. Only the master calls this routine. All other
- ! threads get this allocated and broadcast to them by the mpi setup
- ! routine.
- call qm_assign_atom_types
-
- ! Set default QMMM MPI parameters - for single cpu operation.
- ! These will get overwritten by qmmm_mpi_setup if MPI is on.
- qmmm_mpi%commqmmm_master = master
- qmmm_mpi%numthreads = 1
- qmmm_mpi%mytaskid = 0
- qmmm_mpi%natom_start = 1
- qmmm_mpi%natom_end = natom
- qmmm_mpi%nquant_nlink_start = 1
- qmmm_mpi%nquant_nlink_end = qmmm_struct%nquant_nlink
-
- ! Now we know how many link atoms we can allocate the scf_mchg array...
- allocate(qm2_struct%scf_mchg(qmmm_struct%nquant_nlink), stat = ier)
- REQUIRE(ier == 0) ! Deallocated in deallocate qmmm
-
- ! We can also allocate ewald_memory
- if (qmmm_nml%qm_ewald > 0 ) then
- call allocate_qmewald(natom)
- end if
- if (qmmm_nml%qmgb == 2 ) then ! lam81
- call allocate_qmgb(qmmm_struct%nquant_nlink)
- end if ! lam81
-
- allocate( qmmm_struct%dxyzqm(3, qmmm_struct%nquant_nlink), stat = ier )
- REQUIRE(ier == 0) ! Deallocated in deallocate qmmm
-
- else if(abfqmmm_param%abfqmmm == 1) then ! lam81
-
- call abfqmmm_set_parameters(numbnd, nbonh, nbona, ntheth, ntheta, nphih, nphia, & ! lam81
- ix(iibh), ix(ijbh), ix(iicbh), & ! lam81
- ix(iiba), ix(ijba), ix(iicba), & ! lam81
- ix(i24), ix(i26), ix(i28), ix(i30), & ! lam81
- ix(i32), ix(i34), ix(i36), ix(i38), & ! lam81
- ix(i40), ix(i42), ix(i44), ix(i46), ix(i48), & ! lam81
- ix(i50), ix(i52), ix(i54), ix(i56), ix(i58), & ! lam81
- x(l15), rk, req) ! lam81
-
- call init_extra_pts(ix(iibh),ix(ijbh),ix(iicbh), & ! lam81
- ix(iiba),ix(ijba),ix(iicba), & ! lam81
- ix(i24),ix(i26),ix(i28),ix(i30), & ! lam81
- ix(i32),ix(i34),ix(i36),ix(i38), & ! lam81
- ix(i40),ix(i42),ix(i44),ix(i46),ix(i48), & ! lam81
- ix(i50),ix(i52),ix(i54),ix(i56),ix(i58), & ! lam81
- ih(m06),ix,x,ix(i08),ix(i10), & ! lam81
- nspm,ix(i70),x(l75),tmass,tmassinv,x(lmass),x(lwinv),req) ! lam81
-
- end if !if (qmmm_nml%ifqnt)
-
- ! --- Open the data dumping files and position it depending
- ! on the type of run:
-
- if (abfqmmm_param%qmstep == 1 .and. abfqmmm_param%system == 1) then ! lam81
-#ifdef MPI
- ! adaptive QM/MM (qmmm_nml%vsolv=2) via multisander
- ! all groups have identical coords and velocities
- ! only master of first group needs to dump results
- if ( (qmmm_nml%vsolv < 2) .or. (worldrank == 0) ) then
-#endif
- call open_dump_files
-#ifdef MPI
- end if
-#endif
- end if ! lam81
- if (master) call amflsh(6)
-
- ! --- end of master process setup ---
- end if masterwork ! (master)
-
-# if defined(RISMSANDER)
- call rism_init(commsander)
-# endif /* RISMSANDER */
-
-#ifdef MPI
-
- call mpi_barrier(commsander,ierr)
- ! =========================== AMBER/MPI ===========================
-
- ! NOTE: in the current AMBER/MPI implementation, two means of
- ! running in parallel within sander are supported. The value
- ! of mpi_orig determines which approach is used.
- ! This is turned on when minimization (imin .ne. 0) is requested,
- ! and is otherwise off.
-
- ! When running the mpi_orig case, a variable notdone is now
- ! set by the master and determines when to exit the force()
- ! loop. When the master has finished calling force, the
- ! master changes notdone to 0 and broadcasts the data one more
- ! time to signal end of the loop. force() is modified so that
- ! in the mpi_orig case, an initial broadcast is done to receive
- ! the value from the master to decide whether to do the work or
- ! simply exit.
-
- ! ...set up initial data and send all needed data to other nodes,
- ! now that the master has it
-
- ! First, broadcast parameters in memory.h, so that all processors
- ! will know how much memory to allocate:
-
- call mpi_bcast(natom,BC_MEMORY,mpi_integer,0,commsander,ierr)
- ! -- ti decomp
- call mpi_bcast(idecomp,1,mpi_integer,0,commsander,ierr)
- call mpi_bcast(nat,1,mpi_integer,0,commsander,ierr)
- call mpi_bcast(nrs,1,mpi_integer,0,commsander,ierr)
-
- ! ----- Set up integer stack initial size --------------
- call mpi_bcast(lastist,1,mpi_integer,0,commsander,ierr)
- call mpi_bcast(lastrst,1,mpi_integer,0,commsander,ierr)
-
- call mpi_bcast(qmmm_struct%abfqmmm,1,mpi_integer,0,commsander,ierr) ! lam81
- call mpi_bcast(abfqmmm_param%abfqmmm,1,mpi_integer,0,commsander,ierr) ! lam81
- if(abfqmmm_param%abfqmmm == 1) then ! lam81
- call mpi_bcast(abfqmmm_param%natom,1,mpi_integer,0,commsander,ierr) ! lam81
- call mpi_bcast(abfqmmm_param%qmstep,1,mpi_integer,0,commsander,ierr) ! lam81
- call mpi_bcast(abfqmmm_param%maxqmstep,1,mpi_integer,0,commsander,ierr) ! lam81
- call mpi_bcast(abfqmmm_param%system,1,mpi_integer,0,commsander,ierr) ! lam81
- end if ! lam81
-
- if(abfqmmm_param%abfqmmm == 1) then ! lam81
- if(abfqmmm_param%qmstep == 1 .and. abfqmmm_param%system == 1) then ! lam81
- call mpi_bcast(abfqmmm_param%r_core_in,1,mpi_double_precision,0,commsander,ierr) ! lam81
- call mpi_bcast(abfqmmm_param%r_core_out,1,mpi_double_precision,0,commsander,ierr) ! lam81
- call mpi_bcast(abfqmmm_param%r_qm_in,1,mpi_double_precision,0,commsander,ierr) ! lam81
- call mpi_bcast(abfqmmm_param%r_qm_out,1,mpi_double_precision,0,commsander,ierr) ! lam81
- call mpi_bcast(abfqmmm_param%r_buffer_in,1,mpi_double_precision,0,commsander,ierr) ! lam81
- call mpi_bcast(abfqmmm_param%r_buffer_out,1,mpi_double_precision,0,commsander,ierr) ! lam81
- call mpi_bcast(abfqmmm_param%mom_cons_type,1,mpi_integer,0,commsander,ierr) ! lam81
- call mpi_bcast(abfqmmm_param%mom_cons_region,1,mpi_integer,0,commsander,ierr) ! lam81
- if (.not. master) then ! lam81
- allocate(abfqmmm_param%x(3*natom), stat=ier) ! lam81
- REQUIRE(ier==0) ! lam81
- allocate(abfqmmm_param%id(natom), stat=ier) ! lam81
- REQUIRE(ier==0) ! lam81
- allocate(abfqmmm_param%mass(natom), stat=ier) ! lam81
- REQUIRE(ier==0) ! lam81
- end if ! lam81
- allocate(abfqmmm_param%v(3*natom+iscale), stat=ier) ! lam81
- REQUIRE(ier==0) ! lam81
- allocate(abfqmmm_param%f(3*natom+iscale), stat=ier) ! lam81
- REQUIRE(ier==0) ! lam81
- allocate(abfqmmm_param%f1(3*natom+iscale), stat=ier) ! lam81
- REQUIRE(ier==0) ! lam81
- allocate(abfqmmm_param%f2(3*natom+iscale), stat=ier) ! lam81
- REQUIRE(ier==0) ! lam81
- end if ! lam81
- call mpi_bcast(abfqmmm_param%x,3*natom,mpi_double_precision,0,commsander,ierr) ! lam81
- call mpi_bcast(abfqmmm_param%id,natom,mpi_integer,0,commsander,ierr) ! lam81
- call mpi_bcast(abfqmmm_param%mass,natom,mpi_double_precision,0,commsander,ierr) ! lam81
- end if ! lam81
-
- if (abfqmmm_param%qmstep == 1 .and. abfqmmm_param%system == 1) then ! lam81
- call stack_setup()
- else ! lam81
- call deallocate_stacks ! lam81
- call stack_setup() ! lam81
- end if ! lam81
-
- ! GMS: Broadcast parameters from module 'molecule'
- call mpi_bcast(mol_info%natom,1,mpi_integer,0,commsander,ierr)
- call mpi_bcast(mol_info%nres,1,mpi_integer,0,commsander,ierr)
- call mpi_barrier(commsander,ierr)
-
- ! ---allocate memory on the non-master nodes:
- if (.not. master) then
-
- if (abfqmmm_param%qmstep /= 1 .or. abfqmmm_param%system /= 1) then ! lam81
- deallocate(x,ix,ipairs,ih) ! lam81
- end if ! lam81
-
- allocate( x(1:lastr), stat = ier )
- REQUIRE( ier == 0 )
-
- allocate( ix(1:lasti), stat = ier )
- REQUIRE( ier == 0 )
-
- allocate( ipairs(1:lastpr), stat = ier )
- REQUIRE( ier == 0 )
-
- allocate( ih(1:lasth), stat = ier )
- REQUIRE( ier == 0 )
-
- ! GMS:
- ! Allocate space for molecule module
- ! arrays in the other nodes
- if (abfqmmm_param%qmstep == 1 .and. abfqmmm_param%system == 1) then ! lam81
- call allocate_molecule()
- else ! lam81
- call deallocate_molecule() ! lam81
- call allocate_molecule() ! lam81
- end if ! lam81
-
- ! --------------------------
-
- ! -- ti decomp
- if (idecomp > 0) then
- call allocate_int_decomp(natom, nres)
- if (idecomp == 1 .or. idecomp == 2) then
- call allocate_real_decomp(nrs)
- else if( idecomp == 3 .or. idecomp == 4 ) then
- call allocate_real_decomp(npdec*npdec)
- end if
- end if
- end if ! ( .not.master )
-
- !GMS: Broadcast arrays from module 'molecule'
- call mpi_bcast(mol_info%natom_res,mol_info%nres,MPI_INTEGER,0,commsander,ierr)
- call mpi_bcast(mol_info%atom_to_resid_map,mol_info%natom,MPI_INTEGER,0,commsander,ierr)
- call mpi_bcast(mol_info%atom_mass,mol_info%natom, MPI_DOUBLE_PRECISION, 0, commsander, ier)
-
- if(idecomp == 1 .or. idecomp == 2) then
- call mpi_bcast(jgroup,nat,MPI_INTEGER,0,commsander,ierr)
- end if
-
- if(icfe == 0 .and. (idecomp ==3 .or. idecomp == 4)) then
- call mpi_bcast(jgroup,natom,MPI_INTEGER,0,commsander,ierr)
- call mpi_bcast(indx,nres,MPI_INTEGER,0,commsander,ierr)
- end if
-
- call startup_groups(ierr)
- call startup(x,ix,ih)
-
-! +---------------------------------------------------------------------------+
-! | Broadcast EVB/PIMD inputs/parameters to all PEs |
-! +:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::+
-! | Note: The masters have all required EVB/PIMD inputs/parameters via call |
-! | to mdread2 ( evb_input, evb_init, evb_pimd_init ). For EVB/PIMD, all |
-! | PEs need the inputs/parameters ... so we perform this initialization |
-! | again for all PEs besides the masters. The alternative is to use |
-! | MPI_BCAST. |
-! +---------------------------------------------------------------------------+
-
- call mpi_bcast( ievb , 1, MPI_INTEGER, 0, commworld, ierr )
- call mpi_bcast( ipimd, 1, MPI_INTEGER, 0, commworld, ierr )
-
- ! KFW
- if (ievb /= 0) then
- call mpi_bcast(evbin, MAX_FN_LEN, MPI_CHARACTER, 0, commworld, ierr)
- if (.not. master) then
- call evb_input
- call evb_init
- end if
- end if
- ! KFW
-
-
-# if defined(LES)
- call mpi_bcast ( ncopy, 1, MPI_INTEGER, 0, commworld, ierr )
- call mpi_bcast ( cnum(1:natom), natom, MPI_INTEGER, 0, commworld, ierr )
- call mpi_bcast ( evbin, MAX_FN_LEN, MPI_CHARACTER, 0, commworld, ierr )
-# endif /* LES */
- if (ievb /= 0) then
-# if defined(LES)
- !call mpi_bcast ( mastersize, 1, MPI_INTEGER, 0, commworld, ierr )
- !call mpi_bcast ( jobs_per_node, 1, MPI_INTEGER, 0, commworld, ierr )
- !call mpi_bcast ( nsize, 1, MPI_INTEGER, 0, commworld, ierr )
- if (ipimd > 0 .and. .not. master) then
- call evb_input
- call evb_init
- !call evb_pimd_init
- end if
- call evb_pimd_init
- !call mpi_bcast ( master_worldrank, mastersize, MPI_INTEGER, 0, commworld, ierr )
- !call mpi_bcast ( PE_slice, jobs_per_node*nsize, MPI_INTEGER, 0, commworld, ierr )
-# endif /* LES */
- call evb_bcast
- call evb_alloc
- end if
-
-! +---------------------------------------------------------------------------+
-! | Obtain B vector for Schlegel's distributed Gaussian method |
-! +---------------------------------------------------------------------------+
-
- if (trim(adjustl(xch_type)) == "dist_gauss") call schlegel_dg
-
- if (ifsc /= 0) then
- ! multi-CPU minimization does not work with soft core !
- if (imin > 0 .and. numtasks > 1) then
- call sander_bomb('imin > 0 and numtasks > 1', &
- 'TI minimizations cannot be performed with > 2 CPUs','')
- end if
- call setup_sc(natom, nres, ih(m04), ih(m06), &
- ix(i02), ih(m02), x(lcrd), ntypes, clambda, nstlim)
- if (ntp > 0 .and. master) then
- ! Check which molecules are perturbed in NPT runs
- call sc_check_perturbed_molecules(nspm, ix(i70))
- end if
- ! -- ti decomp
- if (idecomp > 0) then
- if (sanderrank == 0) call build_dec_mask(natom)
- call mpi_bcast(decmask, natom, MPI_INTEGER, 0, commsander, ierr)
- end if
- ! Make sure all common atoms have the same v (that of V0) in TI runs
- if ( ifsc /= 2 ) then
- if (master) call sc_sync_x(x(lvel),nr3)
- !call mpi_barrier(commsander,ierr)
- if (numtasks > 1) then
- call mpi_bcast(nr3,1,MPI_INTEGER,0,commsander,ierr)
- call mpi_bcast(x(lvel),nr3,MPI_DOUBLE_PRECISION,0,commsander,ierr)
- end if
- end if
- if (tishake /= 0) call setnoshake_sc(ix,ntc,num_noshake,master)
- else
- extra_atoms=0
- end if
- if (ifmbar /= 0) then
- call setup_mbar(nstlim)
- end if
-
- if (.not. master .and. igb == 0 .and. ipb == 0) then
- if (abfqmmm_param%qmstep == 1 .and. abfqmmm_param%system == 1) then ! lam81
- call nblist_allocate(natom,ntypes,num_direct,numtasks)
- else ! lam81
- call nblist_deallocate ! lam81
- call nblist_allocate(natom,ntypes,num_direct,numtasks) ! lam81
- end if ! lam81
- end if
-
- ! --- Allocate memory for GB on the non-master nodes:
-
- if( .not.master ) then
-
- if ((igb /= 0 .and. igb /= 10 .and. ipb == 0) .or. hybridgb>0 .or. icnstph.gt.1) then ! lam81
- if (abfqmmm_param%qmstep == 1 .and. abfqmmm_param%system == 1) then ! lam81
- call allocate_gb( natom, ncopy )
- else ! lam81
- call deallocate_gb ! lam81
- call allocate_gb( natom, ncopy ) ! lam81
- end if ! lam81
- end if ! lam81
-
- end if ! ( .not.master )
-
- nr = nrp
- nr3 = 3*nr
- belly = ibelly > 0
-
- ! ---Do setup for QMMM in parallel if ifqnt is on - this is essentially
- ! everything in the QMMM namelist and a few other bits and pieces.
- ! ---Note, currently only master node knows if qmmm_nml%ifqnt is
- ! on so we need to broadcast this first and then make decisions based
- ! on this.
-
- call mpi_bcast(qmmm_nml%ifqnt, 1, mpi_logical, 0, commsander, ierror)
-
- if (qmmm_nml%ifqnt) then
- ! Broadcast all of the stuff in qmmm_nml and allocate the relevant
- ! arrays on all processors. This will also set up information for
- ! openmp on the master processor if it is in use.
- call qmmm_mpi_setup( master, natom )
- if (qmmm_nml%qm_ewald > 0 .and. .not. master) then
- call allocate_qmewald(natom)
- end if
- if (qmmm_nml%qmgb==2 .and. .not. master) then
- call allocate_qmgb(qmmm_struct%nquant_nlink)
- end if
-
- if (.not. master) then
- allocate( qmmm_struct%dxyzqm(3, qmmm_struct%nquant_nlink), stat = ier )
- REQUIRE(ier == 0) !Deallocated in deallocate qmmm
- end if
-
- end if
-
- ! --- END QMMM MPI SETUP ---
-
- ! DAN ROE: Note: all nodes are calling this. amrset(ig) has already been called
- ! by the master node (twice if initial velocities are set, ntx<=3).
- ! DAN ROE: REMD: Now need to call amrset on all child threads, masters have called
- ! it above before initial coord read
- if (abfqmmm_param%qmstep == 1 .and. abfqmmm_param%system == 1) then ! lam81
- if(rem == 0) then
- call amrset(ig+1)
- else
- if (.not. master) call amrset(ig + 17 * nodeid)
- endif
-
- if (nmropt >= 1) &
- call nmrcal(x(lcrd),f,ih(m04),ih(m02),ix(i02),x(lwinv),enmr, &
- devdis,devang,devtor,devplpt,devpln,devgendis,temp0,tautp,cut,ntb,x(lnmr01), &
- ix(inmr02),x(l95),5,6,rk,tk,pk,cn1,cn2, &
- ag,bg,cg,numbnd,numang,numphi,nimprp, &
- nhb,natom,natom,ntypes,nres,rad,wel,radhb, &
- welhb,rwell,isftrp,tgtrmsd,temp0les,-1,'MPI ')
- end if ! lam81
- ! Updated 9/2007 by Matthew Seetin to enable plane-point and plane-plane restraints
-
- call mpi_bcast(lmtmd01,1,mpi_integer,0, commsander,ierr)
- call mpi_bcast(imtmd02,1,mpi_integer,0, commsander,ierr)
-
- if (itgtmd == 2) call mtmdcall(emtmd,x(lmtmd01),ix(imtmd02),x(lcrd),x(lforce),&
- ih(m04),ih(m02),ix(i02),ih(m06),x(lmass),natom,nres,'MPI ')
-
-
- ! ---------------- Check system is neutral and print warning message ------
- ! ---------------- adjust charges for roundoff error. ------
- if( igb == 0 .and. ipb == 0 .and. iyammp == 0 ) then
- if ( icfe == 0 ) then
- call check_neutral(x(l15),natom)
- else
- call ti_check_neutral(x(l15),natom)
- end if
- end if
-
- ! tell all nodes if this is a SEBOMD run
- call mpi_bcast(sebomd_obj%do_sebomd, 1, MPI_LOGICAL, 0, commsander, ierr)
- if (sebomd_obj%do_sebomd) then
- ! transfer SEBOMD info to the nodes
- call sebomd_bcast_obj()
- ! open necessary files
- if (master) then
- call sebomd_open_files
- end if
- ! initialize SEBOMD arrays
- call init_sebomd_arrays(natom)
- end if
-
- ! ---------------- Old parallel for minimization ----------------------
-
- if (imin /= 0) then
- mpi_orig = .true.
- notdone = 1
- else
- mpi_orig = .false.
- end if
-
- if (mpi_orig .and. .not. master) then
-
- ! ...all nodes only do the force calculations (JV)
- ! Minimisation so only only master gets past the loop below
- ! hence need to zero QM charges on non-master threads here.
-
- if (qmmm_nml%ifqnt) then
- ! Apply charge correction if required.
- if (qmmm_nml%adjust_q>0) then
- call qmmm_adjust_q(qmmm_nml%adjust_q, natom, qmmm_struct%nquant, qmmm_struct%nquant_nlink, &
- qmmm_struct%nlink, x(L15), &
- qmmm_struct%iqmatoms, qmmm_nml%qmcharge, qmmm_struct%atom_mask, &
- qmmm_struct%mm_link_mask, master,x(LCRD), qmmm_nml%vsolv)
- end if
- ! At this point we can also fill the qmmm_struct%scaled_mm_charges
- ! array - we only need to do this once as the charges are constant
- ! during a run. Having a separate array of scaled charges saves us
- ! having to do it on every qmmm routine call. Do this BEFORE zeroing
- ! the QM charges since that routine take care of these values as well.
- do i = 1, natom
- qmmm_struct%scaled_mm_charges(i) = x(L15+(i-1)) * INV_AMBER_ELECTROSTATIC &
- * qmmm_nml%chg_lambda ! charge scaling factor for FEP
- end do
- ! Zero out the charges on the quantum mechanical atoms
- call qm_zero_charges(x(L15),qmmm_struct%scaled_mm_charges,.true.)
- if (qmmm_struct%nlink > 0 ) then
- ! We need to exclude all electrostatic
- ! interactions with MM link pairs, both QM-MM and MM-MM. Do this by
- ! zeroing the MM link pair charges in the main charge array.
- ! These charges are stored in qmmm_struct%mm_link_pair_resp_charges in case
- ! they are later needed.
- call qm_zero_mm_link_pair_main_chg(qmmm_struct%nlink,qmmm_struct%link_pairs,x(L15), &
- qmmm_struct%scaled_mm_charges,.true.)
- end if
-
- end if
-
- if (igb == 7 .or. igb == 8) call igb7_init(natom, ncopy, x(l97)) !x(l97) is rborn()
- !Hai Nguyen: add igb == 8 here
-
- if ( ifcr /= 0 ) call cr_allocate( master, natom )
-
- n_force_calls = 0
- do while( notdone == 1 )
- n_force_calls = n_force_calls+1
- call force(x,ix,ih,ipairs,x(lcrd),x(lforce),ene,vir, &
- x(l96), x(l97), x(l98), x(l99), qsetup, &
- do_list_update,n_force_calls)
- end do
-
- ! Deallocate and return
- goto 999
-
- end if
-
- ! ----------------------------------------------------------------------
-
- if (master) then
- if(abfqmmm_param%abfqmmm /=1) write(6, '(a,i4,a,/)') '| Running AMBER/MPI version on ',numtasks, ' nodes' ! lam81
- !BTREE is selected by default if cpu is a power of two.
- !The number of processes is required to be a power of two for Btree
- !Print a warning about inefficiency with cpus not being a power of 2.
- if (numtasks > 1 .and. logtwo(numtasks) <= 0) then
- if(abfqmmm_param%abfqmmm /=1) write(6, '(a,i4,a,/)') '| WARNING: The number of processors is not a power of 2' ! lam81
- if(abfqmmm_param%abfqmmm /=1) write(6, '(a,i4,a,/)') '| this may be inefficient on some systems.' ! lam81
- end if
- end if
- if (master .and. numgroup > 1) write(6, '(a,i4,a,i4,a,i4,a)') &
- '| MULTISANDER: ', numgroup, ' groups. ', &
- numtasks, ' processors out of ', worldsize, ' total.'
- if (master) call amflsh(6)
-
- ! ========================= END AMBER/MPI =========================
-#else
- if(abfqmmm_param%abfqmmm == 1) then ! lam81
- if(abfqmmm_param%qmstep == 1 .and. abfqmmm_param%system == 1) then ! lam81
- allocate(abfqmmm_param%v(3*natom+iscale), stat=ier) ! lam81
- REQUIRE(ier==0) ! lam81
- allocate(abfqmmm_param%f(3*natom+iscale), stat=ier) ! lam81
- REQUIRE(ier==0) ! lam81
- allocate(abfqmmm_param%f1(3*natom+iscale), stat=ier) ! lam81
- REQUIRE(ier==0) ! lam81
- allocate(abfqmmm_param%f2(3*natom+iscale), stat=ier) ! lam81
- REQUIRE(ier==0) ! lam81
- end if ! lam81
- end if ! lam81
-
- ! debug needs to copy charges at start and they can't change later
- ! ---------------- Check system is neutral and print warning message ------
- ! ---------------- adjust charges for roundoff error. ------
- if( igb == 0 .and. ipb == 0 .and. iyammp == 0 ) call check_neutral(x(l15),natom)
-
- if (abfqmmm_param%qmstep == 1 .and. abfqmmm_param%system == 1) then ! lam81
- call amrset(ig+1)
- end if ! lam81
-
- if (abfqmmm_param%qmstep == 1 .and. abfqmmm_param%system == 1) then ! lam81
- call stack_setup()
- else ! lam81
- call deallocate_stacks ! lam81
- call stack_setup() ! lam81
- end if ! lam81
-
- if (sebomd_obj%do_sebomd) then
- ! open necessary files
- call sebomd_open_files
- ! initialize SEBOMD arrays
- call init_sebomd_arrays(natom)
- endif
-
-#endif /* MPI */
-
-#ifdef OPENMP
-
- ! If -openmp was specified to configure_amber then -DOPENMP is defined and the
- ! threaded version of MKL will have been linked in. It is important here that
- ! we set the default number of openmp threads for MKL to be 1 to stop conflicts
- ! with threaded vectorization routines when running in parallel etc.
- ! Individual calls to MKL from routines that know what they are doing - e.g.
- ! QMMM calls to diagonalizers etc can increase this limit as long as they
- ! put it back afterwards.
- call omp_set_num_threads(1)
-
- ! If we are using openmp for matrix diagonalization print some information.
- if (qmmm_nml%ifqnt .and. master) call qm_print_omp_info()
-#endif
-
- ! allocate memory for crg relocation
- if (ifcr /= 0) call cr_allocate( master, natom )
-
- ! initialize LIE module if used
- if ( ilrt /= 0 ) then
- call setup_linear_response(natom,nres,ih(m04),ih(m06),ix(i02),ih(m02),x(lcrd),x(l15), &
- ntypes, ix(i04), ix(i06), cn1, cn2, master)
- end if
-
- call date_and_time( setup_end_date, setup_end_time )
-
- ! Initialize the printing of ongoing time and performance summaries.
- ! We do this quite late here to avoid including all the setup time.
- if (master) call print_ongoing_time_summary(0,0,0.0d0,7)
-
- ! ----------------------------------------------------------------------
- ! Now do the dynamics or minimization.
- ! ----------------------------------------------------------------------
-
- if (igb == 7 .or. igb == 8 ) call igb7_init(natom, ncopy, x(l97)) !x(l97) is rborn()
- !Hai Nguyen: add igb ==8 here
-
- if (qmmm_nml%ifqnt) then
- ! Apply charge correction if required.
- if (qmmm_nml%adjust_q>0) then
- call qmmm_adjust_q(qmmm_nml%adjust_q, natom, qmmm_struct%nquant, qmmm_struct%nquant_nlink, &
- qmmm_struct%nlink, x(L15), &
- qmmm_struct%iqmatoms, qmmm_nml%qmcharge, qmmm_struct%atom_mask, &
- qmmm_struct%mm_link_mask, master,x(LCRD), qmmm_nml%vsolv)
- end if
- ! At this point we can also fill the qmmm_struct%scaled_mm_charges
- ! array - we only need to do this once as the charges are constant
- ! during a run. Having a separate array of scaled charges saves us
- ! having to do it on every qmmm routine call. Do this BEFORE zeroing
- ! the QM charges since that routine take care of these values as well.
- do i = 1, natom
- qmmm_struct%scaled_mm_charges(i) = x(L15+(i-1)) * INV_AMBER_ELECTROSTATIC &
- * qmmm_nml%chg_lambda ! charge scaling factor for FEP
- end do
-
- ! Zeroing of QM charges MUST be done AFTER call to check_neutral.
- ! Zero out the charges on the quantum mechanical atoms.
- call qm_zero_charges(x(L15),qmmm_struct%scaled_mm_charges,.true.)
-
- if (qmmm_struct%nlink > 0) then
- ! We need to exclude all electrostatic
- ! interactions with MM link pairs, both QM-MM and MM-MM. Do this by
- ! zeroing the MM link pair charges in the main charge array.
- ! These charges are stored in qmmm_struct%mm_link_pair_resp_charges in case
- ! they are later needed.
- call qm_zero_mm_link_pair_main_chg(qmmm_struct%nlink,qmmm_struct%link_pairs,x(L15), &
- qmmm_struct%scaled_mm_charges,.true.)
- end if
-
- end if
-
- ! Use the debugf namelist to activate
- call debug_frc(x,ix,ih,ipairs,x(lcrd),x(lforce),cn1,cn2,qsetup)
-
- ! Prepare for SGLD simulation
- if (isgld > 0) call psgld(natom,x(lmass),x(lvel), rem)
-
- ! Prepare for EMAP constraints
- if (temap) call pemap(dt,temp0,x,ix,ih)
-
- ! Prepare for Isotropic periodic sum of nonbonded interaction
- if (ips .gt. 0) call ipssys(natom,ntypes,ntb,x(l15), &
- cut,cn1,cn2,ix(i04),ix(i06),x(lcrd))
-
- if (master .and. (.not. qmmm_nml%ifqnt) .and. (abfqmmm_param%abfqmmm /= 1)) & ! lam81
- write(6,'(/80(''-'')/,'' 4. RESULTS'',/80(''-'')/)')
-
- ! Set up the MC barostat if requested
- if (ntp > 0 .and. barostat == 2) call mcbar_setup(ig)
-
- ! Input flag imin determines the type of calculation: MD, minimization, ...
- select case (imin)
- case (0)
- ! --- Dynamics:
-
- call timer_start(TIME_RUNMD)
- ! Set up AMD
- if (iamd .gt. 0) then
- call amd_setup(ntwx)
- endif
-
- ! Set up scaledMD
- if (scaledMD .gt. 0) then
- call scaledMD_setup(ntwx)
- endif
-
- if (ipimd > 0) then
- call pimd_init(natom,x(lmass),x(lwinv),x(lvel),ipimd)
- end if
-
- if(ineb>0) call neb_init()
-
-#ifdef MPI
- ! ----===== REMD =====----
- ! If this is not a REMD run, runmd is called only once.
- ! If this is a REMD run, runmd is called 0 to numexchg times,
- ! where the 0th runmd is just for getting initial PEs (no dynamics).
- if (rem == 0) then
- ! Not a REMD run. runmd will be called once.
- loop = 0
- else if (rem > 0) then
- ! This is a REMD run. runmd will be called numexchg times.
- loop = numexchg
-
- ! Set up temptable, open remlog, etc.
- call remd1d_setup(numexchg, hybridgb, numwatkeep, &
- temp0, mxvar, natom, ig, solvph)
- else
- ! Multi-D REMD run
- loop = numexchg
- call multid_remd_setup(numexchg, hybridgb, numwatkeep, &
- temp0, mxvar, natom, ig, solvph, irest)
- ! Now set up REMD indices for traj/restart writes. Only do this on
- ! master since only master handles writes.
- if (master) call setup_remd_indices
- end if ! Replica run setup
-
- ! Loop over REMD exchanges
- do mdloop = 0, loop
-
- ! ----===== REMD EXCHANGE HANDLING =====----
- ! Note: mdloop==0 is just used to get initial energies for the
- ! first exchange.
- if (rem < 0 .and. mdloop > 0) then
- call multid_remd_exchange(x, ix, ih, ipairs, qsetup, &
- do_list_update, temp0, solvph)
- else if ((rem == 1 .or. rem == 2) .and. mdloop > 0) then
- call remd_exchange(1, rem, x(lcrd), x(lvel), x(lmass), &
- nr3, natom, nr, temp0)
- else if (rem == 3 .and. mdloop > 0) then
- call hremd_exchange(1, x, ix, ih, ipairs, qsetup, do_list_update)
- ! force was called inside hremd_exchange, so call nmrdcp
- ! to decrement the NMR counter, since this should not count
- ! as a real step. This is OK, since the counter got
- ! incremented at the _very_ end of nmrcal, so we haven't already
- ! printed an unwanted value (JMS 2/12)
- if (nmropt /= 0) call nmrdcp
- else if (rem == 4 .and. mdloop > 0) then
- call ph_remd_exchange(1, solvph)
- end if ! rem>0 and mdloop>0
-
- ! ----===== END REMD EXCHANGE HANDLING =====----
-
-#ifdef VERBOSE_REMD
- if (rem > 0 .and. mdloop .eq. 0 .and. master) &
- write (6,'(a,i4)') "REMD: Getting initial energy for replica ",repnum
-#endif /* VERBOSE_REMD */
-#endif /* MPI */
-
-#ifndef DISABLE_NCSU
- if(abfqmmm_param%qmstep == 1 .and. abfqmmm_param%system == 1) then ! lam81
- call ncsu_on_sander_init(ih, x(lmass), x(lcrd), rem)
- end if ! lam81
-#endif /* DISABLE_NCSU */
-
- if (beeman_integrator == 1) then
- call AM_RUNMD(ix,ih,ipairs, &
- x(lwinv),x(lmass),x, &
- x(lcrd),x(lvel),x(lforce),qsetup)
- else
- call runmd(x,ix,ih,ipairs, &
- x(lcrd),x(lwinv),x(lmass),x(lforce), &
- x(lvel),x(lvel2),x(l45),x(lcrdr), &
- x(l50),x(l95),ix(i70),x(l75), &
- erstop,qsetup)
- end if !beeman_integrator == 1
-
-#ifndef DISABLE_NCSU
- if(abfqmmm_param%qmstep == 1 .and. abfqmmm_param%system == 1) then ! lam81
- call ncsu_on_sander_exit()
- end if ! lam81
-#endif /* DISABLE_NCSU */
-
- ! ----===== END REMD =====----
-#ifdef MPI
- end do ! Loop over REMD exchanges (mdloop)
-
- ! Cleanup REMD files.
- if (rem /= 0) call remd_cleanup()
-
-#endif
-
- call timer_stop(TIME_RUNMD)
-
- if (master) call amflsh(6)
-
- if (erstop) then
- ! This error condition stems from subroutine shake;
- ! furthermore, it seems that erstop can never be true since shake
- ! can never return with its third last argument, niter, equal to 0.
- ! SRB, Sep 24, 2003
- if (master) then
- write(6, *) 'FATAL ERROR'
- end if
- call mexit(6,1)
- end if
-
- case (1)
-
- !--- Minimization:
-
- ! Input flag ntmin determines the method of minimization
- select case (ntmin)
- case (0, 1, 2)
- call runmin(x,ix,ih,ipairs,x(lcrd),x(lforce),x(lvel), &
- ix(iibh),ix(ijbh),x(l50),x(lwinv),ix(ibellygp), &
- x(l95),ene, carrms, qsetup)
- ! If a conventional minimisation is being done,
- ! the restart file is written inside the runmin routine.
- case (LMOD_NTMIN_XMIN)
- write(6,'(a)') ' LMOD XMIN Minimization.'
- write(6,'(a)') ''
- write(6,'(a)') ' Note: Owing to the behaviour of the XMIN algorithm,'
- write(6,'(a)') ' coordinates in the trajectory and intermediate'
- write(6,'(a)') ' restart files will not match up with energies'
- write(6,'(a)') ' in the mdout and mdinfo files. The final energy'
- write(6,'(a)') ' and final coordinates do match.'
- write(6,'(a)') ''
- xmin_iter = 0
- call run_xmin( x, ix, ih, ipairs, &
- x(lcrd), x(lforce), ene, qsetup, xmin_iter, ntpr )
- if (master) call minrit(0,nrp,ntxo,x(lcrd)) ! Write the restart file
- case (LMOD_NTMIN_LMOD)
- write(6,'(a)') ' LMOD LMOD Minimization.'
- write(6,'(a)') ''
- write(6,'(a)') ' Note: Owing to the behaviour of the XMIN algorithm,'
- write(6,'(a)') ' coordinates in the trajectory and intermediate'
- write(6,'(a)') ' restart files will not match up with energies'
- write(6,'(a)') ' in the mdout and mdinfo files. The final energy'
- write(6,'(a)') ' and final coordinates do match.'
- write(6,'(a)') ''
- call run_lmod( x, ix, ih, ipairs, &
- x(lcrd), x(lforce), ene, qsetup )
- if (master) call minrit(0,nrp,ntxo,x(lcrd)) ! Write the restart file
- case default
- ! invalid ntmin
- ! ntmin input validation occurs in mdread.f
- ASSERT( .false. )
- end select
-
-
- case (5)
- ! ---carlos modified for reading trajectories (trajene option)
-
- write (6,*) "POST-PROCESSING OF TRAJECTORY ENERGIES"
-
- ! ---read trajectories and calculate energies for each frame
-
- call trajene(x,ix,ih,ipairs,ene,ok,qsetup)
-
- if (.not. ok) then
- write (6,*) 'error in trajene()'
- call mexit(6,1)
- end if
-
- case default
- ! invalid imin
- ! imin input validation should be transferred to mdread.f
- write(6,'(/2x,a,i3,a)') 'Error: Invalid IMIN (',imin,').'
- ASSERT( .false. )
- end select
-
-#ifdef MPI /* SOFT CORE */
- if (master) then
- if (icfe /=0 .and. ifsc == 1) call summarize_ti_changes(natom,resat)
- end if
-#endif
-
- ! finish up EMAP
- if (temap) call qemap()
-
- if (abfqmmm_param%abfqmmm /= 1) then ! lam81
- exit ! lam81
- else ! lam81
-#ifdef MPI /* lam81 */
- call mpi_barrier(commsander,ierr) ! lam81
-#endif /* lam81 */
- if (abfqmmm_param%qmstep /= abfqmmm_param%maxqmstep .or. abfqmmm_param%system /= 2) then ! lam81
- if(qmmm_nml%ifqnt) call deallocate_qmmm(qmmm_nml, qmmm_struct, qmmm_vsolv, qm2_params) ! lam81
- end if ! lam81
- call deallocate_m1m2m3() ! lam81
- if (abfqmmm_param%system == 2 .and. master) then ! lam81
- call abfqmmm_write_idrst() ! lam81
- call abfqmmm_write_pdb(x(lcrd),ix(i70)) ! lam81
- end if ! lam81
- call abfqmmm_next_step() ! lam81
- end if ! lam81
-
- end do ! lam81
-
- if(abfqmmm_param%abfqmmm == 1) then ! lam81
- deallocate(abfqmmm_param%id, stat=ier) ! lam81
- REQUIRE( ier == 0 ) ! lam81
- deallocate(abfqmmm_param%v, stat=ier) ! lam81
- REQUIRE( ier == 0 ) ! lam81
- deallocate(abfqmmm_param%f, stat=ier) ! lam81
- REQUIRE( ier == 0 ) ! lam81
- deallocate(abfqmmm_param%f1, stat=ier) ! lam81
- REQUIRE( ier == 0 ) ! lam81
- deallocate(abfqmmm_param%f2, stat=ier) ! lam81
- REQUIRE( ier == 0 ) ! lam81
- if(master) then ! lam81
- deallocate(abfqmmm_param%isqm, stat=ier) ! lam81
- REQUIRE( ier == 0 ) ! lam81
- endif ! lam81
- end if ! lam81
-
- ! -- calc time spent running vs setup
- call timer_stop(TIME_TOTAL)
- call wallclock( time1 )
- call date_and_time( final_date, final_time )
- call profile_time( time1 - time0, num_calls_nblist, profile_mpi)
-
-#ifdef MPI
- ! =========================== AMBER/MPI ===========================
-
- ! Set and broadcast notdone in mpi_orig case to inform
- ! other nodes that we are finished calling force(). (tec3)
-
- if (mpi_orig) then
- notdone = 0
- call mpi_bcast(notdone,1,mpi_integer,0, commsander,ierr)
- end if
-
- ! ========================= END AMBER/MPI =========================
-#endif
-
-! ========================= PUPIL INTERFACE =========================
-#ifdef PUPIL_SUPPORT
- ! Finalize Corba Interface
- puperror = 0
- call killcorbaintfc(puperror)
- if (puperror /= 0) then
- write(6,*) 'Error ending PUPIL CORBA interface.'
- end if
- write(6,'(a)') 'PUPIL CORBA interface finalized.'
- pupactive = .false.
-#endif
-! ========================= PUPIL INTERFACE =========================
-
-#ifdef _XRAY
- !(out_lun,residue_pointer,residue_label,atom_name,coor,num_bonds,ibond,jbond)
- call xray_fini()
-#endif
-
- call amflsh(6)
- if (master) then
-#ifdef MPI
- ! adaptive QM/MM (qmmm_nml%vsolv=2) via multisander
- ! all groups have identical coords and velocities
- ! only master of first group needs to dump results
- if ( (qmmm_nml%vsolv < 2) .or. (worldrank == 0) ) then
-#endif
- call close_dump_files
-#ifdef MPI
- end if
-#endif
-
- if (icnstph /= 0) &
- call cnstph_finalize
- ! --- write out final times, taking REMD into account
-#ifdef MPI
- if (rem .ne. 0) then
- nstlim_total = nstlim * numexchg
- else
- nstlim_total = nstlim
- end if
-#else
- nstlim_total = nstlim
-#endif
- if (imin == 0) &
- call print_ongoing_time_summary(nstlim_total,nstlim_total,dt,6)
-
- write(6,'(12(a))') '| Job began at ', initial_time(1:2), &
- ':', initial_time(3:4), ':', initial_time(5:10), ' on ',&
- initial_date(5:6), '/', initial_date(7:8), '/', initial_date(1:4)
- write(6,'(12(a))') '| Setup done at ', setup_end_time(1:2), &
- ':', setup_end_time(3:4), ':', setup_end_time(5:10), ' on ', &
- setup_end_date(5:6), '/',setup_end_date(7:8),'/',setup_end_date(1:4)
- write(6,'(12(a))') '| Run done at ', final_time(1:2), &
- ':', final_time(3:4), ':', final_time(5:10), ' on ', &
- final_date(5:6), '/', final_date(7:8), '/', final_date(1:4)
- call nwallclock( ncalls )
- write(6, '(''|'',5x,''wallclock() was called'',I8,'' times'')') ncalls
- call amflsh(6)
-
- if (iesp > 0) then
- call esp(natom,x(lcrd),x(linddip))
- end if
- end if
- call amflsh(6)
-
- ! --- dynamic memory deallocation:
- 999 continue
-
- if(qmmm_nml%ifqnt .and. qmmm_nml%qmtheory%EXTERN .and. master) then
- call qm2_extern_finalize()
- endif
-
- if (qmmm_nml%ifqnt .and. .not. qmmm_struct%qm_mm_first_call) then
- ! If first_call is still true, this thread never really
- ! called the QMMM routine. E.g. more threads than PIMD replicates
- call deallocate_qmmm(qmmm_nml, qmmm_struct, qmmm_vsolv, qm2_params)
- end if
-
- if (ipimd > 0) call pimd_finalize(ipimd)
-
- if (ineb > 0) call neb_finalize()
-
- if (idecomp > 0) then
- call deallocate_real_decomp()
- call deallocate_int_decomp()
- end if
- if (master .and. idecomp == 0) call deallocate_int_decomp()
-
-#ifdef MPI /* SOFT CORE */
- if (ifsc /= 0) call cleanup_sc()
- if (ifmbar /= 0) call cleanup_mbar()
-#endif
-
- ! finalize LIE module if initiated above
- if ( ilrt /= 0 ) then
- call cleanup_linear_response(master)
- end if
-
-#ifdef RISMSANDER
- call rism_finalize()
-#endif
-
- if ( ifcr /= 0 ) call cr_cleanup()
-
- if (sebomd_obj%do_sebomd) then
- if (master) then
- call sebomd_close_files
- end if
- call cleanup_sebomd_arrays
- end if
-
- if (master .and. iwrap == 2) then
- deallocate(iwrap_mask_atoms, stat=ier)
- REQUIRE(ier == 0)
- end if
- call nblist_deallocate()
- call deallocate_stacks()
- if ((igb /= 0 .and. igb /= 10 .and. ipb == 0) .or. hybridgb > 0 .or. icnstph > 1) then
- call deallocate_gb()
- end if
- if (master) then
- if(igb == 10 .or. ipb /= 0) then
- call pb_free()
- end if
- end if
- deallocate(ih, stat = ier)
- REQUIRE(ier == 0)
- deallocate(ipairs, stat = ier)
- REQUIRE(ier == 0)
- deallocate(ix, stat = ier)
- REQUIRE(ier == 0)
- deallocate(x, stat = ier)
- REQUIRE(ier == 0)
- if(ntb > 0 .and. ifbox == 1 .and. ew_type == 0 .and. mpoltype == 0) &
- call deallocate_m1m2m3()
- call AMOEBA_deallocate
- ! GMS: -- Module molecule --
- call deallocate_molecule()
- ! --------------------------
-
- if (charmm_active) call charmm_deallocate_arrays()
- if (cmap_active) call deallocate_cmap_arrays()
-
- if (master.and.mdout /= 'stdout') close(6)
-
- return
-
-end subroutine sander
-
-!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-!+ Calculate the ElectroStatic Potential
-subroutine esp(natom,x,mom_ind)
-
- ! routine to calculate the ESP due to the induced moments (only)
- ! at the same spatial points as the reference QM.
- use constants, only : zero, BOHRS_TO_A, INV_AMBER_ELECTROSTATIC
- use file_io_dat
- implicit none
- integer natom
- _REAL_ x(3,*)
- _REAL_ mom_ind(3,*)
-
-# include "ew_mpole.h"
-
- integer dat_unit, new_unit, minus_new_unit
- parameter(dat_unit=30, new_unit=31, minus_new_unit=33)
-
- integer inat, nesp, idum
- _REAL_ xin, yin, zin
- integer jn, kn
- _REAL_ esp_qm, xb_esp, yb_esp, zb_esp
- _REAL_ x_esp, y_esp, z_esp
- _REAL_ e_x, e_y, e_z, e_q, esp_new
- _REAL_ dist, dist3
- integer iptr
-
- call amopen(dat_unit,"esp.dat",'O','F','R')
- call amopen(new_unit,"esp.induced",owrite,'F','W')
- call amopen(minus_new_unit,"esp.qm-induced",owrite,'F','W')
- read (dat_unit,'(3i5)')inat,nesp,idum
- write(6,'(t2,''inat = '',i5)')inat
- write(6,'(t2,''nesp = '',i5)')nesp
-
- write(new_unit,'(2i5)')inat,nesp
- write(minus_new_unit,'(2i5)')inat,nesp
-
- if (inat /= natom) then
- write(6,'(t2,''natom mismatch with esp file'')')
- call mexit(6,1)
- end if
-
- do jn = 1,inat
- read (dat_unit,'(17x,3e16.0)')xin,yin,zin
- write(new_unit,'(17x,3e16.7)')xin,yin,zin
- write(minus_new_unit,'(17x,3e16.7)')xin,yin,zin
- end do
-
- do jn = 1,nesp
- e_x = zero
- e_y = zero
- e_z = zero
- e_q = zero
- read(dat_unit,'(1x,4e16.0)')esp_qm,xb_esp,yb_esp,zb_esp
- x_esp = xb_esp * BOHRS_TO_A
- y_esp = yb_esp * BOHRS_TO_A
- z_esp = zb_esp * BOHRS_TO_A
-
- do kn = 1,natom
- dist = (sqrt((x(1,kn)-x_esp)**2 + &
- (x(2,kn)-y_esp)**2 + &
- (x(3,kn)-z_esp)**2))
- dist3 = dist**3
- e_x = e_x - mom_ind(1,kn )*(x(1,kn)-x_esp)/dist3
- e_y = e_y - mom_ind(2,kn )*(x(2,kn)-y_esp)/dist3
- e_z = e_z - mom_ind(3,kn )*(x(3,kn)-z_esp)/dist3
- end do
-
- e_x = e_x * BOHRS_TO_A * INV_AMBER_ELECTROSTATIC
- e_y = e_y * BOHRS_TO_A * INV_AMBER_ELECTROSTATIC
- e_z = e_z * BOHRS_TO_A * INV_AMBER_ELECTROSTATIC
- e_q = e_q * BOHRS_TO_A * INV_AMBER_ELECTROSTATIC
- esp_new = e_x + e_y + e_z
-
- write(new_unit, '(1x,4e16.7)')esp_new, &
- xb_esp,yb_esp,zb_esp
- write(minus_new_unit,'(1x,4e16.7)')esp_qm-esp_new, &
- xb_esp,yb_esp,zb_esp
- end do
-
- close(dat_unit)
- close(new_unit)
- close(minus_new_unit)
-
- return
-
-end subroutine esp
-