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