/[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.12 by molod, Tue Jul 20 16:24:49 2004 UTC revision 1.20 by molod, Tue Mar 8 22:14:20 2005 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
31         integer ksst,kice         integer ksst,kice
32         _RL        sstmin         _RL        sstmin
33         parameter ( sstmin = 273.16 )         parameter ( sstmin = 273.16 )
34    
35    #if defined(ALLOW_EXCH2)
36           PARAMETER ( xsize = exch2_domain_nxt * sNx )
37           PARAMETER ( ysize = exch2_domain_nyt * sNy )
38    #else
39           PARAMETER ( xsize = Nx )
40           PARAMETER ( ysize = Ny )
41    #endif
42           _RL sst1(xsize,ysize),sst2(xsize,ysize)
43           _RL sice1(xsize,ysize),sice2(xsize,ysize)
44    
45           save sst1, sst2, sice1, sice2
46    
47         idim1 = 1-OLx         idim1 = 1-OLx
48         idim2 = sNx+OLx         idim2 = sNx+OLx
49         jdim1 = 1-OLy         jdim1 = 1-OLy
# Line 35  c--------------------------------------- Line 52  c---------------------------------------
52         im2 = sNx         im2 = sNx
53         jm1 = 1         jm1 = 1
54         jm2 = sNy         jm2 = sNy
        nSxglobal = nSx*nPx  
        nSyglobal = nSy*nPy  
55    
56         call mdsfindunit( ksst, myThid )         call mdsfindunit( ksst, myThid )
57         call mdsfindunit( kice, myThid )         call mdsfindunit( kice, myThid )
# Line 45  C*************************************** Line 60  C***************************************
60    
61         DO BJ = myByLo(myThid),myByHi(myThid)         DO BJ = myByLo(myThid),myByHi(myThid)
62         DO BI = myBxLo(myThid),myBxHi(myThid)         DO BI = myBxLo(myThid),myBxHi(myThid)
63    #if defined(ALLOW_EXCH2)
64         biglobal=bi+(myXGlobalLo-1)/im2         bislot = exch2_txglobalo(W2_myTileList(bi))-1
65         bjglobal=bj+(myYGlobalLo-1)/jm2         bjslot = exch2_tyglobalo(W2_myTileList(bi))-1
66    #else
67           bislot = myXGlobalLo-1+(bi-1)*sNx
68           bjslot = myYGlobalLo-1+(bj-1)*sNy
69    #endif
70    
71         call getsst(ksst,idim1,idim2,jdim1,jdim2,im1,im2,jm1,jm2,nSx,         call getsst(ksst,idim1,idim2,jdim1,jdim2,im1,im2,jm1,jm2,nSx,
72       .  nSy,nSxglobal,nSyglobal,bi,bj,biglobal,bjglobal,nymd,nhms,sst)       .  nSy,xsize,ysize,bi,bj,bislot,bjslot,nymd,nhms,sst1,sst2,sst)
73         call getsice(kice,idim1,idim2,jdim1,jdim2,im1,im2,jm1,jm2,nSx,         call getsice(kice,idim1,idim2,jdim1,jdim2,im1,im2,jm1,jm2,nSx,
74       .  nSy,nSxglobal,nSyglobal,bi,bj,biglobal,bjglobal,nymd,nhms,sice)       .  nSy,xsize,ysize,bi,bj,bislot,bjslot,nymd,nhms,sice1,sice2,sice)
75    
76  c Check for Minimum Open-Water SST  c Check for Minimum Open-Water SST
77  c --------------------------------  c --------------------------------
# Line 65  c -------------------------------- Line 84  c --------------------------------
84    
85         ENDDO         ENDDO
86         ENDDO         ENDDO
87           _EXCH_XYZ_R8(sst,myThid)
88           _EXCH_XYZ_R8(sice,myThid)
89    
90         return         return
91         end         end
92    
93         subroutine getsice(iunit,idim1,idim2,jdim1,jdim2,im1,im2,jm1,jm2,         subroutine getsice(iunit,idim1,idim2,jdim1,jdim2,im1,im2,jm1,jm2,
94       .     nSumx,nSumy,nPgx,nPgy,bi,bj,biglobal,bjglobal,nymd,nhms,sice)       .            nSumx,nSumy,xsize,ysize,bi,bj,bislot,bjslot,nymd,nhms,
95  C************************************************************************       .                                             sicebc1,sicebc2,sice)
96    C***********************************************************************
97  C  C
98  C!ROUTINE:      GETSICE  C!ROUTINE:      GETSICE
99  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 113  C!      jm1       Begin of y-direction s
113  C!      jm2       End of y-direction span for filling sice  C!      jm2       End of y-direction span for filling sice
114  C!      nSumx     Number of processors in x-direction (local processor)  C!      nSumx     Number of processors in x-direction (local processor)
115  C!      nSumy     Number of processors in y-direction (local processor)  C!      nSumy     Number of processors in y-direction (local processor)
116  C!      nPgx      Number of processors in x-direction (global)  C!      xsize      Number of processors in x-direction (global)
117  C!      nPgx      Number of processors in y-direction (global)  C!      ysize      Number of processors in y-direction (global)
118  C!      bi        Processor number in x-direction (local to processor)  C!      bi        Processor number in x-direction (local to processor)
119  C!      bj        Processor number in y-direction (local to processor)  C!      bj        Processor number in y-direction (local to processor)
120  C!      biglobal  Processor number in x-direction (global)  C!      bislot  Processor number in x-direction (global)
121  C!      bjglobal  Processor number in y-direction (global)  C!      bjslot  Processor number in y-direction (global)
122  C!      nymd      YYMMDD of the current model timestep  C!      nymd      YYMMDD of the current model timestep
123  C!      nhms      HHMMSS of the model time  C!      nhms      HHMMSS of the model time
124  C  C
# Line 112  C Line 134  C
134  C--------------------------------------------------------------------------  C--------------------------------------------------------------------------
135    
136        implicit none        implicit none
 #include "CPP_EEOPTIONS.h"  
137  #include "SIZE.h"  #include "SIZE.h"
138    
139        integer iunit,idim1,idim2,jdim1,jdim2,im1,im2,jm1,jm2,nSumx,nSumy        integer iunit,idim1,idim2,jdim1,jdim2,im1,im2,jm1,jm2,nSumx,nSumy
140        integer nPgx,nPgy,bi,bj,biglobal,bjglobal,nymd,nhms        integer xsize,ysize,bi,bj,bislot,bjslot,nymd,nhms
141    
142          _RL sicebc1(xsize,ysize)
143          _RL sicebc2(xsize,ysize)
144        _RL sice(idim1:idim2,jdim1:jdim2,nSumx,nSumy)        _RL sice(idim1:idim2,jdim1:jdim2,nSumx,nSumy)
145    
146  C Maximum number of dates in one year for the data  C Maximum number of dates in one year for the data
# Line 126  C Maximum number of dates in one year fo Line 149  C Maximum number of dates in one year fo
149    
150        character*8  cname        character*8  cname
151        character*80 cdscrip        character*80 cdscrip
152        real fac1, fac2, lat0, lon0, timebc1, timebc2, timemod, undef        character*40 sicedata
153          _RL fac1, fac2, lat0, lon0, timebc1, timebc2, timemod, undef
154        logical first, found, error        logical first, found, error
155        integer i,j,n,nn,iyear,iyearbc,nd,ndby3,imbc,jmbc,npxbc,npybc        integer i,j,n,nn,iyear,iyearbc,nd,ndby3,imbc,jmbc
156        integer ndatebc,nhmsbc(ndmax), nhmsbc1, nhmsbc2,nrec        integer ndatebc,nhmsbc(ndmax), nhmsbc1, nhmsbc2,nrec
157        integer nymdbc(ndmax),nymdbc1,nymdbc2,nymdmod        integer nymdbc(ndmax),nymdbc1,nymdbc2,nymdmod
158    
       real sicebc1(sNx,sNy,nSx*nPx,nSy*nPy)  
       real sicebc2(sNx,sNy,nSx*nPx,nSy*nPy)  
159    
160  C--------- Variable Initialization ---------------------------------  C--------- Variable Initialization ---------------------------------
161    
# Line 141  C--------- Variable Initialization ----- Line 163  C--------- Variable Initialization -----
163        data error /.false./        data error /.false./
164    
165  c  save header info  c  save header info
166        save imbc,jmbc,npxbc,npybc,lat0,lon0,ndatebc,undef,nymdbc,nhmsbc        save imbc,jmbc,lat0,lon0,ndatebc,undef,nymdbc,nhmsbc
167        save nymdbc1, nymdbc2, nhmsbc1, nhmsbc2        save nymdbc1, nymdbc2, nhmsbc1, nhmsbc2
168        save first        save first
       save sicebc1, sicebc2  
169    
170  c  this only works for between 1950-2050  c  this only works for between 1950-2050
171        if (nymd .lt. 500101) then        if (nymd .lt. 500101) then
# Line 155  c  this only works for between 1950-2050 Line 176  c  this only works for between 1950-2050
176          nymdmod = nymd          nymdmod = nymd
177        endif        endif
178    
179          sicedata='sice19232.weekly.clim'
180    
181  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
182  c  these vaules make the iyear .ne. iyearbc true anyways for  c  these vaules make the iyear .ne. iyearbc true anyways for
183  c  for the first time so first isnt checked below.  c  for the first time so first isnt checked below.
# Line 165  c  for the first time so first isnt chec Line 188  c  for the first time so first isnt chec
188          nymdbc2   = 0          nymdbc2   = 0
189          nhmsbc1   = 0          nhmsbc1   = 0
190          nhmsbc2   = 0          nhmsbc2   = 0
191          first = .false.  c       first = .false.
192        endif        endif
193    
194  C---------- Read in Header file ----------------------------------  C---------- Read in Header file ----------------------------------
# Line 176  C---------- Read in Header file -------- Line 199  C---------- Read in Header file --------
199        if( iyear.ne.iyearbc ) then        if( iyear.ne.iyearbc ) then
200    
201         close(iunit)         close(iunit)
202         open (iunit,form='unformatted',access='direct',         open (iunit,file=sicedata,form='unformatted',access='direct',
203       .                                         recl=im2*jm2*nPgx*nPgy*4)       .                                         recl=xsize*ysize*4)
204         nrec = 1         nrec = 1
205         call bcheader (iunit, ndmax, nrec,         call bcheader (iunit, ndmax, nrec,
206       .          cname, cdscrip, imbc, jmbc, npxbc, npybc, lat0, lon0,       .          cname, cdscrip, imbc, jmbc, lat0, lon0,
207       .          ndatebc, nymdbc, nhmsbc, undef, error)       .          ndatebc, nymdbc, nhmsbc, undef, error)
208    
209  C--------- Check data for Compatibility ------------------------------  C--------- Check data for Compatibility ------------------------------
# Line 192  C Check for correct data in boundary con Line 215  C Check for correct data in boundary con
215         endif         endif
216    
217  C Check Horizontal Resolution  C Check Horizontal Resolution
218         if(.not.error.and.imbc*jmbc*npxbc*npybc.ne.im2*jm2*npgx*npgy)then         if(.not.error.and.imbc*jmbc.ne.xsize*ysize)then
219          write(6,*) ' B.C. Resolution DOES NOT match Model Resolution!'          write(6,*) ' B.C. Resolution DOES NOT match Model Resolution!'
220          write(6,*) ' B.C. Resolution:  ',imbc*jmbc*npxbc*npybc          write(6,*) ' B.C. Resolution:  ',imbc*jmbc
221          write(6,*) 'Model Resolution:  ',im2*jm2*npgx*npgy          write(6,*) 'Model Resolution:  ',xsize*ysize
222          error = .true.          error = .true.
223         endif         endif
224    
# Line 265  c  from previous call to getsice then re Line 288  c  from previous call to getsice then re
288           nymdbc2 = nymdbc(nd)           nymdbc2 = nymdbc(nd)
289           nhmsbc1 = nhmsbc(nd-1)           nhmsbc1 = nhmsbc(nd-1)
290           nhmsbc2 = nhmsbc(nd)           nhmsbc2 = nhmsbc(nd)
291           call bcdata (iunit,imbc,jmbc,nPgx,nPgy,nd,nd+1,sicebc1,sicebc2)           call bcdata (iunit,imbc,jmbc,nd,nd+1,sicebc1,sicebc2)
292           found = .true.           found = .true.
293          else          else
294           nd = nd + 1           nd = nd + 1
# Line 292  C---------- Interpolate sice data ------ Line 315  C---------- Interpolate sice data ------
315    
316        do j = jm1,jm2        do j = jm1,jm2
317        do i = im1,im2        do i = im1,im2
318         sice(i,j,bi,bj) = sicebc1(i,j,biglobal,bjglobal)*fac1         sice(i,j,bi,bj) = sicebc1(i+bislot,j+bjslot)*fac1
319       .                 + sicebc2(i,j,biglobal,bjglobal)*fac2       .                 + sicebc2(i+bislot,j+bjslot)*fac2
320  c average to 0 or 1  c average to 0 or 1
321  c -----------------  c -----------------
322         if (sice(i,j,bi,bj) .ge. 0.5) then         if (sice(i,j,bi,bj) .ge. 0.5) then
# Line 317  C--------------------------------------- Line 340  C---------------------------------------
340        return        return
341        end        end
342        subroutine getsst(iunit,idim1,idim2,jdim1,jdim2,im1,im2,jm1,jm2,        subroutine getsst(iunit,idim1,idim2,jdim1,jdim2,im1,im2,jm1,jm2,
343       .      nSumx,nSumy,nPgx,nPgy,bi,bj,biglobal,bjglobal,nymd,nhms,sst)       .            nSumx,nSumy,xsize,ysize,bi,bj,bislot,bjslot,nymd,nhms,
344  C************************************************************************       .                                                sstbc1,sstbc2,sst)
345    C***********************************************************************
346  C  C
347  C!ROUTINE:      GETSST  C!ROUTINE:      GETSST
348  C!DESCRIPTION:  GETSST gets the SST data.  C!DESCRIPTION:  GETSST gets the SST data.
# Line 332  C!      idim1     Start dimension in x-d Line 356  C!      idim1     Start dimension in x-d
356  C!      idim2     End dimension in x-direction  C!      idim2     End dimension in x-direction
357  C!      jdim1     Start dimension in y-direction  C!      jdim1     Start dimension in y-direction
358  C!      jdim2     End dimension in y-direction  C!      jdim2     End dimension in y-direction
359  C!      im1       Begin of x-direction span for filling sice  C!      im1       Begin of x-direction span for filling sst
360  C!      im2       End of x-direction span for filling sice  C!      im2       End of x-direction span for filling sst
361  C!      jm1       Begin of y-direction span for filling sice  C!      jm1       Begin of y-direction span for filling sst
362  C!      jm2       End of y-direction span for filling sice  C!      jm2       End of y-direction span for filling sst
363  C!      nSumx     Number of processors in x-direction (local processor)  C!      nSumx     Number of processors in x-direction (local processor)
364  C!      nSumy     Number of processors in y-direction (local processor)  C!      nSumy     Number of processors in y-direction (local processor)
365  C!      nPgx      Number of processors in x-direction (global)  C!      xsize     x-dimension of global array
366  C!      nPgy      Number of processors in y-direction (global)  C!      ysize     y-dimension of global array
367  C!      bi        Processor number in x-direction (local to processor)  C!      bi        Processor number in x-direction (local to processor)
368  C!      bj        Processor number in y-direction (local to processor)  C!      bj        Processor number in y-direction (local to processor)
369  C!      biglobal  Processor number in x-direction (global)  C!      bislot    Slot number into global array in x-direction (global)
370  C!      bjglobal  Processor number in y-direction (global)  C!      bjslot    Slot number into global array in y-direction (global)
371  C!      nymd      YYMMDD of the current model timestep  C!      nymd      YYMMDD of the current model timestep
372  C!      nhms      HHMMSS of the model time  C!      nhms      HHMMSS of the model time
373  C  C
# Line 354  C!ROUTINES CALLED: Line 378  C!ROUTINES CALLED:
378  C  C
379  C!      bcdata          Reads the data for a given unit number  C!      bcdata          Reads the data for a given unit number
380  C!      bcheader        Reads the header info for a given unit number  C!      bcheader        Reads the header info for a given unit number
381  C!     interp_time   Returns weights for linear interpolation  C!     interp_time      Returns weights for linear interpolation
382  C  C
383  C--------------------------------------------------------------------------  C--------------------------------------------------------------------------
384    
385        implicit none        implicit none
 #include "CPP_EEOPTIONS.h"  
386  #include "SIZE.h"  #include "SIZE.h"
387    
388        integer iunit,idim1,idim2,jdim1,jdim2,im1,im2,jm1,jm2,nSumx,nSumy        integer iunit,idim1,idim2,jdim1,jdim2,im1,im2,jm1,jm2,nSumx,nSumy
389        integer nPgx,nPgy,bi,bj,biglobal,bjglobal,nymd,nhms        integer xsize,ysize,bi,bj,bislot,bjslot,nymd,nhms
390    
391          _RL sstbc1(xsize,ysize)
392          _RL sstbc2(xsize,ysize)
393        _RL sst(idim1:idim2,jdim1:jdim2,nSumx,nSumy)        _RL sst(idim1:idim2,jdim1:jdim2,nSumx,nSumy)
394    
395  C Maximum number of dates in one year for the data  C Maximum number of dates in one year for the data
# Line 373  C Maximum number of dates in one year fo Line 398  C Maximum number of dates in one year fo
398    
399        character*8  cname        character*8  cname
400        character*80 cdscrip        character*80 cdscrip
401        real fac1, fac2, lat0, lon0, timebc1, timebc2, timemod, undef        character*20 sstdata
402          _RL fac1, fac2, lat0, lon0, timebc1, timebc2, timemod, undef
403        logical first, found, error        logical first, found, error
404        integer i,j,n,nn,iyear,iyearbc,nd,ndby3,imbc,jmbc,npxbc,npybc        integer i,j,n,nn,iyear,iyearbc,nd,ndby3,imbc,jmbc
405        integer ndatebc,nhmsbc(ndmax), nhmsbc1, nhmsbc2,nrec        integer ndatebc,nhmsbc(ndmax), nhmsbc1, nhmsbc2,nrec
406        integer nymdbc(ndmax),nymdbc1,nymdbc2,nymdmod        integer nymdbc(ndmax),nymdbc1,nymdbc2,nymdmod
407    
       real sstbc1(sNx,sNy,nSx*nPx,nSy*nPy)  
       real sstbc2(sNx,sNy,nSx*nPx,nSy*nPy)  
408    
409  C--------- Variable Initialization ---------------------------------  C--------- Variable Initialization ---------------------------------
410    
# Line 388  C--------- Variable Initialization ----- Line 412  C--------- Variable Initialization -----
412        data error /.false./        data error /.false./
413    
414  c  save header info  c  save header info
415        save imbc,jmbc,npxbc,npybc,lat0,lon0,ndatebc,undef,nymdbc,nhmsbc        save imbc,jmbc,lat0,lon0,ndatebc,undef,nymdbc,nhmsbc
416        save nymdbc1, nymdbc2, nhmsbc1, nhmsbc2        save nymdbc1, nymdbc2, nhmsbc1, nhmsbc2
417        save first        save first
       save sstbc1, sstbc2  
418    
419  c  this only works for between 1950-2050  c  this only works for between 1950-2050
420        if (nymd .lt. 500101) then        if (nymd .lt. 500101) then
# Line 402  c  this only works for between 1950-2050 Line 425  c  this only works for between 1950-2050
425          nymdmod = nymd          nymdmod = nymd
426        endif        endif
427    
428          sstdata='sst19232.weekly.clim'
429    
430  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
431  c  these vaules make the iyear .ne. iyearbc true anyways for  c  these vaules make the iyear .ne. iyearbc true anyways for
432  c  for the first time so first isnt checked below.  c  for the first time so first isnt checked below.
# Line 411  c  for the first time so first isnt chec Line 436  c  for the first time so first isnt chec
436          nymdbc2   = 0          nymdbc2   = 0
437          nhmsbc1   = 0          nhmsbc1   = 0
438          nhmsbc2   = 0          nhmsbc2   = 0
439          first = .false.  c       first = .false.
440        endif        endif
441    
442  C---------- Read in Header file ----------------------------------  C---------- Read in Header file ----------------------------------
# Line 422  C---------- Read in Header file -------- Line 447  C---------- Read in Header file --------
447        if( iyear.ne.iyearbc ) then        if( iyear.ne.iyearbc ) then
448    
449         close(iunit)         close(iunit)
450         open (iunit,form='unformatted',access='direct',         open (iunit,file=sstdata,form='unformatted',access='direct',
451       .                                        recl=im2*jm2*nPgx*nPgy*4)       .                                        recl=xsize*ysize*4)
452         nrec = 1         nrec = 1
453         call bcheader (iunit, ndmax, nrec,         call bcheader (iunit, ndmax, nrec,
454       .          cname, cdscrip, imbc, jmbc, npxbc, npybc, lat0, lon0,       .          cname, cdscrip, imbc, jmbc, lat0, lon0,
455       .          ndatebc, nymdbc, nhmsbc, undef, error)       .          ndatebc, nymdbc, nhmsbc, undef, error)
456    
457  C--------- Check data for Compatibility  C--------- Check data for Compatibility
# Line 438  C Check for correct data in boundary con Line 463  C Check for correct data in boundary con
463         endif         endif
464    
465  C Check Horizontal Resolution  C Check Horizontal Resolution
466         if(.not.error.and.imbc*jmbc*npxbc*npybc.ne.im2*jm2*npgx*npgy)then         if(.not.error.and.imbc*jmbc.ne.xsize*ysize)then
467          write(6,*) ' B.C. Resolution DOES NOT match Model Resolution!'          write(6,*) ' B.C. Resolution DOES NOT match Model Resolution!'
468          write(6,*) ' B.C. Resolution:  ',imbc*jmbc*npxbc*npybc          write(6,*) ' B.C. Resolution:  ',imbc*jmbc
469          write(6,*) 'Model Resolution:  ',im2*jm2*npgx*npgy          write(6,*) 'Model Resolution:  ',xsize*ysize
470          error = .true.          error = .true.
471         endif         endif
472    
# Line 512  c  from previous call to getsst then rea Line 537  c  from previous call to getsst then rea
537           nymdbc2 = nymdbc(nd)           nymdbc2 = nymdbc(nd)
538           nhmsbc1 = nhmsbc(nd-1)           nhmsbc1 = nhmsbc(nd-1)
539           nhmsbc2 = nhmsbc(nd)           nhmsbc2 = nhmsbc(nd)
540           call bcdata (iunit,imbc,jmbc,nPgx,nPgy,nd,nd+1,sstbc1,sstbc2)           call bcdata (iunit,imbc,jmbc,nd,nd+1,sstbc1,sstbc2)
541           found = .true.           found = .true.
542          else          else
543           nd = nd + 1           nd = nd + 1
# Line 539  C---------- Interpolate SST data ------- Line 564  C---------- Interpolate SST data -------
564    
565        do j = jm1,jm2        do j = jm1,jm2
566        do i = im1,im2        do i = im1,im2
567         sst(i,j,bi,bj) = sstbc1(i,j,biglobal,bjglobal)*fac1         sst(i,j,bi,bj) = sstbc1(i+bislot,j+bjslot)*fac1
568       .                + sstbc2(i,j,biglobal,bjglobal)*fac2       .                + sstbc2(i+bislot,j+bjslot)*fac2
569        enddo        enddo
570        enddo        enddo
571    
572        return        return
573        end        end
574    
575        subroutine bcdata (iunit,im,jm,nPx,nPy,nrec1,nrec2,field1,field2)        subroutine bcdata (iunit,im,jm,nrec1,nrec2,field1,field2)
576  C************************************************************************  C************************************************************************
577  C  C
578  C!ROUTINE:      BCDATA  C!ROUTINE:      BCDATA
# Line 559  C Line 584  C
584  C!INPUT PARAMETERS:  C!INPUT PARAMETERS:
585  C!      im      number of x points  C!      im      number of x points
586  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  
587  C!      nrec1   record number of the time before the model time  C!      nrec1   record number of the time before the model time
588  C!      nrec2   record number of the time after the model time  C!      nrec2   record number of the time after the model time
589  C  C
590  C!OUTPUT PARAMETERS:  C!OUTPUT PARAMETERS:
591  C!      field1(im,jm,nPx,nPy)  data field before the model time  C!      field1(im,jm)  data field before the model time
592  C!      field2(im,jm,nPx,nPy)  data field after the model time  C!      field2(im,jm)  data field after the model time
593  C  C
594  C--------------------------------------------------------------------------  C--------------------------------------------------------------------------
595        implicit none        implicit none
 #include "PACKAGES_CONFIG.h"  
 #include "CPP_EEOPTIONS.h"  
596    
597        integer iunit,im,jm,nPx,nPy,nrec1,nrec2        integer iunit,im,jm,nrec1,nrec2
598    
599        real  field1(im,jm,nPx,nPy)        _RL  field1(im,jm)
600        real  field2(im,jm,nPx,nPy)        _RL  field2(im,jm)
601    
602        integer i,j,n1,n2        integer i,j
603        real*4 f1(im,jm,nPx,nPy), f2(im,jm,nPx,nPy)        real*4 f1(im,jm), f2(im,jm)
604    
605  C--------- Read file -----------------------------------------------  C--------- Read file -----------------------------------------------
606        read(iunit,rec=nrec1) f1        read(iunit,rec=nrec1) f1
607        read(iunit,rec=nrec2) f2        read(iunit,rec=nrec2) f2
608    
       do n2=1,nPy  
       do n1=1,nPx  
609  #ifdef _BYTESWAPIO  #ifdef _BYTESWAPIO
610        call MDS_BYTESWAPR4( im*jm, f1(1,1,n1,n2))        call MDS_BYTESWAPR4( im*jm, f1)
611        call MDS_BYTESWAPR4( im*jm, f2(1,1,n1,n2))        call MDS_BYTESWAPR4( im*jm, f2)
612  #endif  #endif
613        do j=1,jm        do j=1,jm
614        do i=1,im        do i=1,im
615         field1(i,j,n1,n2) = f1(i,j,n1,n2)         field1(i,j) = f1(i,j)
616         field2(i,j,n1,n2) = f2(i,j,n1,n2)         field2(i,j) = f2(i,j)
       enddo  
       enddo  
617        enddo        enddo
618        enddo        enddo
619    
620        return        return
621        end        end
622        subroutine bcheader (iunit, ndmax, nrec,        subroutine bcheader (iunit, ndmax, nrec,
623       .           cname, cdscrip, im, jm, npx, npy, lat0, lon0, ndatebc,       .           cname, cdscrip, im, jm, lat0, lon0, ndatebc,
624       .           nymdbc, nhmsbc, undef, error)       .           nymdbc, nhmsbc, undef, error)
625  C************************************************************************  C************************************************************************
626  C  C
# Line 620  C!      cname         name of the data i Line 637  C!      cname         name of the data i
637  C!      cdscrip       description of the data in the file header  C!      cdscrip       description of the data in the file header
638  C!      im            number of x points  C!      im            number of x points
639  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  
640  C!      lat0          starting latitude for the data grid  C!      lat0          starting latitude for the data grid
641  C!      lon0          starting longitude for the data grid  C!      lon0          starting longitude for the data grid
642  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 632  C!      error         logical TRUE if da Line 647  C!      error         logical TRUE if da
647  C  C
648  C--------------------------------------------------------------------------  C--------------------------------------------------------------------------
649        implicit none        implicit none
 #include "PACKAGES_CONFIG.h"  
 #include "CPP_EEOPTIONS.h"  
650    
651        integer iunit, ndmax, nrec        integer iunit, ndmax, nrec
652    
653        character*8  cname        character*8  cname
654        character*80 cdscrip        character*80 cdscrip
655        integer im,jm,npx,npy,ndatebc,nymdbc(ndmax),nhmsbc(ndmax)        character*112 dummy112
656        real lat0,lon0,undef        integer im,jm,ndatebc,nymdbc(ndmax),nhmsbc(ndmax)
657          _RL lat0,lon0,undef
658        logical error        logical error
659    
660        integer i        integer i
661        integer*4 im_32,jm_32,npx_32,npy_32        integer*4 im_32,jm_32
662        integer*4 ndatebc_32,nhmsbc_32(ndmax),nymdbc_32(ndmax)        integer*4 ndatebc_32,nhmsbc_32(ndmax),nymdbc_32(ndmax)
663        real*4 lat0_32,lon0_32,undef_32        real*4 lat0_32,lon0_32,undef_32
664    
665  C--------- Read file -----------------------------------------------  C--------- Read file -----------------------------------------------
666    
667        read(iunit,rec=nrec,err=500) cname, cdscrip,        read(iunit,rec=nrec,err=500) cname, cdscrip,
668       .     im_32, jm_32, npx_32, npy_32, lat0_32, lon0_32,       .     im_32, jm_32, lat0_32, lon0_32,
669       .     ndatebc_32, undef_32,       .     ndatebc_32, undef_32
670       .     (nymdbc_32(i), nhmsbc_32(i), i=1,ndatebc_32)  
671  #ifdef _BYTESWAPIO  #ifdef _BYTESWAPIO
672          call MDS_BYTESWAPI4( 1, im_32)
673          call MDS_BYTESWAPI4( 1, jm_32)
674        call MDS_BYTESWAPR4( 1, lat0_32)        call MDS_BYTESWAPR4( 1, lat0_32)
675        call MDS_BYTESWAPR4( 1, lon0_32)        call MDS_BYTESWAPR4( 1, lon0_32)
676          call MDS_BYTESWAPI4( 1, ndatebc_32)
677        call MDS_BYTESWAPR4( 1, undef_32)        call MDS_BYTESWAPR4( 1, undef_32)
678  #endif  #endif
679    
680          read(iunit,rec=nrec,err=500) dummy112,
681         .     (nymdbc_32(i), nhmsbc_32(i), i=1,ndatebc_32)
682    
683        im = im_32        im = im_32
684        jm = jm_32        jm = jm_32
       npx = npx_32  
       npy = npy_32  
685        lat0 = lat0_32        lat0 = lat0_32
686        lon0 = lon0_32        lon0 = lon0_32
687        undef = undef_32        undef = undef_32
688    
689        ndatebc = ndatebc_32        ndatebc = ndatebc_32
690        do i=1,ndatebc        do i=1,ndatebc
691    #ifdef _BYTESWAPIO
692          call MDS_BYTESWAPI4( 1, nymdbc_32(i))
693          call MDS_BYTESWAPI4( 1, nhmsbc_32(i))
694    #endif
695        nymdbc(i) = nymdbc_32(i)        nymdbc(i) = nymdbc_32(i)
696        nhmsbc(i) = nhmsbc_32(i)        nhmsbc(i) = nhmsbc_32(i)
697        enddo        enddo
Legend:
Removed from v.1.12  
changed lines
  Added in v.1.20
  ViewVC Help
Powered by ViewVC 1.1.22