atmdrvmod.f90

CCSM Research Tools: Community Atmosphere Model (CAM)

                clm(k)%forc_rain = 0.
                clm(k)%forc_snow = forc_precc(k)+forc_precl(k)
             endif
          else
             clm(k)%itypprc   = 0
             clm(k)%forc_rain = 0.
             clm(k)%forc_snow = 0
          endif

! Derive new fields (potential temperature, vapor pressure, 
! air density, CO2, and O2) and copy solar radiations

          clm(k)%forc_th  = clm(k)%forc_t * (clm(k)%forc_psrf/clm(k)%forc_pbot)**(rair/cpair)
          clm(k)%forc_vp  = clm(k)%forc_q*clm(k)%forc_pbot / (0.622+0.378*clm(k)%forc_q)
          clm(k)%forc_rho = (clm(k)%forc_pbot-0.378*clm(k)%forc_vp) / (rair*clm(k)%forc_t)
          clm(k)%forc_co2 = pco2*clm(k)%forc_pbot
          clm(k)%forc_o2  = po2*clm(k)%forc_pbot
          clm(k)%forc_solad(1) = forc_sols(k)     
          clm(k)%forc_solad(2) = forc_soll(k)    
          clm(k)%forc_solai(1) = forc_solsd(k)      
          clm(k)%forc_solai(2) = forc_solld(k)     

       end do
!$OMP END PARALLEL DO

    end if

! Reset open_data 

    if (open_data) then
       open_data = .false.    !reset to false 
    elseif (kda == 1 .and. mcsec == 0) then
       open_data = .true.     !for next time step
    endif

    return
  end subroutine atmdrv

!=======================================================================

  subroutine atm_getgrid()

!----------------------------------------------------------------------- 
! 
! Purpose: 
! Obtain atmospheric grid data
!
! Method: 
! Read offline grid data and allocate dynamic memory
! 
! Author: Mariana Vertenstein
! 
!-----------------------------------------------------------------------

    use precision
    use infnan
    use clm_varder
    use clm_varpar  , only : lsmlon, lsmlat
    use clm_varctl  , only : offline_atmdir
    use clm_varcon  , only : rair, cpair, po2, pco2
    use clm_varmap  , only : begpatch, endpatch
    use clm_varsur  , only : numlon, longxy, latixy, lsmedge
    use fileutils   , only : getfil
    use time_manager, only : get_curr_date
#if (defined SPMD)
    use mpishorthand, only : mpiint, mpir8, mpicom
#endif
    implicit none
    include 'netcdf.inc'

! ------------------------ local variables ---------------------------
    integer :: kda                !day (1 -> 31)
    integer :: kmo                !month (1 -> 12)
    integer :: kyr                !year (0 -> ...)
    integer :: ksec               !current seconds of current date (0 -> 86400)
    integer :: mcsec              !current time of day [seconds]
    character(len=  7) :: ext     !month-year extension, e.g., 01-0005
    character(len=256) :: filenam !full file name, atmdir + ext
    character(len=256) :: locfn   !full file name in case atmdir is in MSS
    logical :: lexist             !true => file exists, used when looking for a file
    integer :: dimid              !netCDF dimension id
    integer :: varid              !netCDF variable id
    integer :: ier                !error status
! ----------------------------------------------------------------------

    if (masterproc) then

! Build [month]-[year] extension for file name to be read
! append extension to path name to get full file name

       call get_curr_date(kyr, kmo, kda, mcsec)
       write (ext,'(i4.4,"-",i2.2)') kyr,kmo
       filenam = trim(offline_atmdir) // '/' // ext // '.nc' 
       call getfil(filenam, locfn, 1)
       inquire (file = locfn, exist = lexist)
       if (.not. lexist) then
          write(6,*) 'ATM_GETGRID error: could not find initial atm datafile' 
          call endrun
       endif
       
! Open netCDF data file and get lengths of lat,lon,time dimensions

       call wrap_open (locfn, nf_nowrite, ncid)
       
       call wrap_inq_dimid  (ncid, 'lon', dimid)
       call wrap_inq_dimlen (ncid, dimid, atmlon)
       
       call wrap_inq_dimid  (ncid, 'lat', dimid)
       call wrap_inq_dimlen (ncid, dimid, atmlat)
       
       call wrap_inq_dimid  (ncid, 'time', dimid)
       call wrap_inq_dimlen (ncid, dimid, ntim)
       if (ntim == 0) then
          write (6,*) 'ATM_GETGRID error: zero input time slices'
          call endrun
       end if
       
    endif  !end of if-masterproc block
