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