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