/[MITgcm]/MITgcm/pkg/fizhi/update_ocean_exports.F
ViewVC logotype

Diff of /MITgcm/pkg/fizhi/update_ocean_exports.F

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

revision 1.11 by molod, Mon Jul 19 22:06:59 2004 UTC revision 1.27 by molod, Thu Jun 21 22:11:57 2007 UTC
# Line 1  Line 1 
1  C $Header$  C $Header$
2  C $Name$  C $Name$
3    
4    #include "FIZHI_OPTIONS.h"
5         subroutine update_ocean_exports (myTime, myIter, myThid)         subroutine update_ocean_exports (myTime, myIter, myThid)
6  c----------------------------------------------------------------------  c----------------------------------------------------------------------
7  c  Subroutine update_ocean_exports - 'Wrapper' routine to update  c  Subroutine update_ocean_exports - 'Wrapper' routine to update
# Line 11  c Call:  getsst  (Return the current sst Line 12  c Call:  getsst  (Return the current sst
12  c        getsice (Return the current sea ice field-read data if needed)  c        getsice (Return the current sea ice field-read data if needed)
13  c-----------------------------------------------------------------------  c-----------------------------------------------------------------------
14         implicit none         implicit none
 #include "CPP_OPTIONS.h"  
15  #include "SIZE.h"  #include "SIZE.h"
16  #include "GRID.h"  #include "GRID.h"
17  #include "fizhi_ocean_coms.h"  #include "fizhi_ocean_coms.h"
18  #include "EEPARAMS.h"  #include "EEPARAMS.h"
19  #include "chronos.h"  #include "chronos.h"
20    #ifdef ALLOW_EXCH2
21    #include "W2_EXCH2_TOPOLOGY.h"
22    #include "W2_EXCH2_PARAMS.h"
23    #endif /* ALLOW_EXCH2 */
24    
25         integer myTime, myIter, myThid         integer myIter, myThid
26           _RL myTime
27    
28         integer i, j, bi, bj, biglobal, bjglobal         integer i, j, bi, bj, bislot, bjslot
29         integer im1, im2, jm1, jm2, idim1, idim2, jdim1, jdim2         integer im1, im2, jm1, jm2, idim1, idim2, jdim1, jdim2
30         integer nSxglobal, nSyglobal         integer xsize, ysize
        integer ksst,kice  
31         _RL        sstmin         _RL        sstmin
32         parameter ( sstmin = 273.16 )         parameter ( sstmin = 273.16 )
33    
34    #if defined(ALLOW_EXCH2)
35           PARAMETER ( xsize = exch2_domain_nxt * sNx )
36           PARAMETER ( ysize = exch2_domain_nyt * sNy )
37    #else
38           PARAMETER ( xsize = Nx )
39           PARAMETER ( ysize = Ny )
40    #endif
41           _RL sst1(xsize,ysize),sst2(xsize,ysize)
42           _RL sice1(xsize,ysize),sice2(xsize,ysize)
43           integer nymd1sst(nSx,nSy),nymd2sst(nSx,nSy)
44           integer nymd1sice(nSx,nSy),nymd2sice(nSx,nSy)
45           integer nhms1sst(nSx,nSy),nhms2sst(nSx,nSy)
46           integer nhms1sice(nSx,nSy),nhms2sice(nSx,nSy)
47           integer sstdates(370,nSx,nSy),sicedates(370,nSx,nSy)
48           integer ssttimes(370,nSx,nSy),sicetimes(370,nSx,nSy)
49           logical first(nSx,nSy)
50           integer nSxnSy
51           parameter(nSxnSy = nSx*nSy)
52           data first/nSxnSy*.true./
53    
54           save nymd1sst,nymd2sst,nymd1sice,nymd2sice
55           save nhms1sst,nhms2sst,nhms1sice,nhms2sice
56           save sst1, sst2, sice1, sice2
57           save sstdates, sicedates
58           save ssttimes, sicetimes
59    
60         idim1 = 1-OLx         idim1 = 1-OLx
61         idim2 = sNx+OLx         idim2 = sNx+OLx
62         jdim1 = 1-OLy         jdim1 = 1-OLy
# Line 35  c--------------------------------------- Line 65  c---------------------------------------
65         im2 = sNx         im2 = sNx
66         jm1 = 1         jm1 = 1
67         jm2 = sNy         jm2 = sNy
        nSxglobal = nSx*nPx  
        nSyglobal = nSy*nPy  
68    
        call mdsfindunit( ksst, myThid )  
        call mdsfindunit( kice, myThid )  
   
