source/cluster/wham/src-M-SAXS.safe/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 'sizesclu.dat'
   8       include 'COMMON.IOUNITS'
   9       include 'COMMON.CHAIN'
  10       include 'COMMON.INTERACT'
  11       include 'COMMON.GEO'
  12       include 'COMMON.LOCAL'
  13       include 'COMMON.TORSION'
  14       include 'COMMON.FFIELD'
  15       include 'COMMON.SBRIDGE'
  16       include 'COMMON.MINIM'
  17       include 'COMMON.DERIV'
  18       include "COMMON.NAMES"
  19       include "COMMON.TIME1"
  20 C
  21 C The following is just to define auxiliary variables used in angle conversion
  22 C
  23       pi=4.0D0*datan(1.0D0)
  24       dwapi=2.0D0*pi
  25       dwapi3=dwapi/3.0D0
  26       pipol=0.5D0*pi
  27       deg2rad=pi/180.0D0
  28       rad2deg=1.0D0/deg2rad
  29       angmin=10.0D0*deg2rad
  30       Rgas = 1.987D-3
  31 C
  32 C Define I/O units.
  33 C
  34       inp=    1
  35       iout=   2
  36       ipdbin= 3
  37       ipdb=   7
  38       imol2= 18
  39       jplot= 19
  40       jstatin=10
  41       imol2=  4
  42       igeom=  8
  43       intin=  9
  44       ithep= 11
  45       irotam=12
  46       itorp= 13
  47       itordp= 23
  48       ielep= 14
  49       isidep=15
  50       isidep1=22
  51       iscpp=25
  52       icbase=16
  53       ifourier=20
  54       istat= 17
  55       ibond=28
  56       isccor=29
  57       jrms=30
  58       iliptran=60
  59 C
  60 C Set default weights of the energy terms.
  61 C
  62       wlong=1.0D0
  63       welec=1.0D0
  64       wtor =1.0D0
  65       wang =1.0D0
  66       wscloc=1.0D0
  67       wstrain=1.0D0
  68 C
  69 C Zero out tables.
  70 C
  71       ndih_constr=0
  72       do i=1,maxres2
  73         do j=1,3
  74           c(j,i)=0.0D0
  75           dc(j,i)=0.0D0
  76         enddo
  77       enddo
  78       do i=1,maxres
  79         do j=1,3
  80           xloc(j,i)=0.0D0
  81         enddo
  82       enddo
  83       do i=1,ntyp
  84         do j=1,ntyp
  85           aa_aq(i,j)=0.0D0
  86           bb_aq(i,j)=0.0D0
  87           aa_lip(i,j)=0.0D0
  88           bb_lip(i,j)=0.0D0
  89           augm(i,j)=0.0D0
  90           sigma(i,j)=0.0D0
  91           r0(i,j)=0.0D0
  92           chi(i,j)=0.0D0
  93         enddo
  94         do j=1,2
  95           bad(i,j)=0.0D0
  96         enddo
  97         chip(i)=0.0D0
  98         alp(i)=0.0D0
  99         sigma0(i)=0.0D0
 100         sigii(i)=0.0D0
 101         rr0(i)=0.0D0
 102         a0thet(i)=0.0D0
 103         do j=1,2
 104          do ichir1=-1,1
 105           do ichir2=-1,1
 106           athet(j,i,ichir1,ichir2)=0.0D0
 107           bthet(j,i,ichir1,ichir2)=0.0D0
 108           enddo
 109          enddo
 110         enddo
 111         do j=0,3
 112           polthet(j,i)=0.0D0
 113         enddo
 114         do j=1,3
 115           gthet(j,i)=0.0D0
 116         enddo
 117         theta0(i)=0.0D0
 118         sig0(i)=0.0D0
 119         sigc0(i)=0.0D0
 120         do j=1,maxlob
 121           bsc(j,i)=0.0D0
 122           do k=1,3
 123             censc(k,j,i)=0.0D0
 124           enddo
 125           do k=1,3
 126             do l=1,3
 127               gaussc(l,k,j,i)=0.0D0
 128             enddo
 129           enddo
 130           nlob(i)=0
 131         enddo
 132       enddo
 133       nlob(ntyp1)=0
 134       dsc(ntyp1)=0.0D0
 135       do i=-maxtor,maxtor
 136         itortyp(i)=0
 137        do iblock=1,2
 138         do j=-maxtor,maxtor
 139           do k=1,maxterm
 140             v1(k,j,i,iblock)=0.0D0
 141             v2(k,j,i,iblock)=0.0D0
 142            enddo
 143          enddo
 144        enddo
 145       enddo
 146       do iblock=1,2
 147        do i=-maxtor,maxtor
 148         do j=-maxtor,maxtor
 149          do k=-maxtor,maxtor
 150           do l=1,maxtermd_1
 151             v1c(1,l,i,j,k,iblock)=0.0D0
 152             v1s(1,l,i,j,k,iblock)=0.0D0
 153             v1c(2,l,i,j,k,iblock)=0.0D0
 154             v1s(2,l,i,j,k,iblock)=0.0D0
 155           enddo !l
 156           do l=1,maxtermd_2
 157            do m=1,maxtermd_2
 158             v2c(m,l,i,j,k,iblock)=0.0D0
 159             v2s(m,l,i,j,k,iblock)=0.0D0
 160            enddo !m
 161           enddo !l
 162         enddo !k
 163        enddo !j
 164       enddo !i
 165       enddo !iblock
 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,maxss
 178         dhpb(i)=0.0D0
 179       enddo
 180       do i=1,maxss
 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       return
 234       end
 235 c-------------------------------------------------------------------------
 236       block data nazwy
 237       implicit real*8 (a-h,o-z)
 238       include 'DIMENSIONS'
 239       include 'sizesclu.dat'
 240       include 'COMMON.NAMES'
 241       include 'COMMON.FFIELD'
 242       data restyp /
 243      &'DD','DAU','DAI','DDB','DSM','DPR','DLY','DAR','DHI','DAS','DGL',
 244      & 'DSG','DGN','DSN','DTH',
 245      &'DYY','DAL','DTY','DTR','DVA','DLE','DIL','DPN','MED','DCY','ZER',
 246      &'CYS','MET','PHE','ILE','LEU','VAL','TRP','TYR','ALA','GLY','THR',
 247      &'SER','GLN','ASN','GLU','ASP','HIS','ARG','LYS','PRO','SME','DBZ',
 248      &'AIB','ABU','D'/
 249       data onelet /
 250      &'z','z','z','z','z','p','k','r','h','d','e','n','q','s','t','g',
 251      &'a','y','w','v','l','i','f','m','c','x',
 252      &'C','M','F','I','L','V','W','Y','A','G','T',
 253      &'S','Q','N','E','D','H','R','K','P','z','z','z','z','X'/
 254       data potname /'LJ','LJK','BP','GB','GBV'/
 255       data ename /
 256      &   "EVDW SC-SC","EVDW2 SC-p","EES p-p","ECORR4 ","ECORR5 ",
 257      &   "ECORR6 ","EELLO ","ETURN3 ","ETURN4 ","ETURN6 ",
 258      &   "EBE bend","ESC SCloc","ETORS ","ETORSD ","EHPB","EVDWPP",
 259      &   "EVDW2_14","ESTR","ESCCOR","EDIHC","EVDW_T","ELIPTRAN",
 260      &   "EAFM","ETHETC","ESHIELD","ESAXS"/
 261       data wname /
 262      &   "WSC","WSCP","WELEC","WCORR","WCORR5","WCORR6","WEL_LOC",
 263      &   "WTURN3","WTURN4","WTURN6","WANG","WSCLOC","WTOR","WTORD",
 264      &   "WHPB","WVDWPP","WSCP14","WBOND","WSCCOR","WDIHC","WSC",
 265      &   "WLIPTRAN","WAFM","WTHETC","WSHIELD","WSAXS"/
 266       data print_order /1,2,3,18,11,12,13,14,4,5,6,7,8,9,10,19,
 267      &  16,15,17,20,21,24,22,23,26/
 268       end
 269 c---------------------------------------------------------------------------
 270       subroutine init_int_table
 271       implicit real*8 (a-h,o-z)
 272       include 'DIMENSIONS'
 273       include 'COMMON.CHAIN'
 274       include 'COMMON.INTERACT'
 275       include 'COMMON.LOCAL'
 276       include 'COMMON.SBRIDGE'
 277       include 'COMMON.IOUNITS'
 278       include "COMMON.TORCNSTR"
 279       logical scheck,lprint
 280       lprint=.false.
 281       do i=1,maxres
 282         nint_gr(i)=0
 283         nscp_gr(i)=0
 284         do j=1,maxint_gr
 285           istart(i,1)=0
 286           iend(i,1)=0
 287           ielstart(i)=0
 288           ielend(i)=0
 289           iscpstart(i,1)=0
 290           iscpend(i,1)=0
 291         enddo
 292       enddo
 293       ind_scint=0
 294       ind_scint_old=0
 295 cd    write (iout,*) 'ns=',ns,' nss=',nss,' ihpb,jhpb',
 296 cd   &   (ihpb(i),jhpb(i),i=1,nss)
 297       do i=nnt,nct-1
 298         scheck=.false.
 299         if (dyn_ss) goto 10
 300         do ii=1,nss
 301           if (ihpb(ii).eq.i+nres) then
 302             scheck=.true.
 303             jj=jhpb(ii)-nres
 304             goto 10
 305           endif
 306         enddo
 307    10   continue
 308 cd      write (iout,*) 'i=',i,' scheck=',scheck,' jj=',jj
 309         if (scheck) then
 310           if (jj.eq.i+1) then
 311             nint_gr(i)=1
 312             istart(i,1)=i+2
 313             iend(i,1)=nct
 314           else if (jj.eq.nct) then
 315             nint_gr(i)=1
 316             istart(i,1)=i+1
 317             iend(i,1)=nct-1
 318           else
 319             nint_gr(i)=2
 320             istart(i,1)=i+1
 321             iend(i,1)=jj-1
 322             istart(i,2)=jj+1
 323             iend(i,2)=nct
 324           endif
 325         else
 326           nint_gr(i)=1
 327           istart(i,1)=i+1
 328           iend(i,1)=nct
 329           ind_scint=int_scint+nct-i
 330         endif
 331       enddo
 332    12 continue
 333       iatsc_s=nnt
 334       iatsc_e=nct-1
 335       if (lprint) then
 336       write (iout,'(a)') 'Interaction array:'
 337       do i=iatsc_s,iatsc_e
 338         write (iout,'(i3,2(2x,2i3))')
 339      & i,(istart(i,iint),iend(i,iint),iint=1,nint_gr(i))
 340       enddo
 341       endif
 342       ispp=2
 343       iatel_s=nnt
 344       iatel_e=nct-3
 345       do i=iatel_s,iatel_e
 346         ielstart(i)=i+4
 347         ielend(i)=nct-1
 348       enddo
 349       if (lprint) then
 350         write (iout,'(a)') 'Electrostatic interaction array:'
 351         do i=iatel_s,iatel_e
 352           write (iout,'(i3,2(2x,2i3))') i,ielstart(i),ielend(i)
 353         enddo
 354       endif ! lprint
 355 c     iscp=3
 356       iscp=2
 357 C Partition the SC-p interaction array
 358       iatscp_s=nnt
 359       iatscp_e=nct-1
 360       do i=nnt,nct-1
 361         if (i.lt.nnt+iscp) then
 362           nscp_gr(i)=1
 363           iscpstart(i,1)=i+iscp
 364           iscpend(i,1)=nct
 365         elseif (i.gt.nct-iscp) then
 366           nscp_gr(i)=1
 367           iscpstart(i,1)=nnt
 368           iscpend(i,1)=i-iscp
 369         else
 370           nscp_gr(i)=2
 371           iscpstart(i,1)=nnt
 372           iscpend(i,1)=i-iscp
 373           iscpstart(i,2)=i+iscp
 374           iscpend(i,2)=nct
 375         endif
 376       enddo ! i
 377       if (lprint) then
 378         write (iout,'(a)') 'SC-p interaction array:'
 379         do i=iatscp_s,iatscp_e
 380           write (iout,'(i3,2(2x,2i3))')
 381      &         i,(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
 382         enddo
 383       endif ! lprint
 384 C Partition local interactions
 385       loc_start=2
 386       loc_end=nres-1
 387       ithet_start=3
 388       ithet_end=nres
 389       iturn3_start=nnt
 390       iturn3_end=nct-3
 391       iturn4_start=nnt
 392       iturn4_end=nct-4
 393       iphi_start=nnt+3
 394       iphi_end=nct
 395       idihconstr_start=1
 396       idihconstr_end=ndih_constr
 397       ithetaconstr_start=1
 398       ithetaconstr_end=ntheta_constr
 399       itau_start=4
 400       itau_end=nres
 401       isaxs_start=1
 402       isaxs_end=nsaxs
 403       write (iout,*) "OSAXS_START",isaxs_start," ISAXS_END",isaxs_end
 404       return
 405       end
 406 c---------------------------------------------------------------------------
 407       subroutine int_partition(int_index,lower_index,upper_index,atom,
 408      & at_start,at_end,first_atom,last_atom,int_gr,jat_start,jat_end,*)
 409       implicit real*8 (a-h,o-z)
 410       include 'DIMENSIONS'
 411       include 'COMMON.IOUNITS'
 412       integer int_index,lower_index,upper_index,atom,at_start,at_end,
 413      & first_atom,last_atom,int_gr,jat_start,jat_end
 414       logical lprn
 415       lprn=.false.
 416       if (lprn) write (iout,*) 'int_index=',int_index
 417       int_index_old=int_index
 418       int_index=int_index+last_atom-first_atom+1
 419       if (lprn)
 420      &   write (iout,*) 'int_index=',int_index,
 421      &               ' int_index_old',int_index_old,
 422      &               ' lower_index=',lower_index,
 423      &               ' upper_index=',upper_index,
 424      &               ' atom=',atom,' first_atom=',first_atom,
 425      &               ' last_atom=',last_atom
 426       if (int_index.ge.lower_index) then
 427         int_gr=int_gr+1
 428         if (at_start.eq.0) then
 429           at_start=atom
 430           jat_start=first_atom-1+lower_index-int_index_old
 431         else
 432           jat_start=first_atom
 433         endif
 434         if (lprn) write (iout,*) 'jat_start',jat_start
 435         if (int_index.ge.upper_index) then
 436           at_end=atom
 437           jat_end=first_atom-1+upper_index-int_index_old
 438           return1
 439         else
 440           jat_end=last_atom
 441         endif
 442         if (lprn) write (iout,*) 'jat_end',jat_end
 443       endif
 444       return
 445       end
 446 c------------------------------------------------------------------------------
 447       subroutine hpb_partition
 448       implicit real*8 (a-h,o-z)
 449       include 'DIMENSIONS'
 450       include 'COMMON.SBRIDGE'
 451       include 'COMMON.IOUNITS'
 452       link_start=1
 453       link_end=nhpb
 454       link_start_peak=1
 455       link_end_peak=npeak
 456       write (iout,*) 'HPB_PARTITION',
 457      &  ' nhpb',nhpb,' link_start=',link_start,
 458      &  ' link_end',link_end,' link_start_peak',link_start_peak,
 459      &  ' link_end_peak',link_end_peak
 460       return
 461       end