source: minim.f@ 32289cd

Last change on this file since 32289cd was 2019dff, checked in by baerbaer <baerbaer@…>, 14 years ago

Explicitly declare variables.

git-svn-id: svn+ssh://svn.berlios.de/svnroot/repos/smmp/trunk@27 26dc1dd8-5c4e-0410-9ffe-d298b4865968

  • Property mode set to 100644
File size: 7.8 KB
Line 
1! **************************************************************
2!
3! This file contains the subroutines: minim,move
4!
5! Copyright 2003-2005 Frank Eisenmenger, U.H.E. Hansmann,
6! Shura Hayryan, Chin-Ku
7! Copyright 2007 Frank Eisenmenger, U.H.E. Hansmann,
8! Jan H. Meinke, Sandipan Mohanty
9!
10! **************************************************************
11
12
13 subroutine minim(imin, maxit, eps)
14
15! ......................................................................
16! PURPOSE: Use minimizers
17!
18! imin = 1: use Quasi-Newton
19! imin = 2: use Conjugated Gradients
20!
21! @param maxit maximum number of iterations
22! @param eps acceptance criterium
23!Institute
24! CALLS: difang,energy,gradient, mincjg,minqsn, nursvr
25! ......................................................................
26
27 include 'INCL.H'
28!f2py intent(in) imin
29!f2py intent(in) maxit
30!f2py intent(in) eps
31 integer msvmx
32
33 integer imin
34
35 integer maxit
36
37 integer nursvr
38 double precision energy, difang
39
40 integer ngbvr, msv, i, j, mxop, n6, n3, n, n1, n2, n5, n4
41 integer ntlvr, nop, nv
42
43 double precision eps, acc, esm, gdey2, gbpro, gdvr, gdrg2, scl
44 double precision vlvrn, w, vlvro, vr
45
46 parameter (msvmx=mxvr*(mxvr+5)/(2*(2*mxvr+1)),
47 & msv = 50 )
48
49 dimension w(mxvr*(mxvr+13)/2)
50
51 dimension vlvrn(mxvr),vlvro(mxvr),gdvr(mxvr),scl(mxvr)
52
53! --------------------------- new
54 dimension gbpro(6,mxml)
55
56 mxop=maxit
57 acc=eps
58
59 if (msv.gt.msvmx) then
60 write (*,'(a,i5)') ' minreg> parameter MSV > ',msvmx
61 stop
62 endif
63
64! ----------------------- energy & gradient
65
66 call gradient()
67
68 write(*,'(/,a,/)') ' Energy BEFORE minimization:'
69
70 if (ireg.eq.0) then
71
72 write (*,'(a,e12.5,/,3(a,e11.4),/,2(a,e11.4),/)') ' Total: ',
73 & eysm,
74 & ' Coulomb: ',eyel,' Lennard-Jones: ',eyvw,' HB: ',eyhb,
75 & ' Variables: ',eyvr,' Solvatation: ',eysl
76
77 else
78
79
80 write (*,'(a,e12.5,/,3(a,e11.4),/,3(a,e11.4),/)') ' Total: ',
81 & wtey*eysm + wtrg*eyrg,
82 & ' Coulomb: ',eyel,' Lennard-Jones: ',eyvw,' HB: ',eyhb,
83 & ' Variables: ',eyvr,' Solvatation: ',eysl,
84 & ' Regularization: ',eyrg
85
86 endif
87
88! --------------------------------------- variables
89
90 ntlvr=ivrml1(ntlml)+nvrml(ntlml)-1
91 nv=0
92
93 gdey2=0.d0
94 gdrg2=0.d0
95
96 do i=1,ntlvr
97 if (.not.fxvr(i)) then
98
99 nv=nv+1
100
101 vlvrn(nv) = vlvr(i)
102
103 scl(nv) = 1.d0 ! scale grad_i
104
105 if (ireg.eq.0) then
106 gdvr(nv) = gdeyvr(i)
107 else
108 gdvr(nv) = wtey*gdeyvr(i)+wtrg*gdeyrg(i)
109 gdrg2 = gdrg2+gdeyrg(i)**2
110 endif
111
112 gdey2=gdey2+gdeyvr(i)**2
113
114 endif
115
116 vlvro(i)=vlvr(i)
117 enddo
118
119 n=nv
120
121 if (ireg.eq.0) then
122
123 esm=eysm
124
125 else
126
127 ngbvr=0
128
129 do i=1,ntlml
130 do j=1,6
131
132 n=n+1
133 ngbvr=ngbvr+1
134
135 vlvrn(n) = gbpr(j,i)
136 scl(n) = 1.d0 ! Scale
137
138 gbpro(j,i) = gbpr(j,i) ! save
139
140 gdvr(n) = wtrg*gdeygb(ngbvr)
141
142 gdrg2=gdrg2+gdeygb(ngbvr)**2
143 enddo
144 enddo
145
146! if (abs(wtrg-1.d0).gt.1.d-4.and.abs(wtey-1.d0).gt.1.d-4) then
147! gdey2 = max(acc,gdey2)
148! gdrg2 = max(acc,gdrg2)
149! wtrg = wtrg * sqrt(gdey2/gdrg2)
150! write(*,*) ' --> Wt_energy = ',wtey,' Wt_regul. = ',wtrg
151! write(*,*) ' '
152! endif
153
154 esm=wtey*eysm+wtrg*eyrg
155
156 endif
157
158
159 if (imin.eq.1) then ! Quasi-Newton
160
161 n1=1+(n*(n+1))/2
162 n2=n1+n
163 n3=n2+n
164 n4=n3+n
165 n5=n4+n
166 n6=n5+n
167
168 call minqsn(n,mxvr,vlvrn,esm,gdvr,scl,acc,w,w(n1),w(n2),
169 & w(n3),w(n4),w(n5),w(n6),mxop,nop)
170
171 elseif (imin.eq.2) then ! Conjugated Gradients
172
173 n1=1+n
174 n2=n1+n
175 n3=n2+n
176 n4=n3+n
177 n5=n4+n
178
179 call mincjg(n,mxvr,vlvrn,esm,gdvr,acc,w,w(n1),w(n2), ! no 'scl'
180 & w(n3),w(n4),w(n5),mxop,nop)
181
182 endif
183
184
185 if (nop.lt.mxop) then
186 write (*,'(a)') ' ---- CONVERGENCE ----'
187 else
188 write (*,'(a)') '---- STEP LIMIT ----'
189 endif
190
191
192 write (*,'(/,2a,/)') ' Final energies ',
193 & '__________________________________________________'
194
195 eysm = energy()
196
197 if (ireg.eq.0) then
198
199 write (*,'(a,e12.5,/,3(a,e11.4),/,2(a,e11.4))') ' Total: ',eysm,
200 & ' Coulomb: ',eyel,' Lennard-Jones: ',eyvw,' HB: ',eyhb,
201 & ' Variables: ',eyvr,' Solvatation: ',eysl
202
203 else
204
205 write (*,'(a,e12.5,/,3(a,e11.4),/,3(a,e11.4))') ' Total: ',
206 & wtey*eysm + wtrg*eyrg,
207 & ' Coulomb: ',eyel,' Lennard-Jones: ',eyvw,' HB: ',eyhb,
208 & ' Variables: ',eyvr,' Solvatation: ',eysl,
209 & ' Regularization: ',eyrg
210
211 endif
212
213 write (*,'(/,a,/)') ' Variables _________________'
214
215 nv = 0
216 do i=1,ntlvr !! nvr
217 if (.not.fxvr(i)) then
218
219 nv=nv+1
220 vr=vlvrn(nv)
221 if (abs(vr).gt.pi) vr=vr-sign(pi2,vr)
222
223 write (*,'(1x,a,1x,i4,f8.1,a,f5.1,a)') nmvr(i),nursvr(i),
224 & vr*crd,' (',abs(difang(vr,vlvro(i)))*crd,')'
225
226 vlvr(i) = vr
227 endif
228 enddo
229
230
231 if (ireg.ne.0) then
232
233 write (*,'(/,a,/)') ' Global Variables ___________'
234
235 do i=1,ntlml
236 write(*,*) ' Molecule #',i,' old new'
237 do j=1,3
238 write(*,*) gbpro(j,i),' ',gbpr(j,i)
239 enddo
240 do j=4,6
241 write(*,*) gbpro(j,i)*crd,' ',gbpr(j,i)*crd
242 enddo
243 enddo
244
245 endif
246
247 write (*,'(/,2a)') ' Gradient ',
248 & '______________________________________________________________'
249
250 write (*,'(8(1x,f8.3))') (gdvr(i),i=1,nv)
251
252 if (ireg.ne.0) then
253
254 write (*,*) ' -------------- global variables ------------'
255 write (*,'(6(1x,f8.3))') (gdvr(i+nv),i=1,ngbvr)
256
257 endif
258
259 return
260 end
261! ********************************************
262 subroutine move(nop,nvr1,esm,vlvrn,gdvr)
263!
264! CALLS: gradient
265!
266 include 'INCL.H'
267 integer ngbvr
268
269 integer nop
270
271 integer nvr1
272
273 double precision esm
274
275 double precision vlvrn
276
277 double precision gdvr, gdsmey, gdsmrg
278
279 integer i, ii, j, ntlvr, n
280
281 dimension vlvrn(mxvr),gdvr(mxvr)
282
283
284! ------------------------ compile & new variables
285
286 ntlvr=ivrml1(ntlml)+nvrml(ntlml)-1
287 n=0
288
289 do i=1,ntlvr
290 if (.not.fxvr(i)) then
291 n=n+1
292 vlvr(i)=vlvrn(n)
293 endif
294 enddo
295
296 if (ireg.ne.0) then
297
298 ii=0
299 do i=1,ntlml
300 do j=1,6 ! global vars.
301 ii=ii+1
302 gbpr(j,i)=vlvrn(ii+n)
303 enddo
304 enddo
305
306 endif
307
308! -------------------------- new minimz. gradient
309
310 call gradient()
311
312 gdsmey=0.d0
313 gdsmrg=0.d0
314
315 n=0
316
317 do i=1,ntlvr
318 if (.not.fxvr(i)) then
319 n=n+1
320
321 if (ireg.eq.0) then
322 gdvr(n) = gdeyvr(i)
323 else
324 gdvr(n) = wtey*gdeyvr(i) + wtrg*gdeyrg(i)
325 gdsmrg = gdsmrg + gdeyrg(i)**2
326 endif
327
328 gdsmey = gdsmey + gdeyvr(i)**2
329
330 endif
331 enddo
332
333
334 if (ireg.eq.0) then
335
336 esm=eysm
337
338 write (*,'(a,i5,a,2(e13.6,a))') ' Step ',nop,': energy ',esm
339 & ,' (',gdsmey,' )'
340
341 else
342
343 ii=0
344 do i=1,ntlml ! global vars.
345 do j=1,6
346 n=n+1
347 ii=ii+1
348
349 gdvr(n) = wtrg*gdeygb(ii)
350 gdsmrg = gdsmrg+gdeygb(ii)**2
351
352 enddo
353 enddo
354
355 esm=wtey*eysm+wtrg*eyrg
356
357 write (*,'(a,i5,a,3(e13.6,a))') ' Step ',nop,': energy ',esm
358 & ,' (',gdsmey,',',gdsmrg,' )'
359
360 endif
361
362 return
363 end
364
Note: See TracBrowser for help on using the repository browser.