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           write (iout,*) 'Calling OVERLAP_SC'
 287           call overlap_sc(fail)
 288           write (iout,*) "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 (outpdb) call pdbout(etot,titel(:50),ipdb)
 343         if (refstr) call rms_nac_nnc(rms,frac,frac_nn,co,.true.)
 344 #ifdef LBFGS
 345           write (iout,'(a,a9)') 'LBFGS return code:',status
 346           write (iout,'(a,i20)') '# of energy evaluations:',nfun+1
 347           write (iout,'(a,f16.3)')'# of energy evaluations/sec:',evals
 348 #else
 349           write (iout,'(a,i3)') 'SUMSL return code:',iretcode
 350           write (iout,'(a,i20)') '# of energy evaluations:',nfun+1
 351           write (iout,'(a,f16.3)')'# of energy evaluations/sec:',evals
 352 #endif
 353       else
 354         print *,'refstr=',refstr
 355         if (refstr) call rms_nac_nnc(rms,frac,frac_nn,co,.true.)
 356         call briefout(0,etot)
 357       endif
 358       if (outpdb) call pdbout(etot,titel(:50),ipdb)
 359       if (outmol2) call mol2out(etot,titel(:32))
 360       return
 361       end
 362 c---------------------------------------------------------------------------
 363       subroutine exec_regularize
 364       implicit none
 365       include 'DIMENSIONS'
 366 #ifdef MPI
 367       include 'mpif.h'
 368 #endif
 369       include 'COMMON.SETUP'
 370       include 'COMMON.TIME1'
 371       include 'COMMON.INTERACT'
 372       include 'COMMON.NAMES'
 373       include 'COMMON.GEO'
 374       include 'COMMON.HEADER'
 375       include 'COMMON.CONTROL'
 376 c      include 'COMMON.CONTACTS'
 377       include 'COMMON.CHAIN'
 378       include 'COMMON.VAR'
 379       include 'COMMON.IOUNITS'
 380       include 'COMMON.FFIELD'
 381       include 'COMMON.REMD'
 382       include 'COMMON.MD'
 383       include 'COMMON.SBRIDGE'
 384       double precision energy(0:n_ene)
 385       double precision etot,rms,frac,frac_nn,co
 386       integer iretcode
 387 #ifdef LBFGS
 388       character*9 status
 389       integer niter,nfun
 390       common /lbfgstat/ status,niter,nfun
 391 #endif
 392
 393       call gen_dist_constr
 394       call sc_conf
 395       call intout
 396       call regularize(nct-nnt+1,etot,rms,cref(1,nnt),iretcode)
 397       call etotal(energy(0))
 398       energy(0)=energy(0)-energy(14)
 399       etot=energy(0)
 400       call enerprint(energy(0))
 401       call intout
 402       call briefout(0,etot)
 403       if (outpdb) call pdbout(etot,titel(:50),ipdb)
 404       if (outmol2) call mol2out(etot,titel(:32))
 405       if (refstr) call rms_nac_nnc(rms,frac,frac_nn,co,.true.)
 406 #ifdef LBFGS
 407       write (iout,'(a,a9)') 'LBFGS return code:',status
 408 #else
 409       write (iout,'(a,i3)') 'SUMSL return code:',iretcode
 410 #endif
 411       return
 412       end
 413 c---------------------------------------------------------------------------
 414       subroutine exec_thread
 415       implicit none
 416       include 'DIMENSIONS'
 417 #ifdef MP
 418       include "mpif.h"
 419 #endif
 420       include "COMMON.SETUP"
 421       call thread_seq
 422       return
 423       end
 424 c---------------------------------------------------------------------------
 425       subroutine exec_MC
 426       implicit none
 427       include 'DIMENSIONS'
 428       character*10 nodeinfo
 429       integer ipar
 430       double precision varia(maxvar)
 431 #ifdef MPI
 432       include "mpif.h"
 433 #endif
 434       include "COMMON.SETUP"
 435       include 'COMMON.CONTROL'
 436       call mcm_setup
 437       if (minim) then
 438 #ifdef MPI
 439         if (modecalc.eq.3) then
 440           call do_mcm(ipar)
 441         else
 442           call entmcm
 443         endif
 444 #else
 445         if (modecalc.eq.3) then
 446           call do_mcm(ipar)
 447         else
 448           call entmcm
 449         endif
 450 #endif
 451       else
 452         call monte_carlo
 453       endif
 454       return
 455       end
 456 c---------------------------------------------------------------------------
 457       subroutine exec_mult_eeval_or_minim
 458       implicit none
 459       include 'DIMENSIONS'
 460 #ifdef MPI
 461       include 'mpif.h'
 462       integer muster(mpi_status_size)
 463       integer ierr,ierror
 464 #endif
 465       include 'COMMON.SETUP'
 466       include 'COMMON.TIME1'
 467       include 'COMMON.INTERACT'
 468       include 'COMMON.NAMES'
 469       include 'COMMON.GEO'
 470       include 'COMMON.HEADER'
 471       include 'COMMON.CONTROL'
 472 c      include 'COMMON.CONTACTS'
 473       include 'COMMON.CHAIN'
 474       include 'COMMON.VAR'
 475       include 'COMMON.IOUNITS'
 476       include 'COMMON.FFIELD'
 477       include 'COMMON.REMD'
 478       include 'COMMON.MD'
 479       include 'COMMON.SBRIDGE'
 480       double precision varia(maxvar)
 481       integer i,j,iconf,ind(6)
 482       integer n,it,man,nf_mcmf,nmin,imm,mm,nft
 483       double precision energy(0:max_ene),ene,etot,ene0
 484       double precision rms,frac,frac_nn,co
 485       double precision time
 486       logical eof
 487       eof=.false.
 488 #ifdef MPI
 489       if(me.ne.king) then
 490         call minim_mcmf
 491         return
 492       endif
 493
 494       close (intin)
 495       open(intin,file=intinname,status='old')
 496       write (istat,'(a5,20a12)')"#    ",
 497      &  (wname(print_order(i)),i=1,nprint_ene)
 498       if (refstr) then
 499         write (istat,'(a5,20a12)')"#    ",
 500      &   (ename(print_order(i)),i=1,nprint_ene),
 501      &   "ETOT total","RMSD","nat.contact","nnt.contact"
 502       else
 503         write (istat,'(a5,20a12)')"#    ",
 504      &    (ename(print_order(i)),i=1,nprint_ene),"ETOT total"
 505       endif
 506
 507       if (.not.minim) then
 508         do while (.not. eof)
 509           if (read_cart) then
 510             read (intin,'(e15.10,e15.5)',end=1100,err=1100) time,ene
 511             call read_x(intin,*11)
 512 #ifdef MPI
 513 c Broadcast the order to compute internal coordinates to the slaves.
 514             if (nfgtasks.gt.1)
 515      &        call MPI_Bcast(6,1,MPI_INTEGER,king,FG_COMM,IERROR)
 516 #endif
 517             call int_from_cart1(.false.)
 518           else
 519             read (intin,'(i5)',end=1100,err=1100) iconf
 520             call read_angles(intin,*11)
 521             call geom_to_var(nvar,varia)
 522             call chainbuild
 523           endif
 524           write (iout,'(a,i7)') 'Conformation #',iconf
 525           call etotal(energy(0))
 526           call briefout(iconf,energy(0))
 527           call enerprint(energy(0))
 528           etot=energy(0)
 529           if (refstr) then
 530             call rms_nac_nnc(rms,frac,frac_nn,co,.true.)
 531             write (istat,'(i5,20(f12.3))') iconf,
 532      &      (energy(print_order(i)),i=1,nprint_ene),etot,
 533      &       rms,frac,frac_nn,co
 534 cjlee end
 535           else
 536             write (istat,'(i5,16(f12.3))') iconf,
 537      &     (energy(print_order(i)),i=1,nprint_ene),etot
 538           endif
 539         enddo
 540 1100    continue
 541         goto 1101
 542       endif
 543
 544       mm=0
 545       imm=0
 546       nft=0
 547       ene0=0.0d0
 548       n=0
 549       iconf=0
 550 c      do n=1,nzsc
 551       do while (.not. eof)
 552         mm=mm+1
 553         if (mm.lt.nodes) then
 554           if (read_cart) then
 555             read (intin,'(e15.10,e15.5)',end=11,err=11) time,ene
 556             call read_x(intin,*11)
 557 #ifdef MPI
 558 c Broadcast the order to compute internal coordinates to the slaves.
 559             if (nfgtasks.gt.1)
 560      &        call MPI_Bcast(6,1,MPI_INTEGER,king,FG_COMM,IERROR)
 561 #endif
 562             call int_from_cart1(.false.)
 563           else
 564             read (intin,'(i5)',end=11,err=11) iconf
 565             call read_angles(intin,*11)
 566             call geom_to_var(nvar,varia)
 567             call chainbuild
 568           endif
 569           write (iout,'(a,i7)') 'Conformation #',iconf
 570           n=n+1
 571          imm=imm+1
 572          ind(1)=1
 573          ind(2)=n
 574          ind(3)=0
 575          ind(4)=0
 576          ind(5)=0
 577          ind(6)=0
 578          ene0=0.0d0
 579          call mpi_send(ind,6,mpi_integer,mm,idint,CG_COMM,
 580      *                  ierr)
 581          call mpi_send(varia,nvar,mpi_double_precision,mm,
 582      *                  idreal,CG_COMM,ierr)
 583          call mpi_send(ene0,1,mpi_double_precision,mm,
 584      *                  idreal,CG_COMM,ierr)
 585 c         print *,'task ',n,' sent to worker ',mm,nvar
 586         else
 587          call mpi_recv(ind,6,mpi_integer,mpi_any_source,idint,
 588      *                 CG_COMM,muster,ierr)
 589          man=muster(mpi_source)
 590 c         print *,'receiving result from worker ',man,' (',iii1,iii,')'
 591          call mpi_recv(varia,nvar,mpi_double_precision,
 592      *               man,idreal,CG_COMM,muster,ierr)
 593          call mpi_recv(ene,1,
 594      *               mpi_double_precision,man,idreal,
 595      *               CG_COMM,muster,ierr)
 596          call mpi_recv(ene0,1,
 597      *               mpi_double_precision,man,idreal,
 598      *               CG_COMM,muster,ierr)
 599 c         print *,'result received from worker ',man,' sending now'
 600
 601           call var_to_geom(nvar,varia)
 602           call chainbuild
 603           call etotal(energy(0))
 604           iconf=ind(2)
 605           write (iout,*)
 606           write (iout,*)
 607           write (iout,'(a,2i7)') 'Conformation #',iconf,ind(5)
 608
 609           etot=energy(0)
 610           call enerprint(energy(0))
 611           call briefout(it,etot)
 612 c          if (minim) call briefout(it,etot)
 613           if (refstr) then
 614             call rms_nac_nnc(rms,frac,frac_nn,co,.true.)
 615             write (istat,'(i5,19(f12.3))') iconf,
 616      &     (energy(print_order(i)),i=1,nprint_ene),etot,
 617      &     rms,frac,frac_nn,co
 618           else
 619             write (istat,'(i5,15(f12.3))') iconf,
 620      &     (energy(print_order(i)),i=1,nprint_ene),etot
 621           endif
 622
 623           imm=imm-1
 624           if (read_cart) then
 625             read (intin,'(e15.10,e15.5)',end=1101,err=1101) time,ene
 626             call read_x(intin,*11)
 627 #ifdef MPI
 628 c Broadcast the order to compute internal coordinates to the slaves.
 629             if (nfgtasks.gt.1)
 630      &        call MPI_Bcast(6,1,MPI_INTEGER,king,FG_COMM,IERROR)
 631 #endif
 632             call int_from_cart1(.false.)
 633           else
 634             read (intin,'(i5)',end=1101,err=1101) iconf
 635             call read_angles(intin,*11)
 636             call geom_to_var(nvar,varia)
 637             call chainbuild
 638           endif
 639           n=n+1
 640           imm=imm+1
 641           ind(1)=1
 642           ind(2)=n
 643           ind(3)=0
 644           ind(4)=0
 645           ind(5)=0
 646           ind(6)=0
 647           call mpi_send(ind,6,mpi_integer,man,idint,CG_COMM,
 648      *                  ierr)
 649           call mpi_send(varia,nvar,mpi_double_precision,man,
 650      *                  idreal,CG_COMM,ierr)
 651           call mpi_send(ene0,1,mpi_double_precision,man,
 652      *                  idreal,CG_COMM,ierr)
 653           nf_mcmf=nf_mcmf+ind(4)
 654           nmin=nmin+1
 655         endif
 656       enddo
 657 11    continue
 658       do j=1,imm
 659         call mpi_recv(ind,6,mpi_integer,mpi_any_source,idint,
 660      *               CG_COMM,muster,ierr)
 661         man=muster(mpi_source)
 662         call mpi_recv(varia,nvar,mpi_double_precision,
 663      *               man,idreal,CG_COMM,muster,ierr)
 664         call mpi_recv(ene,1,
 665      *               mpi_double_precision,man,idreal,
 666      *               CG_COMM,muster,ierr)
 667         call mpi_recv(ene0,1,
 668      *               mpi_double_precision,man,idreal,
 669      *               CG_COMM,muster,ierr)
 670
 671         call var_to_geom(nvar,varia)
 672         call chainbuild
 673         call etotal(energy(0))
 674         iconf=ind(2)
 675         write (iout,*)
 676         write (iout,*)
 677         write (iout,'(a,2i7)') 'Conformation #',iconf,ind(5)
 678
 679         etot=energy(0)
 680         call enerprint(energy(0))
 681         call briefout(it,etot)
 682         if (refstr) then
 683           call rms_nac_nnc(rms,frac,frac_nn,co,.true.)
 684           write (istat,'(i5,19(f12.3))') iconf,
 685      &   (energy(print_order(i)),i=1,nprint_ene),etot,
 686      &   rms,frac,frac_nn,co
 687         else
 688           write (istat,'(i5,15(f12.3))') iconf,
 689      &    (energy(print_order(i)),i=1,nprint_ene),etot
 690         endif
 691         nmin=nmin+1
 692       enddo
 693 1101  continue
 694       do i=1, nodes-1
 695          ind(1)=0
 696          ind(2)=0
 697          ind(3)=0
 698          ind(4)=0
 699          ind(5)=0
 700          ind(6)=0
 701          call mpi_send(ind,6,mpi_integer,i,idint,CG_COMM,
 702      *                  ierr)
 703       enddo
 704 #else
 705       close (intin)
 706       open(intin,file=intinname,status='old')
 707       write (istat,'(a5,20a12)')"#    ",
 708      &   (wname(print_order(i)),i=1,nprint_ene)
 709       write (istat,'("#    ",20(1pe12.4))')
 710      &   (weights(print_order(i)),i=1,nprint_ene)
 711       if (refstr) then
 712         write (istat,'(a5,20a12)')"#    ",
 713      &   (ename(print_order(i)),i=1,nprint_ene),
 714      &   "ETOT total","RMSD","nat.contact","nnt.contact"
 715       else
 716         write (istat,'(a5,14a12)')"#    ",
 717      &   (ename(print_order(i)),i=1,nprint_ene),"ETOT total"
 718       endif
 719       do while (.not. eof)
 720           if (read_cart) then
 721             read (intin,'(e15.10,e15.5)',end=11,err=11) time,ene
 722             call read_x(intin,*11)
 723 #ifdef MPI
 724 c Broadcast the order to compute internal coordinates to the slaves.
 725             if (nfgtasks.gt.1)
 726      &        call MPI_Bcast(6,1,MPI_INTEGER,king,FG_COMM,IERROR)
 727 #endif
 728             call int_from_cart1(.false.)
 729           else
 730             read (intin,'(i5)',end=11,err=11) iconf
 731             call read_angles(intin,*11)
 732             call geom_to_var(nvar,varia)
 733             call chainbuild
 734           endif
 735         write (iout,'(a,i7)') 'Conformation #',iconf
 736         if (minim) call minimize(etot,varia,iretcode,nfun)
 737         call etotal(energy(0))
 738
 739         etot=energy(0)
 740         call enerprint(energy(0))
 741         if (minim) call briefout(it,etot)
 742         if (refstr) then
 743           call rms_nac_nnc(rms,frac,frac_nn,co,.true.)
 744           write (istat,'(i5,18(f12.3))') iconf,
 745      &   (energy(print_order(i)),i=1,nprint_ene),
 746      &   etot,rms,frac,frac_nn,co
 747 cjlee end
 748         else
 749           write (istat,'(i5,14(f12.3))') iconf,
 750      &   (energy(print_order(i)),i=1,nprint_ene),etot
 751         endif
 752       enddo
 753    11 continue
 754 #endif
 755       return
 756       end
 757 c---------------------------------------------------------------------------
 758       subroutine exec_checkgrad
 759       implicit none
 760       include 'DIMENSIONS'
 761 #ifdef MPI
 762       include 'mpif.h'
 763 #endif
 764       include 'COMMON.SETUP'
 765       include 'COMMON.TIME1'
 766       include 'COMMON.INTERACT'
 767       include 'COMMON.NAMES'
 768       include 'COMMON.GEO'
 769       include 'COMMON.HEADER'
 770       include 'COMMON.CONTROL'
 771 c      include 'COMMON.CONTACTS'
 772       include 'COMMON.CHAIN'
 773       include 'COMMON.VAR'
 774       include 'COMMON.IOUNITS'
 775       include 'COMMON.FFIELD'
 776       include 'COMMON.REMD'
 777       include 'COMMON.MD'
 778       include 'COMMON.QRESTR'
 779       include 'COMMON.SBRIDGE'
 780       integer icall
 781       common /srutu/ icall
 782       double precision energy(0:max_ene)
 783 c      print *,"A TU?"
 784 c      do i=2,nres
 785 c        vbld(i)=vbld(i)+ran_number(-0.1d0,0.1d0)
 786 c        if (itype(i).ne.10)
 787 c     &      vbld(i+nres)=vbld(i+nres)+ran_number(-0.001d0,0.001d0)
 788 c      enddo
 789       if (indpdb.eq.0) call chainbuild
 790 c      do i=0,nres
 791 c        do j=1,3
 792 c          dc(j,i)=dc(j,i)+ran_number(-0.2d0,0.2d0)
 793 c        enddo
 794 c      enddo
 795 c      do i=1,nres-1
 796 c        if (itype(i).ne.10) then
 797 c          do j=1,3
 798 c            dc(j,i+nres)=dc(j,i+nres)+ran_number(-0.2d0,0.2d0)
 799 c          enddo
 800 c        endif
 801 c      enddo
 802 c      do j=1,3
 803 c        dc(j,0)=ran_number(-0.2d0,0.2d0)
 804 c      enddo
 805 #ifdef UMB
 806       usampl=.true.
 807       scale_umb=.false.
 808 #ifdef PMF
 809       adaptive=.true.
 810 #endif
 811       totT=1.d0
 812       eq_time=0.0d0
 813       call read_fragments
 814       iset=1
 815       nperm=1
 816       print *, "AFTER read fragments"
 817            write (iout,*) "iset",iset
 818            if (loc_qlike) then
 819            write(iout,*) "fragment, weights, q0:"
 820            do i=1,nfrag_back
 821             write(iout,'(2i5,3(f8.1,f8.2))') ifrag_back(1,i,iset),
 822      &         ifrag_back(2,i,iset),
 823      &         wfrag_back(1,i,iset),qin_back(1,i,iset),
 824      &         wfrag_back(2,i,iset),qin_back(2,i,iset),
 825      &         wfrag_back(3,i,iset),qin_back(3,i,iset)
 826            enddo
 827            else
 828            write(iout,*) "fragment, weights:"
 829            do i=1,nfrag_back
 830             write(iout,'(2i5,3f8.1)') ifrag_back(1,i,iset),
 831      &         ifrag_back(2,i,iset),wfrag_back(1,i,iset),
 832      &         wfrag_back(2,i,iset),wfrag_back(3,i,iset)
 833            enddo
 834            endif
 835 #ifdef PMF
 836       call read_REMDpar
 837       call PMFread
 838 #endif
 839       call rescale_weights(t_bath)
 840       call chainbuild_cart
 841       print *,"chainbuild_cart"
 842       call cartprint
 843       print *,"After cartprint"
 844       call intout
 845       icall=1
 846       print *,"before ETOT"
 847       write (iout,*) "usampl",usampl
 848       call etotal(energy(0))
 849       etot = energy(0)
 850       call enerprint(energy(0))
 851       write (iout,*) "Uconst",Uconst," Uconst_back",uconst_back
 852       print *,'icheckgrad=',icheckgrad
 853 #endif
 854       goto (10,20,30) icheckgrad
 855   10  call check_ecartint
 856       return
 857   20  write (iout,*)
 858      & "Checking the gradient of Cartesian coordinates disabled."
 859       return
 860   30  call check_eint
 861       return
 862       end
 863 c---------------------------------------------------------------------------
 864       subroutine exec_map
 865 C Energy maps
 866       call map_read
 867       call map
 868       return
 869       end
 870 c---------------------------------------------------------------------------
 871       subroutine exec_CSA
 872       implicit none
 873 #ifdef MPI
 874       include "mpif.h"
 875 #endif
 876       include 'DIMENSIONS'
 877       include 'COMMON.IOUNITS'
 878 C Conformational Space Annealling programmed by Jooyoung Lee.
 879 C This method works only with parallel machines!
 880 #ifdef MPI
 881       call together
 882 #else
 883       write (iout,*) "CSA works on parallel machines only"
 884 #endif
 885       return
 886       end
 887 c---------------------------------------------------------------------------
 888       subroutine exec_softreg
 889       implicit none
 890       include 'DIMENSIONS'
 891       include 'COMMON.IOUNITS'
 892       include 'COMMON.CONTROL'
 893       double precision energy(0:max_ene),etot
 894       double precision rms,frac,frac_nn,co
 895       call chainbuild
 896       call etotal(energy(0))
 897       call enerprint(energy(0))
 898       if (.not.lsecondary) then
 899         write(iout,*) 'Calling secondary structure recognition'
 900         call secondary2(.true.)
 901       else
 902         write(iout,*) 'Using secondary structure supplied in pdb'
 903       endif
 904
 905       call softreg
 906
 907       call etotal(energy(0))
 908       etot=energy(0)
 909       call enerprint(energy(0))
 910       call intout
 911       call briefout(0,etot)
 912       call secondary2(.true.)
 913       if (refstr) call rms_nac_nnc(rms,frac,frac_nn,co,.true.)
 914       return
 915       end