zoom_pgd_cover.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_cover (DTCO, UG, U, GCP, &
                                 HPROGRAM,HINIFILE,HINIFILETYPE,OECOCLIMAP)
!     ###########################################################

!!
!!    PURPOSE
!!    -------
!!   This program prepares the physiographic data fields.
!!
!!    METHOD
!!    ------
!!   
!!    EXTERNAL
!!    --------
!!
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!
!!    REFERENCE
!!    ---------
!!
!!    AUTHOR
!!    ------
!!
!!    V. Masson                   Meteo-France
!!
!!    MODIFICATION
!!    ------------
!!
!!    Original     13/10/03
!     Modification 17/04/12 M.Tomasini All COVER physiographic fields are now 
!!                                     interpolated for spawning => 
!!                                     ABOR1_SFX if (.NOT.OECOCLIMAP) in comment
!     Modification 05/02/15 M.Moge : use NSIZE_FULL instead of SIZE(XLAT) (for clarity)
!!      J.Escobar 18/12/2015 : missing interface
!----------------------------------------------------------------------------
!
!*    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_grid_conf_proj_n, ONLY : grid_conf_proj_t
!
USE modd_surf_par, ONLY : xundef
USE modd_data_cover_par,   ONLY : jpcover
USE modd_prep,             ONLY : cingrid_type, cinterp_type
!
USE mode_read_surf_cov, ONLY : read_surf_cov
!
USE modi_convert_cover_frac
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_old_name
USE modi_sum_on_all_procs
USE modi_get_luout
USE modi_clean_prep_output_grid
USE modi_get_1d_mask
USE modi_read_lcover
#ifdef SFX_MNH
USE modi_read_surfx2cov_1cov_mnh
#endif
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
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(grid_conf_proj_t),INTENT(INOUT) :: GCP
!
 CHARACTER(LEN=6),     INTENT(IN)  :: HPROGRAM    ! program calling
 CHARACTER(LEN=28),    INTENT(IN)  :: HINIFILE    ! input atmospheric file name
 CHARACTER(LEN=6),     INTENT(IN)  :: HINIFILETYPE! input atmospheric file type
