source/unres/src_MD/src/old_F/energy_split-sc.F

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