assim_surf_atmn.F90

Go to the documentation of this file.

!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt  
!SFX_LIC for details. version 1.
!     #################################################################################
SUBROUTINE assim_surf_atm_n (DGMI, IG, I, S, U, T, TOP, W, &
                             hprogram, ki,                                               &
                            pcon_rain, pstrat_rain, pcon_snow, pstrat_snow,             &
                            pclouds,   plsm,        pevaptr,   pevap,                   &
                            pswec,     ptsc,                                            &
                            pts,       pt2m,        phu2m,     pswe,                    &
                            psst,      psic,  pucls, pvcls,                             &
                            htest , od_maskext, plon, plat, olkeepextzone )
!     #################################################################################
!
!
!!****  *ASSIM_SURF_ATM_n * - Driver to call the schemes for the 
!!       four surface types (SEA, WATER, NATURE, TOWN)
!!
!!    PURPOSE
!!    -------
!!
!!**  METHOD
!!    ------
!!
!!    REFERENCE
!!    ---------
!!      
!!
!!    AUTHOR
!!    ------
!!     T. Aspelien 
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    04/2012
!!-------------------------------------------------------------
!
!
!
!
!
USE modd_diag_misc_isba_n, ONLY : diag_misc_isba_t
USE modd_isba_grid_n, ONLY : isba_grid_t
USE modd_isba_n, ONLY : isba_t
USE modd_seaflux_n, ONLY : seaflux_t
USE modd_surf_atm_n, ONLY : surf_atm_t
USE modd_teb_n, ONLY : teb_t
USE modd_teb_option_n, ONLY : teb_options_t
USE modd_watflux_n, ONLY : watflux_t
!
USE modd_surfex_mpi,  ONLY : nrank, npio
!
USE modd_surf_conf,      ONLY : cprogname
!
USE modd_assim,          ONLY : xat2m_isba, xahu2m_isba, xazon10m_isba, xamer10m_isba, xat2m_teb, larome
!
!RJ: unneeded?
!
USE modi_abor1_sfx
USE modi_assim_sea_n
USE modi_assim_inland_water_n
USE modi_assim_nature_n
USE modi_assim_town_n
!
USE yomhook,             ONLY : lhook,   dr_hook
USE parkind1,            ONLY : jprb
!
IMPLICIT NONE
!
!*      0.1    declarations of arguments
!
!
TYPE(diag_misc_isba_t), INTENT(INOUT) :: dgmi
TYPE(isba_grid_t), INTENT(INOUT) :: ig
TYPE(isba_t), INTENT(INOUT) :: i
TYPE(seaflux_t), INTENT(INOUT) :: s
TYPE(surf_atm_t), INTENT(INOUT) :: u
TYPE(teb_t), INTENT(INOUT) :: t
TYPE(teb_options_t), INTENT(INOUT) :: top
TYPE(watflux_t), INTENT(INOUT) :: w
!
 CHARACTER(LEN=6),    INTENT(IN) :: hprogram     ! program calling surf. schemes
INTEGER,             INTENT(IN) :: ki
REAL, DIMENSION(KI), INTENT(IN) :: pcon_rain
REAL, DIMENSION(KI), INTENT(IN) :: pstrat_rain
REAL, DIMENSION(KI), INTENT(IN) :: pcon_snow
REAL, DIMENSION(KI), INTENT(IN) :: pstrat_snow
REAL, DIMENSION(KI), INTENT(IN) :: pclouds
REAL, DIMENSION(KI), INTENT(IN) :: plsm
REAL, DIMENSION(KI), INTENT(IN) :: pevaptr
REAL, DIMENSION(KI), INTENT(IN) :: pevap
REAL, DIMENSION(KI), INTENT(IN) :: pswec
REAL, DIMENSION(KI), INTENT(IN) :: ptsc
REAL, DIMENSION(KI), INTENT(IN) :: pts
REAL, DIMENSION(KI), INTENT(IN) :: pt2m
REAL, DIMENSION(KI), INTENT(IN) :: phu2m
REAL, DIMENSION(KI), INTENT(IN) :: pswe
REAL, DIMENSION(KI), INTENT(IN) :: psst
REAL, DIMENSION(KI), INTENT(IN) :: psic
REAL, DIMENSION(KI), INTENT(IN) :: pucls
REAL, DIMENSION(KI), INTENT(IN) :: pvcls
 CHARACTER(LEN=2),   INTENT(IN)  :: htest        ! must be equal to 'OK'
