/[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.3 by molod, Tue Jun 8 16:42:54 2004 UTC revision 1.12 by molod, Tue Jul 20 16:24:49 2004 UTC
# Line 20  c--------------------------------------- Line 20  c---------------------------------------
20    
21         integer myTime, myIter, myThid         integer myTime, myIter, myThid
22    
23         integer i, j, L, bi, bj         integer i, j, bi, bj, biglobal, bjglobal
24         integer im1, im2, jm1, jm2, idim1, idim2, jdim1, jdim2         integer im1, im2, jm1, jm2, idim1, idim2, jdim1, jdim2
25           integer nSxglobal, nSyglobal
        im1 = 1-OLx  
        im2 = sNx+OLx  
        jm1 = 1-OLy  
        jm2 = sNy+OLy  
        idim1 = 1  
        idim2 = sNx  
        jdim1 = 1  
        jdim2 = sNy  
   
26         integer ksst,kice         integer ksst,kice
27           _RL        sstmin
 c Declare Local Variables  
 c -----------------------  
        real        sstmin  
28         parameter ( sstmin = 273.16 )         parameter ( sstmin = 273.16 )
29    
30         integer i,j,im,jm         idim1 = 1-OLx
31           idim2 = sNx+OLx
32           jdim1 = 1-OLy
33           jdim2 = sNy+OLy
34           im1 = 1
35           im2 = sNx
36           jm1 = 1
37           jm2 = sNy
38           nSxglobal = nSx*nPx
39           nSyglobal = nSy*nPy
40    
41           call mdsfindunit( ksst, myThid )
42           call mdsfindunit( kice, myThid )
43    
44    C***********************************************************************
45    
46           DO BJ = myByLo(myThid),myByHi(myThid)
47           DO BI = myBxLo(myThid),myBxHi(myThid)
48    
49  C*********************************************************************         biglobal=bi+(myXGlobalLo-1)/im2
50  C****             Interpolate Data to Current Time                ****         bjglobal=bj+(myYGlobalLo-1)/jm2
 C*********************************************************************  
51    
52         call getsst (ksst,nymd,nhms,sst,im,jm)         call getsst(ksst,idim1,idim2,jdim1,jdim2,im1,im2,jm1,jm2,nSx,
53         call getsice (kice,nymd,nhms,sice,im,jm)       .  nSy,nSxglobal,nSyglobal,bi,bj,biglobal,bjglobal,nymd,nhms,sst)
54           call getsice(kice,idim1,idim2,jdim1,jdim2,im1,im2,jm1,jm2,nSx,
55         .  nSy,nSxglobal,nSyglobal,bi,bj,biglobal,bjglobal,nymd,nhms,sice)
56    
57  c Check for Minimum Open-Water SST  c Check for Minimum Open-Water SST
58  c --------------------------------  c --------------------------------
59         do j=1,jm         do j=jm1,jm2
60         do i=1,im         do i=im1,im2
61         if(sice(i,j).eq.0.0 .and. sst(i,j).lt.sstmin)sst(i,j) = sstmin         if(sice(i,j,bi,bj).eq.0.0 .and. sst(i,j,bi,bj).lt.sstmin)
62         .                                          sst(i,j,bi,bj) = sstmin
63         enddo         enddo
64         enddo         enddo
65    
66           ENDDO
67           ENDDO
68    
69         return         return
70         end         end
71    
72         subroutine getsice ( iunit,nymd,nhms,sice,im,jm )         subroutine getsice(iunit,idim1,idim2,jdim1,jdim2,im1,im2,jm1,jm2,
73  C************************************************************************       .     nSumx,nSumy,nPgx,nPgy,bi,bj,biglobal,bjglobal,nymd,nhms,sice)
 C!GETSICE  
74  C************************************************************************  C************************************************************************
75  C  C
76  C!ROUTINE:      GETSICE  C!ROUTINE:      GETSICE
 C!PROGRAMMER:   Sharon Nebuda  
 C!DATE CODED:   May 8, 1996  
77  C!DESCRIPTION:  GETSICE returns the sea ice depth.  C!DESCRIPTION:  GETSICE returns the sea ice depth.
78  C!              This routine is adaptable for any frequency  C!              This routine is adaptable for any frequency
79  C!              data upto a daily frequency.    C!              data upto a daily frequency.  
80  C!              note: for diurnal data ndmax should be increased.  C!              note: for diurnal data ndmax should be increased.
81  C  C
82  C!INPUT PARAMETERS:  C!INPUT PARAMETERS:
83  C!              iunit   Unit number assigned to the sice data file  C!      iunit     Unit number assigned to the sice data file
84  C!              nymd    YYMMDD of the current model timestep  C!      idim1     Start dimension in x-direction
85  C!              nhms    HHMMSS of the model time  C!      idim2     End dimension in x-direction
86  C!            im     Number of x points  C!      jdim1     Start dimension in y-direction
87  C!            jm     Number of y points  C!      jdim2     End dimension in y-direction
88  C!       lattice     Grid Decomposition defined by Dynamics  C!      im1       Begin of x-direction span for filling sice
89    C!      im2       End of x-direction span for filling sice
90    C!      jm1       Begin of y-direction span for filling sice
91    C!      jm2       End of y-direction span for filling sice
92    C!      nSumx     Number of processors in x-direction (local processor)
93    C!      nSumy     Number of processors in y-direction (local processor)
94    C!      nPgx      Number of processors in x-direction (global)
95    C!      nPgx      Number of processors in y-direction (global)
96    C!      bi        Processor number in x-direction (local to processor)
97    C!      bj        Processor number in y-direction (local to processor)
98    C!      biglobal  Processor number in x-direction (global)
99    C!      bjglobal  Processor number in y-direction (global)
100    C!      nymd      YYMMDD of the current model timestep
101    C!      nhms      HHMMSS of the model time
102  C  C
103  C!OUTPUT PARAMETERS:  C!OUTPUT PARAMETERS:
104  C!              sice(im,jm)     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
108  C!      bcdata          Reads the data for a given unit number  C!      bcdata       Reads the data for a given unit number
109  C!      bcheader        Reads the header info for a given unit number  C!      bcheader     Reads the header info for a given unit number
110  C!     interp_time   Returns weights for linear interpolation  C!      interp_time  Returns weights for linear interpolation
111  C  C
112  C--------------------------------------------------------------------------  C--------------------------------------------------------------------------
113    
       use dynamics_lattice_module  
114        implicit none        implicit none
115        type ( dynamics_lattice_type ) lattice  #include "CPP_EEOPTIONS.h"
116    #include "SIZE.h"
117    
118          integer iunit,idim1,idim2,jdim1,jdim2,im1,im2,jm1,jm2,nSumx,nSumy
119          integer nPgx,nPgy,bi,bj,biglobal,bjglobal,nymd,nhms
120    
121  c MPI Utilities        _RL sice(idim1:idim2,jdim1:jdim2,nSumx,nSumy)
 c -------------  
       include 'mpif.h'  
       integer  ierror  
122    
123  C  Parameter statements  C Maximum number of dates in one year for the data
124        integer   ndmax   ! Maximum number of dates in one year for the data        integer   ndmax
125        parameter (ndmax = 370)        parameter (ndmax = 370)
126    
127  C  Variables passed to the routine:        character*8  cname
128        integer   iunit   ! Unit number assigned to the sea ice data file        character*80 cdscrip
129        integer   nymd    ! YYMMDD of the current model timestep        real fac1, fac2, lat0, lon0, timebc1, timebc2, timemod, undef
130        integer   nhms    ! HHMMSS of the model time        logical first, found, error
131        integer        im     ! Number of x points        integer i,j,n,nn,iyear,iyearbc,nd,ndby3,imbc,jmbc,npxbc,npybc
132        integer        jm     ! Number of y points        integer ndatebc,nhmsbc(ndmax), nhmsbc1, nhmsbc2,nrec
133          integer nymdbc(ndmax),nymdbc1,nymdbc2,nymdmod
134  C  Variables returned by the routine:  
135        real      sice(im,jm)     ! Sea ice depth in meters        real sicebc1(sNx,sNy,nSx*nPx,nSy*nPy)
136          real sicebc2(sNx,sNy,nSx*nPx,nSy*nPy)
 C  Variables unique to the routine:  
       character*8  cname        ! Name of the data in the file header  
       character*80 cdscrip      ! Description of the data in the file header  
       real      fac1            ! Weighted value (fraction) of the data  
                                 ! before the model time  
       real      fac2            ! Weighted value (fraction) of the data  
                                 ! after the model time  
       logical   first           ! True for first time using the dates for the  
                                 ! BC data file.  Then read in the header file.  
       logical   found           ! If false, then the data surrounding the model  
                                 ! time was not found  
       logical   error           ! TRUE if problem with data  
       integer   i,j,n,nn        ! DO loop counters  
       integer   iyear           ! Year of model  
       integer   iyearbc         ! Year of boundary condition data  
       real      lat0            ! Starting lat of the bc data set (future use)  
       real      lon0            ! Starting lon of the bc data set (future use)  
       integer   nd              ! Counter for record number of data to read  
       integer   ndby3           ! int(ndatebc/3) used for write statement  
       integer   imbc            ! IM read from the BC data  
       integer   jmbc            ! JM read from the BC data  
       integer   ndatebc         ! Number of dates in the BC file  
       integer   nhmsbc(ndmax)   ! HHMMSS of the data time (not needed currently)  
       integer   nhmsbc1 ! HHMMSS of the earlier data kept from last timestep  
       integer   nhmsbc2 ! HHMMSS of the later data kept from last timestep  
       integer   nrec            ! Record number of the header (set to 1)  
       integer   nymdbc(ndmax)   ! YYYYMMDD of each data  
       integer   nymdbc1 ! YYYYMMDD of the earlier data kept from last timestep  
       integer   nymdbc2 ! YYYYMMDD of the later data kept from last timestep  
       integer   nymdmod         ! YYYYMMDD of the current model timestep  
       real      timebc1         ! YYYYMMDD.HHMMSS of the earlier bc data  
       real      timebc2         ! YYYYMMDD.HHMMSS of the later bc data  
       real      timemod         ! YYYYMMDD.HHMMSS of the current timestep  
       real      undef           ! Undefined value for missing data  
   
 C Define Allocatable Arrays  
       real, allocatable, save :: sicebc1(:,:)    ! Sea ice 0=no 1=yes from the bc data  
                                                  ! of the date before the model time  
       real, allocatable, save :: sicebc2(:,:)    ! Sea ice 0=no 1=yes from bc data  
                                                  ! of the date after the model time  
137    
138  C--------- Variable Initialization ---------------------------------  C--------- Variable Initialization ---------------------------------
139    
# Line 161  C--------- Variable Initialization ----- Line 141  C--------- Variable Initialization -----
141        data error /.false./        data error /.false./
142    
143  c  save header info  c  save header info
144        save imbc, jmbc, lat0, lon0, ndatebc, undef, nymdbc, nhmsbc        save imbc,jmbc,npxbc,npybc,lat0,lon0,ndatebc,undef,nymdbc,nhmsbc
145        save nymdbc1, nymdbc2, nhmsbc1, nhmsbc2        save nymdbc1, nymdbc2, nhmsbc1, nhmsbc2
146        save first        save first
147          save sicebc1, sicebc2
148    
149  c  this only works for between 1950-2050  c  this only works for between 1950-2050
150        if (nymd .lt. 500101) then        if (nymd .lt. 500101) then
# Line 179  c  these vaules make the iyear .ne. iyea Line 160  c  these vaules make the iyear .ne. iyea
160  c  for the first time so first isnt checked below.  c  for the first time so first isnt checked below.
161    
162        if (first) then        if (first) then
       allocate ( sicebc1(lattice%imglobal,lattice%jmglobal) )    ! Allocate Memory for sicebc1  
       allocate ( sicebc2(lattice%imglobal,lattice%jmglobal) )    ! Allocate Memory for sicebc2  
163          nymdbc(2) = 0          nymdbc(2) = 0
164          nymdbc1   = 0          nymdbc1   = 0
165          nymdbc2   = 0          nymdbc2   = 0
# Line 195  C---------- Read in Header file -------- Line 174  C---------- Read in Header file --------
174        iyearbc = nymdbc(2)/10000        iyearbc = nymdbc(2)/10000
175    
176        if( iyear.ne.iyearbc ) then        if( iyear.ne.iyearbc ) then
         if( lattice%myid.eq.0 ) then  
177    
178          close(iunit)         close(iunit)
179          open (iunit, form='unformatted', access='direct',recl=lattice%imglobal*lattice%jmglobal*4)         open (iunit,form='unformatted',access='direct',
180          nrec = 1       .                                         recl=im2*jm2*nPgx*nPgy*4)
181          call bcheader (iunit, ndmax, nrec,         nrec = 1
182       .                 cname, cdscrip, imbc, jmbc, lat0, lon0,         call bcheader (iunit, ndmax, nrec,
183       .                 ndatebc, nymdbc, nhmsbc, undef, error)       .          cname, cdscrip, imbc, jmbc, npxbc, npybc, lat0, lon0,
184         .          ndatebc, nymdbc, nhmsbc, undef, error)
185    
186  C--------- Check data for Compatibility ------------------------------  C--------- Check data for Compatibility ------------------------------
187    
188  C Check for correct data in boundary condition file  C Check for correct data in boundary condition file
189         if (.not.error .and. cname.ne.'SICE') then         if (.not.error .and. cname.ne.'SICE') then
190              write(6,*) 'Wrong data in SICE boundary condition file => ',cname          write(6,*)'Wrong data in SICE boundary condition file => ',cname
191              error = .true.          error = .true.
192         endif         endif
193    
194  C Check Horizontal Resolution  C Check Horizontal Resolution
195         if (.not.error .and. imbc*jmbc.ne.lattice%imglobal*lattice%jmglobal) then         if(.not.error.and.imbc*jmbc*npxbc*npybc.ne.im2*jm2*npgx*npgy)then
196              write(6,*) 'Boundary Condition Resolution DOES NOT match Model Resolution!'          write(6,*) ' B.C. Resolution DOES NOT match Model Resolution!'
197              write(6,*) 'Boundary Condition Resolution:  ',imbc*jmbc          write(6,*) ' B.C. Resolution:  ',imbc*jmbc*npxbc*npybc
198              write(6,*) '             Model Resolution:  ',lattice%imglobal*lattice%jmglobal          write(6,*) 'Model Resolution:  ',im2*jm2*npgx*npgy
199              error = .true.          error = .true.
200         endif         endif
201    
202  C Check Year  C Check Year
203         iyearbc = nymdbc(2)/10000         iyearbc = nymdbc(2)/10000
204         if (.not.error .and. iyear.ne.iyearbc .and. iyearbc.ne.0) then         if (.not.error .and. iyear.ne.iyearbc .and. iyearbc.ne.0) then
205              write(6,*) 'Boundary Condition Year DOES NOT match REQUESTED Year!'          write(6,*)'     B.C. Year DOES NOT match REQUESTED Year!'
206              write(6,*) 'Boundary Condition Year:  ', iyearbc          write(6,*)'     B.C. Year:  ', iyearbc
207              write(6,*) '         Requested Year:  ', iyear          write(6,*)'Requested Year:  ', iyear
208              error = .true.          error = .true.
209         endif         endif
210    
211         if (.not.error)   then                   if (.not.error)   then
212  C if climatology, fill dates for data with current model year  C if climatology, fill dates for data with current model year
213              if (iyearbc.eq.0) then                        if (iyearbc.eq.0) then          
214              write(6,*)           write(6,*)
215              write(6,*) 'Climatological Dataset is being used.'             write(6,*) 'Climatological Dataset is being used.'  
216              write(6,*) 'Current model year will be used to fill Header Dates'           write(6,*) 'Current model year to be used to fill Header Dates'
217                do n = 2, ndatebc-1           do n = 2, ndatebc-1
218                 nymdbc(n) = nymdbc(n) +(nymdmod/10000)*10000            nymdbc(n) = nymdbc(n) +(nymdmod/10000)*10000
219                enddo           enddo
220  C  For the first date subtract 1 year from the current model NYMD  C  For the first date subtract 1 year from the current model NYMD
221                n = 1           n = 1
222                nymdbc(n) = nymdbc(n) +(nymdmod/10000-1)*10000           nymdbc(n) = nymdbc(n) +(nymdmod/10000-1)*10000
223  C  For the last date add 1 year to the current model NYMD  C  For the last date add 1 year to the current model NYMD
224                n = ndatebc           n = ndatebc
225                nymdbc(n) = nymdbc(n) +(nymdmod/10000+1)*10000           nymdbc(n) = nymdbc(n) +(nymdmod/10000+1)*10000
226              endif          endif
227    
228  C  Write out header info  C  Write out header info
229         write(6,*) ' Updated boundary condition data'          write(6,*) ' Updated boundary condition data'
230         write(6,*) ' ---------------------------------'          write(6,*) ' ---------------------------------'
231         write(6,*) ' Variable: ',cname          write(6,*) ' Variable: ',cname
232         write(6,*) ' Description: ',cdscrip          write(6,*) ' Description: ',cdscrip
233         write(6,*) ' Resolution: x= ',imbc,' y= ',jmbc,' Undefined value = ',undef          write(6,*) ' Resolution: x= ',imbc,' y= ',jmbc,
234         write(6,*) ' Starting latitude = ',lat0,' longitude =',lon0       .                                       ' Undefined value = ',undef
235         write(6,*) ' Data valid at these times: '          write(6,*) ' Starting latitude = ',lat0,' longitude =',lon0
236         ndby3 = ndatebc/3          write(6,*) ' Data valid at these times: '
237         do n = 1, ndby3*3,3          ndby3 = ndatebc/3
238          write(6,1000) (nn,nymdbc(nn),nhmsbc(nn),nn=n,n+2)          do n = 1, ndby3*3,3
239   1000   format(3(2x,i3,':',i8,2x,i8))           write(6,1000) (nn,nymdbc(nn),nhmsbc(nn),nn=n,n+2)
240         enddo   1000    format(3(2x,i3,':',i8,2x,i8))
241         write(6,1000) (nn,nymdbc(nn),nhmsbc(nn),nn=ndby3*3+1,ndatebc)          enddo
242        endif  ! End error  Check          write(6,1000) (nn,nymdbc(nn),nhmsbc(nn),nn=ndby3*3+1,ndatebc)
243           endif  
       endif  ! End MYID=0 Check  
   
 c Broadcast information to other PEs  
 c ----------------------------------  
 #if (mpi)  
        call mpi_bcast ( error,1,mpi_logical,0,lattice%comm,ierror )  
 #endif  
        if( error ) call my_exit (101)  
   
 #if (mpi)  
        call mpi_bcast ( ndatebc,1     ,mpi_integer,0,lattice%comm,ierror )  
        call mpi_bcast ( nymdbc,ndatebc,mpi_integer,0,lattice%comm,ierror )  
        call mpi_bcast ( nhmsbc,ndatebc,mpi_integer,0,lattice%comm,ierror )  
 #endif  
244    
245        endif  ! New Year Info Check        endif
246    
247  C---------- Read sice data if necessary -------------------------------  C---------- Read sice data if necessary -------------------------------
248    
249          found = .false.        found = .false.
250          nd = 2        nd = 2
251    
252  c  If model time is not within the times of saved sice data  c  If model time is not within the times of saved sice data
253  c  from previous call to getsice then read new data  c  from previous call to getsice then read new data
254    
255          timemod = float(nymdmod) + float(nhms)   /1000000        timemod = float(nymdmod) + float(nhms)   /1000000
256          timebc1 = float(nymdbc1) + float(nhmsbc1)/1000000        timebc1 = float(nymdbc1) + float(nhmsbc1)/1000000
257          timebc2 = float(nymdbc2) + float(nhmsbc2)/1000000        timebc2 = float(nymdbc2) + float(nhmsbc2)/1000000
258          if (timemod .lt. timebc1 .or. timemod .ge. timebc2) then  
259          if (timemod .lt. timebc1 .or. timemod .ge. timebc2) then
260          do while (.not.found .and. nd .le. ndatebc)  
261            timebc2 = float(nymdbc(nd)) + float(nhmsbc(nd))/1000000         do while (.not.found .and. nd .le. ndatebc)
262            if (timebc2 .gt. timemod) then                  timebc2 = float(nymdbc(nd)) + float(nhmsbc(nd))/1000000
263              nymdbc1 = nymdbc(nd-1)          if (timebc2 .gt. timemod) then  
264              nymdbc2 = nymdbc(nd)           nymdbc1 = nymdbc(nd-1)
265              nhmsbc1 = nhmsbc(nd-1)           nymdbc2 = nymdbc(nd)
266              nhmsbc2 = nhmsbc(nd)           nhmsbc1 = nhmsbc(nd-1)
267              if ( lattice%myid.eq.0 ) call bcdata (iunit, imbc, jmbc, nd, nd+1, sicebc1, sicebc2)           nhmsbc2 = nhmsbc(nd)
268  #if (mpi)           call bcdata (iunit,imbc,jmbc,nPgx,nPgy,nd,nd+1,sicebc1,sicebc2)
269              call mpi_bcast ( sicebc1,lattice%imglobal*lattice%jmglobal,mpi_double_precision,0,lattice%comm,ierror )           found = .true.
270              call mpi_bcast ( sicebc2,lattice%imglobal*lattice%jmglobal,mpi_double_precision,0,lattice%comm,ierror )          else
271  #endif           nd = nd + 1
272              found = .true.          endif
273            else         enddo
             nd = nd + 1  
           endif  
         enddo  
274    
275  c  Otherwise the data from the last time in getsice surrounds the  c  Otherwise the data from the last time in getsice surrounds the
276  c  current model time.  c  current model time.
277    
278          else        else
279            found = .true.         found = .true.
280          endif        endif
281    
282            if (.not.found) then        if (.not.found) then
283              if( lattice%myid.eq.0 ) print *, 'STOP: Could not find SICE boundary condition dates surrounding the model time.'         print *, 'STOP: Could not find SICE dates for model time.'
284              call my_finalize         call my_finalize
285              call my_exit (101)         call my_exit (101)
286            endif        endif
287    
288  C---------- Interpolate sice data ------------------------------------  C---------- Interpolate sice data ------------------------------------
289    
290            call interp_time ( nymdmod,nhms, nymdbc1,nhmsbc1, nymdbc2,nhmsbc2, fac1,fac2 )        call interp_time(nymdmod,nhms,nymdbc1,nhmsbc1,nymdbc2,nhmsbc2,
291         .                                                       fac1,fac2)
292    
293            do j = 1, jm        do j = jm1,jm2
294            do i = 1, im        do i = im1,im2
295              sice(i,j) = sicebc1( lattice%iglobal(i),lattice%jglobal(j) )*fac1         sice(i,j,bi,bj) = sicebc1(i,j,biglobal,bjglobal)*fac1
296       .                + sicebc2( lattice%iglobal(i),lattice%jglobal(j) )*fac2       .                 + sicebc2(i,j,biglobal,bjglobal)*fac2
297  c average to 0 or 1  c average to 0 or 1
298  c -----------------  c -----------------
299              if (sice(i,j) .ge. 0.5) then         if (sice(i,j,bi,bj) .ge. 0.5) then
300                  sice(i,j) = 1.          sice(i,j,bi,bj) = 1.
301              else         else
302                  sice(i,j) = 0.          sice(i,j,bi,bj) = 0.
303              endif         endif
304            enddo        enddo
305            enddo        enddo
306    
307  C---------- Fill sice with depth of ice ------------------------------------  C---------- Fill sice with depth of ice ------------------------------------
308          do j = jm1,jm2
309            do j = 1, jm        do i = im1,im2
310            do i = 1, im         if (sice(i,j,bi,bj) .eq. 1.) then                
311              if (sice(i,j) .eq. 1.) then         ! sea ice present          sice(i,j,bi,bj) = 3.
312                  sice(i,j) = 3.         endif
313              endif        enddo
314            enddo        enddo
           enddo  
   
315  C---------------------------------------------------------------------------  C---------------------------------------------------------------------------
316    
317        return        return
318        end        end
319        subroutine getsst ( iunit,nymd,nhms,sst,im,jm,lattice )        subroutine getsst(iunit,idim1,idim2,jdim1,jdim2,im1,im2,jm1,jm2,
320  C************************************************************************       .      nSumx,nSumy,nPgx,nPgy,bi,bj,biglobal,bjglobal,nymd,nhms,sst)
 C!GETSST  
321  C************************************************************************  C************************************************************************
322  C  C
323  C!ROUTINE:      GETSST  C!ROUTINE:      GETSST
 C!PROGRAMMER:   Sharon Nebuda  
 C!DATE CODED:   May 8, 1996  
324  C!DESCRIPTION:  GETSST gets the SST data.  C!DESCRIPTION:  GETSST gets the SST data.
325  C!              This routine is adaptable for any frequency  C!              This routine is adaptable for any frequency
326  C!              data upto a daily frequency.    C!              data upto a daily frequency.  
327  C!              note: for diurnal data ndmax should be increased.  C!              note: for diurnal data ndmax should be increased.
328  C  C
329  C!INPUT PARAMETERS:  C!INPUT PARAMETERS:
330  C!              iunit   Unit number assigned to the sst data file  C!      iunit     Unit number assigned to the sice data file
331  C!              nymd    YYMMDD of the current model timestep  C!      idim1     Start dimension in x-direction
332  C!              nhms    HHMMSS of the model time  C!      idim2     End dimension in x-direction
333  C!            im     Number of x points  C!      jdim1     Start dimension in y-direction
334  C!            jm     Number of y points  C!      jdim2     End dimension in y-direction
335  C!       lattice     Grid Decomposition defined by Dynamics  C!      im1       Begin of x-direction span for filling sice
336    C!      im2       End of x-direction span for filling sice
337    C!      jm1       Begin of y-direction span for filling sice
338    C!      jm2       End of y-direction span for filling sice
339    C!      nSumx     Number of processors in x-direction (local processor)
340    C!      nSumy     Number of processors in y-direction (local processor)
341    C!      nPgx      Number of processors in x-direction (global)
342    C!      nPgy      Number of processors in y-direction (global)
343    C!      bi        Processor number in x-direction (local to processor)
344    C!      bj        Processor number in y-direction (local to processor)
345    C!      biglobal  Processor number in x-direction (global)
346    C!      bjglobal  Processor number in y-direction (global)
347    C!      nymd      YYMMDD of the current model timestep
348    C!      nhms      HHMMSS of the model time
349  C  C
350  C!OUTPUT PARAMETERS:  C!OUTPUT PARAMETERS:
351  C!              sst(im,jm)      Sea surface temperature in Kelvin  C!      sst(idim1:idim2,jdim1:jdim2,nSumx,nSumy) Sea surface temperature (K)
352  C  C
353  C!ROUTINES CALLED:  C!ROUTINES CALLED:
354  C  C
# Line 387  C!     interp_time   Returns weights for Line 358  C!     interp_time   Returns weights for
358  C  C
359  C--------------------------------------------------------------------------  C--------------------------------------------------------------------------
360    
       use dynamics_lattice_module  
361        implicit none        implicit none
362        type ( dynamics_lattice_type ) lattice  #include "CPP_EEOPTIONS.h"
363    #include "SIZE.h"
364    
365  c MPI Utilities        integer iunit,idim1,idim2,jdim1,jdim2,im1,im2,jm1,jm2,nSumx,nSumy
366  c -------------        integer nPgx,nPgy,bi,bj,biglobal,bjglobal,nymd,nhms
       include 'mpif.h'  
       integer  ierror  
367    
368  C  Parameter statements        _RL sst(idim1:idim2,jdim1:jdim2,nSumx,nSumy)
369        integer   ndmax   ! Maximum number of dates in one year for the data  
370    C Maximum number of dates in one year for the data
371          integer   ndmax
372        parameter (ndmax = 370)        parameter (ndmax = 370)
373    
374  C  Variables passed to the routine:        character*8  cname
375        integer   iunit   ! Unit number assigned to the SST data file        character*80 cdscrip
376        integer   nymd    ! YYMMDD of the current model timestep        real fac1, fac2, lat0, lon0, timebc1, timebc2, timemod, undef
377        integer   nhms    ! HHMMSS of the model time        logical first, found, error
378        integer        im     ! Number of x points        integer i,j,n,nn,iyear,iyearbc,nd,ndby3,imbc,jmbc,npxbc,npybc
379        integer        jm     ! Number of y points        integer ndatebc,nhmsbc(ndmax), nhmsbc1, nhmsbc2,nrec
380          integer nymdbc(ndmax),nymdbc1,nymdbc2,nymdmod
381  C  Variables returned by the routine:  
382        real      sst(im,jm)      ! Sea surface temperature in Kelvin        real sstbc1(sNx,sNy,nSx*nPx,nSy*nPy)
383          real sstbc2(sNx,sNy,nSx*nPx,nSy*nPy)
 C  Variables unique to the routine:  
       character*8  cname        ! Name of the data in the file header  
       character*80 cdscrip      ! Description of the data in the file header  
       real      fac1            ! Weighted value (fraction) of the data  
                                 ! before the model time  
       real      fac2            ! Weighted value (fraction) of the data  
                                 ! after the model time  
       logical   first           ! True for first time using the dates for the  
                                 ! BC data file.  Then read in the header file.  
       logical   found           ! If false, then the data surrounding the model  
                                 ! time was not found  
       logical error         ! TRUE if problem with data  
       integer   i,j,n,nn        ! DO loop counters  
       integer   iyear           ! Year of model  
       integer   iyearbc         ! Year of boundary condition data  
       real      lat0            ! Starting lat of the bc data set (future use)  
       real      lon0            ! Starting lon of the bc data set (future use)  
       integer   nd              ! Counter for record number of data to read  
       integer   ndby3           ! int(ndatebc/3) used for write statement  
       integer   imbc            ! IM read from the BC data  
       integer   jmbc            ! JM read from the BC data  
       integer   ndatebc         ! Number of dates in the BC file  
       integer   nhmsbc(ndmax)          ! HHMMSS of the data time (not needed currently)  
       integer   nhmsbc1         ! HHMMSS of the earlier data kept from last timestep  
       integer   nhmsbc2                ! HHMMSS of the later data kept from last timestep  
       integer nrec                    ! Record number of the header (set to 1)  
       integer   nymdbc(ndmax)          ! YYYYMMDD of each data  
       integer   nymdbc1         ! YYYYMMDD of the earlier data kept from last timestep  
       integer   nymdbc2                ! YYYYMMDD of the later data kept from last timestep  
       integer nymdmod           ! YYYYMMDD of the current model timestep  
       real      timebc1         ! YYYYMMDD.HHMMSS of the earlier bc data  
       real      timebc2         ! YYYYMMDD.HHMMSS of the later bc data  
       real      timemod         ! YYYYMMDD.HHMMSS of the current timestep  
       real      undef           ! Undefined value for missing data  
   
 C Define Allocatable Arrays  
       real, allocatable, save :: sstbc1(:,:)     ! Sea surface temperature (K) from bc data  
                                                  ! of the date before the model time  
       real, allocatable, save :: sstbc2(:,:)     ! Sea surface temperature (K) from bc data  
                                                  ! of the date after the model time  
384    
385  C--------- Variable Initialization ---------------------------------  C--------- Variable Initialization ---------------------------------
386    
# Line 457  C--------- Variable Initialization ----- Line 388  C--------- Variable Initialization -----
388        data error /.false./        data error /.false./
389    
390  c  save header info  c  save header info
391        save imbc, jmbc, lat0, lon0, ndatebc, undef, nymdbc, nhmsbc        save imbc,jmbc,npxbc,npybc,lat0,lon0,ndatebc,undef,nymdbc,nhmsbc
392        save nymdbc1, nymdbc2, nhmsbc1, nhmsbc2, sstbc1        save nymdbc1, nymdbc2, nhmsbc1, nhmsbc2
393        save first        save first
394          save sstbc1, sstbc2
395    
396  c  this only works for between 1950-2050  c  this only works for between 1950-2050
397        if (nymd .lt. 500101) then        if (nymd .lt. 500101) then
# Line 474  c  initialize so that first time through Line 406  c  initialize so that first time through
406  c  these vaules make the iyear .ne. iyearbc true anyways for  c  these vaules make the iyear .ne. iyearbc true anyways for
407  c  for the first time so first isnt checked below.  c  for the first time so first isnt checked below.
408        if (first) then        if (first) then
       allocate ( sstbc1(lattice%imglobal,lattice%jmglobal) )  ! Allocate Memory for sstbc1  
       allocate ( sstbc2(lattice%imglobal,lattice%jmglobal) )  ! Allocate Memory for sstbc2  
409          nymdbc(2) = 0          nymdbc(2) = 0
410          nymdbc1   = 0          nymdbc1   = 0
411          nymdbc2   = 0          nymdbc2   = 0
# Line 490  C---------- Read in Header file -------- Line 420  C---------- Read in Header file --------
420        iyearbc = nymdbc(2)/10000        iyearbc = nymdbc(2)/10000
421    
422        if( iyear.ne.iyearbc ) then        if( iyear.ne.iyearbc ) then
         if( lattice%myid.eq.0 ) then    
423    
424          close(iunit)         close(iunit)
425          open (iunit, form='unformatted', access='direct',recl=lattice%imglobal*lattice%jmglobal*4)         open (iunit,form='unformatted',access='direct',
426          nrec = 1       .                                        recl=im2*jm2*nPgx*nPgy*4)
427          call bcheader (iunit, ndmax, nrec,         nrec = 1
428       .                 cname, cdscrip, imbc, jmbc, lat0, lon0,         call bcheader (iunit, ndmax, nrec,
429       .                 ndatebc, nymdbc, nhmsbc, undef, error)       .          cname, cdscrip, imbc, jmbc, npxbc, npybc, lat0, lon0,
430         .          ndatebc, nymdbc, nhmsbc, undef, error)
431    
432  C--------- Check data for Compatibility  C--------- Check data for Compatibility
433    
434  C Check for correct data in boundary condition file  C Check for correct data in boundary condition file
435         if (.not.error .and. cname.ne.'SST') then         if (.not.error .and. cname.ne.'SST') then
436              write(6,*) 'Wrong data in SST boundary condition file => ',cname          write(6,*)'Wrong data in SST boundary condition file => ',cname
437              error = .true.          error = .true.
438         endif         endif
439    
440  C Check Horizontal Resolution  C Check Horizontal Resolution
441         if (.not.error .and. imbc*jmbc.ne.lattice%imglobal*lattice%jmglobal) then         if(.not.error.and.imbc*jmbc*npxbc*npybc.ne.im2*jm2*npgx*npgy)then
442              write(6,*) 'Boundary Condition Resolution DOES NOT match Model Resolution!'          write(6,*) ' B.C. Resolution DOES NOT match Model Resolution!'
443              write(6,*) 'Boundary Condition Resolution:  ',imbc*jmbc          write(6,*) ' B.C. Resolution:  ',imbc*jmbc*npxbc*npybc
444              write(6,*) '             Model Resolution:  ',lattice%imglobal*lattice%jmglobal          write(6,*) 'Model Resolution:  ',im2*jm2*npgx*npgy
445              error = .true.          error = .true.
446         endif         endif
447    
448  C Check Year  C Check Year
449         iyearbc = nymdbc(2)/10000         iyearbc = nymdbc(2)/10000
450         if (.not.error .and. iyear.ne.iyearbc .and. iyearbc.ne.0) then         if (.not.error .and. iyear.ne.iyearbc .and. iyearbc.ne.0) then
451              write(6,*) 'Boundary Condition Year DOES NOT match REQUESTED Year!'          write(6,*)'     B.C. Year DOES NOT match REQUESTED Year!'
452              write(6,*) 'Boundary Condition Year:  ', iyearbc          write(6,*)'     B.C. Year:  ', iyearbc
453              write(6,*) '         Requested Year:  ', iyear          write(6,*)'Requested Year:  ', iyear
454              error = .true.          error = .true.
455         endif         endif
456    
457         if (.not.error)   then         if (.not.error)   then
458  C if climatology, fill dates for data with current model year  C if climatology, fill dates for data with current model year
459              if (iyearbc.eq.0) then                        if (iyearbc.eq.0) then          
460              write(6,*)           write(6,*)
461              write(6,*) 'Climatological Dataset is being used.'             write(6,*)'Climatological Dataset is being used.'  
462              write(6,*) 'Current model year will be used to fill Header Dates'           write(6,*)'Current model year is used to fill Header Dates'
463                do n = 2, ndatebc-1           do n = 2, ndatebc-1
464                 nymdbc(n) = nymdbc(n) +(nymdmod/10000)*10000            nymdbc(n) = nymdbc(n) +(nymdmod/10000)*10000
465                enddo           enddo
466  C  For the first date subtract 1 year from the current model NYMD  C  For the first date subtract 1 year from the current model NYMD
467                n = 1           n = 1
468                nymdbc(n) = nymdbc(n) +(nymdmod/10000-1)*10000           nymdbc(n) = nymdbc(n) +(nymdmod/10000-1)*10000
469  C  For the last date add 1 year to the current model NYMD  C  For the last date add 1 year to the current model NYMD
470                n = ndatebc           n = ndatebc
471                nymdbc(n) = nymdbc(n) +(nymdmod/10000+1)*10000           nymdbc(n) = nymdbc(n) +(nymdmod/10000+1)*10000
472              endif          endif
473    
474  C  Write out header info  C  Write out header info
475         write(6,*) ' Updated boundary condition data'          write(6,*) ' Updated boundary condition data'
476         write(6,*) ' ---------------------------------'          write(6,*) ' ---------------------------------'
477         write(6,*) ' Variable: ',cname          write(6,*) ' Variable: ',cname
478         write(6,*) ' Description: ',cdscrip          write(6,*) ' Description: ',cdscrip
479         write(6,*) ' Resolution: x= ',imbc,' y= ',jmbc,' Undefined value = ',undef          write(6,*) ' Resolution: x= ',imbc,' y= ',jmbc,
480         write(6,*) ' Starting latitude = ',lat0,' longitude =',lon0       .                                       ' Undefined value = ',undef
481         write(6,*) ' Data valid at these times: '          write(6,*) ' Starting latitude = ',lat0,' longitude =',lon0
482         ndby3 = ndatebc/3          write(6,*) ' Data valid at these times: '
483         do n = 1, ndby3*3,3          ndby3 = ndatebc/3
484          write(6,1000) (nn,nymdbc(nn),nhmsbc(nn),nn=n,n+2)          do n = 1, ndby3*3,3
485   1000   format(3(2x,i3,':',i8,2x,i8))           write(6,1000) (nn,nymdbc(nn),nhmsbc(nn),nn=n,n+2)
486         enddo   1000    format(3(2x,i3,':',i8,2x,i8))
487         write(6,1000) (nn,nymdbc(nn),nhmsbc(nn),nn=ndby3*3+1,ndatebc)          enddo
488        endif  ! End error  Check          write(6,1000) (nn,nymdbc(nn),nhmsbc(nn),nn=ndby3*3+1,ndatebc)
489           endif
       endif  ! End MYID=0 Check  
490    
 c Broadcast information to other PEs  
 c ----------------------------------  
 #if (mpi)  
        call mpi_bcast ( error,1,mpi_logical,0,lattice%comm,ierror )  
 #endif  
491         if( error ) call my_exit (101)         if( error ) call my_exit (101)
492    
493  #if (mpi)        endif
        call mpi_bcast ( ndatebc,1     ,mpi_integer,0,lattice%comm,ierror )  
        call mpi_bcast ( nymdbc,ndatebc,mpi_integer,0,lattice%comm,ierror )  
        call mpi_bcast ( nhmsbc,ndatebc,mpi_integer,0,lattice%comm,ierror )  
 #endif  
   
       endif  ! New Year Info Check  
494    
495  C---------- Read SST data if necessary -------------------------------  C---------- Read SST data if necessary -------------------------------
496    
497          found = .false.        found = .false.
498          nd = 2        nd = 2
499    
500  c  If model time is not within the times of saved sst data  c  If model time is not within the times of saved sst data
501  c  from previous call to getsst then read new data  c  from previous call to getsst then read new data
502    
503          timemod = float(nymdmod) + float(nhms)   /1000000        timemod = float(nymdmod) + float(nhms)   /1000000
504          timebc1 = float(nymdbc1) + float(nhmsbc1)/1000000        timebc1 = float(nymdbc1) + float(nhmsbc1)/1000000
505          timebc2 = float(nymdbc2) + float(nhmsbc2)/1000000        timebc2 = float(nymdbc2) + float(nhmsbc2)/1000000
506          if (timemod .lt. timebc1 .or. timemod .ge. timebc2) then        if (timemod .lt. timebc1 .or. timemod .ge. timebc2) then
507    
508          do while (.not.found .and. nd .le. ndatebc)         do while (.not.found .and. nd .le. ndatebc)
509            timebc2 = float(nymdbc(nd)) + float(nhmsbc(nd))/1000000          timebc2 = float(nymdbc(nd)) + float(nhmsbc(nd))/1000000
510            if (timebc2 .gt. timemod) then                  if (timebc2 .gt. timemod) then  
511              nymdbc1 = nymdbc(nd-1)           nymdbc1 = nymdbc(nd-1)
512              nymdbc2 = nymdbc(nd)           nymdbc2 = nymdbc(nd)
513              nhmsbc1 = nhmsbc(nd-1)           nhmsbc1 = nhmsbc(nd-1)
514              nhmsbc2 = nhmsbc(nd)           nhmsbc2 = nhmsbc(nd)
515              if ( lattice%myid.eq.0 ) call bcdata (iunit, imbc, jmbc, nd, nd+1, sstbc1, sstbc2)           call bcdata (iunit,imbc,jmbc,nPgx,nPgy,nd,nd+1,sstbc1,sstbc2)
516  #if (mpi)           found = .true.
517              call mpi_bcast ( sstbc1,lattice%imglobal*lattice%jmglobal,mpi_double_precision,0,lattice%comm,ierror )          else
518              call mpi_bcast ( sstbc2,lattice%imglobal*lattice%jmglobal,mpi_double_precision,0,lattice%comm,ierror )           nd = nd + 1
519  #endif          endif
520              found = .true.         enddo
           else  
             nd = nd + 1  
           endif  
         enddo  
521    
522  c  Otherwise the data from the last time in getsst surrounds the  c  Otherwise the data from the last time in getsst surrounds the
523  c  current model time.  c  current model time.
524    
525          else        else
526            found = .true.         found = .true.
527          endif        endif
528    
529          if (.not.found) then        if (.not.found) then
530            if( lattice%myid.eq.0 ) print *, 'STOP: Could not find SST boundary condition dates surrounding the model time.'         print *, 'STOP: Could not find SST dates for model time.'
531            call my_finalize         call my_finalize
532            call my_exit (101)         call my_exit (101)
533          endif        endif
534    
535  C---------- Interpolate SST data ------------------------------------  C---------- Interpolate SST data ------------------------------------
536    
537            call interp_time ( nymdmod,nhms, nymdbc1,nhmsbc1, nymdbc2,nhmsbc2, fac1,fac2 )        call interp_time(nymdmod,nhms,nymdbc1,nhmsbc1,nymdbc2,nhmsbc2,
538         .                                                        fac1,fac2)
539    
540            do j = 1, jm        do j = jm1,jm2
541            do i = 1, im        do i = im1,im2
542              sst(i,j) = sstbc1( lattice%iglobal(i),lattice%jglobal(j) )*fac1         sst(i,j,bi,bj) = sstbc1(i,j,biglobal,bjglobal)*fac1
543       .               + sstbc2( lattice%iglobal(i),lattice%jglobal(j) )*fac2       .                + sstbc2(i,j,biglobal,bjglobal)*fac2
544            enddo        enddo
545            enddo        enddo
546    
547        return        return
548        end        end
549    
550        subroutine bcdata (iunit, im, jm, nrec1, nrec2, field1, field2)        subroutine bcdata (iunit,im,jm,nPx,nPy,nrec1,nrec2,field1,field2)
 C************************************************************************  
 C!BCDATA  
551  C************************************************************************  C************************************************************************
552  C  C
553  C!ROUTINE:      BCDATA  C!ROUTINE:      BCDATA
554  C!PROGRAMMER:   Sharon Nebuda  C!DESCRIPTION:  BCDATA reads the data from the file assigned to the
555  C!DATE CODED:   April 29, 1996  C!              passed unit number and returns data from the two times
556  C!DESCRIPTION:  BCDATA reads the data from the file assigned to the  C!              surrounding the current model time.  The two record
557  C!              passed unit number and returns data from the two times  C!              postitions are not assumed to be next to each other.
 C!              surrounding the current model time.  The two record  
 C!              postitions are not assumed to be next to each other.  
558  C  C
559  C!INPUT PARAMETERS:  C!INPUT PARAMETERS:
560  C!      im      number of x points  C!      im      number of x points
561  C!      jm      number of y points  C!      im      number of x points
562  C!      nrec1   record number of the time before the model time  C!      nPx     number of faces in x-direction
563  C!      nrec2   record number of the time after the model time  C!      nPy     number of faces in y-direction
564    C!      nrec1   record number of the time before the model time
565    C!      nrec2   record number of the time after the model time
566  C  C
567  C!OUTPUT PARAMETERS:  C!OUTPUT PARAMETERS:
568  C!      field1(im,jm)   data field before the model time  C!      field1(im,jm,nPx,nPy)  data field before the model time
569  C!      field2(im,jm)   data field after the model time  C!      field2(im,jm,nPx,nPy)  data field after the model time
 C  
 C!REVISION HISTORY:      
 C!      NEW  
 C  
 C!ROUTINES CALLED:  
 C  
 C!      none  
570  C  C
571  C--------------------------------------------------------------------------  C--------------------------------------------------------------------------
572          implicit none
573    #include "PACKAGES_CONFIG.h"
574    #include "CPP_EEOPTIONS.h"
575    
576          integer iunit,im,jm,nPx,nPy,nrec1,nrec2
577    
578  C--------------- Variable Declaration -------------------------------------        real  field1(im,jm,nPx,nPy)
579        implicit none        real  field2(im,jm,nPx,nPy)
580    
581  C  Variables passed to the routine:        integer i,j,n1,n2
582        integer   iunit   ! Unit number assigned to the data file        real*4 f1(im,jm,nPx,nPy), f2(im,jm,nPx,nPy)
       integer   im      ! Number of x points  
       integer   jm      ! Number of y points  
       integer   nrec1   ! Record number of the time before the model time  
       integer   nrec2   ! Record number of the time after the model time  
   
 C  Variables returned by the routine:  
       real      field1(im,jm)   ! Real*8 Data before the model time  
       real      field2(im,jm)   ! Real*8 Data after  the model time  
   
 C  Variables unique to the routine:  
       integer i,j               ! DO loop counters  
       real*4    f1(im,jm)       ! Real*4 Data before the model time  
       real*4    f2(im,jm)       ! Real*4 Data after  the model time  
583    
584  C--------- Read file -----------------------------------------------  C--------- Read file -----------------------------------------------
   
585        read(iunit,rec=nrec1) f1        read(iunit,rec=nrec1) f1
586        read(iunit,rec=nrec2) f2        read(iunit,rec=nrec2) f2
587    
588          do n2=1,nPy
589          do n1=1,nPx
590    #ifdef _BYTESWAPIO
591          call MDS_BYTESWAPR4( im*jm, f1(1,1,n1,n2))
592          call MDS_BYTESWAPR4( im*jm, f2(1,1,n1,n2))
593    #endif
594        do j=1,jm        do j=1,jm
595        do i=1,im        do i=1,im
596        field1(i,j) = f1(i,j)         field1(i,j,n1,n2) = f1(i,j,n1,n2)
597        field2(i,j) = f2(i,j)         field2(i,j,n1,n2) = f2(i,j,n1,n2)
598          enddo
599          enddo
600        enddo        enddo
601        enddo        enddo
602    
603        return        return
604        end        end
605        subroutine bcheader (iunit, ndmax, nrec,        subroutine bcheader (iunit, ndmax, nrec,
606       .                     cname, cdscrip, im, jm, lat0, lon0, ndatebc,       .           cname, cdscrip, im, jm, npx, npy, lat0, lon0, ndatebc,
607       .                     nymdbc, nhmsbc, undef, error)       .           nymdbc, nhmsbc, undef, error)
 C************************************************************************  
 C!BCHEADER  
608  C************************************************************************  C************************************************************************
609  C  C
610  C!ROUTINE:      BCHEADER  C!ROUTINE:     BCHEADER
611  C!PROGRAMMER:   Sharon Nebuda  C!DESCRIPTION: BCHEADER reads the header from a file and returns the info.  
 C!DATE CODED:   April 29, 1996  
 C!DESCRIPTION:  BCHEADER reads the header info from the file assigned to the  
 C!              passed unit number and returns the info back.    
612  C  C
613  C!INPUT PARAMETERS:  C!INPUT PARAMETERS:
614  C!      iunit   unit number assigned to the data file  C!      iunit    unit number assigned to the data file
615  C!      ndmax   maximum number of date/times of the data  C!      ndmax    maximum number of date/times of the data
616  C!      nrec    record number of the header info (or assume 1??)  C!      nrec     record number of the header info (or assume 1??)
617  C  C
618  C!OUTPUT PARAMETERS:  C!OUTPUT PARAMETERS:
619  C!      cname           name of the data in the file header  C!      cname         name of the data in the file header
620  C!      cdscrip         description of the data in the file header  C!      cdscrip       description of the data in the file header
621  C!      im              number of x points  C!      im            number of x points
622  C!      jm              number of y points  C!      jm            number of y points
623  C!      lat0            starting latitude for the data grid  C!      npx           number of faces (processors) in x-direction
624  C!      lon0            starting longitude for the data grid  C!      npy           number of faces (processors) in x-direction
625  C!      ndatebc         number of date/times of the data in the file  C!      lat0          starting latitude for the data grid
626  C!      nymdbc(ndmax)   array of dates for the data including century  C!      lon0          starting longitude for the data grid
627  C!      nhmsbc(ndmax)   array of times for the data  C!      ndatebc       number of date/times of the data in the file
628  C!      undef           value for undefined values in the data  C!      nymdbc(ndmax) array of dates for the data including century
629  C!      error           logical TRUE if dataset problem  C!      nhmsbc(ndmax) array of times for the data
630  C  C!      undef         value for undefined values in the data
631  C!REVISION HISTORY:      C!      error         logical TRUE if dataset problem
 C!      NEW  
 C  
 C!ROUTINES CALLED:  
 C!      none  
632  C  C
633  C--------------------------------------------------------------------------  C--------------------------------------------------------------------------
   
 C--------------- Variable Declaration -------------------------------------  
634        implicit none        implicit none
635    #include "PACKAGES_CONFIG.h"
636    #include "CPP_EEOPTIONS.h"
637    
638          integer iunit, ndmax, nrec
639    
640  C  Variables passed to the routine:        character*8  cname
641        integer   iunit   ! Unit number assigned to the data file        character*80 cdscrip
642        integer   ndmax   ! Maximum number of dates for a given field        integer im,jm,npx,npy,ndatebc,nymdbc(ndmax),nhmsbc(ndmax)
643        integer   nrec    ! Record number of the header info (or assume 1??)        real lat0,lon0,undef
644          logical error
645  C  Variables returned by the routine:  
646        character*8  cname        ! Name of the data in the file header        integer i
647        character*80 cdscrip      ! Description of the data in the file header        integer*4 im_32,jm_32,npx_32,npy_32
648        integer   im     ! Number of x points        integer*4 ndatebc_32,nhmsbc_32(ndmax),nymdbc_32(ndmax)
649        integer   jm     ! Number of y points        real*4 lat0_32,lon0_32,undef_32
       real         lat0     ! Starting latitude of the data  
       real           lon0     ! Starting longitude of the data  
       integer   ndatebc ! Number of date/times of the data in the file  
       integer   nymdbc(ndmax)   ! array of dates for the data including century  
       integer   nhmsbc(ndmax)   ! array of times for the data  
       real      undef           ! value for undefined values in the data  
       logical error         ! logical TRUE if dataset problem  
   
 C  Variables unique to the routine:  
       integer   i               ! DO loop counters  
       integer n  
       integer*4            im_32  ! Number of x points  
       integer*4               jm_32  ! Number of y points  
       real*4             lat0_32  ! Starting latitude of the data  
       real*4               lon0_32  ! Starting longitude of the data  
       integer*4       ndatebc_32  ! Number of date/times of the data in the file  
       integer*4 nymdbc_32(ndmax)  ! array of dates for the data including century  
       integer*4 nhmsbc_32(ndmax)  ! array of times for the data  
       real*4     undef_32         ! value for undefined values in the data  
650    
651  C--------- Read file -----------------------------------------------  C--------- Read file -----------------------------------------------
652    
653        read(iunit,rec=nrec,err=500) cname, cdscrip,        read(iunit,rec=nrec,err=500) cname, cdscrip,
654       .                     im_32, jm_32, lat0_32, lon0_32,       .     im_32, jm_32, npx_32, npy_32, lat0_32, lon0_32,
655       .                     ndatebc_32, undef_32,       .     ndatebc_32, undef_32,
656       .                    (nymdbc_32(i), nhmsbc_32(i), i=1,ndatebc_32)       .     (nymdbc_32(i), nhmsbc_32(i), i=1,ndatebc_32)
657    #ifdef _BYTESWAPIO
658        im    =    im_32        call MDS_BYTESWAPR4( 1, lat0_32)
659        jm    =    jm_32        call MDS_BYTESWAPR4( 1, lon0_32)
660        lat0  =  lat0_32        call MDS_BYTESWAPR4( 1, undef_32)
661        lon0  =  lon0_32  #endif
662    
663          im = im_32
664          jm = jm_32
665          npx = npx_32
666          npy = npy_32
667          lat0 = lat0_32
668          lon0 = lon0_32
669        undef = undef_32        undef = undef_32
670    
671        ndatebc = ndatebc_32        ndatebc = ndatebc_32
Legend:
Removed from v.1.3  
changed lines
  Added in v.1.12
  ViewVC Help
Powered by ViewVC 1.1.22