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

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

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

revision 1.11 by molod, Mon Jul 19 22:06:59 2004 UTC revision 1.22 by molod, Sat May 7 14:35:18 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_XY_R8(sst,myThid)
88           _EXCH_XY_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 175  C---------- Read in Header file -------- Line 198  C---------- Read in Header file --------
198    
199        if( iyear.ne.iyearbc ) then        if( iyear.ne.iyearbc ) then
200    
201         close(iunit)         open (iunit,file=sicedata,form='unformatted',access='direct',
202         open (iunit,form='unformatted',access='direct',       .                                         recl=xsize*ysize*4)
      .                                         recl=im2*jm2*nPgx*nPgy*4)  
203         nrec = 1         nrec = 1
204         call bcheader (iunit, ndmax, nrec,         call bcheader (iunit, ndmax, nrec,
205       .          cname, cdscrip, imbc, jmbc, npxbc, npybc, lat0, lon0,       .          cname, cdscrip, imbc, jmbc, lat0, lon0,
206       .          ndatebc, nymdbc, nhmsbc, undef, error)       .          ndatebc, nymdbc, nhmsbc, undef, error)
207    
208  C--------- Check data for Compatibility ------------------------------  C--------- Check data for Compatibility ------------------------------
# Line 192  C Check for correct data in boundary con Line 214  C Check for correct data in boundary con
214         endif         endif
215    
216  C Check Horizontal Resolution  C Check Horizontal Resolution
217         if(.not.error.and.imbc*jmbc*npxbc*npybc.ne.im2*jm2*npgx*npgy)then         if(.not.error.and.imbc*jmbc.ne.xsize*ysize)then
218          write(6,*) ' B.C. Resolution DOES NOT match Model Resolution!'          write(6,*) ' B.C. Resolution DOES NOT match Model Resolution!'
219          write(6,*) ' B.C. Resolution:  ',imbc*jmbc*npxbc*npybc          write(6,*) ' B.C. Resolution:  ',imbc*jmbc
220          write(6,*) 'Model Resolution:  ',im2*jm2*npgx*npgy          write(6,*) 'Model Resolution:  ',xsize*ysize
221          error = .true.          error = .true.
222         endif         endif
223    
# Line 265  c  from previous call to getsice then re Line 287  c  from previous call to getsice then re
287           nymdbc2 = nymdbc(nd)           nymdbc2 = nymdbc(nd)
288           nhmsbc1 = nhmsbc(nd-1)           nhmsbc1 = nhmsbc(nd-1)
289           nhmsbc2 = nhmsbc(nd)           nhmsbc2 = nhmsbc(nd)
290           call bcdata (iunit,imbc,jmbc,nPgx,nPgy,nd,nd+1,sicebc1,sicebc2)           call bcdata (iunit,imbc,jmbc,nd,nd+1,sicebc1,sicebc2)
291           found = .true.           found = .true.
292          else          else
293           nd = nd + 1           nd = nd + 1
# Line 292  C---------- Interpolate sice data ------ Line 314  C---------- Interpolate sice data ------
314    
315        do j = jm1,jm2        do j = jm1,jm2
316        do i = im1,im2        do i = im1,im2
317         sice(i,j,bi,bj) = sicebc1(i,j,biglobal,bjglobal)*fac1         sice(i,j,bi,bj) = sicebc1(i+bislot,j+bjslot)*fac1
318       .                 + sicebc2(i,j,biglobal,bjglobal)*fac2       .                 + sicebc2(i+bislot,j+bjslot)*fac2
319  c average to 0 or 1  c average to 0 or 1
320  c -----------------  c -----------------
321         if (sice(i,j,bi,bj) .ge. 0.5) then         if (sice(i,j,bi,bj) .ge. 0.5) then
# Line 313  C---------- Fill sice with depth of ice Line 335  C---------- Fill sice with depth of ice
335        enddo        enddo
336        enddo        enddo
337  C---------------------------------------------------------------------------  C---------------------------------------------------------------------------
338          close(iunit)
339    
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 421  C---------- Read in Header file -------- Line 446  C---------- Read in Header file --------
446    
447        if( iyear.ne.iyearbc ) then        if( iyear.ne.iyearbc ) then
448    
449         close(iunit)         open (iunit,file=sstdata,form='unformatted',access='direct',
450         open (iunit,form='unformatted',access='direct',       .                                        recl=xsize*ysize*4)
      .                                        recl=im2*jm2*nPgx*nPgy*4)  
