source/unres/src_MD/old_F/energy_split.F.org

   1       subroutine etotal_long(energia)
   2       implicit real*8 (a-h,o-z)
   3       include 'DIMENSIONS'
   4 c
   5 c Compute the long-range slow-varying contributions to the energy
   6 c
   7 #ifndef ISNAN
   8       external proc_proc
   9 #ifdef WINPGI
  10 cMS$ATTRIBUTES C ::  proc_proc
  11 #endif
  12 #endif
  13
  14       include 'COMMON.IOUNITS'
  15       double precision energia(0:n_ene),energia1(0:n_ene+1)
  16       include 'COMMON.FFIELD'
  17       include 'COMMON.DERIV'
  18       include 'COMMON.INTERACT'
  19       include 'COMMON.SBRIDGE'
  20       include 'COMMON.CHAIN'
  21       include 'COMMON.VAR'
  22       call int_from_cart1(.false.)
  23 cd    print '(a,i2)','Calling etotal ipot=',ipot
  24 cd    print *,'nnt=',nnt,' nct=',nct
  25 C
  26 C Compute the side-chain and electrostatic interaction energy
  27 C
  28       goto (101,102,103,104,105,106) ipot
  29 C Lennard-Jones potential.
  30   101 call elj(evdw)
  31 cd    print '(a)','Exit ELJ'
  32       goto 107
  33 C Lennard-Jones-Kihara potential (shifted).
  34   102 call eljk(evdw)
  35       goto 107
  36 C Berne-Pechukas potential (dilated LJ, angular dependence).
  37   103 call ebp(evdw)
  38       goto 107
  39 C Gay-Berne potential (shifted LJ, angular dependence).
  40   104 call egb(evdw)
  41       goto 107
  42 C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
  43   105 call egbv(evdw)
  44       goto 107
  45 C Soft-sphere potential
  46   106 call e_softsphere(evdw)
  47 C
  48 C Calculate electrostatic (H-bonding) energy of the main chain.
  49 C
  50   107 continue
  51 c      print *,"Processor",myrank," computed USCSC"
  52       call vec_and_deriv
  53 c      print *,"Processor",myrank," left VEC_AND_DERIV"
  54       if (ipot.lt.6) then
  55 #ifdef SPLITELE
  56          if (welec.gt.0d0.or.wvdwpp.gt.0d0.or.wel_loc.gt.0d0.or.
  57      &       wturn3.gt.0d0.or.wturn4.gt.0d0) then
  58 #else
  59          if (welec.gt.0d0.or.wel_loc.gt.0d0.or.
  60      &       wturn3.gt.0d0.or.wturn4.gt.0d0) then
  61 #endif
  62             call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
  63          else
  64             ees=0
  65             evdw1=0
  66             eel_loc=0
  67             eello_turn3=0
  68             eello_turn4=0
  69          endif
  70       else
  71 c        write (iout,*) "Soft-spheer ELEC potential"
  72         call eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
  73      &   eello_turn4)
  74       endif
  75 C
  76 C Calculate excluded-volume interaction energy between peptide groups
  77 C and side chains.
  78 C
  79       if (ipot.lt.6) then
  80       call escp(evdw2,evdw2_14)
  81       else
  82 c        write (iout,*) "Soft-sphere SCP potential"
  83         call escp_soft_sphere(evdw2,evdw2_14)
  84       endif
  85 C
  86 C 12/1/95 Multi-body terms
  87 C
  88       n_corr=0
  89       n_corr1=0
  90       if ((wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0
  91      &    .or. wturn6.gt.0.0d0) .and. ipot.lt.6) then
  92          call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
  93 c         write (2,*) 'n_corr=',n_corr,' n_corr1=',n_corr1,
  94 c     &" ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6," eturn6",eturn6
  95       else
  96          ecorr=0.0d0
  97          ecorr5=0.0d0
  98          ecorr6=0.0d0
  99          eturn6=0.0d0
 100       endif
 101       if ((wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) .and. ipot.lt.6) then
 102          call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
 103       endif
 104 C
 105 C Sum the energies
 106 C
 107 #ifdef SPLITELE
 108       etot=wsc*evdw+wscp*evdw2+welec*ees+wvdwpp*evdw1
 109      & +wcorr*ecorr+wcorr5*ecorr5
 110      & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
 111      & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
 112 #else
 113       etot=wsc*evdw+wscp*evdw2+welec*(ees+evdw1)
 114      & +wcorr*ecorr+wcorr5*ecorr5
 115      & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
 116      & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
 117 #endif
 118       energia(0)=etot
 119       energia(1)=evdw
 120 #ifdef SCP14
 121       energia(2)=evdw2-evdw2_14
 122       energia(18)=evdw2_14
 123 #else
 124       energia(2)=evdw2
 125       energia(18)=0.0d0
 126 #endif
 127 #ifdef SPLITELE
 128       energia(3)=ees
 129       energia(16)=evdw1
 130 #else
 131       energia(3)=ees+evdw1
 132       energia(16)=0.0d0
 133 #endif
 134       energia(4)=ecorr
 135       energia(5)=ecorr5
 136       energia(6)=ecorr6
 137       energia(7)=eel_loc
 138       energia(8)=eello_turn3
 139       energia(9)=eello_turn4
 140       energia(10)=eturn6
 141       energia(12)=escloc
 142 c detecting NaNQ
 143 #ifdef ISNAN
 144 c      if (isnan(etot)) energia(0)=1.0d+99
 145 #else
 146       i=0
 147 #ifdef WINPGI
 148       idumm=proc_proc(etot,i)
 149 #else
 150       call proc_proc(etot,i)
 151 #endif
 152 c      if(i.eq.1)energia(0)=1.0d+99
 153 #endif
 154 C
 155 C Sum up the components of the Cartesian gradient.
 156 C
 157       return
 158 #ifdef SPLITELE
 159       do i=1,nct
 160         do j=1,3
 161           gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
 162      &                welec*gelc(j,i)+wvdwpp*gvdwpp(j,i)+
 163      &                wcorr*gradcorr(j,i)+
 164      &                wel_loc*gel_loc(j,i)+
 165      &                wturn3*gcorr3_turn(j,i)+
 166      &                wturn4*gcorr4_turn(j,i)+
 167      &                wcorr5*gradcorr5(j,i)+
 168      &                wcorr6*gradcorr6(j,i)+
 169      &                wturn6*gcorr6_turn(j,i)
 170           gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
 171      &                   wcorr*gradxorr(j,i)
 172         enddo
 173 #else
 174       do i=1,nct
 175         do j=1,3
 176           gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
 177      &                welec*gelc(j,i)+
 178      &                wcorr*gradcorr(j,i)+
 179      &                wel_loc*gel_loc(j,i)+
 180      &                wturn3*gcorr3_turn(j,i)+
 181      &                wturn4*gcorr4_turn(j,i)+
 182      &                wcorr5*gradcorr5(j,i)+
 183      &                wcorr6*gradcorr6(j,i)+
 184      &                wturn6*gcorr6_turn(j,i)
 185           gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
 186      &                   wcorr*gradxorr(j,i)
 187         enddo
 188 #endif
 189 cd      print '(i3,9(1pe12.4))',i,(gvdwc(k,i),k=1,3),(gelc(k,i),k=1,3),
 190 cd   &        (gradc(k,i),k=1,3)
 191       enddo
 192 c      write (iout,*) "Cartesian gradient"
 193 c      write (iout,*) "gradcorr5"
 194 c      do i=1,nres
 195 c        write (iout,*) i,(gradcorr5(j,i),j=1,3)
 196 c      enddo
 197 c      write (iout,*) "gradcorr6"
 198 c      do i=1,nres
 199 c        write (iout,*) i,(gradcorr6(j,i),j=1,3)
 200 c      enddo
 201
 202       do i=1,nres-3
 203 cd        write (iout,*) i,g_corr5_loc(i)
 204         gloc(i,icg)=wcorr*gcorr_loc(i)
 205      &   +wcorr5*g_corr5_loc(i)
 206      &   +wcorr6*g_corr6_loc(i)
 207      &   +wturn4*gel_loc_turn4(i)
 208      &   +wturn3*gel_loc_turn3(i)
 209      &   +wturn6*gel_loc_turn6(i)
 210      &   +wel_loc*gel_loc_loc(i)
 211       enddo
 212       return
 213       end
 214 c------------------------------------------------------------------------------
 215       subroutine etotal_short(energia)
 216       implicit real*8 (a-h,o-z)
 217       include 'DIMENSIONS'
 218 c
 219 c Compute the short-range fast-varying contributions to the energy
 220 c
 221 #ifndef ISNAN
 222       external proc_proc
 223 #ifdef WINPGI
 224 cMS$ATTRIBUTES C ::  proc_proc
 225 #endif
 226 #endif
 227 #ifdef MPI
 228       include "mpif.h"
 229       double precision weights_(n_ene)
 230 #endif
 231       include 'COMMON.IOUNITS'
 232       double precision energia(0:n_ene)
 233       include 'COMMON.FFIELD'
 234       include 'COMMON.DERIV'
 235       include 'COMMON.INTERACT'
 236       include 'COMMON.SBRIDGE'
 237       include 'COMMON.CHAIN'
 238       include 'COMMON.VAR'
 239       if (modecalc.eq.12.or.modecalc.eq.14) then
 240 #ifdef MPI
 241         if (fg_rank.eq.0) call int_from_cart1(.false.)
 242 #else
 243         call int_from_cart1(.false.)
 244 #endif
 245       endif
 246 #ifdef MPI
 247       write(iout,*) "ETOTAL_SHORT Processor",fg_rank,
 248      & " absolute rank",myrank," nfgtasks",nfgtasks
 249       call flush(iout)
 250       if (nfgtasks.gt.1) then
 251         time00=MPI_Wtime()
 252 C FG slaves call the following matching MPI_Bcast in ERGASTULUM
 253         if (fg_rank.eq.0) then
 254           call MPI_Bcast(0,1,MPI_INTEGER,king,FG_COMM,IERROR)
 255           write (iout,*) "Processor",myrank," BROADCAST iorder"
 256           call flush(iout)
 257 C FG master sets up the WEIGHTS_ array which will be broadcast to the
 258 C FG slaves as WEIGHTS array.
 259           weights_(1)=wsc
 260           weights_(2)=wscp
 261           weights_(3)=welec
 262           weights_(4)=wcorr
 263           weights_(5)=wcorr5
 264           weights_(6)=wcorr6
 265           weights_(7)=wel_loc
 266           weights_(8)=wturn3
 267           weights_(9)=wturn4
 268           weights_(10)=wturn6
 269           weights_(11)=wang
 270           weights_(12)=wscloc
 271           weights_(13)=wtor
 272           weights_(14)=wtor_d
 273           weights_(15)=wstrain
 274           weights_(16)=wvdwpp
 275           weights_(17)=wbond
 276           weights_(18)=scal14
 277           weights_(21)=wsccor
 278 C FG Master broadcasts the WEIGHTS_ array
 279           call MPI_Bcast(weights_(1),n_ene,
 280      &        MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
 281         else
 282 C FG slaves receive the WEIGHTS array
 283           call MPI_Bcast(weights(1),n_ene,
 284      &        MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
 285         endif
 286         write (iout,*),"Processor",myrank," BROADCAST weights"
 287         call MPI_Bcast(c(1,1),maxres6,MPI_DOUBLE_PRECISION,
 288      &    king,FG_COMM,IERR)
 289         write (iout,*) "Processor",myrank," BROADCAST c"
 290         call MPI_Bcast(dc(1,1),maxres6,MPI_DOUBLE_PRECISION,
 291      &    king,FG_COMM,IERR)
 292         write (iout,*) "Processor",myrank," BROADCAST dc"
 293         call MPI_Bcast(dc_norm(1,1),maxres6,MPI_DOUBLE_PRECISION,
 294      &    king,FG_COMM,IERR)
 295         write (iout,*) "Processor",myrank," BROADCAST dc_norm"
 296         call MPI_Bcast(theta(1),nres,MPI_DOUBLE_PRECISION,
 297      &    king,FG_COMM,IERR)
 298         write (iout,*) "Processor",myrank," BROADCAST theta"
 299         call MPI_Bcast(phi(1),nres,MPI_DOUBLE_PRECISION,
 300      &    king,FG_COMM,IERR)
 301         write (iout,*) "Processor",myrank," BROADCAST phi"
 302         call MPI_Bcast(alph(1),nres,MPI_DOUBLE_PRECISION,
 303      &    king,FG_COMM,IERR)
 304         write (iout,*) "Processor",myrank," BROADCAST alph"
 305         call MPI_Bcast(omeg(1),nres,MPI_DOUBLE_PRECISION,
 306      &    king,FG_COMM,IERR)
 307         write (iout,*) "Processor",myrank," BROADCAST omeg"
 308         call MPI_Bcast(vbld(1),2*nres,MPI_DOUBLE_PRECISION,
 309      &    king,FG_COMM,IERR)
 310         write (iout,*) "Processor",myrank," BROADCAST vbld"
 311         call MPI_Bcast(vbld_inv(1),2*nres,MPI_DOUBLE_PRECISION,
 312      &    king,FG_COMM,IERR)
 313          time_Bcast=time_Bcast+MPI_Wtime()-time00
 314         write (iout,*) "Processor",myrank," BROADCAST vbld_inv"
 315       endif
 316       write (iout,*) 'Processor',myrank,
 317      &  ' calling etotal_short ipot=',ipot
 318       call flush(iout)
 319       print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
 320 #endif
 321 c      call int_from_cart1(.false.)
 322 c
 323 c Calculate the bond-stretching energy
 324 c
 325       call ebond(estr)
 326 C
 327 C Calculate the disulfide-bridge and other energy and the contributions
 328 C from other distance constraints.
 329       call edis(ehpb)
 330 C
 331 C Calculate the virtual-bond-angle energy.
 332 C
 333       call ebend(ebe)
 334 C
 335 C Calculate the SC local energy.
 336 C
 337       call vec_and_deriv
 338       call esc(escloc)
 339 C
 340 C Calculate the virtual-bond torsional energy.
 341 C
 342       call etor(etors,edihcnstr)
 343 C
 344 C 6/23/01 Calculate double-torsional energy
 345 C
 346       call etor_d(etors_d)
 347       etot=wang*ebe+wtor*etors+wscloc*escloc+wtor_d*etors_d+wbond*estr
 348      &     +edihcnstr+wstrain*ehpb+nss*ebr
 349       energia(0)=etot
 350       energia(11)=ebe
 351       energia(12)=escloc
 352       energia(13)=etors
 353       energia(14)=etors_d
 354       energia(15)=ehpb
 355       energia(17)=estr
 356 c detecting NaNQ
 357 #ifdef ISNAN
 358 c      if (isnan(etot)) energia(0)=1.0d+99
 359 #else
 360       i=0
 361 #ifdef WINPGI
 362       idumm=proc_proc(etot,i)
 363 #else
 364       call proc_proc(etot,i)
 365 #endif
 366 c      if(i.eq.1)energia(0)=1.0d+99
 367 #endif
 368 C
 369 C Sum up the components of the Cartesian gradient.
 370 C
 371       return
 372       do i=1,nct
 373         do j=1,3
 374 #ifdef CRYST_SC
 375           gradc(j,i,icg)=wbond*gradb(j,i)+wstrain*ghpbc(j,i)
 376           gradx(j,i,icg)=wbond*gradbx(j,i)+wstrain*ghpbx(j,i)
 377 #else
 378           gradc(j,i,icg)=wbond*gradb(j,i)+wstrain*ghpbc(j,i)+
 379      &        +wscloc*gscloc(j,i)
 380           gradx(j,i,icg)=wbond*gradbx(j,i)+wstrain*ghpbx(j,i)
 381      &        +wscloc*gsclocx(j,i)
 382 #endif
 383         enddo
 384       enddo
 385       return
 386       end