/[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.14 by molod, Fri Oct 22 14:52:14 2004 UTC revision 1.25 by molod, Mon Mar 12 21:59:10 2007 UTC
# Line 17  c--------------------------------------- Line 17  c---------------------------------------
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 myIter, myThid         integer myIter, myThid
26         _RL myTime         _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 36  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           bislot = exch2_txglobalo(W2_myTileList(bi))-1
75           bjslot = exch2_tyglobalo(W2_myTileList(bi))-1
76    #else
77           bislot = myXGlobalLo-1+(bi-1)*sNx
78           bjslot = myYGlobalLo-1+(bj-1)*sNy
79    #endif
80    
81         biglobal=bi+(myXGlobalLo-1)/im2         call getsst(ksst,sstclim,idim1,idim2,jdim1,jdim2,im1,im2,
82         bjglobal=bj+(myYGlobalLo-1)/jm2       .  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         call getsst(ksst,idim1,idim2,jdim1,jdim2,im1,im2,jm1,jm2,nSx,       .  nhms1sst(bi,bj),nhms2sst(bi,bj),sstdates(1,bi,bj),
85       .  nSy,nSxglobal,nSyglobal,bi,bj,biglobal,bjglobal,nymd,nhms,sst)       .  ssttimes(1,bi,bj),sst,myThid)
86         call getsice(kice,idim1,idim2,jdim1,jdim2,im1,im2,jm1,jm2,nSx,         call getsice(kice,siceclim,idim1,idim2,jdim1,jdim2,im1,im2,
87       .  nSy,nSxglobal,nSyglobal,bi,bj,biglobal,bjglobal,nymd,nhms,sice)       .  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 66  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 92  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 116  C--------------------------------------- Line 154  C---------------------------------------
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          character*40 sicedata
174        _RL fac1, fac2, lat0, lon0, timebc1, timebc2, timemod, undef        _RL fac1, fac2, lat0, lon0, timebc1, timebc2, timemod, undef
175        logical first, found, error        logical found, error
176        integer i,j,n,nn,iyear,iyearbc,nd,ndby3,imbc,jmbc,npxbc,npybc        integer i,j,n,nn,iyear,iyearbc,nd,ndby3,imbc,jmbc
177        integer ndatebc,nhmsbc(ndmax), nhmsbc1, nhmsbc2,nrec        integer ndatebc,nrec
178        integer nymdbc(ndmax),nymdbc1,nymdbc2,nymdmod        integer nymdmod
179    
       _RL sicebc1(sNx,sNy,nSx*nPx,nSy*nPy)  
       _RL 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          sicedata='sice19232.weekly.clim'
198    
199  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
200  c  these vaules make the iyear .ne. iyearbc true anyways for  c  these values make the iyear .ne. iyearbc true anyways for
201  c  for the first time so first isnt checked below.  c  for the first time so first isnt checked below.
202    
203        if (first) then        if (first) then
# Line 176  C---------- Read in Header file -------- Line 217  C---------- Read in Header file --------
217        if( iyear.ne.iyearbc ) then        if( iyear.ne.iyearbc ) then
218    
219         close(iunit)         close(iunit)
220         open (iunit,form='unformatted',access='direct',         open (iunit,file=sicedata,form='unformatted',access='direct',
221       .                                         recl=im2*jm2*nPgx*nPgy*4)       .                                         recl=xsize*ysize*4)
222         nrec = 1         nrec = 1
223         call bcheader (iunit, ndmax, nrec,         call bcheader (iunit, ndmax, nrec,
224       .          cname, cdscrip, imbc, jmbc, npxbc, npybc, lat0, lon0,       .          cname, cdscrip, imbc, jmbc, lat0, lon0,
225       .          ndatebc, nymdbc, nhmsbc, undef, error)       .          ndatebc, nymdbc, nhmsbc, undef, error)
226    
227  C--------- Check data for Compatibility ------------------------------  C--------- Check data for Compatibility ------------------------------
# Line 192  C Check for correct data in boundary con Line 233  C Check for correct data in boundary con
233         endif         endif
234    
235  C Check Horizontal Resolution  C Check Horizontal Resolution
236         if(.not.error.and.imbc*jmbc*npxbc*npybc.ne.im2*jm2*npgx*npgy)then         if(.not.error.and.imbc*jmbc.ne.xsize*ysize)then
237          write(6,*) ' B.C. Resolution DOES NOT match Model Resolution!'          write(6,*) ' B.C. Resolution DOES NOT match Model Resolution!'
238          write(6,*) ' B.C. Resolution:  ',imbc*jmbc*npxbc*npybc          write(6,*) ' B.C. Resolution:  ',imbc*jmbc
239          write(6,*) 'Model Resolution:  ',im2*jm2*npgx*npgy          write(6,*) 'Model Resolution:  ',xsize*ysize
240          error = .true.          error = .true.
241         endif         endif
242    
# Line 226  C  For the last date add 1 year to the c Line 267  C  For the last date add 1 year to the c
267          endif          endif
268    
269  C  Write out header info  C  Write out header info
270            _BEGIN_MASTER( myThid )
271          write(6,*) ' Updated boundary condition data'          write(6,*) ' Updated boundary condition data'
272          write(6,*) ' ---------------------------------'          write(6,*) ' ---------------------------------'
273          write(6,*) ' Variable: ',cname          write(6,*) ' Variable: ',cname
# Line 240  C  Write out header info Line 282  C  Write out header info
282   1000    format(3(2x,i3,':',i8,2x,i8))   1000    format(3(2x,i3,':',i8,2x,i8))
283          enddo          enddo
284          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)
285            _END_MASTER( myThid )
286         endif           endif  
287    
288        endif        endif
# Line 252  C---------- Read sice data if necessary Line 295  C---------- Read sice data if necessary
295  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
296  c  from previous call to getsice then read new data  c  from previous call to getsice then read new data
297    
298        timemod = float(nymdmod) + float(nhms)   /1000000        timemod = dfloat(nymdmod) + dfloat(nhms)   /1000000
299        timebc1 = float(nymdbc1) + float(nhmsbc1)/1000000        timebc1 = dfloat(nymdbc1) + dfloat(nhmsbc1)/1000000
300        timebc2 = float(nymdbc2) + float(nhmsbc2)/1000000        timebc2 = dfloat(nymdbc2) + dfloat(nhmsbc2)/1000000
301    
302        if (timemod .lt. timebc1 .or. timemod .ge. timebc2) then        if (timemod .lt. timebc1 .or. timemod .ge. timebc2) then
303    
304         do while (.not.found .and. nd .le. ndatebc)         do while (.not.found .and. nd .le. ndatebc)
305          timebc2 = float(nymdbc(nd)) + float(nhmsbc(nd))/1000000          timebc2 = dfloat(nymdbc(nd)) + dfloat(nhmsbc(nd))/1000000
306          if (timebc2 .gt. timemod) then            if (timebc2 .gt. timemod) then  
307           nymdbc1 = nymdbc(nd-1)           nymdbc1 = nymdbc(nd-1)
308           nymdbc2 = nymdbc(nd)           nymdbc2 = nymdbc(nd)
309           nhmsbc1 = nhmsbc(nd-1)           nhmsbc1 = nhmsbc(nd-1)
310           nhmsbc2 = nhmsbc(nd)           nhmsbc2 = nhmsbc(nd)
311           call bcdata (iunit,imbc,jmbc,nPgx,nPgy,nd,nd+1,sicebc1,sicebc2)           call bcdata (iunit,imbc,jmbc,nd,nd+1,sicebc1,sicebc2)
312           found = .true.           found = .true.
313          else          else
314           nd = nd + 1           nd = nd + 1
# Line 292  C---------- Interpolate sice data ------ Line 335  C---------- Interpolate sice data ------
335    
336        do j = jm1,jm2        do j = jm1,jm2
337        do i = im1,im2        do i = im1,im2
338         sice(i,j,bi,bj) = sicebc1(i,j,biglobal,bjglobal)*fac1         sice(i,j,bi,bj) = sicebc1(i+bislot,j+bjslot)*fac1
339       .                 + sicebc2(i,j,biglobal,bjglobal)*fac2       .                 + sicebc2(i+bislot,j+bjslot)*fac2
340  c average to 0 or 1  c average to 0 or 1
341  c -----------------  c -----------------
342         if (sice(i,j,bi,bj) .ge. 0.5) then         if (sice(i,j,bi,bj) .ge. 0.5) then
# Line 316  C--------------------------------------- Line 359  C---------------------------------------
359    
360        return        return
361        end        end
362        subroutine getsst(iunit,idim1,idim2,jdim1,jdim2,im1,im2,jm1,jm2,        subroutine getsst(iunit,clim,idim1,idim2,jdim1,jdim2,im1,im2,
363       .      nSumx,nSumy,nPgx,nPgy,bi,bj,biglobal,bjglobal,nymd,nhms,sst)       .   jm1,jm2,nSumx,nSumy,xsize,ysize,bi,bj,bislot,bjslot,nymd,nhms,
364  C************************************************************************       .   sstbc1,sstbc2,first,nymdbc1,nymdbc2,nhmsbc1,nhmsbc2,
365         .   nymdbc,nhmsbc,sst,mythid)
366    C***********************************************************************
367  C  C
368  C!ROUTINE:      GETSST  C!ROUTINE:      GETSST
369  C!DESCRIPTION:  GETSST gets the SST data.  C!DESCRIPTION:  GETSST gets the SST data.
# Line 332  C!      idim1     Start dimension in x-d Line 377  C!      idim1     Start dimension in x-d
377  C!      idim2     End dimension in x-direction  C!      idim2     End dimension in x-direction
378  C!      jdim1     Start dimension in y-direction  C!      jdim1     Start dimension in y-direction
379  C!      jdim2     End dimension in y-direction  C!      jdim2     End dimension in y-direction
380  C!      im1       Begin of x-direction span for filling sice  C!      im1       Begin of x-direction span for filling sst
381  C!      im2       End of x-direction span for filling sice  C!      im2       End of x-direction span for filling sst
382  C!      jm1       Begin of y-direction span for filling sice  C!      jm1       Begin of y-direction span for filling sst
383  C!      jm2       End of y-direction span for filling sice  C!      jm2       End of y-direction span for filling sst
384  C!      nSumx     Number of processors in x-direction (local processor)  C!      nSumx     Number of processors in x-direction (local processor)
385  C!      nSumy     Number of processors in y-direction (local processor)  C!      nSumy     Number of processors in y-direction (local processor)
386  C!      nPgx      Number of processors in x-direction (global)  C!      xsize     x-dimension of global array
387  C!      nPgy      Number of processors in y-direction (global)  C!      ysize     y-dimension of global array
388  C!      bi        Processor number in x-direction (local to processor)  C!      bi        Processor number in x-direction (local to processor)
389  C!      bj        Processor number in y-direction (local to processor)  C!      bj        Processor number in y-direction (local to processor)
390  C!      biglobal  Processor number in x-direction (global)  C!      bislot    Slot number into global array in x-direction (global)
391  C!      bjglobal  Processor number in y-direction (global)  C!      bjslot    Slot number into global array in y-direction (global)
392  C!      nymd      YYMMDD of the current model timestep  C!      nymd      YYMMDD of the current model timestep
393  C!      nhms      HHMMSS of the model time  C!      nhms      HHMMSS of the model time
394  C  C
# Line 354  C!ROUTINES CALLED: Line 399  C!ROUTINES CALLED:
399  C  C
400  C!      bcdata          Reads the data for a given unit number  C!      bcdata          Reads the data for a given unit number
401  C!      bcheader        Reads the header info for a given unit number  C!      bcheader        Reads the header info for a given unit number
402  C!     interp_time   Returns weights for linear interpolation  C!     interp_time      Returns weights for linear interpolation
403  C  C
404  C--------------------------------------------------------------------------  C--------------------------------------------------------------------------
405    
# Line 362  C--------------------------------------- Line 407  C---------------------------------------
407  #include "SIZE.h"  #include "SIZE.h"
408    
409        integer iunit,idim1,idim2,jdim1,jdim2,im1,im2,jm1,jm2,nSumx,nSumy        integer iunit,idim1,idim2,jdim1,jdim2,im1,im2,jm1,jm2,nSumx,nSumy
410        integer nPgx,nPgy,bi,bj,biglobal,bjglobal,nymd,nhms        integer xsize,ysize,bi,bj,bislot,bjslot,nymd,nhms,mythid
411          logical clim
412    
413          _RL sstbc1(xsize,ysize)
414          _RL sstbc2(xsize,ysize)
415        _RL sst(idim1:idim2,jdim1:jdim2,nSumx,nSumy)        _RL sst(idim1:idim2,jdim1:jdim2,nSumx,nSumy)
416          integer nhmsbc1,nhmsbc2,nymdbc1,nymdbc2
417          logical first
418    
419  C Maximum number of dates in one year for the data  C Maximum number of dates in one year for the data
420        integer   ndmax        integer   ndmax
421        parameter (ndmax = 370)        parameter (ndmax = 370)
422          integer nymdbc(ndmax),nhmsbc(ndmax)
423    
424        character*8  cname        character*8  cname
425        character*80 cdscrip        character*80 cdscrip
426          character*20 sstdata
427        _RL fac1, fac2, lat0, lon0, timebc1, timebc2, timemod, undef        _RL fac1, fac2, lat0, lon0, timebc1, timebc2, timemod, undef
428        logical first, found, error        logical found, error
429        integer i,j,n,nn,iyear,iyearbc,nd,ndby3,imbc,jmbc,npxbc,npybc        integer i,j,n,nn,iyear,iyearbc,nd,ndby3,imbc,jmbc
430        integer ndatebc,nhmsbc(ndmax), nhmsbc1, nhmsbc2,nrec        integer ndatebc,nrec
431        integer nymdbc(ndmax),nymdbc1,nymdbc2,nymdmod        integer nymdmod
432    
       _RL sstbc1(sNx,sNy,nSx*nPx,nSy*nPy)  
       _RL sstbc2(sNx,sNy,nSx*nPx,nSy*nPy)  
433    
434  C--------- Variable Initialization ---------------------------------  C--------- Variable Initialization ---------------------------------
435    
       data first /.true./  
436        data error /.false./        data error /.false./
437    
438  c  save header info  c  save header info
439        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  
440    
441  c  this only works for between 1950-2050  c  this only works for between 1950-2050
442        if (nymd .lt. 500101) then        if (nymd .lt. 500101) then
# Line 401  c  this only works for between 1950-2050 Line 447  c  this only works for between 1950-2050
447          nymdmod = nymd          nymdmod = nymd
448        endif        endif
449    
450          sstdata='sst19232.weekly.clim'
451    
452  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
453  c  these vaules make the iyear .ne. iyearbc true anyways for  c  these vaules make the iyear .ne. iyearbc true anyways for
454  c  for the first time so first isnt checked below.  c  for the first time so first isnt checked below.
# Line 421  C---------- Read in Header file -------- Line 469  C---------- Read in Header file --------
469        if( iyear.ne.iyearbc ) then        if( iyear.ne.iyearbc ) then
470    
471         close(iunit)         close(iunit)
472         open (iunit,form='unformatted',access='direct',         open (iunit,file=sstdata,form='unformatted',access='direct',
473       .                                        recl=im2*jm2*nPgx*nPgy*4)       .                                        recl=xsize*ysize*4)
474         nrec = 1         nrec = 1
475         call bcheader (iunit, ndmax, nrec,         call bcheader (iunit, ndmax, nrec,
476       .          cname, cdscrip, imbc, jmbc, npxbc, npybc, lat0, lon0,       .          cname, cdscrip, imbc, jmbc, lat0, lon0,
477       .          ndatebc, nymdbc, nhmsbc, undef, error)       .          ndatebc, nymdbc, nhmsbc, undef, error)
478    
479  C--------- Check data for Compatibility  C--------- Check data for Compatibility
# Line 437  C Check for correct data in boundary con Line 485  C Check for correct data in boundary con
485         endif         endif
486    
487  C Check Horizontal Resolution  C Check Horizontal Resolution
488         if(.not.error.and.imbc*jmbc*npxbc*npybc.ne.im2*jm2*npgx*npgy)then         if(.not.error.and.imbc*jmbc.ne.xsize*ysize)then
489          write(6,*) ' B.C. Resolution DOES NOT match Model Resolution!'          write(6,*) ' B.C. Resolution DOES NOT match Model Resolution!'
490          write(6,*) ' B.C. Resolution:  ',imbc*jmbc*npxbc*npybc          write(6,*) ' B.C. Resolution:  ',imbc*jmbc
491          write(6,*) 'Model Resolution:  ',im2*jm2*npgx*npgy          write(6,*) 'Model Resolution:  ',xsize*ysize
492          error = .true.          error = .true.
493         endif         endif
494    
# Line 471  C  For the last date add 1 year to the c Line 519  C  For the last date add 1 year to the c
519          endif          endif
520    
521  C  Write out header info  C  Write out header info
522            _BEGIN_MASTER( myThid )
523          write(6,*) ' Updated boundary condition data'          write(6,*) ' Updated boundary condition data'
524          write(6,*) ' ---------------------------------'          write(6,*) ' ---------------------------------'
525          write(6,*) ' Variable: ',cname          write(6,*) ' Variable: ',cname
# Line 485  C  Write out header info Line 534  C  Write out header info
534   1000    format(3(2x,i3,':',i8,2x,i8))   1000    format(3(2x,i3,':',i8,2x,i8))
535          enddo          enddo
536          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)
537            _END_MASTER( myThid )
538         endif         endif
539    
540         if( error ) call my_exit (101)         if( error ) call my_exit (101)
# Line 499  C---------- Read SST data if necessary - Line 549  C---------- Read SST data if necessary -
549  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
550  c  from previous call to getsst then read new data  c  from previous call to getsst then read new data
551    
552        timemod = float(nymdmod) + float(nhms)   /1000000        timemod = dfloat(nymdmod) + dfloat(nhms)   /1000000
553        timebc1 = float(nymdbc1) + float(nhmsbc1)/1000000        timebc1 = dfloat(nymdbc1) + dfloat(nhmsbc1)/1000000
554        timebc2 = float(nymdbc2) + float(nhmsbc2)/1000000        timebc2 = dfloat(nymdbc2) + dfloat(nhmsbc2)/1000000
555    
556        if (timemod .lt. timebc1 .or. timemod .ge. timebc2) then        if (timemod .lt. timebc1 .or. timemod .ge. timebc2) then
557    
558         do while (.not.found .and. nd .le. ndatebc)         do while (.not.found .and. nd .le. ndatebc)
559          timebc2 = float(nymdbc(nd)) + float(nhmsbc(nd))/1000000          timebc2 = dfloat(nymdbc(nd)) + dfloat(nhmsbc(nd))/1000000
560          if (timebc2 .gt. timemod) then            if (timebc2 .gt. timemod) then  
561           nymdbc1 = nymdbc(nd-1)           nymdbc1 = nymdbc(nd-1)
562           nymdbc2 = nymdbc(nd)           nymdbc2 = nymdbc(nd)
563           nhmsbc1 = nhmsbc(nd-1)           nhmsbc1 = nhmsbc(nd-1)
564           nhmsbc2 = nhmsbc(nd)           nhmsbc2 = nhmsbc(nd)
565           call bcdata (iunit,imbc,jmbc,nPgx,nPgy,nd,nd+1,sstbc1,sstbc2)           call bcdata (iunit,imbc,jmbc,nd,nd+1,sstbc1,sstbc2)
566           found = .true.           found = .true.
567          else          else
568           nd = nd + 1           nd = nd + 1
# Line 538  C---------- Interpolate SST data ------- Line 589  C---------- Interpolate SST data -------
589    
590        do j = jm1,jm2        do j = jm1,jm2
591        do i = im1,im2        do i = im1,im2
592         sst(i,j,bi,bj) = sstbc1(i,j,biglobal,bjglobal)*fac1         sst(i,j,bi,bj) = sstbc1(i+bislot,j+bjslot)*fac1
593       .                + sstbc2(i,j,biglobal,bjglobal)*fac2       .                + sstbc2(i+bislot,j+bjslot)*fac2
594        enddo        enddo
595        enddo        enddo
596    
597    
598        return        return
599        end        end
600    
601        subroutine bcdata (iunit,im,jm,nPx,nPy,nrec1,nrec2,field1,field2)        subroutine bcdata (iunit,im,jm,nrec1,nrec2,field1,field2)
602  C************************************************************************  C************************************************************************
603  C  C
604  C!ROUTINE:      BCDATA  C!ROUTINE:      BCDATA
# Line 558  C Line 610  C
610  C!INPUT PARAMETERS:  C!INPUT PARAMETERS:
611  C!      im      number of x points  C!      im      number of x points
612  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  
613  C!      nrec1   record number of the time before the model time  C!      nrec1   record number of the time before the model time
614  C!      nrec2   record number of the time after the model time  C!      nrec2   record number of the time after the model time
615  C  C
616  C!OUTPUT PARAMETERS:  C!OUTPUT PARAMETERS:
617  C!      field1(im,jm,nPx,nPy)  data field before the model time  C!      field1(im,jm)  data field before the model time
618  C!      field2(im,jm,nPx,nPy)  data field after the model time  C!      field2(im,jm)  data field after the model time
619  C  C
620  C--------------------------------------------------------------------------  C--------------------------------------------------------------------------
621        implicit none        implicit none
622    
623        integer iunit,im,jm,nPx,nPy,nrec1,nrec2        integer iunit,im,jm,nrec1,nrec2
624    
625        _RL  field1(im,jm,nPx,nPy)        _RL  field1(im,jm)
626        _RL  field2(im,jm,nPx,nPy)        _RL  field2(im,jm)
627    
628        integer i,j,n1,n2        integer i,j
629        real*4 f1(im,jm,nPx,nPy), f2(im,jm,nPx,nPy)        real*4 f1(im,jm), f2(im,jm)
630    
631  C--------- Read file -----------------------------------------------  C--------- Read file -----------------------------------------------
632        read(iunit,rec=nrec1) f1        read(iunit,rec=nrec1) f1
633        read(iunit,rec=nrec2) f2        read(iunit,rec=nrec2) f2
634    
       do n2=1,nPy  
       do n1=1,nPx  
