/[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.18 by molod, Tue Mar 8 19:48:51 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    
21         integer myTime, myIter, myThid         integer myIter, myThid
22           _RL myTime
23    
24         integer i, j, bi, bj, biglobal, bjglobal         integer i, j, bi, bj, biglobal, bjglobal
25         integer im1, im2, jm1, jm2, idim1, idim2, jdim1, jdim2         integer im1, im2, jm1, jm2, idim1, idim2, jdim1, jdim2
# Line 70  c -------------------------------- Line 71  c --------------------------------
71         end         end
72    
73         subroutine getsice(iunit,idim1,idim2,jdim1,jdim2,im1,im2,jm1,jm2,         subroutine getsice(iunit,idim1,idim2,jdim1,jdim2,im1,im2,jm1,jm2,
74       .            nSx,nSy,nPx,nPy,bi,bj,biglobal,bjglobal,nymd,nhms,sice)       .     nSumx,nSumy,nPgx,nPgy,bi,bj,biglobal,bjglobal,nymd,nhms,sice)
75  C************************************************************************  C************************************************************************
76  C  C
77  C!ROUTINE:      GETSICE  C!ROUTINE:      GETSICE
# Line 89  C!      im1       Begin of x-direction s Line 90  C!      im1       Begin of x-direction s
90  C!      im2       End of x-direction span for filling sice  C!      im2       End of x-direction span for filling sice
91  C!      jm1       Begin of y-direction span for filling sice  C!      jm1       Begin of y-direction span for filling sice
92  C!      jm2       End of y-direction span for filling sice  C!      jm2       End of y-direction span for filling sice
93  C!      nSx       Number of processors in x-direction (local processor)  C!      nSumx     Number of processors in x-direction (local processor)
94  C!      nSy       Number of processors in y-direction (local processor)  C!      nSumy     Number of processors in y-direction (local processor)
95  C!      nPx       Number of processors in x-direction (global)  C!      nPgx      Number of processors in x-direction (global)
96  C!      nPy       Number of processors in y-direction (global)  C!      nPgx      Number of processors in y-direction (global)
97  C!      bi        Processor number in x-direction (local to processor)  C!      bi        Processor number in x-direction (local to processor)
98  C!      bj        Processor number in y-direction (local to processor)  C!      bj        Processor number in y-direction (local to processor)
99  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 102  C!     nymd      YYMMDD of the current model ti
102  C!      nhms      HHMMSS of the model time  C!      nhms      HHMMSS of the model time
103  C  C
104  C!OUTPUT PARAMETERS:  C!OUTPUT PARAMETERS:
105  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
106  C  C
107  C!ROUTINES CALLED:  C!ROUTINES CALLED:
108  C  C
# Line 112  C Line 113  C
113  C--------------------------------------------------------------------------  C--------------------------------------------------------------------------
114    
115        implicit none        implicit none
116  #include "CPP_EEOPTIONS.h"  #include "SIZE.h"
117    
118        integer iunit,idim1,idim2,jdim1,jdim2,im1,im2,jm1,jm2,nSx,nSy        integer iunit,idim1,idim2,jdim1,jdim2,im1,im2,jm1,jm2,nSumx,nSumy
119        integer bi,bj,biglobal.bjglobal,nymd,nhms        integer nPgx,nPgy,bi,bj,biglobal,bjglobal,nymd,nhms
120    
121        _RL sice(idim1:idim2,jdim1:jdim2,nSx,nSy)        _RL sice(idim1:idim2,jdim1:jdim2,nSumx,nSumy)
122    
123  C Maximum number of dates in one year for the data  C Maximum number of dates in one year for the data
124        integer   ndmax        integer   ndmax
# Line 125  C Maximum number of dates in one year fo Line 126  C Maximum number of dates in one year fo
126    
127        character*8  cname        character*8  cname
128        character*80 cdscrip        character*80 cdscrip
129          character*40 sicedata
130        _RL fac1, fac2, lat0, lon0, timebc1, timebc2, timemod, undef        _RL fac1, fac2, lat0, lon0, timebc1, timebc2, timemod, undef
131        logical first, found, error        logical first, found, error
132        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
133        integer ndatebc,nhmsbc(ndmax), nhmsbc1, nhmsbc2,nrec        integer ndatebc,nhmsbc(ndmax), nhmsbc1, nhmsbc2,nrec
134        integer nymdbc(ndmax),nymdbc1,nymdbc2,nymdmod        integer nymdbc(ndmax),nymdbc1,nymdbc2,nymdmod
135    
136        _RL sicebc1(im2,jm2,nPx,nPy),sicebc2(im2,jm2,nPx,nPy)        _RL sicebc1(sNx,sNy,nSx*nPx,nSy*nPy)
137          _RL sicebc2(sNx,sNy,nSx*nPx,nSy*nPy)
138    
139  C--------- Variable Initialization ---------------------------------  C--------- Variable Initialization ---------------------------------
140    
# Line 153  c  this only works for between 1950-2050 Line 156  c  this only works for between 1950-2050
156          nymdmod = nymd          nymdmod = nymd
157        endif        endif
158    
159          sicedata='sice19232.weekly.clim'
160    
161  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
162  c  these vaules make the iyear .ne. iyearbc true anyways for  c  these vaules make the iyear .ne. iyearbc true anyways for
163  c  for the first time so first isnt checked below.  c  for the first time so first isnt checked below.
# Line 174  C---------- Read in Header file -------- Line 179  C---------- Read in Header file --------
179        if( iyear.ne.iyearbc ) then        if( iyear.ne.iyearbc ) then
180    
181         close(iunit)         close(iunit)
182         open (iunit,form='unformatted',access='direct',         open (iunit,file=sicedata,form='unformatted',access='direct',
183       .                                          recl=im2*jm2*nPx*nPy*4)       .                                         recl=im2*jm2*nPgx*nPgy*4)
184         nrec = 1         nrec = 1
185         call bcheader (iunit, ndmax, nrec,         call bcheader (iunit, ndmax, nrec,
186       .          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 195  C Check for correct data in boundary con
195         endif         endif
196    
197  C Check Horizontal Resolution  C Check Horizontal Resolution
198         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
199          write(6,*) ' B.C. Resolution DOES NOT match Model Resolution!'          write(6,*) ' B.C. Resolution DOES NOT match Model Resolution!'
200          write(6,*) ' B.C. Resolution:  ',imbc*jmbc*npxbc*npybc          write(6,*) ' B.C. Resolution:  ',imbc*jmbc*npxbc*npybc
201          write(6,*) 'Model Resolution:  ',im2*jm2*npx*npy          write(6,*) 'Model Resolution:  ',im2*jm2*npgx*npgy
202          error = .true.          error = .true.
203         endif         endif
204    
# Line 263  c  from previous call to getsice then re Line 268  c  from previous call to getsice then re
268           nymdbc2 = nymdbc(nd)           nymdbc2 = nymdbc(nd)
269           nhmsbc1 = nhmsbc(nd-1)           nhmsbc1 = nhmsbc(nd-1)
270           nhmsbc2 = nhmsbc(nd)           nhmsbc2 = nhmsbc(nd)
271           call bcdata (iunit,imbc,jmbc,nPx,nPy,nd,nd+1,sicebc1,sicebc2)           call bcdata (iunit,imbc,jmbc,nPgx,nPgy,nd,nd+1,sicebc1,sicebc2)
272           found = .true.           found = .true.
273          else          else
274           nd = nd + 1           nd = nd + 1
# Line 315  C--------------------------------------- Line 320  C---------------------------------------
320        return        return
321        end        end
322        subroutine getsst(iunit,idim1,idim2,jdim1,jdim2,im1,im2,jm1,jm2,        subroutine getsst(iunit,idim1,idim2,jdim1,jdim2,im1,im2,jm1,jm2,
323       .            nSx,nSy,nPx,nPy,bi,bj,biglobal,bjglobal,nymd,nhms,sst)       .      nSumx,nSumy,nPgx,nPgy,bi,bj,biglobal,bjglobal,nymd,nhms,sst)
324  C************************************************************************  C************************************************************************
325  C  C
326  C!ROUTINE:      GETSST  C!ROUTINE:      GETSST
# Line 334  C!      im1       Begin of x-direction s Line 339  C!      im1       Begin of x-direction s
339  C!      im2       End of x-direction span for filling sice  C!      im2       End of x-direction span for filling sice
340  C!      jm1       Begin of y-direction span for filling sice  C!      jm1       Begin of y-direction span for filling sice
341  C!      jm2       End of y-direction span for filling sice  C!      jm2       End of y-direction span for filling sice
342  C!      nSx       Number of processors in x-direction (local processor)  C!      nSumx     Number of processors in x-direction (local processor)
343  C!      nSy       Number of processors in y-direction (local processor)  C!      nSumy     Number of processors in y-direction (local processor)
344  C!      nPx       Number of processors in x-direction (global)  C!      nPgx      Number of processors in x-direction (global)
345  C!      nPy       Number of processors in y-direction (global)  C!      nPgy      Number of processors in y-direction (global)
346  C!      bi        Processor number in x-direction (local to processor)  C!      bi        Processor number in x-direction (local to processor)
347  C!      bj        Processor number in y-direction (local to processor)  C!      bj        Processor number in y-direction (local to processor)
348  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 351  C!     nymd      YYMMDD of the current model ti
351  C!      nhms      HHMMSS of the model time  C!      nhms      HHMMSS of the model time
352  C  C
353  C!OUTPUT PARAMETERS:  C!OUTPUT PARAMETERS:
354  C!      sst(idim1:idim2,jdim1:jdim2,nSx,nSy) Sea surface temperature (K)  C!      sst(idim1:idim2,jdim1:jdim2,nSumx,nSumy) Sea surface temperature (K)
355  C  C
356  C!ROUTINES CALLED:  C!ROUTINES CALLED:
357  C  C
# Line 357  C Line 362  C
362  C--------------------------------------------------------------------------  C--------------------------------------------------------------------------
363    
364        implicit none        implicit none
365  #include "CPP_EEOPTIONS.h"  #include "SIZE.h"
366    
367        integer iunit,idim1,idim2,jdim1,jdim2,im1,im2,jm1,jm2,nSx,nSy        integer iunit,idim1,idim2,jdim1,jdim2,im1,im2,jm1,jm2,nSumx,nSumy
368        integer bi,bj,biglobal.bjglobal,nymd,nhms        integer nPgx,nPgy,bi,bj,biglobal,bjglobal,nymd,nhms
369    
370        _RL sst(idim1:idim2,jdim1:jdim2,nSx,nSy)        _RL sst(idim1:idim2,jdim1:jdim2,nSumx,nSumy)
371    
372  C Maximum number of dates in one year for the data  C Maximum number of dates in one year for the data
373        integer   ndmax        integer   ndmax
# Line 370  C Maximum number of dates in one year fo Line 375  C Maximum number of dates in one year fo
375    
376        character*8  cname        character*8  cname
377        character*80 cdscrip        character*80 cdscrip
378          character*20 sstdata
379        _RL fac1, fac2, lat0, lon0, timebc1, timebc2, timemod, undef        _RL fac1, fac2, lat0, lon0, timebc1, timebc2, timemod, undef
380        logical first, found, error        logical first, found, error
381        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
382        integer ndatebc,nhmsbc(ndmax), nhmsbc1, nhmsbc2,nrec        integer ndatebc,nhmsbc(ndmax), nhmsbc1, nhmsbc2,nrec
383        integer nymdbc(ndmax),nymdbc1,nymdbc2,nymdmod        integer nymdbc(ndmax),nymdbc1,nymdbc2,nymdmod
384    
385        _RL sstbc1(im2,jm2,nPx,nPy),sstbc2(im2,jm2,nPx,nPy)        _RL sstbc1(sNx,sNy,nSx*nPx,nSy*nPy)
386          _RL sstbc2(sNx,sNy,nSx*nPx,nSy*nPy)
387    
388  C--------- Variable Initialization ---------------------------------  C--------- Variable Initialization ---------------------------------
389    
# Line 398  c  this only works for between 1950-2050 Line 405  c  this only works for between 1950-2050
405          nymdmod = nymd          nymdmod = nymd
406        endif        endif
407    
408          sstdata='sst19232.weekly.clim'
409    
410  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
411  c  these vaules make the iyear .ne. iyearbc true anyways for  c  these vaules make the iyear .ne. iyearbc true anyways for
412  c  for the first time so first isnt checked below.  c  for the first time so first isnt checked below.
# Line 418  C---------- Read in Header file -------- Line 427  C---------- Read in Header file --------
427        if( iyear.ne.iyearbc ) then        if( iyear.ne.iyearbc ) then
428    
429         close(iunit)         close(iunit)
430         open (iunit,form='unformatted',access='direct',         open (iunit,file=sstdata,form='unformatted',access='direct',
431       .                                          recl=im2*jm2nPx*nPy*4)       .                                        recl=im2*jm2*nPgx*nPgy*4)
432         nrec = 1         nrec = 1
433         call bcheader (iunit, ndmax, nrec,         call bcheader (iunit, ndmax, nrec,
434       .          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 443  C Check for correct data in boundary con
443         endif         endif
444    
445  C Check Horizontal Resolution  C Check Horizontal Resolution
446         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
447          write(6,*) ' B.C. Resolution DOES NOT match Model Resolution!'          write(6,*) ' B.C. Resolution DOES NOT match Model Resolution!'
448          write(6,*) ' B.C. Resolution:  ',imbc*jmbc*npxbc*npybc          write(6,*) ' B.C. Resolution:  ',imbc*jmbc*npxbc*npybc
449          write(6,*) 'Model Resolution:  ',im2*jm2*npx*npy          write(6,*) 'Model Resolution:  ',im2*jm2*npgx*npgy
450          error = .true.          error = .true.
451         endif         endif
452    
# Line 454  C Check Year Line 463  C Check Year
463  C if climatology, fill dates for data with current model year  C if climatology, fill dates for data with current model year
464          if (iyearbc.eq.0) then                    if (iyearbc.eq.0) then          
465           write(6,*)           write(6,*)
466           write(6,*) 'Climatological Dataset is being used.'             write(6,*)'Climatological Dataset is being used.'  
467           write(6,*) 'Current model year will be used to fill Header Dates'           write(6,*)'Current model year is used to fill Header Dates'
468           do n = 2, ndatebc-1           do n = 2, ndatebc-1
469            nymdbc(n) = nymdbc(n) +(nymdmod/10000)*10000            nymdbc(n) = nymdbc(n) +(nymdmod/10000)*10000
470           enddo           enddo
# Line 508  c  from previous call to getsst then rea Line 517  c  from previous call to getsst then rea
517           nymdbc2 = nymdbc(nd)           nymdbc2 = nymdbc(nd)
518           nhmsbc1 = nhmsbc(nd-1)           nhmsbc1 = nhmsbc(nd-1)
519           nhmsbc2 = nhmsbc(nd)           nhmsbc2 = nhmsbc(nd)
520           call bcdata (iunit,imbc,jmbc,nPx,nPy,nd,nd+1,sstbc1,sstbc2)           call bcdata (iunit,imbc,jmbc,nPgx,nPgy,nd,nd+1,sstbc1,sstbc2)
521           found = .true.           found = .true.
522          else          else
523           nd = nd + 1           nd = nd + 1
# Line 566  C!      field2(im,jm,nPx,nPy)  data fiel Line 575  C!      field2(im,jm,nPx,nPy)  data fiel
575  C  C
576  C--------------------------------------------------------------------------  C--------------------------------------------------------------------------
577        implicit none        implicit none
 #include "CPP_EEOPTIONS.h"  
578    
579        integer iunit,im,jm,nPx,nPy,nrec1,nrec2        integer iunit,im,jm,nPx,nPy,nrec1,nrec2
580    
581        _RL  field1(im,jm)        _RL  field1(im,jm,nPx,nPy)
582        _RL  field2(im,jm)        _RL  field2(im,jm,nPx,nPy)
583    
584        integer i,j,n1,n2        integer i,j,n1,n2
585        real*4 f1(im,jm,nPx,nPy), f1(im,jm,nPx,nPy)        real*4 f1(im,jm,nPx,nPy), f2(im,jm,nPx,nPy)
586    
587  C--------- Read file -----------------------------------------------  C--------- Read file -----------------------------------------------
588        read(iunit,rec=nrec1) f1        read(iunit,rec=nrec1) f1
# Line 582  C--------- Read file ------------------- Line 590  C--------- Read file -------------------
590    
591        do n2=1,nPy        do n2=1,nPy
592        do n1=1,nPx        do n1=1,nPx
593    #ifdef _BYTESWAPIO
594          call MDS_BYTESWAPR4( im*jm, f1(1,1,n1,n2))
595          call MDS_BYTESWAPR4( im*jm, f2(1,1,n1,n2))
596    #endif
597        do j=1,jm        do j=1,jm
598        do i=1,im        do i=1,im
599         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 635  C!      error         logical TRUE if da
635  C  C
636  C--------------------------------------------------------------------------  C--------------------------------------------------------------------------
637        implicit none        implicit none
 #include "CPP_EEOPTIONS.h"  
638    
639        integer iunit, ndmax, nrec        integer iunit, ndmax, nrec
640    
# Line 633  C--------------------------------------- Line 644  C---------------------------------------
644        _RL lat0,lon0,undef        _RL lat0,lon0,undef
645        logical error        logical error
646    
647        integer i,n        integer i
648        integer*4 im_32,jm_32,npx_32,npy_32        integer*4 im_32,jm_32,npx_32,npy_32
649        integer*4 ndatebc_32(ndmax),nhmsbc_32(ndmax)        integer*4 ndatebc_32,nhmsbc_32(ndmax),nymdbc_32(ndmax)
650        real*4 lat0_32,lon0_32,undef_32        real*4 lat0_32,lon0_32,undef_32
651    
652  C--------- Read file -----------------------------------------------  C--------- Read file -----------------------------------------------
# Line 644  C--------- Read file ------------------- Line 655  C--------- Read file -------------------
655       .     im_32, jm_32, npx_32, npy_32, lat0_32, lon0_32,       .     im_32, jm_32, npx_32, npy_32, lat0_32, lon0_32,
656       .     ndatebc_32, undef_32,       .     ndatebc_32, undef_32,
657       .     (nymdbc_32(i), nhmsbc_32(i), i=1,ndatebc_32)       .     (nymdbc_32(i), nhmsbc_32(i), i=1,ndatebc_32)
658    #ifdef _BYTESWAPIO
659          call MDS_BYTESWAPI4( 1, im_32)
660          call MDS_BYTESWAPI4( 1, jm_32)
661          call MDS_BYTESWAPR4( 1, lat0_32)
662          call MDS_BYTESWAPR4( 1, lon0_32)
663          call MDS_BYTESWAPR4( 1, undef_32)
664    #endif
665    
666          print *,' Read header: ',cname, cdscrip
667          print *,' Read header: ',im_32, jm_32
668          print *,' Read header: ',npx_32, npy_32
669        im = im_32        im = im_32
670        jm = jm_32        jm = jm_32
671        npx = npx_32        npx = npx_32
# Line 665  C--------- Read file ------------------- Line 686  C--------- Read file -------------------
686        error = .true.        error = .true.
687        return        return
688        end        end
689    
690    #include "MDSIO_OPTIONS.h"
691    
692          subroutine MDS_BYTESWAPI4( n, arr )
693    C IN:
694    C   n           integer - Number of 4-byte words in arr
695    C IN/OUT:
696    C   arr         integer*4  - Array declared as integer*4(n)
697    C
698    C Created: 05/05/99 adcroft@mit.edu (This is an unfortunate hack!!)
699    
700          implicit none
701    C Arguments
702          integer n
703          character*(*) arr
704    C Local
705          integer i
706          character*(1) cc
707    C     ------------------------------------------------------------------
708          do i=1,4*n,4
709           cc=arr(i:i)
710           arr(i:i)=arr(i+3:i+3)
711           arr(i+3:i+3)=cc
712           cc=arr(i+1:i+1)
713           arr(i+1:i+1)=arr(i+2:i+2)
714           arr(i+2:i+2)=cc
715          enddo
716    C     ------------------------------------------------------------------
717          return
718          end
Legend:
Removed from v.1.8  
changed lines
  Added in v.1.18
  ViewVC Help
Powered by ViewVC 1.1.22