initext.f90

CCSM Research Tools: Community Atmosphere Model (CAM)

#include <misc.h>
#include <params.h>

subroutine initext
!----------------------------------------------------------------------- 
! 
! Purpose: Initialize external models and/or boundary dataset information
! 
! Method: 
! 
! Author: CCM Core Group
! 
!-----------------------------------------------------------------------
   use precision
   use pmgrid
   use ppgrid, only: begchunk, endchunk
   use phys_grid, only: get_ncols_p, get_rlat_all_p, get_rlon_all_p,get_lat_all_p, get_lon_all_p
   use pspect
   use comsrf
   use rgrid
   use shr_orb_mod
   use ioFileMod
   use so4bnd
   use commap
#if ( ! defined COUP_CSM )
   use ice_constants, only: Tffresh
#endif
   use filenames, only: bndtvo, bndtvs
   use physconst, only: stebol
   use time_manager, only: is_first_step, get_curr_calday, get_curr_date, &
                           is_perpetual, get_perp_date
#if ( defined SPMD )
   use mpishorthand
#endif

#if (defined COUP_CSM)
   use ccsm_msg, only: ccsmini
#else
   use atm_lndMod, only: atmlnd_ini
#if ( ! defined COUP_SOM )
   use sst_data, only: sstini, sstint, sstan, sst
   use ice_data, only: iceini, iceint
   use atm_lndMod
#endif
#endif
!-----------------------------------------------------------------------
   implicit none
!-----------------------------------------------------------------------
#include <comlun.h>
!-----------------------------------------------------------------------
#include <comctl.h>
!-----------------------------------------------------------------------
#include <comsol.h>
!-----------------------------------------------------------------------
   include 'netcdf.inc'
!--------------------------Local Variables------------------------------
!
#if (!defined COUP_CSM)
   integer  :: i,c        ! indices
   integer  :: ncol               ! number of columns in current chunk
   real(r8) :: coszrs(pcols)      ! Cosine solar zenith angle
   real(r8) :: clat1(pcols)       ! Current latitude(radians)
   real(r8) :: clon1(pcols)       ! Current longitude(radians)
   integer  :: sghid              ! NetCDF sgh field id 
   logical  :: oro_hires          ! true => ORO came from high res topo file
   logical  :: log_print          ! Flag to print out log information or not
   integer  :: ret                ! NetCDF returned status 
   integer  :: attlen             ! NetCDF attribute length
   character(len=256) :: text     ! NetCDF attribute
#endif
   character(len=256) :: locfn    ! netcdf local filename to open 
   character*4 ncnam(5)
   integer  :: yr, mon, day, tod  ! components of a date
   real(r8) :: calday             ! current calendar day
   integer  :: lchnk
   integer  :: lats(pcols)
   integer  :: lons(pcols)
!
!-----------------------------------------------------------------------

   calday = get_curr_calday()
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
! Obtain datasets
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
! Obtain time-variant ozone and sst datatsets and do initial read of
! ozone dataset
!
   if (.not. ideal_phys) then
      if (masterproc) then
         call getfil (bndtvo, locfn)
         call wrap_open (locfn, 0, ncid_oz)
         write(6,*)'INITEXT: NCOPN returns id ',ncid_oz,' for file ',trim(locfn)
      endif
#if ( ! defined COUP_CSM )
      if (.not. aqua_planet) then
         if (masterproc) then
            call getfil(bndtvs, locfn)
            call wrap_open(locfn, 0, ncid_sst)
            write(6,*)'INITEXT: NCOPN returns id ',ncid_sst,' for file ',trim(locfn)
         endif
      endif
#endif
      call oznini
   endif
!
! Obtain sulfate aerosol datasets
!
   if ( doRamp_so4 ) then
      call sulfini
   end if

!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
! Preprocessing if -- If NOT coupled to the Climate System Model (CSM)
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
#if ( ! defined COUP_CSM )
!
! Determine if SGH field came from hi-res dataset
!
   if (is_first_step()) then
      if (masterproc) then
         call wrap_inq_varid (ncid_ini, 'SGH', sghid)
         ret = nf_inq_attlen (ncid_ini, sghid, 'from_hires', attlen)
         if (ret == nf_noerr .and. attlen > 256) then
            write(6,*)'INITEXT: Att length of from_hires is too long'
            call endrun
         end if
         ret = nf_get_att_text (ncid_ini, sghid, 'from_hires', text)
         if (ret == nf_noerr .and. text(1:4) == 'true')then
            oro_hires = .true.
            write(6,*)'INITEXT: attribute from_hires is true.'
            write(6,*)'         Will use tssub values to guess sea ice'
         else
            oro_hires = .false.
            write(6,*)'INITEXT: attribute from_hires is either false or not present.'
            write(6,*)'         Where sea ice exists, its initial temperature will be just below freezing'
         end if
      end if
