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