if (nint(x(i,j,9))==-1.or.nint(x(i,j,10))==-1) then             if (nint(x(i,j,8)) /= -1) then                forc_solsxy_a(i,j)  = 0.7 * (0.5 * x(i,j,8))                forc_sollxy_a(i,j)  = forc_solsxy_a(i,j)                forc_solsdxy_a(i,j) = 0.3 * (0.5 * x(i,j,8))                forc_solldxy_a(i,j) = forc_solsdxy_a(i,j)             else                write(6,*)'ATM error: neither FSDSdir/dif nor'                write(6,*)'       FSDS have been read in by atm_readdata'                atmread_err = .true.             end if          else             forc_solsxy_a(i,j)  = 0.5 * x(i,j,9)             forc_sollxy_a(i,j)  = forc_solsxy_a(i,j)             forc_solsdxy_a(i,j) = 0.5 * x(i,j,10)             forc_solldxy_a(i,j) = forc_solsdxy_a(i,j)          end if! PRCXY, PRLXY          if (nint(x(i,j,13))==-1.or.nint(x(i,j,14))==-1) then             if (nint(x(i,j,12)).ne.-1) then                prcxy_a(i,j) = 0.1 * x(i,j,12)                prlxy_a(i,j) = 0.9 * x(i,j,12)             else                write(6,*)'ATM error: neither PRECC/L nor PRECT'                write(6,*)'           have been read in by atm_readdata'                atmread_err = .true.             end if          else             prcxy_a(i,j) = x(i,j,13)             prlxy_a(i,j) = x(i,j,14)          end if! FLWDSXY          if (nint(x(i,j,11)) == -1) then             e = forc_psrfxy_a(i,j) * forc_qxy_a(i,j) / (0.622 + 0.378 * forc_qxy_a(i,j))             ea = 0.70 + 5.95e-05 * 0.01*e * exp(1500.0/forc_txy_a(i,j))                          flwdsxy_a(i,j) = ea * sb * forc_txy_a(i,j)**4          else             flwdsxy_a(i,j) = x(i,j,11)           end if       end do                 !end loop of latitudes    end do                    !end loop of longitudes!$OMP END PARALLEL DO    if (atmread_err) then       write(6,*) 'atm_readdata: error reading atm data'       call endrun    end if    return  end subroutine atm_readdata!=======================================================================  subroutine interpa2si!----------------------------------------------------------------------- ! ! Purpose: ! initialize variables for atm->land model surface interp!! Method: ! ! Author: Gordon Bonan! !-----------------------------------------------------------------------    use precision    use clm_varpar, only : lsmlon, lsmlat    use clm_varsur, only : numlon, longxy, latixy, lsmedge, lonw, lats, area    use areaMod      implicit none! ------------------------ local variables ---------------------------    integer i,j,k                        !indices    real(r8), allocatable :: lon_a(:,:)  !atm grid longitude cell edges    real(r8), allocatable :: lat_a(:)    !atm grid latitude cell edges    real(r8), allocatable :: area_a(:,:) !atm grid grid cell areas    real(r8), allocatable :: mask_a(:,:) !dummy field: atm grid mask    real(r8), allocatable :: mask_s(:,:) !dummy field: land model grid mask! --------------------------------------------------------------------! Dynamically allocate memory    allocate (lon_a(atmlon+1,atmlat))    allocate (lat_a(atmlat+1))    allocate (area_a(atmlon,atmlat))    allocate (mask_a(atmlon,atmlat))    allocate (mask_s(lsmlon,lsmlat))    if ( masterproc )then       write (6,*) 'Attempting to initialize atm->land model grid interpolation .....'       write (6,*) 'Initializing atm -> srf interpolation .....'    end if! --------------------------------------------------------------------! Map from atmosphere grid to surface grid! --------------------------------------------------------------------! determine numlon for atmosphere grid     numlon_a(:) = 0    do j = 1, atmlat       do i = 1, atmlon          if (longxy_a(i,j) /= 1.e36) numlon_a(j) = numlon_a(j) + 1       end do    end do! [mask_a] = 1 means all grid cells on atm grid, regardless of whether! land or ocean, will contribute to surface grid.    do j = 1, atmlat       do i = 1, numlon_a(j)          mask_a(i,j) = 1.       end do    end do! [mask_s] = 1 means all the surface grid is land. Used as dummy! variable so code will not abort with false, non-valid error check    do j = 1, lsmlat       do i = 1, numlon(j)          mask_s(i,j) = 1.       end do    end do! For each surface grid cell: get lat [jovr_a2s] and lon [iovr_a2s] indices ! and weights [wovr_a2s] of overlapping atm grid cells     call celledge (atmlat    , atmlon    , numlon_a  , longxy_a  , &                    latixy_a  , edge_a(1) , edge_a(2) , edge_a(3) , &                    edge_a(4) , lat_a     , lon_a     )    call cellarea (atmlat    , atmlon    , numlon_a  , lat_a     , &                   lon_a     , edge_a(1) , edge_a(2) , edge_a(3) , &                   edge_a(4) , area_a    )    call areaini (atmlon, atmlat, numlon_a, lon_a, lat_a, area_a, mask_a, &                  lsmlon, lsmlat, numlon  , lonw , lats , area  , mask_s, &                  mxovr , novr_a2s, iovr_a2s, jovr_a2s, wovr_a2s )    deallocate (lon_a)    deallocate (lat_a)    deallocate (area_a)    deallocate (mask_a)    deallocate (mask_s)    if ( masterproc )then       write (6,*) 'Successfully made atm -> srf interpolation'       write (6,*) 'Successfully initialized area-averaging interpolation'       write (6,*)    end if    return  end subroutine interpa2si!=======================================================================  subroutine interpa2s (forc_t_a  , forc_t_s  , zgcm_a  , zgcm_s  , &                        forc_u_a  , forc_u_s  , forc_v_a  , forc_v_s  , &                        forc_q_a  , forc_q_s  , prc_a   , prc_s   , &                        prl_a   , prl_s   , flwds_a , flwds_s , &                        forc_sols_a  , forc_sols_s  , forc_soll_a  , forc_soll_s  , &                        forc_solsd_a , forc_solsd_s , forc_solld_a , forc_solld_s , &                        forc_pbot_a  , forc_pbot_s  , forc_psrf_a  , forc_psrf_s  )!----------------------------------------------------------------------- ! ! Purpose: ! area average fields from atmosphere grid to surface grid!! Method: ! ! Author: Gordon Bonan! !-----------------------------------------------------------------------    use precision    use clm_varpar, only : lsmlon, lsmlat    use clm_varsur, only : numlon, longxy, latixy, lsmedge    use areaMod      implicit none! ------------------------ arguments ---------------------------------    real(r8), intent(in)  ::  forc_t_a(atmlon,atmlat) !atm bottom level temperature (Kelvin)    real(r8), intent(in)  ::  zgcm_a(atmlon,atmlat)   !atm bottom level height above surface (m)    real(r8), intent(in)  ::  forc_u_a(atmlon,atmlat) !atm bottom level zonal wind (m/s)    real(r8), intent(in)  ::  forc_v_a(atmlon,atmlat) !atm bottom level meridional wind (m/s)    real(r8), intent(in)  ::  forc_q_a(atmlon,atmlat) !atm bottom level specific humidity (kg/kg)    real(r8), intent(in)  ::   prc_a(atmlon,atmlat)   !convective precipitation rate (mm H2O/s)    real(r8), intent(in)  ::   prl_a(atmlon,atmlat)   !large-scale precipitation rate (mm H2O/s)    real(r8), intent(in)  :: flwds_a(atmlon,atmlat)   !downward longwave rad onto surface (W/m**2)    real(r8), intent(in)  ::  forc_sols_a(atmlon,atmlat) !vis direct beam solar rad onto srf (W/m**2)    real(r8), intent(in)  ::  forc_soll_a(atmlon,atmlat) !nir direct beam solar rad onto srf (W/m**2)    real(r8), intent(in)  :: forc_solsd_a(atmlon,atmlat) !vis diffuse solar rad onto srf (W/m**2)    real(r8), intent(in)  :: forc_solld_a(atmlon,atmlat) !nir diffuse solar rad onto srf(W/m**2)    real(r8), intent(in)  ::  forc_pbot_a(atmlon,atmlat) !atm bottom level pressure (Pa)    real(r8), intent(in)  ::  forc_psrf_a(atmlon,atmlat) !atm surface pressure (Pa)    real(r8), intent(out) ::  forc_t_s(lsmlon,lsmlat) !atm bottom level temperature (Kelvin)    real(r8), intent(out) ::  zgcm_s(lsmlon,lsmlat)   !atm bottom level height above surface (m)    real(r8), intent(out) ::  forc_u_s(lsmlon,lsmlat) !atm bottom level zonal wind (m/s)    real(r8), intent(out) ::  forc_v_s(lsmlon,lsmlat) !atm bottom level meridional wind (m/s)    real(r8), intent(out) ::  forc_q_s(lsmlon,lsmlat) !atm bottom level specific humidity (kg/kg)    real(r8), intent(out) ::   prc_s(lsmlon,lsmlat)   !convective precipitation rate (mm H2O/s)    real(r8), intent(out) ::   prl_s(lsmlon,lsmlat)   !large-scale precipitation rate (mm H2O/s)    real(r8), intent(out) :: flwds_s(lsmlon,lsmlat)   !downward longwave rad onto surface (W/m**2)    real(r8), intent(out) ::  forc_sols_s(lsmlon,lsmlat) !vis direct beam solar rad onto srf (W/m**2)    real(r8), intent(out) ::  forc_soll_s(lsmlon,lsmlat) !nir direct beam solar rad onto srf (W/m**2)    real(r8), intent(out) :: forc_solsd_s(lsmlon,lsmlat) !vis diffuse solar rad onto srf (W/m**2)    real(r8), intent(out) :: forc_solld_s(lsmlon,lsmlat) !nir diffuse solar rad onto srf(W/m**2)    real(r8), intent(out) ::  forc_pbot_s(lsmlon,lsmlat) !atm bottom level pressure (Pa)    real(r8), intent(out) ::  forc_psrf_s(lsmlon,lsmlat) !atm surface pressure (Pa)! --------------------------------------------------------------------! ------------------------ local variables ---------------------------    integer  :: i,j                    !longitude,latitude loop indices    real(r8) :: forc_u(atmlon,atmlat)  !dummy wind (u)    real(r8) :: forc_v(atmlon,atmlat)  !dummy wind (v)    logical  :: initinterp = .false.   !interpolation initialization flag! --------------------------------------------------------------------! Initialize    if (.not. initinterp) then       call interpa2si       initinterp = .true.    endif! area-average absolute value of winds (i.e., regardless of! direction) since land model cares about magnitude not direction.! then need to adjust resultant stresses for direction of wind. !$OMP PARALLEL DO PRIVATE (j,i)    do j = 1, atmlat       do i = 1, numlon_a(j)          forc_u(i,j) = abs(forc_u_a(i,j))          forc_v(i,j) = abs(forc_v_a(i,j))       end do    end do!$OMP END PARALLEL DO    call areaave (atmlat   , atmlon   , numlon_a , forc_t_a  , &                  lsmlat   , lsmlon   , numlon   , forc_t_s  , &                  iovr_a2s , jovr_a2s , wovr_a2s , mxovr   )    call areaave (atmlat   , atmlon   , numlon_a , zgcm_a  , &                  lsmlat   , lsmlon   , numlon   , zgcm_s  , &                  iovr_a2s , jovr_a2s , wovr_a2s , mxovr   )    call areaave (atmlat   , atmlon   , numlon_a , forc_u    , &                  lsmlat   , lsmlon   , numlon   , forc_u_s  , &                  iovr_a2s , jovr_a2s , wovr_a2s , mxovr   )    call areaave (atmlat   , atmlon   , numlon_a , forc_v    , &                  lsmlat   , lsmlon   , numlon   , forc_v_s  , &                  iovr_a2s , jovr_a2s , wovr_a2s , mxovr   )    call areaave (atmlat   , atmlon   , numlon_a , forc_q_a  , &                  lsmlat   , lsmlon   , numlon   , forc_q_s  , &                  iovr_a2s , jovr_a2s , wovr_a2s , mxovr   )    call areaave (atmlat   , atmlon   , numlon_a , forc_pbot_a  , &                  lsmlat   , lsmlon   , numlon   , forc_pbot_s  , &                  iovr_a2s , jovr_a2s , wovr_a2s , mxovr   )    call areaave (atmlat   , atmlon   , numlon_a , forc_psrf_a  , &                  lsmlat   , lsmlon   , numlon   , forc_psrf_s  , &                  iovr_a2s , jovr_a2s , wovr_a2s , mxovr   )    call areaave (atmlat   , atmlon   , numlon_a , prc_a   , &                  lsmlat   , lsmlon   , numlon   , prc_s   , &                  iovr_a2s , jovr_a2s , wovr_a2s , mxovr   )    call areaave (atmlat   , atmlon   , numlon_a , prl_a   , &                  lsmlat   , lsmlon   , numlon   , prl_s   , &                  iovr_a2s , jovr_a2s , wovr_a2s , mxovr   )    call areaave (atmlat   , atmlon   , numlon_a , flwds_a , &                  lsmlat   , lsmlon   , numlon   , flwds_s , &                  iovr_a2s , jovr_a2s , wovr_a2s , mxovr   )    call areaave (atmlat   , atmlon   , numlon_a , forc_sols_a  , &                  lsmlat   , lsmlon   , numlon   , forc_sols_s  , &                  iovr_a2s , jovr_a2s , wovr_a2s , mxovr   )    call areaave (atmlat   , atmlon   , numlon_a , forc_soll_a  , &                  lsmlat   , lsmlon   , numlon   , forc_soll_s  , &                  iovr_a2s , jovr_a2s , wovr_a2s , mxovr   )    call areaave (atmlat   , atmlon   , numlon_a , forc_solsd_a , &                  lsmlat   , lsmlon   , numlon   , forc_solsd_s , &                  iovr_a2s , jovr_a2s , wovr_a2s , mxovr   )    call areaave (atmlat   , atmlon   , numlon_a , forc_solld_a , &                  lsmlat   , lsmlon   , numlon   , forc_solld_s , &                  iovr_a2s , jovr_a2s , wovr_a2s , mxovr   )    return  end subroutine interpa2s#endifend module atmdrvMod