critical bug fix for ions langvin and fix pdb output for wham and cluster

[unres4.git] / source / wham / io_wham.F90

diff --git a/source/wham/io_wham.F90 b/source/wham/io_wham.F90
index e3f0151..fee1e46 100644 (file)
--- a/source/wham/io_wham.F90
+++ b/source/wham/io_wham.F90
@@ -98,6 +98,8 @@
 
       call mygetenv('SCPPAR_NUCL',scpname_nucl)
       open (iscpp_nucl,file=scpname_nucl,status='old')
+      call mygetenv('IONPAR_NUCL',ionnuclname)
+      open (iionnucl,file=ionnuclname,status='old')
 
 
 #ifndef OLDSCP
@@ -514,6 +516,7 @@ allocate(ww(max_eneW))
       wpepbase=ww(47)
       wscpho=ww(48)
       wpeppho=ww(49)
+      wcatnucl=ww(50)
 !      print *,"KURWA",ww(48)
 !        "WSCBASE   ","WPEPBASE  ","WSCPHO    ","WPEPPHO   "
 !        "WVDWPP    ","WELPP     ","WVDWPSB   ","WELPSB    ","WVDWSB    ",&
@@ -570,6 +573,8 @@ allocate(ww(max_eneW))
       weights(47)= wpepbase
       weights(48) =wscpho
       weights(49) =wpeppho
+      weights(50) =wcatnucl
+
 ! el--------
       call card_concat(controlcard,.false.)
 
@@ -613,7 +618,7 @@ allocate(ww(max_eneW))
       write (iout,*) "Parameter set:",iparm
       write (iout,*) "Energy-term weights:"
       do i=1,n_eneW
-        write (iout,'(a16,f10.5)') wname(i),ww(i)
+        write (iout,'(i3,a16,f10.5)') i,wname(i),ww(i)
       enddo
       write (iout,*) "Sidechain potential file        : ",&
         sidename_t(:ilen(sidename_t))
@@ -712,6 +717,23 @@ allocate(ww(max_eneW))
             enddo
             print *, catprm
       endif
+      allocate(catnuclprm(14,ntyp_molec(2),ntyp_molec(5)))
+      do i=1,ntyp_molec(5)
+         do j=1,ntyp_molec(2)
+         write(iout,*) i,j
+            read(iionnucl,*) (catnuclprm(k,j,i),k=1,14)
+         enddo
+      enddo
+      write(*,'(3(5x,a6)11(7x,a6))') "w1    ","w2    ","epslj ","pis1  ", &
+      "sigma0","epsi0 ","chi1   ","chip1 ","sig   ","b1    ","b2    ", &
+      "b3    ","b4    ","chis1  "
+      do i=1,ntyp_molec(5)
+         do j=1,ntyp_molec(2)
+            write(*,'(3(f10.3,x),11(f12.6,x),a3,2a)') (catnuclprm(k,j,i),k=1,14), &
+                                      restyp(i,5),"-",restyp(j,2)
+         enddo
+      enddo
+
       read (ibond_nucl,*) vbldp0_nucl,akp_nucl,mp(2),ip(2),pstok(2)
       do i=1,ntyp_molec(2)
         nbondterm_nucl(i)=1
@@ -2706,6 +2728,7 @@ allocate(ww(max_eneW))
 ! Ions by Aga
 
        allocate(alphapolcat(ntyp,ntyp),epsheadcat(ntyp,ntyp),sig0headcat(ntyp,ntyp))
+       allocate(alphapolcat2(ntyp,ntyp))
        allocate(sigiso1cat(ntyp,ntyp),rborn1cat(ntyp,ntyp),rborn2cat(ntyp,ntyp),sigmap1cat(ntyp,ntyp))
        allocate(sigmap2cat(ntyp,ntyp),sigiso2cat(ntyp,ntyp))
        allocate(chis1cat(ntyp,ntyp),chis2cat(ntyp,ntyp),wquadcat(ntyp,ntyp),chipp1cat(ntyp,ntyp),chipp2cat(ntyp,ntyp))
@@ -2762,7 +2785,7 @@ allocate(ww(max_eneW))
 !       rborncat(i,j),rborncat(j,i),&
        rborn1cat(i,j),rborn2cat(i,j),&
        (wqdipcat(k,i,j),k=1,2), &
-       alphapolcat(i,j),alphapolcat(j,i), &
+       alphapolcat(i,j),alphapolcat2(j,i), &
        (alphisocat(k,i,j),k=1,4),sigiso1cat(i,j),sigiso2cat(i,j),epsintabcat(i,j),debaykapcat(i,j)
 !       print *,eps(i,j),sigma(i,j),"SIGMAP",i,j,sigmap1(i,j),sigmap2(j,i) 
        END DO
@@ -3885,8 +3908,9 @@ allocate(ww(max_eneW))
 !--------------------------------------------------------------------------------
       subroutine pdboutW(ii,temp,efree,etot,entropy,rmsdev)
 
-      use geometry_data, only:nres,c
+      use geometry_data, only:nres,c,boxxsize,boxysize,boxzsize
       use energy_data, only:nss,nnt,nct,ihpb,jhpb,itype,molnum
+      use energy, only:boxshift
 !      implicit real*8 (a-h,o-z)
 !      include 'DIMENSIONS'
 !      include 'DIMENSIONS.ZSCOPT'
@@ -3901,7 +3925,7 @@ allocate(ww(max_eneW))
                       'D','E','F','G','H','I','J','K','L','M','N','O',&
                       'P','Q','R','S','V','W','X','Y','Z'/),shape(chainid))
       integer,dimension(nres) :: ica !(maxres)
-      real(kind=8) :: temp,efree,etot,entropy,rmsdev
+      real(kind=8) :: temp,efree,etot,entropy,rmsdev,xj,yj,zj
       integer :: ii,i,j,iti,ires,iatom,ichain,mnum
       write(ipdb,'("REMARK CONF",i8," TEMPERATURE",f7.1," RMS",0pf7.2)')&
         ii,temp,rmsdev
@@ -3925,9 +3949,17 @@ allocate(ww(max_eneW))
         ires=ires+1
         iatom=iatom+1
         ica(i)=iatom
+        if (mnum.ne.5) then
         write (ipdb,10) iatom,restyp(iti,mnum),chainid(ichain),&
            ires,(c(j,i),j=1,3)
-        if (iti.ne.10) then
+        else
+        xj=boxshift(c(1,i)-c(1,2),boxxsize)
+        yj=boxshift(c(2,i)-c(2,2),boxysize)
+        zj=boxshift(c(3,i)-c(3,2),boxzsize)
+        write (ipdb,10) iatom,restyp(iti,mnum),chainid(ichain),&
+           ires,c(1,2)+xj,c(2,2)+yj,c(3,2)+zj
+        endif
+        if ((iti.ne.10).and.(mnum.ne.5)) then
           iatom=iatom+1
           write (ipdb,20) iatom,restyp(iti,mnum),chainid(ichain),&
             ires,(c(j,nres+i),j=1,3)