get_vegtype_2_patch_mask.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 get_vegtype_2_patch_mask(  &
        kluout,                            &! output listing logical unit
       ksize_veg,                         &!I Size of a vegetation vector within a patch vector
       ksize_patch,                       &!I Size of a patch within a nature vector
       ksize_nat,                         &!I Size of nature vector
       kmask_patch_nature,                &!I Mask to transform from patch vector to nature vector
       pvegtype_patch,                    &!I Fraction of a nature point #i with vegetation #j which is packed to patch #k
       kmask,                             &!O Mask from vegtype vector to patch vector
       kpatch_max,                        &!I Number of possible patches
       kpatch,                            &!I Index of patch in question
       kvegtype                          &!I Index of vegtype in question
       )      
!
!
!!    PURPOSE
!!    -------
!     Create a patch-->vegtype mask
!     So that later, a patch can be packed into vegtype vectors
!!
!!    AUTHOR
!!    ------
!!     Alf Grini <alf.grini@cnrm.meteo.fr>
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    01/2005
USE modd_data_cover_par, ONLY : nvegtype  ! Number of possible vegtypes
!!------------------------------------------------------------------
!
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
USE modi_abor1_sfx
!
IMPLICIT NONE
!*      0.1    declarations of arguments
!
INTEGER, INTENT(IN)                        :: kluout               !Output listing logical unit
INTEGER, INTENT(IN)                        :: ksize_veg            !Size of vegetation vector in question
INTEGER, INTENT(IN)                        :: ksize_patch          !Size of patch vector in question
INTEGER, INTENT(IN)                        :: ksize_nat            !Size of nature vector
INTEGER, INTENT(IN),DIMENSION(KSIZE_PATCH) :: kmask_patch_nature   !PATCH -->NATURE mask
INTEGER, INTENT(IN)                        :: kpatch_max           !Number of possible patches
!
INTEGER, INTENT(IN)                        :: kpatch   !Patch in question
INTEGER, INTENT(IN)                        :: kvegtype !Vegtype in quesition

REAL, DIMENSION(KSIZE_NAT,NVEGTYPE,KPATCH_MAX), INTENT(IN)  :: pvegtype_patch  !Fraction of nature point in npatch with nveg vegetation
!
!OUTPUT
INTEGER, DIMENSION(KSIZE_VEG), INTENT(OUT)   :: kmask     !vegetation type to patch

!
!LOCAL
!
INTEGER                                  :: kk       ! Counter for points in vegetation vector
INTEGER                                  :: jj       ! Counter for points in patch vector
INTEGER                                  :: ii       ! Point in nature vector corresponding to JJ
REAL(KIND=JPRB) :: zhook_handle
!
!-------------------------------------------------------------------------------
!
IF (lhook) CALL dr_hook('GET_VEGTYPE_2_PATCH_MASK',0,zhook_handle)
kmask(:)              = 0

kk=1  !First point of vegetation-vector
DO jj=1,ksize_patch                  !Number of points in the patch in question
   ii=kmask_patch_nature(jj)         !Nature-index corresponding to the point in question
   IF(pvegtype_patch(ii,kvegtype,kpatch)>0.)THEN
      kmask(kk)=jj
      kk=kk+1
   ENDIF
ENDDO  !Loop on points in patch vector

IF(kk-1.ne.ksize_veg) THEN
  WRITE(kluout,*) "ERROR in routine GET_VEGTYPE_2_PATCH_MASK"
  WRITE(kluout,*) "problem in number of vegetation types"
  WRITE(kluout,*) "KK-1     =", kk-1
  WRITE(kluout,*) "KSIZE_VEG=", ksize_veg
  CALL abor1_sfx('GET_VEGTYPE_2_PATCH_MASK: WRONG NUMBER OF VEGETATION TYPES')
END IF
IF (lhook) CALL dr_hook('GET_VEGTYPE_2_PATCH_MASK',1,zhook_handle)

END SUBROUTINE get_vegtype_2_patch_mask