#if (defined SPMD) 
    call mpi_bcast (atmlon, 1, mpiint, 0, mpicom, ier)
    call mpi_bcast (atmlat, 1, mpiint, 0, mpicom, ier)
#endif

! Allocate space for dynamic variables

    if (.not. allocated_data) then
       if (masterproc) write(6,*)' ATM_GETRID: allocating dynamic space'
       allocate (numlon_a (atmlat))      
       allocate (latixy_a (atmlon,atmlat))    
       allocate (longxy_a (atmlon,atmlat))    
       allocate (forc_txy_a (atmlon,atmlat))   
       allocate (forc_uxy_a (atmlon,atmlat))   
       allocate (forc_vxy_a (atmlon,atmlat))   
       allocate (forc_qxy_a (atmlon,atmlat))   
       allocate (zgcmxy_a (atmlon,atmlat))   
       allocate (prcxy_a  (atmlon,atmlat))   
       allocate (prlxy_a  (atmlon,atmlat))   
       allocate (flwdsxy_a(atmlon,atmlat))   
       allocate (forc_solsxy_a (atmlon,atmlat))   
       allocate (forc_sollxy_a (atmlon,atmlat))   
       allocate (forc_solsdxy_a(atmlon,atmlat))   
       allocate (forc_solldxy_a(atmlon,atmlat))   
       allocate (forc_pbotxy_a (atmlon,atmlat))   
       allocate (forc_psrfxy_a (atmlon,atmlat))   
       allocate (x        (atmlon,atmlat,14))
       allocated_data = .true.
    endif

! Extract atmospheric data grid information and close file

    if (masterproc) then
       
       call wrap_inq_varid(ncid, 'EDGEN', varid)
       call wrap_get_var_realx(ncid, varid, edge_a(1))
       
       call wrap_inq_varid(ncid, 'EDGEE', varid)
       call wrap_get_var_realx(ncid, varid, edge_a(2))
       
       call wrap_inq_varid(ncid, 'EDGES', varid)
       call wrap_get_var_realx(ncid, varid, edge_a(3))
       
       call wrap_inq_varid(ncid, 'EDGEW', varid)
       call wrap_get_var_realx(ncid, varid, edge_a(4))
       
       call wrap_inq_varid(ncid, 'LONGXY', varid)
       call wrap_get_var_realx(ncid, varid, longxy_a)
       
       call wrap_inq_varid(ncid,'LATIXY', varid)
       call wrap_get_var_realx(ncid, varid, latixy_a)
       
       call wrap_close (ncid)
       write (6,*) 'ATM_GETGRID: closing data for ',trim(locfn)
       
    endif !end of if-masterproc block
#if (defined SPMD) 
    call mpi_bcast (edge_a  , size(edge_a)  , mpir8 , 0, mpicom, ier)
    call mpi_bcast (longxy_a, size(longxy_a), mpir8 , 0, mpicom, ier)
    call mpi_bcast (latixy_a, size(latixy_a), mpir8 , 0, mpicom, ier)
#endif

    return
  end subroutine atm_getgrid

!=======================================================================

  subroutine atm_openfile (kda, kmo, kyr, locfn, itim, atmmin)

!----------------------------------------------------------------------- 
! 
! Purpose: 
! open atmospheric forcing netCDF file
!
! Method: 
! 
! Author: Mariana Vertenstein
! 
!-----------------------------------------------------------------------

    use precision
    use clm_varctl, only : offline_atmdir
    use fileutils , only : getfil 
#if (defined SPMD)
    use mpishorthand, only : mpiint, mpicom
#endif
    implicit none
    include 'netcdf.inc' 

! ------------------------ arguments ---------------------------------
    integer, intent(in)  :: kda             !day (1 -> 31)
    integer, intent(in)  :: kmo             !month (1 -> 12)
    integer, intent(in)  :: kyr             !year (0 -> ...)
    character(len=*), intent(inout) :: locfn  !history file to open and read
    integer, intent(out) :: itim            !time index used in atm_readdata
    integer, intent(out) :: atmmin          !temporal resolution of atm data (in minutes)