#if ( defined SPMD )
      call mpibcast (oro_hires, 1, mpilog, 0, mpicom)
#endif
   end if
!
! Setup the characteristics of the orbit
! (Based on the namelist parameters)
!
   if (masterproc) then
      log_print = .true.
   else
      log_print = .false.
   end if
   call shr_orb_params (iyear_AD, eccen , obliq , mvelp, obliqr, &
                        lambm0, mvelpp, log_print)

!
! Initialize land model. This involves initializing land 
! albedos, surface temperature, lwup and snowh.  NOTE: On restart, 
! lwup, ts, albedos and snowh, come from the atm restart data.  
!
   if (is_first_step()) then
      call srfflx_state_reset(srfflx_state2d)
   end if
   if (.not. adiabatic .and. .not. ideal_phys .and. .not. aqua_planet) then
      call atmlnd_ini(srfflx_parm2d)
   endif
   call update_srf_fluxes(srfflx_state2d,srfflx_parm2d,landfrac)

#if ( defined COUP_SOM )
!
! Slab ocean model: set initial surf temps for initial run. Read in 2 time slices of
! mixed layer depths and q fluxes from boundary dataset whether initial or restart
!
   call somini (oro_hires)

#else
!
! Data ocean model: Initialize ocean/sea-ice surface datasets and determine initial sea surface 
! temperature 
! 
   if (.not. adiabatic .and. .not. ideal_phys) then
      call sstini
      call iceini
      call sstint
      call iceint
   else
      icefrac(:pcols,begchunk:endchunk) = 0.0
      call update_srf_fractions ( )
   end if
!
! Initialize surface and sub-surface temperatures, set new 
! new sea ice concentrations and compute longwave up over non-land
!
   if (is_first_step()) then
      do lchnk=begchunk,endchunk
         if (.not. adiabatic .and. .not. ideal_phys) then
         ncol = get_ncols_p(lchnk)
         do i=1,ncol
            srfflx_state2d(lchnk)%ts(i) = &
                 landfrac(i,lchnk)*srfflx_state2d(lchnk)%ts(i) + &
                 icefrac(i,lchnk)*tsice(i,lchnk) + &
                 ocnfrac(i,lchnk)*(sst(i,lchnk)+Tffresh)
            if (landfrac(i,lchnk).ne.1.) then
	            srfflx_state2d(lchnk)%lwup(i) = &
                         stebol*(srfflx_state2d(lchnk)%ts(i)**4)
            end if
         end do
         end if
      end do
   end if
#endif
!
! Initialize non-land albedos at NSTEP = 0.  At NSTEP = 1 and 
! beyond, albedos will be computed for the *next* timestep to 
! accomodate coupling with a single interface.
!
   if (is_first_step()) then
      do c = begchunk,endchunk
         ncol = get_ncols_p(c)
         call get_rlat_all_p(c, ncol, clat1)
         call get_rlon_all_p(c, ncol, clon1)
         call zenith (calday, clat1, clon1, coszrs, ncol)
         call albocean (c, ncol, coszrs, &
                        srfflx_parm2d(c)%asdir, srfflx_parm2d(c)%aldir, &
                        srfflx_parm2d(c)%asdif, srfflx_parm2d(c)%aldif)
      end do

      call update_srf_fluxes(srfflx_state2d,srfflx_parm2d,ocnfrac)

      do lchnk = begchunk,endchunk
         ncol = get_ncols_p(lchnk)
         call get_lat_all_p(lchnk, ncol, lats)
         call get_lon_all_p(lchnk, ncol, lons)
         call get_rlat_all_p(lchnk, ncol, clat1)
         call get_rlon_all_p(lchnk, ncol, clon1)
         call zenith (calday, clat1, clon1, coszrs, ncol)
         call albice(lchnk,ncol, tsice(1,lchnk), snowhice(1,lchnk), coszrs, &
              srfflx_parm2d(lchnk)%asdir, &
              srfflx_parm2d(lchnk)%aldir, srfflx_parm2d(lchnk)%asdif, &
              srfflx_parm2d(lchnk)%aldif)
!
! fill in ice albedoes for therm ice model
!
         asdirice(:ncol,lchnk)= srfflx_parm2d(lchnk)%asdir(:ncol)
         aldirice(:ncol,lchnk)= srfflx_parm2d(lchnk)%aldir(:ncol)
         asdifice(:ncol,lchnk)= srfflx_parm2d(lchnk)%asdif(:ncol)
         aldifice(:ncol,lchnk)= srfflx_parm2d(lchnk)%aldif(:ncol)

      end do
      call update_srf_fluxes(srfflx_state2d,srfflx_parm2d,icefrac)
   end if
#endif
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
! Preprocessing if -- if coupled to (CSM)
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
#if ( defined COUP_CSM )
!
! Initial communications with coupler
!
   call ccsmini
#endif

   return
end subroutine initext