zoom_pgd_orography.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 zoom_pgd_orography (DTCO, UG, U, USS, GCP, &
                                     HPROGRAM,PSEA,PWATER,HINIFILE,HINIFILETYPE)
!     ###########################################################

!!
!!    PURPOSE
!!    -------
!!   This program prepares the physiographic data fields.
!!
!!    METHOD
!!    ------
!!   
!!    EXTERNAL
!!    --------
!!
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!
!!    REFERENCE
!!    ---------
!!
!!    AUTHOR
!!    ------
!!
!!    V. Masson                   Meteo-France
!!
!!    MODIFICATION
!!    ------------
!!
!!    Original     13/10/03
!----------------------------------------------------------------------------
!
!*    0.     DECLARATION
!            -----------
!
USE modd_data_cover_n, ONLY : data_cover_t
!
USE modd_surf_atm_grid_n, ONLY : surf_atm_grid_t
USE modd_surf_atm_n, ONLY : surf_atm_t
USE modd_sso_n, ONLY : sso_t
USE modd_grid_conf_proj_n, ONLY : grid_conf_proj_t
!
USE modd_prep,             ONLY : cingrid_type, cinterp_type, linterp
USE modd_surf_par,         ONLY : xundef
!
USE modi_open_aux_io_surf
USE modi_read_surf
USE modi_close_aux_io_surf
USE modi_prep_grid_extern
USE modi_hor_interpol
USE modi_prep_output_grid
USE modi_goto_model_mnh
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
USE modi_clean_prep_output_grid
!
USE modi_get_luout
IMPLICIT NONE
!
!*    0.1    Declaration of dummy arguments
!            ------------------------------
!
TYPE(data_cover_t), INTENT(INOUT) :: DTCO
!
TYPE(surf_atm_grid_t), INTENT(INOUT) :: UG
TYPE(surf_atm_t), INTENT(INOUT) :: U
TYPE(sso_t), INTENT(INOUT) :: USS
TYPE(grid_conf_proj_t),INTENT(INOUT) :: GCP
!
 CHARACTER(LEN=6),     INTENT(IN)  :: HPROGRAM    ! program calling
REAL, DIMENSION(:),   INTENT(IN)  :: PSEA        ! sea fraction
REAL, DIMENSION(:),   INTENT(IN)  :: PWATER      ! inland water fraction
 CHARACTER(LEN=28),    INTENT(IN)  :: HINIFILE    ! input atmospheric file name
 CHARACTER(LEN=6),     INTENT(IN)  :: HINIFILETYPE! input atmospheric file type
!
!
!*    0.2    Declaration of local variables
!            ------------------------------
!
INTEGER :: IINFO_ll
INTEGER :: IRESP
INTEGER :: ILUOUT
INTEGER :: INI     ! total 1D dimension (input field)
INTEGER :: IL      ! total 1D dimension (output field)
REAL, DIMENSION(:), POINTER :: ZZS
REAL, DIMENSION(:), POINTER :: ZAVG_ZS
REAL, DIMENSION(:), POINTER :: ZSIL_ZS
REAL, DIMENSION(:), POINTER :: ZSSO_STDEV
REAL, DIMENSION(:), POINTER :: ZMIN_ZS
REAL, DIMENSION(:), POINTER :: ZMAX_ZS
REAL, DIMENSION(:), POINTER :: ZSSO_ANIS
REAL, DIMENSION(:), POINTER :: ZSSO_DIR
REAL, DIMENSION(:), POINTER :: ZSSO_SLOPE
REAL, DIMENSION(:), POINTER :: ZAOSIP
REAL, DIMENSION(:), POINTER :: ZAOSIM
REAL, DIMENSION(:), POINTER :: ZAOSJP
REAL, DIMENSION(:), POINTER :: ZAOSJM
REAL, DIMENSION(:), POINTER :: ZHO2IP
REAL, DIMENSION(:), POINTER :: ZHO2IM
REAL, DIMENSION(:), POINTER :: ZHO2JP
REAL, DIMENSION(:), POINTER :: ZHO2JM
 CHARACTER(LEN=12) :: YRECFM         ! Name of the article to be read
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!------------------------------------------------------------------------------
IF (lhook) CALL dr_hook('ZOOM_PGD_OROGRAPHY',0,zhook_handle)
 CALL get_luout(hprogram,iluout)
!
!*      1.     Preparation of IO for reading in the file
!              -----------------------------------------
!
!* Note that all points are read, even those without physical meaning.
!  These points will not be used during the horizontal interpolation step.
!  Their value must be defined as XUNDEF.
!
! get the local sizes of model 1
 CALL goto_model_mnh(u,hprogram, 1, iinfo_ll)
 CALL open_aux_io_surf(hinifile,hinifiletype,'FULL  ')
!
!------------------------------------------------------------------------------
!
!*      2.     Reading of grid
!              ---------------
!
 CALL prep_output_grid(ug%G, ug%G, u%NSIZE_FULL, iluout)
