f9bd52a15c4b637b9fd48d97117c71d92b5e3a6f
[MNH-git_open_source-lfs.git] / src / SURFEX / diag_teb_initn.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 DIAG_TEB_INIT_n(HPROGRAM,KLU,KSW)
7 !     #####################
8 !
9 !!****  *DIAG_TEB_INIT_n* - routine to initialize TEB diagnostic variables
10 !!
11 !!    PURPOSE
12 !!    -------
13 !!
14 !!**  METHOD
15 !!    ------
16 !!
17 !!    EXTERNAL
18 !!    --------
19 !!
20 !!
21 !!    IMPLICIT ARGUMENTS
22 !!    ------------------
23 !!
24 !!    REFERENCE
25 !!    ---------
26 !!
27 !!
28 !!    AUTHOR
29 !!    ------
30 !!      V. Masson   *Meteo France*      
31 !!
32 !!    MODIFICATIONS
33 !!    -------------
34 !!      Original    01/2004 
35 !-------------------------------------------------------------------------------
36 !
37 !*       0.    DECLARATIONS
38 !              ------------
39 !
40 USE MODD_SURF_PAR,   ONLY : XUNDEF
41 USE MODD_TYPE_DATE_SURF
42 USE MODD_TEB_n,      ONLY : CBEM
43 USE MODD_DIAG_TEB_n, ONLY : N2M, LSURF_BUDGET, LCOEF, LSURF_VARS, &
44                               XRN, XH, XLE, XGFLUX, XRI,            &
45                               XCD, XCH, XCE, XZ0, XZ0H,             &
46                               XT2M, XQ2M, XHU2M,                    &
47                               XZON10M, XMER10M, XSFCO2, XQS,        &
48                               XSWD, XSWU, XSWBD, XSWBU, XLWD, XLWU, &
49                               XFMU, XFMV  
50 !
51 USE MODD_DIAG_UTCI_TEB_n,   ONLY : XUTCI_OUTSUN, XUTCI_OUTSHADE, XTRAD_SUN, &
52                                    XTRAD_SHADE, XUTCI_IN, LUTCI
53
54 !
55 USE MODI_READ_SURF
56 !
57 !
58 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
59 USE PARKIND1  ,ONLY : JPRB
60 !
61 IMPLICIT NONE
62 !
63 !*       0.1   Declarations of arguments
64 !              -------------------------
65 !
66 INTEGER, INTENT(IN) :: KLU   ! size of arrays
67 INTEGER, INTENT(IN) :: KSW   ! spectral bands
68  CHARACTER(LEN=6), INTENT(IN):: HPROGRAM  ! program calling
69 !
70 !*       0.2   Declarations of local variables
71 !              -------------------------------
72 !
73 INTEGER           :: IRESP          ! IRESP  : return-code if a problem appears
74  CHARACTER(LEN=12) :: YREC           ! Name of the article to be read
75 REAL(KIND=JPRB) :: ZHOOK_HANDLE
76 !
77 !-------------------------------------------------------------------------------
78 !
79 !* surface energy budget
80 !
81 IF (LHOOK) CALL DR_HOOK('DIAG_TEB_INIT_N',0,ZHOOK_HANDLE)
82 IF (LSURF_BUDGET) THEN
83   ALLOCATE(XRN     (KLU))
84   ALLOCATE(XH      (KLU))
85   ALLOCATE(XLE     (KLU))
86   ALLOCATE(XGFLUX  (KLU))
87   ALLOCATE(XSWD    (KLU))
88   ALLOCATE(XSWU    (KLU))
89   ALLOCATE(XSWBD   (KLU,KSW))
90   ALLOCATE(XSWBU   (KLU,KSW))
91   ALLOCATE(XLWD    (KLU))
92   ALLOCATE(XLWU    (KLU))
93   ALLOCATE(XFMU    (KLU))
94   ALLOCATE(XFMV    (KLU))
95   ALLOCATE(XSFCO2  (KLU))
96   !
97   XRN      = XUNDEF
98   XH       = XUNDEF
99   XLE      = XUNDEF
100   XGFLUX   = XUNDEF
101   XSWD     = XUNDEF
102   XSWU     = XUNDEF
103   XSWBD    = XUNDEF
104   XSWBU    = XUNDEF
105   XLWD     = XUNDEF
106   XLWU     = XUNDEF
107   XFMU     = XUNDEF
108   XFMV     = XUNDEF
109   XSFCO2   = XUNDEF
110 ELSE
111   ALLOCATE(XRN     (0))
112   ALLOCATE(XH      (0))
113   ALLOCATE(XLE     (0))
114   ALLOCATE(XGFLUX  (0))
115   ALLOCATE(XSWD    (0))
116   ALLOCATE(XSWU    (0))
117   ALLOCATE(XSWBD   (0,0))
118   ALLOCATE(XSWBU   (0,0))  
119   ALLOCATE(XLWD    (0))
120   ALLOCATE(XLWU    (0))
121   ALLOCATE(XFMU    (0))
122   ALLOCATE(XFMV    (0))
123   ALLOCATE(XSFCO2  (0))
124 END IF
125 !
126 !* parameters at 2m
127 !
128 IF (N2M>=1) THEN
129   ALLOCATE(XRI     (KLU))
130   ALLOCATE(XT2M    (KLU))
131   ALLOCATE(XQ2M    (KLU))
132   ALLOCATE(XHU2M   (KLU))
133   ALLOCATE(XZON10M (KLU))
134   ALLOCATE(XMER10M (KLU))
135   !
136   XRI      = XUNDEF
137   XT2M     = XUNDEF
138   XQ2M     = XUNDEF
139   XHU2M    = XUNDEF
140   XZON10M  = XUNDEF
141   XMER10M  = XUNDEF
142 ELSE
143   ALLOCATE(XRI      (0))
144   ALLOCATE(XT2M     (0))
145   ALLOCATE(XQ2M     (0))
146   ALLOCATE(XHU2M    (0))
147   ALLOCATE(XZON10M  (0))
148   ALLOCATE(XMER10M  (0))  
149 END IF
150 !!
151 !* miscellaneous fields
152 !
153 IF (N2M>0 .AND. LUTCI) THEN
154   !
155   ALLOCATE(XUTCI_IN       (KLU))
156   ALLOCATE(XUTCI_OUTSUN   (KLU))
157   ALLOCATE(XUTCI_OUTSHADE (KLU))
158   ALLOCATE(XTRAD_SUN      (KLU))
159   ALLOCATE(XTRAD_SHADE    (KLU))
160   !
161   XUTCI_IN        = XUNDEF
162   XUTCI_OUTSUN    = XUNDEF
163   XUTCI_OUTSHADE  = XUNDEF
164   XTRAD_SUN       = XUNDEF
165   XTRAD_SHADE     = XUNDEF
166   !  
167 ELSE
168   ALLOCATE(XUTCI_IN       (0))
169   ALLOCATE(XUTCI_OUTSUN   (0))
170   ALLOCATE(XUTCI_OUTSHADE (0))
171   ALLOCATE(XTRAD_SUN      (0))
172   ALLOCATE(XTRAD_SHADE    (0))        
173 ENDIF
174 !
175 !* transfer coefficients
176 !
177 IF (LCOEF) THEN
178   ALLOCATE(XCD     (KLU))
179   ALLOCATE(XCH     (KLU))
180   ALLOCATE(XCE     (KLU))
181   ALLOCATE(XZ0     (KLU))
182   ALLOCATE(XZ0H    (KLU))
183   !
184   XCD      = XUNDEF
185   XCH      = XUNDEF
186   XCE      = XUNDEF
187   XZ0      = XUNDEF
188   XZ0H     = XUNDEF
189 ELSE
190   ALLOCATE(XCD     (0))
191   ALLOCATE(XCH     (0))
192   ALLOCATE(XCE     (0))
193   ALLOCATE(XZ0     (0))
194   ALLOCATE(XZ0H    (0))
195 END IF
196 !
197 !
198 !* surface humidity
199 !
200 IF (LSURF_VARS) THEN
201   ALLOCATE(XQS     (KLU))
202   !
203   XQS      = XUNDEF
204 ELSE
205   ALLOCATE(XQS     (0))  
206 END IF
207 IF (LHOOK) CALL DR_HOOK('DIAG_TEB_INIT_N',1,ZHOOK_HANDLE)
208 !
209 !-------------------------------------------------------------------------------
210 !
211 END SUBROUTINE DIAG_TEB_INIT_n