/[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.8 by molod, Thu Jun 10 21:50:33 2004 UTC revision 1.13 by molod, Mon Jul 26 18:45:17 2004 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"
# Line 70  c -------------------------------- Line 70  c --------------------------------
70         end         end
71    
72         subroutine getsice(iunit,idim1,idim2,jdim1,jdim2,im1,im2,jm1,jm2,         subroutine getsice(iunit,idim1,idim2,jdim1,jdim2,im1,im2,jm1,jm2,
73       .            nSx,nSy,nPx,nPy,bi,bj,biglobal,bjglobal,nymd,nhms,sice)       .     nSumx,nSumy,nPgx,nPgy,bi,bj,biglobal,bjglobal,nymd,nhms,sice)
74  C************************************************************************  C************************************************************************
75  C  C
76  C!ROUTINE:      GETSICE  C!ROUTINE:      GETSICE
# Line 89  C!      im1       Begin of x-direction s Line 89  C!      im1       Begin of x-direction s
89  C!      im2       End of x-direction span for filling sice  C!      im2       End of x-direction span for filling sice
90  C!      jm1       Begin of y-direction span for filling sice  C!      jm1       Begin of y-direction span for filling sice
91  C!      jm2       End of y-direction span for filling sice  C!      jm2       End of y-direction span for filling sice
92  C!      nSx       Number of processors in x-direction (local processor)  C!      nSumx     Number of processors in x-direction (local processor)
93  C!      nSy       Number of processors in y-direction (local processor)  C!      nSumy     Number of processors in y-direction (local processor)
94  C!      nPx       Number of processors in x-direction (global)  C!      nPgx      Number of processors in x-direction (global)
95  C!      nPy       Number of processors in y-direction (global)  C!      nPgx      Number of processors in y-direction (global)
96  C!      bi        Processor number in x-direction (local to processor)  C!      bi        Processor number in x-direction (local to processor)
97  C!      bj        Processor number in y-direction (local to processor)  C!      bj        Processor number in y-direction (local to processor)
98  C!      biglobal  Processor number in x-direction (global)  C!      biglobal  Processor number in x-direction (global)
# Line 101  C!     nymd      YYMMDD of the current model ti Line 101  C!     nymd      YYMMDD of the current model ti
101  C!      nhms      HHMMSS of the model time  C!      nhms      HHMMSS of the model time
102  C  C
103  C!OUTPUT PARAMETERS:  C!OUTPUT PARAMETERS:
104  C!      sice(idim1:idim2,jdim1:jdim2,nSx,nSy) Sea ice depth in meters  C!      sice(idim1:idim2,jdim1:jdim2,nSumx,nSumy) Sea ice depth in meters
105  C  C
106  C!ROUTINES CALLED:  C!ROUTINES CALLED:
107  C  C
# Line 112  C Line 112  C
112  C--------------------------------------------------------------------------  C--------------------------------------------------------------------------
113    
114        implicit none        implicit none
115  #include "CPP_EEOPTIONS.h"  #include "SIZE.h"
116    
117        integer iunit,idim1,idim2,jdim1,jdim2,im1,im2,jm1,jm2,nSx,nSy        integer iunit,idim1,idim2,jdim1,jdim2,im1,im2,jm1,jm2,nSumx,nSumy
118        integer bi,bj,biglobal.bjglobal,nymd,nhms        integer nPgx,nPgy,bi,bj,biglobal,bjglobal,nymd,nhms
119    
120        _RL sice(idim1:idim2,jdim1:jdim2,nSx,nSy)        _RL sice(idim1:idim2,jdim1:jdim2,nSumx,nSumy)
121    
122  C Maximum number of dates in one year for the data  C Maximum number of dates in one year for the data
123        integer   ndmax        integer   ndmax
# Line 127  C Maximum number of dates in one year fo Line 127  C Maximum number of dates in one year fo
127        character*80 cdscrip        character*80 cdscrip
128        _RL fac1, fac2, lat0, lon0, timebc1, timebc2, timemod, undef        _RL fac1, fac2, lat0, lon0, timebc1, timebc2, timemod, undef
129        logical first, found, error        logical first, found, error
130        integer i,j,n,nn,iyear,iyearbc,nd,ndby3,imbc,jmbc,npxbc,npybd        integer i,j,n,nn,iyear,iyearbc,nd,ndby3,imbc,jmbc,npxbc,npybc
131        integer ndatebc,nhmsbc(ndmax), nhmsbc1, nhmsbc2,nrec        integer ndatebc,nhmsbc(ndmax), nhmsbc1, nhmsbc2,nrec
132        integer nymdbc(ndmax),nymdbc1,nymdbc2,nymdmod        integer nymdbc(ndmax),nymdbc1,nymdbc2,nymdmod
133    
134        _RL sicebc1(im2,jm2,nPx,nPy),sicebc2(im2,jm2,nPx,nPy)        _RL sicebc1(sNx,sNy,nSx*nPx,nSy*nPy)
135          _RL sicebc2(sNx,sNy,nSx*nPx,nSy*nPy)
136    
137  C--------- Variable Initialization ---------------------------------  C--------- Variable Initialization ---------------------------------
138    
# Line 175  C---------- Read in Header file -------- Line 176  C---------- Read in Header file --------
176    
177         close(iunit)         close(iunit)
178         open (iunit,form='unformatted',access='direct',         open (iunit,form='unformatted',access='direct',
179       .                                          recl=im2*jm2*nPx*nPy*4)       .                                         recl=im2*jm2*nPgx*nPgy*4)
180         nrec = 1         nrec = 1
181         call bcheader (iunit, ndmax, nrec,         call bcheader (iunit, ndmax, nrec,
182       .          cname, cdscrip, imbc, jmbc, npxbc, npybc, lat0, lon0,       .          cname, cdscrip, imbc, jmbc, npxbc, npybc, lat0, lon0,
# Line 190  C Check for correct data in boundary con Line 191  C Check for correct data in boundary con
191         endif         endif
192    
193  C Check Horizontal Resolution  C Check Horizontal Resolution
194         if(.not.error .and. imbc*jmbc*npxbc*npybc.ne.im2*jm2*npx*npy)then         if(.not.error.and.imbc*jmbc*npxbc*npybc.ne.im2*jm2*npgx*npgy)then
195          write(6,*) ' B.C. Resolution DOES NOT match Model Resolution!'          write(6,*) ' B.C. Resolution DOES NOT match Model Resolution!'
196          write(6,*) ' B.C. Resolution:  ',imbc*jmbc*npxbc*npybc          write(6,*) ' B.C. Resolution:  ',imbc*jmbc*npxbc*npybc
197          write(6,*) 'Model Resolution:  ',im2*jm2*npx*npy          write(6,*) 'Model Resolution:  ',im2*jm2*npgx*npgy
198          error = .true.          error = .true.
199         endif         endif
200    
# Line 263  c  from previous call to getsice then re Line 264  c  from previous call to getsice then re
264           nymdbc2 = nymdbc(nd)           nymdbc2 = nymdbc(nd)
265           nhmsbc1 = nhmsbc(nd-1)           nhmsbc1 = nhmsbc(nd-1)
266           nhmsbc2 = nhmsbc(nd)           nhmsbc2 = nhmsbc(nd)
267           call bcdata (iunit,imbc,jmbc,nPx,nPy,nd,nd+1,sicebc1,sicebc2)           call bcdata (iunit,imbc,jmbc,nPgx,nPgy,nd,nd+1,sicebc1,sicebc2)
268           found = .true.           found = .true.
269          else          else
270           nd = nd + 1           nd = nd + 1
# Line 315  C--------------------------------------- Line 316  C---------------------------------------
316        return        return
317        end        end
318        subroutine getsst(iunit,idim1,idim2,jdim1,jdim2,im1,im2,jm1,jm2,        subroutine getsst(iunit,idim1,idim2,jdim1,jdim2,im1,im2,jm1,jm2,
319       .            nSx,nSy,nPx,nPy,bi,bj,biglobal,bjglobal,nymd,nhms,sst)       .      nSumx,nSumy,nPgx,nPgy,bi,bj,biglobal,bjglobal,nymd,nhms,sst)
320  C************************************************************************  C************************************************************************
321  C  C
322  C!ROUTINE:      GETSST  C!ROUTINE:      GETSST
# Line 334  C!      im1       Begin of x-direction s Line 335  C!      im1       Begin of x-direction s
335  C!      im2       End of x-direction span for filling sice  C!      im2       End of x-direction span for filling sice
336  C!      jm1       Begin of y-direction span for filling sice  C!      jm1       Begin of y-direction span for filling sice
337  C!      jm2       End of y-direction span for filling sice  C!      jm2       End of y-direction span for filling sice
338  C!      nSx       Number of processors in x-direction (local processor)  C!      nSumx     Number of processors in x-direction (local processor)
339  C!      nSy       Number of processors in y-direction (local processor)  C!      nSumy     Number of processors in y-direction (local processor)
340  C!      nPx       Number of processors in x-direction (global)  C!      nPgx      Number of processors in x-direction (global)
341  C!      nPy       Number of processors in y-direction (global)  C!      nPgy      Number of processors in y-direction (global)
342  C!      bi        Processor number in x-direction (local to processor)  C!      bi        Processor number in x-direction (local to processor)
343  C!      bj        Processor number in y-direction (local to processor)  C!      bj        Processor number in y-direction (local to processor)
344  C!      biglobal  Processor number in x-direction (global)  C!      biglobal  Processor number in x-direction (global)
# Line 346  C!     nymd      YYMMDD of the current model ti Line 347  C!     nymd      YYMMDD of the current model ti
347  C!      nhms      HHMMSS of the model time  C!      nhms      HHMMSS of the model time
348  C  C
349  C!OUTPUT PARAMETERS:  C!OUTPUT PARAMETERS:
350  C!      sst(idim1:idim2,jdim1:jdim2,nSx,nSy) Sea surface temperature (K)  C!      sst(idim1:idim2,jdim1:jdim2,nSumx,nSumy) Sea surface temperature (K)
351  C  C
352  C!ROUTINES CALLED:  C!ROUTINES CALLED:
353  C  C
# Line 357  C Line 358  C
358  C--------------------------------------------------------------------------  C--------------------------------------------------------------------------
359    
360        implicit none        implicit none
361  #include "CPP_EEOPTIONS.h"  #include "SIZE.h"
362    
363        integer iunit,idim1,idim2,jdim1,jdim2,im1,im2,jm1,jm2,nSx,nSy        integer iunit,idim1,idim2,jdim1,jdim2,im1,im2,jm1,jm2,nSumx,nSumy
364        integer bi,bj,biglobal.bjglobal,nymd,nhms        integer nPgx,nPgy,bi,bj,biglobal,bjglobal,nymd,nhms
365    
366        _RL sst(idim1:idim2,jdim1:jdim2,nSx,nSy)        _RL sst(idim1:idim2,jdim1:jdim2,nSumx,nSumy)
367    
368  C Maximum number of dates in one year for the data  C Maximum number of dates in one year for the data
369        integer   ndmax        integer   ndmax
# Line 372  C Maximum number of dates in one year fo Line 373  C Maximum number of dates in one year fo
373        character*80 cdscrip        character*80 cdscrip
374        _RL fac1, fac2, lat0, lon0, timebc1, timebc2, timemod, undef        _RL fac1, fac2, lat0, lon0, timebc1, timebc2, timemod, undef
375        logical first, found, error        logical first, found, error
376        integer i,j,n,nn,iyear,iyearbc,nd,ndby3,imbc,jmbc,npxbc,npybd        integer i,j,n,nn,iyear,iyearbc,nd,ndby3,imbc,jmbc,npxbc,npybc
377        integer ndatebc,nhmsbc(ndmax), nhmsbc1, nhmsbc2,nrec        integer ndatebc,nhmsbc(ndmax), nhmsbc1, nhmsbc2,nrec
378        integer nymdbc(ndmax),nymdbc1,nymdbc2,nymdmod        integer nymdbc(ndmax),nymdbc1,nymdbc2,nymdmod
379    
380        _RL sstbc1(im2,jm2,nPx,nPy),sstbc2(im2,jm2,nPx,nPy)        _RL sstbc1(sNx,sNy,nSx*nPx,nSy*nPy)
381          _RL sstbc2(sNx,sNy,nSx*nPx,nSy*nPy)
382    
383  C--------- Variable Initialization ---------------------------------  C--------- Variable Initialization ---------------------------------
384    
# Line 419  C---------- Read in Header file -------- Line 421  C---------- Read in Header file --------
421    
422         close(iunit)         close(iunit)
423         open (iunit,form='unformatted',access='direct',         open (iunit,form='unformatted',access='direct',
424       .                                          recl=im2*jm2nPx*nPy*4)       .                                        recl=im2*jm2*nPgx*nPgy*4)
425         nrec = 1         nrec = 1
426         call bcheader (iunit, ndmax, nrec,         call bcheader (iunit, ndmax, nrec,
427       .          cname, cdscrip, imbc, jmbc, npxbc, npybc, lat0, lon0,       .          cname, cdscrip, imbc, jmbc, npxbc, npybc, lat0, lon0,
# Line 434  C Check for correct data in boundary con Line 436  C Check for correct data in boundary con
436         endif         endif
437    
438  C Check Horizontal Resolution  C Check Horizontal Resolution
439         if(.not.error .and. imbc*jmbc*npxbc*npybc.ne.im2*jm2*npx*npy)then         if(.not.error.and.imbc*jmbc*npxbc*npybc.ne.im2*jm2*npgx*npgy)then
440          write(6,*) ' B.C. Resolution DOES NOT match Model Resolution!'          write(6,*) ' B.C. Resolution DOES NOT match Model Resolution!'
441          write(6,*) ' B.C. Resolution:  ',imbc*jmbc*npxbc*npybc          write(6,*) ' B.C. Resolution:  ',imbc*jmbc*npxbc*npybc
442          write(6,*) 'Model Resolution:  ',im2*jm2*npx*npy          write(6,*) 'Model Resolution:  ',im2*jm2*npgx*npgy
443          error = .true.          error = .true.
444         endif         endif
445    
# Line 454  C Check Year Line 456  C Check Year
456  C if climatology, fill dates for data with current model year  C if climatology, fill dates for data with current model year
457          if (iyearbc.eq.0) then                    if (iyearbc.eq.0) then          
458           write(6,*)           write(6,*)
459           write(6,*) 'Climatological Dataset is being used.'             write(6,*)'Climatological Dataset is being used.'  
460           write(6,*) 'Current model year will be used to fill Header Dates'           write(6,*)'Current model year is used to fill Header Dates'
461           do n = 2, ndatebc-1           do n = 2, ndatebc-1
462            nymdbc(n) = nymdbc(n) +(nymdmod/10000)*10000            nymdbc(n) = nymdbc(n) +(nymdmod/10000)*10000
463           enddo           enddo
# Line 508  c  from previous call to getsst then rea Line 510  c  from previous call to getsst then rea
510           nymdbc2 = nymdbc(nd)           nymdbc2 = nymdbc(nd)
511           nhmsbc1 = nhmsbc(nd-1)           nhmsbc1 = nhmsbc(nd-1)
512           nhmsbc2 = nhmsbc(nd)           nhmsbc2 = nhmsbc(nd)
513           call bcdata (iunit,imbc,jmbc,nPx,nPy,nd,nd+1,sstbc1,sstbc2)           call bcdata (iunit,imbc,jmbc,nPgx,nPgy,nd,nd+1,sstbc1,sstbc2)
514           found = .true.           found = .true.
515          else          else
516           nd = nd + 1           nd = nd + 1
# Line 566  C!      field2(im,jm,nPx,nPy)  data fiel Line 568  C!      field2(im,jm,nPx,nPy)  data fiel
568  C  C
569  C--------------------------------------------------------------------------  C--------------------------------------------------------------------------
570        implicit none        implicit none
 #include "CPP_EEOPTIONS.h"  
571    
572        integer iunit,im,jm,nPx,nPy,nrec1,nrec2        integer iunit,im,jm,nPx,nPy,nrec1,nrec2
573    
574        _RL  field1(im,jm)        _RL  field1(im,jm,nPx,nPy)
575        _RL  field2(im,jm)        _RL  field2(im,jm,nPx,nPy)
576    
577        integer i,j,n1,n2        integer i,j,n1,n2
578        real*4 f1(im,jm,nPx,nPy), f1(im,jm,nPx,nPy)        real*4 f1(im,jm,nPx,nPy), f2(im,jm,nPx,nPy)
579    
580  C--------- Read file -----------------------------------------------  C--------- Read file -----------------------------------------------
581        read(iunit,rec=nrec1) f1        read(iunit,rec=nrec1) f1
# Line 582  C--------- Read file ------------------- Line 583  C--------- Read file -------------------
583    
584        do n2=1,nPy        do n2=1,nPy
585        do n1=1,nPx        do n1=1,nPx
586    #ifdef _BYTESWAPIO
587          call MDS_BYTESWAPR4( im*jm, f1(1,1,n1,n2))
588          call MDS_BYTESWAPR4( im*jm, f2(1,1,n1,n2))
589    #endif
590        do j=1,jm        do j=1,jm
591        do i=1,im        do i=1,im
592         field1(i,j,n1,n2) = f1(i,j,n1,n2)         field1(i,j,n1,n2) = f1(i,j,n1,n2)
# Line 623  C!      error         logical TRUE if da Line 628  C!      error         logical TRUE if da
628  C  C
629  C--------------------------------------------------------------------------  C--------------------------------------------------------------------------
630        implicit none        implicit none
 #include "CPP_EEOPTIONS.h"  
631    
632        integer iunit, ndmax, nrec        integer iunit, ndmax, nrec
633    
# Line 633  C--------------------------------------- Line 637  C---------------------------------------
637        _RL lat0,lon0,undef        _RL lat0,lon0,undef
638        logical error        logical error
639    
640        integer i,n        integer i
641        integer*4 im_32,jm_32,npx_32,npy_32        integer*4 im_32,jm_32,npx_32,npy_32
642        integer*4 ndatebc_32(ndmax),nhmsbc_32(ndmax)        integer*4 ndatebc_32,nhmsbc_32(ndmax),nymdbc_32(ndmax)
643        real*4 lat0_32,lon0_32,undef_32        real*4 lat0_32,lon0_32,undef_32
644    
645  C--------- Read file -----------------------------------------------  C--------- Read file -----------------------------------------------
# Line 644  C--------- Read file ------------------- Line 648  C--------- Read file -------------------
648       .     im_32, jm_32, npx_32, npy_32, lat0_32, lon0_32,       .     im_32, jm_32, npx_32, npy_32, lat0_32, lon0_32,
649       .     ndatebc_32, undef_32,       .     ndatebc_32, undef_32,
650       .     (nymdbc_32(i), nhmsbc_32(i), i=1,ndatebc_32)       .     (nymdbc_32(i), nhmsbc_32(i), i=1,ndatebc_32)
651    #ifdef _BYTESWAPIO
652          call MDS_BYTESWAPR4( 1, lat0_32)
653          call MDS_BYTESWAPR4( 1, lon0_32)
654          call MDS_BYTESWAPR4( 1, undef_32)
655    #endif
656    
657        im = im_32        im = im_32
658        jm = jm_32        jm = jm_32
Legend:
Removed from v.1.8  
changed lines
  Added in v.1.13
  ViewVC Help
Powered by ViewVC 1.1.22