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