|
SURFEX v7.3
General documentation of Surfex
|
|
SURFEX v7.3
General documentation of Surfex
|
00001 ! ################ 00002 MODULE MODD_TEB_CANOPY_n 00003 ! ################ 00004 ! 00005 !!**** *MODD_TEB_CANOPY_n - declaration of surface parameters for urban canopy 00006 !! 00007 !! PURPOSE 00008 !! ------- 00009 ! Declaration of surface parameters 00010 ! 00011 !! 00012 !!** IMPLICIT ARGUMENTS 00013 !! ------------------ 00014 !! None 00015 !! 00016 !! REFERENCE 00017 !! --------- 00018 !! 00019 !! AUTHOR 00020 !! ------ 00021 !! V. Masson *Meteo France* 00022 !! 00023 !! MODIFICATIONS 00024 !! ------------- 00025 !! Original 07/2006 00026 ! 00027 !* 0. DECLARATIONS 00028 ! ------------ 00029 ! 00030 ! 00031 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00032 USE PARKIND1 ,ONLY : JPRB 00033 ! 00034 IMPLICIT NONE 00035 00036 TYPE TEB_CANOPY_t 00037 ! 00038 INTEGER :: NLVL ! number of levels in canopy 00039 REAL, POINTER, DIMENSION(:,:) :: XZ ! height of middle of each level grid (m) 00040 REAL, POINTER, DIMENSION(:,:) :: XU ! wind at each level in canopy (m/s) 00041 REAL, POINTER, DIMENSION(:,:) :: XT ! temperature at each level in canopy (m/s) 00042 REAL, POINTER, DIMENSION(:,:) :: XQ ! humidity at each level in canopy (kg/m3) 00043 REAL, POINTER, DIMENSION(:,:) :: XTKE ! Tke at each level in canopy (m2/s2) 00044 REAL, POINTER, DIMENSION(:,:) :: XLMO ! Monin-Obhukov length (m) 00045 REAL, POINTER, DIMENSION(:,:) :: XLM ! Mixing lentgh (m) 00046 REAL, POINTER, DIMENSION(:,:) :: XLEPS! Dissipative length (m) 00047 REAL, POINTER, DIMENSION(:,:) :: XP ! pressure at each level in canopy (kg/m3) 00048 ! 00049 REAL, POINTER, DIMENSION(:,:) :: XDZ ! depth of each level in canopy (m) 00050 REAL, POINTER, DIMENSION(:,:) :: XZF ! height of bottom of each level grid (m) 00051 REAL, POINTER, DIMENSION(:,:) :: XDZF ! depth between each level in canopy (m) 00052 ! 00053 END TYPE TEB_CANOPY_t 00054 00055 TYPE(TEB_CANOPY_t), ALLOCATABLE, TARGET, SAVE :: TEB_CANOPY_MODEL(:) 00056 00057 INTEGER, POINTER :: NLVL=>NULL() 00058 !$OMP THREADPRIVATE(NLVL) 00059 REAL, POINTER, DIMENSION(:,:) :: XZ=>NULL() 00060 !$OMP THREADPRIVATE(XZ) 00061 REAL, POINTER, DIMENSION(:,:) :: XU=>NULL() 00062 !$OMP THREADPRIVATE(XU) 00063 REAL, POINTER, DIMENSION(:,:) :: XT=>NULL() 00064 !$OMP THREADPRIVATE(XT) 00065 REAL, POINTER, DIMENSION(:,:) :: XQ=>NULL() 00066 !$OMP THREADPRIVATE(XQ) 00067 REAL, POINTER, DIMENSION(:,:) :: XTKE=>NULL() 00068 !$OMP THREADPRIVATE(XTKE) 00069 REAL, POINTER, DIMENSION(:,:) :: XLMO=>NULL() 00070 !$OMP THREADPRIVATE(XLMO) 00071 REAL, POINTER, DIMENSION(:,:) :: XLM=>NULL() 00072 !$OMP THREADPRIVATE(XLM) 00073 REAL, POINTER, DIMENSION(:,:) :: XLEPS=>NULL() 00074 !$OMP THREADPRIVATE(XLEPS) 00075 REAL, POINTER, DIMENSION(:,:) :: XP=>NULL() 00076 !$OMP THREADPRIVATE(XP) 00077 REAL, POINTER, DIMENSION(:,:) :: XDZ=>NULL() 00078 !$OMP THREADPRIVATE(XDZ) 00079 REAL, POINTER, DIMENSION(:,:) :: XZF=>NULL() 00080 !$OMP THREADPRIVATE(XZF) 00081 REAL, POINTER, DIMENSION(:,:) :: XDZF=>NULL() 00082 !$OMP THREADPRIVATE(XDZF) 00083 00084 CONTAINS 00085 00086 SUBROUTINE TEB_CANOPY_GOTO_MODEL(KFROM, KTO, LKFROM) 00087 LOGICAL, INTENT(IN) :: LKFROM 00088 INTEGER, INTENT(IN) :: KFROM, KTO 00089 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00090 ! 00091 ! Save current state for allocated arrays 00092 IF (LKFROM) THEN 00093 TEB_CANOPY_MODEL(KFROM)%XZ=>XZ 00094 TEB_CANOPY_MODEL(KFROM)%XU=>XU 00095 TEB_CANOPY_MODEL(KFROM)%XT=>XT 00096 TEB_CANOPY_MODEL(KFROM)%XQ=>XQ 00097 TEB_CANOPY_MODEL(KFROM)%XTKE=>XTKE 00098 TEB_CANOPY_MODEL(KFROM)%XLMO=>XLMO 00099 TEB_CANOPY_MODEL(KFROM)%XLM=>XLM 00100 TEB_CANOPY_MODEL(KFROM)%XLEPS=>XLEPS 00101 TEB_CANOPY_MODEL(KFROM)%XP=>XP 00102 TEB_CANOPY_MODEL(KFROM)%XDZ=>XDZ 00103 TEB_CANOPY_MODEL(KFROM)%XZF=>XZF 00104 TEB_CANOPY_MODEL(KFROM)%XDZF=>XDZF 00105 ENDIF 00106 ! 00107 ! Current model is set to model KTO 00108 IF (LHOOK) CALL DR_HOOK('MODD_TEB_CANOPY_N:TEB_CANOPY_GOTO_MODEL',0,ZHOOK_HANDLE) 00109 NLVL=>TEB_CANOPY_MODEL(KTO)%NLVL 00110 XZ=>TEB_CANOPY_MODEL(KTO)%XZ 00111 XU=>TEB_CANOPY_MODEL(KTO)%XU 00112 XT=>TEB_CANOPY_MODEL(KTO)%XT 00113 XQ=>TEB_CANOPY_MODEL(KTO)%XQ 00114 XTKE=>TEB_CANOPY_MODEL(KTO)%XTKE 00115 XLMO=>TEB_CANOPY_MODEL(KTO)%XLMO 00116 XLM=>TEB_CANOPY_MODEL(KTO)%XLM 00117 XLEPS=>TEB_CANOPY_MODEL(KTO)%XLEPS 00118 XP=>TEB_CANOPY_MODEL(KTO)%XP 00119 XDZ=>TEB_CANOPY_MODEL(KTO)%XDZ 00120 XZF=>TEB_CANOPY_MODEL(KTO)%XZF 00121 XDZF=>TEB_CANOPY_MODEL(KTO)%XDZF 00122 IF (LHOOK) CALL DR_HOOK('MODD_TEB_CANOPY_N:TEB_CANOPY_GOTO_MODEL',1,ZHOOK_HANDLE) 00123 00124 END SUBROUTINE TEB_CANOPY_GOTO_MODEL 00125 00126 SUBROUTINE TEB_CANOPY_ALLOC(KMODEL) 00127 INTEGER, INTENT(IN) :: KMODEL 00128 INTEGER :: J 00129 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00130 IF (LHOOK) CALL DR_HOOK("MODD_TEB_CANOPY_N:TEB_CANOPY_ALLOC",0,ZHOOK_HANDLE) 00131 ALLOCATE(TEB_CANOPY_MODEL(KMODEL)) 00132 DO J=1,KMODEL 00133 NULLIFY(TEB_CANOPY_MODEL(J)%XZ) 00134 NULLIFY(TEB_CANOPY_MODEL(J)%XU) 00135 NULLIFY(TEB_CANOPY_MODEL(J)%XT) 00136 NULLIFY(TEB_CANOPY_MODEL(J)%XQ) 00137 NULLIFY(TEB_CANOPY_MODEL(J)%XTKE) 00138 NULLIFY(TEB_CANOPY_MODEL(J)%XLMO) 00139 NULLIFY(TEB_CANOPY_MODEL(J)%XLM) 00140 NULLIFY(TEB_CANOPY_MODEL(J)%XLEPS) 00141 NULLIFY(TEB_CANOPY_MODEL(J)%XP) 00142 NULLIFY(TEB_CANOPY_MODEL(J)%XDZ) 00143 NULLIFY(TEB_CANOPY_MODEL(J)%XZF) 00144 NULLIFY(TEB_CANOPY_MODEL(J)%XDZF) 00145 ENDDO 00146 TEB_CANOPY_MODEL(:)%NLVL=0 00147 IF (LHOOK) CALL DR_HOOK("MODD_TEB_CANOPY_N:TEB_CANOPY_ALLOC",1,ZHOOK_HANDLE) 00148 END SUBROUTINE TEB_CANOPY_ALLOC 00149 00150 SUBROUTINE TEB_CANOPY_DEALLO 00151 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00152 IF (LHOOK) CALL DR_HOOK("MODD_TEB_CANOPY_N:TEB_CANOPY_DEALLO",0,ZHOOK_HANDLE) 00153 IF (ALLOCATED(TEB_CANOPY_MODEL)) DEALLOCATE(TEB_CANOPY_MODEL) 00154 IF (LHOOK) CALL DR_HOOK("MODD_TEB_CANOPY_N:TEB_CANOPY_DEALLO",1,ZHOOK_HANDLE) 00155 END SUBROUTINE TEB_CANOPY_DEALLO 00156 00157 END MODULE MODD_TEB_CANOPY_n
1.8.0