451         nrec = 1         nrec = 1
452         call bcheader (iunit, ndmax, nrec,         call bcheader (iunit, ndmax, nrec,
453       .          cname, cdscrip, imbc, jmbc, npxbc, npybc, lat0, lon0,       .          cname, cdscrip, imbc, jmbc, lat0, lon0,
454       .          ndatebc, nymdbc, nhmsbc, undef, error)       .          ndatebc, nymdbc, nhmsbc, undef, error)
455    
456  C--------- Check data for Compatibility  C--------- Check data for Compatibility
# Line 438  C Check for correct data in boundary con Line 462  C Check for correct data in boundary con
462         endif         endif
463    
464  C Check Horizontal Resolution  C Check Horizontal Resolution
465         if(.not.error.and.imbc*jmbc*npxbc*npybc.ne.im2*jm2*npgx*npgy)then         if(.not.error.and.imbc*jmbc.ne.xsize*ysize)then
466          write(6,*) ' B.C. Resolution DOES NOT match Model Resolution!'          write(6,*) ' B.C. Resolution DOES NOT match Model Resolution!'
467          write(6,*) ' B.C. Resolution:  ',imbc*jmbc*npxbc*npybc          write(6,*) ' B.C. Resolution:  ',imbc*jmbc
468          write(6,*) 'Model Resolution:  ',im2*jm2*npgx*npgy          write(6,*) 'Model Resolution:  ',xsize*ysize
469          error = .true.          error = .true.
470         endif         endif
471    
# Line 512  c  from previous call to getsst then rea Line 536  c  from previous call to getsst then rea
536           nymdbc2 = nymdbc(nd)           nymdbc2 = nymdbc(nd)
537           nhmsbc1 = nhmsbc(nd-1)           nhmsbc1 = nhmsbc(nd-1)
538           nhmsbc2 = nhmsbc(nd)           nhmsbc2 = nhmsbc(nd)
539           call bcdata (iunit,imbc,jmbc,nPgx,nPgy,nd,nd+1,sstbc1,sstbc2)           call bcdata (iunit,imbc,jmbc,nd,nd+1,sstbc1,sstbc2)
540           found = .true.           found = .true.
541          else          else
542           nd = nd + 1           nd = nd + 1
# Line 539  C---------- Interpolate SST data ------- Line 563  C---------- Interpolate SST data -------
563    
564        do j = jm1,jm2        do j = jm1,jm2
565        do i = im1,im2        do i = im1,im2
566         sst(i,j,bi,bj) = sstbc1(i,j,biglobal,bjglobal)*fac1         sst(i,j,bi,bj) = sstbc1(i+bislot,j+bjslot)*fac1
567       .                + sstbc2(i,j,biglobal,bjglobal)*fac2       .                + sstbc2(i+bislot,j+bjslot)*fac2
568        enddo        enddo
569        enddo        enddo
570    
571          close(iunit)
572    
573        return        return
574        end        end
575    
576        subroutine bcdata (iunit,im,jm,nPx,nPy,nrec1,nrec2,field1,field2)        subroutine bcdata (iunit,im,jm,nrec1,nrec2,field1,field2)
577  C************************************************************************  C************************************************************************
578  C  C
579  C!ROUTINE:      BCDATA  C!ROUTINE:      BCDATA
# Line 559  C Line 585  C
585  C!INPUT PARAMETERS:  C!INPUT PARAMETERS:
586  C!      im      number of x points  C!      im      number of x points
587  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  
588  C!      nrec1   record number of the time before the model time  C!      nrec1   record number of the time before the model time
589  C!      nrec2   record number of the time after the model time  C!      nrec2   record number of the time after the model time
590  C  C
591  C!OUTPUT PARAMETERS:  C!OUTPUT PARAMETERS:
592  C!      field1(im,jm,nPx,nPy)  data field before the model time  C!      field1(im,jm)  data field before the model time
593  C!      field2(im,jm,nPx,nPy)  data field after the model time  C!      field2(im,jm)  data field after the model time
594  C  C
595  C--------------------------------------------------------------------------  C--------------------------------------------------------------------------
596        implicit none        implicit none
 #include "CPP_EEOPTIONS.h"  
597    
598        integer iunit,im,jm,nPx,nPy,nrec1,nrec2        integer iunit,im,jm,nrec1,nrec2
599    
600        real  field1(im,jm,nPx,nPy)        _RL  field1(im,jm)
601        real  field2(im,jm,nPx,nPy)        _RL  field2(im,jm)
602    
603        integer i,j,n1,n2        integer i,j
604        real*4 f1(im,jm,nPx,nPy), f2(im,jm,nPx,nPy)        real*4 f1(im,jm), f2(im,jm)
605    
606  C--------- Read file -----------------------------------------------  C--------- Read file -----------------------------------------------
607        read(iunit,rec=nrec1) f1        read(iunit,rec=nrec1) f1
608        read(iunit,rec=nrec2) f2        read(iunit,rec=nrec2) f2
609    
610        do n2=1,nPy  #ifdef _BYTESWAPIO
611        do n1=1,nPx        call MDS_BYTESWAPR4( im*jm, f1)
612          call MDS_BYTESWAPR4( im*jm, f2)
613    #endif
614        do j=1,jm        do j=1,jm
615        do i=1,im        do i=1,im
616         field1(i,j,n1,n2) = f1(i,j,n1,n2)         field1(i,j) = f1(i,j)
617         field2(i,j,n1,n2) = f2(i,j,n1,n2)         field2(i,j) = f2(i,j)
       enddo  
       enddo  
