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