69  C***********************************************************************  C***********************************************************************
70    
71         DO BJ = myByLo(myThid),myByHi(myThid)         DO BJ = myByLo(myThid),myByHi(myThid)
72         DO BI = myBxLo(myThid),myBxHi(myThid)         DO BI = myBxLo(myThid),myBxHi(myThid)
73    #if defined(ALLOW_EXCH2)
74         biglobal=bi+(myXGlobalLo-1)/im2         bislot = exch2_txglobalo(W2_myTileList(bi))-1
75         bjglobal=bj+(myYGlobalLo-1)/jm2         bjslot = exch2_tyglobalo(W2_myTileList(bi))-1
76    #else
77         call getsst(ksst,idim1,idim2,jdim1,jdim2,im1,im2,jm1,jm2,nSx,         bislot = myXGlobalLo-1+(bi-1)*sNx
78       .  nSy,nSxglobal,nSyglobal,bi,bj,biglobal,bjglobal,nymd,nhms,sst)         bjslot = myYGlobalLo-1+(bj-1)*sNy
79         call getsice(kice,idim1,idim2,jdim1,jdim2,im1,im2,jm1,jm2,nSx,  #endif
80       .  nSy,nSxglobal,nSyglobal,bi,bj,biglobal,bjglobal,nymd,nhms,sice)  
81           call getsst(ksst,sstclim,idim1,idim2,jdim1,jdim2,im1,im2,
82         .  jm1,jm2,nSx,nSy,xsize,ysize,bi,bj,bislot,bjslot,nymd,nhms,
83         .  sst1,sst2,first(bi,bj),nymd1sst(bi,bj),nymd2sst(bi,bj),
84         .  nhms1sst(bi,bj),nhms2sst(bi,bj),sstdates(1,bi,bj),
85         .  ssttimes(1,bi,bj),sst,myThid)
86           call getsice(kice,siceclim,idim1,idim2,jdim1,jdim2,im1,im2,
87         .  jm1,jm2,nSx,nSy,xsize,ysize,bi,bj,bislot,bjslot,nymd,nhms,
88         .  sice1,sice2,first(bi,bj),nymd1sice(bi,bj),nymd2sice(bi,bj),
89         .  nhms1sice(bi,bj),nhms2sice(bi,bj),sicedates(1,bi,bj),
90         .  sicetimes(1,bi,bj),sice,myThid)
91    
92  c Check for Minimum Open-Water SST  c Check for Minimum Open-Water SST
93  c --------------------------------  c --------------------------------
# Line 65  c -------------------------------- Line 100  c --------------------------------
100    
101         ENDDO         ENDDO
102         ENDDO         ENDDO
103           _EXCH_XY_R8(sst,myThid)
104           _EXCH_XY_R8(sice,myThid)
105    
106         return         return
107         end         end
108    
109         subroutine getsice(iunit,idim1,idim2,jdim1,jdim2,im1,im2,jm1,jm2,         subroutine getsice(iunit,clim,idim1,idim2,jdim1,jdim2,im1,im2,
110       .     nSumx,nSumy,nPgx,nPgy,bi,bj,biglobal,bjglobal,nymd,nhms,sice)       .   jm1,jm2,nSumx,nSumy,xsize,ysize,bi,bj,bislot,bjslot,nymd,nhms,
111  C************************************************************************       .   sicebc1,sicebc2,first,nymdbc1,nymdbc2,nhmsbc1,nhmsbc2,
112         .   nymdbc,nhmsbc,sice,mythid)
113    C***********************************************************************
114  C  C
115  C!ROUTINE:      GETSICE  C!ROUTINE:      GETSICE
116  C!DESCRIPTION:  GETSICE returns the sea ice depth.  C!DESCRIPTION:  GETSICE returns the sea ice depth.
# Line 91  C!      jm1       Begin of y-direction s Line 130  C!      jm1       Begin of y-direction s
130  C!      jm2       End of y-direction span for filling sice  C!      jm2       End of y-direction span for filling sice
131  C!      nSumx     Number of processors in x-direction (local processor)  C!      nSumx     Number of processors in x-direction (local processor)
132  C!      nSumy     Number of processors in y-direction (local processor)  C!      nSumy     Number of processors in y-direction (local processor)
133  C!      nPgx      Number of processors in x-direction (global)  C!      xsize      Number of processors in x-direction (global)
134  C!      nPgx      Number of processors in y-direction (global)  C!      ysize      Number of processors in y-direction (global)
135  C!      bi        Processor number in x-direction (local to processor)  C!      bi        Processor number in x-direction (local to processor)
136  C!      bj        Processor number in y-direction (local to processor)  C!      bj        Processor number in y-direction (local to processor)
137  C!      biglobal  Processor number in x-direction (global)  C!      bislot  Processor number in x-direction (global)
138  C!      bjglobal  Processor number in y-direction (global)  C!      bjslot  Processor number in y-direction (global)
139  C!      nymd      YYMMDD of the current model timestep  C!      nymd      YYMMDD of the current model timestep
140  C!      nhms      HHMMSS of the model time  C!      nhms      HHMMSS of the model time
141  C  C
# Line 112  C Line 151  C
151  C--------------------------------------------------------------------------  C--------------------------------------------------------------------------
152    
153        implicit none        implicit none
 #include "CPP_EEOPTIONS.h"  
