clm_csmmod.f90

CCSM Research Tools: Community Atmosphere Model (CAM)

#include <misc.h>
#include <preproc.h>

module clm_csmMod

!----------------------------------------------------------------------- 
! 
! Purpose: 
! Set of routines that define communication between the land model
! and the flux coupler. The order of sends/receives is as follows:
!  - receive orbital data from coupler (csm_recvorb)
!  - send control data (grids and masks) to coupler (csm_sendcontrol)
!    land grid does not have valid data, runoff grid does 
!  - receive valid land grid from flux coupler (csm_recvgrid)
!  - send compressed runoff information to flux coupler (csm_sendrunoff)
!  - send first land model data to flux coupler (csm_send_alb)
!  - start normal send/recv communication pattern   
!      => csm_dosndrcv
!      => csm_recv
!      => csm_flxave
!      => csm_send   
! 
! Method: 
! 
! Author: Mariana Vertenstein
! 
!-----------------------------------------------------------------------
! $Id: clm_csmMod.F90,v 1.12.2.6 2002/04/27 15:38:44 erik Exp $
!-----------------------------------------------------------------------

#if (defined COUP_CSM)

  USE precision
  USE infnan
  USE mpishorthand
  USE clm_varpar         !parameters
  USE spmdMod            !spmd routines and variables
  USE shr_msg_mod        !csm_share message passing routines
  USE shr_sys_mod, only: shr_sys_irtc !csm_share system utility routines

  implicit none 

! Buffer information 

  integer, parameter :: nibuff = 100    ! cpl ->atm msg, initial
  integer, parameter :: ncbuff_max=2000 ! Max size of character data from cpl

  integer   :: ncbuff             !Size of character data from cpl
  integer   :: ibuffr(nibuff)     !Integer buffer from cpl
  integer   :: ibuffs(nibuff)     !Integer buffer to   cpl
  real(r8)  :: rbuff(nibuff)      !Floating pt buffer from cpl
  character :: cbuff(ncbuff_max)  !Character data recieved from cpl

! Timing information 

  logical :: csm_timing
  integer :: irtc_w               !rc ticks when waiting for msg
  integer :: irtc_r               !rtc tics when msg recved
  integer :: irtc_s               !rtc tics when msg sent

! Send/recv buffers 

  integer, parameter :: nsnd = 14
  integer, parameter :: nrcv = 16

  real(r8) :: send2d(lsmlon,lsmlat,nsnd)  !2d send buffer
  real(r8) :: recv2d(lsmlon,lsmlat,nrcv)  !2d recv buffer
  
  real(r8), private, pointer :: send1d(:,:)    !1d send buffer
  real(r8), private, pointer :: gather1d(:,:)  
  real(r8), private, pointer :: recv1d(:,:)    !1d recv buffer
  real(r8), private, pointer :: scatter1d(:,:)

  logical :: debug_flag   !received from coupler

! Flux averaging arrays and counters

  integer  :: icnt  !step counter for flux averager 
  integer  :: ncnt  !number of steps over which to average output fluxes 
  real(r8) :: rncnt !reciprocal of ncnt

  real(r8), allocatable :: taux_ave(:)     !averaged array
  real(r8), allocatable :: tauy_ave(:)     !averaged array
  real(r8), allocatable :: lhflx_ave(:)    !averaged array
  real(r8), allocatable :: shflx_ave(:)    !averaged array
  real(r8), allocatable :: lwup_ave(:)     !averaged array
  real(r8), allocatable :: qflx_ave(:)     !averaged array
  real(r8), allocatable :: swabs_ave(:)    !averaged array

! When to send/receive messages to coupler and when to make restart and stop

  integer :: ncpday         !number of send/recv calls per day
  logical :: dorecv         !receive data from coupler this step
  logical :: dosend         !send data to coupler this step
  logical :: csmstop_next   !received stop at eod signal and will stop on next ts
  logical :: csmstop_now    !received stop now signal from coupler
  logical :: csmrstrt       !restart write signal received from coupler