!
 CALL prep_grid_extern(gcp,hinifiletype,iluout,cingrid_type,cinterp_type,ini)
!
!------------------------------------------------------------------------------
!
!*      3.     Reading of orographic parameters
!              --------------------------------
!
ALLOCATE(zzs(ini))
!
ALLOCATE(zavg_zs(ini))
ALLOCATE(zsil_zs(ini))
ALLOCATE(zsso_stdev(ini))
ALLOCATE(zmin_zs(ini))
ALLOCATE(zmax_zs(ini))
!
ALLOCATE(zsso_anis(ini))
ALLOCATE(zsso_dir(ini))
ALLOCATE(zsso_slope(ini))
!
ALLOCATE(zaosip(ini))
ALLOCATE(zaosim(ini))
ALLOCATE(zaosjp(ini))
ALLOCATE(zaosjm(ini))
ALLOCATE(zho2ip(ini))
ALLOCATE(zho2im(ini))
ALLOCATE(zho2jp(ini))
ALLOCATE(zho2jm(ini))
!
yrecfm='ZS'
 CALL read_surf(hprogram,yrecfm,zzs,iresp,hdir='A')
!
yrecfm='AVG_ZS'
 CALL read_surf(hprogram,yrecfm,zavg_zs,iresp,hdir='A')
yrecfm='SIL_ZS'
 CALL read_surf(hprogram,yrecfm,zsil_zs,iresp,hdir='A')
yrecfm='SSO_STDEV'
 CALL read_surf(hprogram,yrecfm,zsso_stdev,iresp,hdir='A')
yrecfm='MIN_ZS'
 CALL read_surf(hprogram,yrecfm,zmin_zs,iresp,hdir='A')
yrecfm='MAX_ZS'
 CALL read_surf(hprogram,yrecfm,zmax_zs,iresp,hdir='A')
!
yrecfm='SSO_ANIS'
 CALL read_surf(hprogram,yrecfm,zsso_anis,iresp,hdir='A')
yrecfm='SSO_DIR'
 CALL read_surf(hprogram,yrecfm,zsso_dir,iresp,hdir='A')
yrecfm='SSO_SLOPE'
 CALL read_surf(hprogram,yrecfm,zsso_slope,iresp,hdir='A')
!
yrecfm='AOSIP'
 CALL read_surf(hprogram,yrecfm,zaosip,iresp,hdir='A')
yrecfm='AOSIM'
 CALL read_surf(hprogram,yrecfm,zaosim,iresp,hdir='A')
yrecfm='AOSJP'
 CALL read_surf(hprogram,yrecfm,zaosjp,iresp,hdir='A')
yrecfm='AOSJM'
 CALL read_surf(hprogram,yrecfm,zaosjm,iresp,hdir='A')
yrecfm='HO2IP'
 CALL read_surf(hprogram,yrecfm,zho2ip,iresp,hdir='A')
yrecfm='HO2IM'
 CALL read_surf(hprogram,yrecfm,zho2im,iresp,hdir='A')
yrecfm='HO2JP'
 CALL read_surf(hprogram,yrecfm,zho2jp,iresp,hdir='A')
yrecfm='HO2JM'
 CALL read_surf(hprogram,yrecfm,zho2jm,iresp,hdir='A')
!
 CALL close_aux_io_surf(hinifile,hinifiletype)
!------------------------------------------------------------------------------
!
!*      4.     Interpolations
!              --------------
!
il = SIZE(ug%G%XLAT)
!
ALLOCATE(u%XZS        (il))
!
ALLOCATE(uss%XAVG_ZS    (il))
ALLOCATE(uss%XSIL_ZS    (il))
ALLOCATE(uss%XSSO_STDEV (il))
ALLOCATE(uss%XMIN_ZS    (il))
ALLOCATE(uss%XMAX_ZS    (il))
!
ALLOCATE(uss%XSSO_ANIS  (il))
ALLOCATE(uss%XSSO_DIR   (il))
ALLOCATE(uss%XSSO_SLOPE (il))
!
ALLOCATE(uss%XAOSIP     (il))
ALLOCATE(uss%XAOSIM     (il))
ALLOCATE(uss%XAOSJP     (il))
ALLOCATE(uss%XAOSJM     (il))
ALLOCATE(uss%XHO2IP     (il))
ALLOCATE(uss%XHO2IM     (il))
ALLOCATE(uss%XHO2JP     (il))
ALLOCATE(uss%XHO2JM     (il))
!
 CALL zoom(iluout,zzs,u%XZS)
 CALL zoom(iluout,zavg_zs,uss%XAVG_ZS)
 CALL zoom(iluout,zsil_zs,uss%XSIL_ZS)
 CALL zoom(iluout,zmin_zs,uss%XMIN_ZS)
 CALL zoom(iluout,zmax_zs,uss%XMAX_ZS)