154  #include "SIZE.h"  #include "SIZE.h"
155    
156        integer iunit,idim1,idim2,jdim1,jdim2,im1,im2,jm1,jm2,nSumx,nSumy        integer iunit,idim1,idim2,jdim1,jdim2,im1,im2,jm1,jm2,nSumx,nSumy
157        integer nPgx,nPgy,bi,bj,biglobal,bjglobal,nymd,nhms        integer xsize,ysize,bi,bj,bislot,bjslot,nymd,nhms,mythid
158          logical clim
159    
160          _RL sicebc1(xsize,ysize)
161          _RL sicebc2(xsize,ysize)
162        _RL sice(idim1:idim2,jdim1:jdim2,nSumx,nSumy)        _RL sice(idim1:idim2,jdim1:jdim2,nSumx,nSumy)
163          integer nhmsbc1,nhmsbc2,nymdbc1,nymdbc2
164          logical first
165    
166  C Maximum number of dates in one year for the data  C Maximum number of dates in one year for the data
167        integer   ndmax        integer   ndmax
168        parameter (ndmax = 370)        parameter (ndmax = 370)
169          integer nymdbc(ndmax),nhmsbc(ndmax)
170    
171        character*8  cname        character*8  cname
172        character*80 cdscrip        character*80 cdscrip
173        real fac1, fac2, lat0, lon0, timebc1, timebc2, timemod, undef        character*22 sicedata
174        logical first, found, error        _RL fac1, fac2, lat0, lon0, timebc1, timebc2, timemod, undef
175        integer i,j,n,nn,iyear,iyearbc,nd,ndby3,imbc,jmbc,npxbc,npybc        logical found, error
176        integer ndatebc,nhmsbc(ndmax), nhmsbc1, nhmsbc2,nrec        integer i,j,n,nn,iyear,iyearbc,nd,ndby3,imbc,jmbc
177        integer nymdbc(ndmax),nymdbc1,nymdbc2,nymdmod        integer ndatebc,nrec
178          integer nymdmod
179    
       real sicebc1(sNx,sNy,nSx*nPx,nSy*nPy)  
       real sicebc2(sNx,sNy,nSx*nPx,nSy*nPy)  
180    
181  C--------- Variable Initialization ---------------------------------  C--------- Variable Initialization ---------------------------------
182    
       data first /.true./  
183        data error /.false./        data error /.false./
184    
185  c  save header info  c  save header info
186        save imbc,jmbc,npxbc,npybc,lat0,lon0,ndatebc,undef,nymdbc,nhmsbc        save imbc,jmbc,lat0,lon0,ndatebc,undef
       save nymdbc1, nymdbc2, nhmsbc1, nhmsbc2  
       save first  
       save sicebc1, sicebc2  
187    
188  c  this only works for between 1950-2050  c  this only works for between 1950-2050
189        if (nymd .lt. 500101) then        if (nymd .lt. 500101) then
# Line 155  c  this only works for between 1950-2050 Line 194  c  this only works for between 1950-2050
194          nymdmod = nymd          nymdmod = nymd
195        endif        endif
196    
197          iyear   = nymdmod/10000
198          if(clim) then
199           if(xsize.eq.192)sicedata='sice19232.weekly.clim'
200           if(xsize.eq.612)sicedata='sice612102.weekly.clim'
201          else
202           if(xsize.eq.192)
203         .           WRITE(sicedata,'(A,I4)')'sice19232.weekly.y',iyear
204           if(xsize.eq.612)
205         .           WRITE(sicedata,'(A,I4)')'sice612102.weekly.y',iyear
206          endif
207    
208  c  initialize so that first time through they have values for the check  c  initialize so that first time through they have values for the check
209  c  these vaules make the iyear .ne. iyearbc true anyways for  c  these values make the iyear .ne. iyearbc true anyways for
210  c  for the first time so first isnt checked below.  c  for the first time so first isnt checked below.
211    
212        if (first) then        if (first) then
# Line 170  c  for the first time so first isnt chec Line 220  c  for the first time so first isnt chec
220    
221  C---------- Read in Header file ----------------------------------  C---------- Read in Header file ----------------------------------
222    
       iyear   = nymdmod/10000  