! Indices for send/recv fields

  integer, parameter :: irecv_hgt    = 1    !zgcmxy       Atm state m    
  integer, parameter :: irecv_u      = 2    !forc_uxy     Atm state m/s  
  integer, parameter :: irecv_v      = 3    !forc_vxy     Atm state m/s  
  integer, parameter :: irecv_th     = 4    !forc_thxy    Atm state K    
  integer, parameter :: irecv_q      = 5    !forc_qxy     Atm state kg/kg
  integer, parameter :: irecv_pbot   = 6    !ptcmxy       Atm state Pa   
  integer, parameter :: irecv_t      = 7    !forc_txy     Atm state K    
  integer, parameter :: irecv_lwrad  = 8    !flwdsxy      Atm flux  W/m^2
  integer, parameter :: irecv_rainc  = 9    !rainxy       Atm flux  mm/s 
  integer, parameter :: irecv_rainl  = 10   !rainxy       Atm flux  mm/s 
  integer, parameter :: irecv_snowc  = 11   !snowfxy      Atm flux  mm/s 
  integer, parameter :: irecv_snowl  = 12   !snowfxl      Atm flux  mm/s 
  integer, parameter :: irecv_soll   = 13   !forc_sollxy  Atm flux  W/m^2
  integer, parameter :: irecv_sols   = 14   !forc_solsxy  Atm flux  W/m^2
  integer, parameter :: irecv_solld  = 15   !forc_solldxy Atm flux  W/m^2
  integer, parameter :: irecv_solsd  = 16   !forc_solsdxy Atm flux  W/m^2

  integer, parameter :: isend_trad   = 1
  integer, parameter :: isend_asdir  = 2
  integer, parameter :: isend_aldir  = 3
  integer, parameter :: isend_asdif  = 4
  integer, parameter :: isend_aldif  = 5 
  integer, parameter :: isend_sno    = 6 
  integer, parameter :: isend_taux   = 7 
  integer, parameter :: isend_tauy   = 8 
  integer, parameter :: isend_lhflx  = 9 
  integer, parameter :: isend_shflx  = 10
  integer, parameter :: isend_lwup   = 11
  integer, parameter :: isend_qflx   = 12
  integer, parameter :: isend_tref2m = 13
  integer, parameter :: isend_swabs  = 14

! csm timers

  logical  :: timer_lnd_sendrecv = .false. !true => timer is on
  logical  :: timer_lnd_recvsend = .false. !true => timer is on

  SAVE

!===============================================================================
CONTAINS
!===============================================================================

  SUBROUTINE csm_recvorb (eccen, obliqr, lambm0, mvelpp)

!----------------------------------------------------------------------- 
! 
! Purpose: 
! receive the initial integer, real and character control data from 
! the flux coupler.  Then parse it out into the variables used by the 
! land model.
! 
! Method: 
! 
! Author: Mariana Vertenstein
! 
!-----------------------------------------------------------------------

! ---------------------- arguments------- -------------------------
    real(r8), intent(out) :: eccen  !Earth's eccentricity of orbit
    real(r8), intent(out) :: obliqr !Earth's obliquity in radians
    real(r8), intent(out) :: lambm0 !Mean longitude of perihelion at the vernal equinox (radians)
    real(r8), intent(out) :: mvelpp !Earth's moving vernal equinox long of perihelion plus pi (radians)
! -----------------------------------------------------------------

! ---------------------- Local variables --------------------------
    integer  :: i,j,k                !indices
    integer  :: ierr                 !error code                     
    integer  :: info_time            !T => turn on msg-passing timing
    integer  :: maj_vers             !Major version of message passed from the cpl
    integer  :: min_vers             !Minor version of message passed from the cpl
    real(r8) :: spval                !float-pt buffer special value from coupler
! -----------------------------------------------------------------

    if (masterproc) then

! Receive control message from coupler

       ibuffr(:) = 0    

       call shr_msg_recv_i (ibuffr, size(ibuffr), SHR_MSG_TID_CPL, SHR_MSG_TAG_C2LI)

       ierr       = ibuffr( 1)  !error code
       info_time  = ibuffr(11)  !T => turn on msg-passing timing
       maj_vers   = ibuffr(40)  !Coupler message major version
       min_vers   = ibuffr(41)  !Coupler message minor version
       ncbuff     = ibuffr(42)  !Size of character data to receive
       write(6,*) '(CSM_RECVORB): recd d->l initial ibuffr msg_id = ',SHR_MSG_TAG_C2LI

! Determine debug flag

       if (ibuffr(12) >= 2) then	
          debug_flag = .true.
       else
          debug_flag = .false.
       endif

! Check that the version of the message from the coupler is valid

       call csm_compat(maj_vers, min_vers,SHR_MSG_L_MAJ_V04, SHR_MSG_L_MIN_V00)

! Receive orbital parameters from coupler

       rbuff(:) = 0.0

       call shr_msg_recv_r (rbuff, size(rbuff), SHR_MSG_TID_CPL, SHR_MSG_TAG_C2LI)

       spval  = rbuff(1)      !Coupler float-pt special data flag
       eccen  = rbuff(2)      !Earth's eccentricity of orbit
       obliqr = rbuff(3)      !Earth's Obliquity radians
       lambm0 = rbuff(4)      !Earth's Long. of prehelian at v-equinox
       mvelpp = rbuff(5)      !Earth's Moving vernal equinox of orbit + pi
       write(6,*)'(CSM_RECVORB): recd d->l initial real buff msg_id = ',SHR_MSG_TAG_C2LI
 
