source/wham/src-M-Pawel/store_parm.F

   1               subroutine store_parm(iparm)
   2 C
   3 C Store parameters of set IPARM
   4 C valence angles and the side chains and energy parameters.
   5 C
   6       implicit none
   7       include 'DIMENSIONS'
   8       include 'DIMENSIONS.ZSCOPT'
   9       include 'DIMENSIONS.FREE'
  10       include 'COMMON.IOUNITS'
  11       include 'COMMON.CHAIN'
  12       include 'COMMON.INTERACT'
  13       include 'COMMON.GEO'
  14       include 'COMMON.LOCAL'
  15       include 'COMMON.TORSION'
  16       include 'COMMON.FFIELD'
  17       include 'COMMON.NAMES'
  18       include 'COMMON.SBRIDGE'
  19       include 'COMMON.SCROT'
  20       include 'COMMON.SCCOR'
  21       include 'COMMON.ALLPARM'
  22       integer i,j,k,l,m,mm,iparm,ichir1,ichir2,iblock,iii
  23
  24 c Store weights
  25       ww_all(1,iparm)=wsc
  26       ww_all(2,iparm)=wscp
  27       ww_all(3,iparm)=welec
  28       ww_all(4,iparm)=wcorr
  29       ww_all(5,iparm)=wcorr5
  30       ww_all(6,iparm)=wcorr6
  31       ww_all(7,iparm)=wel_loc
  32       ww_all(8,iparm)=wturn3
  33       ww_all(9,iparm)=wturn4
  34       ww_all(10,iparm)=wturn6
  35       ww_all(11,iparm)=wang
  36       ww_all(12,iparm)=wscloc
  37       ww_all(13,iparm)=wtor
  38       ww_all(14,iparm)=wtor_d
  39       ww_all(15,iparm)=wstrain
  40       ww_all(16,iparm)=wvdwpp
  41       ww_all(17,iparm)=wbond
  42       ww_all(19,iparm)=wsccor
  43 c Store bond parameters
  44       vbldp0_all(iparm)=vbldp0
  45       akp_all(iparm)=akp
  46       do i=1,ntyp
  47         nbondterm_all(i,iparm)=nbondterm(i)
  48         do j=1,nbondterm(i)
  49           vbldsc0_all(j,i,iparm)=vbldsc0(j,i)
  50           aksc_all(j,i,iparm)=aksc(j,i)
  51           abond0_all(j,i,iparm)=abond0(j,i)
  52         enddo
  53       enddo
  54 c Store bond angle parameters
  55 #ifdef CRYST_THETA
  56       do i=-ntyp,ntyp
  57         a0thet_all(i,iparm)=a0thet(i)
  58         do ichir1=-1,1
  59         do ichir2=-1,1
  60         do j=1,2
  61           athet_all(j,i,ichir1,ichir2,iparm)=athet(j,i,ichir1,ichir2)
  62           bthet_all(j,i,ichir1,ichir2,iparm)=bthet(j,i,ichir1,ichir2)
  63         enddo
  64         enddo
  65         enddo
  66         do j=0,3
  67           polthet_all(j,i,iparm)=polthet(j,i)
  68         enddo
  69         do j=1,3
  70           gthet_all(j,i,iparm)=gthet(j,i)
  71         enddo
  72         theta0_all(i,iparm)=theta0(i)
  73         sig0_all(i,iparm)=sig0(i)
  74         sigc0_all(i,iparm)=sigc0(i)
  75       enddo
  76 #else
  77       nthetyp_all(iparm)=nthetyp
  78       ntheterm_all(iparm)=ntheterm
  79       ntheterm2_all(iparm)=ntheterm2
  80       ntheterm3_all(iparm)=ntheterm3
  81       nsingle_all(iparm)=nsingle
  82       ndouble_all(iparm)=ndouble
  83       nntheterm_all(iparm)=nntheterm
  84       do i=-ntyp,ntyp
  85         ithetyp_all(i,iparm)=ithetyp(i)
  86       enddo
  87       do iblock=1,2
  88       do i=-maxthetyp1,maxthetyp1
  89         do j=-maxthetyp1,maxthetyp1
  90           do k=-maxthetyp1,maxthetyp1
  91             aa0thet_all(i,j,k,iblock,iparm)=aa0thet(i,j,k,iblock)
  92             do l=1,ntheterm
  93               aathet_all(l,i,j,k,iblock,iparm)=aathet(l,i,j,k,iblock)
  94             enddo
  95             do l=1,ntheterm2
  96               do m=1,nsingle
  97                 bbthet_all(m,l,i,j,k,iblock,iparm)=
  98      & bbthet(m,l,i,j,k,iblock)
  99                 ccthet_all(m,l,i,j,k,iblock,iparm)=
 100      &ccthet(m,l,i,j,k,iblock)
 101                 ddthet_all(m,l,i,j,k,iblock,iparm)=
 102      &ddthet(m,l,i,j,k,iblock)
 103                 eethet_all(m,l,i,j,k,iblock,iparm)=
 104      &eethet(m,l,i,j,k,iblock)
 105               enddo
 106             enddo
 107             do l=1,ntheterm3
 108               do m=1,ndouble
 109                 do mm=1,ndouble
 110                 if (iblock.eq.1) then
 111                  ffthet_all1(mm,m,l,i,j,k,iparm)=
 112      &   ffthet(mm,m,l,i,j,k,iblock)
 113                  ggthet_all1(mm,m,l,i,j,k,iparm)=
 114      &ggthet(mm,m,l,i,j,k,iblock)
 115                   else
 116                  ffthet_all2(mm,m,l,i,j,k,iparm)=
 117      &   ffthet(mm,m,l,i,j,k,iblock)
 118                  ggthet_all2(mm,m,l,i,j,k,iparm)=
 119      &ggthet(mm,m,l,i,j,k,iblock)
 120                   endif
 121                 enddo
 122               enddo
 123             enddo
 124           enddo
 125         enddo
 126       enddo
 127       enddo
 128 #endif
 129 #ifdef CRYST_SC
 130 c Store the sidechain rotamer parameters
 131       do i=-ntyp,ntyp
 132        iii=iabs(i)
 133 cc       write (iout,*) i,"storeparm1"
 134        if (i.eq.0) cycle
 135         nlob_all(iii,iparm)=nlob(iii)
 136         do j=1,nlob(iii)
 137           bsc_all(j,iii,iparm)=bsc(j,iii)
 138           do k=1,3
 139             censc_all(k,j,i,iparm)=censc(k,j,i)
 140           enddo
 141           do k=1,3
 142             do l=1,3
 143               gaussc_all(l,k,j,i,iparm)=gaussc(l,k,j,i)
 144             enddo
 145           enddo
 146         enddo
 147       enddo
 148 #else
 149       do i=1,ntyp
 150         do j=1,65
 151           sc_parmin_all(j,i,iparm)=sc_parmin(j,i)
 152         enddo
 153       enddo
 154 #endif
 155 c Store the torsional parameters
 156       do iblock=1,2
 157       do i=-ntortyp+1,ntortyp-1
 158         do j=-ntortyp+1,ntortyp-1
 159           v0_all(i,j,iblock,iparm)=v0(i,j,iblock)
 160           nterm_all(i,j,iblock,iparm)=nterm(i,j,iblock)
 161           nlor_all(i,j,iblock,iparm)=nlor(i,j,iblock)
 162           do k=1,nterm(i,j,iblock)
 163             v1_all(k,i,j,iblock,iparm)=v1(k,i,j,iblock)
 164             v2_all(k,i,j,iblock,iparm)=v2(k,i,j,iblock)
 165           enddo
 166           do k=1,nlor(i,j,iblock)
 167             vlor1_all(k,i,j,iparm)=vlor1(k,i,j)
 168             vlor2_all(k,i,j,iparm)=vlor2(k,i,j)
 169             vlor3_all(k,i,j,iparm)=vlor3(k,i,j)
 170           enddo
 171         enddo
 172       enddo
 173       enddo
 174 c Store the double torsional parameters
 175       do iblock=1,2
 176       do i=-ntortyp+1,ntortyp-1
 177         do j=-ntortyp+1,ntortyp-1
 178           do k=-ntortyp+1,ntortyp-1
 179             ntermd1_all(i,j,k,iblock,iparm)=ntermd_1(i,j,k,iblock)
 180             ntermd2_all(i,j,k,iblock,iparm)=ntermd_2(i,j,k,iblock)
 181             do l=1,ntermd_1(i,j,k,iblock)
 182               v1c_all(1,l,i,j,k,iblock,iparm)=v1c(1,l,i,j,k,iblock)
 183               v1c_all(2,l,i,j,k,iblock,iparm)=v1c(2,l,i,j,k,iblock)
 184               v2c_all(1,l,i,j,k,iblock,iparm)=v2c(1,l,i,j,k,iblock)
 185               v2c_all(2,l,i,j,k,iblock,iparm)=v2c(2,l,i,j,k,iblock)
 186             enddo
 187             do l=1,ntermd_2(i,j,k,iblock)
 188               do m=1,ntermd_2(i,j,k,iblock)
 189                 v2s_all(l,m,i,j,k,iblock,iparm)=v2s(l,m,i,j,k,iblock)
 190               enddo
 191             enddo
 192           enddo
 193         enddo
 194       enddo
 195       enddo
 196 c Store parameters of the cumulants
 197       do i=-nloctyp,nloctyp
 198         do j=1,2
 199           b1_all(j,i,iparm)=b1(j,i)
 200           b1tilde_all(j,i,iparm)=b1tilde(j,i)
 201           b2_all(j,i,iparm)=b2(j,i)
 202         enddo
 203         do j=1,2
 204           do k=1,2
 205             cc_all(k,j,i,iparm)=cc(k,j,i)
 206             ctilde_all(k,j,i,iparm)=ctilde(k,j,i)
 207             dd_all(k,j,i,iparm)=dd(k,j,i)
 208             dtilde_all(k,j,i,iparm)=dtilde(k,j,i)
 209             ee_all(k,j,i,iparm)=ee(k,j,i)
 210           enddo
 211         enddo
 212       enddo
 213 c Store the parameters of electrostatic interactions
 214       do i=1,2
 215         do j=1,2
 216           app_all(j,i,iparm)=app(j,i)
 217           bpp_all(j,i,iparm)=bpp(j,i)
 218           ael6_all(j,i,iparm)=ael6(j,i)
 219           ael3_all(j,i,iparm)=ael3(j,i)
 220         enddo
 221       enddo
 222 c Store sidechain parameters
 223       do i=1,ntyp
 224         do j=1,ntyp
 225           aa_all(j,i,iparm)=aa(j,i)
 226           bb_all(j,i,iparm)=bb(j,i)
 227           r0_all(j,i,iparm)=r0(j,i)
 228           sigma_all(j,i,iparm)=sigma(j,i)
 229           chi_all(j,i,iparm)=chi(j,i)
 230           augm_all(j,i,iparm)=augm(j,i)
 231           eps_all(j,i,iparm)=eps(j,i)
 232         enddo
 233       enddo
 234       do i=1,ntyp
 235         chip_all(i,iparm)=chip(i)
 236         alp_all(i,iparm)=alp(i)
 237       enddo
 238 c Store the SCp parameters
 239       do i=1,ntyp
 240         do j=1,2
 241           aad_all(i,j,iparm)=aad(i,j)
 242           bad_all(i,j,iparm)=bad(i,j)
 243         enddo
 244       enddo
 245 c Store disulfide-bond parameters
 246       ebr_all(iparm)=ebr
 247       d0cm_all(iparm)=d0cm
 248       akcm_all(iparm)=akcm
 249       akth_all(iparm)=akth
 250       akct_all(iparm)=akct
 251       v1ss_all(iparm)=v1ss
 252       v2ss_all(iparm)=v2ss
 253       v3ss_all(iparm)=v3ss
 254 c Store SC-backbone correlation parameters
 255       do i=-nsccortyp,nsccortyp
 256        do j=-nsccortyp,nsccortyp
 257
 258       nterm_sccor_all(j,i,iparm)=nterm_sccor(j,i)
 259 c      do i=1,20
 260 c        do j=1,20
 261          do l=1,3
 262           do k=1,nterm_sccor(j,i)
 263             v1sccor_all(k,l,j,i,iparm)=v1sccor(k,l,j,i)
 264             v2sccor_all(k,l,j,i,iparm)=v2sccor(k,l,j,i)
 265            enddo
 266           enddo
 267         enddo
 268       enddo
 269       return
 270       end
 271 c--------------------------------------------------------------------------
 272       subroutine restore_parm(iparm)
 273 C
 274 C Store parameters of set IPARM
 275 C valence angles and the side chains and energy parameters.
 276 C
 277       implicit none
 278       include 'DIMENSIONS'
 279       include 'DIMENSIONS.ZSCOPT'
 280       include 'DIMENSIONS.FREE'
 281       include 'COMMON.IOUNITS'
 282       include 'COMMON.CHAIN'
 283       include 'COMMON.INTERACT'
 284       include 'COMMON.GEO'
 285       include 'COMMON.LOCAL'
 286       include 'COMMON.TORSION'
 287       include 'COMMON.FFIELD'
 288       include 'COMMON.NAMES'
 289       include 'COMMON.SBRIDGE'
 290       include 'COMMON.SCROT'
 291       include 'COMMON.SCCOR'
 292       include 'COMMON.ALLPARM'
 293       integer i,j,k,l,m,mm,iparm,ichir1,ichir2,iblock,iii
 294
 295 c Restore weights
 296       wsc=ww_all(1,iparm)
 297       wscp=ww_all(2,iparm)
 298       welec=ww_all(3,iparm)
 299       wcorr=ww_all(4,iparm)
 300       wcorr5=ww_all(5,iparm)
 301       wcorr6=ww_all(6,iparm)
 302       wel_loc=ww_all(7,iparm)
 303       wturn3=ww_all(8,iparm)
 304       wturn4=ww_all(9,iparm)
 305       wturn6=ww_all(10,iparm)
 306       wang=ww_all(11,iparm)
 307       wscloc=ww_all(12,iparm)
 308       wtor=ww_all(13,iparm)
 309       wtor_d=ww_all(14,iparm)
 310       wstrain=ww_all(15,iparm)
 311       wvdwpp=ww_all(16,iparm)
 312       wbond=ww_all(17,iparm)
 313       wsccor=ww_all(19,iparm)
 314 c Restore bond parameters
 315       vbldp0=vbldp0_all(iparm)
 316       akp=akp_all(iparm)
 317       do i=1,ntyp
 318         nbondterm(i)=nbondterm_all(i,iparm)
 319         do j=1,nbondterm(i)
 320           vbldsc0(j,i)=vbldsc0_all(j,i,iparm)
 321           aksc(j,i)=aksc_all(j,i,iparm)
 322           abond0(j,i)=abond0_all(j,i,iparm)
 323         enddo
 324       enddo
 325 c Restore bond angle parameters
 326 #ifdef CRYST_THETA
 327       do i=-ntyp,ntyp
 328         a0thet(i)=a0thet_all(i,iparm)
 329         do ichir1=-1,1
 330         do ichir2=-1,1
 331         do j=1,2
 332           athet(j,i,ichir1,ichir2)=athet_all(j,i,ichir1,ichir2,iparm)
 333           bthet(j,i,ichir1,ichir2)=bthet_all(j,i,ichir1,ichir2,iparm)
 334         enddo
 335         enddo
 336         enddo
 337         do j=0,3
 338           polthet(j,i)=polthet_all(j,i,iparm)
 339         enddo
 340         do j=1,3
 341           gthet(j,i)=gthet_all(j,i,iparm)
 342         enddo
 343         theta0(i)=theta0_all(i,iparm)
 344         sig0(i)=sig0_all(i,iparm)
 345         sigc0(i)=sigc0_all(i,iparm)
 346       enddo
 347 #else
 348       nthetyp=nthetyp_all(iparm)
 349       ntheterm=ntheterm_all(iparm)
 350       ntheterm2=ntheterm2_all(iparm)
 351       ntheterm3=ntheterm3_all(iparm)
 352       nsingle=nsingle_all(iparm)
 353       ndouble=ndouble_all(iparm)
 354       nntheterm=nntheterm_all(iparm)
 355       do i=-ntyp,ntyp
 356         ithetyp(i)=ithetyp_all(i,iparm)
 357       enddo
 358       do iblock=1,2
 359       do i=-maxthetyp1,maxthetyp1
 360         do j=-maxthetyp1,maxthetyp1
 361           do k=-maxthetyp1,maxthetyp1
 362             aa0thet(i,j,k,iblock)=aa0thet_all(i,j,k,iblock,iparm)
 363             do l=1,ntheterm
 364               aathet(l,i,j,k,iblock)=aathet_all(l,i,j,k,iblock,iparm)
 365             enddo
 366             do l=1,ntheterm2
 367               do m=1,nsingle
 368                 bbthet(m,l,i,j,k,iblock)=
 369      &bbthet_all(m,l,i,j,k,iblock,iparm)
 370                 ccthet(m,l,i,j,k,iblock)=
 371      &ccthet_all(m,l,i,j,k,iblock,iparm)
 372                 ddthet(m,l,i,j,k,iblock)=
 373      &ddthet_all(m,l,i,j,k,iblock,iparm)
 374                 eethet(m,l,i,j,k,iblock)=
 375      &eethet_all(m,l,i,j,k,iblock,iparm)
 376               enddo
 377             enddo
 378             do l=1,ntheterm3
 379               do m=1,ndouble
 380                 do mm=1,ndouble
 381                 if (iblock.eq.1) then
 382                  ffthet(mm,m,l,i,j,k,iblock)=
 383      &ffthet_all1(mm,m,l,i,j,k,iparm)
 384                  ggthet(mm,m,l,i,j,k,iblock)=
 385      &ggthet_all1(mm,m,l,i,j,k,iparm)
 386                 else
 387                  ffthet(mm,m,l,i,j,k,iblock)=
 388      &ffthet_all2(mm,m,l,i,j,k,iparm)
 389                  ggthet(mm,m,l,i,j,k,iblock)=
 390      &ggthet_all2(mm,m,l,i,j,k,iparm)
 391                 endif
 392                 enddo
 393               enddo
 394             enddo
 395           enddo
 396         enddo
 397       enddo
 398       enddo
 399 #endif
 400 c Restore the sidechain rotamer parameters
 401 #ifdef CRYST_SC
 402       do i=-ntyp,ntyp
 403         if (i.eq.0) cycle
 404         iii=iabs(i)
 405         nlob(iii)=nlob_all(iii,iparm)
 406         do j=1,nlob(iii)
 407           bsc(j,iii)=bsc_all(j,iii,iparm)
 408           do k=1,3
 409             censc(k,j,i)=censc_all(k,j,i,iparm)
 410           enddo
 411           do k=1,3
 412             do l=1,3
 413               gaussc(l,k,j,i)=gaussc_all(l,k,j,i,iparm)
 414             enddo
 415           enddo
 416         enddo
 417       enddo
 418 #else
 419       do i=1,ntyp
 420         do j=1,65
 421           sc_parmin(j,i)=sc_parmin_all(j,i,iparm)
 422         enddo
 423       enddo
 424 #endif
 425 c Restore the torsional parameters
 426       do iblock=1,2
 427       do i=-ntortyp+1,ntortyp-1
 428         do j=-ntortyp+1,ntortyp-1
 429           v0(i,j,iblock)=v0_all(i,j,iblock,iparm)
 430           nterm(i,j,iblock)=nterm_all(i,j,iblock,iparm)
 431           nlor(i,j,iblock)=nlor_all(i,j,iblock,iparm)
 432           do k=1,nterm(i,j,iblock)
 433             v1(k,i,j,iblock)=v1_all(k,i,j,iblock,iparm)
 434             v2(k,i,j,iblock)=v2_all(k,i,j,iblock,iparm)
 435           enddo
 436           do k=1,nlor(i,j,iblock)
 437             vlor1(k,i,j)=vlor1_all(k,i,j,iparm)
 438             vlor2(k,i,j)=vlor2_all(k,i,j,iparm)
 439             vlor3(k,i,j)=vlor3_all(k,i,j,iparm)
 440           enddo
 441         enddo
 442       enddo
 443       enddo
 444 c Restore the double torsional parameters
 445       do iblock=1,2
 446       do i=-ntortyp+1,ntortyp-1
 447         do j=-ntortyp+1,ntortyp-1
 448           do k=-ntortyp+1,ntortyp-1
 449             ntermd_1(i,j,k,iblock)=ntermd1_all(i,j,k,iblock,iparm)
 450             ntermd_2(i,j,k,iblock)=ntermd2_all(i,j,k,iblock,iparm)
 451             do l=1,ntermd_1(i,j,k,iblock)
 452               v1c(1,l,i,j,k,iblock)=v1c_all(1,l,i,j,k,iblock,iparm)
 453               v1c(2,l,i,j,k,iblock)=v1c_all(2,l,i,j,k,iblock,iparm)
 454               v2c(1,l,i,j,k,iblock)=v2c_all(1,l,i,j,k,iblock,iparm)
 455               v2c(2,l,i,j,k,iblock)=v2c_all(2,l,i,j,k,iblock,iparm)
 456             enddo
 457             do l=1,ntermd_2(i,j,k,iblock)
 458               do m=1,ntermd_2(i,j,k,iblock)
 459                 v2s(l,m,i,j,k,iblock)=v2s_all(l,m,i,j,k,iblock,iparm)
 460               enddo
 461             enddo
 462           enddo
 463         enddo
 464       enddo
 465       enddo
 466 c Restore parameters of the cumulants
 467       do i=-nloctyp,nloctyp
 468         do j=1,2
 469           b1(j,i)=b1_all(j,i,iparm)
 470           b1tilde(j,i)=b1tilde_all(j,i,iparm)
 471           b2(j,i)=b2_all(j,i,iparm)
 472         enddo
 473         do j=1,2
 474           do k=1,2
 475             cc(k,j,i)=cc_all(k,j,i,iparm)
 476             ctilde(k,j,i)=ctilde_all(k,j,i,iparm)
 477             dd(k,j,i)=dd_all(k,j,i,iparm)
 478             dtilde(k,j,i)=dtilde_all(k,j,i,iparm)
 479             ee(k,j,i)=ee_all(k,j,i,iparm)
 480           enddo
 481         enddo
 482       enddo
 483 c Restore the parameters of electrostatic interactions
 484       do i=1,2
 485         do j=1,2
 486           app(j,i)=app_all(j,i,iparm)
 487           bpp(j,i)=bpp_all(j,i,iparm)
 488           ael6(j,i)=ael6_all(j,i,iparm)
 489           ael3(j,i)=ael3_all(j,i,iparm)
 490         enddo
 491       enddo
 492 c Restore sidechain parameters
 493       do i=1,ntyp
 494         do j=1,ntyp
 495           aa(j,i)=aa_all(j,i,iparm)
 496           bb(j,i)=bb_all(j,i,iparm)
 497           r0(j,i)=r0_all(j,i,iparm)
 498           sigma(j,i)=sigma_all(j,i,iparm)
 499           chi(j,i)=chi_all(j,i,iparm)
 500           augm(j,i)=augm_all(j,i,iparm)
 501           eps(j,i)=eps_all(j,i,iparm)
 502         enddo
 503       enddo
 504       do i=1,ntyp
 505         chip(i)=chip_all(i,iparm)
 506         alp(i)=alp_all(i,iparm)
 507       enddo
 508 c Restore the SCp parameters
 509       do i=1,ntyp
 510         do j=1,2
 511           aad(i,j)=aad_all(i,j,iparm)
 512           bad(i,j)=bad_all(i,j,iparm)
 513         enddo
 514       enddo
 515 c Restore disulfide-bond parameters
 516       ebr=ebr_all(iparm)
 517       d0cm=d0cm_all(iparm)
 518       akcm=akcm_all(iparm)
 519       akth=akth_all(iparm)
 520       akct=akct_all(iparm)
 521       v1ss=v1ss_all(iparm)
 522       v2ss=v2ss_all(iparm)
 523       v3ss=v3ss_all(iparm)
 524 c Restore SC-backbone correlation parameters
 525       do i=-nsccortyp,nsccortyp
 526        do j=-nsccortyp,nsccortyp
 527
 528       nterm_sccor(j,i)=nterm_sccor_all(j,i,iparm)
 529         do l=1,3
 530            do k=1,nterm_sccor(j,i)
 531             v1sccor(k,l,j,i)=v1sccor_all(k,l,j,i,iparm)
 532             v2sccor(k,l,j,i)=v2sccor_all(k,l,j,i,iparm)
 533            enddo
 534           enddo
 535         enddo
 536       enddo
 537       return
 538       end