223        iyearbc = nymdbc(2)/10000        iyearbc = nymdbc(2)/10000
224    
225        if( iyear.ne.iyearbc ) then        if( iyear.ne.iyearbc ) then
226    
227         close(iunit)         close(iunit)
228         open (iunit,form='unformatted',access='direct',         open (iunit,file=sicedata,form='unformatted',access='direct',
229       .                                         recl=im2*jm2*nPgx*nPgy*4)       .                                         recl=xsize*ysize*4)
230         nrec = 1         nrec = 1
231         call bcheader (iunit, ndmax, nrec,         call bcheader (iunit, ndmax, nrec,
232       .          cname, cdscrip, imbc, jmbc, npxbc, npybc, lat0, lon0,       .          cname, cdscrip, imbc, jmbc, lat0, lon0,
233       .          ndatebc, nymdbc, nhmsbc, undef, error)       .          ndatebc, nymdbc, nhmsbc, undef, error)
234    
235  C--------- Check data for Compatibility ------------------------------  C--------- Check data for Compatibility ------------------------------
# Line 192  C Check for correct data in boundary con Line 241  C Check for correct data in boundary con
241         endif         endif
242    
243  C Check Horizontal Resolution  C Check Horizontal Resolution
244         if(.not.error.and.imbc*jmbc*npxbc*npybc.ne.im2*jm2*npgx*npgy)then         if(.not.error.and.imbc*jmbc.ne.xsize*ysize)then
245          write(6,*) ' B.C. Resolution DOES NOT match Model Resolution!'          write(6,*) ' B.C. Resolution DOES NOT match Model Resolution!'
246          write(6,*) ' B.C. Resolution:  ',imbc*jmbc*npxbc*npybc          write(6,*) ' B.C. Resolution:  ',imbc*jmbc
247          write(6,*) 'Model Resolution:  ',im2*jm2*npgx*npgy          write(6,*) 'Model Resolution:  ',xsize*ysize
248          error = .true.          error = .true.
249         endif         endif
250    
# Line 226  C  For the last date add 1 year to the c Line 275  C  For the last date add 1 year to the c
275          endif          endif
276    
277  C  Write out header info  C  Write out header info
278            _BEGIN_MASTER( myThid )
279          write(6,*) ' Updated boundary condition data'          write(6,*) ' Updated boundary condition data'
280          write(6,*) ' ---------------------------------'          write(6,*) ' ---------------------------------'
281          write(6,*) ' Variable: ',cname          write(6,*) ' Variable: ',cname
# Line 240  C  Write out header info Line 290  C  Write out header info
290   1000    format(3(2x,i3,':',i8,2x,i8))   1000    format(3(2x,i3,':',i8,2x,i8))
291          enddo          enddo
292          write(6,1000) (nn,nymdbc(nn),nhmsbc(nn),nn=ndby3*3+1,ndatebc)          write(6,1000) (nn,nymdbc(nn),nhmsbc(nn),nn=ndby3*3+1,ndatebc)
293            _END_MASTER( myThid )
294         endif           endif  
295    
296        endif        endif
# Line 252  C---------- Read sice data if necessary Line 303  C---------- Read sice data if necessary
303  c  If model time is not within the times of saved sice data  c  If model time is not within the times of saved sice data
304  c  from previous call to getsice then read new data  c  from previous call to getsice then read new data
305    
306        timemod = float(nymdmod) + float(nhms)   /1000000        timemod = dfloat(nymdmod) + dfloat(nhms)   /1000000
307        timebc1 = float(nymdbc1) + float(nhmsbc1)/1000000        timebc1 = dfloat(nymdbc1) + dfloat(nhmsbc1)/1000000
308        timebc2 = float(nymdbc2) + float(nhmsbc2)/1000000        timebc2 = dfloat(nymdbc2) + dfloat(nhmsbc2)/1000000
309    
310        if (timemod .lt. timebc1 .or. timemod .ge. timebc2) then        if (timemod .lt. timebc1 .or. timemod .ge. timebc2) then
311    
312         do while (.not.found .and. nd .le. ndatebc)         do while (.not.found .and. nd .le. ndatebc)
313          timebc2 = float(nymdbc(nd)) + float(nhmsbc(nd))/1000000          timebc2 = dfloat(nymdbc(nd)) + dfloat(nhmsbc(nd))/1000000
314          if (timebc2 .gt. timemod) then            if (timebc2 .gt. timemod) then  
315           nymdbc1 = nymdbc(nd-1)           nymdbc1 = nymdbc(nd-1)
316           nymdbc2 = nymdbc(nd)           nymdbc2 = nymdbc(nd)
317           nhmsbc1 = nhmsbc(nd-1)           nhmsbc1 = nhmsbc(nd-1)
318           nhmsbc2 = nhmsbc(nd)           nhmsbc2 = nhmsbc(nd)
319           call bcdata (iunit,imbc,jmbc,nPgx,nPgy,nd,nd+1,sicebc1,sicebc2)           call bcdata (iunit,imbc,jmbc,nd,nd+1,sicebc1,sicebc2)
320           found = .true.           found = .true.
321          else          else
322           nd = nd + 1           nd = nd + 1
# Line 292  C---------- Interpolate sice data ------ Line 343  C---------- Interpolate sice data ------
343    
344        do j = jm1,jm2        do j = jm1,jm2
345        do i = im1,im2        do i = im1,im2
346         sice(i,j,bi,bj) = sicebc1(i,j,biglobal,bjglobal)*fac1         sice(i,j,bi,bj) = sicebc1(i+bislot,j+bjslot)*fac1
347       .                 + sicebc2(i,j,biglobal,bjglobal)*fac2       .                 + sicebc2(i+bislot,j+bjslot)*fac2
348  c average to 0 or 1  c average to 0 or 1
349  c -----------------  c -----------------
350         if (sice(i,j,bi,bj) .ge. 0.5) then         if (sice(i,j,bi,bj) .ge. 0.5) then
# Line 316  C--------------------------------------- Line 367  C---------------------------------------
367    
368        return        return
369        end        end
370        subroutine getsst(iunit,idim1,idim2,jdim1,jdim2,im1,im2,jm1,jm2,        subroutine getsst(iunit,clim,idim1,idim2,jdim1,jdim2,im1,im2,
371       .      nSumx,nSumy,nPgx,nPgy,bi,bj,biglobal,bjglobal,nymd,nhms,sst)       .   jm1,jm2,nSumx,nSumy,xsize,ysize,bi,bj,bislot,bjslot,nymd,nhms,
372  C************************************************************************       .   sstbc1,sstbc2,first,nymdbc1,nymdbc2,nhmsbc1,nhmsbc2,
373         .   nymdbc,nhmsbc,sst,mythid)
374    C***********************************************************************
375  C  C
376  C!ROUTINE:      GETSST  C!ROUTINE:      GETSST
377  C!DESCRIPTION:  GETSST gets the SST data.  C!DESCRIPTION:  GETSST gets the SST data.
# Line 332  C!      idim1     Start dimension in x-d Line 385  C!      idim1     Start dimension in x-d
385  C!      idim2     End dimension in x-direction  C!      idim2     End dimension in x-direction
386  C!      jdim1     Start dimension in y-direction  C!      jdim1     Start dimension in y-direction
387  C!      jdim2     End dimension in y-direction  C!      jdim2     End dimension in y-direction
388  C!      im1       Begin of x-direction span for filling sice  C!      im1       Begin of x-direction span for filling sst
389  C!      im2       End of x-direction span for filling sice  C!      im2       End of x-direction span for filling sst
390  C!      jm1       Begin of y-direction span for filling sice  C!      jm1       Begin of y-direction span for filling sst
391  C!      jm2       End of y-direction span for filling sice  C!      jm2       End of y-direction span for filling sst
392  C!      nSumx     Number of processors in x-direction (local processor)  C!      nSumx     Number of processors in x-direction (local processor)
393  C!      nSumy     Number of processors in y-direction (local processor)  C!      nSumy     Number of processors in y-direction (local processor)
394  C!      nPgx      Number of processors in x-direction (global)  C!      xsize     x-dimension of global array
395  C!      nPgy      Number of processors in y-direction (global)  C!      ysize     y-dimension of global array
396  C!      bi        Processor number in x-direction (local to processor)  C!      bi        Processor number in x-direction (local to processor)
397  C!      bj        Processor number in y-direction (local to processor)  C!      bj        Processor number in y-direction (local to processor)
398  C!      biglobal  Processor number in x-direction (global)  C!      bislot    Slot number into global array in x-direction (global)
399  C!      bjglobal  Processor number in y-direction (global)  C!      bjslot    Slot number into global array in y-direction (global)
400  C!      nymd      YYMMDD of the current model timestep  C!      nymd      YYMMDD of the current model timestep
401  C!      nhms      HHMMSS of the model time  C!      nhms      HHMMSS of the model time
402  C  C
# Line 354  C!ROUTINES CALLED: Line 407  C!ROUTINES CALLED:
407  C  C
408  C!      bcdata          Reads the data for a given unit number  C!      bcdata          Reads the data for a given unit number
409  C!      bcheader        Reads the header info for a given unit number  C!      bcheader        Reads the header info for a given unit number
410  C!     interp_time   Returns weights for linear interpolation  C!     interp_time      Returns weights for linear interpolation
411  C  C
412  C--------------------------------------------------------------------------  C--------------------------------------------------------------------------
413    
414        implicit none        implicit none
 #include "CPP_EEOPTIONS.h"  
