mlosch/optim_m1qn3/optim_readparms.F

C $Header: /u/gcmpack/MITgcm_contrib/mlosch/optim_m1qn3/optim_readparms.F,v 1.9 2012/05/10 16:56:33 mlosch Exp $
C $Name:  $

C     ECCO_CPPOPTIONS used to affect maxcvars and defined ALLOW_OBCS?_CONTROL
C#include "ECCO_CPPOPTIONS.h"
C     now:
C     CTRL_OPTIONS affects maxcvars and may define ALLOW_OBCS?_CONTROL
#include "CTRL_OPTIONS.h"

      subroutine optim_readparms(
     O                    nn, ff
     &                  )

c     ==================================================================
c     subroutine optim_readparms
c     ==================================================================
c
c     o Read namelist files and
c     o read the number of control variables and return it as nn
c     o read the cost function value from ctrlname and return as ff,
c       note that this value is only meaning full in the first iteration
c
c     ==================================================================

      implicit none

c     == global variables ==

#include "EEPARAMS.h"
#include "SIZE.h"
#include "ctrl.h"
#include "optim.h"

c     == routine arguments ==

      integer nn

c     == local variables ==

      integer il
      integer errio

      _RL            ff
      _RL            dfminFrac

#ifdef DYNAMIC
      _RL            vv(nn)
#else
      integer nmax
      parameter( nmax = MAX_INDEPEND )
      _RL   vv(nmax)
#endif

      character*(max_len_prec) record

c     == external ==

      integer  ilnblnk

c     == end of interface ==

      namelist /CTRL_PACKNAMES/
     &     yadmark, ctrlname, costname, scalname, maskname, metaname,
     &     yctrlid, yctrlposunpack, yctrlpospack

      namelist /OPTIM/
     &                      optimcycle,
     &                      numiter, nfunc, fmin, dfminFrac, iprint,
     &                      epsf, epsx, epsg,
     &                      nupdate, eps

      namelist /M1QN3/
     &     coldStart

c--   Preset the optimization parameters.
      optimcycle =  0
      nvars      =  0
      numiter    =  1
      nfunc      =  1
      fmin       =  UNSET_RL
      dfminFrac  =  0.0
      iprint     =  10
      epsx       =  1.e-6
      epsg       =  1.e-6
      eps        = -1.e-6
      nupdate    =  1
      ff         = 0.
cdfer      expId      = 'MIT_CE_000'
      yctrlid    = 'MIT_CE_000'
      yctrlposunpack      = '.opt'
      yctrlpospack        = '.opt'
      ctrlname            = 'ecco_ctrl'
      costname            = 'ecco_cost'
      scalname            = ' '
      maskname            = ' '
      metaname            = ' '
      coldStart  = .false.

      modeldataunit = 14
      scrunit1      = 11

c--   Read control parameters from file.
      open(unit=scrunit1,status='scratch')

      open(unit = modeldataunit,file = 'data.ctrl',
     &     status = 'old', iostat = errio)
      if ( errio .lt. 0 ) then
       stop ' stopped in optim_readparms while opening data.ctrl'
      endif

      do while ( .true. )
       read(modeldataunit, fmt='(a)', end=21) record
       il = max(ilnblnk(record),1)
       if ( record(1:1) .ne. commentcharacter )
     &      write(unit=scrunit1, fmt='(a)') record(:il)
      enddo
   21 continue
      close( modeldataunit )

      rewind( scrunit1 )
      read(unit = scrunit1, nml = ctrl_packnames)
      close( scrunit1 )
      print*, ' OPTIM_READPARMS: Control options have been read.'

c--   Read optimization parameters from file.
      open(unit=scrunit1,status='scratch')

      open(unit = modeldataunit,file = 'data.optim',
     &     status = 'old', iostat = errio)
      if ( errio .lt. 0 ) then
       stop ' stopped in optim_readparms while opening data.optim'
      endif

      do while ( .true. )
       read(modeldataunit, fmt='(a)', end=22) record
       il = max(ilnblnk(record),1)
       if ( record(1:1) .ne. commentcharacter )
     &      write(unit=scrunit1, fmt='(a)') record(:il)
      enddo
   22 continue
      close( modeldataunit )

      rewind( scrunit1 )
      read(unit = scrunit1, nml = optim)
      read(unit = scrunit1, nml = m1qn3)
      close( scrunit1 )
      print*, ' OPTIM_READPARMS: Minimization options have been read.'

      if (eps .gt. 0.0) then
        epsf = eps
        epsx = eps
        epsg = eps
      endif
c     always force cold start for the 0th cycle
      if ( optimcycle .eq. 0 ) coldStart=.true.

c     read header from costname rather than ctrlname, because the
c     cost function value in costname is what we need, ctrlname only
c     contains a valid cost function value for the 0th iteration
      call optim_readdata ( nn, costname, .true., ff, vv)
      
      if ( dfminFrac.lt.0.0 .or. dfminFrac.ge.1.0) then
       print*, ' OPTIM_READPARMS: dfminFrac = ', dfminFrac,
     &      ' should be > 0 and < 1'
       stop 'S/R OPTIM_READPARMS: ABNORMAL END'
      endif
      if ( dfminFrac.ne.0.0 ) dfminFrac = 1.0 - dfminFrac
      if ( fmin.eq.UNSET_RL ) then
       if ( coldStart ) then
c     only in this case does ff contain the actual cost function value
        fmin = dfminFrac*ff
       else
c     otherwise we (ab-)use the file ctrlname for storing fmin
        fmin = ff
       endif
      endif
      if ( coldStart ) then
       if ( fmin.le.0.0 ) then
        print '(A,E12.6,A)', ' OPTIM_READPARMS: fmin = ', fmin,
     &       ' should be > 0'
        stop 'S/R OPTIM_READPARMS: ABNORMAL END'
       endif
       if ( fmin.gt.ff ) then
        print '(A,E12.6,A,E12.6)', ' OPTIM_READPARMS: fmin = ', fmin, 
     &       ' should be < ff = ', ff
        stop 'S/R OPTIM_READPARMS: ABNORMAL END'
       endif
      endif

c--   Do some final printout.
      print*
      print*, ' OPTIM_READPARMS: Iteration number = ', optimcycle
      print*, ' number of control variables       = ', nn
      print*, ' cost function value in ', ctrlname, '  = ', ff
      if ( coldStart ) then
       print*, ' expected cost function minimum    = ', fmin
       print*, ' expected cost function decrease   = ', ff-fmin
      endif
      print '(a,4a,i4.4)', 
     &        ' Data will be read from the following file: ',
     &     ctrlname,'_',yctrlid(1:10),'.opt', optimcycle
      print*

      return
      end

CStartOfInterface
      INTEGER FUNCTION ILNBLNK( string )
C     /==========================================================\
C     | FUNCTION ILNBLNK                                         |
C     | o Find last non-blank in character string.               |
C     \==========================================================/
      IMPLICIT NONE
      CHARACTER*(*) string
CEndOfInterface
      INTEGER L, LS
C
      LS      = LEN(string)
      ILNBLNK = LS
      DO 10 L = LS, 1, -1
        IF ( string(L:L) .EQ. ' ' ) GOTO 10
         ILNBLNK = L
         GOTO 11
   10 CONTINUE
   11 CONTINUE
C
      RETURN
      END

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