/[MITgcm]/MITgcm_contrib/mlosch/optim_m1qn3/optim_readparms.F
ViewVC logotype

Contents of /MITgcm_contrib/mlosch/optim_m1qn3/optim_readparms.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph


Revision 1.12 - (show annotations) (download)
Thu May 3 11:26:05 2018 UTC (2 years ago) by mlosch
Branch: MAIN
CVS Tags: HEAD
Changes since 1.11: +2 -2 lines
spring cleaning

- adjust some debugging output
- reduce amount of output
- code cleaning (mainly indentation) for better readability

1 C $Header: /u/gcmpack/MITgcm_contrib/mlosch/optim_m1qn3/optim_readparms.F,v 1.11 2016/05/09 09:37:17 mlosch Exp $
2 C $Name: $
3
4 C ECCO_CPPOPTIONS used to affect maxcvars and defined ALLOW_OBCS?_CONTROL
5 C#include "ECCO_CPPOPTIONS.h"
6 C now:
7 C CTRL_OPTIONS affects maxcvars and may define ALLOW_OBCS?_CONTROL
8 #include "CTRL_OPTIONS.h"
9
10 subroutine optim_readparms(
11 O nn, ff
12 & )
13
14 c ==================================================================
15 c subroutine optim_readparms
16 c ==================================================================
17 c
18 c o Read namelist files and
19 c o read the number of control variables and return it as nn
20 c o read the cost function value from ctrlname and return as ff,
21 c note that this value is only meaning full in the first iteration
22 c
23 c ==================================================================
24
25 implicit none
26
27 c == global variables ==
28
29 #include "EEPARAMS.h"
30 #include "SIZE.h"
31 #if (defined (ALLOW_GENARR2D_CONTROL) || defined (ALLOW_GENARR3D_CONTROL) || defined (ALLOW_GENTIM2D_CONTROL))
32 # include "CTRL_SIZE.h"
33 #endif
34 #include "ctrl.h"
35 #include "optim.h"
36
37 c == routine arguments ==
38
39 integer nn
40
41 c == local variables ==
42
43 integer il
44 integer errio
45
46 _RL ff
47 _RL dfminFrac
48
49 #ifdef DYNAMIC
50 _RL vv(nn)
51 #else
52 integer nmax
53 parameter( nmax = MAX_INDEPEND )
54 _RL vv(nmax)
55 #endif
56
57 character*(max_len_prec) record
58
59 c == external ==
60
61 integer ilnblnk
62
63 c == end of interface ==
64
65 namelist /CTRL_PACKNAMES/
66 & yadmark, ctrlname, costname, scalname, maskname, metaname,
67 & yctrlid, yctrlposunpack, yctrlpospack
68
69 namelist /OPTIM/
70 & optimcycle,
71 & numiter, nfunc, fmin, dfminFrac, iprint,
72 & epsf, epsx, epsg,
73 & nupdate, eps
74
75 namelist /M1QN3/
76 & coldStart
77
78 c-- Preset the optimization parameters.
79 optimcycle = 0
80 nvars = 0
81 numiter = 1
82 nfunc = 1
83 fmin = UNSET_RL
84 dfminFrac = 0.0
85 iprint = 10
86 epsx = 1.e-6
87 epsg = 1.e-6
88 eps = -1.e-6
89 nupdate = 1
90 ff = 0.
91 cdfer expId = 'MIT_CE_000'
92 yctrlid = 'MIT_CE_000'
93 yctrlposunpack = '.opt'
94 yctrlpospack = '.opt'
95 ctrlname = 'ecco_ctrl'
96 costname = 'ecco_cost'
97 scalname = ' '
98 maskname = ' '
99 metaname = ' '
100 coldStart = .false.
101
102 modeldataunit = 14
103 scrunit1 = 11
104
105 c-- Read control parameters from file.
106 open(unit=scrunit1,status='scratch')
107
108 open(unit = modeldataunit,file = 'data.ctrl',
109 & status = 'old', iostat = errio)
110 if ( errio .lt. 0 ) then
111 stop ' stopped in optim_readparms while opening data.ctrl'
112 endif
113
114 do while ( .true. )
115 read(modeldataunit, fmt='(a)', end=21) record
116 il = max(ilnblnk(record),1)
117 if ( record(1:1) .ne. commentcharacter )
118 & write(unit=scrunit1, fmt='(a)') record(:il)
119 enddo
120 21 continue
121 close( modeldataunit )
122
123 rewind( scrunit1 )
124 read(unit = scrunit1, nml = ctrl_packnames)
125 close( scrunit1 )
126 print*, ' OPTIM_READPARMS: Control options have been read.'
127
128 c-- Read optimization parameters from file.
129 open(unit=scrunit1,status='scratch')
130
131 open(unit = modeldataunit,file = 'data.optim',
132 & status = 'old', iostat = errio)
133 if ( errio .lt. 0 ) then
134 stop ' stopped in optim_readparms while opening data.optim'
135 endif
136
137 do while ( .true. )
138 read(modeldataunit, fmt='(a)', end=22) record
139 il = max(ilnblnk(record),1)
140 if ( record(1:1) .ne. commentcharacter )
141 & write(unit=scrunit1, fmt='(a)') record(:il)
142 enddo
143 22 continue
144 close( modeldataunit )
145
146 rewind( scrunit1 )
147 read(unit = scrunit1, nml = optim)
148 read(unit = scrunit1, nml = m1qn3)
149 close( scrunit1 )
150 print*, ' OPTIM_READPARMS: Minimization options have been read.'
151
152 if (eps .gt. 0.0) then
153 epsf = eps
154 epsx = eps
155 epsg = eps
156 endif
157 c always force cold start for the 0th cycle
158 if ( optimcycle .eq. 0 ) coldStart=.true.
159
160 c read header from costname rather than ctrlname, because the
161 c cost function value in costname is what we need, ctrlname only
162 c contains a valid cost function value for the 0th iteration
163 call optim_readdata ( nn, costname, .true., ff, vv)
164
165 if ( dfminFrac.lt.0.0 .or. dfminFrac.ge.1.0) then
166 print*, ' OPTIM_READPARMS: dfminFrac = ', dfminFrac,
167 & ' should be > 0 and < 1'
168 stop 'S/R OPTIM_READPARMS: ABNORMAL END'
169 endif
170 if ( dfminFrac.ne.0.0 ) dfminFrac = 1.0 - dfminFrac
171 if ( fmin.eq.UNSET_RL ) then
172 if ( coldStart ) then
173 c only in this case does ff contain the actual cost function value
174 fmin = dfminFrac*ff
175 else
176 c otherwise we (ab-)use the file ctrlname for storing fmin
177 fmin = ff
178 endif
179 endif
180 if ( coldStart ) then
181 if ( fmin.le.0.0 ) then
182 print '(A,E12.6,A)', ' OPTIM_READPARMS: fmin = ', fmin,
183 & ' should be > 0'
184 stop 'S/R OPTIM_READPARMS: ABNORMAL END'
185 endif
186 if ( fmin.gt.ff ) then
187 print '(A,E12.6,A,E12.6)', ' OPTIM_READPARMS: fmin = ', fmin,
188 & ' should be < ff = ', ff
189 stop 'S/R OPTIM_READPARMS: ABNORMAL END'
190 endif
191 endif
192
193 c-- Do some final printout.
194 print*
195 print*, ' OPTIM_READPARMS: Iteration number = ', optimcycle
196 print*, ' number of control variables = ', nn
197 print*, ' cost function value in ', ctrlname, ' = ', ff
198 if ( coldStart ) then
199 print*, ' expected cost function minimum = ', fmin
200 print*, ' expected cost function decrease = ', ff-fmin
201 endif
202 print '(a,4a,i4.4)',
203 & ' Data will be read from the following file: ',
204 & ctrlname,'_',yctrlid(1:10),'.opt', optimcycle
205 print*
206
207 return
208 end
209
210 CStartOfInterface
211 INTEGER FUNCTION ILNBLNK( string )
212 C /==========================================================\
213 C | FUNCTION ILNBLNK |
214 C | o Find last non-blank in character string. |
215 C \==========================================================/
216 IMPLICIT NONE
217 CHARACTER*(*) string
218 CEndOfInterface
219 INTEGER L, LS
220 C
221 LS = LEN(string)
222 ILNBLNK = LS
223 DO 10 L = LS, 1, -1
224 IF ( string(L:L) .EQ. ' ' ) GOTO 10
225 ILNBLNK = L
226 GOTO 11
227 10 CONTINUE
228 11 CONTINUE
229 C
230 RETURN
231 END
232

  ViewVC Help
Powered by ViewVC 1.1.22