635  #ifdef _BYTESWAPIO  #ifdef _BYTESWAPIO
636        call MDS_BYTESWAPR4( im*jm, f1(1,1,n1,n2))        call MDS_BYTESWAPR4( im*jm, f1)
637        call MDS_BYTESWAPR4( im*jm, f2(1,1,n1,n2))        call MDS_BYTESWAPR4( im*jm, f2)
638  #endif  #endif
639        do j=1,jm        do j=1,jm
640        do i=1,im        do i=1,im
641         field1(i,j,n1,n2) = f1(i,j,n1,n2)         field1(i,j) = f1(i,j)
642         field2(i,j,n1,n2) = f2(i,j,n1,n2)         field2(i,j) = f2(i,j)
       enddo  
       enddo  
643        enddo        enddo
644        enddo        enddo
645    
646        return        return
647        end        end
648        subroutine bcheader (iunit, ndmax, nrec,        subroutine bcheader (iunit, ndmax, nrec,
649       .           cname, cdscrip, im, jm, npx, npy, lat0, lon0, ndatebc,       .           cname, cdscrip, im, jm, lat0, lon0, ndatebc,
650       .           nymdbc, nhmsbc, undef, error)       .           nymdbc, nhmsbc, undef, error)
651  C************************************************************************  C************************************************************************
652  C  C
# Line 617  C!      cname         name of the data i Line 663  C!      cname         name of the data i
663  C!      cdscrip       description of the data in the file header  C!      cdscrip       description of the data in the file header
664  C!      im            number of x points  C!      im            number of x points
665  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  
666  C!      lat0          starting latitude for the data grid  C!      lat0          starting latitude for the data grid
667  C!      lon0          starting longitude for the data grid  C!      lon0          starting longitude for the data grid
668  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 634  C--------------------------------------- Line 678  C---------------------------------------
678    
679        character*8  cname        character*8  cname
680        character*80 cdscrip        character*80 cdscrip
681        integer im,jm,npx,npy,ndatebc,nymdbc(ndmax),nhmsbc(ndmax)        character*112 dummy112
682          integer im,jm,ndatebc,nymdbc(ndmax),nhmsbc(ndmax)
683        _RL lat0,lon0,undef        _RL lat0,lon0,undef
684        logical error        logical error
685    
686        integer i        integer i
687        integer*4 im_32,jm_32,npx_32,npy_32        integer*4 im_32,jm_32
688        integer*4 ndatebc_32,nhmsbc_32(ndmax),nymdbc_32(ndmax)        integer*4 ndatebc_32,nhmsbc_32(ndmax),nymdbc_32(ndmax)
689        real*4 lat0_32,lon0_32,undef_32        real*4 lat0_32,lon0_32,undef_32
690    
691  C--------- Read file -----------------------------------------------  C--------- Read file -----------------------------------------------
692    
693        read(iunit,rec=nrec,err=500) cname, cdscrip,        read(iunit,rec=nrec,err=500) cname, cdscrip,
694       .     im_32, jm_32, npx_32, npy_32, lat0_32, lon0_32,       .     im_32, jm_32, lat0_32, lon0_32,
695       .     ndatebc_32, undef_32,       .     ndatebc_32, undef_32
696       .     (nymdbc_32(i), nhmsbc_32(i), i=1,ndatebc_32)  
697  #ifdef _BYTESWAPIO  #ifdef _BYTESWAPIO
698          call MDS_BYTESWAPI4( 1, im_32)
699          call MDS_BYTESWAPI4( 1, jm_32)
700        call MDS_BYTESWAPR4( 1, lat0_32)        call MDS_BYTESWAPR4( 1, lat0_32)
701        call MDS_BYTESWAPR4( 1, lon0_32)        call MDS_BYTESWAPR4( 1, lon0_32)
702          call MDS_BYTESWAPI4( 1, ndatebc_32)
703        call MDS_BYTESWAPR4( 1, undef_32)        call MDS_BYTESWAPR4( 1, undef_32)
704  #endif  #endif
705    
706          read(iunit,rec=nrec,err=500) dummy112,
707         .     (nymdbc_32(i), nhmsbc_32(i), i=1,ndatebc_32)
708    
709        im = im_32        im = im_32
710        jm = jm_32        jm = jm_32
       npx = npx_32  
       npy = npy_32  
711        lat0 = lat0_32        lat0 = lat0_32
712        lon0 = lon0_32        lon0 = lon0_32
713        undef = undef_32        undef = undef_32
714    
715        ndatebc = ndatebc_32        ndatebc = ndatebc_32
716        do i=1,ndatebc        do i=1,ndatebc
717    #ifdef _BYTESWAPIO
718          call MDS_BYTESWAPI4( 1, nymdbc_32(i))
719          call MDS_BYTESWAPI4( 1, nhmsbc_32(i))
720    #endif
721        nymdbc(i) = nymdbc_32(i)        nymdbc(i) = nymdbc_32(i)
722        nhmsbc(i) = nhmsbc_32(i)        nhmsbc(i) = nhmsbc_32(i)
723        enddo        enddo
Legend:
Removed from v.1.14  
changed lines
  Added in v.1.25
  ViewVC Help
Powered by ViewVC 1.1.22