/[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.12 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_writedata(        subroutine optim_writedata(
11       I                       nn,       I                       nn,
12       I                       dfile,       I                       dfile,
# Line 30  c     == global variables == Line 38  c     == global variables ==
38    
39  #include "EEPARAMS.h"  #include "EEPARAMS.h"
40  #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"  
41  #include "ctrl.h"  #include "ctrl.h"
42  #include "optim.h"  #include "optim.h"
43  #include "minimization.h"  #include "minimization.h"
# Line 62  c     == local variables == Line 65  c     == local variables ==
65        integer funit        integer funit
66        integer cbuffindex        integer cbuffindex
67    
68        _RL     cbuff( sNx*nSx*nPx*sNy*nSy*nPy )        real*4 cbuff( sNx*nSx*nPx*sNy*nSy*nPy )
69    
70        character*(128) fname        character*(128) fname
71  cgg(  cgg(
# Line 97  c--   Next optimization cycle. Line 100  c--   Next optimization cycle.
100    
101  c--         Generate file name and open the file.  c--         Generate file name and open the file.
102        write(fname(1:128),'(4a,i4.4)')        write(fname(1:128),'(4a,i4.4)')
103       &     dfile,'_',expId(1:10),'.opt', nopt       &     dfile,'_',yctrlid(1:10),'.opt', nopt
104        open( funit, file   = fname,        open( funit, file   = fname,
105       &     status = 'new',       &     status = 'new',
106       &     form   = 'unformatted',       &     form   = 'unformatted',
# Line 106  c--         Generate file name and open Line 109  c--         Generate file name and open
109  cph(  cph(
110           print *, 'pathei: nvartype ', nvartype           print *, 'pathei: nvartype ', nvartype
111           print *, 'pathei: nvarlength ', nvarlength           print *, 'pathei: nvarlength ', nvarlength
112           print *, 'pathei: expId ', expId           print *, 'pathei: yctrlid ', yctrlid
113           print *, 'pathei: nopt ', nopt           print *, 'pathei: nopt ', nopt
114           print *, 'pathei: ff ', ff           print *, 'pathei: ff ', ff
115           print *, 'pathei: iG ', biG           print *, 'pathei: iG ', biG
# Line 114  cph( Line 117  cph(
117           print *, 'pathei: nsx ', nsx           print *, 'pathei: nsx ', nsx
118           print *, 'pathei: nsy ', nsy           print *, 'pathei: nsy ', nsy
119                    
120           print *, 'pathei: nWetcTile ',           print *, 'pathei: nWetcGlobal ',
121       &        (((nWetcTile(i,j,k), i=1,nsx), j=1,nsy), k=1,nr)       &        (nWetcGlobal(k), k=1,nr)
122           print *, 'pathei: nWetsTile ',           print *, 'pathei: nWetsGlobal ',
123       &        (((nWetsTile(i,j,k), i=1,nsx), j=1,nsy), k=1,nr)       &        (nWetsGlobal(k), k=1,nr)
124           print *, 'pathei: nWetwTile ',           print *, 'pathei: nWetwGlobal ',
125       &        (((nWetwTile(i,j,k), i=1,nsx), j=1,nsy), k=1,nr)       &        (nWetwGlobal(k), k=1,nr)
126             print *, 'pathei: nWetvGlobal ',
127         &        (nWetvGlobal(k), k=1,nr)
128           print *, 'pathei: ncvarindex ',           print *, 'pathei: ncvarindex ',
129       &        (ncvarindex(i), i=1,maxcvars)       &        (ncvarindex(i), i=1,maxcvars)
130           print *, 'pathei: ncvarrecs ',           print *, 'pathei: ncvarrecs ',
# Line 137  cph) Line 142  cph)
142  c--   Write the header.  c--   Write the header.
143        write( funit ) nvartype        write( funit ) nvartype
144        write( funit ) nvarlength        write( funit ) nvarlength
145        write( funit ) expId        write( funit ) yctrlid
146        write( funit ) optimcycle        write( funit ) optimcycle
147        write( funit ) ff        write( funit ) ff
148        write( funit ) big        write( funit ) big
149        write( funit ) bjg        write( funit ) bjg
150        write( funit ) nsx        write( funit ) nsx
151        write( funit ) nsy        write( funit ) nsy
152        write( funit ) (((nWetcTile(i,j,k), i=1,nsx), j=1,nsy),        write( funit ) (nWetcGlobal(k), k=1,nr)
153       &     k=1,nr)        write( funit ) (nWetsGlobal(k), k=1,nr)
154        write( funit ) (((nWetsTile(i,j,k), i=1,nsx), j=1,nsy),        write( funit ) (nWetwGlobal(k), k=1,nr)
155       &     k=1,nr)  #ifdef ALLOW_CTRL_WETV
156        write( funit ) (((nWetwTile(i,j,k), i=1,nsx), j=1,nsy),        write( funit ) (nWetvGlobal(k), k=1,nr)
157       &     k=1,nr)  #endif
158    #ifdef ALLOW_SHIFWFLX_CONTROL
159          write(funit) (nWetiGlobal(k),   k=1,nr)
160    c     write(funit) nWetiGlobal(1)
161    #endif
162    
163  cgg(    Add OBCS Mask information into the header section for optimization.  cgg(    Add OBCS Mask information into the header section for optimization.
164  #ifdef ALLOW_OBCSN_CONTROL  #ifdef ALLOW_OBCSN_CONTROL
165            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)  
166  #endif  #endif
167  #ifdef ALLOW_OBCSS_CONTROL  #ifdef ALLOW_OBCSS_CONTROL
168            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)  
169  #endif  #endif
170  #ifdef ALLOW_OBCSW_CONTROL  #ifdef ALLOW_OBCSW_CONTROL
171            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)  
172  #endif  #endif
173  #ifdef ALLOW_OBCSE_CONTROL  #ifdef ALLOW_OBCSE_CONTROL
174            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)  
175  #endif  #endif
176  cgg)  cgg)
177    
# Line 183  c--         Write the data. Line 188  c--         Write the data.
188        do icvar = 1,maxcvars        do icvar = 1,maxcvars
189           if ( ncvarindex(icvar) .ne. -1 ) then           if ( ncvarindex(icvar) .ne. -1 ) then
190              do icvrec = 1,ncvarrecs(icvar)              do icvrec = 1,ncvarrecs(icvar)
191  cph(  cph               do bj = 1,nsy
192                 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  
193                       write( funit ) ncvarindex(icvar)                       write( funit ) ncvarindex(icvar)
194                       write( funit ) bj                       write( funit ) bj
195                       write( funit ) bi                       write( funit ) bi
196                       do k = 1,ncvarnrmax(icvar)                       do k = 1,ncvarnrmax(icvar)
197                          cbuffindex = 0                          cbuffindex = 0
198                          if (ncvargrd(icvar) .eq. 'c') then                          if (ncvargrd(icvar) .eq. 'c') then
199                             cbuffindex = nwetctile(bi,bj,k)                             cbuffindex = nWetcGlobal(k)
200                          else if (ncvargrd(icvar) .eq. 's') then                          else if (ncvargrd(icvar) .eq. 's') then
201                             cbuffindex = nwetstile(bi,bj,k)                             cbuffindex = nWetsGlobal(k)
202                          else if (ncvargrd(icvar) .eq. 'w') then                          else if (ncvargrd(icvar) .eq. 'w') then
203                             cbuffindex = nwetwtile(bi,bj,k)                             cbuffindex = nWetwGlobal(k)
204                            else if (ncvargrd(icvar) .eq. 'v') then
205                               cbuffindex = nWetvGlobal(k)
206    #ifdef ALLOW_SHIFWFLX_CONTROL
207                            else if (ncvargrd(icvar) .eq. 'i') then
208                               cbuffindex = nWetiGlobal(k)
209    #endif
210  cgg(   O.B. points have the grid mask "m".  cgg(   O.B. points have the grid mask "m".
211                          else if (ncvargrd(icvar) .eq. 'm') then                          else if (ncvargrd(icvar) .eq. 'm') then
212  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 215  cgg    From "icvrec", calculate what iob
215                            iobcs= icvrec - igg*nobcs                            iobcs= icvrec - igg*nobcs
216  #ifdef ALLOW_OBCSN_CONTROL  #ifdef ALLOW_OBCSN_CONTROL
217                            if (icvar .eq. 11) then                                                if (icvar .eq. 11) then                    
218                               cbuffindex = nwetobcsn(bi,bj,k,iobcs)                               cbuffindex = nWetobcsnGlo(k,iobcs)
219                            endif                            endif
220  #endif  #endif
221  #ifdef ALLOW_OBCSS_CONTROL  #ifdef ALLOW_OBCSS_CONTROL
222                            if (icvar .eq. 12) then                            if (icvar .eq. 12) then
223                               cbuffindex = nwetobcss(bi,bj,k,iobcs)                               cbuffindex = nWetobcssGlo(k,iobcs)
224                            endif                            endif
225  #endif  #endif
226  #ifdef ALLOW_OBCSW_CONTROL  #ifdef ALLOW_OBCSW_CONTROL
227                            if (icvar .eq. 13) then                            if (icvar .eq. 13) then
228                               cbuffindex = nwetobcsw(bi,bj,k,iobcs)                               cbuffindex = nWetobcswGlo(k,iobcs)
229                            endif                            endif
230  #endif  #endif
231  #ifdef ALLOW_OBCSE_CONTROL  #ifdef ALLOW_OBCSE_CONTROL
232                            if (icvar .eq. 14) then                            if (icvar .eq. 14) then
233                               cbuffindex = nwetobcse(bi,bj,k,iobcs)                               cbuffindex = nWetobcseGlo(k,iobcs)
234                            endif                            endif
235  #endif  #endif
236                          endif                          endif
# Line 232  cgg) Line 238  cgg)
238                          if (cbuffindex .gt. 0) then                          if (cbuffindex .gt. 0) then
239                             do icvcomp = 1,cbuffindex                             do icvcomp = 1,cbuffindex
240                                cbuff(icvcomp) = vv(icvoffset + icvcomp)                                cbuff(icvcomp) = vv(icvoffset + icvcomp)
241  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
242  cgg( The model will crash due to physical reasons.  c     uncomment the next two lines.
243  cgg( However, we can optimize with respect to just O.B. T and S if the  c                              if (iobcs .eq. 3) cbuff(icvcomp)=0.
244  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.  
245                             enddo                             enddo
246                             write( funit ) cbuffindex                             write( funit ) cbuffindex
247                             write( funit ) k                             write( funit ) k
# Line 245  cgg                              if (iob Line 249  cgg                              if (iob
249                             icvoffset = icvoffset + cbuffindex                             icvoffset = icvoffset + cbuffindex
250                          endif                          endif
251                       enddo                       enddo
252                    enddo  cph                  enddo
253                 enddo  cph               enddo
254              enddo              enddo
255           endif           endif
256        enddo        enddo
Legend:
Removed from v.1.2  
changed lines
  Added in v.1.12
  ViewVC Help
Powered by ViewVC 1.1.22