LOGICAL,  DIMENSION (KI), INTENT(IN) ::  od_maskext
REAL(KIND=JPRB), DIMENSION (:), INTENT(IN) ::  plon
REAL(KIND=JPRB), DIMENSION (:), INTENT(IN) ::  plat
LOGICAL, INTENT(IN) :: olkeepextzone
!
!*      0.2    declarations of local variables
!
INTEGER :: jtile                        ! loop on type of surface
LOGICAL :: gnature, gtown, gwater, gsea ! .T. if the corresponding surface is represented
REAL(KIND=JPRB) :: zhook_handle
!
!-------------------------------------------------------------------------------------
IF (lhook) CALL dr_hook('ASSIM_SURF_ATM_N',0,zhook_handle)
!
 cprogname = hprogram
!
IF (htest/='OK') THEN
  CALL abor1_sfx('ASSIM_SURF_ATMN: FATAL ERROR DURING ARGUMENT TRANSFER')
END IF
!
!-------------------------------------------------------------------------------------
! Preliminaries: Tile related operations
!-------------------------------------------------------------------------------------

! FLAGS for the various surfaces:
!
gsea      = u%NDIM_SEA    >0
gwater    = u%NDIM_WATER  >0
gtown     = u%NDIM_TOWN   >0
gnature   = u%NDIM_NATURE >0
!
! Tile counter:
!
jtile     = 0 
!
!--------------------------------------------------------------------------------------
! Call interfaces for sea, water, nature and town here...
!--------------------------------------------------------------------------------------
!
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
! SEA Tile calculations:
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
!
jtile = jtile + 1
!
IF(gsea)THEN
!
  CALL assim_treat_surf(jtile,u%NSIZE_SEA,u%NR_SEA)
!
ENDIF
!
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
! INLAND WATER Tile calculations:
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
!
jtile = jtile + 1
!
IF(gwater)THEN
!
  CALL assim_treat_surf(jtile,u%NSIZE_WATER,u%NR_WATER)
!
ENDIF 
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
! NATURAL SURFACE Tile calculations:
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
!
jtile = jtile + 1
!
IF(gnature)THEN
!
  CALL assim_treat_surf(jtile,u%NSIZE_NATURE,u%NR_NATURE)

  IF ( ALLOCATED(xat2m_isba))    DEALLOCATE(xat2m_isba)
  IF ( ALLOCATED(xahu2m_isba))   DEALLOCATE(xahu2m_isba)
  IF ( ALLOCATED(xazon10m_isba)) DEALLOCATE(xazon10m_isba)
  IF ( ALLOCATED(xamer10m_isba)) DEALLOCATE(xamer10m_isba)
!
ENDIF 
!
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
! URBAN Tile calculations:
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
!
jtile = jtile + 1
!
IF(gtown)THEN
!
  CALL assim_treat_surf(jtile,u%NSIZE_TOWN,u%NR_TOWN)

  IF ( ALLOCATED(xat2m_teb))    DEALLOCATE(xat2m_teb)
!
ENDIF
!
IF (lhook) CALL dr_hook('ASSIM_SURF_ATM_N',1,zhook_handle)
!
!=======================================================================================
 CONTAINS
