end do       end do    endif    numperlat = plon*nrcv    call compute_gsfactors (numperlat, numrecv, numsend, displs)    if ( masterproc ) then       call mpiscatterv (arget_buf, numsend, displs, mpir8, arget_spmd(1,1,beglat), &                         numrecv, mpir8, 0, mpicom)    else       call mpiscatterv (0.0_r8, numsend, displs, mpir8, arget_spmd(1,1,beglat), &                         numrecv, mpir8, 0, mpicom)    end if    do lat=beglat,endlat       do i=1,nlon(lat)          srfflx_state2d(lat)%wsx(i)    = -arget_spmd(i,1 ,lat) ! Atmosphere-surface flux          srfflx_state2d(lat)%wsy(i)    = -arget_spmd(i,2 ,lat) ! Atmosphere-surface flux          srfflx_state2d(lat)%lhf(i)    = -arget_spmd(i,3 ,lat) ! Atmosphere-surface flux          srfflx_state2d(lat)%shf(i)    = -arget_spmd(i,4 ,lat) ! Atmosphere-surface flux          srfflx_state2d(lat)%lwup(i)   = -arget_spmd(i,5 ,lat) ! Atmosphere-surface flux          srfflx_state2d(lat)%cflx(i,1) = -arget_spmd(i,6 ,lat) ! Atmosphere-surface flux          srfflx_state2d(lat)%asdir(i)  =  arget_spmd(i,7 ,lat) ! Surface state variable          srfflx_state2d(lat)%aldir(i)  =  arget_spmd(i,8 ,lat) ! Surface state variable          srfflx_state2d(lat)%asdif(i)  =  arget_spmd(i,9 ,lat) ! Surface state variable          srfflx_state2d(lat)%aldif(i)  =  arget_spmd(i,10,lat) ! Surface state variable          srfflx_state2d(lat)%ts(i)     =  arget_spmd(i,11,lat) ! Surface state variable          snowhland(i,lat)              =  arget_spmd(i,12,lat) ! Surface state variable          icefrac(i,lat)                =  arget_spmd(i,13,lat) ! Surface type fraction          ocnfrac(i,lat)                =  arget_spmd(i,14,lat) ! Surface type fraction          srfflx_state2d(lat)%tref(i)   =  arget_spmd(i,15,lat) ! Surface state variable       end do    end do#else!$OMP PARALLEL DO PRIVATE(lat,i)    do lat=beglat,endlat       do i=1,nlon(lat)          srfflx_state2d(lat)%wsx(i)    = -arget(i,lat,1) ! Atmosphere-surface flux          srfflx_state2d(lat)%wsy(i)    = -arget(i,lat,2) ! Atmosphere-surface flux          srfflx_state2d(lat)%lhf(i)    = -arget(i,lat,3) ! Atmosphere-surface flux          srfflx_state2d(lat)%shf(i)    = -arget(i,lat,4) ! Atmosphere-surface flux          srfflx_state2d(lat)%lwup(i)   = -arget(i,lat,5) ! Atmosphere-surface flux          srfflx_state2d(lat)%cflx(i,1) = -arget(i,lat,6) ! Atmosphere-surface flux          srfflx_state2d(lat)%asdir(i)  =  arget(i,lat,7) ! Surface state variable          srfflx_state2d(lat)%aldir(i)  =  arget(i,lat,8) ! Surface state variable          srfflx_state2d(lat)%asdif(i)  =  arget(i,lat,9) ! Surface state variable          srfflx_state2d(lat)%aldif(i)  =  arget(i,lat,10) ! Surface state variable          srfflx_state2d(lat)%ts(i)     =  arget(i,lat,11) ! Surface state variable          snowhland(i,lat)              =  arget(i,lat,12) ! Surface state variable          icefrac(i,lat)                =  arget(i,lat,13) ! Surface type fraction          ocnfrac(i,lat)                =  arget(i,lat,14) ! Surface type fraction          srfflx_state2d(lat)%tref(i)   =  arget(i,lat,15) ! Surface state variable       end do    end do#endif!! Set snowh over ice to zero since flux coupler only returns snowh over land!    snowhice(:,:) = 0.0!!    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       end do    end do!! Determine if stop at end of day!    if ( (.not. csmstop) .and. (ibuff(2)/=0) ) then       csmstop = .true.       if (masterproc) write(6,*) &       '(CCSMRCV): received stop at end of day signal from flux coupler'    end if!! Determine if write restart at end of day!    if ( (.not. csmrstrt) .and. (ibuff(21)/=0) ) then       csmrstrt = .true.       if (masterproc) write(6,*) &       '(CCSMRCV): received write restart at end of day signal from flux coupler'    else if ( ibuff(21) == 0 )then       csmrstrt = .false.    endif9099 format('[mp timing]  irtc = ',i20,' ',a)    return   end subroutine ccsmrcv  subroutine ccsmsnd!----------------------------------------------------------------------- ! ! Purpose: ! Send the message array to the csm driver.! ! Method: ! On steps where the data is to be sent to the coupler, fill the! message passing array with instantaneous atmospheric states, ! instantaneous downward radiative fluxes, averaged precipitation, ! instantaneous surface states and averaged surface fluxes. ! Condense the data into one array. The coupler has the convention that ! fluxes are positive downward. Note that precc and precl precipitation rates ! in units of m/sec. They are turned into fluxes by multiplying by 1000 kg/m^3.! ! Author: Byron Boville! !-----------------------------------------------------------------------    use comsrf, only: surface_state2d, srfflx_state2d#include <comctl.h>!---------------------------Local workspace-----------------------------    integer i,lat,n         ! indices    integer len             ! temporary length variable    real(r8) totrain        ! total rain    real(r8) totsnow        ! total snow#ifdef SPMD    integer numperlat         ! temporary length variable    integer numsend           ! number of items to send    integer numrecv(0:npes-1) ! number of items to receive    integer displs(0:npes-1)  ! displacement vector#endif!-----------------------------------------------------------------------!! Divide total precipitation and snowfall into rain and snowfall!    if (flxave) then!$OMP PARALLEL DO PRIVATE(lat,i)       do lat = beglat,endlat          do i=1,nlon(lat)             rainconv(i,lat) = ((precca(i,lat) - precsca(i,lat)))*1000.             rainlrsc(i,lat) = ((precla(i,lat) - precsla(i,lat)))*1000.             snowconv(i,lat) = precsca(i,lat)*1000.             snowlrsc(i,lat) = precsla(i,lat)*1000.          end do       end do    else!$OMP PARALLEL DO PRIVATE(lat,i)       do lat = beglat,endlat          do i = 1,nlon(lat)             rainconv(i,lat) = ((surface_state2d(lat)%precc(i) - surface_state2d(lat)%precsc(i)))*1000.             rainlrsc(i,lat) = ((surface_state2d(lat)%precl(i) - surface_state2d(lat)%precsl(i)))*1000.             snowconv(i,lat) = surface_state2d(lat)%precsc(i)*1000.             snowlrsc(i,lat) = surface_state2d(lat)%precsl(i)*1000.          end do       end do    end if!! If averaging flux over several timesteps, ensure rain and snow do not! exist simultaneously to satisfy a limitation in LSM.!    if (flxave) then!$OMP PARALLEL DO PRIVATE(lat,i,totrain,totsnow)       do lat = beglat,endlat          do i = 1,nlon(lat)             totrain = rainconv(i,lat) + rainlrsc(i,lat)              totsnow = snowconv(i,lat) + snowlrsc(i,lat)              if (totrain /= 0. .and. totsnow /= 0.) then                if (totrain >= totsnow) then                   rainconv(i,lat) = rainconv(i,lat) + snowconv(i,lat)                   rainlrsc(i,lat) = rainlrsc(i,lat) + snowlrsc(i,lat)                   prc_err(i,lat)  = snowconv(i,lat) + snowlrsc(i,lat)                   snowconv(i,lat) = 0.                   snowlrsc(i,lat) = 0.                else                   snowconv(i,lat) = snowconv(i,lat) + rainconv(i,lat)                   snowlrsc(i,lat) = snowlrsc(i,lat) + rainlrsc(i,lat)                   prc_err(i,lat)  = rainconv(i,lat) + rainlrsc(i,lat)                   rainconv(i,lat) = 0.                   rainlrsc(i,lat) = 0.                end if             else                prc_err(i,lat)  = 0.             end if          end do       end do    else!$OMP PARALLEL DO PRIVATE(lat)       do lat = beglat,endlat          prc_err(1:nlon(lat),lat)  = 0.       end do    end if#if (defined SPMD)!$OMP PARALLEL DO PRIVATE(lat,i)    do lat = beglat,endlat       do i = 1,nlon(lat)          arput_spmd(i, 1,lat)  =  surface_state2d(lat)%zbot(i)          ! Atmospheric state variable m          arput_spmd(i, 2,lat)  =  surface_state2d(lat)%ubot(i)          ! Atmospheric state variable m/s          arput_spmd(i, 3,lat)  =  surface_state2d(lat)%vbot(i)          ! Atmospheric state variable m/s          arput_spmd(i, 4,lat)  =  surface_state2d(lat)%tbot(i)          ! Atmospheric state variable K          arput_spmd(i, 5,lat)  =  surface_state2d(lat)%thbot(i)         ! Atmospheric state variable K          arput_spmd(i, 6,lat)  =  surface_state2d(lat)%pbot(i)          ! Atmospheric state variable Pa          arput_spmd(i, 7,lat)  =  psl(i,lat)           ! Atmospheric state variable Pa          arput_spmd(i, 8,lat)  =  surface_state2d(lat)%qbot(i)          ! Atmospheric state variable kg/kg          arput_spmd(i, 9,lat)  =  rho(i,lat)           ! Atmospheric state variable kg/m^3          arput_spmd(i,10,lat)  =  netsw(i,lat)         ! Atmospheric flux W/m^2          arput_spmd(i,11,lat)  =  surface_state2d(lat)%flwds(i)         ! Atmospheric flux W/m^2          arput_spmd(i,12,lat)  =  rainconv(i,lat)      ! Atmospheric flux kg/s/m^2            arput_spmd(i,13,lat)  =  rainlrsc(i,lat)      ! Atmospheric flux kg/s/m^2          arput_spmd(i,14,lat)  =  snowconv(i,lat)      ! Atmospheric flux kg/s/m^2          arput_spmd(i,15,lat)  =  snowlrsc(i,lat)      ! Atmospheric flux kg/s/m^2          arput_spmd(i,16,lat)  =  surface_state2d(lat)%soll(i)          ! Atmospheric flux W/m^2          arput_spmd(i,17,lat)  =  surface_state2d(lat)%sols(i)          ! Atmospheric flux W/m^2          arput_spmd(i,18,lat)  =  surface_state2d(lat)%solld(i)         ! Atmospheric flux W/m^2          arput_spmd(i,19,lat)  =  surface_state2d(lat)%solsd(i)         ! Atmospheric flux W/m^2       end do    end do    numperlat = plon*nsnd    call compute_gsfactors (numperlat, numsend, numrecv, displs)    if ( masterproc ) then       call mpigatherv (arput_spmd(1,1,beglat), numsend, mpir8, arput_buf, numrecv, &                        displs, mpir8, 0, mpicom)    else       call mpigatherv (arput_spmd(1,1,beglat), numsend, mpir8, 0.0_r8, numrecv, &                        displs, mpir8, 0, mpicom)    end if    if (masterproc) then       do n = 1,nsnd          do lat = 1,plat             arput(:nlon(lat),lat,n) = arput_buf(:nlon(lat),n,lat)            end do       end do    endif#else!$OMP PARALLEL DO PRIVATE(lat,i)    do lat = beglat,endlat       do i = 1,nlon(lat)          arput(i,lat, 1)  =  surface_state2d(lat)%zbot(i)          ! Atmospheric state variable m          arput(i,lat, 2)  =  surface_state2d(lat)%ubot(i)          ! Atmospheric state variable m/s          arput(i,lat, 3)  =  surface_state2d(lat)%vbot(i)          ! Atmospheric state variable m/s          arput(i,lat, 4)  =  surface_state2d(lat)%tbot(i)          ! Atmospheric state variable K          arput(i,lat, 5)  =  surface_state2d(lat)%thbot(i)         ! Atmospheric state variable K          arput(i,lat, 6)  =  surface_state2d(lat)%pbot(i)          ! Atmospheric state variable Pa          arput(i,lat, 7)  =  psl(i,lat)           ! Atmospheric state variable Pa          arput(i,lat, 8)  =  surface_state2d(lat)%qbot(i)          ! Atmospheric state variable kg/kg          arput(i,lat, 9)  =  rho(i,lat)           ! Atmospheric state variable kg/m^3          arput(i,lat,10)  =  netsw(i,lat)         ! Atmospheric flux W/m^2          arput(i,lat,11)  =  surface_state2d(lat)%flwds(i)         ! Atmospheric flux W/m^2          arput(i,lat,12)  =  rainconv(i,lat)      ! Atmospheric flux kg/s/m^2            arput(i,lat,13)  =  rainlrsc(i,lat)      ! Atmospheric flux kg/s/m^2          arput(i,lat,14)  =  snowconv(i,lat)      ! Atmospheric flux kg/s/m^2          arput(i,lat,15)  =  snowlrsc(i,lat)      ! Atmospheric flux kg/s/m^2          arput(i,lat,16)  =  surface_state2d(lat)%soll(i)          ! Atmospheric flux W/m^2          arput(i,lat,17)  =  surface_state2d(lat)%sols(i)          ! Atmospheric flux W/m^2          arput(i,lat,18)  =  surface_state2d(lat)%solld(i)         ! Atmospheric flux W/m^2          arput(i,lat,19)  =  surface_state2d(lat)%solsd(i)         ! Atmospheric flux W/m^2       end do    end do#endif!! Output to history file the snow and rain actually sent to coupler as well as the! error between what is sent and what is reported on history file in PRECT/PRECS!!$OMP PARALLEL DO PRIVATE(lat)      do lat = beglat,endlat         call outfld('CPLRAINC', rainconv(1,lat), plon, lat)         call outfld('CPLRAINL', rainlrsc(1,lat), plon, lat)         call outfld('CPLSNOWC', snowconv(1,lat), plon, lat)         call outfld('CPLSNOWL', snowlrsc(1,lat), plon, lat)         call outfld('CPLPRCER', prc_err(1,lat) , plon, lat)      end do!! Send buffer to coupler!    if (masterproc) then       call msgsnd    endif!    return  end subroutine ccsmsnd  subroutine ccsmfin!----------------------------------------------------------------------- ! ! Purpose: Send and receive final msgs at end of run.! ! Method: ! The coupler currently expects a final when nlend is true - ! this data is only written out the coupler restart file! restart file and is not used upon restart by the coupler ! for the cam component. The coupler also sends a final msg. ! This data is put into a dummy array! ! Author: Mariana Vertenstein! !-----------------------------------------------------------------------     use time_manager, only: get_nstep, get_prev_date#include <comctl.h>!---------------------------Local workspace-----------------------------    integer nstepcsm                 ! time step sent to flux coupler    integer cdatecsm,cseccsm         ! date,sec at beginning of current timestep    integer yr, mon, day             ! year, month, day components of cdatecsm!-----------------------------------------------------------------------    if (masterproc) then!! Determine final date to send to coupler!       nstepcsm = get_nstep() - 1       call get_prev_date(yr, mon, day, cseccsm)       cdatecsm = yr*10000 + mon*100 + day