#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   returnend subroutine initext