mlosch/optim_m1qn3/optim_readparms.F

C $Header: /u/gcmpack/MITgcm_contrib/mlosch/optim_m1qn3/optim_readparms.F,v 1.8 2012/05/10 10:25:14 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'
      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.9	C $Header: /u/gcmpack/MITgcm_contrib/mlosch/optim_m1qn3/optim_readparms.F,v 1.8 2012/05/10 10:25:14 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.9	yctrlposunpack = '.opt'
89			yctrlpospack = '.opt'
90			ctrlname = 'ecco_ctrl'
91			costname = 'ecco_cost'
92			scalname = ' '
93			maskname = ' '
94			metaname = ' '
95	mlosch	1.7	coldStart = .false.
96	mlosch	1.1
97			modeldataunit = 14
98			scrunit1 = 11
99
100			c-- Read control parameters from file.
101			open(unit=scrunit1,status='scratch')
102
103			open(unit = modeldataunit,file = 'data.ctrl',
104			& status = 'old', iostat = errio)
105			if ( errio .lt. 0 ) then
106	mlosch	1.3	stop ' stopped in optim_readparms while opening data.ctrl'
107	mlosch	1.1	endif
108
109			do while ( .true. )
110			read(modeldataunit, fmt='(a)', end=21) record
111			il = max(ilnblnk(record),1)
112			if ( record(1:1) .ne. commentcharacter )
113			& write(unit=scrunit1, fmt='(a)') record(:il)
114			enddo
115			21 continue
116			close( modeldataunit )
117
118			rewind( scrunit1 )
119			read(unit = scrunit1, nml = ctrl_packnames)
120			close( scrunit1 )
121			print*, ' OPTIM_READPARMS: Control options have been read.'
122
123			c-- Read optimization parameters from file.
124			open(unit=scrunit1,status='scratch')
125
126			open(unit = modeldataunit,file = 'data.optim',
127			& status = 'old', iostat = errio)
128			if ( errio .lt. 0 ) then
129	mlosch	1.3	stop ' stopped in optim_readparms while opening data.optim'
130	mlosch	1.1	endif
131
132			do while ( .true. )
133			read(modeldataunit, fmt='(a)', end=22) record
134			il = max(ilnblnk(record),1)
135			if ( record(1:1) .ne. commentcharacter )
136			& write(unit=scrunit1, fmt='(a)') record(:il)
137			enddo
138			22 continue
139			close( modeldataunit )
140
141			rewind( scrunit1 )
142			read(unit = scrunit1, nml = optim)
143	mlosch	1.7	read(unit = scrunit1, nml = m1qn3)
144	mlosch	1.1	close( scrunit1 )
145			print*, ' OPTIM_READPARMS: Minimization options have been read.'
146
147			if (eps .gt. 0.0) then
148			epsf = eps
149			epsx = eps
150			epsg = eps
151			endif
152	mlosch	1.8	c always force cold start for the 0th cycle
153			if ( optimcycle .eq. 0 ) coldStart=.true.
154	mlosch	1.1
155	mlosch	1.8	c read header from costname rather than ctrlname, because the
156			c cost function value in costname is what we need, ctrlname only
157			c contains a valid cost function value for the 0th iteration
158			call optim_readdata ( nn, costname, .true., ff, vv)
159	mlosch	1.1
160			if ( dfminFrac.lt.0.0 .or. dfminFrac.ge.1.0) then
161			print*, ' OPTIM_READPARMS: dfminFrac = ', dfminFrac,
162			& ' should be > 0 and < 1'
163			stop 'S/R OPTIM_READPARMS: ABNORMAL END'
164			endif
165			if ( dfminFrac.ne.0.0 ) dfminFrac = 1.0 - dfminFrac
166			if ( fmin.eq.UNSET_RL ) then
167	mlosch	1.8	if ( coldStart ) then
168	mlosch	1.1	c only in this case does ff contain the actual cost function value
169			fmin = dfminFrac*ff
170			else
171			c otherwise we (ab-)use the file ctrlname for storing fmin
172			fmin = ff
173			endif
174			endif
175	mlosch	1.8	if ( coldStart ) then
176	mlosch	1.4	if ( fmin.le.0.0 ) then
177	mlosch	1.6	print '(A,E12.6,A)', ' OPTIM_READPARMS: fmin = ', fmin,
178			& ' should be > 0'
179	mlosch	1.4	stop 'S/R OPTIM_READPARMS: ABNORMAL END'
180			endif
181	mlosch	1.6	if ( fmin.gt.ff ) then
182			print '(A,E12.6,A,E12.6)', ' OPTIM_READPARMS: fmin = ', fmin,
183	mlosch	1.4	& ' should be < ff = ', ff
184			stop 'S/R OPTIM_READPARMS: ABNORMAL END'
185			endif
186	mlosch	1.2	endif
187	mlosch	1.1
188			c-- Do some final printout.
189			print*
190			print*, ' OPTIM_READPARMS: Iteration number = ', optimcycle
191			print*, ' number of control variables = ', nn
192			print*, ' cost function value in ', ctrlname, ' = ', ff
193	mlosch	1.8	if ( coldStart ) then
194			print*, ' expected cost function minimum = ', fmin
195			print*, ' expected cost function decrease = ', ff-fmin
196			endif
197	mlosch	1.1	print '(a,4a,i4.4)',
198			& ' Data will be read from the following file: ',
199			& ctrlname,'_',yctrlid(1:10),'.opt', optimcycle
200			print*
201
202			return
203			end
204
205			CStartOfInterface
206			INTEGER FUNCTION ILNBLNK( string )
207			C /==========================================================\
208			C \| FUNCTION ILNBLNK \|
209			C \| o Find last non-blank in character string. \|
210			C \==========================================================/
211			IMPLICIT NONE
212			CHARACTER() string
213			CEndOfInterface
214			INTEGER L, LS
215			C
216			LS = LEN(string)
217			ILNBLNK = LS
218			DO 10 L = LS, 1, -1
219			IF ( string(L:L) .EQ. ' ' ) GOTO 10
220			ILNBLNK = L
221			GOTO 11
222			10 CONTINUE
223			11 CONTINUE
224			C
225			RETURN
226			END
227