/[MITgcm]/MITgcm_contrib/mlosch/optim_m1qn3/optim_writedata.F
ViewVC logotype

Diff of /MITgcm_contrib/mlosch/optim_m1qn3/optim_writedata.F

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

revision 1.4 by mlosch, Mon May 9 09:37:17 2016 UTC revision 1.5 by mlosch, Thu May 3 11:26:05 2018 UTC
# Line 10  C     CTRL_OPTIONS affects maxcvars and Line 10  C     CTRL_OPTIONS affects maxcvars and
10        subroutine optim_writedata(        subroutine optim_writedata(
11       I                       nn,       I                       nn,
12       I                       dfile,       I                       dfile,
13       I                       lheaderonly,       I                       printlists,
14       I                       ff,       I                       ff,
15       I                       vv       I                       vv
16       &                     )       &                     )
# Line 51  c     == routine arguments == Line 51  c     == routine arguments ==
51        _RL     vv(nn)        _RL     vv(nn)
52    
53        character*(9) dfile        character*(9) dfile
54        logical lheaderonly        logical printlists
55    
56  c     == local variables ==  c     == local variables ==
57    
# Line 70  c     == local variables == Line 70  c     == local variables ==
70        real*4 cbuff( sNx*nSx*nPx*sNy*nSy*nPy )        real*4 cbuff( sNx*nSx*nPx*sNy*nSy*nPy )
71    
72        character*(128) fname        character*(128) fname
73          character*(18)  prefix
74          parameter ( prefix =  " OPTIM_WRITEDATA: " )
75  cgg(  cgg(
76        _RL     gg        _RL     gg
77        integer igg        integer igg
# Line 85  c--   Next optimization cycle. Line 87  c--   Next optimization cycle.
87        nopt = optimcycle + 1        nopt = optimcycle + 1
88    
89        if ( dfile .eq. ctrlname ) then        if ( dfile .eq. ctrlname ) then
90          print*         print*
91          print*,' OPTIM_WRITEDATA: Writing new control vector to file(s)'         print*,' OPTIM_WRITEDATA: Writing new control vector to file(s)'
92          print*,'             for optimization cycle: ',nopt         print*,'                  for optimization cycle: ',nopt
93          print*         print*
94        else        else
95          print*         print*
96          print*,' OPTIM_WRITEDATA: subroutine called by a false *dfile*'         print*,' OPTIM_WRITEDATA: subroutine called by a false *dfile*'
97          print*,'             argument. *dfile* = ',dfile         print*,'                  argument. *dfile* = ',dfile
98          print*         print*
99          stop   '  ...  stopped in OPTIM_WRITEDATA.'         stop   '  ...  stopped in OPTIM_WRITEDATA.'
100        endif        endif
101    
102        bjG = 1 + (myygloballo - 1)/sny        bjG = 1 + (myygloballo - 1)/sny
# Line 108  c--         Generate file name and open Line 110  c--         Generate file name and open
110       &     form   = 'unformatted',       &     form   = 'unformatted',
111       &     access = 'sequential'   )       &     access = 'sequential'   )
112    
113  cph(        print *, prefix, 'nvartype   ', nvartype
114           print *, 'pathei: nvartype ', nvartype        print *, prefix, 'nvarlength ', nvarlength
115           print *, 'pathei: nvarlength ', nvarlength        print *, prefix, 'yctrlid    ', yctrlid
116           print *, 'pathei: yctrlid ', yctrlid        print *, prefix, 'nopt       ', nopt
117           print *, 'pathei: nopt ', nopt        print *, prefix, 'ff         ', ff
118           print *, 'pathei: ff ', ff        print *, prefix, 'iG         ', biG
119           print *, 'pathei: iG ', biG        print *, prefix, 'jG         ', bjG
120           print *, 'pathei: jG ', bjG        print *, prefix, 'nsx        ', nsx
121           print *, 'pathei: nsx ', nsx        print *, prefix, 'nsy        ', nsy
          print *, 'pathei: nsy ', nsy  
122                    
123           print *, 'pathei: nWetcGlobal ',        if ( printlists ) then
124       &        (nWetcGlobal(k), k=1,nr)         print *, prefix, 'nWetcGlobal ', (nWetcGlobal(k), k=1,nr)
125           print *, 'pathei: nWetsGlobal ',         print *, prefix, 'nWetsGlobal ', (nWetsGlobal(k), k=1,nr)
126       &        (nWetsGlobal(k), k=1,nr)         print *, prefix, 'nWetwGlobal ', (nWetwGlobal(k), k=1,nr)
127           print *, 'pathei: nWetwGlobal ',         print *, prefix, 'nWetvGlobal ', (nWetvGlobal(k), k=1,nr)
128       &        (nWetwGlobal(k), k=1,nr)         print *, prefix, 'ncvarindex ',  (ncvarindex(i), i=1,maxcvars)
129           print *, 'pathei: nWetvGlobal ',         print *, prefix, 'ncvarrecs ',   (ncvarrecs(i),  i=1,maxcvars)
130       &        (nWetvGlobal(k), k=1,nr)         print *, prefix, 'ncvarxmax ',   (ncvarxmax(i),  i=1,maxcvars)
131           print *, 'pathei: ncvarindex ',         print *, prefix, 'ncvarymax ',   (ncvarymax(i),  i=1,maxcvars)
132       &        (ncvarindex(i), i=1,maxcvars)         print *, prefix, 'ncvarnrmax ',  (ncvarnrmax(i), i=1,maxcvars)
133           print *, 'pathei: ncvarrecs ',         print *, prefix, 'ncvargrd ',    (ncvargrd(i),   i=1,maxcvars)
134       &        (ncvarrecs(i),  i=1,maxcvars)        endif
135           print *, 'pathei: ncvarxmax ',  
      &        (ncvarxmax(i),  i=1,maxcvars)  
          print *, 'pathei: ncvarymax ',  
      &        (ncvarymax(i),  i=1,maxcvars)  
          print *, 'pathei: ncvarnrmax ',  
      &        (ncvarnrmax(i), i=1,maxcvars)  
          print *, 'pathei: ncvargrd ',  
      &        (ncvargrd(i),   i=1,maxcvars)  
 cph)  
