source/maxlik/src-Fmatch/initialize_p.F

   1       subroutine initialize
   2 C
   3 C Define constants and zero out tables.
   4 C
   5       implicit real*8 (a-h,o-z)
   6       include 'DIMENSIONS'
   7       include 'DIMENSIONS.ZSCOPT'
   8 #ifdef MPI
   9       include 'mpif.h'
  10       include "COMMON.MPI"
  11       integer ierror
  12 #endif
  13       include 'COMMON.IOUNITS'
  14       include 'COMMON.CHAIN'
  15       include 'COMMON.INTERACT'
  16       include 'COMMON.GEO'
  17       include 'COMMON.LOCAL'
  18       include 'COMMON.TORSION'
  19       include 'COMMON.FFIELD'
  20       include 'COMMON.SBRIDGE'
  21       include 'COMMON.MINIM'
  22       include 'COMMON.DERIV'
  23       include "COMMON.WEIGHTS"
  24       include "COMMON.NAMES"
  25       include "COMMON.TIME1"
  26       include "COMMON.THERMAL"
  27       include "COMMON.TORCNSTR"
  28       include "COMMON.ENERGIES"
  29 C
  30 C The following is just to define auxiliary variables used in angle conversion
  31 C
  32       pi=4.0D0*datan(1.0D0)
  33       dwapi=2.0D0*pi
  34       dwapi3=dwapi/3.0D0
  35       pipol=0.5D0*pi
  36       deg2rad=pi/180.0D0
  37       rad2deg=1.0D0/deg2rad
  38       angmin=10.0D0*deg2rad
  39       Rgas = 1.987D-3
  40       eps_out = 80.0d0
  41 C
  42 C Define I/O units.
  43 C
  44       inp=    1
  45       iout=   2
  46       ipdbin= 3
  47       ipdb=   7
  48       imol2=  4
  49       igeom=  8
  50       intin=  9
  51       ithep= 11
  52       irotam=12
  53       itorp= 13
  54       itordp= 23
  55       ielep= 14
  56       isidep=15
  57       isidep1=22
  58       iscpp=25
  59       icbase=16
  60       ifourier=20
  61       istat= 17
  62       ientin=18
  63       ientout=19
  64       ibond=28
  65       isccor=29
  66 C
  67 C CSA I/O units (separated from others especially for Jooyoung)
  68 C
  69       icsa_rbank=30
  70       icsa_seed=31
  71       icsa_history=32
  72       icsa_bank=33
  73       icsa_bank1=34
  74       icsa_alpha=35
  75       icsa_alpha1=36
  76       icsa_bankt=37
  77       icsa_int=39
  78       icsa_bank_reminimized=38
  79       icsa_native_int=41
  80       icsa_in=40
  81 C
  82 C Set default weights of the energy terms.
  83 C
  84       wlong=1.0D0
  85       welec=1.0D0
  86       wtor =1.0D0
  87       wang =1.0D0
  88       wscloc=1.0D0
  89       wstrain=1.0D0
  90 C
  91 C Zero out tables.
  92 C
  93       ndih_constr=0
  94       do i=1,maxres2
  95         do j=1,3
  96           c(j,i)=0.0D0
  97           dc(j,i)=0.0D0
  98         enddo
  99       enddo
 100       do i=1,maxres
 101         do j=1,3
 102           xloc(j,i)=0.0D0
 103         enddo
 104       enddo
 105       do i=1,ntyp
 106         do j=1,ntyp
 107           aa(i,j)=0.0D0
 108           bb(i,j)=0.0D0
 109           augm(i,j)=0.0D0
 110           sigma(i,j)=0.0D0
 111           r0(i,j)=0.0D0
 112           chi(i,j)=0.0D0
 113         enddo
 114         do j=1,2
 115           bad(i,j)=0.0D0
 116         enddo
 117         chip(i)=0.0D0
 118         alp(i)=0.0D0
 119         sigma0(i)=0.0D0
 120         sigii(i)=0.0D0
 121         rr0(i)=0.0D0
 122         a0thet(i)=0.0D0
 123         do j=1,2
 124          do ichir1=-1,1
 125           do ichir2=-1,1
 126           athet(j,i,ichir1,ichir2)=0.0D0
 127           bthet(j,i,ichir1,ichir2)=0.0D0
 128           enddo
 129          enddo
 130         enddo
 131         do j=0,3
 132           polthet(j,i)=0.0D0
 133         enddo
 134         do j=1,3
 135           gthet(j,i)=0.0D0
 136         enddo
 137         theta0(i)=0.0D0
 138         sig0(i)=0.0D0
 139         sigc0(i)=0.0D0
 140         do j=1,maxlob
 141           bsc(j,i)=0.0D0
 142           do k=1,3
 143             censc(k,j,i)=0.0D0
 144           enddo
 145           do k=1,3
 146             do l=1,3
 147               gaussc(l,k,j,i)=0.0D0
 148             enddo
 149           enddo
 150           nlob(i)=0
 151         enddo
 152       enddo
 153       nlob(ntyp1)=0
 154       dsc(ntyp1)=0.0D0
 155       do iblock=1,2
 156       do i=1,maxtor
 157         itortyp(i)=0
 158         do j=1,maxtor
 159           do k=1,maxterm
 160             v1(k,j,i,iblock)=0.0D0
 161             v2(k,j,i,iblock)=0.0D0
 162           enddo
 163         enddo
 164       enddo
 165       enddo
 166       do i=1,maxres
 167         itype(i)=0
 168         itel(i)=0
 169       enddo
 170 C Initialize the bridge arrays
 171       ns=0
 172       nss=0
 173       nhpb=0
 174       do i=1,maxss
 175         iss(i)=0
 176       enddo
 177       do i=1,maxdim
 178         dhpb(i)=0.0D0
 179       enddo
 180       do i=1,maxres
 181         ihpb(i)=0
 182         jhpb(i)=0
 183       enddo
 184 C
 185 C Initialize timing.
 186 C
 187       call set_timers
 188 C
 189 C Initialize variables used in minimization.
 190 C
 191 c     maxfun=5000
 192 c     maxit=2000
 193       maxfun=500
 194       maxit=200
 195       tolf=1.0D-2
 196       rtolf=5.0D-4
 197 C
 198 C Initialize the variables responsible for the mode of gradient storage.
 199 C
 200       nfl=0
 201       icg=1
 202       do i=1,14
 203         do j=1,14
 204           if (print_order(i).eq.j) then
 205             iw(print_order(i))=j
 206             goto 1121
 207           endif
 208         enddo
 209 1121    continue
 210       enddo
 211       calc_grad=.false.
 212 C Set timers and counters for the respective routines
 213       t_func = 0.0d0
 214       t_grad = 0.0d0
 215       t_fhel = 0.0d0
 216       t_fbet = 0.0d0
 217       t_ghel = 0.0d0
 218       t_gbet = 0.0d0
 219       t_viol = 0.0d0
 220       t_gviol = 0.0d0
 221       n_func = 0
 222       n_grad = 0
 223       n_fhel = 0
 224       n_fbet = 0
 225       n_ghel = 0
 226       n_gbet = 0
 227       n_viol = 0
 228       n_gviol = 0
 229       n_map = 0
 230 #ifndef SPLITELE
 231       nprint_ene=nprint_ene-1
 232 #endif
 233       enetb=0.0d0
 234       nfgtasks=1
 235 #ifdef MPI
 236 c      write (iout,*) "maxres6",maxres6
 237 c      write (iout,*) "Calling MPI_Type_contiguous"
 238 c      call flush(iout)
 239       call MPI_Type_contiguous(maxres6,MPI_DOUBLE_PRECISION,MPI_FORCE,
 240      &  IERROR)
 241       call MPI_Type_commit(MPI_FORCE,ierror)
 242 c      write (iout,*) "After MPI_Type_contiguous ierror",ierror
 243 #endif
 244       return
 245       end
 246 c-------------------------------------------------------------------------
 247       block data nazwy
 248       implicit real*8 (a-h,o-z)
 249       include 'DIMENSIONS'
 250       include 'DIMENSIONS.ZSCOPT'
 251       include 'COMMON.NAMES'
 252       include 'COMMON.WEIGHTS'
 253       include 'COMMON.FFIELD'
 254       data restyp /
 255      &'DD','DAU','DAI','DDB','DSM','DPR','DLY','DAR','DHI','DAS','DGL',
 256      & 'DSG','DGN','DSN','DTH',
 257      &'DYY','DAL','DTY','DTR','DVA','DLE','DIL','DPN','MED','DCY','ZER',
 258      &'CYS','MET','PHE','ILE','LEU','VAL','TRP','TYR','ALA','GLY','THR',
 259      &'SER','GLN','ASN','GLU','ASP','HIS','ARG','LYS','PRO','SME','DBZ',
 260      &'AIB','ABU','D'/
 261       data onelet /
 262      &'z','z','z','z','z','p','k','r','h','d','e','n','q','s','t','g',
 263      &'a','y','w','v','l','i','f','m','c','x',
 264      &'C','M','F','I','L','V','W','Y','A','G','T',
 265      &'S','Q','N','E','D','H','R','K','P','z','z','z','z','X'/
 266       data potname /'LJ','LJK','BP','GB','GBV','MM'/
 267       data ename /
 268      &   "EVDW SC-SC","EVDW2 SC-p","EES p-p","ECORR4 ","ECORR5 ",
 269      &   "ECORR6 ","EELLO ","ETURN3 ","ETURN4 ","ETURN6 ",
 270      &   "EBE bend","ESC SCloc","ETORS ","ETORSD ","EHPB","EVDWPP",
 271      &   "ESTR","EVDW2_14","ESCCOR","EDIHC","EVDW_T","ELIPTRAN",
 272      &   "EAFM","ETHETC","EMPTY"/
 273       data wname /
 274      &   "WSC","WSCP","WELEC","WCORR","WCORR5","WCORR6","WEL_LOC",
 275      &   "WTURN3","WTURN4","WTURN6","WANG","WSCLOC","WTOR","WTORD",
 276      &   "WHPB","WVDWPP","WBOND","WSCP14","WSCCOR","WDIHC","WSC_T",
 277      &   "WLIPTRAN","WAFM","WTHETC","WSHIELD"/
 278       data ww0 /1.0d0,1.0d0,1.0d0,1.0d0,1.0d0,1.0d0,1.0d0,1.0d0,1.0d0,
 279      &    1.0d0,1.0d0,1.0d0,1.0d0,1.0d0,1.0d0,1.0d0,1.0d0,0.0d0,1.0d0,
 280      &    0.0d0,0.0,0.0d0,0.0d0,0.0d0,0.0d0/
 281       data nprint_ene /25/
 282       data print_order /1,2,3,17,11,12,13,14,4,5,6,7,8,9,10,19,16,15,18,
 283      &  20,21,22,23,24,25/
 284       end
 285 c---------------------------------------------------------------------------
 286       subroutine init_int_table
 287       implicit real*8 (a-h,o-z)
 288       include 'DIMENSIONS'
 289       include 'DIMENSIONS.ZSCOPT'
 290 #ifdef MPI
 291       include 'mpif.h'
 292 #endif
 293 #ifdef MP
 294       include 'COMMON.INFO'
 295 #endif
 296       include 'COMMON.CHAIN'
 297       include 'COMMON.INTERACT'
 298       include 'COMMON.LOCAL'
 299       include 'COMMON.SBRIDGE'
 300       include 'COMMON.IOUNITS'
 301       logical scheck,lprint
 302       lprint=.false.
 303       do i=1,maxres
 304         nint_gr(i)=0
 305         nscp_gr(i)=0
 306         do j=1,maxint_gr
 307           istart(i,1)=0
 308           iend(i,1)=0
 309           ielstart(i)=0
 310           ielend(i)=0
 311           iscpstart(i,1)=0
 312           iscpend(i,1)=0
 313         enddo
 314       enddo
 315       ind_scint=0
 316       ind_scint_old=0
 317 cd    write (iout,*) 'ns=',ns,' nss=',nss,' ihpb,jhpb',
 318 cd   &   (ihpb(i),jhpb(i),i=1,nss)
 319       do i=nnt,nct-1
 320         scheck=.false.
 321         do ii=1,nss
 322           if (ihpb(ii).eq.i+nres) then
 323             scheck=.true.
 324             jj=jhpb(ii)-nres
 325             goto 10
 326           endif
 327         enddo
 328    10   continue
 329 cd      write (iout,*) 'i=',i,' scheck=',scheck,' jj=',jj
 330         if (scheck) then
 331           if (jj.eq.i+1) then
 332             nint_gr(i)=1
 333             istart(i,1)=i+2
 334             iend(i,1)=nct
 335           else if (jj.eq.nct) then
 336             nint_gr(i)=1
 337             istart(i,1)=i+1
 338             iend(i,1)=nct-1
 339           else
 340             nint_gr(i)=2
 341             istart(i,1)=i+1
 342             iend(i,1)=jj-1
 343             istart(i,2)=jj+1
 344             iend(i,2)=nct
 345           endif
 346         else
 347           nint_gr(i)=1
 348           istart(i,1)=i+1
 349           iend(i,1)=nct
 350           ind_scint=int_scint+nct-i
 351         endif
 352       enddo
 353    12 continue
 354       iatsc_s=nnt
 355       iatsc_e=nct-1
 356       if (lprint) then
 357       write (iout,'(a)') 'Interaction array:'
 358       do i=iatsc_s,iatsc_e
 359         write (iout,'(i3,2(2x,2i3))')
 360      & i,(istart(i,iint),iend(i,iint),iint=1,nint_gr(i))
 361       enddo
 362       endif
 363       ispp=2
 364       iatel_s=nnt
 365       iatel_e=nct-3
 366       do i=iatel_s,iatel_e
 367         ielstart(i)=i+4
 368         ielend(i)=nct-1
 369       enddo
 370       if (lprint) then
 371         write (iout,'(a)') 'Electrostatic interaction array:'
 372         do i=iatel_s,iatel_e
 373           write (iout,'(i3,2(2x,2i3))') i,ielstart(i),ielend(i)
 374         enddo
 375       endif ! lprint
 376 c     iscp=3
 377       iscp=2
 378 C Partition the SC-p interaction array
 379       iatscp_s=nnt
 380       iatscp_e=nct-1
 381       do i=nnt,nct-1
 382         if (i.lt.nnt+iscp) then
 383           nscp_gr(i)=1
 384           iscpstart(i,1)=i+iscp
 385           iscpend(i,1)=nct
 386         elseif (i.gt.nct-iscp) then
 387           nscp_gr(i)=1
 388           iscpstart(i,1)=nnt
 389           iscpend(i,1)=i-iscp
 390         else
 391           nscp_gr(i)=2
 392           iscpstart(i,1)=nnt
 393           iscpend(i,1)=i-iscp
 394           iscpstart(i,2)=i+iscp
 395           iscpend(i,2)=nct
 396         endif
 397       enddo ! i
 398       if (lprint) then
 399         write (iout,'(a)') 'SC-p interaction array:'
 400         do i=iatscp_s,iatscp_e
 401           write (iout,'(i3,2(2x,2i3))')
 402      &         i,(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
 403         enddo
 404       endif ! lprint
 405 C Partition local interactions
 406       loc_start=2
 407       loc_end=nres-1
 408       ithet_start=3
 409       ithet_end=nres
 410       iturn3_start=nnt
 411       iturn3_end=nct-3
 412       iturn4_start=nnt
 413       iturn4_end=nct-4
 414       iphi_start=nnt+3
 415       iphi_end=nct
 416       idihconstr_start=1
 417       idihconstr_end=ndih_constr
 418       ithetaconstr_start=1
 419       ithetaconstr_end=ntheta_constr
 420       itau_start=4
 421       itau_end=nres
 422       return
 423       end
 424 c---------------------------------------------------------------------------
 425       subroutine int_partition(int_index,lower_index,upper_index,atom,
 426      & at_start,at_end,first_atom,last_atom,int_gr,jat_start,jat_end,*)
 427       implicit real*8 (a-h,o-z)
 428       include 'DIMENSIONS'
 429       include 'DIMENSIONS.ZSCOPT'
 430       include 'COMMON.IOUNITS'
 431       integer int_index,lower_index,upper_index,atom,at_start,at_end,
 432      & first_atom,last_atom,int_gr,jat_start,jat_end
 433       logical lprn
 434       lprn=.false.
 435       if (lprn) write (iout,*) 'int_index=',int_index
 436       int_index_old=int_index
 437       int_index=int_index+last_atom-first_atom+1
 438       if (lprn)
 439      &   write (iout,*) 'int_index=',int_index,
 440      &               ' int_index_old',int_index_old,
 441      &               ' lower_index=',lower_index,
 442      &               ' upper_index=',upper_index,
 443      &               ' atom=',atom,' first_atom=',first_atom,
 444      &               ' last_atom=',last_atom
 445       if (int_index.ge.lower_index) then
 446         int_gr=int_gr+1
 447         if (at_start.eq.0) then
 448           at_start=atom
 449           jat_start=first_atom-1+lower_index-int_index_old
 450         else
 451           jat_start=first_atom
 452         endif
 453         if (lprn) write (iout,*) 'jat_start',jat_start
 454         if (int_index.ge.upper_index) then
 455           at_end=atom
 456           jat_end=first_atom-1+upper_index-int_index_old
 457           return1
 458         else
 459           jat_end=last_atom
 460         endif
 461         if (lprn) write (iout,*) 'jat_end',jat_end
 462       endif
 463       return
 464       end
 465 c------------------------------------------------------------------------------
 466       subroutine hpb_partition
 467       implicit real*8 (a-h,o-z)
 468       include 'DIMENSIONS'
 469       include 'DIMENSIONS.ZSCOPT'
 470       include 'COMMON.SBRIDGE'
 471       include 'COMMON.IOUNITS'
 472       link_start=1
 473       link_end=nhpb
 474 cd    write (iout,*) 'Processor',MyID,' MyRank',MyRank,
 475 cd   &  ' nhpb',nhpb,' link_start=',link_start,
 476 cd   &  ' link_end',link_end
 477       return
 478       end