SURFEX v7.3: /home/dasprezs/EXPORT_v7_3/src/SURFEX/modd_diag_utci

Go to the documentation of this file.
00001 !     ############################
00002       MODULE MODD_DIAG_UTCI_TEB_n
00003 !     ############################
00004 !
00005 !!****  *MODD_DIAG_UTCI_TEB - declaration of confort from TEB scheme
00006 !!
00007 !!    PURPOSE
00008 !!    -------
00009 !
00010 !!
00011 !!**  IMPLICIT ARGUMENTS
00012 !!    ------------------
00013 !!      None 
00014 !!
00015 !!    REFERENCE
00016 !!    ---------
00017 !!
00018 !!    AUTHOR
00019 !!    ------
00020 !!      P. Le Moigne   *Meteo France*
00021 !!
00022 !!    MODIFICATIONS
00023 !!    -------------
00024 !!      Original       07/10/04
00025 !
00026 !
00027 !*       0.   DECLARATIONS
00028 !             ------------
00029 !
00030 !
00031 !
00032 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00033 USE PARKIND1  ,ONLY : JPRB
00034 !
00035 IMPLICIT NONE
00036 
00037 TYPE DIAG_UTCI_TEB_t
00038 !------------------------------------------------------------------------------
00039 !
00040   LOGICAL :: LUTCI                               ! flag to compute UTCI quantities
00041   REAL, POINTER, DIMENSION(:)   :: XUTCI_IN      ! UTCI for person indoor
00042   REAL, POINTER, DIMENSION(:)   :: XUTCI_OUTSUN  ! UTCI for person outdoor at sun
00043   REAL, POINTER, DIMENSION(:)   :: XUTCI_OUTSHADE! UTCI for person outdoor at shade
00044   REAL, POINTER, DIMENSION(:)   :: XTRAD_SUN! Mean radiant temperature seen by person at sun (K)
00045   REAL, POINTER, DIMENSION(:)   :: XTRAD_SHADE! Mean radiant temperature seen by person in shade (K)
00046 !
00047 END TYPE DIAG_UTCI_TEB_t
00048 !
00049 
00050 TYPE(DIAG_UTCI_TEB_t), ALLOCATABLE, TARGET, SAVE :: DIAG_UTCI_TEB_MODEL(:)
00051 
00052 LOGICAL, POINTER :: LUTCI=>NULL()
00053 !$OMP THREADPRIVATE(LUTCI)
00054 REAL, POINTER, DIMENSION(:)   :: XUTCI_IN=>NULL()
00055 !$OMP THREADPRIVATE(XUTCI_IN)
00056 REAL, POINTER, DIMENSION(:)   :: XUTCI_OUTSUN=>NULL()
00057 !$OMP THREADPRIVATE(XUTCI_OUTSUN)
00058 REAL, POINTER, DIMENSION(:)   :: XUTCI_OUTSHADE=>NULL()
00059 !$OMP THREADPRIVATE(XUTCI_OUTSHADE)
00060 REAL, POINTER, DIMENSION(:)   :: XTRAD_SUN=>NULL()
00061 !$OMP THREADPRIVATE(XTRAD_SUN)
00062 REAL, POINTER, DIMENSION(:)   :: XTRAD_SHADE=>NULL()
00063 !$OMP THREADPRIVATE(XTRAD_SHADE)
00064 
00065 CONTAINS
00066 
00067 SUBROUTINE DIAG_UTCI_TEB_GOTO_MODEL(KFROM, KTO, LKFROM)
00068 LOGICAL, INTENT(IN) :: LKFROM
00069 INTEGER, INTENT(IN) :: KFROM, KTO
00070 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00071 !
00072 ! Current model is set to model KTO
00073 IF (LHOOK) CALL DR_HOOK('MODD_DIAG_UTCI_TEB_N:DIAG_UTCI_TEB_GOTO_MODEL',0,ZHOOK_HANDLE)
00074 DIAG_UTCI_TEB_MODEL(KFROM)%XUTCI_IN=>XUTCI_IN
00075 DIAG_UTCI_TEB_MODEL(KFROM)%XUTCI_OUTSUN=>XUTCI_OUTSUN
00076 DIAG_UTCI_TEB_MODEL(KFROM)%XUTCI_OUTSHADE=>XUTCI_OUTSHADE
00077 DIAG_UTCI_TEB_MODEL(KFROM)%XTRAD_SUN=>XTRAD_SUN
00078 DIAG_UTCI_TEB_MODEL(KFROM)%XTRAD_SHADE=>XTRAD_SHADE
00079 !
00080 LUTCI => DIAG_UTCI_TEB_MODEL(KTO)%LUTCI
00081 XUTCI_IN => DIAG_UTCI_TEB_MODEL(KTO)%XUTCI_IN
00082 XUTCI_OUTSUN => DIAG_UTCI_TEB_MODEL(KTO)%XUTCI_OUTSUN
00083 XUTCI_OUTSHADE => DIAG_UTCI_TEB_MODEL(KTO)%XUTCI_OUTSHADE
00084 XTRAD_SUN => DIAG_UTCI_TEB_MODEL(KTO)%XTRAD_SUN
00085 XTRAD_SHADE => DIAG_UTCI_TEB_MODEL(KTO)%XTRAD_SHADE
00086 IF (LHOOK) CALL DR_HOOK('MODD_DIAG_UTCI_TEB_N:DIAG_UTCI_TEB_GOTO_MODEL',1,ZHOOK_HANDLE)
00087 
00088 END SUBROUTINE DIAG_UTCI_TEB_GOTO_MODEL
00089 
00090 SUBROUTINE DIAG_UTCI_TEB_ALLOC(KMODEL)
00091 INTEGER, INTENT(IN) :: KMODEL
00092 INTEGER :: J
00093 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00094 IF (LHOOK) CALL DR_HOOK("MODD_DIAG_UTCI_TEB_N:DIAG_UTCI_TEB_ALLOC",0,ZHOOK_HANDLE)
00095 ALLOCATE(DIAG_UTCI_TEB_MODEL(KMODEL))
00096 DIAG_UTCI_TEB_MODEL(:)%LUTCI=.FALSE.
00097 DO J=1,KMODEL
00098   NULLIFY(DIAG_UTCI_TEB_MODEL(J)%XUTCI_IN)
00099   NULLIFY(DIAG_UTCI_TEB_MODEL(J)%XUTCI_OUTSUN)
00100   NULLIFY(DIAG_UTCI_TEB_MODEL(J)%XUTCI_OUTSHADE)
00101   NULLIFY(DIAG_UTCI_TEB_MODEL(J)%XTRAD_SUN)
00102   NULLIFY(DIAG_UTCI_TEB_MODEL(J)%XTRAD_SHADE)
00103 END DO
00104 IF (LHOOK) CALL DR_HOOK("MODD_DIAG_UTCI_TEB_N:DIAG_UTCI_TEB_ALLOC",1,ZHOOK_HANDLE)
00105 END SUBROUTINE DIAG_UTCI_TEB_ALLOC
00106 
00107 SUBROUTINE DIAG_UTCI_TEB_DEALLO
00108 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00109 IF (LHOOK) CALL DR_HOOK("MODD_DIAG_UTCI_TEB_OTPIONS_N:DIAG_UTCI_TEB_OTPIONS_DEALLO",0,ZHOOK_HANDLE)
00110 IF (ALLOCATED(DIAG_UTCI_TEB_MODEL)) DEALLOCATE(DIAG_UTCI_TEB_MODEL)
00111 IF (LHOOK) CALL DR_HOOK("MODD_DIAG_UTCI_TEB_OTPIONS_N:DIAG_UTCI_TEB_OTPIONS_DEALLO",1,ZHOOK_HANDLE)
00112 END SUBROUTINE DIAG_UTCI_TEB_DEALLO
00113 
00114 
00115 END MODULE MODD_DIAG_UTCI_TEB_n