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