/[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.2 by heimbach, Fri Nov 15 04:03:25 2002 UTC revision 1.7 by dfer, Tue Jan 15 16:36:32 2008 UTC
# Line 34  cgg   Include ECCO_CPPOPTIONS because th Line 34  cgg   Include ECCO_CPPOPTIONS because th
34  cgg   options for OBCS masks.  cgg   options for OBCS masks.
35  #include "ECCO_CPPOPTIONS.h"  #include "ECCO_CPPOPTIONS.h"
36    
 #include "ecco.h"  
37  #include "ctrl.h"  #include "ctrl.h"
38  #include "optim.h"  #include "optim.h"
39  #include "minimization.h"  #include "minimization.h"
# Line 62  c     == local variables == Line 61  c     == local variables ==
61        integer funit        integer funit
62        integer cbuffindex        integer cbuffindex
63    
64        _RL     cbuff( sNx*nSx*nPx*sNy*nSy*nPy )        real*4 cbuff( sNx*nSx*nPx*sNy*nSy*nPy )
65    
66        character*(128) fname        character*(128) fname
67  cgg(  cgg(
# Line 97  c--   Next optimization cycle. Line 96  c--   Next optimization cycle.
96    
97  c--         Generate file name and open the file.  c--         Generate file name and open the file.
98        write(fname(1:128),'(4a,i4.4)')        write(fname(1:128),'(4a,i4.4)')
99       &     dfile,'_',expId(1:10),'.opt', nopt       &     dfile,'_',yctrlid(1:10),'.opt', nopt
100        open( funit, file   = fname,        open( funit, file   = fname,
101       &     status = 'new',       &     status = 'new',
102       &     form   = 'unformatted',       &     form   = 'unformatted',
# Line 106  c--         Generate file name and open Line 105  c--         Generate file name and open
105  cph(  cph(
106           print *, 'pathei: nvartype ', nvartype           print *, 'pathei: nvartype ', nvartype
107           print *, 'pathei: nvarlength ', nvarlength           print *, 'pathei: nvarlength ', nvarlength
108           print *, 'pathei: expId ', expId           print *, 'pathei: yctrlid ', yctrlid
109           print *, 'pathei: nopt ', nopt           print *, 'pathei: nopt ', nopt
110           print *, 'pathei: ff ', ff           print *, 'pathei: ff ', ff
111           print *, 'pathei: iG ', biG           print *, 'pathei: iG ', biG
# Line 114  cph( Line 113  cph(
113           print *, 'pathei: nsx ', nsx           print *, 'pathei: nsx ', nsx
114           print *, 'pathei: nsy ', nsy           print *, 'pathei: nsy ', nsy
115                    
116           print *, 'pathei: nWetcTile ',           print *, 'pathei: nWetcGlobal ',
117       &        (((nWetcTile(i,j,k), i=1,nsx), j=1,nsy), k=1,nr)       &        (nWetcGlobal(k), k=1,nr)
118           print *, 'pathei: nWetsTile ',           print *, 'pathei: nWetsGlobal ',
119       &        (((nWetsTile(i,j,k), i=1,nsx), j=1,nsy), k=1,nr)       &        (nWetsGlobal(k), k=1,nr)
120           print *, 'pathei: nWetwTile ',           print *, 'pathei: nWetwGlobal ',
121       &        (((nWetwTile(i,j,k), i=1,nsx), j=1,nsy), k=1,nr)       &        (nWetwGlobal(k), k=1,nr)
122             print *, 'pathei: nWetvGlobal ',
123         &        (nWetvGlobal(k), k=1,nr)
124           print *, 'pathei: ncvarindex ',           print *, 'pathei: ncvarindex ',
125       &        (ncvarindex(i), i=1,maxcvars)       &        (ncvarindex(i), i=1,maxcvars)
126           print *, 'pathei: ncvarrecs ',           print *, 'pathei: ncvarrecs ',
# Line 137  cph) Line 138  cph)
138  c--   Write the header.  c--   Write the header.
139        write( funit ) nvartype        write( funit ) nvartype
140        write( funit ) nvarlength        write( funit ) nvarlength
141        write( funit ) expId        write( funit ) yctrlid
142        write( funit ) optimcycle        write( funit ) optimcycle
143        write( funit ) ff        write( funit ) ff
144        write( funit ) big        write( funit ) big
145        write( funit ) bjg        write( funit ) bjg
146        write( funit ) nsx        write( funit ) nsx
147        write( funit ) nsy        write( funit ) nsy
148        write( funit ) (((nWetcTile(i,j,k), i=1,nsx), j=1,nsy),        write( funit ) (nWetcGlobal(k), k=1,nr)
149       &     k=1,nr)        write( funit ) (nWetsGlobal(k), k=1,nr)
150        write( funit ) (((nWetsTile(i,j,k), i=1,nsx), j=1,nsy),        write( funit ) (nWetwGlobal(k), k=1,nr)
151       &     k=1,nr)  #ifdef ALLOW_CTRL_WETV
152        write( funit ) (((nWetwTile(i,j,k), i=1,nsx), j=1,nsy),        write( funit ) (nWetvGlobal(k), k=1,nr)
153       &     k=1,nr)  #endif
154    
155  cgg(    Add OBCS Mask information into the header section for optimization.  cgg(    Add OBCS Mask information into the header section for optimization.
156  #ifdef ALLOW_OBCSN_CONTROL  #ifdef ALLOW_OBCSN_CONTROL
157            write(funit) ((((nWetobcsn(i,j,k,iobcs), k=1,nr),            write(funit) ((nWetobcsnGlo(k,iobcs), k=1,nr),iobcs= 1,nobcs)
      &          iobcs= 1,nobcs), i=1,nsx) , j=1,nsy)  
158  #endif  #endif
159  #ifdef ALLOW_OBCSS_CONTROL  #ifdef ALLOW_OBCSS_CONTROL
160            write(funit) ((((nWetobcss(i,j,k,iobcs), k=1,nr),            write(funit) ((nWetobcssGlo(k,iobcs), k=1,nr),iobcs= 1,nobcs)
      &          iobcs= 1,nobcs), i=1,nsx) , j=1,nsy)  
161  #endif  #endif
162  #ifdef ALLOW_OBCSW_CONTROL  #ifdef ALLOW_OBCSW_CONTROL
163            write(funit) ((((nWetobcsw(i,j,k,iobcs), k=1,nr),            write(funit) ((nWetobcswGlo(k,iobcs), k=1,nr),iobcs= 1,nobcs)
      &          iobcs= 1,nobcs), i=1,nsx) , j=1,nsy)  
164  #endif  #endif
165  #ifdef ALLOW_OBCSE_CONTROL  #ifdef ALLOW_OBCSE_CONTROL
166            write(funit) ((((nWetobcse(i,j,k,iobcs), k=1,nr),            write(funit) ((nWetobcseGlo(k,iobcs), k=1,nr),iobcs= 1,nobcs)
      &          iobcs= 1,nobcs), i=1,nsx) , j=1,nsy)  
167  #endif  #endif
168  cgg)  cgg)
169    
# Line 183  c--         Write the data. Line 180  c--         Write the data.
180        do icvar = 1,maxcvars        do icvar = 1,maxcvars
181           if ( ncvarindex(icvar) .ne. -1 ) then           if ( ncvarindex(icvar) .ne. -1 ) then
182              do icvrec = 1,ncvarrecs(icvar)              do icvrec = 1,ncvarrecs(icvar)
 cph(  
                print *,'in owd: icvar, icvrec, ncvarrecs, ncvarindex',  
      &              icvar, icvrec, ncvarrecs(icvar), ncvarindex(icvar)  
 cph)  
183                 do bj = 1,nsy                 do bj = 1,nsy
184                    do bi = 1,nsx                    do bi = 1,nsx
185                       write( funit ) ncvarindex(icvar)                       write( funit ) ncvarindex(icvar)
# Line 195  cph) Line 188  cph)
188                       do k = 1,ncvarnrmax(icvar)                       do k = 1,ncvarnrmax(icvar)
189                          cbuffindex = 0                          cbuffindex = 0
190                          if (ncvargrd(icvar) .eq. 'c') then                          if (ncvargrd(icvar) .eq. 'c') then
191                             cbuffindex = nwetctile(bi,bj,k)                             cbuffindex = nWetcGlobal(k)
192                          else if (ncvargrd(icvar) .eq. 's') then                          else if (ncvargrd(icvar) .eq. 's') then
193                             cbuffindex = nwetstile(bi,bj,k)                             cbuffindex = nWetsGlobal(k)
194                          else if (ncvargrd(icvar) .eq. 'w') then                          else if (ncvargrd(icvar) .eq. 'w') then
195                             cbuffindex = nwetwtile(bi,bj,k)                             cbuffindex = nWetwGlobal(k)
196                            else if (ncvargrd(icvar) .eq. 'v') then
197                               cbuffindex = nWetvGlobal(k)
198    
199  cgg(   O.B. points have the grid mask "m".  cgg(   O.B. points have the grid mask "m".
200                          else if (ncvargrd(icvar) .eq. 'm') then                          else if (ncvargrd(icvar) .eq. 'm') then
# Line 209  cgg    From "icvrec", calculate what iob Line 204  cgg    From "icvrec", calculate what iob
204                            iobcs= icvrec - igg*nobcs                            iobcs= icvrec - igg*nobcs
205  #ifdef ALLOW_OBCSN_CONTROL  #ifdef ALLOW_OBCSN_CONTROL
206                            if (icvar .eq. 11) then                                                if (icvar .eq. 11) then                    
207                               cbuffindex = nwetobcsn(bi,bj,k,iobcs)                               cbuffindex = nWetobcsnGlo(k,iobcs)
208                            endif                            endif
209  #endif  #endif
210  #ifdef ALLOW_OBCSS_CONTROL  #ifdef ALLOW_OBCSS_CONTROL
211                            if (icvar .eq. 12) then                            if (icvar .eq. 12) then
212                               cbuffindex = nwetobcss(bi,bj,k,iobcs)                               cbuffindex = nWetobcssGlo(k,iobcs)
213                            endif                            endif
214  #endif  #endif
215  #ifdef ALLOW_OBCSW_CONTROL  #ifdef ALLOW_OBCSW_CONTROL
216                            if (icvar .eq. 13) then                            if (icvar .eq. 13) then
217                               cbuffindex = nwetobcsw(bi,bj,k,iobcs)                               cbuffindex = nWetobcswGlo(k,iobcs)
218                            endif                            endif
219  #endif  #endif
220  #ifdef ALLOW_OBCSE_CONTROL  #ifdef ALLOW_OBCSE_CONTROL
221                            if (icvar .eq. 14) then                            if (icvar .eq. 14) then
222                               cbuffindex = nwetobcse(bi,bj,k,iobcs)                               cbuffindex = nWetobcseGlo(k,iobcs)
223                            endif                            endif
224  #endif  #endif
225                          endif                          endif

Legend:
Removed from v.1.2  
changed lines
  Added in v.1.7

  ViewVC Help
Powered by ViewVC 1.1.22