Debug part 10
[unres.git] / source / wham / src / 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=1,ntyp1
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        if (i.eq.0) cycle
134         nlob_all(iii,iparm)=nlob(iii)
135         do j=1,nlob(iii)
136           bsc_all(j,iii,iparm)=bsc(j,iii)
137           do k=1,3
138             censc_all(k,j,i,iparm)=censc(k,j,i)
139           enddo
140           do k=1,3
141             do l=1,3
142               gaussc_all(l,k,j,i,iparm)=gaussc(l,k,j,i)
143             enddo
144           enddo
145         enddo
146       enddo
147 #else
148       do i=1,ntyp
149         do j=1,65
150           sc_parmin_all(j,i,iparm)=sc_parmin(j,i)
151         enddo
152       enddo
153 #endif
154 c Store the torsional parameters
155       do iblock=1,2
156       do i=-ntortyp+1,ntortyp-1
157         do j=-ntortyp+1,ntortyp-1
158           v0_all(i,j,iblock,iparm)=v0(i,j,iblock)
159           nterm_all(i,j,iblock,iparm)=nterm(i,j,iblock)
160           nlor_all(i,j,iblock,iparm)=nlor(i,j,iblock)
161           do k=1,nterm(i,j,iblock)
162             v1_all(k,i,j,iblock,iparm)=v1(k,i,j,iblock)
163             v2_all(k,i,j,iblock,iparm)=v2(k,i,j,iblock)
164            enddo
165           do k=1,nlor(i,j,iblock)
166              vlor1_all(k,i,j,iparm)=vlor1(k,i,j)
167              vlor2_all(k,i,j,iparm)=vlor2(k,i,j)
168              vlor3_all(k,i,j,iparm)=vlor3(k,i,j)
169            enddo
170          enddo
171       enddo
172        enddo  
173 c Store the double torsional parameters
174       do iblock=1,2
175       do i=-ntortyp+1,ntortyp-1
176         do j=-ntortyp+1,ntortyp-1
177           do k=-ntortyp+1,ntortyp-1
178             ntermd1_all(i,j,k,iblock,iparm)=ntermd_1(i,j,k,iblock)
179             ntermd2_all(i,j,k,iblock,iparm)=ntermd_2(i,j,k,iblock)
180             do l=1,ntermd_1(i,j,k,iblock)
181               v1c_all(1,l,i,j,k,iblock,iparm)=v1c(1,l,i,j,k,iblock)
182               v1c_all(2,l,i,j,k,iblock,iparm)=v1c(2,l,i,j,k,iblock)
183               v2c_all(1,l,i,j,k,iblock,iparm)=v2c(1,l,i,j,k,iblock)
184               v2c_all(2,l,i,j,k,iblock,iparm)=v2c(2,l,i,j,k,iblock)
185              enddo
186             do l=1,ntermd_2(i,j,k,iblock)
187               do m=1,ntermd_2(i,j,k,iblock)
188                 v2s_all(l,m,i,j,k,iblock,iparm)=v2s(l,m,i,j,k,iblock)
189                enddo
190              enddo
191            enddo
192          enddo
193        enddo
194       enddo
195 c Store parameters of the cumulants
196       do i=-nloctyp,nloctyp
197         do j=1,2
198           b1_all(j,i,iparm)=b1(j,i)
199           b1tilde_all(j,i,iparm)=b1tilde(j,i)
200           b2_all(j,i,iparm)=b2(j,i)
201         enddo
202         do j=1,2
203           do k=1,2
204             cc_all(k,j,i,iparm)=cc(k,j,i)
205             ctilde_all(k,j,i,iparm)=ctilde(k,j,i)
206             dd_all(k,j,i,iparm)=dd(k,j,i)
207             dtilde_all(k,j,i,iparm)=dtilde(k,j,i)
208             ee_all(k,j,i,iparm)=ee(k,j,i)
209           enddo
210         enddo
211       enddo
212 c Store the parameters of electrostatic interactions
213       do i=1,2
214         do j=1,2
215           app_all(j,i,iparm)=app(j,i)
216           bpp_all(j,i,iparm)=bpp(j,i)
217           ael6_all(j,i,iparm)=ael6(j,i)
218           ael3_all(j,i,iparm)=ael3(j,i)
219         enddo
220       enddo
221 c Store sidechain parameters
222       do i=1,ntyp
223         do j=1,ntyp
224           aa_all(j,i,iparm)=aa(j,i)
225           bb_all(j,i,iparm)=bb(j,i)
226           r0_all(j,i,iparm)=r0(j,i)
227           sigma_all(j,i,iparm)=sigma(j,i)
228           chi_all(j,i,iparm)=chi(j,i)
229           augm_all(j,i,iparm)=augm(j,i)
230           eps_all(j,i,iparm)=eps(j,i)
231         enddo
232       enddo
233       do i=1,ntyp
234         chip_all(i,iparm)=chip(i)
235         alp_all(i,iparm)=alp(i)
236       enddo
237 c Store the SCp parameters
238       do i=1,ntyp
239         do j=1,2
240           aad_all(i,j,iparm)=aad(i,j)
241           bad_all(i,j,iparm)=bad(i,j)
242         enddo
243       enddo
244 c Store disulfide-bond parameters
245       ht_all(iparm)=ht
246       ss_depth_all(iparm)=ss_depth
247       ebr_all(iparm)=ebr
248       d0cm_all(iparm)=d0cm
249       akcm_all(iparm)=akcm
250       akth_all(iparm)=akth
251       akct_all(iparm)=akct
252       v1ss_all(iparm)=v1ss
253       v2ss_all(iparm)=v2ss
254       v3ss_all(iparm)=v3ss
255 c Store SC-backbone correlation parameters
256       do i=1,nsccortyp
257        do j=1,nsccortyp
258
259       nterm_sccor_all(j,i,iparm)=nterm_sccor(j,i)
260         do l=1,3
261            do k=1,nterm_sccor(j,i)
262             v1sccor_all(k,l,j,i,iparm)=v1sccor(k,l,j,i)
263             v2sccor_all(k,l,j,i,iparm)=v2sccor(k,l,j,i)
264           enddo
265          enddo
266         enddo
267       enddo
268       return
269       end
270 c--------------------------------------------------------------------------
271       subroutine restore_parm(iparm)
272 C
273 C Store parameters of set IPARM
274 C valence angles and the side chains and energy parameters.
275 C
276       implicit none
277       include 'DIMENSIONS'
278       include 'DIMENSIONS.ZSCOPT'
279       include 'DIMENSIONS.FREE'
280       include 'COMMON.IOUNITS'
281       include 'COMMON.CHAIN'
282       include 'COMMON.INTERACT'
283       include 'COMMON.GEO'
284       include 'COMMON.LOCAL'
285       include 'COMMON.TORSION'
286       include 'COMMON.FFIELD'
287       include 'COMMON.NAMES'
288       include 'COMMON.SBRIDGE'
289       include 'COMMON.SCROT'
290       include 'COMMON.SCCOR'
291       include 'COMMON.ALLPARM'
292       integer i,j,k,l,m,mm,iparm,ichir1,ichir2,iblock,iii
293
294 c Restore weights
295       wsc=ww_all(1,iparm)
296       wscp=ww_all(2,iparm)
297       welec=ww_all(3,iparm)
298       wcorr=ww_all(4,iparm)
299       wcorr5=ww_all(5,iparm)
300       wcorr6=ww_all(6,iparm)
301       wel_loc=ww_all(7,iparm)
302       wturn3=ww_all(8,iparm)
303       wturn4=ww_all(9,iparm)
304       wturn6=ww_all(10,iparm)
305       wang=ww_all(11,iparm)
306       wscloc=ww_all(12,iparm)
307       wtor=ww_all(13,iparm)
308       wtor_d=ww_all(14,iparm)
309       wstrain=ww_all(15,iparm)
310       wvdwpp=ww_all(16,iparm)
311       wbond=ww_all(17,iparm)
312       wsccor=ww_all(19,iparm)
313 c Restore bond parameters
314       vbldp0=vbldp0_all(iparm)
315       akp=akp_all(iparm)
316       do i=1,ntyp
317         nbondterm(i)=nbondterm_all(i,iparm)
318         do j=1,nbondterm(i)
319           vbldsc0(j,i)=vbldsc0_all(j,i,iparm)
320           aksc(j,i)=aksc_all(j,i,iparm)
321           abond0(j,i)=abond0_all(j,i,iparm)
322         enddo
323       enddo
324 c Restore bond angle parameters
325 #ifdef CRYST_THETA
326       do i=-ntyp,ntyp
327         a0thet(i)=a0thet_all(i,iparm)
328
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=1,ntyp1
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       ht=ht_all(iparm)
517       ss_depth=ss_depth_all(iparm) 
518       ebr=ebr_all(iparm)
519       d0cm=d0cm_all(iparm)
520       akcm=akcm_all(iparm)
521       akth=akth_all(iparm)
522       akct=akct_all(iparm)
523       v1ss=v1ss_all(iparm)
524       v2ss=v2ss_all(iparm)
525       v3ss=v3ss_all(iparm)
526 c Restore SC-backbone correlation parameters
527       do i=1,nsccortyp
528        do j=1,nsccortyp
529
530       nterm_sccor(j,i)=nterm_sccor_all(j,i,iparm)
531 c      do i=1,20
532 c        do j=1,20
533          do l=1,3
534           do k=1,nterm_sccor(j,i)
535             v1sccor(k,l,j,i)=v1sccor_all(k,l,j,i,iparm)
536             v2sccor(k,l,j,i)=v2sccor_all(k,l,j,i,iparm)
537           enddo
538          enddo
539         enddo
540       enddo
541       return
542       end