!---------------------------Local workspace-----------------------------    integer i,lat,n                ! longitude,latitude,count indices    integer nstep                  ! current time step    integer nstepcsm               ! time step sent to flux coupler    integer yr, mon, day           ! year, month, day components of cdatecsm    integer cdatecsm,cseccsm       ! current date,sec     integer msgpday                ! number of send/recv msgs per day    logical nextsw                 ! set to true for next sw calculation    real(r8) dtime                 ! timestep size    real(r8) albshift              ! albedo calculation time shift!-----------------------------------------------------------------------    nstep = get_nstep()    dtime = get_step_size()!! Determine time step sent to flux coupler and corresponding date.!    if (nstep==0) then                      nstepcsm = nstep       call get_curr_date(yr, mon, day, cseccsm)       cdatecsm = yr*10000 + mon*100 + day    else       nstepcsm = nstep - 1       call get_prev_date(yr, mon, day, cseccsm)       cdatecsm = yr*10000 + mon*100 + day    end if!! Determine albedo calculation time shift, which is the time interval ! from nstepcsm until the next short wave calculation.    if (nstep /= 0) then                      if (flxave) then          albshift = nint((nstep+iradsw-nstepcsm)*dtime)       else          nextsw = .false.          n = 1          do while (.not. nextsw)             nextsw = (mod((nstep+n-1),iradsw)==0)             if (nextsw) albshift = nint((nstep+n-nstepcsm)*dtime)             n = n+1          end do       endif    else       albshift = nint(iradsw*dtime) + dtime    endif!! Determine number of send/recv msgs per day!    if (flxave) then                       msgpday = nint(86400./dtime)/iradsw     else       msgpday = nint(86400./dtime)          endif!! Determine ibuff array!    ibuff(:)  = 0    ibuff(4)  = cdatecsm            ! model date (yyyymmdd)    ibuff(5)  = cseccsm             ! elapsed seconds in current day    ibuff(6)  = nstepcsm            ! model time step     ibuff(7)  = plon                ! number of model longitudes    ibuff(8)  = plat                ! number of model latitudes    ibuff(9)  = msgpday             ! number of send/recv msgs per day    ibuff(32) = albshift            ! albedo calculation time shift!! Send data to coupler!    call shr_msg_send_i (ibuff, size(ibuff), SHR_MSG_TID_CPL, SHR_MSG_TAG_A2C)    call shr_msg_send_r (arput, size(arput), SHR_MSG_TID_CPL, SHR_MSG_TAG_A2C)    if (csm_timing) then       irtc_s = shr_sys_irtc()       write(6,9099) irtc_s,'a->d sending'    end if9099 format('[mp timing]  irtc = ',i20,' ',a)    return  end subroutine msgsnd!===============================================================================  subroutine ccsmave (iradsw, nstep, dosw)!----------------------------------------------------------------------- ! ! Purpose: ! Average the input fluxes to lsm between solar radiation times.! ! Method: ! Currently, the only flux requiring averaging is the precipitation, ! since the radiative fluxes are constant over the averaging interval.! ! Author: Byron Boville! !-----------------------------------------------------------------------    use comsrf, only: surface_state2d!------------------------------Arguments--------------------------------    integer, intent(in) :: iradsw  ! solar radiation interval    integer, intent(in) ::  nstep  ! time step number    logical, intent(in) ::  dosw   ! time to compute averages (solar radiation time)!-----------------------------------------------------------------------!---------------------------Local workspace-----------------------------    integer i,lat    ! longitude,level,latitude indices    real(r8) rcount  ! reciprocal of count!-----------------------------------------------------------------------!! If iradsw == 1, then no averaging is required!    if (iradsw == 1) return!! Set the counter and normalizing factor!    if (nstep == 0) countfa = 0    countfa = countfa + 1    if (dosw) then       rcount = 1./countfa    end if!$OMP PARALLEL DO PRIVATE(lat,i)    do lat = beglat,endlat       if (countfa == 1) then          do i = 1, nlon(lat)             precca(i,lat)  = surface_state2d(lat)%precc(i)                precla(i,lat)  = surface_state2d(lat)%precl(i)                precsca(i,lat) = surface_state2d(lat)%precsc(i)                precsla(i,lat) = surface_state2d(lat)%precsl(i)             end do!! Final call of averaging interval, complete averaging and copy data back!       else if (dosw) then          do i = 1, nlon(lat)             precca(i,lat)  = rcount*(precca(i,lat) + surface_state2d(lat)%precc(i))             precla(i,lat)  = rcount*(precla(i,lat) + surface_state2d(lat)%precl(i))             precsca(i,lat) = rcount*(precsca(i,lat) + surface_state2d(lat)%precsc(i))             precsla(i,lat) = rcount*(precsla(i,lat) + surface_state2d(lat)%precsl(i))          end do!! Intermediate call, add data to accumulators!       else          do i = 1, nlon(lat)             precca(i,lat)  = precca(i,lat) + surface_state2d(lat)%precc(i)                precla(i,lat)  = precla(i,lat) + surface_state2d(lat)%precl(i)                precsca(i,lat) = precsca(i,lat) + surface_state2d(lat)%precsc(i)                precsla(i,lat) = precsla(i,lat) + surface_state2d(lat)%precsl(i)             end do       end if    end do!! Reset the counter if the average was just computed!    if (dosw) then       countfa = 0    end if    return  end subroutine ccsmave!===============================================================================  subroutine ccsm_msg_getorb!----------------------------------------------------------------------- ! ! Purpose: Get orbital values from flux coupler! ! Method: ! ! Author: Erik Kluzek! !-----------------------------------------------------------------------     use physconst, only:#include <comctl.h>#include <comsol.h>!--------------------------Local Variables------------------------------    integer cplcdate           ! current date from coupler          integer cplcsec            ! elapsed sec on current date        integer info_time          ! T => turn on msg-passing timing    integer maj_vers           ! Coupler major message compatibility version    integer min_vers           ! Coupler minor message compatibility version    integer ierr               ! Return error  !!-----------------------------------------------------------------------!    if (masterproc) then!! Receive first ibuff message from coupler. This is currently only used! to determine if output csm timing will occur.!       ibuff(:) = 0       call shr_msg_recv_i (ibuff, nibuff, SHR_MSG_TID_CPL, SHR_MSG_TAG_C2AI)       ierr      = ibuff( 1)  ! error code       cplcdate  = ibuff( 4)  ! current date from coupler       cplcsec   = ibuff( 5)  ! elapsed sec on current date       info_time = ibuff(11)  ! T => turn on msg-passing timing       maj_vers  = ibuff(40)  ! Coupler message major version       min_vers  = ibuff(41)  ! Coupler message minor version       ncbuff    = ibuff(42)  ! Size of character data to recieve       write(6,*)'(CCSM_MSG_GET_ORB): recd d->a initial ibuf msg_id = ',SHR_MSG_TAG_C2AI       call shr_sys_flush(6)!! Check that the version of the message from the coupler is version expected!       call ccsm_msg_compat(maj_vers, min_vers, SHR_MSG_A_MAJ_V04, SHR_MSG_A_MIN_V00)!! Receive first floating point rbuff message from coupler.!       rbuff(:) = 0.0       call shr_msg_recv_r (rbuff, nibuff, SHR_MSG_TID_CPL, SHR_MSG_TAG_C2AI)       spval  = rbuff(1)      !Special flag value for data       eccen  = rbuff(2)      !Earth's eccentricity of orbit       obliqr = rbuff(3)      !Earth's Obliquity radians       lambm0 = rbuff(4)      !longitude of perihelion at v-equinox       mvelpp = rbuff(5)      !Earth's Moving vernal equinox of orbit + pi!! Check that data sent is good data and not the special value!       call ccsm_compat_check_spval(spval, eccen ,'Eccentricity' )       call ccsm_compat_check_spval(spval, obliqr,'Obliquity' )       call ccsm_compat_check_spval(spval, lambm0,'long of perh.' )       call ccsm_compat_check_spval(spval, mvelpp,'Moving lon of perh')       write(6,*)'(CCSM_MSG_GET_ORB): eccen:  ', eccen       write(6,*)'(CCSM_MSG_GET_ORB): obliqr: ', obliqr       write(6,*)'(CCSM_MSG_GET_ORB): lambm0: ', lambm0       write(6,*)'(CCSM_MSG_GET_ORB): mvelpp: ', mvelpp       write(6,*)'(CCSM_MSG_GET_ORB): recd d->a initial real buf msg_id = ',SHR_MSG_TAG_C2AI       call shr_sys_flush(6)!! Receive character data cbuff message from coupler.!       if ( ncbuff > 0 )then          call shr_msg_recv_c (cbuff, ncbuff, SHR_MSG_TID_CPL, SHR_MSG_TAG_C2AI)          write(6,*)'(CCSM_MSG_GET_ORB): recd d->a initial char. buf msg_id= ',SHR_MSG_TAG_C2AI          call shr_sys_flush(6)       end if!! Determine if will output csm timing info.!       if (info_time == 0) then          csm_timing = .false.       else          csm_timing = .true.       endif    endif ! End of if-masterproc#if ( defined SPMD )    call mpibcast(spval , 1, mpir8, 0, mpicom)    call mpibcast(eccen , 1, mpir8, 0, mpicom)    call mpibcast(obliqr, 1, mpir8, 0, mpicom)    call mpibcast(lambm0, 1, mpir8, 0, mpicom)    call mpibcast(mvelpp, 1, mpir8, 0, mpicom)#endif    return  end subroutine ccsm_msg_getorb!===============================================================================  subroutine ccsm_msg_sendgrid!----------------------------------------------------------------------- ! ! Purpose: ! Send grid to flux coupler! ! Method: ! ! Author: Mariana Vertenstein! !-----------------------------------------------------------------------    use infnan    use commap, only: latdeg, londeg    use dycore, only: dycore_is    use time_manager, only: get_nstep, get_step_size#include <comctl.h>!--------------------------Local Variables------------------------------    integer lat, lon              ! loop indices    integer nstep                  ! current time step    integer msgpday               ! number of send/recv msgs per day    integer(SHR_KIND_IN) ::  mask(plon,plat)       ! Mask of valid data    real(r8) dtime                ! timestep size [s]    real(r8) area(plon,plat)      ! Area in radians squared for each grid point    real(r8) clondeg(plon,plat)   ! Longitude grid    real(r8) clatdeg(plon,plat)   ! latitude grid as 2 dimensional array    real(r8) ns_vert(4,plon,plat) ! latitude grid vertices    real(r8) ew_vert(4,plon,plat) ! longitude grid vertices    real(r8) del_theta            ! difference in latitude at a grid point    real(r8) del_phi              ! difference in longitude at a grid point    real(r8) pie                  ! mathmatical constant 3.1415...    real(r8) degtorad             ! convert degrees to radians!-----------------------------------------------------------------------    if (masterproc) then       nstep = get_nstep()       dtime = get_step_size()!! Determine number of send/recv msgs per day!       if (flxave) then                          msgpday = nint(86400./dtime)/iradsw        else          msgpday = nint(86400./dtime)             endif       write(6,*)'(CCSM_MSG_SENDGRID): there are ',msgpday,' send/recv msgs per day'       call shr_sys_flush(6)!! Determine ibuff sent to coupler!       ibuff(:) = 0