added source code
[unres.git] / source / unres / src_MD / src / old_F / 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
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
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
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