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

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

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


Revision 1.11 - (hide annotations) (download)
Mon May 9 09:37:17 2016 UTC (7 years, 10 months ago) by mlosch
Branch: MAIN
Changes since 1.10: +4 -1 lines
add CTRL_SIZE.h if ALLOW_GENARR2D_CONTROL, ALLOW_GENARR3D_CONTROL, or
ALLOW_GENTIM2D_CONTROL is defined, so that it compiles in that case, too

1 mlosch 1.11 C $Header: /u/gcmpack/MITgcm_contrib/mlosch/optim_m1qn3/optim_readparms.F,v 1.10 2015/06/02 16:17:08 mlosch Exp $
2 mlosch 1.2 C $Name: $
3 mlosch 1.1
4 mlosch 1.10 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 mlosch 1.1
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 mlosch 1.11 #if (defined (ALLOW_GENARR2D_CONTROL) || defined (ALLOW_GENARR3D_CONTROL) || defined (ALLOW_GENTIM2D_CONTROL))
32     # include "CTRL_SIZE.h"
33     #endif
34 mlosch 1.1 #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 mlosch 1.5 #ifdef DYNAMIC
50 mlosch 1.1 _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 mlosch 1.7 namelist /M1QN3/
76     & coldStart
77    
78 mlosch 1.1 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 mlosch 1.9 yctrlposunpack = '.opt'
94     yctrlpospack = '.opt'
95     ctrlname = 'ecco_ctrl'
96     costname = 'ecco_cost'
97     scalname = ' '
98     maskname = ' '
99     metaname = ' '
100 mlosch 1.7 coldStart = .false.
101 mlosch 1.1
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 mlosch 1.3 stop ' stopped in optim_readparms while opening data.ctrl'
112 mlosch 1.1 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 mlosch 1.3 stop ' stopped in optim_readparms while opening data.optim'
135 mlosch 1.1 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 mlosch 1.7 read(unit = scrunit1, nml = m1qn3)
149 mlosch 1.1 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 mlosch 1.8 c always force cold start for the 0th cycle
158     if ( optimcycle .eq. 0 ) coldStart=.true.
159 mlosch 1.1
160 mlosch 1.8 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 mlosch 1.1
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 mlosch 1.8 if ( coldStart ) then
173 mlosch 1.1 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 mlosch 1.8 if ( coldStart ) then
181 mlosch 1.4 if ( fmin.le.0.0 ) then
182 mlosch 1.6 print '(A,E12.6,A)', ' OPTIM_READPARMS: fmin = ', fmin,
183     & ' should be > 0'
184 mlosch 1.4 stop 'S/R OPTIM_READPARMS: ABNORMAL END'
185     endif
186 mlosch 1.6 if ( fmin.gt.ff ) then
187     print '(A,E12.6,A,E12.6)', ' OPTIM_READPARMS: fmin = ', fmin,
188 mlosch 1.4 & ' should be < ff = ', ff
189     stop 'S/R OPTIM_READPARMS: ABNORMAL END'
190     endif
191 mlosch 1.2 endif
192 mlosch 1.1
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 mlosch 1.8 if ( coldStart ) then
199     print*, ' expected cost function minimum = ', fmin
200     print*, ' expected cost function decrease = ', ff-fmin
201     endif
202 mlosch 1.1 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