618        enddo        enddo
619        enddo        enddo
620    
621        return        return
622        end        end
623        subroutine bcheader (iunit, ndmax, nrec,        subroutine bcheader (iunit, ndmax, nrec,
624       .           cname, cdscrip, im, jm, npx, npy, lat0, lon0, ndatebc,       .           cname, cdscrip, im, jm, lat0, lon0, ndatebc,
625       .           nymdbc, nhmsbc, undef, error)       .           nymdbc, nhmsbc, undef, error)
626  C************************************************************************  C************************************************************************
627  C  C
# Line 615  C!      cname         name of the data i Line 638  C!      cname         name of the data i
638  C!      cdscrip       description of the data in the file header  C!      cdscrip       description of the data in the file header
639  C!      im            number of x points  C!      im            number of x points
640  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  
641  C!      lat0          starting latitude for the data grid  C!      lat0          starting latitude for the data grid
642  C!      lon0          starting longitude for the data grid  C!      lon0          starting longitude for the data grid
643  C!      ndatebc       number of date/times of the data in the file  C!      ndatebc       number of date/times of the data in the file
# Line 627  C!      error         logical TRUE if da Line 648  C!      error         logical TRUE if da
648  C  C
649  C--------------------------------------------------------------------------  C--------------------------------------------------------------------------
650        implicit none        implicit none
 #include "CPP_EEOPTIONS.h"  
651    
652        integer iunit, ndmax, nrec        integer iunit, ndmax, nrec
653    
654        character*8  cname        character*8  cname
655        character*80 cdscrip        character*80 cdscrip
656        integer im,jm,npx,npy,ndatebc,nymdbc(ndmax),nhmsbc(ndmax)        character*112 dummy112
657        real lat0,lon0,undef        integer im,jm,ndatebc,nymdbc(ndmax),nhmsbc(ndmax)
658          _RL lat0,lon0,undef
659        logical error        logical error
660    
661        integer i        integer i
662        integer*4 im_32,jm_32,npx_32,npy_32        integer*4 im_32,jm_32
663        integer*4 ndatebc_32,nhmsbc_32(ndmax),nymdbc_32(ndmax)        integer*4 ndatebc_32,nhmsbc_32(ndmax),nymdbc_32(ndmax)
664        real*4 lat0_32,lon0_32,undef_32        real*4 lat0_32,lon0_32,undef_32
665    
666  C--------- Read file -----------------------------------------------  C--------- Read file -----------------------------------------------
667    
668        read(iunit,rec=nrec,err=500) cname, cdscrip,        read(iunit,rec=nrec,err=500) cname, cdscrip,
669       .     im_32, jm_32, npx_32, npy_32, lat0_32, lon0_32,       .     im_32, jm_32, lat0_32, lon0_32,
670       .     ndatebc_32, undef_32,       .     ndatebc_32, undef_32
671    
672    #ifdef _BYTESWAPIO
673          call MDS_BYTESWAPI4( 1, im_32)
674          call MDS_BYTESWAPI4( 1, jm_32)
675          call MDS_BYTESWAPR4( 1, lat0_32)
676          call MDS_BYTESWAPR4( 1, lon0_32)
677          call MDS_BYTESWAPI4( 1, ndatebc_32)
678          call MDS_BYTESWAPR4( 1, undef_32)
679    #endif
680    
681          read(iunit,rec=nrec,err=500) dummy112,
682       .     (nymdbc_32(i), nhmsbc_32(i), i=1,ndatebc_32)       .     (nymdbc_32(i), nhmsbc_32(i), i=1,ndatebc_32)
683    
684        im = im_32        im = im_32
685        jm = jm_32        jm = jm_32
       npx = npx_32  
       npy = npy_32  
686        lat0 = lat0_32        lat0 = lat0_32
687        lon0 = lon0_32        lon0 = lon0_32
688        undef = undef_32        undef = undef_32
689    
690        ndatebc = ndatebc_32        ndatebc = ndatebc_32
691        do i=1,ndatebc        do i=1,ndatebc
692    #ifdef _BYTESWAPIO
693          call MDS_BYTESWAPI4( 1, nymdbc_32(i))
694          call MDS_BYTESWAPI4( 1, nhmsbc_32(i))
695    #endif
696        nymdbc(i) = nymdbc_32(i)        nymdbc(i) = nymdbc_32(i)
697        nhmsbc(i) = nhmsbc_32(i)        nhmsbc(i) = nhmsbc_32(i)
698        enddo        enddo
Legend:
Removed from v.1.11  
changed lines
  Added in v.1.22
  ViewVC Help
Powered by ViewVC 1.1.22