88c98f32dbafc69d22181386830d9bfc96318e74
[MNH-git_open_source-lfs.git] / src / SURFEX / read_isba_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_ISBA_CANOPY_n(HPROGRAM)
7 !     #########################################
8 !
9 !!****  *READ_ISBA_CANOPY_n* - reads ISBA 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 !
44 USE MODD_ISBA_n,          ONLY : LCANOPY
45 USE MODD_ISBA_CANOPY_n,   ONLY : NLVL, XZ, XU, XT, XQ, XTKE, XLMO, XDZ, XZF, XDZF, XP
46 !
47 USE MODI_READ_SURF
48 USE MODI_CANOPY_GRID
49 USE MODI_GET_TYPE_DIM_n
50 !
51 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
52 USE PARKIND1  ,ONLY : JPRB
53 !
54 IMPLICIT NONE
55 !
56 !*       0.1   Declarations of arguments
57 !              -------------------------
58 !
59  CHARACTER(LEN=6),  INTENT(IN)  :: HPROGRAM ! calling program
60 !
61 !
62 !*       0.2   Declarations of local variables
63 !              -------------------------------
64 !
65 !
66  CHARACTER(LEN=12) :: YRECFM         ! Name of the article to be read
67  CHARACTER(LEN=3)  :: YREAD
68 INTEGER :: JLAYER  ! loop counter on layers
69 INTEGER :: ILU     ! 1D physical dimension
70 INTEGER :: IRESP   ! Error code after redding
71 INTEGER :: IVERSION, IBUGFIX  ! surface version
72 REAL(KIND=JPRB) :: ZHOOK_HANDLE
73 !-------------------------------------------------------------------------------
74 !
75 !* 1D physical dimension
76 !
77 IF (LHOOK) CALL DR_HOOK('READ_ISBA_CANOPY_N',0,ZHOOK_HANDLE)
78 YRECFM='SIZE_NATURE'
79  CALL GET_TYPE_DIM_n('NATURE',ILU)
80 !
81 !
82 !* flag to use or not canopy levels
83 !
84 YRECFM='VERSION'
85  CALL READ_SURF(HPROGRAM,YRECFM,IVERSION,IRESP)
86 !
87 YRECFM='BUG'
88  CALL READ_SURF(HPROGRAM,YRECFM,IBUGFIX,IRESP)
89 !
90 IF (IVERSION<3) THEN
91   LCANOPY = .FALSE.
92 ELSE
93   YRECFM='ISBA_CANOPY'
94   CALL READ_SURF(HPROGRAM,YRECFM,LCANOPY,IRESP)
95 END IF
96 !
97 IF (.NOT.LCANOPY) THEN
98   ALLOCATE(XZ  (0,0))
99   ALLOCATE(XU  (0,0))
100   ALLOCATE(XT  (0,0))
101   ALLOCATE(XQ  (0,0))
102   ALLOCATE(XTKE(0,0))
103   ALLOCATE(XLMO(0)  )
104   ALLOCATE(XP  (0,0))
105   ALLOCATE(XDZ (0,0))
106   ALLOCATE(XZF (0,0))
107   ALLOCATE(XDZF(0,0))
108   IF (LHOOK) CALL DR_HOOK('READ_ISBA_CANOPY_N',1,ZHOOK_HANDLE)
109   RETURN
110 ENDIF
111 !
112 !* number of vertical levels
113 !
114 YRECFM='ISBA_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,'(A10,I2.2)') 'ISBA_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)     )
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,'(A10,I2.2)') 'ISBA_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,'(A10,I2.2)') 'ISBA_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,'(A10,I2.2)') 'ISBA_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,'(A10,I2.2)') 'ISBA_CAN_E',JLAYER
166     CALL READ_SURF(HPROGRAM,YRECFM,XTKE(:,JLAYER),IRESP)
167   END DO
168   !
169   !* Monin-Obhukov length
170   YRECFM='ISBA_CAN_LMO     '
171   CALL READ_SURF(HPROGRAM,YRECFM,XLMO(:),IRESP)
172   !
173   !* Pressure
174   DO JLAYER=1,NLVL
175     WRITE(YRECFM,'(A10,I2.2)') 'ISBA_CAN_P',JLAYER
176     CALL READ_SURF(HPROGRAM,YRECFM,XP(:,JLAYER),IRESP)
177   END DO
178   !
179 ELSE
180   XU  (:,:) = XUNDEF
181   XT  (:,:) = XUNDEF
182   XQ  (:,:) = XUNDEF
183   XTKE(:,:) = XUNDEF
184   XLMO(:)   = XUNDEF
185   XP  (:,:) = XUNDEF
186 ENDIF
187 !
188 !
189 !* Grid characteristics
190 !
191 !
192 !  --------------------------------- XZ(k+1)                     XDZ(k+1)
193 !                                                                           ^
194 !                                                                           |
195 !                                                                           |
196 !  - - - - - - - - - - - - - - - - - XZf(k+1)                               | XDZf(k+1)
197 !                                                              ^            |
198 !                                                              |            |
199 !  --------------------------------- XZ(k), XU, XT, XQ, XTKE   | XDZ(k)     V
200 !                                                              |            ^
201 !  - - - - - - - - - - - - - - - - - XZf(k)                    V            | XDZf(k)
202 !  --------------------------------- XZ(k-1)                     XDZ(k-1)   V
203 !  - - - - - - - - - - - - - - - - - XZf(k-1)
204 !
205 ALLOCATE(XDZ (ILU,NLVL))
206 ALLOCATE(XZF (ILU,NLVL))
207 ALLOCATE(XDZF(ILU,NLVL))
208  CALL CANOPY_GRID(ILU,NLVL,XZ,XZF,XDZ,XDZF)
209 !
210 IF (LHOOK) CALL DR_HOOK('READ_ISBA_CANOPY_N',1,ZHOOK_HANDLE)
211 !
212 !-------------------------------------------------------------------------------
213 !
214 END SUBROUTINE READ_ISBA_CANOPY_n