136    
137  c--   Write the header.  c--   Write the header.
138        write( funit ) nvartype        write( funit ) nvartype
# Line 162  c--   Write the header. Line 155  c--   Write the header.
155  c     write(funit) nWetiGlobal(1)  c     write(funit) nWetiGlobal(1)
156  #endif  #endif
157    
158  cgg(    Add OBCS Mask information into the header section for optimization.  c     Add OBCS Mask information into the header section for optimization.
159  #ifdef ALLOW_OBCSN_CONTROL  #ifdef ALLOW_OBCSN_CONTROL
160            write(funit) ((nWetobcsnGlo(k,iobcs), k=1,nr),iobcs= 1,nobcs)        write(funit) ((nWetobcsnGlo(k,iobcs), k=1,nr),iobcs= 1,nobcs)
161  #endif  #endif
162  #ifdef ALLOW_OBCSS_CONTROL  #ifdef ALLOW_OBCSS_CONTROL
163            write(funit) ((nWetobcssGlo(k,iobcs), k=1,nr),iobcs= 1,nobcs)        write(funit) ((nWetobcssGlo(k,iobcs), k=1,nr),iobcs= 1,nobcs)
164  #endif  #endif
165  #ifdef ALLOW_OBCSW_CONTROL  #ifdef ALLOW_OBCSW_CONTROL
166            write(funit) ((nWetobcswGlo(k,iobcs), k=1,nr),iobcs= 1,nobcs)        write(funit) ((nWetobcswGlo(k,iobcs), k=1,nr),iobcs= 1,nobcs)
167  #endif  #endif
168  #ifdef ALLOW_OBCSE_CONTROL  #ifdef ALLOW_OBCSE_CONTROL
169            write(funit) ((nWetobcseGlo(k,iobcs), k=1,nr),iobcs= 1,nobcs)        write(funit) ((nWetobcseGlo(k,iobcs), k=1,nr),iobcs= 1,nobcs)
170  #endif  #endif
171  cgg)        
   
