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