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       write (iout,*) "After readrtns"
  63       call flush(iout)
  64       call cartprint
  65       call intout
  66       if (me.eq.king .or. .not. out1file) then
  67        write (iout,'(/2a/)')
  68      & text_mode_calc(modecalc)(:ilen(text_mode_calc(modecalc))),
  69      & ' calculation.'
  70        if (minim) write (iout,'(a)')
  71      &  'Conformations will be energy-minimized.'
  72        write (iout,'(80(1h*)/)')
  73       endif
  74       call flush(iout)
  75 C
  76       if (modecalc.eq.-2) then
  77 c        call test
  78 c        stop
  79       else if (modecalc.eq.-1) then
  80         write(iout,*) "call check_sc_map next"
  81         call check_bond
  82         stop
  83       endif
  84 #ifdef MPI
  85       if (fg_rank.gt.0) then
  86 C Fine-grain slaves just do energy and gradient components.
  87         call ergastulum ! slave workhouse in Latin
  88       else
  89 #endif
  90       if (indpdb.eq.0 .and. .not.read_cart) call chainbuild
  91       if (indpdb.ne.0 .or. read_cart) then
  92         dc(1,0)=c(1,1)
  93         dc(2,0)=c(2,1)
  94         dc(3,0)=c(3,1)
  95       endif
  96       if (modecalc.eq.0) then
  97         write (iout,*) "Calling exec_eeval_or_minim"
  98         call exec_eeval_or_minim
  99       else if (modecalc.eq.1) then
 100         call exec_regularize
 101       else if (modecalc.eq.2) then
 102         call exec_thread
 103       else if (modecalc.eq.3 .or. modecalc .eq.6) then
 104         call exec_MC
 105       else if (modecalc.eq.4) then
 106         call exec_mult_eeval_or_minim
 107       else if (modecalc.eq.5) then
 108         call exec_checkgrad
 109       else if (ModeCalc.eq.7) then
 110         call exec_map
 111       else if (ModeCalc.eq.8) then
 112         call exec_CSA
 113       else if (modecalc.eq.11) then
 114         call exec_softreg
 115       else if (modecalc.eq.12) then
 116         call exec_MD
 117       else if (modecalc.eq.14) then
 118 #ifdef MPI
 119         call exec_MREMD
 120 #else
 121         write (iout,*) "Need a parallel version to run MREMD."
 122         stop
 123 #endif
 124       else
 125         write (iout,'(a)') 'This calculation type is not supported',
 126      &   ModeCalc
 127       endif
 128 #ifdef MPI
 129       endif
 130 C Finish task.
 131       if (fg_rank.eq.0) call finish_task
 132 c      call memmon_print_usage()
 133 #ifdef TIMING
 134        call print_detailed_timing
 135 #endif
 136       call MPI_Finalize(ierr)
 137       stop 'Bye Bye...'
 138 #else
 139       call dajczas(tcpu(),hrtime,mintime,sectime)
 140       stop '********** Program terminated normally.'
 141 #endif
 142       end
 143 c--------------------------------------------------------------------------
 144       subroutine exec_MD
 145       implicit none
 146       include 'DIMENSIONS'
 147 #ifdef MPI
 148       include "mpif.h"
 149 #endif
 150       include 'COMMON.SETUP'
 151       include 'COMMON.CONTROL'
 152       include 'COMMON.IOUNITS'
 153 c      if (me.eq.king .or. .not. out1file) then
 154 c        write (iout,*) "Calling chainbuild"
 155 c        call flush(iout)
 156 c      endif
 157       call chainbuild
 158 c      if (me.eq.king .or. .not. out1file) then
 159 c        write (iout,*) "Calling MD"
 160 c        call flush(iout)
 161 c      endif
 162       call MD
 163       return
 164       end
 165 c---------------------------------------------------------------------------
 166 #ifdef MPI
 167       subroutine exec_MREMD
 168       implicit none
 169       include 'DIMENSIONS'
 170 #ifdef MPI
 171       include "mpif.h"
 172 #endif
 173       include 'COMMON.SETUP'
 174       include 'COMMON.CONTROL'
 175       include 'COMMON.IOUNITS'
 176       include 'COMMON.REMD'
 177       integer i
 178       if (me.eq.king .or. .not. out1file)
 179      &   write (iout,*) "Calling chainbuild"
 180       call chainbuild
 181       if (me.eq.king .or. .not. out1file)
 182      &   write (iout,*) "Calling REMD"
 183       if (remd_mlist) then
 184         call MREMD
 185       else
 186         do i=1,nrep
 187           remd_m(i)=1
 188         enddo
 189         call MREMD
 190       endif
 191       return
 192       end
 193 #endif
 194 c---------------------------------------------------------------------------
 195       subroutine exec_eeval_or_minim
 196       implicit none
 197       include 'DIMENSIONS'
 198 #ifdef MPI
 199       include 'mpif.h'
 200 #endif
 201       include 'COMMON.SETUP'
 202       include 'COMMON.TIME1'
 203       include 'COMMON.INTERACT'
 204       include 'COMMON.NAMES'
 205       include 'COMMON.GEO'
 206       include 'COMMON.HEADER'
 207       include 'COMMON.CONTROL'
 208 c      include 'COMMON.CONTACTS'
 209       include 'COMMON.CHAIN'
 210       include 'COMMON.VAR'
 211       include 'COMMON.IOUNITS'
 212       include 'COMMON.FFIELD'
 213       include 'COMMON.REMD'
 214       include 'COMMON.MD'
 215       include 'COMMON.SBRIDGE'
 216       integer i,icall,iretcode,nfun
 217       common /srutu/ icall
 218       integer nharp,iharp(4,maxres/3)
 219       integer nft_sc
 220       logical fail
 221       double precision energy(0:n_ene),etot,etota
 222       double precision energy_long(0:n_ene),energy_short(0:n_ene)
 223       double precision rms,frac,frac_nn,co
 224       double precision varia(maxvar)
 225       double precision time00,time1,time_ene,evals
 226 #ifdef LBFGS
 227       character*9 status
 228       integer niter
 229       common /lbfgstat/ status,niter,nfun
 230 #endif
 231       integer ilen
 232       if (indpdb.eq.0 .and. .not.read_cart) call chainbuild
 233       if (indpdb.ne.0 .or. read_cart) then
 234       dc(1,0)=c(1,1)
 235       dc(2,0)=c(2,1)
 236       dc(3,0)=c(3,1)
 237       endif
 238 #ifdef MPI
 239       time00=MPI_Wtime()
 240 #else
 241       time00=tcpu()
 242 #endif
 243       write (iout,*) "Energy evaluation/minimization"
 244       call chainbuild_cart
 245 c      print *,'dc',dc(1,0),dc(2,0),dc(3,0)
 246       if (split_ene) then
 247        print *,"Processor",myrank," after chainbuild"
 248        icall=1
 249        call etotal_long(energy_long(0))
 250        write (iout,*) "Printing long range energy"
 251        call enerprint(energy_long(0))
 252        call etotal_short(energy_short(0))
 253        write (iout,*) "Printing short range energy"
 254        call enerprint(energy_short(0))
 255        do i=0,n_ene
 256          energy(i)=energy_long(i)+energy_short(i)
 257 c         write (iout,*) i,energy_long(i),energy_short(i),energy(i)
 258        enddo
 259        write (iout,*) "Printing long+short range energy"
 260        call enerprint(energy(0))
 261       endif
 262 c      write(iout,*)"before etotal"
 263 c      call flush(iout)
 264       call etotal(energy(0))
 265 c      write(iout,*)"after etotal"
 266 c      call flush(iout)
 267 #ifdef MPI
 268       time_ene=MPI_Wtime()-time00
 269 #else
 270       time_ene=tcpu()-time00
 271 #endif
 272       write (iout,*) "Time for energy evaluation",time_ene
 273 c      print *,"after etotal"
 274       etota = energy(0)
 275       etot =etota
 276       call enerprint(energy(0))
 277       call hairpin(.true.,nharp,iharp)
 278 c        print *,'after hairpin'
 279       call secondary2(.true.)
 280 c        print *,'after secondary'
 281       if (minim) then
 282 crc overlap test
 283         if (indpdb.ne.0 .and. .not.dccart) then
 284           call bond_regular
 285           call chainbuild_extconf
 286           call etotal(energy(0))
 287           write (iout,*) "After bond regularization"
 288           call enerprint(energy(0))
 289         endif
 290
 291         if (overlapsc) then
 292           write (iout,*) 'Calling OVERLAP_SC'
 293           call overlap_sc(fail)
 294           write (iout,*) "After overlap_sc"
 295         endif
 296
 297         if (searchsc) then
 298           call sc_move(2,nres-1,10,1d10,nft_sc,etot)
 299           print *,'SC_move',nft_sc,etot
 300           write(iout,*) 'SC_move',nft_sc,etot
 301         endif
 302
 303         if (dccart) then
 304           print *, 'Calling MINIM_DC'
 305 #ifdef MPI
 306           time1=MPI_WTIME()
 307 #else
 308           time1=tcpu()
 309 #endif
 310           call minim_dc(etot,iretcode,nfun)
 311         else
 312           call geom_to_var(nvar,varia)
 313 c          print *,'Calling MINIMIZE.'
 314 #ifdef MPI
 315           time1=MPI_WTIME()
 316 #else
 317           time1=tcpu()
 318 #endif
 319           call minimize(etot,varia,iretcode,nfun)
 320         endif
 321 #ifdef LBFGS
 322         print *,'LBFGS return code is',status,' eval ',nfun
 323 #else
 324         print *,'SUMSL return code is',iretcode,' eval ',nfun
 325 #endif
 326 #ifdef MPI
 327         evals=nfun/(MPI_WTIME()-time1)
 328 #else
 329         evals=nfun/(tcpu()-time1)
 330 #endif
 331         print *,'# eval/s',evals
 332         print *,'refstr=',refstr
 333         call hairpin(.false.,nharp,iharp)
 334         print *,'after hairpin'
 335         call secondary2(.true.)
 336         print *,'after secondary'
 337         call etotal(energy(0))
 338         etot = energy(0)
 339         call enerprint(energy(0))
 340         call intout
 341 #ifdef LBFGS
 342           write (iout,'(a,a9)') 'LBFGS return code:',status
 343           write (iout,'(a,i20)') '# of energy evaluations:',nfun+1
 344           write (iout,'(a,f16.3)')'# of energy evaluations/sec:',evals
 345 #else
 346           write (iout,'(a,i3)') 'SUMSL return code:',iretcode
 347           write (iout,'(a,i20)') '# of energy evaluations:',nfun+1
 348           write (iout,'(a,f16.3)')'# of energy evaluations/sec:',evals
 349 #endif
 350       endif
 351       if (refstr) call rms_nac_nnc(rms,frac,frac_nn,co,.true.)
 352       if (out_int) call briefout(0,etot)
 353       if (out_cart) then
 354         cartname=prefix(:ilen(prefix))//'.x'
 355         potE=etot
 356         call cartoutx(0.0d0)
 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