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

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

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

revision 1.5 by mlosch, Mon May 9 09:37:16 2016 UTC revision 1.6 by mlosch, Thu May 3 11:26:05 2018 UTC
# Line 80  c     == local variables == Line 80  c     == local variables ==
80        real*4 cbuff( sNx*nSx*nPx*sNy*nSy*nPy )        real*4 cbuff( sNx*nSx*nPx*sNy*nSy*nPy )
81    
82        character*(128) fname        character*(128) fname
83          character*(17)  prefix
84          parameter ( prefix =  " OPTIM_READDATA: " )
85    
86  c      integer         filei  c      integer         filei
87  c      integer         filej  c      integer         filej
# Line 99  cgg) Line 101  cgg)
101    
102  c     == end of interface ==  c     == end of interface ==
103    
       print *, 'pathei-lsopt in optim_readdata'  
   
104  c--   The reference i/o unit.  c--   The reference i/o unit.
105        funit = 20        funit = 20
106    
# Line 108  c--   Next optimization cycle. Line 108  c--   Next optimization cycle.
108        nopt = optimcycle        nopt = optimcycle
109    
110        if      ( dfile .eq. ctrlname ) then        if      ( dfile .eq. ctrlname ) then
111          print*         print*
112          print*,' OPTIM_READDATA: Reading control vector'         print*,' OPTIM_READDATA: Reading control vector'
113          print*,'            for optimization cycle: ',nopt         print*,'                 for optimization cycle: ',nopt
114          print*         print*
115        else if ( dfile .eq. costname ) then        else if ( dfile .eq. costname ) then
116          print*         print*
117          print*,' OPTIM_READDATA: Reading cost function and'         print*,' OPTIM_READDATA: Reading cost function and'//
118          print*,'            gradient of cost function'       &                        ' gradient of cost function'
119          print*,'            for optimization cycle: ',nopt         print*,'                 for optimization cycle: ',nopt
120          print*         print*
121        else        else
122          print*         print*
123          print*,' OPTIM_READDATA: subroutine called by a false *dfile*'         print*,' OPTIM_READDATA: subroutine called by a false *dfile*'
124          print*,'            argument. *dfile* = ',dfile         print*,'                 argument. *dfile* = ',dfile
125          print*         print*
126          stop   '  ...  stopped in OPTIM_READDATA.'         stop   '  ...  stopped in OPTIM_READDATA.'
127        endif        endif
128    
129  c--   Read the data.  c--   Read the data.
# Line 138  c--   Generate file name and open the fi Line 138  c--   Generate file name and open the fi
138       &     status = 'old',       &     status = 'old',
139       &     form   = 'unformatted',       &     form   = 'unformatted',
140       &     access = 'sequential'   )       &     access = 'sequential'   )
141        print*, 'opened file ', fname        print*, prefix, 'opened file ', fname
142    
143  c--   Read the header.  c--   Read the header.
144        read( funit ) nvartype        read( funit ) nvartype
# Line 184  cgg) Line 184  cgg)
184        read( funit ) (ncvargrd(i),   i=1,maxcvars)        read( funit ) (ncvargrd(i),   i=1,maxcvars)
185        read( funit )        read( funit )
186    
187  cph(        print *, prefix, 'nvartype ', nvartype
188  cph      if (lheaderonly) then        print *, prefix, 'nvarlength ', nvarlength
189           print *, 'pathei: nvartype ', nvartype        print *, prefix, 'yctrlid ', yctrlid
190           print *, 'pathei: nvarlength ', nvarlength        print *, prefix, 'filenopt ', filenopt
191           print *, 'pathei: yctrlid ', yctrlid        print *, prefix, 'fileff ', fileff
192           print *, 'pathei: filenopt ', filenopt        print *, prefix, 'fileiG ', fileiG
193           print *, 'pathei: fileff ', fileff        print *, prefix, 'filejG ', filejG
194           print *, 'pathei: fileiG ', fileiG        print *, prefix, 'filensx ', filensx
195           print *, 'pathei: filejG ', filejG        print *, prefix, 'filensy ', filensy
          print *, 'pathei: filensx ', filensx  
          print *, 'pathei: filensy ', filensy  
196                    
197           print *, 'pathei: nWetcGlobal ',        if (lheaderonly) then
198       &        (nWetcGlobal(k),  k=1,nr)         print *, prefix, 'nWetcGlobal ', (nWetcGlobal(k), k=1,nr)
199           print *, 'pathei: nWetsGlobal ',         print *, prefix, 'nWetsGlobal ', (nWetsGlobal(k), k=1,nr)
200       &        (nWetsGlobal(k),  k=1,nr)         print *, prefix, 'nWetwGlobal ', (nWetwGlobal(k), k=1,nr)
201           print *, 'pathei: nWetwGlobal ',         print *, prefix, 'nWetvGlobal ', (nWetvGlobal(k), k=1,nr)
      &        (nWetwGlobal(k),  k=1,nr)  
          print *, 'pathei: nWetvGlobal ',  
      &        (nWetvGlobal(k),  k=1,nr)  
202  #ifdef ALLOW_SHIFWFLX_CONTROL  #ifdef ALLOW_SHIFWFLX_CONTROL
203           print *, 'pathei: nWetiGlobal ',         print *, prefix, 'nWetiGlobal ', (nWetiGlobal(k), k=1,nr)
      &        (nWetiGlobal(k), k=1,nr)  
204  #endif  #endif
205  #ifdef ALLOW_OBCSN_CONTROL  #ifdef ALLOW_OBCSN_CONTROL
206           do iobcs=1,nobcs         do iobcs=1,nobcs
207            print *, 'pathei: nWetobcsnGlo (iobcs=', iobcs,')',          print *, prefix, 'nWetobcsnGlo (iobcs=', iobcs,')',
208       &         (nWetobcsnGlo(k,iobcs), k=1,nr)       &       (nWetobcsnGlo(k,iobcs), k=1,nr)
209           enddo         enddo
210  #endif  #endif
211  #ifdef ALLOW_OBCSS_CONTROL  #ifdef ALLOW_OBCSS_CONTROL
212           do iobcs=1,nobcs         do iobcs=1,nobcs
213            print *, 'pathei: nWetobcssGlo (iobcs=', iobcs,')',          print *, prefix, 'nWetobcssGlo (iobcs=', iobcs,')',
214       &         (nWetobcssGlo(k,iobcs), k=1,nr)       &         (nWetobcssGlo(k,iobcs), k=1,nr)
215           enddo         enddo
216  #endif  #endif
217  #ifdef ALLOW_OBCSW_CONTROL  #ifdef ALLOW_OBCSW_CONTROL
218           do iobcs=1,nobcs         do iobcs=1,nobcs
219            print *, 'pathei: nWetobcswGlo (iobcs=', iobcs,')',          print *, prefix, 'nWetobcswGlo (iobcs=', iobcs,')',
220       &         (nWetobcswGlo(k,iobcs), k=1,nr)       &       (nWetobcswGlo(k,iobcs), k=1,nr)
221           enddo         enddo
222  #endif  #endif
223  #ifdef ALLOW_OBCSE_CONTROL  #ifdef ALLOW_OBCSE_CONTROL
224           do iobcs=1,nobcs         do iobcs=1,nobcs
225            print *, 'pathei: nWetobcseGlo (iobcs=', iobcs,')',          print *, prefix, 'nWetobcseGlo (iobcs=', iobcs,')',
226       &         (nWetobcseGlo(k,iobcs), k=1,nr)       &       (nWetobcseGlo(k,iobcs), k=1,nr)
227           enddo         enddo
228  #endif  #endif
229           print *, 'pathei: ncvarindex ',         print *, prefix, 'ncvarindex ', (ncvarindex(i), i=1,maxcvars)
230       &        (ncvarindex(i), i=1,maxcvars)         print *, prefix, 'ncvarrecs  ', (ncvarrecs(i),  i=1,maxcvars)
231           print *, 'pathei: ncvarrecs ',         print *, prefix, 'ncvarxmax  ', (ncvarxmax(i),  i=1,maxcvars)
232       &        (ncvarrecs(i),  i=1,maxcvars)         print *, prefix, 'ncvarymax  ', (ncvarymax(i),  i=1,maxcvars)
233           print *, 'pathei: ncvarxmax ',         print *, prefix, 'ncvarnrmax ', (ncvarnrmax(i), i=1,maxcvars)
234       &        (ncvarxmax(i),  i=1,maxcvars)         print *, prefix, 'ncvargrd   ', (ncvargrd(i),   i=1,maxcvars)
235           print *, 'pathei: ncvarymax ',        end if
      &        (ncvarymax(i),  i=1,maxcvars)  
          print *, 'pathei: ncvarnrmax ',  
      &        (ncvarnrmax(i), i=1,maxcvars)  
          print *, 'pathei: ncvargrd ',  
      &        (ncvargrd(i),   i=1,maxcvars)  
 cph      end if  
 cph)  
