/[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.4 by molod, Tue Jun 8 22:26:08 2004 UTC revision 1.5 by molod, Wed Jun 9 16:23:43 2004 UTC
# Line 119  C--------------------------------------- Line 119  C---------------------------------------
119    
120        _RL sice(idim1:idim2,jdim1:jdim2,nSx,nSy)        _RL sice(idim1:idim2,jdim1:jdim2,nSx,nSy)
121    
 c MPI Utilities  
 c -------------  
       include 'mpif.h'  
       integer  ierror  
   
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
124        parameter (ndmax = 370)        parameter (ndmax = 370)
# Line 132  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        real fac1, fac2, lat0, lon0, timebc1, timebc2, timemod, undef        real 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,ndatebc        integer i,j,n,nn,iyear,iyearbc,nd,ndby3,imbc,jmbc,npxbc,npybd
131        integer 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    
 C Define Allocatable Arrays  
134        real sicebc1(im2,jm2,nPx,nPy),sicebc2(im2,jm2,nPx,nPy)        real sicebc1(im2,jm2,nPx,nPy),sicebc2(im2,jm2,nPx,nPy)
135    
136  C--------- Variable Initialization ---------------------------------  C--------- Variable Initialization ---------------------------------
# Line 145  C--------- Variable Initialization ----- Line 139  C--------- Variable Initialization -----
139        data error /.false./        data error /.false./
140    
141  c  save header info  c  save header info
142        save imbc, jmbc, lat0, lon0, ndatebc, undef, nymdbc, nhmsbc        save imbc,jmbc,npxbc,npybc,lat0,lon0,ndatebc,undef,nymdbc,nhmsbc
143        save nymdbc1, nymdbc2, nhmsbc1, nhmsbc2        save nymdbc1, nymdbc2, nhmsbc1, nhmsbc2
144        save first        save first
145        save sicebc1, sicebc2        save sicebc1, sicebc2
# Line 179  C---------- Read in Header file -------- Line 173  C---------- Read in Header file --------
173    
174        if( iyear.ne.iyearbc ) then        if( iyear.ne.iyearbc ) then
175    
176          close(iunit)         close(iunit)
177          open (iunit, form='unformatted', access='direct',recl=im2*jm2*4)         open (iunit,form='unformatted',access='direct',
178          nrec = 1       .                                          recl=im2*jm2*nPx*nPy*4)
179          call bcheader (iunit, ndmax, nrec,         nrec = 1
180       .                 cname, cdscrip, imbc, jmbc, lat0, lon0,         call bcheader (iunit, ndmax, nrec,
181       .                 ndatebc, nymdbc, nhmsbc, undef, error)       .          cname, cdscrip, imbc, jmbc, npxbc, npybc, lat0, lon0,
182         .          ndatebc, nymdbc, nhmsbc, undef, error)
183    
184  C--------- Check data for Compatibility ------------------------------  C--------- Check data for Compatibility ------------------------------
185    
# Line 195  C Check for correct data in boundary con Line 190  C Check for correct data in boundary con
190         endif         endif
191    
192  C Check Horizontal Resolution  C Check Horizontal Resolution
193         if (.not.error .and. imbc*jmbc.ne.im2*jm2) then         if(.not.error .and. imbc*jmbc*npxbc*npybc.ne.im2*jm2*npx*npy)then
194          write(6,*) ' B.C. Resolution DOES NOT match Model Resolution!'          write(6,*) ' B.C. Resolution DOES NOT match Model Resolution!'
195          write(6,*) ' B.C. Resolution:  ',imbc*jmbc          write(6,*) ' B.C. Resolution:  ',imbc*jmbc*npxbc*npybc
196          write(6,*) 'Model Resolution:  ',im2*jm2          write(6,*) 'Model Resolution:  ',im2*jm2*npx*npy
197          error = .true.          error = .true.
198         endif         endif
199    
200  C Check Year  C Check Year
201         iyearbc = nymdbc(2)/10000         iyearbc = nymdbc(2)/10000
202         if (.not.error .and. iyear.ne.iyearbc .and. iyearbc.ne.0) then         if (.not.error .and. iyear.ne.iyearbc .and. iyearbc.ne.0) then
203          write(6,*) '     B.C. Year DOES NOT match REQUESTED Year!'          write(6,*)'     B.C. Year DOES NOT match REQUESTED Year!'
204          write(6,*) '     B.C. Year:  ', iyearbc          write(6,*)'     B.C. Year:  ', iyearbc
205          write(6,*) 'Requested Year:  ', iyear          write(6,*)'Requested Year:  ', iyear
206          error = .true.          error = .true.
207         endif         endif
208    
# Line 264  c  from previous call to getsice then re Line 259  c  from previous call to getsice then re
259         do while (.not.found .and. nd .le. ndatebc)         do while (.not.found .and. nd .le. ndatebc)
260          timebc2 = float(nymdbc(nd)) + float(nhmsbc(nd))/1000000          timebc2 = float(nymdbc(nd)) + float(nhmsbc(nd))/1000000
261          if (timebc2 .gt. timemod) then            if (timebc2 .gt. timemod) then  
262            nymdbc1 = nymdbc(nd-1)           nymdbc1 = nymdbc(nd-1)
263            nymdbc2 = nymdbc(nd)           nymdbc2 = nymdbc(nd)
264            nhmsbc1 = nhmsbc(nd-1)           nhmsbc1 = nhmsbc(nd-1)
265            nhmsbc2 = nhmsbc(nd)           nhmsbc2 = nhmsbc(nd)
266            call bcdata (iunit, imbc, jmbc, nd, nd+1, sicebc1, sicebc2)           call bcdata (iunit,imbc,jmbc,nPx,nPy,nd,nd+1,sicebc1,sicebc2)
267            found = .true.           found = .true.
268          else          else
269            nd = nd + 1           nd = nd + 1
270          endif          endif
271         enddo         enddo
272    
# Line 319  C--------------------------------------- Line 314  C---------------------------------------
314    
315        return        return
316        end        end
317        subroutine getsst ( iunit,nymd,nhms,sst,im,jm,lattice )        subroutine getsst(iunit,idim1,idim2,jdim1,jdim2,im1,im2,jm1,jm2,
318  C************************************************************************       .            nSx,nSy,nPx,nPy,bi,bj,biglobal,bjglobal,nymd,nhms,sst)
 C!GETSST  
319  C************************************************************************  C************************************************************************
320  C  C
321  C!ROUTINE:      GETSST  C!ROUTINE:      GETSST
 C!PROGRAMMER:   Sharon Nebuda  
 C!DATE CODED:   May 8, 1996  
322  C!DESCRIPTION:  GETSST gets the SST data.  C!DESCRIPTION:  GETSST gets the SST data.
323  C!              This routine is adaptable for any frequency  C!              This routine is adaptable for any frequency
324  C!              data upto a daily frequency.    C!              data upto a daily frequency.  
325  C!              note: for diurnal data ndmax should be increased.  C!              note: for diurnal data ndmax should be increased.
326  C  C
327  C!INPUT PARAMETERS:  C!INPUT PARAMETERS:
328  C!              iunit   Unit number assigned to the sst data file  C!      iunit     Unit number assigned to the sice data file
329  C!              nymd    YYMMDD of the current model timestep  C!      idim1     Start dimension in x-direction
330  C!              nhms    HHMMSS of the model time  C!      idim2     End dimension in x-direction
331  C!            im     Number of x points  C!      jdim1     Start dimension in y-direction
332  C!            jm     Number of y points  C!      jdim2     End dimension in y-direction
333  C!       lattice     Grid Decomposition defined by Dynamics  C!      im1       Begin of x-direction span for filling sice
334    C!      im2       End of x-direction span for filling sice
335    C!      jm1       Begin of y-direction span for filling sice
336    C!      jm2       End of y-direction span for filling sice
337    C!      nSx       Number of processors in x-direction (local processor)
338    C!      nSy       Number of processors in y-direction (local processor)
339    C!      nPx       Number of processors in x-direction (global)
340    C!      nPy       Number of processors in y-direction (global)
341    C!      bi        Processor number in x-direction (local to processor)
342    C!      bj        Processor number in y-direction (local to processor)
343    C!      biglobal  Processor number in x-direction (global)
344    C!      bjglobal  Processor number in y-direction (global)
345    C!      nymd      YYMMDD of the current model timestep
346    C!      nhms      HHMMSS of the model time
347  C  C
348  C!OUTPUT PARAMETERS:  C!OUTPUT PARAMETERS:
349  C!              sst(im,jm)      Sea surface temperature in Kelvin  C!      sst(idim1:idim2,jdim1:jdim2,nSx,nSy) Sea surface temperature (K)
350  C  C
351  C!ROUTINES CALLED:  C!ROUTINES CALLED:
352  C  C
# Line 351  C!     interp_time   Returns weights for Line 356  C!     interp_time   Returns weights for
356  C  C
357  C--------------------------------------------------------------------------  C--------------------------------------------------------------------------
358    
       use dynamics_lattice_module  
359        implicit none        implicit none
360        type ( dynamics_lattice_type ) lattice  #include "CPP_OPTIONS.h"
361    
362          integer iunit,idim1,idim2,jdim1,jdim2,im1,im2,jm1,jm2,nSx,nSy
363          integer bi,bj,biglobal.bjglobal,nymd,nhms
364    
365  c MPI Utilities        _RL sst(idim1:idim2,jdim1:jdim2,nSx,nSy)
 c -------------  
       include 'mpif.h'  
       integer  ierror  
366    
367  C  Parameter statements  C Maximum number of dates in one year for the data
368        integer   ndmax   ! Maximum number of dates in one year for the data        integer   ndmax
369        parameter (ndmax = 370)        parameter (ndmax = 370)
370    
371  C  Variables passed to the routine:        character*8  cname
372        integer   iunit   ! Unit number assigned to the SST data file        character*80 cdscrip
373        integer   nymd    ! YYMMDD of the current model timestep        real fac1, fac2, lat0, lon0, timebc1, timebc2, timemod, undef
374        integer   nhms    ! HHMMSS of the model time        logical first, found, error
375        integer        im     ! Number of x points        integer i,j,n,nn,iyear,iyearbc,nd,ndby3,imbc,jmbc,npxbc,npybd
376        integer        jm     ! Number of y points        integer ndatebc,nhmsbc(ndmax), nhmsbc1, nhmsbc2,nrec
377          integer nymdbc(ndmax),nymdbc1,nymdbc2,nymdmod
378  C  Variables returned by the routine:  
379        real      sst(im,jm)      ! Sea surface temperature in Kelvin        real sstbc1(im2,jm2,nPx,nPy),sstbc2(im2,jm2,nPx,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  
380    
381  C--------- Variable Initialization ---------------------------------  C--------- Variable Initialization ---------------------------------
382    
# Line 421  C--------- Variable Initialization ----- Line 384  C--------- Variable Initialization -----
384        data error /.false./        data error /.false./
385    
386  c  save header info  c  save header info
387        save imbc, jmbc, lat0, lon0, ndatebc, undef, nymdbc, nhmsbc        save imbc,jmbc,npxbc,npybc,lat0,lon0,ndatebc,undef,nymdbc,nhmsbc
388        save nymdbc1, nymdbc2, nhmsbc1, nhmsbc2, sstbc1        save nymdbc1, nymdbc2, nhmsbc1, nhmsbc2
389        save first        save first
390          save sstbc1, sstbc2
391    
392  c  this only works for between 1950-2050  c  this only works for between 1950-2050
393        if (nymd .lt. 500101) then        if (nymd .lt. 500101) then
# Line 438  c  initialize so that first time through Line 402  c  initialize so that first time through
402  c  these vaules make the iyear .ne. iyearbc true anyways for  c  these vaules make the iyear .ne. iyearbc true anyways for
403  c  for the first time so first isnt checked below.  c  for the first time so first isnt checked below.
404        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  
405          nymdbc(2) = 0          nymdbc(2) = 0
406          nymdbc1   = 0          nymdbc1   = 0
407          nymdbc2   = 0          nymdbc2   = 0
# Line 454  C---------- Read in Header file -------- Line 416  C---------- Read in Header file --------
416        iyearbc = nymdbc(2)/10000        iyearbc = nymdbc(2)/10000
417    
418        if( iyear.ne.iyearbc ) then        if( iyear.ne.iyearbc ) then
         if( lattice%myid.eq.0 ) then    
419    
420          close(iunit)         close(iunit)
421          open (iunit, form='unformatted', access='direct',recl=lattice%imglobal*lattice%jmglobal*4)         open (iunit,form='unformatted',access='direct',
422          nrec = 1       .                                          recl=im2*jm2nPx*nPy*4)
423          call bcheader (iunit, ndmax, nrec,         nrec = 1
424       .                 cname, cdscrip, imbc, jmbc, lat0, lon0,         call bcheader (iunit, ndmax, nrec,
425       .                 ndatebc, nymdbc, nhmsbc, undef, error)       .          cname, cdscrip, imbc, jmbc, npxbc, npybc, lat0, lon0,
426         .          ndatebc, nymdbc, nhmsbc, undef, error)
427    
428  C--------- Check data for Compatibility  C--------- Check data for Compatibility
429    
430  C Check for correct data in boundary condition file  C Check for correct data in boundary condition file
431         if (.not.error .and. cname.ne.'SST') then         if (.not.error .and. cname.ne.'SST') then
432              write(6,*) 'Wrong data in SST boundary condition file => ',cname          write(6,*)'Wrong data in SST boundary condition file => ',cname
433              error = .true.          error = .true.
434         endif         endif
435    
436  C Check Horizontal Resolution  C Check Horizontal Resolution
437         if (.not.error .and. imbc*jmbc.ne.lattice%imglobal*lattice%jmglobal) then         if(.not.error .and. imbc*jmbc*npxbc*npybc.ne.im2*jm2*npx*npy)then
438              write(6,*) 'Boundary Condition Resolution DOES NOT match Model Resolution!'          write(6,*) ' B.C. Resolution DOES NOT match Model Resolution!'
439              write(6,*) 'Boundary Condition Resolution:  ',imbc*jmbc          write(6,*) ' B.C. Resolution:  ',imbc*jmbc*npxbc*npybc
440              write(6,*) '             Model Resolution:  ',lattice%imglobal*lattice%jmglobal          write(6,*) 'Model Resolution:  ',im2*jm2*npx*npy
441              error = .true.          error = .true.
442         endif         endif
443    
444  C Check Year  C Check Year
445         iyearbc = nymdbc(2)/10000         iyearbc = nymdbc(2)/10000
446         if (.not.error .and. iyear.ne.iyearbc .and. iyearbc.ne.0) then         if (.not.error .and. iyear.ne.iyearbc .and. iyearbc.ne.0) then
447              write(6,*) 'Boundary Condition Year DOES NOT match REQUESTED Year!'          write(6,*)'     B.C. Year DOES NOT match REQUESTED Year!'
448              write(6,*) 'Boundary Condition Year:  ', iyearbc          write(6,*)'     B.C. Year:  ', iyearbc
449              write(6,*) '         Requested Year:  ', iyear          write(6,*)'Requested Year:  ', iyear
450              error = .true.          error = .true.
451         endif         endif
452    
453         if (.not.error)   then         if (.not.error)   then
454  C if climatology, fill dates for data with current model year  C if climatology, fill dates for data with current model year
455              if (iyearbc.eq.0) then                        if (iyearbc.eq.0) then          
456              write(6,*)           write(6,*)
457              write(6,*) 'Climatological Dataset is being used.'             write(6,*) 'Climatological Dataset is being used.'  
458              write(6,*) 'Current model year will be used to fill Header Dates'           write(6,*) 'Current model year will be used to fill Header Dates'
459                do n = 2, ndatebc-1           do n = 2, ndatebc-1
460                 nymdbc(n) = nymdbc(n) +(nymdmod/10000)*10000            nymdbc(n) = nymdbc(n) +(nymdmod/10000)*10000
461                enddo           enddo
462  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
463                n = 1           n = 1
464                nymdbc(n) = nymdbc(n) +(nymdmod/10000-1)*10000           nymdbc(n) = nymdbc(n) +(nymdmod/10000-1)*10000
465  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
466                n = ndatebc           n = ndatebc
467                nymdbc(n) = nymdbc(n) +(nymdmod/10000+1)*10000           nymdbc(n) = nymdbc(n) +(nymdmod/10000+1)*10000
468              endif          endif
469    
470  C  Write out header info  C  Write out header info
471         write(6,*) ' Updated boundary condition data'          write(6,*) ' Updated boundary condition data'
472         write(6,*) ' ---------------------------------'          write(6,*) ' ---------------------------------'
473         write(6,*) ' Variable: ',cname          write(6,*) ' Variable: ',cname
474         write(6,*) ' Description: ',cdscrip          write(6,*) ' Description: ',cdscrip
475         write(6,*) ' Resolution: x= ',imbc,' y= ',jmbc,' Undefined value = ',undef          write(6,*) ' Resolution: x= ',imbc,' y= ',jmbc,
476         write(6,*) ' Starting latitude = ',lat0,' longitude =',lon0       .                                       ' Undefined value = ',undef
477         write(6,*) ' Data valid at these times: '          write(6,*) ' Starting latitude = ',lat0,' longitude =',lon0
478         ndby3 = ndatebc/3          write(6,*) ' Data valid at these times: '
479         do n = 1, ndby3*3,3          ndby3 = ndatebc/3
480          write(6,1000) (nn,nymdbc(nn),nhmsbc(nn),nn=n,n+2)          do n = 1, ndby3*3,3
481   1000   format(3(2x,i3,':',i8,2x,i8))           write(6,1000) (nn,nymdbc(nn),nhmsbc(nn),nn=n,n+2)
482         enddo   1000    format(3(2x,i3,':',i8,2x,i8))
483         write(6,1000) (nn,nymdbc(nn),nhmsbc(nn),nn=ndby3*3+1,ndatebc)          enddo
484        endif  ! End error  Check          write(6,1000) (nn,nymdbc(nn),nhmsbc(nn),nn=ndby3*3+1,ndatebc)
485           endif  ! End error  Check
       endif  ! End MYID=0 Check  
486    
 c Broadcast information to other PEs  
 c ----------------------------------  
 #if (mpi)  
        call mpi_bcast ( error,1,mpi_logical,0,lattice%comm,ierror )  
 #endif  
487         if( error ) call my_exit (101)         if( error ) call my_exit (101)
488    
 #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  
   
489        endif  ! New Year Info Check        endif  ! New Year Info Check
490    
491  C---------- Read SST data if necessary -------------------------------  C---------- Read SST data if necessary -------------------------------
492    
493          found = .false.        found = .false.
494          nd = 2        nd = 2
495    
496  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
497  c  from previous call to getsst then read new data  c  from previous call to getsst then read new data
498    
499          timemod = float(nymdmod) + float(nhms)   /1000000        timemod = float(nymdmod) + float(nhms)   /1000000
500          timebc1 = float(nymdbc1) + float(nhmsbc1)/1000000        timebc1 = float(nymdbc1) + float(nhmsbc1)/1000000
501          timebc2 = float(nymdbc2) + float(nhmsbc2)/1000000        timebc2 = float(nymdbc2) + float(nhmsbc2)/1000000
502          if (timemod .lt. timebc1 .or. timemod .ge. timebc2) then        if (timemod .lt. timebc1 .or. timemod .ge. timebc2) then
503    
504          do while (.not.found .and. nd .le. ndatebc)         do while (.not.found .and. nd .le. ndatebc)
505            timebc2 = float(nymdbc(nd)) + float(nhmsbc(nd))/1000000          timebc2 = float(nymdbc(nd)) + float(nhmsbc(nd))/1000000
506            if (timebc2 .gt. timemod) then                  if (timebc2 .gt. timemod) then  
507              nymdbc1 = nymdbc(nd-1)           nymdbc1 = nymdbc(nd-1)
508              nymdbc2 = nymdbc(nd)           nymdbc2 = nymdbc(nd)
509              nhmsbc1 = nhmsbc(nd-1)           nhmsbc1 = nhmsbc(nd-1)
510              nhmsbc2 = nhmsbc(nd)           nhmsbc2 = nhmsbc(nd)
511              if ( lattice%myid.eq.0 ) call bcdata (iunit, imbc, jmbc, nd, nd+1, sstbc1, sstbc2)           call bcdata (iunit,imbc,jmbc,nPx,nPy,nd,nd+1,sstbc1,sstbc2)
512  #if (mpi)           found = .true.
513              call mpi_bcast ( sstbc1,lattice%imglobal*lattice%jmglobal,mpi_double_precision,0,lattice%comm,ierror )          else
514              call mpi_bcast ( sstbc2,lattice%imglobal*lattice%jmglobal,mpi_double_precision,0,lattice%comm,ierror )           nd = nd + 1
515  #endif          endif
516              found = .true.         enddo
           else  
             nd = nd + 1  
           endif  
         enddo  
517    
518  c  Otherwise the data from the last time in getsst surrounds the  c  Otherwise the data from the last time in getsst surrounds the
519  c  current model time.  c  current model time.
520    
521          else        else
522            found = .true.         found = .true.
523          endif        endif
524    
525          if (.not.found) then        if (.not.found) then
526            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.'
527            call my_finalize         call my_finalize
528            call my_exit (101)         call my_exit (101)
529          endif        endif
530    
531  C---------- Interpolate SST data ------------------------------------  C---------- Interpolate SST data ------------------------------------
532    
533            call interp_time ( nymdmod,nhms, nymdbc1,nhmsbc1, nymdbc2,nhmsbc2, fac1,fac2 )        call interp_time(nymdmod,nhms,nymdbc1,nhmsbc1,nymdbc2,nhmsbc2,
534         .                                                        fac1,fac2)
535    
536            do j = 1, jm        do j = jm1,jm2
537            do i = 1, im        do i = im1,im2
538              sst(i,j) = sstbc1( lattice%iglobal(i),lattice%jglobal(j) )*fac1         sst(i,j,bi,bj) = sstbc1(i,j,biglobal,bjglobal)*fac1
539       .               + sstbc2( lattice%iglobal(i),lattice%jglobal(j) )*fac2       .                + sstbc2(i,j,biglobal,bjglobal)*fac2
540            enddo        enddo
541            enddo        enddo
542    
543        return        return
544        end        end
545    
546        subroutine bcdata (iunit, im, jm, nrec1, nrec2, field1, field2)        subroutine bcdata (iunit,im,jm,nPx,nPy,nrec1,nrec2,field1,field2)
 C************************************************************************  
 C!BCDATA  
547  C************************************************************************  C************************************************************************
548  C  C
549  C!ROUTINE:      BCDATA  C!ROUTINE:      BCDATA
550  C!PROGRAMMER:   Sharon Nebuda  C!DESCRIPTION:  BCDATA reads the data from the file assigned to the
551  C!DATE CODED:   April 29, 1996  C!              passed unit number and returns data from the two times
552  C!DESCRIPTION:  BCDATA reads the data from the file assigned to the  C!              surrounding the current model time.  The two record
553  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.  
554  C  C
555  C!INPUT PARAMETERS:  C!INPUT PARAMETERS:
556  C!      im      number of x points  C!      im      number of x points
557  C!      jm      number of y points  C!      im      number of x points
558  C!      nrec1   record number of the time before the model time  C!      nPx     number of faces in x-direction
559  C!      nrec2   record number of the time after the model time  C!      nPy     number of faces in y-direction
560    C!      nrec1   record number of the time before the model time
561    C!      nrec2   record number of the time after the model time
562  C  C
563  C!OUTPUT PARAMETERS:  C!OUTPUT PARAMETERS:
564  C!      field1(im,jm)   data field before the model time  C!      field1(im,jm,nPx,nPy)  data field before the model time
565  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  
566  C  C
567  C--------------------------------------------------------------------------  C--------------------------------------------------------------------------
568          implicit none
569    
570          integer iunit,im,jm,nPx,nPy,nrec1,nrec2
571    
572  C--------------- Variable Declaration -------------------------------------        real  field1(im,jm)
573        implicit none        real  field2(im,jm)
574    
575  C  Variables passed to the routine:        integer i,j,n1,n2
576        integer   iunit   ! Unit number assigned to the data file        real*4 f1(im,jm,nPx,nPy), f1(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  
577    
578  C--------- Read file -----------------------------------------------  C--------- Read file -----------------------------------------------
   
579        read(iunit,rec=nrec1) f1        read(iunit,rec=nrec1) f1
580        read(iunit,rec=nrec2) f2        read(iunit,rec=nrec2) f2
581    
582          do n2=1,nPy
583          do n1=1,nPx
584        do j=1,jm        do j=1,jm
585        do i=1,im        do i=1,im
586        field1(i,j) = f1(i,j)         field1(i,j,n1,n2) = f1(i,j,n1,n2)
587        field2(i,j) = f2(i,j)         field2(i,j,n1,n2) = f2(i,j,n1,n2)
588          enddo
589          enddo
590        enddo        enddo
591        enddo        enddo
592    
593        return        return
594        end        end
595        subroutine bcheader (iunit, ndmax, nrec,        subroutine bcheader (iunit, ndmax, nrec,
596       .                     cname, cdscrip, im, jm, lat0, lon0, ndatebc,       .           cname, cdscrip, im, jm, npx, npy, lat0, lon0, ndatebc,
597       .                     nymdbc, nhmsbc, undef, error)       .           nymdbc, nhmsbc, undef, error)
 C************************************************************************  
 C!BCHEADER  
598  C************************************************************************  C************************************************************************
599  C  C
600  C!ROUTINE:      BCHEADER  C!ROUTINE:     BCHEADER
601  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.    
602  C  C
603  C!INPUT PARAMETERS:  C!INPUT PARAMETERS:
604  C!      iunit   unit number assigned to the data file  C!      iunit    unit number assigned to the data file
605  C!      ndmax   maximum number of date/times of the data  C!      ndmax    maximum number of date/times of the data
606  C!      nrec    record number of the header info (or assume 1??)  C!      nrec     record number of the header info (or assume 1??)
607  C  C
608  C!OUTPUT PARAMETERS:  C!OUTPUT PARAMETERS:
609  C!      cname           name of the data in the file header  C!      cname         name of the data in the file header
610  C!      cdscrip         description of the data in the file header  C!      cdscrip       description of the data in the file header
611  C!      im              number of x points  C!      im            number of x points
612  C!      jm              number of y points  C!      jm            number of y points
613  C!      lat0            starting latitude for the data grid  C!      npx           number of faces (processors) in x-direction
614  C!      lon0            starting longitude for the data grid  C!      npy           number of faces (processors) in x-direction
615  C!      ndatebc         number of date/times of the data in the file  C!      lat0          starting latitude for the data grid
616  C!      nymdbc(ndmax)   array of dates for the data including century  C!      lon0          starting longitude for the data grid
617  C!      nhmsbc(ndmax)   array of times for the data  C!      ndatebc       number of date/times of the data in the file
618  C!      undef           value for undefined values in the data  C!      nymdbc(ndmax) array of dates for the data including century
619  C!      error           logical TRUE if dataset problem  C!      nhmsbc(ndmax) array of times for the data
620  C  C!      undef         value for undefined values in the data
621  C!REVISION HISTORY:      C!      error         logical TRUE if dataset problem
 C!      NEW  
 C  
 C!ROUTINES CALLED:  
 C!      none  
622  C  C
623  C--------------------------------------------------------------------------  C--------------------------------------------------------------------------
   
 C--------------- Variable Declaration -------------------------------------  
624        implicit none        implicit none
625    
626  C  Variables passed to the routine:        integer iunit, ndmax, nrec
627        integer   iunit   ! Unit number assigned to the data file  
628        integer   ndmax   ! Maximum number of dates for a given field        character*8  cname
629        integer   nrec    ! Record number of the header info (or assume 1??)        character*80 cdscrip
630          integer im,jm,npx,npy,ndatebc,nymdbc(ndmax),nhmsbc(ndmax)
631  C  Variables returned by the routine:        real lat0,lon0,undef
632        character*8  cname        ! Name of the data in the file header        logical error
633        character*80 cdscrip      ! Description of the data in the file header  
634        integer   im     ! Number of x points        integer i,n
635        integer   jm     ! Number of y points        integer*4 im_32,jm_32,npx_32,npy_32
636        real         lat0     ! Starting latitude of the data        integer*4 ndatebc_32(ndmax),nhmsbc_32(ndmax)
637        real           lon0     ! Starting longitude of the data        real*4 lat0_32,lon0_32,undef_32
       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  
638    
639  C--------- Read file -----------------------------------------------  C--------- Read file -----------------------------------------------
640    
641        read(iunit,rec=nrec,err=500) cname, cdscrip,        read(iunit,rec=nrec,err=500) cname, cdscrip,
642       .                     im_32, jm_32, lat0_32, lon0_32,       .     im_32, jm_32, npx_32, npy_32, lat0_32, lon0_32,
643       .                     ndatebc_32, undef_32,       .     ndatebc_32, undef_32,
644       .                    (nymdbc_32(i), nhmsbc_32(i), i=1,ndatebc_32)       .     (nymdbc_32(i), nhmsbc_32(i), i=1,ndatebc_32)
645    
646        im    =    im_32        im = im_32
647        jm    =    jm_32        jm = jm_32
648        lat0  =  lat0_32        npx = npx_32
649        lon0  =  lon0_32        npy = npy_32
650          lat0 = lat0_32
651          lon0 = lon0_32
652        undef = undef_32        undef = undef_32
653    
654        ndatebc = ndatebc_32        ndatebc = ndatebc_32
Legend:
Removed from v.1.4  
changed lines
  Added in v.1.5
  ViewVC Help
Powered by ViewVC 1.1.22