172        write( funit ) (ncvarindex(i), i=1,maxcvars)        write( funit ) (ncvarindex(i), i=1,maxcvars)
173        write( funit ) (ncvarrecs(i),  i=1,maxcvars)        write( funit ) (ncvarrecs(i),  i=1,maxcvars)
174        write( funit ) (ncvarxmax(i),  i=1,maxcvars)        write( funit ) (ncvarxmax(i),  i=1,maxcvars)
# Line 188  cgg) Line 180  cgg)
180  c--         Write the data.  c--         Write the data.
181        icvoffset = 0        icvoffset = 0
182        do icvar = 1,maxcvars        do icvar = 1,maxcvars
183           if ( ncvarindex(icvar) .ne. -1 ) then         if ( ncvarindex(icvar) .ne. -1 ) then
184              do icvrec = 1,ncvarrecs(icvar)          do icvrec = 1,ncvarrecs(icvar)
185  cph               do bj = 1,nsy  cph         do bj = 1,nsy
186  cph                  do bi = 1,nsx  cph          do bi = 1,nsx
187                       write( funit ) ncvarindex(icvar)           write( funit ) ncvarindex(icvar)
188                       write( funit ) bj           write( funit ) bj
189                       write( funit ) bi           write( funit ) bi
190                       do k = 1,ncvarnrmax(icvar)           do k = 1,ncvarnrmax(icvar)
191                          cbuffindex = 0            cbuffindex = 0
192                          if (ncvargrd(icvar) .eq. 'c') then            if (ncvargrd(icvar) .eq. 'c') then
193                             cbuffindex = nWetcGlobal(k)             cbuffindex = nWetcGlobal(k)
194                          else if (ncvargrd(icvar) .eq. 's') then            else if (ncvargrd(icvar) .eq. 's') then
195                             cbuffindex = nWetsGlobal(k)             cbuffindex = nWetsGlobal(k)
196                          else if (ncvargrd(icvar) .eq. 'w') then            else if (ncvargrd(icvar) .eq. 'w') then
197                             cbuffindex = nWetwGlobal(k)             cbuffindex = nWetwGlobal(k)
198                          else if (ncvargrd(icvar) .eq. 'v') then            else if (ncvargrd(icvar) .eq. 'v') then
199                             cbuffindex = nWetvGlobal(k)             cbuffindex = nWetvGlobal(k)
200  #ifdef ALLOW_SHIFWFLX_CONTROL  #ifdef ALLOW_SHIFWFLX_CONTROL
201                          else if (ncvargrd(icvar) .eq. 'i') then            else if (ncvargrd(icvar) .eq. 'i') then
202                             cbuffindex = nWetiGlobal(k)             cbuffindex = nWetiGlobal(k)
203  #endif  #endif
204  cgg(   O.B. points have the grid mask "m".  c     O.B. points have the grid mask "m".
205                          else if (ncvargrd(icvar) .eq. 'm') then            else if (ncvargrd(icvar) .eq. 'm') then
206  cgg    From "icvrec", calculate what iobcs must be.  c     From "icvrec", calculate what iobcs must be.
207                            gg   = (icvrec-1)/nobcs             gg   = (icvrec-1)/nobcs
208                            igg  = int(gg)             igg  = int(gg)
209                            iobcs= icvrec - igg*nobcs             iobcs= icvrec - igg*nobcs
210  #ifdef ALLOW_OBCSN_CONTROL  #ifdef ALLOW_OBCSN_CONTROL
211                            if (icvar .eq. 11) then                                 if (icvar .eq. 11) cbuffindex = nWetobcsnGlo(k,iobcs)
                              cbuffindex = nWetobcsnGlo(k,iobcs)  
                           endif  
212  #endif  #endif
213  #ifdef ALLOW_OBCSS_CONTROL  #ifdef ALLOW_OBCSS_CONTROL
214                            if (icvar .eq. 12) then             if (icvar .eq. 12) cbuffindex = nWetobcssGlo(k,iobcs)
                              cbuffindex = nWetobcssGlo(k,iobcs)  
                           endif  
215  #endif  #endif
216  #ifdef ALLOW_OBCSW_CONTROL  #ifdef ALLOW_OBCSW_CONTROL
217                            if (icvar .eq. 13) then             if (icvar .eq. 13) cbuffindex = nWetobcswGlo(k,iobcs)
                              cbuffindex = nWetobcswGlo(k,iobcs)  
                           endif  
218  #endif  #endif
219  #ifdef ALLOW_OBCSE_CONTROL  #ifdef ALLOW_OBCSE_CONTROL
220                            if (icvar .eq. 14) then             if (icvar .eq. 14) cbuffindex = nWetobcseGlo(k,iobcs)
                              cbuffindex = nWetobcseGlo(k,iobcs)  
                           endif  
221  #endif  #endif
222                          endif            endif
223  cgg)            if (cbuffindex .gt. 0) then
224                          if (cbuffindex .gt. 0) then             do icvcomp = 1,cbuffindex
225                             do icvcomp = 1,cbuffindex              cbuff(icvcomp) = vv(icvoffset + icvcomp)
                               cbuff(icvcomp) = vv(icvoffset + icvcomp)  
226  c     If you want to optimize with respect to just O.B. T and S  c     If you want to optimize with respect to just O.B. T and S
227  c     uncomment the next two lines.  c     uncomment the next two lines.
228  c                              if (iobcs .eq. 3) cbuff(icvcomp)=0.  c           if (iobcs .eq. 3) cbuff(icvcomp)=0.
229  c                              if (iobcs .eq. 4) cbuff(icvcomp)=0.  c           if (iobcs .eq. 4) cbuff(icvcomp)=0.
230                             enddo             enddo
231                             write( funit ) cbuffindex             write( funit ) cbuffindex
232                             write( funit ) k             write( funit ) k
233                             write( funit ) (cbuff(ii), ii=1,cbuffindex)             write( funit ) (cbuff(ii), ii=1,cbuffindex)
234                             icvoffset = icvoffset + cbuffindex             icvoffset = icvoffset + cbuffindex
235                          endif            endif
236                       enddo           enddo
237  cph                  enddo  cph                  enddo
238  cph               enddo  cph               enddo
239              enddo          enddo
240           endif         endif
241        enddo        enddo
242    
243        close( funit )        close( funit )
244  cph(  
245        print *,'end of optim_writedata: icvoffset ', icvoffset        print *, prefix, 'end of optim_writedata, icvoffset ', icvoffset
246  cph)        print *, ' '
247    
248        return        return
249        end        end
Legend:
Removed from v.1.4  
changed lines
  Added in v.1.5
  ViewVC Help
Powered by ViewVC 1.1.22