LOGICAL,              INTENT(OUT) :: OECOCLIMAP  ! flag to use ecoclimap
!
!
!*    0.2    Declaration of local variables
!            ------------------------------
!
INTEGER :: ICPT1
INTEGER :: IRESP
INTEGER :: ILUOUT
INTEGER :: INI     ! total 1D dimension (input grid)
INTEGER :: IL      ! total 1D dimension (output grid)
INTEGER :: JCOVER  ! loop counter
INTEGER :: IVERSION       ! surface version
#ifdef MNH_PARALLEL
REAL, DIMENSION(:), POINTER  :: ZCOVER1D
#endif
REAL, DIMENSION(:,:), POINTER     :: ZCOVER
REAL, DIMENSION(:,:), POINTER :: ZSEA1, ZWATER1, ZNATURE1, ZTOWN1
REAL, DIMENSION(:,:), POINTER :: ZSEA2, ZWATER2, ZNATURE2, ZTOWN2
REAL, DIMENSION(:),   ALLOCATABLE :: ZSUM
 CHARACTER(LEN=12)  :: YRECFM         ! Name of the article to be read
 CHARACTER(LEN=100) :: YCOMMENT
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!------------------------------------------------------------------------------
IF (lhook) CALL dr_hook('ZOOM_PGD_COVER',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.
!
 CALL open_aux_io_surf(hinifile,hinifiletype,'FULL  ')
!
 CALL read_surf(hprogram,'ECOCLIMAP',oecoclimap,iresp)
!
!------------------------------------------------------------------------------
!
!*      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 cover
!              ----------------
!
yrecfm='VERSION'
 CALL read_surf(hprogram,yrecfm,iversion,iresp)
!
ALLOCATE(u%LCOVER(jpcover))
!
 CALL old_name(hprogram,'COVER_LIST      ',yrecfm)
 CALL read_lcover(hprogram,u%LCOVER)
!
#ifndef MNH_PARALLEL
ALLOCATE(zcover(ini,count(u%LCOVER)))
 CALL read_surf_cov(hprogram,yrecfm,zcover(:,:),u%LCOVER,iresp,hdir='A')
#endif
!
ALLOCATE(zsea1(ini,1))
ALLOCATE(znature1(ini,1))
ALLOCATE(zwater1(ini,1))
ALLOCATE(ztown1(ini,1))
!
IF (iversion>=7) THEN
  CALL read_surf(hprogram,'FRAC_SEA   ',zsea1(:,1),   iresp,hdir='A')
  CALL read_surf(hprogram,'FRAC_NATURE',znature1(:,1),iresp,hdir='A')
  CALL read_surf(hprogram,'FRAC_WATER ',zwater1(:,1), iresp,hdir='A')
  CALL read_surf(hprogram,'FRAC_TOWN  ',ztown1(:,1),  iresp,hdir='A')
  !
ELSE
#ifndef MNH_PARALLEL
  CALL convert_cover_frac(dtco,zcover,u%LCOVER,zsea1(:,1),znature1(:,1),ztown1(:,1),zwater1(:,1))
#endif
ENDIF
!
!------------------------------------------------------------------------------
!
!*      4.     Interpolations
!              --------------
!
il = u%NSIZE_FULL
ALLOCATE(u%XCOVER(il,count(u%LCOVER)))
!
! on lit les cover une apres l'autre, et on appelle hor_interpol sur chaque cover separement
!
#ifdef MNH_PARALLEL
IF ( hprogram == 'MESONH' ) THEN
  ALLOCATE(zcover1d(ini))
  icpt1 = 0
  DO jcover=1,jpcover
    IF ( u%LCOVER( jcover ) ) THEN
      icpt1 = icpt1 + 1
      CALL read_surfx2cov_1cov_mnh(yrecfm,ini,jcover,zcover1d(:),iresp,ycomment,'A')
      CALL hor_interpol(dtco, u,gcp,iluout,spread(zcover1d,2,1),u%XCOVER(:,icpt1:icpt1))
    ENDIF
    !
  ENDDO 
  DEALLOCATE(zcover1d)
ENDIF
#else
 CALL hor_interpol(dtco, u, gcp, iluout,zcover,u%XCOVER)
DEALLOCATE(zcover)
#endif
!
 CALL close_aux_io_surf(hinifile,hinifiletype)
!
ALLOCATE(zcover(il,count(u%LCOVER)))
!
ALLOCATE(zsea2(il,1))
ALLOCATE(znature2(il,1))
ALLOCATE(zwater2(il,1))
ALLOCATE(ztown2(il,1))
!
 CALL hor_interpol(dtco, u, gcp, iluout,zsea1,zsea2)
 CALL hor_interpol(dtco, u, gcp, iluout,znature1,znature2)
 CALL hor_interpol(dtco, u, gcp, iluout,zwater1,zwater2)
 CALL hor_interpol(dtco, u, gcp, iluout,ztown1,ztown2)
!
DEALLOCATE(zsea1)
DEALLOCATE(znature1)
DEALLOCATE(zwater1)
DEALLOCATE(ztown1)
!
ALLOCATE(u%XSEA   (il))
ALLOCATE(u%XNATURE(il))
ALLOCATE(u%XWATER (il))
ALLOCATE(u%XTOWN  (il))
!
u%XSEA(:)   = zsea2(:,1)
u%XNATURE(:)= znature2(:,1)
u%XWATER(:) = zwater2(:,1)
u%XTOWN(:)  = ztown2(:,1)
!
DEALLOCATE(zsea2)
DEALLOCATE(znature2)
DEALLOCATE(zwater2)
DEALLOCATE(ztown2)
!
 CALL clean_prep_output_grid
!------------------------------------------------------------------------------
!
!*      5.     Coherence check
!              ---------------
! 
ALLOCATE(zsum(il))
zsum = 0.
DO jcover=1,SIZE(u%XCOVER,2)
  zsum(:) = zsum(:) + u%XCOVER(:,jcover)
END DO
!
DO jcover=1,SIZE(u%XCOVER,2)
  WHERE(zsum(:)/=0.)  u%XCOVER(:,jcover) = u%XCOVER(:,jcover)/zsum(:)
END DO
!
!------------------------------------------------------------------------------
!
!*      6.     Fractions
!              ---------
!
! When the model runs in multiproc, NSIZE* represents the number of points
! on a proc, and NDIM* the total number of points on all procs.
! The following definition of NDIM* won't be correct any more when the PGD
! runs in multiproc.
!
u%NSIZE_NATURE    = count(u%XNATURE(:) > 0.0)
u%NSIZE_WATER     = count(u%XWATER (:) > 0.0)
u%NSIZE_SEA       = count(u%XSEA   (:) > 0.0)
u%NSIZE_TOWN      = count(u%XTOWN  (:) > 0.0)
u%NSIZE_FULL      = il
!
u%NDIM_NATURE    = sum_on_all_procs(hprogram,ug%G%CGRID,u%XNATURE(:) > 0., 'DIM')
u%NDIM_WATER     = sum_on_all_procs(hprogram,ug%G%CGRID,u%XWATER (:) > 0., 'DIM')
u%NDIM_SEA       = sum_on_all_procs(hprogram,ug%G%CGRID,u%XSEA   (:) > 0., 'DIM')
u%NDIM_TOWN      = sum_on_all_procs(hprogram,ug%G%CGRID,u%XTOWN  (:) > 0., 'DIM')
zsum=1.
u%NDIM_FULL      = sum_on_all_procs(hprogram,ug%G%CGRID,zsum(:) ==1., 'DIM')
DEALLOCATE(zsum)
!
ALLOCATE(u%NR_NATURE (u%NSIZE_NATURE))
ALLOCATE(u%NR_TOWN   (u%NSIZE_TOWN  ))
ALLOCATE(u%NR_WATER  (u%NSIZE_WATER ))
ALLOCATE(u%NR_SEA    (u%NSIZE_SEA   ))
!
IF (u%NSIZE_SEA   >0)CALL get_1d_mask( u%NSIZE_SEA,    u%NSIZE_FULL, u%XSEA   , u%NR_SEA   )
IF (u%NSIZE_WATER >0)CALL get_1d_mask( u%NSIZE_WATER,  u%NSIZE_FULL, u%XWATER , u%NR_WATER )
IF (u%NSIZE_TOWN  >0)CALL get_1d_mask( u%NSIZE_TOWN,   u%NSIZE_FULL, u%XTOWN  , u%NR_TOWN  )
IF (u%NSIZE_NATURE>0)CALL get_1d_mask( u%NSIZE_NATURE, u%NSIZE_FULL, u%XNATURE, u%NR_NATURE)
IF (lhook) CALL dr_hook('ZOOM_PGD_COVER',1,zhook_handle)

!_______________________________________________________________________________
!
END SUBROUTINE zoom_pgd_cover