saxs and adam's corrections to multichain
[unres.git] / 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