2832610556103d03fa4c35fe996f8f07b9c76006
[MNH-git_open_source-lfs.git] / src / SURFEX / read_watflux_sbln.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_WATFLUX_SBL_n(HPROGRAM)
7 !     #########################################
8 !
9 !!****  *READ_WATFLUX_SBL_n* - reads WATFLUX 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_WATFLUX_n,       ONLY : LSBL
44 USE MODD_WATFLUX_SBL_n,   ONLY : NLVL, XZ, XU, XT, XQ, XTKE, XLMO, 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  CHARACTER(LEN=12) :: YRECFM         ! Name of the article to be read
65  CHARACTER(LEN=3)  :: YREAD
66 INTEGER :: JLAYER  ! loop counter on layers
67 INTEGER :: ILU     ! 1D physical dimension
68 INTEGER :: IRESP   ! Error code after redding
69 INTEGER :: IVERSION, IBUGFIX   ! surface version
70 REAL(KIND=JPRB) :: ZHOOK_HANDLE
71 !-------------------------------------------------------------------------------
72 !
73 !* 1D physical dimension
74 !
75 IF (LHOOK) CALL DR_HOOK('READ_WATFLUX_SBL_N',0,ZHOOK_HANDLE)
76  CALL GET_TYPE_DIM_n('WATER ',ILU)
77 !
78 !* flag to use or not SBL levels
79 !
80 YRECFM='VERSION'
81  CALL READ_SURF(HPROGRAM,YRECFM,IVERSION,IRESP)
82 !
83 YRECFM='BUG'
84  CALL READ_SURF(HPROGRAM,YRECFM,IBUGFIX,IRESP)
85 !
86 YRECFM='WAT_SBL'
87  CALL READ_SURF(HPROGRAM,YRECFM,LSBL,IRESP)
88 !
89 IF (.NOT.LSBL) THEN
90   ALLOCATE(XZ  (0,0))
91   ALLOCATE(XU  (0,0))
92   ALLOCATE(XT  (0,0))
93   ALLOCATE(XQ  (0,0))
94   ALLOCATE(XTKE(0,0))
95   ALLOCATE(XLMO(0)  )
96   ALLOCATE(XP  (0,0))
97   ALLOCATE(XDZ (0,0))
98   ALLOCATE(XZF (0,0))
99   ALLOCATE(XDZF(0,0))
100   IF (LHOOK) CALL DR_HOOK('READ_WATFLUX_SBL_N',1,ZHOOK_HANDLE)
101   RETURN
102 ENDIF
103 !
104 !* number of vertical levels
105 !
106 YRECFM='WAT_SBL_LVL'
107  CALL READ_SURF(HPROGRAM,YRECFM,NLVL,IRESP)
108 !
109 !*       2.     Prognostic fields:
110 !               -----------------
111 !
112 !* altitudes
113 !
114 ALLOCATE(XZ(ILU,NLVL))
115 !
116 DO JLAYER=1,NLVL
117   WRITE(YRECFM,'(A9,I2.2,A1)') 'WAT_SBL_Z',JLAYER,' '
118   CALL READ_SURF(HPROGRAM,YRECFM,XZ(:,JLAYER),IRESP)
119 END DO
120 !
121 ALLOCATE(XU  (ILU,NLVL))
122 ALLOCATE(XT  (ILU,NLVL))
123 ALLOCATE(XQ  (ILU,NLVL))
124 ALLOCATE(XTKE(ILU,NLVL))
125 ALLOCATE(XLMO(ILU)     )
126 ALLOCATE(XP  (ILU,NLVL))
127 !
128 IF (IVERSION>7 .OR. IVERSION==7 .AND.IBUGFIX>=2) THEN
129   YRECFM='STORAGETYPE'
130   CALL READ_SURF(HPROGRAM,YRECFM,YREAD,IRESP)
131 ELSE
132   YREAD = 'ALL'
133 ENDIF
134 !
135 IF(YREAD=='ALL') THEN
136   !
137   !* wind in SBL
138   DO JLAYER=1,NLVL
139     WRITE(YRECFM,'(A9,I2.2,A1)') 'WAT_SBL_U',JLAYER,' '
140     CALL READ_SURF(HPROGRAM,YRECFM,XU(:,JLAYER),IRESP)
141   END DO
142   !
143   !* theta in SBL
144   DO JLAYER=1,NLVL
145     WRITE(YRECFM,'(A9,I2.2,A1)') 'WAT_SBL_T',JLAYER,' '
146     CALL READ_SURF(HPROGRAM,YRECFM,XT(:,JLAYER),IRESP)
147   END DO
148   !
149   !* humidity in SBL
150   DO JLAYER=1,NLVL
151     WRITE(YRECFM,'(A9,I2.2,A1)') 'WAT_SBL_Q',JLAYER,' '
152     CALL READ_SURF(HPROGRAM,YRECFM,XQ(:,JLAYER),IRESP)
153   END DO
154   !
155   !* Tke in SBL
156   DO JLAYER=1,NLVL
157     WRITE(YRECFM,'(A9,I2.2,A1)') 'WAT_SBL_E',JLAYER,' '
158     CALL READ_SURF(HPROGRAM,YRECFM,XTKE(:,JLAYER),IRESP)
159   END DO
160   !
161   !* Monin-Obhukov length
162   YRECFM='WAT_SBL_LMO     '
163   CALL READ_SURF(HPROGRAM,YRECFM,XLMO(:),IRESP)
164   !
165   !* Pressure
166   DO JLAYER=1,NLVL
167     WRITE(YRECFM,'(A9,I2.2,A1)') 'WAT_SBL_P',JLAYER,' '
168     CALL READ_SURF(HPROGRAM,YRECFM,XP(:,JLAYER),IRESP)
169   END DO
170   !
171 ELSE
172   XU  (:,:) = XUNDEF
173   XT  (:,:) = XUNDEF
174   XQ  (:,:) = XUNDEF
175   XTKE(:,:) = XUNDEF
176   XLMO(:)   = XUNDEF
177   XP  (:,:) = XUNDEF
178 ENDIF
179 !
180 !
181 !* Grid characteristics
182 !
183 !
184 !  --------------------------------- XZ(k+1)                     XDZ(k+1)
185 !                                                                           ^
186 !                                                                           |
187 !                                                                           |
188 !  - - - - - - - - - - - - - - - - - XZf(k+1)                               | XDZf(k+1)
189 !                                                              ^            |
190 !                                                              |            |
191 !  --------------------------------- XZ(k), XU, XT, XQ, XTKE   | XDZ(k)     V
192 !                                                              |            ^
193 !  - - - - - - - - - - - - - - - - - XZf(k)                    V            | XDZf(k)
194 !  --------------------------------- XZ(k-1)                     XDZ(k-1)   V
195 !  - - - - - - - - - - - - - - - - - XZf(k-1)
196 !
197 ALLOCATE(XDZ (ILU,NLVL))
198 ALLOCATE(XZF (ILU,NLVL))
199 ALLOCATE(XDZF(ILU,NLVL))
200  CALL CANOPY_GRID(ILU,NLVL,XZ,XZF,XDZ,XDZF)
201 !
202 IF (LHOOK) CALL DR_HOOK('READ_WATFLUX_SBL_N',1,ZHOOK_HANDLE)
203 !
204 !-------------------------------------------------------------------------------
205 !
206 END SUBROUTINE READ_WATFLUX_SBL_n