bldcode.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.
FUNCTION bldcode (BDD, KTYPE,KAGE) RESULT(KCODE)
!
!
!
USE modd_bld_description_n, ONLY : bld_desc_t
!
IMPLICIT NONE
!
TYPE(bld_desc_t), INTENT(INOUT) :: BDD
!
INTEGER, DIMENSION(:), INTENT(IN) :: KTYPE ! Type of building
INTEGER, DIMENSION(:), INTENT(IN) :: KAGE  ! date of construction (or total renovation) of building
INTEGER, DIMENSION(SIZE(KTYPE))   :: KCODE ! Building code (merges type & age info).
!
INTEGER :: JL        ! loop counter on points
INTEGER :: JAGE      ! loop counter on construction date ranges
INTEGER :: ICODE_AGE ! code for the adequate construction date range
!
DO jl=1,SIZE(ktype)
  icode_age=bdd%NDESC_AGE_LIST(bdd%NDESC_AGE) ! default value is the more recent building
  DO jage=bdd%NDESC_AGE,1,-1
    IF (bdd%NDESC_AGE_DATE(jage)>=kage(jl)) icode_age = bdd%NDESC_AGE_LIST(jage)
  END DO
  kcode(jl) = 100*ktype(jl)+icode_age
END DO
!
END FUNCTION bldcode