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, &
                                 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
!----------------------------------------------------------------------------
!
!*    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_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 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
!
 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, icpt2
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
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
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_grid_extern(&
                       hinifiletype,iluout,cingrid_type,cinterp_type,ini)
!
 CALL prep_output_grid(ug, u, &
                       iluout,ug%CGRID,ug%XGRID_PAR,ug%XLAT,ug%XLON)
!
!------------------------------------------------------------------------------
!
!*      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_surf(&
                hprogram,yrecfm,u%LCOVER(:),iresp,hdir='-')
!
ALLOCATE(zcover(ini,count(u%LCOVER)))
 CALL read_surf_cov(&
                    hprogram,yrecfm,zcover(:,:),u%LCOVER,iresp,hdir='A')
!
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
  CALL convert_cover_frac(dtco, &
                          zcover,u%LCOVER,zsea1(:,1),znature1(:,1),ztown1(:,1),zwater1(:,1))
ENDIF
!
 CALL close_aux_io_surf(hinifile,hinifiletype)
!------------------------------------------------------------------------------
!
!*      4.     Interpolations
!              --------------
!
il = SIZE(ug%XLAT)
ALLOCATE(u%XCOVER(il,count(u%LCOVER)))
!
 CALL hor_interpol(dtco, u, &
                   iluout,zcover,u%XCOVER)
!
DEALLOCATE(zcover)
!
ALLOCATE(zcover(il,count(u%LCOVER)))
icpt1 = 0
icpt2 = 0
DO jcover = 1,jpcover
  IF (u%LCOVER(jcover)) THEN
    icpt1 = icpt1 + 1
    IF (all(u%XCOVER(:,icpt1)==0.)) THEN
      u%LCOVER(jcover) = .false.
    ELSE
      icpt2 = icpt2 + 1
      zcover(:,icpt2) = u%XCOVER(:,icpt1)
    ENDIF
  ENDIF
ENDDO
!
DEALLOCATE(u%XCOVER)
ALLOCATE(u%XCOVER(il,icpt2))
u%XCOVER(:,:) = zcover(:,1:icpt2)
DEALLOCATE(zcover)
!
ALLOCATE(zsea2(il,1))
ALLOCATE(znature2(il,1))
ALLOCATE(zwater2(il,1))
ALLOCATE(ztown2(il,1))
!
 CALL hor_interpol(dtco, u, &
                   iluout,zsea1,zsea2)
 CALL hor_interpol(dtco, u, &
                   iluout,znature1,znature2)
 CALL hor_interpol(dtco, u, &
                   iluout,zwater1,zwater2)
 CALL hor_interpol(dtco, u, &
                   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
!
DO jcover=1,SIZE(u%XCOVER,2)
  IF (all(u%XCOVER(:,jcover)==0.)) u%LCOVER(jcover) = .false.
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%CGRID,u%XNATURE(:) > 0., 'DIM')
u%NDIM_WATER     = sum_on_all_procs(hprogram,ug%CGRID,u%XWATER (:) > 0., 'DIM')
u%NDIM_SEA       = sum_on_all_procs(hprogram,ug%CGRID,u%XSEA   (:) > 0., 'DIM')
u%NDIM_TOWN      = sum_on_all_procs(hprogram,ug%CGRID,u%XTOWN  (:) > 0., 'DIM')
zsum=1.
u%NDIM_FULL      = sum_on_all_procs(hprogram,ug%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