415  #include "SIZE.h"  #include "SIZE.h"
416    
417        integer iunit,idim1,idim2,jdim1,jdim2,im1,im2,jm1,jm2,nSumx,nSumy        integer iunit,idim1,idim2,jdim1,jdim2,im1,im2,jm1,jm2,nSumx,nSumy
418        integer nPgx,nPgy,bi,bj,biglobal,bjglobal,nymd,nhms        integer xsize,ysize,bi,bj,bislot,bjslot,nymd,nhms,mythid
419          logical clim
420    
421          _RL sstbc1(xsize,ysize)
422          _RL sstbc2(xsize,ysize)
423        _RL sst(idim1:idim2,jdim1:jdim2,nSumx,nSumy)        _RL sst(idim1:idim2,jdim1:jdim2,nSumx,nSumy)
424          integer nhmsbc1,nhmsbc2,nymdbc1,nymdbc2
425          logical first
426    
427  C Maximum number of dates in one year for the data  C Maximum number of dates in one year for the data
428        integer   ndmax        integer   ndmax
429        parameter (ndmax = 370)        parameter (ndmax = 370)
430          integer nymdbc(ndmax),nhmsbc(ndmax)
431    
432        character*8  cname        character*8  cname
433        character*80 cdscrip        character*80 cdscrip
434        real fac1, fac2, lat0, lon0, timebc1, timebc2, timemod, undef        character*21 sstdata
435        logical first, found, error        _RL fac1, fac2, lat0, lon0, timebc1, timebc2, timemod, undef
436        integer i,j,n,nn,iyear,iyearbc,nd,ndby3,imbc,jmbc,npxbc,npybc        logical found, error
437        integer ndatebc,nhmsbc(ndmax), nhmsbc1, nhmsbc2,nrec        integer i,j,n,nn,iyear,iyearbc,nd,ndby3,imbc,jmbc
438        integer nymdbc(ndmax),nymdbc1,nymdbc2,nymdmod        integer ndatebc,nrec
439          integer nymdmod
440    
       real sstbc1(sNx,sNy,nSx*nPx,nSy*nPy)  
       real sstbc2(sNx,sNy,nSx*nPx,nSy*nPy)  
