mlosch/optim_m1qn3/optim_readparms.F

C $Header: /u/gcmpack/MITgcm_contrib/mlosch/optim_m1qn3/optim_readparms.F,v 1.7 2012/05/09 18:33:38 mlosch Exp $
C $Name:  $

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