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(KNPATCH,PVEGTYPE,PPATCH,PVEGTYPE_PATCH)

INTEGER               , INTENT(IN)  :: KNPATCH   ! 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_2d
      SUBROUTINE surf_patch_1d(KPATCH,KNPATCH,PVEGTYPE,PPATCH,PVEGTYPE_PATCH)

INTEGER               , INTENT(IN)  :: KPATCH   ! 
INTEGER               , INTENT(IN)  :: KNPATCH   ! 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(KNPATCH,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)  :: KNPATCH   ! 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_2D',0,zhook_handle)
ppatch(:,:)  =0.
IF (PRESENT(pvegtype_patch)) pvegtype_patch(:,:,:)=0.
DO jveg=1,nvegtype
  jpatch=vegtype_to_patch(jveg, knpatch)
  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,knpatch
    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_2D',1,zhook_handle)
!
!
!-------------------------------------------------------------------------------
!
END SUBROUTINE surf_patch_2d
!-------------------------------------------------------------------------------
!
!     #############################################
      SUBROUTINE surf_patch_1d(KPATCH,KNPATCH,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
INTEGER, INTENT(IN) :: KNPATCH   ! 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, knpatch)
  IF (jpatch/=kpatch) cycle
  WHERE (pvegtype(:,jveg) /= xundef)
    ppatch(:) = ppatch(:) + pvegtype(:,jveg)
  END WHERE
  IF (PRESENT(pvegtype_patch)) THEN
    WHERE (pvegtype(:,jveg) /= xundef)
      pvegtype_patch(:,jveg) = pvegtype(:,jveg)
    END WHERE
  END IF
END DO
IF (PRESENT(pvegtype_patch)) THEN
  DO jveg=1,nvegtype
    WHERE (pvegtype(:,jveg) /= xundef .AND. ppatch(:)/= 0.) 
      pvegtype_patch(:,jveg) = pvegtype_patch(:,jveg) / ppatch(:)
    END WHERE
  END DO
END IF
IF (lhook) CALL dr_hook('MODI_SURF_PATCH:SURF_PATCH_1D',1,zhook_handle)
!
!
!-------------------------------------------------------------------------------
!
END SUBROUTINE surf_patch_1d
!