441    
442  C--------- Variable Initialization ---------------------------------  C--------- Variable Initialization ---------------------------------
443    
       data first /.true./  
444        data error /.false./        data error /.false./
445    
446  c  save header info  c  save header info
447        save imbc,jmbc,npxbc,npybc,lat0,lon0,ndatebc,undef,nymdbc,nhmsbc        save imbc,jmbc,lat0,lon0,ndatebc,undef
       save nymdbc1, nymdbc2, nhmsbc1, nhmsbc2  
       save first  
       save sstbc1, sstbc2  
448    
449  c  this only works for between 1950-2050  c  this only works for between 1950-2050
450        if (nymd .lt. 500101) then        if (nymd .lt. 500101) then
# Line 402  c  this only works for between 1950-2050 Line 455  c  this only works for between 1950-2050
455          nymdmod = nymd          nymdmod = nymd
456        endif        endif
457    
458          iyear   = nymdmod/10000
459          if(clim) then
460           if(xsize.eq.192)sstdata='sst19232.weekly.clim'
461           if(xsize.eq.612)sstdata='sst612102.weekly.clim'
462          else
463           if(xsize.eq.192)
464         .           WRITE(sstdata,'(A,I4)')'sst19232.weekly.y',iyear
465           if(xsize.eq.612)
466         .           WRITE(sstdata,'(A,I4)')'sst612102.weekly.y',iyear
467          endif
468    
469  c  initialize so that first time through they have values for the check  c  initialize so that first time through they have values for the check
470  c  these vaules make the iyear .ne. iyearbc true anyways for  c  these vaules make the iyear .ne. iyearbc true anyways for
471  c  for the first time so first isnt checked below.  c  for the first time so first isnt checked below.
# Line 416  c  for the first time so first isnt chec Line 480  c  for the first time so first isnt chec
480    
481  C---------- Read in Header file ----------------------------------  C---------- Read in Header file ----------------------------------
482    
       iyear   = nymdmod/10000  
