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