!
linterp(:)=(psea(:)<1.)
 CALL zoom(iluout,zsso_stdev,uss%XSSO_STDEV)
 CALL zoom(iluout,zsso_anis,uss%XSSO_ANIS)
 CALL zoom(iluout,zsso_dir,uss%XSSO_DIR)
 CALL zoom(iluout,zsso_slope,uss%XSSO_SLOPE)
 CALL zoom(iluout,zaosip,uss%XAOSIP)
 CALL zoom(iluout,zaosim,uss%XAOSIM)
 CALL zoom(iluout,zaosjp,uss%XAOSJP)
 CALL zoom(iluout,zaosjm,uss%XAOSJM)
 CALL zoom(iluout,zho2ip,uss%XHO2IP)
 CALL zoom(iluout,zho2im,uss%XHO2IM)
 CALL zoom(iluout,zho2jp,uss%XHO2JP)
 CALL zoom(iluout,zho2jm,uss%XHO2JM)
!
!* coherence with land sea mask
!
WHERE(psea==1.) u%XZS=0.
WHERE(psea(:)==1.) uss%XSSO_STDEV(:) = xundef
WHERE(pwater(:)==1.) uss%XSSO_STDEV(:) = 0.
WHERE(psea(:)>0.) uss%XMIN_ZS(:) = 0.
WHERE(psea(:)==1.) uss%XMAX_ZS(:) = 0.
!
WHERE (psea(:)==1.)
  uss%XSSO_ANIS (:) = xundef
  uss%XSSO_DIR  (:) = xundef
  uss%XSSO_SLOPE(:) = xundef
END WHERE
!
WHERE (pwater(:)==1.)
  uss%XSSO_ANIS (:) = 1.
  uss%XSSO_DIR  (:) = 0.
  uss%XSSO_SLOPE(:) = 0.
END WHERE
!
WHERE (psea(:)==1.)
  uss%XHO2IP(:) = xundef
  uss%XHO2IM(:) = xundef
  uss%XHO2JP(:) = xundef
  uss%XHO2JM(:) = xundef
  uss%XAOSIP(:) = xundef
  uss%XAOSIM(:) = xundef
  uss%XAOSJP(:) = xundef
  uss%XAOSJM(:) = xundef
END WHERE
!
WHERE (pwater(:)==1.)
  uss%XHO2IP(:) = 0.
  uss%XHO2IM(:) = 0.
  uss%XHO2JP(:) = 0.
  uss%XHO2JM(:) = 0.
  uss%XAOSIP(:) = 0.
  uss%XAOSIM(:) = 0.
  uss%XAOSJP(:) = 0.
  uss%XAOSJM(:) = 0.
END WHERE
!
! go back to child model
 CALL goto_model_mnh(u,hprogram, 2, iinfo_ll)
!_______________________________________________________________________________
DEALLOCATE(zzs        )
!
DEALLOCATE(zavg_zs    )
DEALLOCATE(zsil_zs    )
DEALLOCATE(zsso_stdev )
DEALLOCATE(zmin_zs    )
DEALLOCATE(zmax_zs    )
!
DEALLOCATE(zsso_anis  )
DEALLOCATE(zsso_dir   )
DEALLOCATE(zsso_slope )
!
DEALLOCATE(zaosip     )
DEALLOCATE(zaosim     )
DEALLOCATE(zaosjp     )
DEALLOCATE(zaosjm     )
DEALLOCATE(zho2ip     )
DEALLOCATE(zho2im     )
DEALLOCATE(zho2jp     )
DEALLOCATE(zho2jm     )
!_______________________________________________________________________________
 CALL clean_prep_output_grid
!_______________________________________________________________________________
IF (lhook) CALL dr_hook('ZOOM_PGD_OROGRAPHY',1,zhook_handle)
CONTAINS
!
SUBROUTINE zoom(KLUOUT,PFIELDIN,PFIELDOUT)
INTEGER, INTENT(IN)             :: KLUOUT
REAL, DIMENSION(:), POINTER     :: PFIELDIN
REAL, DIMENSION(:), INTENT(OUT) :: PFIELDOUT
REAL, DIMENSION(:,:), POINTER   :: ZFIELDIN
REAL, DIMENSION(:,:), POINTER   :: ZFIELDOUT
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (lhook) CALL dr_hook('ZOOM',0,zhook_handle)
ALLOCATE(zfieldin(SIZE(pfieldin, 1),1))
ALLOCATE(zfieldout(SIZE(pfieldout,1),1))
zfieldin(:,1) = pfieldin(:)
 CALL hor_interpol(dtco, u, gcp, kluout,zfieldin,zfieldout)
pfieldout(:) = zfieldout(:,1)
DEALLOCATE(zfieldin )
DEALLOCATE(zfieldout)
IF (lhook) CALL dr_hook('ZOOM',1,zhook_handle)

END SUBROUTINE zoom
!
END SUBROUTINE zoom_pgd_orography