236  c--   Check the header information for consistency.  c--   Check the header information for consistency.
237    
238  cph      if ( filenopt .ne. nopt ) then  cph      if ( filenopt .ne. nopt ) then
239  cph         print*  cph       print*
240  cph         print*,' READ_HEADER: Input data belong to the wrong'  cph       print*,' READ_HEADER: Input data belong to the wrong'
241  cph         print*,'              optimization cycle.'  cph       print*,'              optimization cycle.'
242  cph         print*,'              optimization cycle = ',nopt  cph       print*,'              optimization cycle = ',nopt
243  cph         print*,'              input optim  cycle = ',filenopt  cph       print*,'              input optim  cycle = ',filenopt
244  cph         print*  cph       print*
245  cph         stop   ' ... stopped in READ_HEADER.'  cph       stop   ' ... stopped in READ_HEADER.'
246  cph      endif  cph      endif
247                
248        if ( (fileiG .ne. biG) .or. (filejG .ne. bjG) ) then        if ( (fileiG .ne. biG) .or. (filejG .ne. bjG) ) then
249           print*         print*
250           print*,' READ_HEADER: Tile indices of loop and data '         print*, prefix, 'Tile indices of loop and data do not match.'
251           print*,'              do not match.'         print*,'                 loop x/y component = ',
252           print*,'              loop x/y component = ',       &      biG,bjG
253       &        biG,bjG         print*,'                 data x/y component = ',
254           print*,'              data x/y component = ',       &      fileiG,filejG
255       &        fileiG,filejG         print*
256           print*         stop   ' ... stopped in OPTIM_READDATA.'
          stop   ' ... stopped in READ_HEADER.'  