! Check that data received is good data and not the special value
 
       call compat_check_spval(spval, eccen ,'Eccentricity'     )
       call compat_check_spval(spval, obliqr,'Obliquity'        )
       call compat_check_spval(spval, lambm0,'Long of perhelion')
       call compat_check_spval(spval, mvelpp,'Move long of perh')
       
       write(6,*)'(CSM_RECVORB): eccen:  ', eccen
       write(6,*)'(CSM_RECVORB): obliqr: ', obliqr
       write(6,*)'(CSM_RECVORB): lambm0: ', lambm0
       write(6,*)'(CSM_RECVORB): mvelpp: ', mvelpp
       
! Receive character data from coupler and determine if will output csm timing info

       if (ncbuff > 0) then
          call shr_msg_recv_c (cbuff, ncbuff, SHR_MSG_TID_CPL, SHR_MSG_TAG_C2LI)
          write(6,*)'(CSM_RECVORB): recd d->a initial char. buf msg_id = ',SHR_MSG_TAG_C2LI
          write(6,*)'(CSM_RECVORB): Char: ',(cbuff(i), i = 1,ncbuff)
       end if

       if (info_time == 0) then
          csm_timing = .false.
       else
          csm_timing = .true.
       endif

    end if
#if ( defined SPMD )
   call mpi_bcast(spval , 1, mpir8, 0, mpicom, ierr)
   call mpi_bcast(eccen , 1, mpir8, 0, mpicom, ierr)
   call mpi_bcast(obliqr, 1, mpir8, 0, mpicom, ierr)
   call mpi_bcast(lambm0, 1, mpir8, 0, mpicom, ierr)
   call mpi_bcast(mvelpp, 1, mpir8, 0, mpicom, ierr)
#endif

 END SUBROUTINE csm_recvorb 

!===============================================================================

 SUBROUTINE csm_sendcontrol(irad)

!----------------------------------------------------------------------- 
! 
! Purpose: 
! send first control data to flux coupler and "invalid" grid
! containing special value data
! 
! Method: 
! The coupler treats points where the mask is nonzero as points where 
! you could possibly do a calculation (in the case of the runoff, this 
! corresponds to all RTM ocean points). The coupler then defines a "key"
! as points where the model can give you valid data (in the case of runoff, 
! this corresponds to points where the land model will give you valid 
! compressed data points). The key can be 0 where the mask is 1. However,
! the key cannot be 1 where the mask is 0 unless the data is also zero. 
! In the case of runoff, the key the coupler builds is time invariant.
! 
! Author: Mariana Vertenstein
! 
!-----------------------------------------------------------------------

    use clm_varctl   , only : csm_doflxave, nsrest
    use RtmMod       , only : area_r, longxy_r, latixy_r, mask_r
    use clm_varcon   , only : re	
    use time_manager , only : get_step_size
    use controlMod   , only : csm_dtime
    use shr_const_mod, only : SHR_CONST_CDAY

! ---------------------- arguments--------------------------------------
    integer , intent(in) :: irad  !frequency of radiation computation 
!-----------------------------------------------------------------------

! ---------------------- Local variables --------------------------
    real(r8) rtemp_lnd(lsmlon*lsmlat*4) !temporary vector
    integer  itemp_lnd(lsmlon*lsmlat)   !temporary vector 
    real(r8) rtemp_rtm(rtmlon*rtmlat*4) !temporary vector
    real(r8) temp_area(rtmlon,rtmlat)   !temporary area 
    integer  temp_mask(rtmlon,rtmlat)   !temporary mask
    real(r8) dtime                      !step size
! -----------------------------------------------------------------

    if (masterproc) then

       rtemp_lnd(:) = 1.e30
       itemp_lnd(:) = 999
       rtemp_rtm(:) = 1.e30

! Determine number of send/recv calls steps per day to flux coupler
    
       if (nsrest == 0) then
          dtime = get_step_size()
       else
          dtime = csm_dtime
       endif
       if (csm_doflxave) then
          ncpday = nint(SHR_CONST_CDAY/dtime)/irad
       else
          ncpday = nint(SHR_CONST_CDAY/dtime)
       endif
       
! Send integer control information 

       ibuffs(:)  = 0                !initialize ibuffs
       ibuffs(7)  = lsmlon           !number of land longitudes
       ibuffs(8)  = lsmlat           !number of land latitudes
       ibuffs(9)  = ncpday           !number of land send/recv calls per day
       ibuffs(34) = 1                !T(or 1) => requests cpl to send valid land domain info back
       ibuffs(36) = 0                !size of compressed runoff vector, if zero then not sending compressed info 
       ibuffs(37) = rtmlon           !number of longitudes in uncompressed 2d runoff array
       ibuffs(38) = rtmlat           !number of latitudes  in uncompressed 2d runoff array