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