! -----------------------------------------------------------------

! ------------------------ local variables ---------------------------
    integer :: i,j,k,n                !do loop indices
    integer :: dimid                  !netCDF dimension id
    integer :: status                 !netCDF error status
    integer :: cyc                    !current cycle
    integer :: nyr                    !year extension to data file name, e.g., 05
    integer :: pyr = 0                !complete years of data since basedate
    integer :: nmo = 0                !number of months past basedate
    integer :: mmo = -1               !number of months past end of data 
    integer :: ier                    !error status
    character(len=256) :: filenam     !full file name, atmdir + ext
    character(len=256) :: locfnlast   !full file name saved from last call
    character(len=  7) :: ext         !month-year extension, e.g., 01-0005
    logical :: lexist                 !true => file exists, used when looking for a file
    integer :: ndaypm(12) =      &    !number of days per month
    	     (/ 31,28,31,30,31,30,31,31,30,31,30,31 /)              
    integer :: minpday = 1440         !minutes per day
! -----------------------------------------------------------------

    if (masterproc) then

! Build [month]-[year] extension for file name to be read
! append extension to path name to get full file name
! first save old locfn, then obtain the file if it exists, and
! finally check if file to be opened exists (e.g. if are at the
! end of the set of files to be cycled, then the next file will
! not exists and will have to go back to beginning of data set

       write (ext,'(i4.4,"-",i2.2)') kyr,kmo
       filenam = trim(offline_atmdir) //'/'// ext // '.nc' 
       locfnlast = locfn
       call getfil(filenam, locfn, 1)
       inquire (file = locfn, exist = lexist)

! If file exists...
!   makes sure that if run was restarted within the same month
!   that the original 'initial' run was started, then nmo will 
!   not count that month twice
! If file doesn't exist...
!   go to to beginning of data set (by repeating the process of 
!   creating extension, appending to path name and looking for 
!   the file

       if (lexist) then
          if (locfn /= locfnlast) nmo = nmo + 1 !months past base date
          pyr = nmo / 12      !years past base date 
       elseif (nmo == 0) then
          write(6,*) 'ATM_OPENFILE error: could not find initial atm datafile' 
          call endrun
       else
          mmo = mmo + 1       !(months-1) past end of data
          cyc = mmo / (pyr*12) !cycles since end of data
          nyr = kyr - pyr * (cyc + 1) !rewind to beginning of dataset
          write (ext,'(i4.4,"-",i2.2)') kyr,kmo
          filenam = trim(offline_atmdir) //'/'// ext // '.nc' 
          call getfil(filenam, locfn, 1)
          inquire (file = locfn, exist = lexist)
          if (.not. lexist) then
             if (nmo < 12) then
                write(6,*) 'ATM_OPENFILE error: You must supply at least a'
                write(6,*) 'year of input data if you wish to'
                write(6,*) 'cycle through it more than once'
             else
                write(6,*) 'ATM_OPENFILE error: Not finding ',locfn
             end if
             call endrun
          end if
       end if

! Open netCDF data file and get lengths of lat,lon,time dimensions
! Do this only at the first timestep of the run or of the month

       call wrap_open (locfn, nf_nowrite, ncid)

       call wrap_inq_dimid  (ncid, 'lon', dimid)
       call wrap_inq_dimlen (ncid, dimid, nlon)

       call wrap_inq_dimid  (ncid, 'lat', dimid)
       call wrap_inq_dimlen (ncid, dimid, nlat)

       call wrap_inq_dimid  (ncid, 'time', dimid)
       call wrap_inq_dimlen (ncid, dimid, ntim)

       if (ntim == 0) then
          write (6,*) 'ATM_OPENFILE error: zero input time slices'
          call endrun
       end if
       if (nlon /= atmlon) then
          write (6,*) 'ATM_OPENFILE error: nlon = ',nlon, &
               ' in data file not equal to atmlon = ',atmlon,' first read in'
          call endrun
       end if
       if (nlat /= atmlat) then
          write (6,*) 'ATM_READDATA error: nlat = ',nlat, &
               ' in data file not equal to atmlat = ',atmlat,' first read in'
          call endrun