483        iyearbc = nymdbc(2)/10000        iyearbc = nymdbc(2)/10000
484    
485        if( iyear.ne.iyearbc ) then        if( iyear.ne.iyearbc ) then
486    
487         close(iunit)         close(iunit)
488         open (iunit,form='unformatted',access='direct',         open (iunit,file=sstdata,form='unformatted',access='direct',
489       .                                        recl=im2*jm2*nPgx*nPgy*4)       .                                        recl=xsize*ysize*4)
490         nrec = 1         nrec = 1
491         call bcheader (iunit, ndmax, nrec,         call bcheader (iunit, ndmax, nrec,
492       .          cname, cdscrip, imbc, jmbc, npxbc, npybc, lat0, lon0,       .          cname, cdscrip, imbc, jmbc, lat0, lon0,
493       .          ndatebc, nymdbc, nhmsbc, undef, error)       .          ndatebc, nymdbc, nhmsbc, undef, error)
494    
495  C--------- Check data for Compatibility  C--------- Check data for Compatibility
# Line 438  C Check for correct data in boundary con Line 501  C Check for correct data in boundary con
501         endif         endif
502    
503  C Check Horizontal Resolution  C Check Horizontal Resolution
504         if(.not.error.and.imbc*jmbc*npxbc*npybc.ne.im2*jm2*npgx*npgy)then         if(.not.error.and.imbc*jmbc.ne.xsize*ysize)then
505          write(6,*) ' B.C. Resolution DOES NOT match Model Resolution!'          write(6,*) ' B.C. Resolution DOES NOT match Model Resolution!'
506          write(6,*) ' B.C. Resolution:  ',imbc*jmbc*npxbc*npybc          write(6,*) ' B.C. Resolution:  ',imbc*jmbc
507          write(6,*) 'Model Resolution:  ',im2*jm2*npgx*npgy          write(6,*) 'Model Resolution:  ',xsize*ysize
508          error = .true.          error = .true.
509         endif         endif
510    
# Line 472  C  For the last date add 1 year to the c Line 535  C  For the last date add 1 year to the c
535          endif          endif
536    
537  C  Write out header info  C  Write out header info
538            _BEGIN_MASTER( myThid )
539          write(6,*) ' Updated boundary condition data'          write(6,*) ' Updated boundary condition data'
540          write(6,*) ' ---------------------------------'          write(6,*) ' ---------------------------------'
541          write(6,*) ' Variable: ',cname          write(6,*) ' Variable: ',cname
# Line 486  C  Write out header info Line 550  C  Write out header info
550   1000    format(3(2x,i3,':',i8,2x,i8))   1000    format(3(2x,i3,':',i8,2x,i8))
551          enddo          enddo
552          write(6,1000) (nn,nymdbc(nn),nhmsbc(nn),nn=ndby3*3+1,ndatebc)          write(6,1000) (nn,nymdbc(nn),nhmsbc(nn),nn=ndby3*3+1,ndatebc)
553            _END_MASTER( myThid )
554         endif         endif
555    
556         if( error ) call my_exit (101)         if( error ) call my_exit (101)
# Line 500  C---------- Read SST data if necessary - Line 565  C---------- Read SST data if necessary -
565  c  If model time is not within the times of saved sst data  c  If model time is not within the times of saved sst data
566  c  from previous call to getsst then read new data  c  from previous call to getsst then read new data
567    
568        timemod = float(nymdmod) + float(nhms)   /1000000        timemod = dfloat(nymdmod) + dfloat(nhms)   /1000000
569        timebc1 = float(nymdbc1) + float(nhmsbc1)/1000000        timebc1 = dfloat(nymdbc1) + dfloat(nhmsbc1)/1000000
570        timebc2 = float(nymdbc2) + float(nhmsbc2)/1000000        timebc2 = dfloat(nymdbc2) + dfloat(nhmsbc2)/1000000
571    
572        if (timemod .lt. timebc1 .or. timemod .ge. timebc2) then        if (timemod .lt. timebc1 .or. timemod .ge. timebc2) then
573    
574         do while (.not.found .and. nd .le. ndatebc)         do while (.not.found .and. nd .le. ndatebc)
575          timebc2 = float(nymdbc(nd)) + float(nhmsbc(nd))/1000000          timebc2 = dfloat(nymdbc(nd)) + dfloat(nhmsbc(nd))/1000000
576          if (timebc2 .gt. timemod) then            if (timebc2 .gt. timemod) then  
577           nymdbc1 = nymdbc(nd-1)           nymdbc1 = nymdbc(nd-1)
578           nymdbc2 = nymdbc(nd)           nymdbc2 = nymdbc(nd)
579           nhmsbc1 = nhmsbc(nd-1)           nhmsbc1 = nhmsbc(nd-1)
580           nhmsbc2 = nhmsbc(nd)           nhmsbc2 = nhmsbc(nd)
581           call bcdata (iunit,imbc,jmbc,nPgx,nPgy,nd,nd+1,sstbc1,sstbc2)           call bcdata (iunit,imbc,jmbc,nd,nd+1,sstbc1,sstbc2)
582           found = .true.           found = .true.
583          else          else
584           nd = nd + 1           nd = nd + 1
# Line 539  C---------- Interpolate SST data ------- Line 605  C---------- Interpolate SST data -------
605    
606        do j = jm1,jm2        do j = jm1,jm2
607        do i = im1,im2        do i = im1,im2
608         sst(i,j,bi,bj) = sstbc1(i,j,biglobal,bjglobal)*fac1         sst(i,j,bi,bj) = sstbc1(i+bislot,j+bjslot)*fac1
609       .                + sstbc2(i,j,biglobal,bjglobal)*fac2       .                + sstbc2(i+bislot,j+bjslot)*fac2
610        enddo        enddo
611        enddo        enddo
612    
613    
614        return        return
615        end        end
616    
617        subroutine bcdata (iunit,im,jm,nPx,nPy,nrec1,nrec2,field1,field2)        subroutine bcdata (iunit,im,jm,nrec1,nrec2,field1,field2)
618  C************************************************************************  C************************************************************************
619  C  C
620  C!ROUTINE:      BCDATA  C!ROUTINE:      BCDATA
# Line 559  C Line 626  C
626  C!INPUT PARAMETERS:  C!INPUT PARAMETERS:
627  C!      im      number of x points  C!      im      number of x points
628  C!      im      number of x points  C!      im      number of x points
 C!      nPx     number of faces in x-direction  
 C!      nPy     number of faces in y-direction  
629  C!      nrec1   record number of the time before the model time  C!      nrec1   record number of the time before the model time
630  C!      nrec2   record number of the time after the model time  C!      nrec2   record number of the time after the model time
631  C  C
632  C!OUTPUT PARAMETERS:  C!OUTPUT PARAMETERS:
633  C!      field1(im,jm,nPx,nPy)  data field before the model time  C!      field1(im,jm)  data field before the model time
634  C!      field2(im,jm,nPx,nPy)  data field after the model time  C!      field2(im,jm)  data field after the model time
635  C  C
636  C--------------------------------------------------------------------------  C--------------------------------------------------------------------------
637        implicit none        implicit none
 #include "CPP_EEOPTIONS.h"  
638    
639        integer iunit,im,jm,nPx,nPy,nrec1,nrec2        integer iunit,im,jm,nrec1,nrec2
640    
641        real  field1(im,jm,nPx,nPy)        _RL  field1(im,jm)
642        real  field2(im,jm,nPx,nPy)        _RL  field2(im,jm)
643    
644        integer i,j,n1,n2        integer i,j
645        real*4 f1(im,jm,nPx,nPy), f2(im,jm,nPx,nPy)        real*4 f1(im,jm), f2(im,jm)
646    
647  C--------- Read file -----------------------------------------------  C--------- Read file -----------------------------------------------
648        read(iunit,rec=nrec1) f1        read(iunit,rec=nrec1) f1
649        read(iunit,rec=nrec2) f2        read(iunit,rec=nrec2) f2
650    
651        do n2=1,nPy  #ifdef _BYTESWAPIO
652        do n1=1,nPx        call MDS_BYTESWAPR4( im*jm, f1)
653          call MDS_BYTESWAPR4( im*jm, f2)
654    #endif
655        do j=1,jm        do j=1,jm
656        do i=1,im        do i=1,im
657         field1(i,j,n1,n2) = f1(i,j,n1,n2)         field1(i,j) = f1(i,j)
658         field2(i,j,n1,n2) = f2(i,j,n1,n2)         field2(i,j) = f2(i,j)
       enddo  
       enddo  
