/[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.10 by heimbach, Fri Jun 1 16:13:56 2012 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    #ifdef ALLOW_SHIFWFLX_CONTROL
155          write(funit) (nWetiGlobal(k),   k=1,nr)
156    c     write(funit) nWetiGlobal(1)
157    #endif
158    
159  cgg(    Add OBCS Mask information into the header section for optimization.  cgg(    Add OBCS Mask information into the header section for optimization.
160  #ifdef ALLOW_OBCSN_CONTROL  #ifdef ALLOW_OBCSN_CONTROL
161            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)  
162  #endif  #endif
163  #ifdef ALLOW_OBCSS_CONTROL  #ifdef ALLOW_OBCSS_CONTROL
164            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)  
165  #endif  #endif
166  #ifdef ALLOW_OBCSW_CONTROL  #ifdef ALLOW_OBCSW_CONTROL
167            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)  
168  #endif  #endif
169  #ifdef ALLOW_OBCSE_CONTROL  #ifdef ALLOW_OBCSE_CONTROL
170            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)  
171  #endif  #endif
172  cgg)  cgg)
173    
# Line 183  c--         Write the data. Line 184  c--         Write the data.
184        do icvar = 1,maxcvars        do icvar = 1,maxcvars
185           if ( ncvarindex(icvar) .ne. -1 ) then           if ( ncvarindex(icvar) .ne. -1 ) then
186              do icvrec = 1,ncvarrecs(icvar)              do icvrec = 1,ncvarrecs(icvar)
187  cph(  cph               do bj = 1,nsy
188                 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  
189                       write( funit ) ncvarindex(icvar)                       write( funit ) ncvarindex(icvar)
190                       write( funit ) bj                       write( funit ) bj
191                       write( funit ) bi                       write( funit ) bi
192                       do k = 1,ncvarnrmax(icvar)                       do k = 1,ncvarnrmax(icvar)
193                          cbuffindex = 0                          cbuffindex = 0
194                          if (ncvargrd(icvar) .eq. 'c') then                          if (ncvargrd(icvar) .eq. 'c') then
195                             cbuffindex = nwetctile(bi,bj,k)                             cbuffindex = nWetcGlobal(k)
196                          else if (ncvargrd(icvar) .eq. 's') then                          else if (ncvargrd(icvar) .eq. 's') then
197                             cbuffindex = nwetstile(bi,bj,k)                             cbuffindex = nWetsGlobal(k)
198                          else if (ncvargrd(icvar) .eq. 'w') then                          else if (ncvargrd(icvar) .eq. 'w') then
199                             cbuffindex = nwetwtile(bi,bj,k)                             cbuffindex = nWetwGlobal(k)
200                            else if (ncvargrd(icvar) .eq. 'v') then
201                               cbuffindex = nWetvGlobal(k)
202    #ifdef ALLOW_SHIFWFLX_CONTROL
203                            else if (ncvargrd(icvar) .eq. 'i') then
204                               cbuffindex = nWetiGlobal(k)
205    #endif
206  cgg(   O.B. points have the grid mask "m".  cgg(   O.B. points have the grid mask "m".
207                          else if (ncvargrd(icvar) .eq. 'm') then                          else if (ncvargrd(icvar) .eq. 'm') then
208  cgg    From "icvrec", calculate what iobcs must be.  cgg    From "icvrec", calculate what iobcs must be.
# Line 209  cgg    From "icvrec", calculate what iob Line 211  cgg    From "icvrec", calculate what iob
211                            iobcs= icvrec - igg*nobcs                            iobcs= icvrec - igg*nobcs
212  #ifdef ALLOW_OBCSN_CONTROL  #ifdef ALLOW_OBCSN_CONTROL
213                            if (icvar .eq. 11) then                                                if (icvar .eq. 11) then                    
214                               cbuffindex = nwetobcsn(bi,bj,k,iobcs)                               cbuffindex = nWetobcsnGlo(k,iobcs)
215                            endif                            endif
216  #endif  #endif
217  #ifdef ALLOW_OBCSS_CONTROL  #ifdef ALLOW_OBCSS_CONTROL
218                            if (icvar .eq. 12) then                            if (icvar .eq. 12) then
219                               cbuffindex = nwetobcss(bi,bj,k,iobcs)                               cbuffindex = nWetobcssGlo(k,iobcs)
220                            endif                            endif
221  #endif  #endif
222  #ifdef ALLOW_OBCSW_CONTROL  #ifdef ALLOW_OBCSW_CONTROL
223                            if (icvar .eq. 13) then                            if (icvar .eq. 13) then
224                               cbuffindex = nwetobcsw(bi,bj,k,iobcs)                               cbuffindex = nWetobcswGlo(k,iobcs)
225                            endif                            endif
226  #endif  #endif
227  #ifdef ALLOW_OBCSE_CONTROL  #ifdef ALLOW_OBCSE_CONTROL
228                            if (icvar .eq. 14) then                            if (icvar .eq. 14) then
229                               cbuffindex = nwetobcse(bi,bj,k,iobcs)                               cbuffindex = nWetobcseGlo(k,iobcs)
230                            endif                            endif
231  #endif  #endif
232                          endif                          endif
# Line 232  cgg) Line 234  cgg)
234                          if (cbuffindex .gt. 0) then                          if (cbuffindex .gt. 0) then
235                             do icvcomp = 1,cbuffindex                             do icvcomp = 1,cbuffindex
236                                cbuff(icvcomp) = vv(icvoffset + icvcomp)                                cbuff(icvcomp) = vv(icvoffset + icvcomp)
237  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
238  cgg( The model will crash due to physical reasons.  c     uncomment the next two lines.
239  cgg( However, we can optimize with respect to just O.B. T and S if the  c                              if (iobcs .eq. 3) cbuff(icvcomp)=0.
240  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.  
241                             enddo                             enddo
242                             write( funit ) cbuffindex                             write( funit ) cbuffindex
243                             write( funit ) k                             write( funit ) k
# Line 245  cgg                              if (iob Line 245  cgg                              if (iob
245                             icvoffset = icvoffset + cbuffindex                             icvoffset = icvoffset + cbuffindex
246                          endif                          endif
247                       enddo                       enddo
248                    enddo  cph                  enddo
249                 enddo  cph               enddo
250              enddo              enddo
251           endif           endif
252        enddo        enddo
Legend:
Removed from v.1.2  
changed lines
  Added in v.1.10
  ViewVC Help
Powered by ViewVC 1.1.22