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