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

Diff of /MITgcm/optim/optim_writedata.F

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

revision 1.3 by heimbach, Fri Dec 6 01:42:25 2002 UTC revision 1.11 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_writedata(        subroutine optim_writedata(
10       I                       nn,       I                       nn,
11       I                       dfile,       I                       dfile,
# Line 30  c     == global variables == Line 37  c     == global variables ==
37    
38  #include "EEPARAMS.h"  #include "EEPARAMS.h"
39  #include "SIZE.h"  #include "SIZE.h"
 cgg   Include ECCO_CPPOPTIONS because the ecco_ctrl,cost files have headers with  
 cgg   options for OBCS masks.  
 #include "ECCO_CPPOPTIONS.h"  
   
 #include "ecco.h"  
40  #include "ctrl.h"  #include "ctrl.h"
41  #include "optim.h"  #include "optim.h"
42  #include "minimization.h"  #include "minimization.h"
# Line 62  c     == local variables == Line 64  c     == local variables ==
64        integer funit        integer funit
65        integer cbuffindex        integer cbuffindex
66    
67        _RL     cbuff( sNx*nSx*nPx*sNy*nSy*nPy )        real*4 cbuff( sNx*nSx*nPx*sNy*nSy*nPy )
68    
69        character*(128) fname        character*(128) fname
70  cgg(  cgg(
# Line 97  c--   Next optimization cycle. Line 99  c--   Next optimization cycle.
99    
100  c--         Generate file name and open the file.  c--         Generate file name and open the file.
101        write(fname(1:128),'(4a,i4.4)')        write(fname(1:128),'(4a,i4.4)')
102       &     dfile,'_',expId(1:10),'.opt', nopt       &     dfile,'_',yctrlid(1:10),'.opt', nopt
103        open( funit, file   = fname,        open( funit, file   = fname,
104       &     status = 'new',       &     status = 'new',
105       &     form   = 'unformatted',       &     form   = 'unformatted',
# Line 106  c--         Generate file name and open Line 108  c--         Generate file name and open
108  cph(  cph(
109           print *, 'pathei: nvartype ', nvartype           print *, 'pathei: nvartype ', nvartype
110           print *, 'pathei: nvarlength ', nvarlength           print *, 'pathei: nvarlength ', nvarlength
111           print *, 'pathei: expId ', expId           print *, 'pathei: yctrlid ', yctrlid
112           print *, 'pathei: nopt ', nopt           print *, 'pathei: nopt ', nopt
113           print *, 'pathei: ff ', ff           print *, 'pathei: ff ', ff
114           print *, 'pathei: iG ', biG           print *, 'pathei: iG ', biG
# Line 139  cph) Line 141  cph)
141  c--   Write the header.  c--   Write the header.
142        write( funit ) nvartype        write( funit ) nvartype
143        write( funit ) nvarlength        write( funit ) nvarlength
144        write( funit ) expId        write( funit ) yctrlid
145        write( funit ) optimcycle        write( funit ) optimcycle
146        write( funit ) ff        write( funit ) ff
147        write( funit ) big        write( funit ) big
# Line 149  c--   Write the header. Line 151  c--   Write the header.
151        write( funit ) (nWetcGlobal(k), k=1,nr)        write( funit ) (nWetcGlobal(k), k=1,nr)
152        write( funit ) (nWetsGlobal(k), k=1,nr)        write( funit ) (nWetsGlobal(k), k=1,nr)
153        write( funit ) (nWetwGlobal(k), k=1,nr)        write( funit ) (nWetwGlobal(k), k=1,nr)
154    #ifdef ALLOW_CTRL_WETV
155        write( funit ) (nWetvGlobal(k), k=1,nr)        write( funit ) (nWetvGlobal(k), k=1,nr)
156    #endif
157    #ifdef ALLOW_SHIFWFLX_CONTROL
158          write(funit) (nWetiGlobal(k),   k=1,nr)
159    c     write(funit) nWetiGlobal(1)
160    #endif
161    
162  cgg(    Add OBCS Mask information into the header section for optimization.  cgg(    Add OBCS Mask information into the header section for optimization.
163  #ifdef ALLOW_OBCSN_CONTROL  #ifdef ALLOW_OBCSN_CONTROL
# Line 179  c--         Write the data. Line 187  c--         Write the data.
187        do icvar = 1,maxcvars        do icvar = 1,maxcvars
188           if ( ncvarindex(icvar) .ne. -1 ) then           if ( ncvarindex(icvar) .ne. -1 ) then
189              do icvrec = 1,ncvarrecs(icvar)              do icvrec = 1,ncvarrecs(icvar)
190  cph(  cph               do bj = 1,nsy
191                 print *,'in owd: icvar, icvrec, ncvarrecs, ncvarindex',  cph                  do bi = 1,nsx
      &              icvar, icvrec, ncvarrecs(icvar), ncvarindex(icvar)  
 cph)  
                do bj = 1,nsy  
                   do bi = 1,nsx  
192                       write( funit ) ncvarindex(icvar)                       write( funit ) ncvarindex(icvar)
193                       write( funit ) bj                       write( funit ) bj
194                       write( funit ) bi                       write( funit ) bi
# Line 198  cph) Line 202  cph)
202                             cbuffindex = nWetwGlobal(k)                             cbuffindex = nWetwGlobal(k)
203                          else if (ncvargrd(icvar) .eq. 'v') then                          else if (ncvargrd(icvar) .eq. 'v') then
204                             cbuffindex = nWetvGlobal(k)                             cbuffindex = nWetvGlobal(k)
205    #ifdef ALLOW_SHIFWFLX_CONTROL
206                            else if (ncvargrd(icvar) .eq. 'i') then
207                               cbuffindex = nWetiGlobal(k)
208    #endif
209  cgg(   O.B. points have the grid mask "m".  cgg(   O.B. points have the grid mask "m".
210                          else if (ncvargrd(icvar) .eq. 'm') then                          else if (ncvargrd(icvar) .eq. 'm') then
211  cgg    From "icvrec", calculate what iobcs must be.  cgg    From "icvrec", calculate what iobcs must be.
# Line 230  cgg) Line 237  cgg)
237                          if (cbuffindex .gt. 0) then                          if (cbuffindex .gt. 0) then
238                             do icvcomp = 1,cbuffindex                             do icvcomp = 1,cbuffindex
239                                cbuff(icvcomp) = vv(icvoffset + icvcomp)                                cbuff(icvcomp) = vv(icvoffset + icvcomp)
240  cgg( Right now, the changes to the open boundary velocities are not balanced.  c     If you want to optimize with respect to just O.B. T and S
241  cgg( The model will crash due to physical reasons.  c     uncomment the next two lines.
242  cgg( However, we can optimize with respect to just O.B. T and S if the  c                              if (iobcs .eq. 3) cbuff(icvcomp)=0.
243  cgg( next two lines are uncommented.  c                              if (iobcs .eq. 4) cbuff(icvcomp)=0.
 cgg                              if (iobcs .eq. 3) cbuff(icvcomp)=0.  
 cgg                              if (iobcs .eq. 4) cbuff(icvcomp)=0.  
244                             enddo                             enddo
245                             write( funit ) cbuffindex                             write( funit ) cbuffindex
246                             write( funit ) k                             write( funit ) k
# Line 243  cgg                              if (iob Line 248  cgg                              if (iob
248                             icvoffset = icvoffset + cbuffindex                             icvoffset = icvoffset + cbuffindex
249                          endif                          endif
250                       enddo                       enddo
251                    enddo  cph                  enddo
252                 enddo  cph               enddo
253              enddo              enddo
254           endif           endif
255        enddo        enddo

Legend:
Removed from v.1.3  
changed lines
  Added in v.1.11

  ViewVC Help
Powered by ViewVC 1.1.22