mlosch/optim_m1qn3/optim_readparms.F

C $Header: /u/gcmpack/MITgcm_contrib/mlosch/optim_m1qn3/optim_readparms.F,v 1.4 2012/04/27 09:45:03 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

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'

      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)
      close( scrunit1 )
      print*, ' OPTIM_READPARMS: Minimization options have been read.'

      if (eps .gt. 0.0) then
        epsf = eps
        epsx = eps
        epsg = eps
      endif

      call optim_readdata ( nn, ctrlname, .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 ( optimcycle .eq. 0 ) 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 ( optimcycle.eq.0 ) then
       if ( fmin.le.0.0 ) then
        print*, ' OPTIM_READPARMS: fmin = ', fmin, ' should be > 0'
        stop 'S/R OPTIM_READPARMS: ABNORMAL END'
       endif
       if ( fmin.lt.ff ) then
        print*, ' 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
      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.5	C $Header: /u/gcmpack/MITgcm_contrib/mlosch/optim_m1qn3/optim_readparms.F,v 1.4 2012/04/27 09:45:03 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			c-- Preset the optimization parameters.
71			optimcycle = 0
72			nvars = 0
73			numiter = 1
74			nfunc = 1
75			fmin = UNSET_RL
76			dfminFrac = 0.0
77			iprint = 10
78			epsx = 1.e-6
79			epsg = 1.e-6
80			eps = -1.e-6
81			nupdate = 1
82			ff = 0.
83			cdfer expId = 'MIT_CE_000'
84			yctrlid = 'MIT_CE_000'
85
86			modeldataunit = 14
87			scrunit1 = 11
88
89			c-- Read control parameters from file.
90			open(unit=scrunit1,status='scratch')
91
92			open(unit = modeldataunit,file = 'data.ctrl',
93			& status = 'old', iostat = errio)
94			if ( errio .lt. 0 ) then
95	mlosch	1.3	stop ' stopped in optim_readparms while opening data.ctrl'
96	mlosch	1.1	endif
97
98			do while ( .true. )
99			read(modeldataunit, fmt='(a)', end=21) record
100			il = max(ilnblnk(record),1)
101			if ( record(1:1) .ne. commentcharacter )
102			& write(unit=scrunit1, fmt='(a)') record(:il)
103			enddo
104			21 continue
105			close( modeldataunit )
106
107			rewind( scrunit1 )
108			read(unit = scrunit1, nml = ctrl_packnames)
109			close( scrunit1 )
110			print*, ' OPTIM_READPARMS: Control options have been read.'
111
112			c-- Read optimization parameters from file.
113			open(unit=scrunit1,status='scratch')
114
115			open(unit = modeldataunit,file = 'data.optim',
116			& status = 'old', iostat = errio)
117			if ( errio .lt. 0 ) then
118	mlosch	1.3	stop ' stopped in optim_readparms while opening data.optim'
119	mlosch	1.1	endif
120
121			do while ( .true. )
122			read(modeldataunit, fmt='(a)', end=22) record
123			il = max(ilnblnk(record),1)
124			if ( record(1:1) .ne. commentcharacter )
125			& write(unit=scrunit1, fmt='(a)') record(:il)
126			enddo
127			22 continue
128			close( modeldataunit )
129
130			rewind( scrunit1 )
131			read(unit = scrunit1, nml = optim)
132			close( scrunit1 )
133			print*, ' OPTIM_READPARMS: Minimization options have been read.'
134
135			if (eps .gt. 0.0) then
136			epsf = eps
137			epsx = eps
138			epsg = eps
139			endif
140
141			call optim_readdata ( nn, ctrlname, .true., ff, vv)
142
143			if ( dfminFrac.lt.0.0 .or. dfminFrac.ge.1.0) then
144			print*, ' OPTIM_READPARMS: dfminFrac = ', dfminFrac,
145			& ' should be > 0 and < 1'
146			stop 'S/R OPTIM_READPARMS: ABNORMAL END'
147			endif
148			if ( dfminFrac.ne.0.0 ) dfminFrac = 1.0 - dfminFrac
149			if ( fmin.eq.UNSET_RL ) then
150			if ( optimcycle .eq. 0 ) then
151			c only in this case does ff contain the actual cost function value
152			fmin = dfminFrac*ff
153			else
154			c otherwise we (ab-)use the file ctrlname for storing fmin
155			fmin = ff
156			endif
157			endif
158	mlosch	1.2	if ( optimcycle.eq.0 ) then
159	mlosch	1.4	if ( fmin.le.0.0 ) then
160			print*, ' OPTIM_READPARMS: fmin = ', fmin, ' should be > 0'
161			stop 'S/R OPTIM_READPARMS: ABNORMAL END'
162			endif
163			if ( fmin.lt.ff ) then
164			print*, ' OPTIM_READPARMS: fmin = ', fmin,
165			& ' should be < ff = ', ff
166			stop 'S/R OPTIM_READPARMS: ABNORMAL END'
167			endif
168	mlosch	1.2	endif
169	mlosch	1.1
170			c-- Do some final printout.
171			print*
172			print*, ' OPTIM_READPARMS: Iteration number = ', optimcycle
173			print*, ' number of control variables = ', nn
174			print*, ' cost function value in ', ctrlname, ' = ', ff
175			print '(a,4a,i4.4)',
176			& ' Data will be read from the following file: ',
177			& ctrlname,'_',yctrlid(1:10),'.opt', optimcycle
178			print*
179
180			return
181			end
182
183			CStartOfInterface
184			INTEGER FUNCTION ILNBLNK( string )
185			C /==========================================================\
186			C \| FUNCTION ILNBLNK \|
187			C \| o Find last non-blank in character string. \|
188			C \==========================================================/
189			IMPLICIT NONE
190			CHARACTER() string
191			CEndOfInterface
192			INTEGER L, LS
193			C
194			LS = LEN(string)
195			ILNBLNK = LS
196			DO 10 L = LS, 1, -1
197			IF ( string(L:L) .EQ. ' ' ) GOTO 10
198			ILNBLNK = L
199			GOTO 11
200			10 CONTINUE
201			11 CONTINUE
202			C
203			RETURN
204			END
205