source/unres/src_MD-M-SAXS-homology/unres.F

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