put_on_all_vegtypes.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 put_on_all_vegtypes(KNI,KLAYER,KPATCH,KVEGTYPE,PFIELD_PATCH,PFIELD_VEGTYPE)
!     #######################
!
USE modi_vegtype_to_patch
!
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!
!* dummy arguments
!  ---------------
!
INTEGER, INTENT(IN) :: kni      ! number of points
INTEGER, INTENT(IN) :: klayer   ! number of layers
INTEGER, INTENT(IN) :: kpatch   ! number of patch
INTEGER, INTENT(IN) :: kvegtype ! number of vegtypes
REAL, DIMENSION(KNI,KLAYER,KPATCH  ),INTENT(IN) :: pfield_patch   ! field for each patch
REAL, DIMENSION(KNI,KLAYER,KVEGTYPE), INTENT(OUT) :: pfield_vegtype ! field for each vegtype
!
!
!* local variables
!  ---------------
!
INTEGER :: ipatch   ! patch   counter
INTEGER :: jvegtype ! vegtype counter
REAL(KIND=JPRB) :: zhook_handle
!
!-------------------------------------------------------------------
!
IF (lhook) CALL dr_hook('PUT_ON_ALL_VEGTYPES',0,zhook_handle)
IF (kvegtype==1) THEN
  pfield_vegtype(:,:,1) = pfield_patch(:,:,1)
ELSE
  DO jvegtype=1,kvegtype
    ipatch = vegtype_to_patch(jvegtype,kpatch)
    pfield_vegtype(:,:,jvegtype) = pfield_patch(:,:,ipatch)
  END DO
END IF
IF (lhook) CALL dr_hook('PUT_ON_ALL_VEGTYPES',1,zhook_handle)
!-------------------------------------------------------------------
!
END SUBROUTINE put_on_all_vegtypes