f7cc6270f1c098ab81d419591585dff023ba0914
[MNH-git_open_source-lfs.git] / src / SURFEX / read_teb_canopyn.F90
1 !SURFEX_LIC Copyright 1994-2014 Meteo-France 
2 !SURFEX_LIC This is part of the SURFEX software governed by the CeCILL-C  licence
3 !SURFEX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
4 !SURFEX_LIC for details. version 1.
5 !     #########
6       SUBROUTINE READ_TEB_CANOPY_n(HPROGRAM)
7 !     #########################################
8 !
9 !!****  *READ_TEB_CANOPY_n* - reads TEB fields
10 !!                        
11 !!
12 !!    PURPOSE
13 !!    -------
14 !!
15 !!**  METHOD
16 !!    ------
17 !!
18 !!    EXTERNAL
19 !!    --------
20 !!
21 !!
22 !!    IMPLICIT ARGUMENTS
23 !!    ------------------
24 !!
25 !!    REFERENCE
26 !!    ---------
27 !!
28 !!
29 !!    AUTHOR
30 !!    ------
31 !!      V. Masson   *Meteo France*      
32 !!
33 !!    MODIFICATIONS
34 !!    -------------
35 !!      Original    01/2003 
36 !!      E. Martin   01/2012 Add LSBL_COLD_START
37 !-------------------------------------------------------------------------------
38 !
39 !*       0.    DECLARATIONS
40 !              ------------
41 !
42 USE MODD_SURF_PAR,       ONLY : XUNDEF
43 USE MODD_TEB_n,          ONLY : LCANOPY
44 USE MODD_TEB_CANOPY_n,   ONLY : NLVL, XZ, XU, XT, XQ, XTKE, XLMO, XLM,XLEPS, XDZ, XZF, XDZF, XP
45 !
46 USE MODI_READ_SURF
47 USE MODI_CANOPY_GRID
48 USE MODI_GET_TYPE_DIM_n
49 !
50 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
51 USE PARKIND1  ,ONLY : JPRB
52 !
53 IMPLICIT NONE
54 !
55 !*       0.1   Declarations of arguments
56 !              -------------------------
57 !
58  CHARACTER(LEN=6),  INTENT(IN)  :: HPROGRAM ! calling program
59 !
60 !
61 !*       0.2   Declarations of local variables
62 !              -------------------------------
63 !
64 !
65  CHARACTER(LEN=12) :: YRECFM         ! Name of the article to be read
66  CHARACTER(LEN=3)  :: YREAD
67 INTEGER :: JLAYER  ! loop counter on layers
68 INTEGER :: ILU     ! 1D physical dimension
69 INTEGER :: IRESP   ! Error code after redding
70 INTEGER           :: IVERSION, IBUGFIX   ! surface version
71 REAL(KIND=JPRB) :: ZHOOK_HANDLE
72 !-------------------------------------------------------------------------------
73 !
74 !* 1D physical dimension
75 !
76 IF (LHOOK) CALL DR_HOOK('READ_TEB_CANOPY_N',0,ZHOOK_HANDLE)
77 YRECFM='SIZE_TOWN'
78  CALL GET_TYPE_DIM_n('TOWN  ',ILU)
79 !
80 !* flag to use or not canopy levels
81 !
82 YRECFM='VERSION'
83  CALL READ_SURF(HPROGRAM,YRECFM,IVERSION,IRESP)
84 !
85 YRECFM='BUG'
86  CALL READ_SURF(HPROGRAM,YRECFM,IBUGFIX,IRESP)
87 !
88 IF (IVERSION<3) THEN
89   LCANOPY = .FALSE.
90 ELSE
91   YRECFM='TEB_CANOPY'
92   CALL READ_SURF(HPROGRAM,YRECFM,LCANOPY,IRESP)
93 END IF
94 !
95 IF (.NOT.LCANOPY) THEN
96   ALLOCATE(XZ  (0,0))
97   ALLOCATE(XU  (0,0))
98   ALLOCATE(XT  (0,0))
99   ALLOCATE(XQ  (0,0))
100   ALLOCATE(XTKE(0,0))
101   ALLOCATE(XLMO(0,0))
102   ALLOCATE(XP  (0,0))
103   ALLOCATE(XLM (0,0))
104   ALLOCATE(XLEPS(0,0))  
105   ALLOCATE(XDZ (0,0))
106   ALLOCATE(XZF (0,0))
107   ALLOCATE(XDZF(0,0))
108   IF (LHOOK) CALL DR_HOOK('READ_TEB_CANOPY_N',1,ZHOOK_HANDLE)
109   RETURN
110 ENDIF
111 !
112 !* number of vertical levels
113 !
114 YRECFM='TEB_CAN_LVL'
115  CALL READ_SURF(HPROGRAM,YRECFM,NLVL,IRESP)
116 !
117 !*       2.     Prognostic fields:
118 !               -----------------
119 !
120 !* altitudes
121 !
122 ALLOCATE(XZ(ILU,NLVL))
123 !
124 DO JLAYER=1,NLVL
125   WRITE(YRECFM,'(A9,I2.2,A1)') 'TEB_CAN_Z',JLAYER,' '
126   CALL READ_SURF(HPROGRAM,YRECFM,XZ(:,JLAYER),IRESP)
127 END DO
128 !
129 ALLOCATE(XU  (ILU,NLVL))
130 ALLOCATE(XT  (ILU,NLVL))
131 ALLOCATE(XQ  (ILU,NLVL))
132 ALLOCATE(XTKE(ILU,NLVL))
133 ALLOCATE(XLMO(ILU,NLVL))
134 ALLOCATE(XP  (ILU,NLVL))
135 !
136 IF (IVERSION>7 .OR. IVERSION==7 .AND.IBUGFIX>=2) THEN
137   YRECFM='STORAGETYPE'
138   CALL READ_SURF(HPROGRAM,YRECFM,YREAD,IRESP)
139 ELSE
140   YREAD = 'ALL'
141 ENDIF
142 !
143 IF(YREAD=='ALL') THEN
144   !
145   !* wind in SBL
146   DO JLAYER=1,NLVL
147     WRITE(YRECFM,'(A9,I2.2,A1)') 'TEB_CAN_U',JLAYER,' '
148     CALL READ_SURF(HPROGRAM,YRECFM,XU(:,JLAYER),IRESP)
149   END DO
150   !
151   !* theta in SBL
152   DO JLAYER=1,NLVL
153     WRITE(YRECFM,'(A9,I2.2,A1)') 'TEB_CAN_T',JLAYER,' '
154     CALL READ_SURF(HPROGRAM,YRECFM,XT(:,JLAYER),IRESP)
155   END DO
156   !
157   !* humidity in SBL
158   DO JLAYER=1,NLVL
159     WRITE(YRECFM,'(A9,I2.2,A1)') 'TEB_CAN_Q',JLAYER,' '
160     CALL READ_SURF(HPROGRAM,YRECFM,XQ(:,JLAYER),IRESP)
161   END DO
162   !
163   !* Tke in SBL
164   DO JLAYER=1,NLVL
165     WRITE(YRECFM,'(A9,I2.2,A1)') 'TEB_CAN_E',JLAYER,' '
166     CALL READ_SURF(HPROGRAM,YRECFM,XTKE(:,JLAYER),IRESP)
167   END DO
168   !
169   !* Monin-Obhukov length
170   IF (IVERSION<7) THEN
171     YRECFM='TEB_CAN_LMO ' 
172     CALL READ_SURF(HPROGRAM,YRECFM,XLMO(:,1),IRESP) 
173     DO JLAYER = 2,NLVL
174       XLMO(:,JLAYER) = XLMO(:,1)
175     ENDDO    
176   ELSE
177     DO JLAYER=1,NLVL
178       WRITE(YRECFM,'(A10,I2.2)') 'TEB_CAN_MO',JLAYER
179       CALL READ_SURF(HPROGRAM,YRECFM,XLMO(:,JLAYER),IRESP)
180     ENDDO
181   ENDIF    
182   !
183   !* Pressure
184   DO JLAYER=1,NLVL
185     WRITE(YRECFM,'(A9,I2.2,A1)') 'TEB_CAN_P',JLAYER,' '
186     CALL READ_SURF(HPROGRAM,YRECFM,XP(:,JLAYER),IRESP)
187   END DO
188   !
189 ELSE
190   XU  (:,:) = XUNDEF
191   XT  (:,:) = XUNDEF
192   XQ  (:,:) = XUNDEF
193   XTKE(:,:) = XUNDEF
194   XLMO(:,:) = XUNDEF
195   XP  (:,:) = XUNDEF
196 ENDIF
197 !
198 !* mixing length
199 !
200 ALLOCATE(XLM(ILU,NLVL))
201 !
202 !* dissipative length
203 !
204 ALLOCATE(XLEPS(ILU,NLVL))
205 !
206 !
207 !* Grid characteristics
208 !
209 !
210 !  --------------------------------- XZ(k+1)                     XDZ(k+1)
211 !                                                                           ^
212 !                                                                           |
213 !                                                                           |
214 !  - - - - - - - - - - - - - - - - - XZf(k+1)                               | XDZf(k+1)
215 !                                                              ^            |
216 !                                                              |            |
217 !  --------------------------------- XZ(k), XU, XT, XQ, XTKE   | XDZ(k)     V
218 !                                                              |            ^
219 !  - - - - - - - - - - - - - - - - - XZf(k)                    V            | XDZf(k)
220 !  --------------------------------- XZ(k-1)                     XDZ(k-1)   V
221 !  - - - - - - - - - - - - - - - - - XZf(k-1)
222 !
223 ALLOCATE(XDZ (ILU,NLVL))
224 ALLOCATE(XZF (ILU,NLVL))
225 ALLOCATE(XDZF(ILU,NLVL))
226  CALL CANOPY_GRID(ILU,NLVL,XZ,XZF,XDZ,XDZF)
227 !
228 IF (LHOOK) CALL DR_HOOK('READ_TEB_CANOPY_N',1,ZHOOK_HANDLE)
229 !-------------------------------------------------------------------------------
230 !
231 END SUBROUTINE READ_TEB_CANOPY_n