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