Philippe 07/03/2019: IO bugfix: io_set_mnhversion must be called by all the processes
[MNH-git_open_source-lfs.git] / src / SURFEX / alloc_diag_surf_atmn.F90
1 !SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
2 !SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
3 !SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt  
4 !SFX_LIC for details. version 1.
5 !     #############################################################
6       SUBROUTINE ALLOC_DIAG_SURF_ATM_n (DGO, D, DC, ND, NDC, &
7                        KSIZE_FULL, TPTIME, HPROGRAM,KSW)
8 !     #############################################################
9 !
10 !!    AUTHOR
11 !!    ------
12 !!      V. Masson   *Meteo France*
13 !!
14 !!    MODIFICATIONS
15 !!    -------------
16 !!      Original    01/2004
17 !!      Modified    01/2006 : sea flux parameterization.
18 !!                  08/2009 : TIME_BUDGETC for all Tile
19 !       B. decharme 09/2012 : XQS_TILE not initialize
20 !       B. decharme 04/2013 : Add EVAP and SUBL diag
21 !-------------------------------------------------------------------------------
22 !
23 !*       0.    DECLARATIONS
24 !              ------------
25 !
26 USE MODD_DIAG_n, ONLY : DIAG_t, DIAG_NP_t, DIAG_OPTIONS_t
27 !
28 USE MODD_DATA_COVER_PAR, ONLY : NTILESFC
29 USE MODD_SURF_PAR,       ONLY : XUNDEF
30 !
31 USE MODD_TYPE_DATE_SURF, ONLY : DATE_TIME
32 !
33 USE MODI_READ_SURF
34 !
35 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
36 USE PARKIND1  ,ONLY : JPRB
37 !
38 IMPLICIT NONE
39 !
40 !*       0.1   Declarations of arguments
41 !              -------------------------
42 !
43 TYPE(DIAG_OPTIONS_t), INTENT(INOUT) :: DGO
44 TYPE(DIAG_t), INTENT(INOUT) :: D
45 TYPE(DIAG_t), INTENT(INOUT) :: DC
46 TYPE(DIAG_NP_t), INTENT(INOUT) :: ND
47 TYPE(DIAG_NP_t), INTENT(INOUT) :: NDC
48 !
49 INTEGER, INTENT(IN) :: KSIZE_FULL
50 TYPE(DATE_TIME), INTENT(IN) :: TPTIME
51 !
52  CHARACTER(LEN=6),        INTENT(IN) :: HPROGRAM  ! program calling surf. schemes
53 INTEGER,                 INTENT(IN) :: KSW       ! number of short-wave spectral bands
54 !
55 !*       0.2   Declarations of local variables
56 !              -------------------------------
57 !
58 INTEGER :: JTILE
59 INTEGER           :: IVERSION
60 INTEGER           :: IRESP          ! IRESP  : return-code if a problem appears
61  CHARACTER(LEN=LEN_HREC) :: YREC           ! Name of the article to be read
62 REAL(KIND=JPRB) :: ZHOOK_HANDLE
63 !
64 !-------------------------------------------------------------------------------
65 !
66 IF (LHOOK) CALL DR_HOOK('ALLOC_DIAG_SURF_ATM_N',0,ZHOOK_HANDLE)
67 !
68 ! Initialization: Outputs to atmosphere over each tile:
69 !
70 DO JTILE = 1,NTILESFC
71   !
72   CALL ALLOC_DIAG(ND%AL(JTILE),.FALSE.,KSIZE_FULL,KSW)
73   CALL INIT_DIAG(ND%AL(JTILE),.FALSE.,XUNDEF)
74   !
75 ENDDO
76 !
77 ! Initialization: aggregated fields
78 !
79 CALL ALLOC_DIAG(D,.FALSE.,KSIZE_FULL,KSW)
80 CALL INIT_DIAG(D,.FALSE.,XUNDEF)
81 !
82 ALLOCATE(D%XSFCO2  (KSIZE_FULL))
83 !
84 ALLOCATE(D%XT2M_MIN_ZS    (KSIZE_FULL))
85 ALLOCATE(D%XQ2M_MIN_ZS    (KSIZE_FULL))
86 ALLOCATE(D%XHU2M_MIN_ZS   (KSIZE_FULL))
87 !
88 ALLOCATE(D%XPS            (KSIZE_FULL))
89 ALLOCATE(D%XRHOA          (KSIZE_FULL))
90 !
91 ALLOCATE(D%XSSO_FMU    (KSIZE_FULL))
92 ALLOCATE(D%XSSO_FMV    (KSIZE_FULL))
93 !
94 ALLOCATE(D%XUREF  (KSIZE_FULL))
95 ALLOCATE(D%XZREF  (KSIZE_FULL))
96 ALLOCATE(D%XTRAD  (KSIZE_FULL))
97 ALLOCATE(D%XEMIS  (KSIZE_FULL))
98 !
99 D%XSFCO2   = XUNDEF
100 !
101 D%XT2M_MIN_ZS     = XUNDEF
102 D%XQ2M_MIN_ZS     = XUNDEF
103 D%XHU2M_MIN_ZS    = XUNDEF
104 !
105 D%XPS                 = XUNDEF
106 D%XRHOA               = XUNDEF
107 !
108 D%XSSO_FMU     = XUNDEF
109 D%XSSO_FMV     = XUNDEF
110 !
111 D%XUREF   = XUNDEF
112 D%XZREF   = XUNDEF
113 D%XTRAD   = XUNDEF
114 D%XEMIS   = XUNDEF
115 !
116 IF (DGO%LSURF_BUDGETC) THEN
117   !
118   DO JTILE = 1,NTILESFC
119     !
120     CALL ALLOC_DIAG(NDC%AL(JTILE),.TRUE.,KSIZE_FULL,0)
121     CALL INIT_DIAG(NDC%AL(JTILE),.TRUE.,XUNDEF)
122     !
123   ENDDO
124   !
125   CALL ALLOC_DIAG(DC,.TRUE.,KSIZE_FULL,0)
126   !
127   YREC='BUDC'
128   CALL READ_SURF(HPROGRAM,YREC,DGO%LREAD_BUDGETC,IRESP)
129   !
130   IF (.NOT. DGO%LREAD_BUDGETC .OR. (DGO%LREAD_BUDGETC.AND.DGO%LRESET_BUDGETC)) THEN
131     !
132     DGO%TIME_BUDGETC = TPTIME
133     CALL INIT_DIAG(DC,.TRUE.,0.0)  
134     !
135   ELSE
136     !
137     YREC='TBUDC'
138     CALL READ_SURF(HPROGRAM,YREC,DGO%TIME_BUDGETC,IRESP)
139     !
140     YREC='RNC'
141     CALL READ_SURF(HPROGRAM,YREC,DC%XRN,IRESP)
142     YREC='HC'
143     CALL READ_SURF(HPROGRAM,YREC,DC%XH ,IRESP)
144     YREC='LEC'
145     CALL READ_SURF(HPROGRAM,YREC,DC%XLE,IRESP)
146     YREC='LEIC'
147     CALL READ_SURF(HPROGRAM,YREC,DC%XLEI,IRESP)     
148     YREC='GFLUXC'
149     CALL READ_SURF(HPROGRAM,YREC,DC%XGFLUX ,IRESP)
150     !
151     YREC='SWDC'
152     CALL READ_SURF(HPROGRAM,YREC,DC%XSWD,IRESP)
153     YREC='SWUC'
154     CALL READ_SURF(HPROGRAM,YREC,DC%XSWU,IRESP)
155     YREC='LWDC'
156     CALL READ_SURF(HPROGRAM,YREC,DC%XLWD,IRESP)
157     YREC='LWUC'
158     CALL READ_SURF(HPROGRAM,YREC,DC%XLWU,IRESP)
159     !
160     YREC='FMUC'
161     CALL READ_SURF(HPROGRAM,YREC,DC%XFMU,IRESP)
162     YREC='FMVC'
163     CALL READ_SURF(HPROGRAM,YREC,DC%XFMV,IRESP)   
164     !
165     CALL READ_SURF(HPROGRAM,'VERSION',IVERSION,IRESP)
166     IF (IVERSION<8)THEN
167       DC%XEVAP  = 0.0
168       DC%XSUBL  = 0.0              
169     ELSE
170       YREC='EVAPC'
171       CALL READ_SURF(HPROGRAM,YREC,DC%XEVAP,IRESP)
172       YREC='SUBLC'
173       CALL READ_SURF(HPROGRAM,YREC,DC%XSUBL,IRESP)              
174     ENDIF
175     !     
176   ENDIF
177   !
178 ELSE
179   !
180   DO JTILE=1,NTILESFC
181     CALL ALLOC_DIAG(NDC%AL(JTILE),.TRUE.,0,0)
182   ENDDO
183   !
184   CALL ALLOC_DIAG(DC,.TRUE.,0,0)
185   !
186 ENDIF
187 IF (LHOOK) CALL DR_HOOK('ALLOC_DIAG_SURF_ATM_N',1,ZHOOK_HANDLE)
188 !
189 CONTAINS
190 !
191 SUBROUTINE ALLOC_DIAG(DA,OCUM,KSIZE1,KSIZE2)
192 !
193 TYPE(DIAG_t), INTENT(INOUT) :: DA
194 LOGICAL, INTENT(IN) :: OCUM
195 INTEGER, INTENT(IN) :: KSIZE1
196 INTEGER, INTENT(IN) :: KSIZE2
197 REAL(KIND=JPRB) :: ZHOOK_HANDLE
198 !
199 IF (LHOOK) CALL DR_HOOK('ALLOC_DIAG_SURF_ATM_N:ALLOC_DIAG',0,ZHOOK_HANDLE)
200 !
201 IF (.NOT.OCUM) THEN
202   !
203   ALLOCATE(DA%XRI     (KSIZE1))
204   ALLOCATE(DA%XCD     (KSIZE1))
205   ALLOCATE(DA%XCH     (KSIZE1))
206   ALLOCATE(DA%XCE     (KSIZE1))
207   !
208   ALLOCATE(DA%XT2M    (KSIZE1))
209   ALLOCATE(DA%XTS     (KSIZE1))
210   ALLOCATE(DA%XT2M_MIN(KSIZE1))
211   ALLOCATE(DA%XT2M_MAX(KSIZE1))
212   ALLOCATE(DA%XQ2M    (KSIZE1))
213   ALLOCATE(DA%XHU2M   (KSIZE1))
214   ALLOCATE(DA%XHU2M_MIN(KSIZE1))
215   ALLOCATE(DA%XHU2M_MAX(KSIZE1))
216   ALLOCATE(DA%XZON10M (KSIZE1))
217   ALLOCATE(DA%XMER10M (KSIZE1))
218   !
219   ALLOCATE(DA%XSWBD   (KSIZE1,KSIZE2))
220   ALLOCATE(DA%XSWBU   (KSIZE1,KSIZE2))
221   !
222   ALLOCATE(DA%XQS     (KSIZE1))
223   ALLOCATE(DA%XZ0     (KSIZE1))
224   ALLOCATE(DA%XZ0H    (KSIZE1))
225   !
226   ALLOCATE(DA%XWIND10M(KSIZE1))
227   ALLOCATE(DA%XWIND10M_MAX(KSIZE1))
228   !  
229 ELSE
230   !
231   ALLOCATE(DA%XSWBD   (0,0))
232   ALLOCATE(DA%XSWBU   (0,0))
233   !
234 ENDIF
235 !
236 ALLOCATE(DA%XRN     (KSIZE1))
237 ALLOCATE(DA%XH      (KSIZE1))
238 ALLOCATE(DA%XLE     (KSIZE1))
239 ALLOCATE(DA%XLEI    (KSIZE1))
240 ALLOCATE(DA%XGFLUX  (KSIZE1))
241 ALLOCATE(DA%XEVAP   (KSIZE1))
242 ALLOCATE(DA%XSUBL   (KSIZE1))
243 !
244 ALLOCATE(DA%XSWD    (KSIZE1))
245 ALLOCATE(DA%XSWU    (KSIZE1))
246 !
247 ALLOCATE(DA%XLWD    (KSIZE1))
248 ALLOCATE(DA%XLWU    (KSIZE1))
249 ALLOCATE(DA%XFMU    (KSIZE1))
250 ALLOCATE(DA%XFMV    (KSIZE1))
251 !
252 IF (LHOOK) CALL DR_HOOK('ALLOC_DIAG_SURF_ATM_N:ALLOC_DIAG',1,ZHOOK_HANDLE)
253 !
254 END SUBROUTINE ALLOC_DIAG
255 !
256 SUBROUTINE INIT_DIAG(DA,OCUM,PVAL)
257 !
258 TYPE(DIAG_t), INTENT(INOUT) :: DA
259 LOGICAL, INTENT(IN) :: OCUM
260 REAL, INTENT(IN) :: PVAL
261 REAL(KIND=JPRB) :: ZHOOK_HANDLE
262 !
263 IF (LHOOK) CALL DR_HOOK('ALLOC_DIAG_SURF_ATM_N:INIT_DIAG',0,ZHOOK_HANDLE)
264 !
265 IF (.NOT.OCUM) THEN
266   !
267   DA%XRI      = PVAL
268   DA%XCD      = PVAL
269   DA%XCH      = PVAL
270   DA%XCE      = PVAL
271   !
272   DA%XT2M     = PVAL
273   DA%XTS      = PVAL
274   DA%XT2M_MIN = PVAL
275   DA%XT2M_MAX = PVAL
276   DA%XQ2M     = PVAL
277   DA%XHU2M    = PVAL
278   DA%XHU2M_MIN= PVAL
279   DA%XHU2M_MAX= PVAL
280   DA%XZON10M  = PVAL
281   DA%XMER10M  = PVAL
282   !
283   DA%XSWBD    = PVAL
284   DA%XSWBU    = PVAL
285   !
286   DA%XQS      = PVAL
287   DA%XZ0      = PVAL
288   DA%XZ0H     = PVAL
289   !
290   DA%XWIND10M = PVAL
291   DA%XWIND10M_MAX = PVAL
292   !  
293 ENDIF
294 !
295 DA%XRN      = PVAL
296 DA%XH       = PVAL
297 DA%XLE      = PVAL
298 DA%XLEI     = PVAL
299 DA%XGFLUX   = PVAL
300 DA%XEVAP    = PVAL
301 DA%XSUBL    = PVAL
302 !
303 DA%XSWD     = PVAL
304 DA%XSWU     = PVAL
305 DA%XLWD     = PVAL
306 DA%XLWU     = PVAL
307 DA%XFMU     = PVAL
308 DA%XFMV     = PVAL
309 !
310 IF (LHOOK) CALL DR_HOOK('ALLOC_DIAG_SURF_ATM_N:INIT_DIAG',1,ZHOOK_HANDLE)
311 !
312 END SUBROUTINE INIT_DIAG
313 !
314 !-------------------------------------------------------------------------------
315 !
316 END SUBROUTINE ALLOC_DIAG_SURF_ATM_n