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       do i=1,nsccortyp
 241        do j=1,nsccortyp
 242
 243       nterm_sccor(j,i)=nterm_sccor_all(j,i,iparm)
 244 c      do i=1,20
 245 c        do j=1,20
 246          do l=1,3
 247           do k=1,nterm_sccor(j,i)
 248             v1sccor(k,l,j,i)=v1sccor_all(k,l,j,i,iparm)
 249             v2sccor(k,l,j,i)=v2sccor_all(k,l,j,i,iparm)
 250            enddo
 251           enddo
 252         enddo
 253       enddo
 254       return
 255       end
 256 c--------------------------------------------------------------------------
 257       subroutine restore_parm(iparm)
 258 C
 259 C Store parameters of set IPARM
 260 C valence angles and the side chains and energy parameters.
 261 C
 262       implicit none
 263       include 'DIMENSIONS'
 264       include 'DIMENSIONS.ZSCOPT'
 265       include 'DIMENSIONS.FREE'
 266       include 'COMMON.IOUNITS'
 267       include 'COMMON.CHAIN'
 268       include 'COMMON.INTERACT'
 269       include 'COMMON.GEO'
 270       include 'COMMON.LOCAL'
 271       include 'COMMON.TORSION'
 272       include 'COMMON.FFIELD'
 273       include 'COMMON.NAMES'
 274       include 'COMMON.SBRIDGE'
 275       include 'COMMON.SCROT'
 276       include 'COMMON.SCCOR'
 277       include 'COMMON.ALLPARM'
 278       integer i,j,k,l,m,mm,iparm,ichir1,ichir2,iblock,iii
 279
 280 c Restore weights
 281       wsc=ww_all(1,iparm)
 282       wscp=ww_all(2,iparm)
 283       welec=ww_all(3,iparm)
 284       wcorr=ww_all(4,iparm)
 285       wcorr5=ww_all(5,iparm)
 286       wcorr6=ww_all(6,iparm)
 287       wel_loc=ww_all(7,iparm)
 288       wturn3=ww_all(8,iparm)
 289       wturn4=ww_all(9,iparm)
 290       wturn6=ww_all(10,iparm)
 291       wang=ww_all(11,iparm)
 292       wscloc=ww_all(12,iparm)
 293       wtor=ww_all(13,iparm)
 294       wtor_d=ww_all(14,iparm)
 295       wstrain=ww_all(15,iparm)
 296       wvdwpp=ww_all(16,iparm)
 297       wbond=ww_all(17,iparm)
 298       wsccor=ww_all(19,iparm)
 299 c Restore bond parameters
 300       vbldp0=vbldp0_all(iparm)
 301       akp=akp_all(iparm)
 302       do i=1,ntyp
 303         nbondterm(i)=nbondterm_all(i,iparm)
 304         do j=1,nbondterm(i)
 305           vbldsc0(j,i)=vbldsc0_all(j,i,iparm)
 306           aksc(j,i)=aksc_all(j,i,iparm)
 307           abond0(j,i)=abond0_all(j,i,iparm)
 308         enddo
 309       enddo
 310 c Restore bond angle parameters
 311 #ifdef CRYST_THETA
 312       do i=-ntyp,ntyp
 313         a0thet(i)=a0thet_all(i,iparm)
 314         do ichir1=-1,1
 315         do ichir2=-1,1
 316         do j=1,2
 317           athet(j,i,ichir1,ichir2)=athet_all(j,i,ichir1,ichir2,iparm)
 318           bthet(j,i,ichir1,ichir2)=bthet_all(j,i,ichir1,ichir2,iparm)
 319         enddo
 320         enddo
 321         enddo
 322         do j=0,3
 323           polthet(j,i)=polthet_all(j,i,iparm)
 324         enddo
 325         do j=1,3
 326           gthet(j,i)=gthet_all(j,i,iparm)
 327         enddo
 328         theta0(i)=theta0_all(i,iparm)
 329         sig0(i)=sig0_all(i,iparm)
 330         sigc0(i)=sigc0_all(i,iparm)
 331       enddo
 332 #else
 333       nthetyp=nthetyp_all(iparm)
 334       ntheterm=ntheterm_all(iparm)
 335       ntheterm2=ntheterm2_all(iparm)
 336       ntheterm3=ntheterm3_all(iparm)
 337       nsingle=nsingle_all(iparm)
 338       ndouble=ndouble_all(iparm)
 339       nntheterm=nntheterm_all(iparm)
 340       do i=1,ntyp1
 341         ithetyp(i)=ithetyp_all(i,iparm)
 342       enddo
 343       do i=1,maxthetyp1
 344         do j=1,maxthetyp1
 345           do k=1,maxthetyp1
 346             aa0thet(i,j,k)=aa0thet_all(i,j,k,iparm)
 347             do l=1,ntheterm
 348               aathet(l,i,j,k)=aathet_all(l,i,j,k,iparm)
 349             enddo
 350             do l=1,ntheterm2
 351               do m=1,nsingle
 352                 bbthet(m,l,i,j,k)=bbthet_all(m,l,i,j,k,iparm)
 353                 ccthet(m,l,i,j,k)=ccthet_all(m,l,i,j,k,iparm)
 354                 ddthet(m,l,i,j,k)=ddthet_all(m,l,i,j,k,iparm)
 355                 eethet(m,l,i,j,k)=eethet_all(m,l,i,j,k,iparm)
 356               enddo
 357             enddo
 358             do l=1,ntheterm3
 359               do m=1,ndouble
 360                 do mm=1,ndouble
 361                  ffthet(mm,m,l,i,j,k)=ffthet_all(mm,m,l,i,j,k,iparm)
 362                  ggthet(mm,m,l,i,j,k)=ggthet_all(mm,m,l,i,j,k,iparm)
 363                 enddo
 364               enddo
 365             enddo
 366           enddo
 367         enddo
 368       enddo
 369 #endif
 370 c Restore the sidechain rotamer parameters
 371 #ifdef CRYST_SC
 372       do i=-ntyp,ntyp
 373         if (i.eq.0) cycle
 374         iii=iabs(i)
 375         nlob(iii)=nlob_all(iii,iparm)
 376         do j=1,nlob(iii)
 377           bsc(j,iii)=bsc_all(j,iii,iparm)
 378           do k=1,3
 379             censc(k,j,i)=censc_all(k,j,i,iparm)
 380           enddo
 381           do k=1,3
 382             do l=1,3
 383               gaussc(l,k,j,i)=gaussc_all(l,k,j,i,iparm)
 384             enddo
 385           enddo
 386         enddo
 387       enddo
 388 #else
 389       do i=1,ntyp
 390         do j=1,65
 391           sc_parmin(j,i)=sc_parmin_all(j,i,iparm)
 392         enddo
 393       enddo
 394 #endif
 395 c Restore the torsional parameters
 396       do iblock=1,2
 397       do i=-ntortyp+1,ntortyp-1
 398         do j=-ntortyp+1,ntortyp-1
 399           v0(i,j,iblock)=v0_all(i,j,iblock,iparm)
 400           nterm(i,j,iblock)=nterm_all(i,j,iblock,iparm)
 401           nlor(i,j,iblock)=nlor_all(i,j,iblock,iparm)
 402           do k=1,nterm(i,j,iblock)
 403             v1(k,i,j,iblock)=v1_all(k,i,j,iblock,iparm)
 404             v2(k,i,j,iblock)=v2_all(k,i,j,iblock,iparm)
 405           enddo
 406           do k=1,nlor(i,j,iblock)
 407             vlor1(k,i,j)=vlor1_all(k,i,j,iparm)
 408             vlor2(k,i,j)=vlor2_all(k,i,j,iparm)
 409             vlor3(k,i,j)=vlor3_all(k,i,j,iparm)
 410           enddo
 411         enddo
 412       enddo
 413       enddo
 414 c Restore the double torsional parameters
 415       do iblock=1,2
 416       do i=-ntortyp+1,ntortyp-1
 417         do j=-ntortyp+1,ntortyp-1
 418           do k=-ntortyp+1,ntortyp-1
 419             ntermd_1(i,j,k,iblock)=ntermd1_all(i,j,k,iblock,iparm)
 420             ntermd_2(i,j,k,iblock)=ntermd2_all(i,j,k,iblock,iparm)
 421             do l=1,ntermd_1(i,j,k,iblock)
 422               v1c(1,l,i,j,k,iblock)=v1c_all(1,l,i,j,k,iblock,iparm)
 423               v1c(2,l,i,j,k,iblock)=v1c_all(2,l,i,j,k,iblock,iparm)
 424               v2c(1,l,i,j,k,iblock)=v2c_all(1,l,i,j,k,iblock,iparm)
 425               v2c(2,l,i,j,k,iblock)=v2c_all(2,l,i,j,k,iblock,iparm)
 426             enddo
 427             do l=1,ntermd_2(i,j,k,iblock)
 428               do m=1,ntermd_2(i,j,k,iblock)
 429                 v2s(l,m,i,j,k,iblock)=v2s_all(l,m,i,j,k,iblock,iparm)
 430               enddo
 431             enddo
 432           enddo
 433         enddo
 434       enddo
 435       enddo
 436 c Restore parameters of the cumulants
 437       do i=-nloctyp,nloctyp
 438         do j=1,2
 439           b1(j,i)=b1_all(j,i,iparm)
 440           b1tilde(j,i)=b1tilde_all(j,i,iparm)
 441           b2(j,i)=b2_all(j,i,iparm)
 442         enddo
 443         do j=1,2
 444           do k=1,2
 445             cc(k,j,i)=cc_all(k,j,i,iparm)
 446             ctilde(k,j,i)=ctilde_all(k,j,i,iparm)
 447             dd(k,j,i)=dd_all(k,j,i,iparm)
 448             dtilde(k,j,i)=dtilde_all(k,j,i,iparm)
 449             ee(k,j,i)=ee_all(k,j,i,iparm)
 450           enddo
 451         enddo
 452       enddo
 453 c Restore the parameters of electrostatic interactions
 454       do i=1,2
 455         do j=1,2
 456           app(j,i)=app_all(j,i,iparm)
 457           bpp(j,i)=bpp_all(j,i,iparm)
 458           ael6(j,i)=ael6_all(j,i,iparm)
 459           ael3(j,i)=ael3_all(j,i,iparm)
 460         enddo
 461       enddo
 462 c Restore sidechain parameters
 463       do i=1,ntyp
 464         do j=1,ntyp
 465           aa(j,i)=aa_all(j,i,iparm)
 466           bb(j,i)=bb_all(j,i,iparm)
 467           r0(j,i)=r0_all(j,i,iparm)
 468           sigma(j,i)=sigma_all(j,i,iparm)
 469           chi(j,i)=chi_all(j,i,iparm)
 470           augm(j,i)=augm_all(j,i,iparm)
 471           eps(j,i)=eps_all(j,i,iparm)
 472         enddo
 473       enddo
 474       do i=1,ntyp
 475         chip(i)=chip_all(i,iparm)
 476         alp(i)=alp_all(i,iparm)
 477       enddo
 478 c Restore the SCp parameters
 479       do i=1,ntyp
 480         do j=1,2
 481           aad(i,j)=aad_all(i,j,iparm)
 482           bad(i,j)=bad_all(i,j,iparm)
 483         enddo
 484       enddo
 485 c Restore disulfide-bond parameters
 486       ebr=ebr_all(iparm)
 487       d0cm=d0cm_all(iparm)
 488       akcm=akcm_all(iparm)
 489       akth=akth_all(iparm)
 490       akct=akct_all(iparm)
 491       v1ss=v1ss_all(iparm)
 492       v2ss=v2ss_all(iparm)
 493       v3ss=v3ss_all(iparm)
 494 c Restore SC-backbone correlation parameters
 495       do i=1,nsccortyp
 496        do j=1,nsccortyp
 497
 498       nterm_sccor_all(j,i,iparm)=nterm_sccor(j,i)
 499         do l=1,3
 500            do k=1,nterm_sccor(j,i)
 501             v1sccor_all(k,l,j,i,iparm)=v1sccor(k,l,j,i)
 502             v2sccor_all(k,l,j,i,iparm)=v2sccor(k,l,j,i)
 503            enddo
 504           enddo
 505         enddo
 506       enddo
 507       return
 508       end