!
!=======================================================================================
SUBROUTINE assim_treat_surf(KTILE,KSIZE,KMASK)
!
IMPLICIT NONE
!
INTEGER, INTENT(IN)                   :: ktile
INTEGER, INTENT(IN)                   :: ksize
INTEGER, INTENT(IN), DIMENSION(KSIZE) :: kmask
!
REAL,DIMENSION(KSIZE)                 :: zp_pcon_rain
REAL,DIMENSION(KSIZE)                 :: zp_pstrat_rain
REAL,DIMENSION(KSIZE)                 :: zp_pcon_snow
REAL,DIMENSION(KSIZE)                 :: zp_pstrat_snow
REAL,DIMENSION(KSIZE)                 :: zp_pclouds
REAL,DIMENSION(KSIZE)                 :: zp_plsm
REAL,DIMENSION(KSIZE)                 :: zp_pevaptr
REAL,DIMENSION(KSIZE)                 :: zp_pevap
REAL,DIMENSION(KSIZE)                 :: zp_pswec
REAL,DIMENSION(KSIZE)                 :: zp_ptsc
REAL,DIMENSION(KSIZE)                 :: zp_pts
REAL,DIMENSION(KSIZE)                 :: zp_pt2m
REAL,DIMENSION(KSIZE)                 :: zp_phu2m
REAL,DIMENSION(KSIZE)                 :: zp_pswe
REAL,DIMENSION(KSIZE)                 :: zp_psst
REAL,DIMENSION(KSIZE)                 :: zp_psic
REAL,DIMENSION(KSIZE)                 :: zp_ucls
REAL,DIMENSION(KSIZE)                 :: zp_vcls
REAL,DIMENSION(KSIZE)                 :: zp_lon
REAL,DIMENSION(KSIZE)                 :: zp_lat
LOGICAL,DIMENSION(KSIZE)              :: gd_maskext
INTEGER                               :: jj,ji
!
DO jj=1,ksize
  ji=kmask(jj)
  zp_plsm(jj)        = plsm(ji)  
  zp_pcon_rain(jj)   = pcon_rain(ji)
  zp_pstrat_rain(jj) = pstrat_rain(ji)
  zp_pcon_snow(jj)   = pcon_snow(ji)
  zp_pstrat_snow(jj) = pstrat_snow(ji)
  zp_pclouds(jj)     = pclouds(ji)
  zp_pevaptr(jj)     = pevaptr(ji)
  zp_pevap(jj)       = pevap(ji)
  zp_pswe(jj)        = pswe(ji)  
  zp_pswec(jj)       = pswec(ji)
  zp_ptsc(jj)        = ptsc(ji)
  zp_pts(jj)         = pts(ji) 
  zp_pt2m(jj)        = pt2m(ji)
  zp_phu2m(jj)       = phu2m(ji)
  zp_psst(jj)        = psst(ji)
  zp_psic(jj)        = psic(ji)
  zp_ucls(jj)        = pucls(ji)
  zp_vcls(jj)        = pvcls(ji)
  zp_lon(jj)         = plon(ji)
  zp_lat(jj)         = plat(ji)
  gd_maskext(jj)     = od_maskext(ji)
ENDDO

IF (ktile==1) THEN
  
  IF (nrank==npio) THEN 
    WRITE(*,*) '*********************************************'
    WRITE(*,*) '*      ASSIMILATIONS FOR SEA POINTS         *'
    WRITE(*,*) '*********************************************'
  ENDIF
 
  CALL assim_sea_n(s, u, &
                    hprogram,ksize,zp_pts,zp_psst,zp_psic,zp_plsm,htest,&
                    olkeepextzone,gd_maskext,zp_lon,zp_lat)

ELSEIF (ktile==2) THEN
  
  IF (nrank==npio) THEN
    WRITE(*,*) '*********************************************'  
    WRITE(*,*) '*      ASSIMILATIONS FOR WATER POINTS       *'
    WRITE(*,*) '*********************************************'
  ENDIF

  CALL assim_inland_water_n(i, u, w, &
                            hprogram,ksize,zp_pts,zp_plsm,htest,&
                            olkeepextzone,gd_maskext,zp_lon,zp_lat)

ELSEIF (ktile==3) THEN
  
  IF (nrank==npio) THEN
    WRITE(*,*) '*********************************************'  
    WRITE(*,*) '*      ASSIMILATIONS FOR NATURE POINTS      *'
    WRITE(*,*) '*********************************************'
  ENDIF

  CALL assim_nature_n(dgmi, ig, i, u, &
                      hprogram,ksize,                                             &
                      zp_pcon_rain, zp_pstrat_rain, zp_pcon_snow, zp_pstrat_snow, &
                      zp_pclouds,   zp_plsm,        zp_pevaptr,   zp_pevap,       & 
                      zp_pswec,     zp_ptsc,        zp_ucls,      zp_vcls,        &
                      zp_pts,       zp_pt2m,        zp_phu2m,     zp_pswe,        & 
                      htest, gd_maskext, zp_lon, zp_lat )
  
ELSEIF (ktile==4) THEN
  
  IF (nrank==npio) THEN
    WRITE(*,*) '*********************************************'  
    WRITE(*,*) '*      ASSIMILATIONS FOR URBAN POINTS       *'
    WRITE(*,*) '*********************************************'
  ENDIF

  CALL assim_town_n(u, t, top, &
                    hprogram,ksize,zp_pt2m,htest)
  
ENDIF

END SUBROUTINE assim_treat_surf
!=======================================================================================
END SUBROUTINE assim_surf_atm_n
!=======================================================================================