switched to CMake FindMPI module in all source files that use MPI
[unres.git] / source / unres / src_MD / unres.F
1 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2 C                                                                              C
3 C                                U N R E S                                     C
4 C                                                                              C
5 C Program to carry out conformational search of proteins in an united-residue  C
6 C approximation.                                                               C
7 C                                                                              C
8 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9       implicit real*8 (a-h,o-z)
10       include 'DIMENSIONS'
11
12
13 #ifdef MPI
14       include 'mpif.h'
15       include 'COMMON.SETUP'
16 #endif
17       include 'COMMON.TIME1'
18       include 'COMMON.INTERACT'
19       include 'COMMON.NAMES'
20       include 'COMMON.GEO'
21       include 'COMMON.HEADER'
22       include 'COMMON.CONTROL'
23       include 'COMMON.CONTACTS'
24       include 'COMMON.CHAIN'
25       include 'COMMON.VAR'
26       include 'COMMON.IOUNITS'
27       include 'COMMON.FFIELD'
28       include 'COMMON.REMD'
29       include 'COMMON.MD'
30       include 'COMMON.SBRIDGE'
31       double precision hrtime,mintime,sectime
32       character*64 text_mode_calc(-2:14) /'test',
33      & 'SC rotamer distribution',
34      & 'Energy evaluation or minimization',
35      & 'Regularization of PDB structure',
36      & 'Threading of a sequence on PDB structures',
37      & 'Monte Carlo (with minimization) ',
38      & 'Energy minimization of multiple conformations',
39      & 'Checking energy gradient',
40      & 'Entropic sampling Monte Carlo (with minimization)',
41      & 'Energy map',
42      & 'CSA calculations',
43      & 'Not used 9',
44      & 'Not used 10',
45      & 'Soft regularization of PDB structure',
46      & 'Mesoscopic molecular dynamics (MD) ',
47      & 'Not used 13',
48      & 'Replica exchange molecular dynamics (REMD)'/
49       external ilen
50
51 c      call memmon_print_usage()
52
53       call init_task
54       if (me.eq.king)
55      & write(iout,*)'### LAST MODIFIED  03/28/12 23:29 by czarek'  
56       if (me.eq.king) call cinfo
57 C Read force field parameters and job setup data
58       call readrtns
59       call flush(iout)
60 C
61       if (me.eq.king .or. .not. out1file) then
62        write (iout,'(2a/)') 
63      & text_mode_calc(modecalc)(:ilen(text_mode_calc(modecalc))),
64      & ' calculation.' 
65        if (minim) write (iout,'(a)') 
66      &  'Conformations will be energy-minimized.'
67        write (iout,'(80(1h*)/)') 
68       endif
69       call flush(iout)
70 C
71       if (modecalc.eq.-2) then
72         call test
73         stop
74       else if (modecalc.eq.-1) then
75         write(iout,*) "call check_sc_map next"
76         call check_bond
77         stop
78       endif
79 #ifdef MPI
80       if (fg_rank.gt.0) then
81 C Fine-grain slaves just do energy and gradient components.
82         call ergastulum ! slave workhouse in Latin
83       else
84 #endif
85       if (modecalc.eq.0) then
86         call exec_eeval_or_minim
87       else if (modecalc.eq.1) then
88         call exec_regularize
89       else if (modecalc.eq.2) then
90         call exec_thread
91       else if (modecalc.eq.3 .or. modecalc .eq.6) then
92         call exec_MC
93       else if (modecalc.eq.4) then
94         call exec_mult_eeval_or_minim
95       else if (modecalc.eq.5) then
96         call exec_checkgrad
97       else if (ModeCalc.eq.7) then
98         call exec_map
99       else if (ModeCalc.eq.8) then
100         call exec_CSA
101       else if (modecalc.eq.11) then
102         call exec_softreg
103       else if (modecalc.eq.12) then
104         call exec_MD
105       else if (modecalc.eq.14) then
106         call exec_MREMD
107       else
108         write (iout,'(a)') 'This calculation type is not supported',
109      &   ModeCalc
110       endif
111 #ifdef MPI
112       endif
113 C Finish task.
114       if (fg_rank.eq.0) call finish_task
115 c      call memmon_print_usage()
116 #ifdef TIMING
117        call print_detailed_timing
118 #endif
119       call MPI_Finalize(ierr)
120       stop 'Bye Bye...'
121 #else
122       call dajczas(tcpu(),hrtime,mintime,sectime)
123       stop '********** Program terminated normally.'
124 #endif
125       end
126 c--------------------------------------------------------------------------
127       subroutine exec_MD
128       include 'DIMENSIONS'
129 #ifdef MPI
130       include "mpif.h"
131 #endif
132       include 'COMMON.SETUP'
133       include 'COMMON.CONTROL'
134       include 'COMMON.IOUNITS'
135       if (me.eq.king .or. .not. out1file)
136      &   write (iout,*) "Calling chainbuild"
137       call chainbuild
138       call MD
139       return
140       end
141 c---------------------------------------------------------------------------
142       subroutine exec_MREMD
143       include 'DIMENSIONS'
144 #ifdef MPI
145       include "mpif.h"
146       include 'COMMON.SETUP'
147       include 'COMMON.CONTROL'
148       include 'COMMON.IOUNITS'
149       include 'COMMON.REMD'
150       if (me.eq.king .or. .not. out1file)
151      &   write (iout,*) "Calling chainbuild"
152       call chainbuild
153       if (me.eq.king .or. .not. out1file)
154      &   write (iout,*) "Calling REMD"
155       if (remd_mlist) then 
156         call MREMD
157       else
158         do i=1,nrep
159           remd_m(i)=1
160         enddo
161         call MREMD
162       endif
163 #else
164       write (iout,*) "MREMD works on parallel machines only"
165 #endif
166       return
167       end
168 c---------------------------------------------------------------------------
169       subroutine exec_eeval_or_minim
170       implicit real*8 (a-h,o-z)
171       include 'DIMENSIONS'
172 #ifdef MPI
173       include 'mpif.h'
174 #endif
175       include 'COMMON.SETUP'
176       include 'COMMON.TIME1'
177       include 'COMMON.INTERACT'
178       include 'COMMON.NAMES'
179       include 'COMMON.GEO'
180       include 'COMMON.HEADER'
181       include 'COMMON.CONTROL'
182       include 'COMMON.CONTACTS'
183       include 'COMMON.CHAIN'
184       include 'COMMON.VAR'
185       include 'COMMON.IOUNITS'
186       include 'COMMON.FFIELD'
187       include 'COMMON.REMD'
188       include 'COMMON.MD'
189       include 'COMMON.SBRIDGE'
190       common /srutu/ icall
191       double precision energy(0:n_ene)
192       double precision energy_long(0:n_ene),energy_short(0:n_ene)
193       double precision varia(maxvar)
194       if (indpdb.eq.0) call chainbuild
195 #ifdef MPI
196       time00=MPI_Wtime()
197 #else
198       time00=tcpu()
199 #endif
200       call chainbuild_cart
201       if (split_ene) then
202        print *,"Processor",myrank," after chainbuild"
203        icall=1
204        call etotal_long(energy_long(0))
205        write (iout,*) "Printing long range energy"
206        call enerprint(energy_long(0))
207        call etotal_short(energy_short(0))
208        write (iout,*) "Printing short range energy"
209        call enerprint(energy_short(0))
210        do i=0,n_ene
211          energy(i)=energy_long(i)+energy_short(i)
212          write (iout,*) i,energy_long(i),energy_short(i),energy(i)
213        enddo
214        write (iout,*) "Printing long+short range energy"
215        call enerprint(energy(0))
216       endif
217       call etotal(energy(0))
218 #ifdef MPI
219       time_ene=MPI_Wtime()-time00
220 #else
221       time_ene=tcpu()-time00
222 #endif
223       write (iout,*) "Time for energy evaluation",time_ene
224       print *,"after etotal"
225       etota = energy(0)
226       etot =etota
227       call enerprint(energy(0))
228       call hairpin(.true.,nharp,iharp)
229       call secondary2(.true.)
230       if (minim) then
231 crc overlap test
232         if (overlapsc) then 
233           print *, 'Calling OVERLAP_SC'
234           call overlap_sc(fail)
235         endif 
236
237         if (searchsc) then 
238           call sc_move(2,nres-1,10,1d10,nft_sc,etot)
239           print *,'SC_move',nft_sc,etot
240           write(iout,*) 'SC_move',nft_sc,etot
241         endif 
242
243         if (dccart) then
244           print *, 'Calling MINIM_DC'
245 #ifdef MPI
246           time1=MPI_WTIME()
247 #else
248           time1=tcpu()
249 #endif
250           call minim_dc(etot,iretcode,nfun)
251         else
252           if (indpdb.ne.0) then 
253             call bond_regular
254             call chainbuild
255           endif
256           call geom_to_var(nvar,varia)
257           print *,'Calling MINIMIZE.'
258 #ifdef MPI
259           time1=MPI_WTIME()
260 #else
261           time1=tcpu()
262 #endif
263           call minimize(etot,varia,iretcode,nfun)
264         endif
265         print *,'SUMSL return code is',iretcode,' eval ',nfun
266 #ifdef MPI
267         evals=nfun/(MPI_WTIME()-time1)
268 #else
269         evals=nfun/(tcpu()-time1)
270 #endif
271         print *,'# eval/s',evals
272         print *,'refstr=',refstr
273         call hairpin(.true.,nharp,iharp)
274         call secondary2(.true.)
275         call etotal(energy(0))
276         etot = energy(0)
277         call enerprint(energy(0))
278
279         call intout
280         call briefout(0,etot)
281         if (refstr) call rms_nac_nnc(rms,frac,frac_nn,co,.true.)
282           write (iout,'(a,i3)') 'SUMSL return code:',iretcode
283           write (iout,'(a,i20)') '# of energy evaluations:',nfun+1
284           write (iout,'(a,f16.3)')'# of energy evaluations/sec:',evals
285       else
286         print *,'refstr=',refstr
287         if (refstr) call rms_nac_nnc(rms,frac,frac_nn,co,.true.)
288         call briefout(0,etot)
289       endif
290       if (outpdb) call pdbout(etot,titel(:32),ipdb)
291       if (outmol2) call mol2out(etot,titel(:32))
292       return
293       end
294 c---------------------------------------------------------------------------
295       subroutine exec_regularize
296       implicit real*8 (a-h,o-z)
297       include 'DIMENSIONS'
298 #ifdef MPI
299       include 'mpif.h'
300 #endif
301       include 'COMMON.SETUP'
302       include 'COMMON.TIME1'
303       include 'COMMON.INTERACT'
304       include 'COMMON.NAMES'
305       include 'COMMON.GEO'
306       include 'COMMON.HEADER'
307       include 'COMMON.CONTROL'
308       include 'COMMON.CONTACTS'
309       include 'COMMON.CHAIN'
310       include 'COMMON.VAR'
311       include 'COMMON.IOUNITS'
312       include 'COMMON.FFIELD'
313       include 'COMMON.REMD'
314       include 'COMMON.MD'
315       include 'COMMON.SBRIDGE'
316       double precision energy(0:n_ene)
317
318       call gen_dist_constr
319       call sc_conf
320       call intout
321       call regularize(nct-nnt+1,etot,rms,cref(1,nnt),iretcode)
322       call etotal(energy(0))
323       energy(0)=energy(0)-energy(14)
324       etot=energy(0)
325       call enerprint(energy(0))
326       call intout
327       call briefout(0,etot)
328       if (outpdb) call pdbout(etot,titel(:32),ipdb)
329       if (outmol2) call mol2out(etot,titel(:32))
330       if (refstr) call rms_nac_nnc(rms,frac,frac_nn,co,.true.)
331       write (iout,'(a,i3)') 'SUMSL return code:',iretcode
332       return
333       end
334 c---------------------------------------------------------------------------
335       subroutine exec_thread
336       include 'DIMENSIONS'
337 #ifdef MP
338       include "mpif.h"
339 #endif
340       include "COMMON.SETUP"
341       call thread_seq
342       return
343       end
344 c---------------------------------------------------------------------------
345       subroutine exec_MC
346       implicit real*8 (a-h,o-z)
347       include 'DIMENSIONS'
348       character*10 nodeinfo
349       double precision varia(maxvar)
350 #ifdef MPI
351       include "mpif.h"
352 #endif
353       include "COMMON.SETUP"
354       include 'COMMON.CONTROL'
355       call mcm_setup
356       if (minim) then
357 #ifdef MPI
358         if (modecalc.eq.3) then
359           call do_mcm(ipar)
360         else
361           call entmcm
362         endif
363 #else
364         if (modecalc.eq.3) then
365           call do_mcm(ipar)
366         else
367           call entmcm
368         endif
369 #endif
370       else
371         call monte_carlo
372       endif
373       return
374       end
375 c---------------------------------------------------------------------------
376       subroutine exec_mult_eeval_or_minim
377       implicit real*8 (a-h,o-z)
378       include 'DIMENSIONS'
379 #ifdef MPI
380       include 'mpif.h'
381       dimension muster(mpi_status_size)
382 #endif
383       include 'COMMON.SETUP'
384       include 'COMMON.TIME1'
385       include 'COMMON.INTERACT'
386       include 'COMMON.NAMES'
387       include 'COMMON.GEO'
388       include 'COMMON.HEADER'
389       include 'COMMON.CONTROL'
390       include 'COMMON.CONTACTS'
391       include 'COMMON.CHAIN'
392       include 'COMMON.VAR'
393       include 'COMMON.IOUNITS'
394       include 'COMMON.FFIELD'
395       include 'COMMON.REMD'
396       include 'COMMON.MD'
397       include 'COMMON.SBRIDGE'
398       double precision varia(maxvar)
399       dimension ind(6)
400       double precision energy(0:n_ene)
401       logical eof
402       eof=.false.
403 #ifdef MPI
404       if(me.ne.king) then
405         call minim_mcmf
406         return
407       endif
408
409       close (intin)
410       open(intin,file=intinname,status='old')
411       write (istat,'(a5,30a12)')"#    ",
412      &  (wname(print_order(i)),i=1,nprint_ene)
413       if (refstr) then
414         write (istat,'(a5,30a12)')"#    ",
415      &   (ename(print_order(i)),i=1,nprint_ene),
416      &   "ETOT total","RMSD","nat.contact","nnt.contact","cont.order"
417       else
418         write (istat,'(a5,30a12)')"#    ",
419      &    (ename(print_order(i)),i=1,nprint_ene),"ETOT total"
420       endif
421
422       if (.not.minim) then
423         do while (.not. eof)
424           if (read_cart) then
425             read (intin,'(e15.10,e15.5)',end=1100,err=1100) time,ene
426             call read_x(intin,*11)
427 #ifdef MPI
428 c Broadcast the order to compute internal coordinates to the slaves.
429             if (nfgtasks.gt.1)
430      &        call MPI_Bcast(6,1,MPI_INTEGER,king,FG_COMM,IERROR)
431 #endif
432             call int_from_cart1(.false.)
433           else
434             read (intin,'(i5)',end=1100,err=1100) iconf
435             call read_angles(intin,*11)
436             call geom_to_var(nvar,varia)
437             call chainbuild
438           endif
439           write (iout,'(a,i7)') 'Conformation #',iconf
440           call etotal(energy(0))
441           call briefout(iconf,energy(0))
442           call enerprint(energy(0))
443           etot=energy(0)
444           if (refstr) then 
445             call rms_nac_nnc(rms,frac,frac_nn,co,.true.)
446             write (istat,'(i5,30(f12.3))') iconf,
447      &      (energy(print_order(i)),i=1,nprint_ene),etot,
448      &       rms,frac,frac_nn,co
449 cjlee end
450           else
451             write (istat,'(i5,30(f12.3))') iconf,
452      &     (energy(print_order(i)),i=1,nprint_ene),etot
453           endif
454         enddo
455 1100    continue
456         goto 1101
457       endif
458
459       mm=0
460       imm=0
461       nft=0
462       ene0=0.0d0
463       n=0
464       iconf=0
465 c      do n=1,nzsc
466       do while (.not. eof)
467         mm=mm+1
468         if (mm.lt.nodes) then
469           if (read_cart) then
470             read (intin,'(e15.10,e15.5)',end=11,err=11) time,ene
471             call read_x(intin,*11)
472 #ifdef MPI
473 c Broadcast the order to compute internal coordinates to the slaves.
474             if (nfgtasks.gt.1) 
475      &        call MPI_Bcast(6,1,MPI_INTEGER,king,FG_COMM,IERROR)
476 #endif
477             call int_from_cart1(.false.)
478           else
479             read (intin,'(i5)',end=11,err=11) iconf
480             call read_angles(intin,*11)
481             call geom_to_var(nvar,varia)
482             call chainbuild
483           endif
484
485           n=n+1
486           write (iout,*) 'Conformation #',iconf,' read'
487          imm=imm+1
488          ind(1)=1
489          ind(2)=n
490          ind(3)=0
491          ind(4)=0
492          ind(5)=0
493          ind(6)=0
494          ene0=0.0d0
495          call mpi_send(ind,6,mpi_integer,mm,idint,CG_COMM,
496      *                  ierr)
497          call mpi_send(varia,nvar,mpi_double_precision,mm,
498      *                  idreal,CG_COMM,ierr)
499          call mpi_send(ene0,1,mpi_double_precision,mm,
500      *                  idreal,CG_COMM,ierr)
501 c         print *,'task ',n,' sent to worker ',mm,nvar
502         else
503          call mpi_recv(ind,6,mpi_integer,mpi_any_source,idint,
504      *                 CG_COMM,muster,ierr)
505          man=muster(mpi_source)
506 c         print *,'receiving result from worker ',man,' (',iii1,iii,')'
507          call mpi_recv(varia,nvar,mpi_double_precision, 
508      *               man,idreal,CG_COMM,muster,ierr)
509          call mpi_recv(ene,1,
510      *               mpi_double_precision,man,idreal,
511      *               CG_COMM,muster,ierr)
512          call mpi_recv(ene0,1,
513      *               mpi_double_precision,man,idreal,
514      *               CG_COMM,muster,ierr)
515 c         print *,'result received from worker ',man,' sending now'
516
517           call var_to_geom(nvar,varia)
518           call chainbuild
519           call etotal(energy(0))
520           iconf=ind(2)
521           write (iout,*)
522           write (iout,*)
523           write (iout,*) 'Conformation #',iconf," sumsl return code ",
524      &                      ind(5)
525
526           etot=energy(0)
527           call enerprint(energy(0))
528           call briefout(it,etot)
529 c          if (minim) call briefout(it,etot)
530           if (refstr) then 
531             call rms_nac_nnc(rms,frac,frac_nn,co,.true.)
532             write (istat,'(i5,30(f12.3))') iconf,
533      &     (energy(print_order(i)),i=1,nprint_ene),etot,
534      &     rms,frac,frac_nn,co
535           else
536             write (istat,'(i5,30(f12.3))') iconf,
537      &     (energy(print_order(i)),i=1,nprint_ene),etot
538           endif
539
540           imm=imm-1
541           if (read_cart) then
542             read (intin,'(e15.10,e15.5)',end=11,err=11) time,ene
543             call read_x(intin,*11)
544 #ifdef MPI
545 c Broadcast the order to compute internal coordinates to the slaves.
546             if (nfgtasks.gt.1)
547      &        call MPI_Bcast(6,1,MPI_INTEGER,king,FG_COMM,IERROR)
548 #endif
549             call int_from_cart1(.false.)
550           else
551             read (intin,'(i5)',end=11,err=11) iconf
552             call read_angles(intin,*11)
553             call geom_to_var(nvar,varia)
554             call chainbuild
555           endif
556           n=n+1
557           write (iout,*) 'Conformation #',iconf,' read'
558           imm=imm+1
559           ind(1)=1
560           ind(2)=n
561           ind(3)=0
562           ind(4)=0
563           ind(5)=0
564           ind(6)=0
565           call mpi_send(ind,6,mpi_integer,man,idint,CG_COMM,
566      *                  ierr)
567           call mpi_send(varia,nvar,mpi_double_precision,man, 
568      *                  idreal,CG_COMM,ierr)
569           call mpi_send(ene0,1,mpi_double_precision,man,
570      *                  idreal,CG_COMM,ierr)
571           nf_mcmf=nf_mcmf+ind(4)
572           nmin=nmin+1
573         endif
574       enddo
575 11    continue
576       do j=1,imm
577         call mpi_recv(ind,6,mpi_integer,mpi_any_source,idint,
578      *               CG_COMM,muster,ierr)
579         man=muster(mpi_source)
580         call mpi_recv(varia,nvar,mpi_double_precision, 
581      *               man,idreal,CG_COMM,muster,ierr)
582         call mpi_recv(ene,1,
583      *               mpi_double_precision,man,idreal,
584      *               CG_COMM,muster,ierr)
585         call mpi_recv(ene0,1,
586      *               mpi_double_precision,man,idreal,
587      *               CG_COMM,muster,ierr)
588
589         call var_to_geom(nvar,varia)
590         call chainbuild
591         call etotal(energy(0))
592         iconf=ind(2)
593         write (iout,*)
594         write (iout,*)
595         write (iout,*) 'Conformation #',iconf," sumsl return code ",
596      &                  ind(5)
597
598         etot=energy(0)
599         call enerprint(energy(0))
600         call briefout(it,etot)
601         if (refstr) then 
602           call rms_nac_nnc(rms,frac,frac_nn,co,.true.)
603           write (istat,'(i5,30(f12.3))') iconf,
604      &   (energy(print_order(i)),i=1,nprint_ene),etot,
605      &   rms,frac,frac_nn,co
606         else
607           write (istat,'(i5,30(f12.3))') iconf,
608      &    (energy(print_order(i)),i=1,nprint_ene),etot
609         endif
610         nmin=nmin+1
611       enddo
612 1101  continue
613       do i=1, nodes-1
614          ind(1)=0
615          ind(2)=0
616          ind(3)=0
617          ind(4)=0
618          ind(5)=0
619          ind(6)=0
620          call mpi_send(ind,6,mpi_integer,i,idint,CG_COMM,
621      *                  ierr)
622       enddo
623 #else
624       close (intin)
625       open(intin,file=intinname,status='old')
626       write (istat,'(a5,20a12)')"#    ",
627      &   (wname(print_order(i)),i=1,nprint_ene)
628       write (istat,'("#    ",20(1pe12.4))')
629      &   (weights(print_order(i)),i=1,nprint_ene)
630       if (refstr) then
631         write (istat,'(a5,20a12)')"#    ",
632      &   (ename(print_order(i)),i=1,nprint_ene),
633      &   "ETOT total","RMSD","nat.contact","nnt.contact"
634       else
635         write (istat,'(a5,14a12)')"#    ",
636      &   (ename(print_order(i)),i=1,nprint_ene),"ETOT total"
637       endif
638       do while (.not. eof)
639           if (read_cart) then
640             read (intin,'(e15.10,e15.5)',end=1100,err=1100) time,ene
641             call read_x(intin,*11)
642 #ifdef MPI
643 c Broadcast the order to compute internal coordinates to the slaves.
644             if (nfgtasks.gt.1)
645      &        call MPI_Bcast(6,1,MPI_INTEGER,king,FG_COMM,IERROR)
646 #endif
647             call int_from_cart1(.false.)
648           else
649             read (intin,'(i5)',end=1100,err=1100) iconf
650             call read_angles(intin,*11)
651             call geom_to_var(nvar,varia)
652             call chainbuild
653           endif
654         write (iout,'(a,i7)') 'Conformation #',iconf
655         if (minim) call minimize(etot,varia,iretcode,nfun)
656         call etotal(energy(0))
657
658         etot=energy(0)
659         call enerprint(energy(0))
660         if (minim) call briefout(it,etot) 
661         if (refstr) then 
662           call rms_nac_nnc(rms,frac,frac_nn,co,.true.)
663           write (istat,'(i5,18(f12.3))') iconf,
664      &   (energy(print_order(i)),i=1,nprint_ene),
665      &   etot,rms,frac,frac_nn,co
666 cjlee end
667         else
668           write (istat,'(i5,14(f12.3))') iconf,
669      &   (energy(print_order(i)),i=1,nprint_ene),etot
670         endif
671       enddo
672    11 continue
673  1100 continue
674 #endif
675       return
676       end
677 c---------------------------------------------------------------------------
678       subroutine exec_checkgrad
679       implicit real*8 (a-h,o-z)
680       include 'DIMENSIONS'
681 #ifdef MPI
682       include 'mpif.h'
683 #endif
684       include 'COMMON.SETUP'
685       include 'COMMON.TIME1'
686       include 'COMMON.INTERACT'
687       include 'COMMON.NAMES'
688       include 'COMMON.GEO'
689       include 'COMMON.HEADER'
690       include 'COMMON.CONTROL'
691       include 'COMMON.CONTACTS'
692       include 'COMMON.CHAIN'
693       include 'COMMON.VAR'
694       include 'COMMON.IOUNITS'
695       include 'COMMON.FFIELD'
696       include 'COMMON.REMD'
697       include 'COMMON.MD'
698       include 'COMMON.SBRIDGE'
699       common /srutu/ icall
700       double precision energy(0:max_ene)
701 c      do i=2,nres
702 c        vbld(i)=vbld(i)+ran_number(-0.1d0,0.1d0)
703 c        if (itype(i).ne.10) 
704 c     &      vbld(i+nres)=vbld(i+nres)+ran_number(-0.001d0,0.001d0)
705 c      enddo
706       if (indpdb.eq.0) call chainbuild
707 c      do i=0,nres
708 c        do j=1,3
709 c          dc(j,i)=dc(j,i)+ran_number(-0.2d0,0.2d0)
710 c        enddo
711 c      enddo
712 c      do i=1,nres-1
713 c        if (itype(i).ne.10) then
714 c          do j=1,3
715 c            dc(j,i+nres)=dc(j,i+nres)+ran_number(-0.2d0,0.2d0)
716 c          enddo
717 c        endif
718 c      enddo
719 c      do j=1,3
720 c        dc(j,0)=ran_number(-0.2d0,0.2d0)
721 c      enddo
722       usampl=.true.
723       totT=1.d0
724       eq_time=0.0d0
725       call read_fragments
726       read(inp,*) t_bath
727       call rescale_weights(t_bath)
728       call chainbuild_cart
729       call cartprint
730       call intout
731       icall=1
732       call etotal(energy(0))
733       etot = energy(0)
734       call enerprint(energy(0))
735       write (iout,*) "Uconst",Uconst," Uconst_back",uconst_back
736       print *,'icheckgrad=',icheckgrad
737       goto (10,20,30) icheckgrad
738   10  call check_ecartint
739       return
740   20  call check_cartgrad
741       return
742   30  call check_eint
743       return
744       end
745 c---------------------------------------------------------------------------
746       subroutine exec_map
747 C Energy maps
748       call map_read
749       call map
750       return
751       end
752 c---------------------------------------------------------------------------
753       subroutine exec_CSA
754 #ifdef MPI
755       include "mpif.h"
756 #endif
757       include 'DIMENSIONS'
758       include 'COMMON.IOUNITS'
759 C Conformational Space Annealling programmed by Jooyoung Lee.
760 C This method works only with parallel machines!
761 #ifdef MPI
762 csa      call together
763       write (iout,*) "CSA is not supported in this version"
764 #else
765 csa      write (iout,*) "CSA works on parallel machines only"
766       write (iout,*) "CSA is not supported in this version"
767 #endif
768       return
769       end
770 c---------------------------------------------------------------------------
771       subroutine exec_softreg
772       implicit real*8 (a-h,o-z)
773       include 'DIMENSIONS'
774       include 'COMMON.IOUNITS'
775       include 'COMMON.CONTROL'
776       double precision energy(0:max_ene)
777       logical debug /.false./
778       call chainbuild
779       call etotal(energy(0))
780       call enerprint(energy(0))
781       if (.not.lsecondary) then
782         write(iout,*) 'Calling secondary structure recognition'
783         call secondary2(debug)
784       else
785         write(iout,*) 'Using secondary structure supplied in pdb'
786       endif
787
788       call softreg
789
790       call etotal(energy(0))
791       etot=energy(0)
792       call enerprint(energy(0))
793       call intout
794       call briefout(0,etot)
795       call secondary2(.true.)
796       if (refstr) call rms_nac_nnc(rms,frac,frac_nn,co,.true.)
797       return
798       end