257        endif        endif
258                
259        if ( (filensx .ne. nsx) .or. (filensy .ne. nsy) ) then        if ( (filensx .ne. nsx) .or. (filensy .ne. nsy) ) then
260           print*         print*
261           print*,' READ_HEADER: Numbers of tiles do not match.'         print*, prefix, ' Numbers of tiles do not match.'
262           print*,'              parameter x/y no. of tiles = ',         print*,'                 parameter x/y no. of tiles = ',
263       &        bi,bj       &      bi,bj
264           print*,'              data      x/y no. of tiles = ',         print*,'                 data      x/y no. of tiles = ',
265       &        filensx,filensy       &      filensx,filensy
266           print*         print*
267           stop   ' ... stopped in READ_HEADER.'         stop   ' ... stopped in OPTIM_READDATA.'
268        endif        endif
269    
270  ce    Add some more checks. ...  ce    Add some more checks. ...
# Line 315  cgg    From "icvrec", calculate what iob Line 301  cgg    From "icvrec", calculate what iob
301                igg  = int(gg)                igg  = int(gg)
302                iobcs= icvrec - igg*nobcs                iobcs= icvrec - igg*nobcs
303  #ifdef ALLOW_OBCSN_CONTROL  #ifdef ALLOW_OBCSN_CONTROL
304                if (icvar .eq. 11) then                                    if (icvar .eq. 11) cbuffindex = nWetobcsnGlo(k,iobcs)
                cbuffindex = nWetobcsnGlo(k,iobcs)  
               endif  
305  #endif  #endif
306  #ifdef ALLOW_OBCSS_CONTROL  #ifdef ALLOW_OBCSS_CONTROL
307                if (icvar .eq. 12) then                if (icvar .eq. 12) cbuffindex = nWetobcssGlo(k,iobcs)
                cbuffindex = nWetobcssGlo(k,iobcs)  
               endif  
308  #endif  #endif
309  #ifdef ALLOW_OBCSW_CONTROL  #ifdef ALLOW_OBCSW_CONTROL
310                if (icvar .eq. 13) then                if (icvar .eq. 13) cbuffindex = nWetobcswGlo(k,iobcs)
                cbuffindex = nWetobcswGlo(k,iobcs)  
               endif  
311  #endif  #endif
312  #ifdef ALLOW_OBCSE_CONTROL  #ifdef ALLOW_OBCSE_CONTROL
313                if (icvar .eq. 14) then                if (icvar .eq. 14) cbuffindex = nWetobcseGlo(k,iobcs)
                cbuffindex = nWetobcseGlo(k,iobcs)  
               endif  
314  #endif  #endif
315  cgg)  cgg)
316               endif               endif
# Line 389  c--   Assign the cost function value in Line 367  c--   Assign the cost function value in
367  c--   Always return the cost function value if lheaderonly  c--   Always return the cost function value if lheaderonly
368        if ( lheaderonly) ff = fileff        if ( lheaderonly) ff = fileff
369    
370          print *, prefix, 'end of optim_readdata'
371          print *, ' '
372    
373        return        return
374        end        end
Legend:
Removed from v.1.5  
changed lines
  Added in v.1.6
  ViewVC Help
Powered by ViewVC 1.1.22