/[MITgcm]/MITgcm/optim/optim_readdata.F
ViewVC logotype

Diff of /MITgcm/optim/optim_readdata.F

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

revision 1.1.2.4 by heimbach, Fri Mar 7 05:21:33 2003 UTC revision 1.13 by gforget, Tue Jun 2 14:49:13 2015 UTC
# Line 1  Line 1 
1    
2    c ECCO_CPPOPTIONS used to affect maxcvars
3    c and def ALLOW_OBCSN_CONTROL etc (OBCS masks etc)
4    c#include ECCO_CPPOPTIONS.h
5    
6    c CTRL_OPTIONS affects maxcvars and may def
7    c ALLOW_OBCSN_CONTROL etc (OBCS masks etc)
8    #include "CTRL_OPTIONS.h"
9    
10        subroutine optim_readdata(        subroutine optim_readdata(
11       I                      nn,       I                      nn,
12       I                      dfile,       I                      dfile,
# Line 33  c     == global variables == Line 41  c     == global variables ==
41    
42  #include "EEPARAMS.h"  #include "EEPARAMS.h"
43  #include "SIZE.h"  #include "SIZE.h"
 cgg   Include ECCO_CPPOPTIONS because the ecco_ctrl,cost files  
 cgg   have headers with options for OBCS masks.  
 #include "ECCO_CPPOPTIONS.h"  
   
 #include "ecco.h"  
44  #include "ctrl.h"  #include "ctrl.h"
45  #include "optim.h"  #include "optim.h"
46  #include "minimization.h"  #include "minimization.h"
# Line 75  c     == local variables == Line 78  c     == local variables ==
78        integer funit        integer funit
79    
80        integer cbuffindex        integer cbuffindex
81        _RL     cbuff( sNx*nSx*nPx*sNy*nSy*nPy )        real*4 cbuff( sNx*nSx*nPx*sNy*nSy*nPy )
82    
83        character*(128) fname        character*(128) fname
84    
85        integer         filei  c      integer         filei
86        integer         filej  c      integer         filej
87        integer         filek  c      integer         filek
88    c      integer         fileiG
89    c      integer         filejG
90    c      integer         filensx
91    c      integer         filensy
92        integer         filenopt        integer         filenopt
       integer         fileig  
       integer         filejg  
       integer         filensx  
       integer         filensy  
93        _RL             fileff        _RL             fileff
94    
95  cgg(  cgg(
# Line 97  cgg) Line 100  cgg)
100    
101  c     == end of interface ==  c     == end of interface ==
102    
103          print *, 'pathei-lsopt in optim_readdata'
104    
105  c--   The reference i/o unit.  c--   The reference i/o unit.
106        funit = 20        funit = 20
107    
# Line 129  c--   Read the data. Line 134  c--   Read the data.
134    
135  c--   Generate file name and open the file.  c--   Generate file name and open the file.
136        write(fname(1:128),'(4a,i4.4)')        write(fname(1:128),'(4a,i4.4)')
137       &     dfile,'_',expId(1:10),'.opt', nopt       &     dfile,'_',yctrlid(1:10),'.opt', nopt
138        open( funit, file   = fname,        open( funit, file   = fname,
139       &     status = 'old',       &     status = 'old',
140       &     form   = 'unformatted',       &     form   = 'unformatted',
# Line 139  c--   Generate file name and open the fi Line 144  c--   Generate file name and open the fi
144  c--   Read the header.  c--   Read the header.
145        read( funit ) nvartype        read( funit ) nvartype
146        read( funit ) nvarlength        read( funit ) nvarlength
147        read( funit ) expId        read( funit ) yctrlid
148        read( funit ) filenopt        read( funit ) filenopt
149        read( funit ) fileff        read( funit ) fileff
150        read( funit ) fileiG        read( funit ) fileiG
# Line 147  c--   Read the header. Line 152  c--   Read the header.
152        read( funit ) filensx        read( funit ) filensx
153        read( funit ) filensy        read( funit ) filensy
154    
 cph(  
       print *,'ph-opt 1 ', nvartype, nvarlength, filensx, filensy  
 cph)  
   
155        read( funit ) (nWetcGlobal(k), k=1,nr)        read( funit ) (nWetcGlobal(k), k=1,nr)
156        read( funit ) (nWetsGlobal(k), k=1,nr)        read( funit ) (nWetsGlobal(k), k=1,nr)
157        read( funit ) (nWetwGlobal(k), k=1,nr)        read( funit ) (nWetwGlobal(k), k=1,nr)
158  #ifdef ALLOW_CTRL_WETV  #ifdef ALLOW_CTRL_WETV
159        read( funit ) (nWetvGlobal(k), k=1,nr)        read( funit ) (nWetvGlobal(k), k=1,nr)
160  #endif  #endif
161    #ifdef ALLOW_SHIFWFLX_CONTROL
162          read(funit) (nWetiGlobal(k), k=1,nr)
163    c     read(funit) nWetiGlobal(1)
164    #endif
165    
166  cgg(    Add OBCS Mask information into the header section for optimization.  cgg(    Add OBCS Mask information into the header section for optimization.
167  #ifdef ALLOW_OBCSN_CONTROL  #ifdef ALLOW_OBCSN_CONTROL
# Line 184  cph( Line 189  cph(
189  cph      if (lheaderonly) then  cph      if (lheaderonly) then
190           print *, 'pathei: nvartype ', nvartype           print *, 'pathei: nvartype ', nvartype
191           print *, 'pathei: nvarlength ', nvarlength           print *, 'pathei: nvarlength ', nvarlength
192           print *, 'pathei: expId ', expId           print *, 'pathei: yctrlid ', yctrlid
193           print *, 'pathei: filenopt ', filenopt           print *, 'pathei: filenopt ', filenopt
194           print *, 'pathei: fileff ', fileff           print *, 'pathei: fileff ', fileff
195           print *, 'pathei: fileiG ', fileiG           print *, 'pathei: fileiG ', fileiG
# Line 200  cph      if (lheaderonly) then Line 205  cph      if (lheaderonly) then
205       &        (nWetwGlobal(k),  k=1,nr)       &        (nWetwGlobal(k),  k=1,nr)
206           print *, 'pathei: nWetvGlobal ',           print *, 'pathei: nWetvGlobal ',
207       &        (nWetvGlobal(k),  k=1,nr)       &        (nWetvGlobal(k),  k=1,nr)
208    #ifdef ALLOW_SHIFWFLX_CONTROL
209             print *, 'pathei: nWetiGlobal ',
210         &        (nWetiGlobal(k), k=1,nr)
211    #endif
212    #ifdef ALLOW_OBCSN_CONTROL
213             do iobcs=1,nobcs
214              print *, 'pathei: nWetobcsnGlo (iobcs=', iobcs,')',
215         &         (nWetobcsnGlo(k,iobcs), k=1,nr)
216             enddo
217    #endif
218    #ifdef ALLOW_OBCSS_CONTROL
219             do iobcs=1,nobcs
220              print *, 'pathei: nWetobcssGlo (iobcs=', iobcs,')',
221         &         (nWetobcssGlo(k,iobcs), k=1,nr)
222             enddo
223    #endif
224    #ifdef ALLOW_OBCSW_CONTROL
225             do iobcs=1,nobcs
226              print *, 'pathei: nWetobcswGlo (iobcs=', iobcs,')',
227         &         (nWetobcswGlo(k,iobcs), k=1,nr)
228             enddo
229    #endif
230    #ifdef ALLOW_OBCSE_CONTROL
231             do iobcs=1,nobcs
232              print *, 'pathei: nWetobcseGlo (iobcs=', iobcs,')',
233         &         (nWetobcseGlo(k,iobcs), k=1,nr)
234             enddo
235    #endif
236           print *, 'pathei: ncvarindex ',           print *, 'pathei: ncvarindex ',
237       &        (ncvarindex(i), i=1,maxcvars)       &        (ncvarindex(i), i=1,maxcvars)
238           print *, 'pathei: ncvarrecs ',           print *, 'pathei: ncvarrecs ',
# Line 253  ce    Add some more checks. ... Line 286  ce    Add some more checks. ...
286    
287        if (.NOT. lheaderonly) then        if (.NOT. lheaderonly) then
288  c--   Read the data.  c--   Read the data.
289           icvoffset = 0         icvoffset = 0
290           do icvar = 1,maxcvars         do icvar = 1,maxcvars
291              if ( ncvarindex(icvar) .ne. -1 ) then          if ( ncvarindex(icvar) .ne. -1 ) then
292                 do icvrec = 1,ncvarrecs(icvar)           do icvrec = 1,ncvarrecs(icvar)
293                    do bj = 1,nsy  cph          do bj = 1,nsy
294                       do bi = 1,nsx  cph           do bi = 1,nsx
295                          read( funit ) ncvarindex(icvar)              read( funit ) ncvarindex(icvar)
296                          read( funit ) filej              read( funit ) filej
297                          read( funit ) filei              read( funit ) filei
298                          do k = 1,ncvarnrmax(icvar)              do k = 1,ncvarnrmax(icvar)
299                             cbuffindex = 0               cbuffindex = 0
300                             if (ncvargrd(icvar) .eq. 'c') then               if (ncvargrd(icvar) .eq. 'c') then
301                                cbuffindex = nWetcGlobal(k)                cbuffindex = nWetcGlobal(k)
302                             else if (ncvargrd(icvar) .eq. 's') then               else if (ncvargrd(icvar) .eq. 's') then
303                                cbuffindex = nWetsGlobal(k)                cbuffindex = nWetsGlobal(k)
304                             else if (ncvargrd(icvar) .eq. 'w') then               else if (ncvargrd(icvar) .eq. 'w') then
305                                cbuffindex = nWetwGlobal(k)                cbuffindex = nWetwGlobal(k)
306                             else if (ncvargrd(icvar) .eq. 'v') then               else if (ncvargrd(icvar) .eq. 'v') then
307                                cbuffindex = nWetvGlobal(k)                cbuffindex = nWetvGlobal(k)
308    #ifdef ALLOW_SHIFWFLX_CONTROL
309                 else if (ncvargrd(icvar) .eq. 'i') then
310                  cbuffindex = nWetiGlobal(k)
311    #endif
312  cgg(   O.B. points have the grid mask "m".  cgg(   O.B. points have the grid mask "m".
313                             else if (ncvargrd(icvar) .eq. 'm') then               else if (ncvargrd(icvar) .eq. 'm') then
314  cgg    From "icvrec", calculate what iobcs must be.  cgg    From "icvrec", calculate what iobcs must be.
315                               gg   = (icvrec-1)/nobcs                gg   = (icvrec-1)/nobcs
316                               igg  = int(gg)                igg  = int(gg)
317                               iobcs= icvrec - igg*nobcs                iobcs= icvrec - igg*nobcs
318  #ifdef ALLOW_OBCSN_CONTROL  #ifdef ALLOW_OBCSN_CONTROL
319                               if (icvar .eq. 11) then                                    if (icvar .eq. 11) then                    
320                                 cbuffindex = nWetobcsnGlo(k,iobcs)                 cbuffindex = nWetobcsnGlo(k,iobcs)
321                               endif                endif
322  #endif  #endif
323  #ifdef ALLOW_OBCSS_CONTROL  #ifdef ALLOW_OBCSS_CONTROL
324                               if (icvar .eq. 12) then                if (icvar .eq. 12) then
325                                 cbuffindex = nWetobcssGlo(k,iobcs)                 cbuffindex = nWetobcssGlo(k,iobcs)
326                               endif                endif
327  #endif  #endif
328  #ifdef ALLOW_OBCSW_CONTROL  #ifdef ALLOW_OBCSW_CONTROL
329                               if (icvar .eq. 13) then                if (icvar .eq. 13) then
330                                 cbuffindex = nWetobcswGlo(k,iobcs)                 cbuffindex = nWetobcswGlo(k,iobcs)
331                               endif                endif
332  #endif  #endif
333  #ifdef ALLOW_OBCSE_CONTROL  #ifdef ALLOW_OBCSE_CONTROL
334                               if (icvar .eq. 14) then                if (icvar .eq. 14) then
335                                 cbuffindex = nWetobcseGlo(k,iobcs)                 cbuffindex = nWetobcseGlo(k,iobcs)
336                               endif                endif
337  #endif  #endif
338  cgg)  cgg)
339                             endif               endif
340                             if (cbuffindex .gt. 0) then               if ( icvoffset + cbuffindex .gt. nvarlength ) then
341                                read( funit ) cbuffindex                print*
342                                read( funit ) filek                print *, ' ERROR:'
343                                read( funit ) (cbuff(ii), ii=1,cbuffindex)                print *, ' There are at least ', icvoffset+cbuffindex,
344                                do icvcomp = 1,cbuffindex       &             ' records in '//fname(1:28)//'.'
345                                   vv(icvoffset+icvcomp) = cbuff(icvcomp)                print *, ' This is more than expected from nvarlength =',
346  cgg( Right now, the changes to the open boundary velocities are not balanced.       &             nvarlength, '.'
347  cgg( The model will crash due to physical reasons.                print *, ' Something is wrong in the computation of '//
348  cgg( However, we can optimize with respect to just O.B. T and S if the       &             'the wet points or'
349  cgg( next two lines are uncommented.                print *, ' in computing the number of records in '//
350  cgg                         if (iobcs .eq. 3) vv(icvoffset+icvcomp)=0.       &             'some variable(s).'
351  cgg                         if (iobcs .eq. 4) vv(icvoffset+icvcomp)=0.                print *, '  ...  stopped in OPTIM_READDATA.'
352                                enddo                stop     '  ...  stopped in OPTIM_READDATA.'
353                                icvoffset = icvoffset + cbuffindex               endif
354                             endif               if (cbuffindex .gt. 0) then
355                          enddo                read( funit ) cbuffindex
356                       enddo                read( funit ) filek
357                    enddo                read( funit ) (cbuff(ii), ii=1,cbuffindex)
358                 enddo                do icvcomp = 1,cbuffindex
359              endif                 vv(icvoffset+icvcomp) = cbuff(icvcomp)
360    c     If you want to optimize with respect to just O.B. T and S
361    c     uncomment the next two lines.
362    c              if (iobcs .eq. 3) vv(icvoffset+icvcomp)=0.
363    c              if (iobcs .eq. 4) vv(icvoffset+icvcomp)=0.
364                  enddo
365                  icvoffset = icvoffset + cbuffindex
366                 endif
367                enddo
368    cph           enddo
369    cph          enddo
370           enddo           enddo
371            endif
372           enddo
373            
374        else        else
375    
376  c--   Assign the number of control variables.  c--   Assign the number of control variables.
377           nn = nvarlength         nn = nvarlength
378                    
379        endif        endif
380    
# Line 334  c--   Assign the number of control varia Line 383  c--   Assign the number of control varia
383  c--   Assign the cost function value in case we read the cost file.  c--   Assign the cost function value in case we read the cost file.
384    
385        if      ( dfile .eq. ctrlname ) then        if      ( dfile .eq. ctrlname ) then
386          ff = 0. d 0         ff = 0. d 0
387        else if ( dfile .eq. costname ) then        else if ( dfile .eq. costname ) then
388          ff = fileff         ff = fileff
389        endif        endif
390    
391        return        return
Legend:
Removed from v.1.1.2.4  
changed lines
  Added in v.1.13
  ViewVC Help
Powered by ViewVC 1.1.22