surf_patch.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.
!#####################
MODULE modi_surf_patch
!#####################
!
INTERFACE surf_patch
      SUBROUTINE surf_patch_2d(KPATCH,PVEGTYPE,PPATCH)

INTEGER               , INTENT(IN)  :: kpatch   ! number of patches
REAL, DIMENSION(:,:,:), INTENT(IN)  :: pvegtype ! vegtype fractions
REAL, DIMENSION(:,:,:), INTENT(OUT) :: ppatch   ! patch weight in nature fraction

END SUBROUTINE surf_patch_2d
      SUBROUTINE surf_patch_1d(KPATCH,PVEGTYPE,PPATCH,PVEGTYPE_PATCH)

INTEGER               , INTENT(IN)  :: kpatch   ! number of patches
REAL, DIMENSION(:,:),   INTENT(IN)  :: pvegtype ! vegtype fractions
REAL, DIMENSION(:,:),   INTENT(OUT) :: ppatch   ! patch weight in nature fraction
REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(OUT) :: pvegtype_patch  ! vegtype fractions
!                                                                ! for each patch

END SUBROUTINE surf_patch_1d
!
END INTERFACE surf_patch
!
END MODULE modi_surf_patch
!
!     #############################################
      SUBROUTINE surf_patch_2d(KPATCH,PVEGTYPE,PPATCH)
!     #############################################
!
!!****  *SURF_PATCH * - subroutine to compute the patch fractions in each grid
!!                      mesh with nature in it.
!!
!!    PURPOSE
!!    -------
!!
!!
!!**  METHOD
!!    ------
!!
!!
!!
!!    EXTERNAL
!!    --------
!!
!!
!! 
!!    IMPLICIT ARGUMENTS
!!    ------------------ 
!!
!!
!!    REFERENCE
!!    ---------
!!
!!      
!!
!!    AUTHOR
!!    ------
!!
!!       V. Masson    * METEO-FRANCE *
!!
!!    MODIFICATIONS
!!    -------------
!!
!!      Original     15/03/99
!       F.solmon      06/00 adaptation for patch approach
!-------------------------------------------------------------------------------
!
!*       0.     DECLARATIONS
!               ------------
!
USE modd_data_cover_par, ONLY : nvegtype
USE modd_surf_par,       ONLY : xundef
!
USE modi_vegtype_to_patch
!
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!*       0.1   Declarations of dummy arguments :
!
INTEGER,                INTENT(IN)  :: kpatch   ! number of patches
REAL, DIMENSION(:,:,:), INTENT(IN)  :: pvegtype ! vegtype fractions
REAL, DIMENSION(:,:,:), INTENT(OUT) :: ppatch   ! patch weight in nature fraction
!
!
!*       0.2    Declarations of local variables for print on FM file
!
!
INTEGER                              ::jveg, jpatch  ! loop on patches
REAL(KIND=JPRB) :: zhook_handle
!-------------------------------------------------------------------------------
!
IF (lhook) CALL dr_hook('MODI_SURF_PATCH:SURF_PATCH_2D',0,zhook_handle)
ppatch(:,:,:)=0.
DO jveg=1,nvegtype
  jpatch=vegtype_to_patch(jveg, kpatch)
  WHERE (pvegtype(:,:,jveg) /= xundef)
    ppatch(:,:,jpatch)=   ppatch(:,:,jpatch) +   pvegtype(:,:,jveg)
  END WHERE
END DO
IF (lhook) CALL dr_hook('MODI_SURF_PATCH:SURF_PATCH_2D',1,zhook_handle)
!
!
!-------------------------------------------------------------------------------
!
END SUBROUTINE surf_patch_2d
!-------------------------------------------------------------------------------
!
!     #############################################
      SUBROUTINE surf_patch_1d(KPATCH,PVEGTYPE,PPATCH,PVEGTYPE_PATCH)
!     #############################################
!
!!****  *SURF_PATCH * - subroutine to compute the patch fractions in each grid
!!                      mesh with nature in it.
!!
!!    PURPOSE
!!    -------
!!
!!
!!**  METHOD
!!    ------
!!
!!
!!
!!    EXTERNAL
!!    --------
!!
!!
!! 
!!    IMPLICIT ARGUMENTS
!!    ------------------ 
!!
!!
!!    REFERENCE
!!    ---------
!!
!!      
!!
!!    AUTHOR
!!    ------
!!
!!       V. Masson    * METEO-FRANCE *
!!
!!    MODIFICATIONS
!!    -------------
!!
!!      Original     15/03/99
!       F.solmon      06/00 adaptation for patch approach
!-------------------------------------------------------------------------------
!
!*       0.     DECLARATIONS
!               ------------
!
USE modd_data_cover_par, ONLY : nvegtype
USE modd_surf_par,       ONLY : xundef
!
USE modi_vegtype_to_patch
!
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!*       0.1   Declarations of dummy arguments :
!
INTEGER               , INTENT(IN)  :: kpatch   ! number of patches
REAL, DIMENSION(:,:),   INTENT(IN)  :: pvegtype ! vegtype fractions
REAL, DIMENSION(:,:),   INTENT(OUT) :: ppatch   ! patch weight in nature fraction
REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(OUT) :: pvegtype_patch  ! vegtype fractions
!                                                                ! for each patch
!
!
!*       0.2    Declarations of local variables for print on FM file
!
!
INTEGER                              ::jveg, jpatch  ! loop on patches
REAL(KIND=JPRB) :: zhook_handle
!-------------------------------------------------------------------------------
!
IF (lhook) CALL dr_hook('MODI_SURF_PATCH:SURF_PATCH_1D',0,zhook_handle)
ppatch(:,:)  =0.
IF (present(pvegtype_patch)) pvegtype_patch(:,:,:)=0.
DO jveg=1,nvegtype
  jpatch=vegtype_to_patch(jveg, kpatch)
  WHERE (pvegtype(:,jveg) /= xundef)
    ppatch(:,jpatch)     =   ppatch(:,jpatch) +   pvegtype(:,jveg)
  END WHERE
  IF (present(pvegtype_patch)) THEN
    WHERE (pvegtype(:,jveg) /= xundef)
      pvegtype_patch(:,jveg,jpatch)=                         pvegtype(:,jveg)
    END WHERE
  END IF
END DO
IF (present(pvegtype_patch)) THEN
  DO jpatch=1,kpatch
    DO jveg=1,nvegtype
      WHERE (pvegtype(:,jveg) /= xundef .AND. ppatch(:,jpatch)/= 0.) 
        pvegtype_patch(:,jveg,jpatch) = pvegtype_patch(:,jveg,jpatch) / ppatch(:,jpatch)
      END WHERE
    END DO
  END DO
END IF
IF (lhook) CALL dr_hook('MODI_SURF_PATCH:SURF_PATCH_1D',1,zhook_handle)
!
!
!-------------------------------------------------------------------------------
!
END SUBROUTINE surf_patch_1d