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