#include <misc.h>#include <params.h>module ccsm_msg!----------------------------------------------------------------------- ! ! Purpose: Module to handle all of the message passing to/from!          the CCSM coupler for coupled simulations.! ! Author: Erik Kluzek!! Adapted from: The "ccm_csm*.F90" series of Mariana Vertenstein!! CVS Id: $Id: ccsm_msg.F90,v 1.11.2.6 2002/05/08 23:35:58 erik Exp $! !-----------------------------------------------------------------------#if (defined COUP_CSM)  use precision, only: r8          ! atmospheric model precision  use pmgrid, only: beglat, endlat, plat, plon, plond, masterproc, numlats    ! Model grid  use shr_sys_mod, only: shr_sys_flush, shr_sys_irtc          ! standardized system subroutines  use shr_msg_mod, only: shr_msg_send_i, shr_msg_send_r, shr_msg_recv_i, & ! CCSM messages                         shr_msg_recv_r, shr_msg_recv_c, SHR_MSG_TID_CPL, &                         SHR_MSG_TAG_C2A, SHR_MSG_TAG_A2C,  SHR_MSG_TAG_C2AI, &                         SHR_MSG_TAG_A2CI, SHR_MSG_A_MAJ_V04, SHR_MSG_A_MIN_V00  use shr_kind_mod, only: SHR_KIND_IN                   ! defines CCSM real & integer kinds  use rgrid, only: nlon  ! Reduced grid#if ( defined SPMD )  use spmd_dyn, only: npes, compute_gsfactors           ! SPMD variables  use mpishorthand, only: mpicom, mpir8, mpiint, mpilog ! MPI interface#endif  use history, only: outfld  use binary_io, only: wrtout_r8, readin_r8  implicit none!--------------------------------------------------------------------------! Public interface and information!--------------------------------------------------------------------------  public ccsmini                  ! Initialization  public ccsmsnd                  ! Send information to coupler  public ccsmrcv                  ! Receive information from coupler  public ccsmfin                  ! Finalization, shut down model  public ccsmave                  ! Average CCSM data (when flxave set)  public read_restart_ccsm        ! Read the CCSM restart information  public write_restart_ccsm       ! Write the CCSM restart information  public initialize_ccsm_msg      ! Initialize ccsm_msg data!! When to send/receive messages to coupler and when to make restart and stop!  logical, public :: dorecv       ! receive data from coupler this step  logical, public :: dosend       ! send data to coupler this step  logical, public :: csmstop      ! stop signal received from coupler  logical, public :: csmrstrt     ! restart write signal received from coupler!! Surface data important for CCSM only!  real(r8), public, allocatable:: rho(:,:)      ! surface air density  real(r8), public, allocatable:: netsw(:,:)    ! net shortwave  real(r8), public, allocatable:: psl(:,:)      ! sea-level pressure!--------------------------------------------------------------------------! Private data local to this module only!--------------------------------------------------------------------------  private         ! Make the default access private, explicitly declare public!! Buffer information !  integer(SHR_KIND_IN), private, parameter :: nibuff = 100    ! cpl ->atm msg, initial  integer(SHR_KIND_IN), private, parameter :: ncbuff_max=2000 ! Max size of character data from cpl  integer(SHR_KIND_IN), private :: ncbuff        ! Size of character data from cpl  integer(SHR_KIND_IN), private :: ibuff(nibuff) ! Integer buffer from cpl  real(r8), private :: rbuff(nibuff)        ! Floating pt buffer from cpl  character, private:: cbuff(ncbuff_max)    ! Character data recieved from cpl  real(r8) spval                            ! Special value for real msg data!! Timing information !  logical, private :: csm_timing            ! turn timing of CCSM messages on  integer, private :: irtc_w                ! rtc ticks when waiting for msg  integer, private :: irtc_r                ! rtc ticks when msg recved  integer, private :: irtc_s                ! rtc ticks when msg sent!! Send/recv buffers!  integer(SHR_KIND_IN), private, parameter :: nsnd=19 ! number of send variables  integer(SHR_KIND_IN), private, parameter :: nrcv=15 ! number of recv variables  real(r8), private :: arget(plon,plat,nrcv)! recv array  real(r8), private :: arput(plon,plat,nsnd)! send array#if (defined SPMD)  real(r8), allocatable:: arget_spmd(:,:,:)   ! recv array for spmd  real(r8), allocatable:: arput_spmd(:,:,:)   ! send array for spmd  real(r8), allocatable:: arget_buf(:,:,:)    ! gather array used on masterproc  real(r8), allocatable:: arput_buf(:,:,:)    ! scatter array used on masterproc#endif!! Flux accumulator!  integer, private :: countfa      ! counter for flux accumulators!! Surface data that needs to be averaged!  real(r8), allocatable:: precca(:,:)   ! Average convective precipitation  real(r8), allocatable:: precla(:,:)   ! Average large-scale precipation  real(r8), allocatable:: precsca(:,:)  ! Average convective snow-fall  real(r8), allocatable:: precsla(:,:)  ! Average large-scale snow-fall  real(r8), allocatable:: rainconv(:,:) ! Convective rainfall  real(r8), allocatable:: rainlrsc(:,:) ! Large-scale rainfall  real(r8), allocatable:: snowconv(:,:) ! Convective snowfall  real(r8), allocatable:: snowlrsc(:,:) ! Larse-scale snowfall  real(r8), allocatable:: prc_err(:,:)  ! Error in precipitation sent to coupler!===============================================================================CONTAINS!===============================================================================!===============================================================================! The following first set of subroutines can be publically called.! After this set are the subroutines that are callable only from within! this module.!===============================================================================  subroutine ccsmini!----------------------------------------------------------------------- ! ! Purpose: Initialize ccsm coupler communications! ! Method: ! ! Author: Mariana Vertenstein! !-----------------------------------------------------------------------    use comsrf, only: srfflx_state2d,surface_state2d, icefrac, ocnfrac, landfrac    use physconst, only: stebol    use tracers, only: pcnst, pnats    use time_manager, only: is_first_step!-----------------------------------------------------------------------#include <comctl.h>!--------------------------Local Variables------------------------------    integer i,m,lat,n     ! indices#if (defined SPMD)    integer ierr          ! Allocation error signal#endif!-----------------------------------------------------------------------! Set the CCSM stop and restart to false!    csmstop  = .false.    csmrstrt = .false.!! For SPMD allocate the send and receive buffers!#if (defined SPMD)   if ( .not. allocated(arget_spmd) )then      allocate(arget_spmd(plon,nrcv,beglat:endlat), STAT=ierr)      if (ierr /= 0) then         write(6,*)'(CCSMINI) arget_spmd allocation error'         call endrun      endif   endif   allocate(arput_spmd(plon,nsnd,beglat:endlat), STAT=ierr)   if (ierr /= 0) then      write(6,*)'(CCSMINI) arput_spmd allocation error'      call endrun   endif   if ( masterproc ) then      if ( .not. allocated(arget_buf) )then         allocate(arget_buf(plon,nrcv,plat), STAT=ierr)         if (ierr /= 0) then            write(6,*)'(CCSMINI) arget_buf allocation error'            call endrun         endif      endif      allocate(arput_buf(plon,nsnd,plat), STAT=ierr)      if (ierr /= 0) then         write(6,*)'(CCSMINI) arput_buf allocation error'         call endrun      endif   end if#endif!! For now set all tracer fluxes to zero!    do m=2,pcnst+pnats       do lat=beglat,endlat          do i=1,nlon(lat)             srfflx_state2d(lat)%cflx(i,m) = 0.          end do       end do    end do!! Require the short and longwave radiation frequencies to match, since these! fluxes will be sent as instantaneous fluxes to the coupler, valid over the ! next interval.!    if (masterproc) then       if (flxave) then          if (iradsw == iradlw) then             write(6,*) '(CCSMINI): coupling will take place every ',iradsw, ' steps'          else             write(6,*) '(CCSMINI): iradsw != iradlw ', iradsw, iradlw             stop 'bad irad'          endif       else          write(6,*) '(CCSMINI): coupling will take place every time step'       end if       call shr_sys_flush(6)    end if!! Receive orbital parameters!    if (masterproc) then       write(6,*) '(CCSMINI): get orbital parameters from coupler'       call shr_sys_flush(6)    end if    call ccsm_msg_getorb!! Send grid to flux coupler!    if (masterproc) then       write(6,*) '(CCSMINI): send grid to coupler'       call shr_sys_flush(6)    end if    call ccsm_msg_sendgrid!! For initial run only:     if (is_first_step()) then!! Initial run only: get albedos and ice fraction !       if (masterproc) then          write(6,*) '(CCSMINI): get albedos from coupler'          call shr_sys_flush(6)       end if       call ccsm_msg_getalb!! Initial run only: determine landfrac field (complement of ocean orography)!       do lat=beglat,endlat          do i=1,nlon(lat)             if (icefrac(i,lat) + ocnfrac(i,lat) <= .999) then	        landfrac(i,lat) = 1.	        ocnfrac(i,lat) = 0.             else                landfrac(i,lat) = 0.	        ocnfrac(i,lat) = 1.             end if!             landfrac(i,lat) = 1. - icefrac(i,lat) - ocnfrac(i,lat)          end do       end do!! Initial run only: determine longwave up flux from the surface temperature. !       do lat=beglat,endlat          do i=1,nlon(lat)             srfflx_state2d(lat)%lwup(i) = stebol*(srfflx_state2d(lat)%ts(i)**4)          end do       end do    end if        if (masterproc) then       write(6,*) '(CCSMINI): CCSM initialization complete!'       call shr_sys_flush(6)    end if    return  end subroutine ccsmini  subroutine ccsmrcv!----------------------------------------------------------------------- ! ! Purpose: ! Get the message array from the csm driver and extract the data! ! Method: ! ! Author: Byron Boville! !-----------------------------------------------------------------------    use comsrf, only: srfflx_state2d,surface_state2d, icefrac, ocnfrac, &                      landfrac, snowhice, snowhland#include <comctl.h>!---------------------------Local workspace-----------------------------    integer i,lat,n           ! indices    integer len               ! temporary variable length#ifdef SPMD    integer :: numperlat         ! number of values per latitude band    integer :: numsend(0:npes-1) ! number of items to be sent    integer :: numrecv           ! number of items to be received    integer :: displs(0:npes-1)  ! displacement array#endif!-----------------------------------------------------------------------!! Get data from flux coupler. !    if (masterproc) then       if (csm_timing) irtc_w = shr_sys_irtc()       call shr_msg_recv_i(ibuff, size(ibuff), SHR_MSG_TID_CPL, SHR_MSG_TAG_C2A)       call shr_msg_recv_r(arget, size(arget), SHR_MSG_TID_CPL, SHR_MSG_TAG_C2A)       if (csm_timing) then          irtc_r = shr_sys_irtc()          write(6,9099) irtc_w,'d->a waiting'          write(6,9099) irtc_r,'d->a received'       endif    endif!! Split buffer into component arrays. Change signs as required.! Note that coupler has convention that fluxes are positive downward.!#if (defined SPMD)    call mpibcast (ibuff,nibuff,mpiint,0,mpicom)        if (masterproc) then       do n=1,nrcv          do lat=1,plat             do i=1,nlon(lat)                arget_buf(i,n,lat) = arget(i,lat,n)             end do