659        enddo        enddo
660        enddo        enddo
661    
662        return        return
663        end        end
664        subroutine bcheader (iunit, ndmax, nrec,        subroutine bcheader (iunit, ndmax, nrec,
665       .           cname, cdscrip, im, jm, npx, npy, lat0, lon0, ndatebc,       .           cname, cdscrip, im, jm, lat0, lon0, ndatebc,
666       .           nymdbc, nhmsbc, undef, error)       .           nymdbc, nhmsbc, undef, error)
667  C************************************************************************  C************************************************************************
668  C  C
# Line 615  C!      cname         name of the data i Line 679  C!      cname         name of the data i
679  C!      cdscrip       description of the data in the file header  C!      cdscrip       description of the data in the file header
680  C!      im            number of x points  C!      im            number of x points
681  C!      jm            number of y points  C!      jm            number of y points
 C!      npx           number of faces (processors) in x-direction  
 C!      npy           number of faces (processors) in x-direction  
682  C!      lat0          starting latitude for the data grid  C!      lat0          starting latitude for the data grid
683  C!      lon0          starting longitude for the data grid  C!      lon0          starting longitude for the data grid
684  C!      ndatebc       number of date/times of the data in the file  C!      ndatebc       number of date/times of the data in the file
# Line 627  C!      error         logical TRUE if da Line 689  C!      error         logical TRUE if da
689  C  C
690  C--------------------------------------------------------------------------  C--------------------------------------------------------------------------
691        implicit none        implicit none
 #include "CPP_EEOPTIONS.h"  
692    
693        integer iunit, ndmax, nrec        integer iunit, ndmax, nrec
694    
695        character*8  cname        character*8  cname
696        character*80 cdscrip        character*80 cdscrip
697        integer im,jm,npx,npy,ndatebc,nymdbc(ndmax),nhmsbc(ndmax)        character*112 dummy112
698        real lat0,lon0,undef        integer im,jm,ndatebc,nymdbc(ndmax),nhmsbc(ndmax)
699          _RL lat0,lon0,undef
700        logical error        logical error
701    
702        integer i        integer i
703        integer*4 im_32,jm_32,npx_32,npy_32        integer*4 im_32,jm_32
704        integer*4 ndatebc_32,nhmsbc_32(ndmax),nymdbc_32(ndmax)        integer*4 ndatebc_32,nhmsbc_32(ndmax),nymdbc_32(ndmax)
705        real*4 lat0_32,lon0_32,undef_32        real*4 lat0_32,lon0_32,undef_32
706    
707  C--------- Read file -----------------------------------------------  C--------- Read file -----------------------------------------------
708    
709        read(iunit,rec=nrec,err=500) cname, cdscrip,        read(iunit,rec=nrec,err=500) cname, cdscrip,
710       .     im_32, jm_32, npx_32, npy_32, lat0_32, lon0_32,       .     im_32, jm_32, lat0_32, lon0_32,
711       .     ndatebc_32, undef_32,       .     ndatebc_32, undef_32
712    
713    #ifdef _BYTESWAPIO
714          call MDS_BYTESWAPI4( 1, im_32)
715          call MDS_BYTESWAPI4( 1, jm_32)
716          call MDS_BYTESWAPR4( 1, lat0_32)
717          call MDS_BYTESWAPR4( 1, lon0_32)
718          call MDS_BYTESWAPI4( 1, ndatebc_32)
719          call MDS_BYTESWAPR4( 1, undef_32)
720    #endif
721    
722          read(iunit,rec=nrec,err=500) dummy112,
723       .     (nymdbc_32(i), nhmsbc_32(i), i=1,ndatebc_32)       .     (nymdbc_32(i), nhmsbc_32(i), i=1,ndatebc_32)
724    
725        im = im_32        im = im_32
726        jm = jm_32        jm = jm_32
       npx = npx_32  
       npy = npy_32  
727        lat0 = lat0_32        lat0 = lat0_32
728        lon0 = lon0_32        lon0 = lon0_32
729        undef = undef_32        undef = undef_32
730    
731        ndatebc = ndatebc_32        ndatebc = ndatebc_32
732        do i=1,ndatebc        do i=1,ndatebc
733    #ifdef _BYTESWAPIO
734          call MDS_BYTESWAPI4( 1, nymdbc_32(i))
735          call MDS_BYTESWAPI4( 1, nhmsbc_32(i))
736    #endif
737        nymdbc(i) = nymdbc_32(i)        nymdbc(i) = nymdbc_32(i)
738        nhmsbc(i) = nhmsbc_32(i)        nhmsbc(i) = nhmsbc_32(i)
739        enddo        enddo
Legend:
Removed from v.1.11  
changed lines
  Added in v.1.27
  ViewVC Help
Powered by ViewVC 1.1.22