SURFEX v8.1
General documentation of Surfex
ini_var_from_data.F90
Go to the documentation of this file.
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 MODULE modi_ini_var_from_data
6 !
7 INTERFACE ini_var_from_data
8 !
9 SUBROUTINE ini_var_from_data_nat_1d (DTCO, UG, U, USS, PPAR_VEGTYPE, &
10  HPROGRAM, HATYPE, HNAME, HTYPE, HFNAM, HFTYP, PUNIF, PFIELD, OPRESENT)
11 !
12 USE modd_data_cover_n, ONLY : data_cover_t
13 USE modd_surf_atm_grid_n, ONLY : surf_atm_grid_t
14 USE modd_surf_atm_n, ONLY : surf_atm_t
15 USE modd_sso_n, ONLY : sso_t
16 !
17 TYPE(data_cover_t), INTENT(INOUT) :: DTCO
18 TYPE(surf_atm_grid_t), INTENT(INOUT) :: UG
19 TYPE(surf_atm_t), INTENT(INOUT) :: U
20 TYPE(sso_t), INTENT(INOUT) :: USS
21 !
22 REAL, DIMENSION(:,:), INTENT(IN) :: PPAR_VEGTYPE
23 !
24  CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM
25  CHARACTER(LEN=3), INTENT(IN) :: HATYPE
26  CHARACTER(LEN=*), INTENT(IN) :: HNAME
27  CHARACTER(LEN=3), INTENT(IN) :: HTYPE
28  CHARACTER(LEN=28), DIMENSION(:), INTENT(IN) :: HFNAM
29  CHARACTER(LEN=6), DIMENSION(:), INTENT(INOUT) :: HFTYP
30 REAL, DIMENSION(:), INTENT(IN) :: PUNIF
31 REAL, DIMENSION(:,:), INTENT(OUT) :: PFIELD
32 LOGICAL, DIMENSION(:), INTENT(OUT) :: OPRESENT
33 !
34 END SUBROUTINE ini_var_from_data_nat_1d
35 !
36 SUBROUTINE ini_var_from_data_1d (DTCO, UG, U, USS, &
37  HPROGRAM, HATYPE, HNAME, HTYPE, HFNAM, HFTYP, PUNIF, PFIELD, OPRESENT)
38 !
39 USE modd_data_cover_n, ONLY : data_cover_t
40 USE modd_surf_atm_grid_n, ONLY : surf_atm_grid_t
41 USE modd_surf_atm_n, ONLY : surf_atm_t
42 USE modd_sso_n, ONLY : sso_t
43 !
44 TYPE(data_cover_t), INTENT(INOUT) :: DTCO
45 TYPE(surf_atm_grid_t), INTENT(INOUT) :: UG
46 TYPE(surf_atm_t), INTENT(INOUT) :: U
47 TYPE(sso_t), INTENT(INOUT) :: USS
48 !
49  CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM
50  CHARACTER(LEN=3), INTENT(IN) :: HATYPE
51  CHARACTER(LEN=*), INTENT(IN) :: HNAME
52  CHARACTER(LEN=3), INTENT(IN) :: HTYPE
53  CHARACTER(LEN=28), DIMENSION(:), INTENT(IN) :: HFNAM
54  CHARACTER(LEN=6), DIMENSION(:), INTENT(INOUT) :: HFTYP
55 REAL, DIMENSION(:), INTENT(IN) :: PUNIF
56 REAL, DIMENSION(:,:), INTENT(OUT) :: PFIELD
57 LOGICAL, INTENT(OUT) :: OPRESENT
58 !
59 END SUBROUTINE ini_var_from_data_1d
60 !
61 !
62  SUBROUTINE ini_var_from_data_nat_2d (DTCO, UG, U, USS, PPAR_VEGTYPE, &
63  HPROGRAM, HATYPE, HNAME, HTYPE, HFNAM, HFTYP, PUNIF, PFIELD_TIME, OPRESENT)
64 !
65 USE modd_data_cover_n, ONLY : data_cover_t
66 USE modd_surf_atm_grid_n, ONLY : surf_atm_grid_t
67 USE modd_surf_atm_n, ONLY : surf_atm_t
68 USE modd_sso_n, ONLY : sso_t
69 !
70 REAL, DIMENSION(:,:), INTENT(IN) :: PPAR_VEGTYPE
71 !
72 TYPE(data_cover_t), INTENT(INOUT) :: DTCO
73 TYPE(surf_atm_grid_t), INTENT(INOUT) :: UG
74 TYPE(surf_atm_t), INTENT(INOUT) :: U
75 TYPE(sso_t), INTENT(INOUT) :: USS
76 !
77  CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM
78  CHARACTER(LEN=3), INTENT(IN) :: HATYPE
79  CHARACTER(LEN=*), INTENT(IN) :: HNAME
80  CHARACTER(LEN=3), INTENT(IN) :: HTYPE
81  CHARACTER(LEN=28), DIMENSION(:,:), INTENT(IN) :: HFNAM
82  CHARACTER(LEN=6), DIMENSION(:,:), INTENT(INOUT) :: HFTYP
83 REAL, DIMENSION(:,:), INTENT(IN) :: PUNIF
84 REAL, DIMENSION(:,:,:), INTENT(OUT) :: PFIELD_TIME
85 LOGICAL, DIMENSION(:), INTENT(OUT) :: OPRESENT
86 !
87 END SUBROUTINE ini_var_from_data_nat_2d
88 !
89 !
90  SUBROUTINE ini_var_from_data_2d (DTCO, UG, U, USS, &
91  HPROGRAM, HATYPE, HNAME, HTYPE, HFNAM, HFTYP, PUNIF, PFIELD_TIME, OPRESENT)
92 !
93 USE modd_data_cover_n, ONLY : data_cover_t
94 USE modd_surf_atm_grid_n, ONLY : surf_atm_grid_t
95 USE modd_surf_atm_n, ONLY : surf_atm_t
96 USE modd_sso_n, ONLY : sso_t
97 !
98 TYPE(data_cover_t), INTENT(INOUT) :: DTCO
99 TYPE(surf_atm_grid_t), INTENT(INOUT) :: UG
100 TYPE(surf_atm_t), INTENT(INOUT) :: U
101 TYPE(sso_t), INTENT(INOUT) :: USS
102 !
103  CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM
104  CHARACTER(LEN=3), INTENT(IN) :: HATYPE
105  CHARACTER(LEN=*), INTENT(IN) :: HNAME
106  CHARACTER(LEN=3), INTENT(IN) :: HTYPE
107  CHARACTER(LEN=28), DIMENSION(:,:), INTENT(IN) :: HFNAM
108  CHARACTER(LEN=6), DIMENSION(:,:), INTENT(INOUT) :: HFTYP
109 REAL, DIMENSION(:,:), INTENT(IN) :: PUNIF
110 REAL, DIMENSION(:,:,:), INTENT(OUT) :: PFIELD_TIME
111 LOGICAL, INTENT(OUT) :: OPRESENT
112 !
113 END SUBROUTINE ini_var_from_data_2d
114 !
115 !
116 END INTERFACE ini_var_from_data
117 !
118 END MODULE modi_ini_var_from_data
119 !
120 !
121 ! #########
122  SUBROUTINE ini_var_from_data_nat_1d (DTCO, UG, U, USS, PPAR_VEGTYPE, &
123  HPROGRAM, HATYPE, HNAME ,HTYPE, HFNAM, HFTYP, PUNIF, PFIELD, OPRESENT)
124 ! ##############################################################
125 !
126 !* 0. DECLARATION
127 ! -----------
128 !
129 USE modd_data_cover_n, ONLY : data_cover_t
130 USE modd_surf_atm_grid_n, ONLY : surf_atm_grid_t
131 USE modd_surf_atm_n, ONLY : surf_atm_t
132 USE modd_sso_n, ONLY : sso_t
133 !
134 USE modd_surf_par, ONLY : xundef
135 USE modd_data_cover_par, ONLY : nvegtype
136 !
137 USE modi_ini_var_from_data_0d
138 USE modi_abor1_sfx
139 !
140 USE yomhook ,ONLY : lhook, dr_hook
141 USE parkind1 ,ONLY : jprb
142 !
143 IMPLICIT NONE
144 !
145 !* 0.1 Declaration of arguments
146 ! ------------------------
147 !
148 TYPE(data_cover_t), INTENT(INOUT) :: DTCO
149 TYPE(surf_atm_grid_t), INTENT(INOUT) :: UG
150 TYPE(surf_atm_t), INTENT(INOUT) :: U
151 TYPE(sso_t), INTENT(INOUT) :: USS
152 REAL, DIMENSION(:,:), INTENT(IN) :: PPAR_VEGTYPE
153 !
154  CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM
155  CHARACTER(LEN=3), INTENT(IN) :: HATYPE
156  CHARACTER(LEN=*), INTENT(IN) :: HNAME
157  CHARACTER(LEN=3), INTENT(IN) :: HTYPE
158  CHARACTER(LEN=28), DIMENSION(:), INTENT(INOUT) :: HFNAM
159  CHARACTER(LEN=6), DIMENSION(:), INTENT(INOUT) :: HFTYP
160 REAL, DIMENSION(:), INTENT(INOUT) :: PUNIF
161 REAL, DIMENSION(:,:), INTENT(OUT) :: PFIELD
162 LOGICAL, DIMENSION(:), INTENT(OUT) :: OPRESENT
163 !
164 !
165 !* 0.2 Declaration of local variables
166 ! ------------------------------
167 !
168 REAL, DIMENSION(SIZE(PPAR_VEGTYPE,1)) :: ZMASK
169  CHARACTER(LEN=40) :: YNAME
170 INTEGER :: JV, JV2 ! loop counter on vegtypes
171 !
172 REAL(KIND=JPRB) :: ZHOOK_HANDLE
173 !
174 
175 !-------------------------------------------------------------------------------
176 !
177 !* 1. Initializations
178 ! ---------------
179 !
180 IF (lhook) &
181  CALL dr_hook('MODI_INI_VAR_FROM_DATA:INI_VAR_FROM_DATA_NAT_1D',0,zhook_handle)
182 !
183 opresent(:) = .false.
184 !
185 yname=adjustl(hname)
186 !
187 IF (hftyp(1)=='DIRTYP') THEN
188 
189  CALL ini_var_from_data_0d(dtco, ug, u, uss, &
190  hprogram, hatype, hname, htype, hfnam(1), &
191  hftyp(1), punif(1), pfield, opresent(1), ppar_vegtype)
192 
193  opresent(2:) = opresent(1)
194 
195 
196 ELSE
197 
198  IF (.NOT.all(len_trim(hfnam(:))/=0) .AND. .NOT.all(len_trim(hfnam(2:))==0)) THEN
199  DO jv=1,SIZE(pfield,2)
200  IF (len_trim(hfnam(jv))==0) THEN
201  DO jv2=jv-1,1,-1
202  IF (len_trim(hfnam(jv2))/=0) THEN
203  hfnam(jv) = hfnam(jv2)
204  hftyp(jv) = hftyp(jv2)
205  ENDIF
206  ENDDO
207  ENDIF
208  ENDDO
209  ENDIF
210 
211  DO jv=1,SIZE(pfield,2)
212 
213  IF (all(len_trim(hfnam(2:))==0)) THEN
214  zmask(:) = 1.
215  ELSE
216  zmask(:) = ppar_vegtype(:,jv)
217  ENDIF
218 
219  CALL ini_var_from_data_0d(dtco, ug, u, uss, &
220  hprogram, hatype, hname, htype, hfnam(jv), &
221  hftyp(jv), punif(jv), pfield(:,jv), opresent(jv), zmask)
222  ENDDO
223 
224 ENDIF
225 !
226 IF (lhook) &
227  CALL dr_hook('MODI_INI_VAR_FROM_DATA:INI_VAR_FROM_DATA_NAT_1D',1,zhook_handle)
228 !
229 !-------------------------------------------------------------------------------
230 !
231 END SUBROUTINE ini_var_from_data_nat_1d
232 !
233 !
234 ! #########
235  SUBROUTINE ini_var_from_data_1d (DTCO, UG, U, USS, &
236  HPROGRAM, HATYPE, HNAME ,HTYPE, HFNAM, HFTYP, PUNIF, PFIELD, OPRESENT)
237 ! ##############################################################
238 !
239 !!
240 !! PURPOSE
241 !! -------
242 !!
243 !! METHOD
244 !! ------
245 !!
246 !
247 !! EXTERNAL
248 !! --------
249 !!
250 !! IMPLICIT ARGUMENTS
251 !! ------------------
252 !!
253 !! REFERENCE
254 !! ---------
255 !!
256 !! AUTHOR
257 !! ------
258 !!
259 !! S. Faroux Meteo-France
260 !!
261 !! MODIFICATION
262 !! ------------
263 !!
264 !! Original 16/11/10
265 !!
266 !----------------------------------------------------------------------------
267 !
268 !* 0. DECLARATION
269 ! -----------
270 !
271 USE modd_data_cover_n, ONLY : data_cover_t
272 USE modd_surf_atm_grid_n, ONLY : surf_atm_grid_t
273 USE modd_surf_atm_n, ONLY : surf_atm_t
274 USE modd_sso_n, ONLY : sso_t
275 !
276 USE modd_data_cover_par, ONLY : nvegtype
277 !
278 USE modi_ini_var_from_data_0d
279 USE modi_abor1_sfx
280 !
281 USE yomhook ,ONLY : lhook, dr_hook
282 USE parkind1 ,ONLY : jprb
283 !
284 IMPLICIT NONE
285 !
286 !* 0.1 Declaration of arguments
287 ! ------------------------
288 !
289 TYPE(data_cover_t), INTENT(INOUT) :: DTCO
290 TYPE(surf_atm_grid_t), INTENT(INOUT) :: UG
291 TYPE(surf_atm_t), INTENT(INOUT) :: U
292 TYPE(sso_t), INTENT(INOUT) :: USS
293 !
294  CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM
295  CHARACTER(LEN=3), INTENT(IN) :: HATYPE
296  CHARACTER(LEN=*), INTENT(IN) :: HNAME
297  CHARACTER(LEN=3), INTENT(IN) :: HTYPE
298  CHARACTER(LEN=28), DIMENSION(:), INTENT(IN) :: HFNAM
299  CHARACTER(LEN=6), DIMENSION(:), INTENT(INOUT) :: HFTYP
300 REAL, DIMENSION(:), INTENT(IN) :: PUNIF
301 REAL, DIMENSION(:,:), INTENT(OUT) :: PFIELD
302 LOGICAL, INTENT(OUT) :: OPRESENT
303 !
304 !
305 !* 0.2 Declaration of local variables
306 ! ------------------------------
307 !
308  CHARACTER(LEN=40) :: YNAME
309 LOGICAL, DIMENSION(SIZE(PFIELD,2)) :: LPRESENT
310 INTEGER :: JV, JJ ! loop counter on vegtypes
311 !
312 REAL(KIND=JPRB) :: ZHOOK_HANDLE
313 !
314 
315 !-------------------------------------------------------------------------------
316 !
317 !* 1. Initializations
318 ! ---------------
319 !
320 IF (lhook) &
321  CALL dr_hook('MODI_INI_VAR_FROM_DATA:INI_VAR_FROM_DATA_1D',0,zhook_handle)
322 !
323 opresent=.false.
324 yname=adjustl(hname)
325 !
326 DO jv=1,SIZE(pfield,2)
327  CALL ini_var_from_data_0d(dtco, ug, u, uss, &
328  hprogram, hatype, hname, htype, hfnam(jv), &
329  hftyp(jv), punif(jv), pfield(:,jv), lpresent(jv))
330 ENDDO
331 !
332 IF (any(lpresent(:))) THEN
333 
334  opresent=.true.
335 
336  IF (.NOT.all(lpresent)) THEN
337  CALL abor1_sfx("INI_VAR_FROM_DATA_1D: MISSING INPUT DATA FOR "//hname)
338  ENDIF
339 
340 ENDIF
341 !
342 IF (lhook) &
343  CALL dr_hook('MODI_INI_VAR_FROM_DATA:INI_VAR_FROM_DATA_1D',1,zhook_handle)
344 !
345 !-------------------------------------------------------------------------------
346 !
347 END SUBROUTINE ini_var_from_data_1d
348 !
349 !
350 ! #########
351  SUBROUTINE ini_var_from_data_nat_2d (DTCO, UG, U, USS, PPAR_VEGTYPE, &
352  HPROGRAM, HATYPE, HNAME, HTYPE, HFNAM, HFTYP, PUNIF, PFIELD_TIME, OPRESENT)
353 ! ##############################################################
354 !
355 !
356 !* 0. DECLARATION
357 ! -----------
358 !
359 USE modd_data_cover_n, ONLY : data_cover_t
360 USE modd_surf_atm_grid_n, ONLY : surf_atm_grid_t
361 USE modd_surf_atm_n, ONLY : surf_atm_t
362 USE modd_sso_n, ONLY : sso_t
363 !
364 USE modd_surf_par, ONLY : xundef
365 USE modd_pgdwork, ONLY : nsize
366 USE modd_data_cover_par, ONLY : nvegtype
367 !
368 USE modi_abor1_sfx
369 USE modi_ini_var_from_data_0d
370 !
371 USE yomhook ,ONLY : lhook, dr_hook
372 USE parkind1 ,ONLY : jprb
373 !
374 IMPLICIT NONE
375 !
376 !* 0.1 Declaration of arguments
377 ! ------------------------
378 !
379 TYPE(data_cover_t), INTENT(INOUT) :: DTCO
380 TYPE(surf_atm_grid_t), INTENT(INOUT) :: UG
381 TYPE(surf_atm_t), INTENT(INOUT) :: U
382 TYPE(sso_t), INTENT(INOUT) :: USS
383 !
384 REAL, DIMENSION(:,:), INTENT(IN) :: PPAR_VEGTYPE
385 !
386  CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM
387  CHARACTER(LEN=3), INTENT(IN) :: HATYPE
388  CHARACTER(LEN=*), INTENT(IN) :: HNAME
389  CHARACTER(LEN=3), INTENT(IN) :: HTYPE
390  CHARACTER(LEN=28), DIMENSION(:,:), INTENT(INOUT) :: HFNAM
391  CHARACTER(LEN=6), DIMENSION(:,:), INTENT(INOUT) :: HFTYP
392 REAL, DIMENSION(:,:), INTENT(INOUT) :: PUNIF
393 REAL, DIMENSION(:,:,:), INTENT(OUT) :: PFIELD_TIME
394 LOGICAL, DIMENSION(:), INTENT(OUT) :: OPRESENT
395 !
396 !
397 !* 0.2 Declaration of local variables
398 ! ------------------------------
399 !
400 REAL, DIMENSION(SIZE(PPAR_VEGTYPE,1)) :: ZMASK
401 INTEGER :: JV, JJ, JV2 ! loop counter on vegtypes
402 INTEGER :: JTIME
403 INTEGER :: ITIME, ISIZE_V, IDX
404 !
405 REAL(KIND=JPRB) :: ZHOOK_HANDLE
406 !
407 
408 !-------------------------------------------------------------------------------
409 !
410 !* 1. Initializations
411 ! ---------------
412 !
413 IF (lhook) &
414  CALL dr_hook('MODI_INI_VAR_FROM_DATA:INI_VAR_FROM_DATA_NAT_2D',0,zhook_handle)
415 !
416 opresent(:)=.false.
417 itime=0
418 !
419 isize_v = SIZE(pfield_time,3)
420 !
421 DO jtime=1,SIZE(pfield_time,2)
422 !
423  IF (hftyp(1,jtime)=='DIRTYP') THEN
424 
425  IF (SIZE(opresent)>isize_v) THEN
426  idx = (jtime-1)*isize_v+1
427  ELSE
428  idx = 1
429  ENDIF
430  CALL ini_var_from_data_0d(dtco, ug, u, uss, &
431  hprogram, hatype, hname, htype, hfnam(1,jtime), &
432  hftyp(1,jtime), punif(1,jtime), pfield_time(:,jtime,:), &
433  opresent(idx), ppar_vegtype)
434  opresent(idx+1:idx+isize_v-1) = opresent(idx)
435 
436  ELSE
437 
438  IF (.NOT.all(len_trim(hfnam(:,jtime))/=0) .AND. &
439  count(len_trim(hfnam(:,jtime))/=0)>1) THEN
440  DO jv=1,SIZE(pfield_time,3)
441  IF (len_trim(hfnam(jv,jtime))==0) THEN
442  DO jv2=jv-1,1,-1
443  IF (len_trim(hfnam(jv2,jtime))/=0) THEN
444  hfnam(jv,jtime) = hfnam(jv2,jtime)
445  hftyp(jv,jtime) = hftyp(jv2,jtime)
446  ENDIF
447  ENDDO
448  ENDIF
449  ENDDO
450  ENDIF
451 
452  IF (.NOT.all(punif(:,jtime)/=xundef) .AND. &
453  count(punif(:,jtime)/=xundef)>1) THEN
454  DO jv=1,SIZE(pfield_time,3)
455  IF (punif(jv,jtime)==xundef) THEN
456  DO jv2=jv-1,1,-1
457  IF (punif(jv2,jtime)/=xundef) THEN
458  punif(jv,jtime) = punif(jv2,jtime)
459  ENDIF
460  ENDDO
461  ENDIF
462  ENDDO
463  ENDIF
464 
465  DO jv=1,isize_v
466 
467  IF (SIZE(opresent)>isize_v) THEN
468  idx = (jtime-1)*isize_v+jv
469  ELSE
470  idx = jv
471  ENDIF
472 
473  IF (all(len_trim(hfnam(2:,jtime))==0)) THEN
474  zmask(:) = 1.
475  ELSE
476  zmask(:) = ppar_vegtype(:,jv)
477  ENDIF
478 
479  CALL ini_var_from_data_0d(dtco, ug, u, uss, &
480  hprogram, hatype, hname, htype, hfnam(jv,jtime), &
481  hftyp(jv,jtime), punif(jv,jtime), pfield_time(:,jtime,jv), &
482  opresent(idx), zmask)
483  ENDDO
484 
485  ENDIF
486 
487 ENDDO
488 !
489 !print*,HNAME
490 IF (SIZE(opresent)>isize_v) THEN
491  DO jv = 1,isize_v
492  DO jtime=1,SIZE(pfield_time,2)-1
493  IF (opresent((jtime-1)*isize_v+jv).NEQV.opresent(jtime*isize_v+jv)) THEN
494  CALL abor1_sfx("INI_VAR_FROM_DATA: "//trim(hname)//" - CHECK NTIME AND ADAPT NUMBER OF DATA TO NTIME")
495  ENDIF
496  ENDDO
497  ENDDO
498 ENDIF
499 !
500 
501 IF (lhook) CALL dr_hook('MODI_INI_VAR_FROM_DATA:INI_VAR_FROM_DATA_NAT_2D',1,zhook_handle)
502 !
503 !-------------------------------------------------------------------------------
504 !
505 END SUBROUTINE ini_var_from_data_nat_2d
506 !
507 !
508 ! #########
509  SUBROUTINE ini_var_from_data_2d (DTCO, UG, U, USS, &
510  HPROGRAM, HATYPE, HNAME, HTYPE, HFNAM, HFTYP, PUNIF, PFIELD_TIME, OPRESENT)
511 ! ##############################################################
512 !
513 !!
514 !! PURPOSE
515 !! -------
516 !!
517 !! METHOD
518 !! ------
519 !!
520 !
521 !! EXTERNAL
522 !! --------
523 !!
524 !! IMPLICIT ARGUMENTS
525 !! ------------------
526 !!
527 !! REFERENCE
528 !! ---------
529 !!
530 !! AUTHOR
531 !! ------
532 !!
533 !! S. Faroux Meteo-France
534 !!
535 !! MODIFICATION
536 !!
537 !! Original 16/11/10
538 !!
539 !----------------------------------------------------------------------------
540 !
541 !* 0. DECLARATION
542 ! -----------
543 !
544 USE modd_data_cover_n, ONLY : data_cover_t
545 USE modd_surf_atm_grid_n, ONLY : surf_atm_grid_t
546 USE modd_surf_atm_n, ONLY : surf_atm_t
547 USE modd_sso_n, ONLY : sso_t
548 !
549 USE modd_data_cover_par, ONLY : nvegtype
550 !
551 USE modi_ini_var_from_data_0d
552 USE modi_put_in_time
553 !
554 USE yomhook ,ONLY : lhook, dr_hook
555 USE parkind1 ,ONLY : jprb
556 !
557 USE modi_abor1_sfx
558 !
559 IMPLICIT NONE
560 !
561 !* 0.1 Declaration of arguments
562 ! ------------------------
563 !
564 TYPE(data_cover_t), INTENT(INOUT) :: DTCO
565 TYPE(surf_atm_grid_t), INTENT(INOUT) :: UG
566 TYPE(surf_atm_t), INTENT(INOUT) :: U
567 TYPE(sso_t), INTENT(INOUT) :: USS
568 !
569  CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM
570  CHARACTER(LEN=3), INTENT(IN) :: HATYPE
571  CHARACTER(LEN=*), INTENT(IN) :: HNAME
572  CHARACTER(LEN=3), INTENT(IN) :: HTYPE
573  CHARACTER(LEN=28), DIMENSION(:,:), INTENT(IN) :: HFNAM
574  CHARACTER(LEN=6), DIMENSION(:,:), INTENT(INOUT) :: HFTYP
575 REAL, DIMENSION(:,:), INTENT(IN) :: PUNIF
576 REAL, DIMENSION(:,:,:), INTENT(OUT) :: PFIELD_TIME
577 LOGICAL, INTENT(OUT) :: OPRESENT
578 !
579 !
580 !* 0.2 Declaration of local variables
581 ! ------------------------------
582 !
583 LOGICAL, DIMENSION(SIZE(PFIELD_TIME,3)) :: LPRESENT
584 LOGICAL, DIMENSION(SIZE(PFIELD_TIME,2)) :: LPRESENT_TIME
585 INTEGER :: JV, JJ ! loop counter on vegtypes
586 INTEGER :: JTIME
587 INTEGER :: ITIME
588 !
589 REAL(KIND=JPRB) :: ZHOOK_HANDLE
590 !
591 
592 !-------------------------------------------------------------------------------
593 !
594 !* 1. Initializations
595 ! ---------------
596 !
597 IF (lhook) &
598  CALL dr_hook('MODI_INI_VAR_FROM_DATA:INI_VAR_FROM_DATA_2D',0,zhook_handle)
599 !
600 opresent=.false.
601 lpresent_time(:)=.false.
602 itime=0
603 !
604 DO jtime=1,SIZE(pfield_time,2)
605 
606  DO jv=1,SIZE(pfield_time,3)
607 
608  CALL ini_var_from_data_0d(dtco, ug, u, uss, &
609  hprogram, hatype, hname, htype, hfnam(jv,jtime), &
610  hftyp(jv,jtime), punif(jv,jtime), pfield_time(:,jtime,jv),&
611  lpresent(jv))
612 
613  ENDDO
614 
615  IF (any(lpresent(:))) THEN
616 
617  lpresent_time(jtime)=.true.
618  opresent=.true.
619  itime=itime+1
620 
621  IF (.NOT.all(lpresent)) THEN
622  CALL abor1_sfx("INI_VAR_FROM_DATA_2D: MISSING INPUT DATA FOR "//hname)
623  ENDIF
624 
625  ENDIF
626 
627 ENDDO
628 !
629 IF (opresent) THEN
630  IF (SIZE(pfield_time,2)==36) THEN
631  CALL put_in_time(hname,htype,itime,36,pfield_time)
632  ELSE
633  IF (any(lpresent_time(:)) .AND. .NOT.all(lpresent_time(:))) &
634  CALL abor1_sfx("INI_VAR_FROM_DATA_2D: MISSING INPUT DATA FOR "//hname)
635  ENDIF
636 ENDIF
637 !
638 !
639 IF (lhook) &
640  CALL dr_hook('MODI_INI_VAR_FROM_DATA:INI_VAR_FROM_DATA_2D',1,zhook_handle)
641 !
642 !-------------------------------------------------------------------------------
643 !
644 END SUBROUTINE ini_var_from_data_2d
modi_ini_var_from_data_0d::ini_var_from_data_0d
Definition: ini_var_from_data_0d.F90:7
modd_surf_atm_n::surf_atm_t
Definition: modd_surf_atmn.F90:42
modd_surf_par
Definition: modd_surf_par.F90:6
modd_sso_n
Definition: modd_sson.F90:6
yomhook::dr_hook
Definition: yomhook.F90:20
ini_var_from_data_2d
subroutine ini_var_from_data_2d(DTCO, UG, U, USS, HPROGRAM, HATYPE, HNAME, HTYPE, HFNAM, HFTYP, PUNIF, PFIELD_TIME, OPRESENT)
Definition: ini_var_from_data.F90:511
ini_var_from_data_nat_1d
subroutine ini_var_from_data_nat_1d(DTCO, UG, U, USS, PPAR_VEGTYPE, HPROGRAM, HATYPE, HNAME, HTYPE, HFNAM, HFTYP, PUNIF, PFIELD, OPRESENT)
Definition: ini_var_from_data.F90:124
modd_surf_atm_grid_n::surf_atm_grid_t
Definition: modd_surf_atm_gridn.F90:40
modi_ini_var_from_data
Definition: ini_var_from_data.F90:5
abor1_sfx
subroutine abor1_sfx(YTEXT)
Definition: abor1_sfx.F90:7
modd_surf_par::xundef
real, parameter xundef
Definition: modd_surf_par.F90:43
modi_ini_var_from_data::ini_var_from_data
Definition: ini_var_from_data.F90:7
modi_ini_var_from_data_0d
Definition: ini_var_from_data_0d.F90:5
put_in_time
subroutine put_in_time(HNAME, HTYPE, NTIME1, NTIME2, PDATA)
Definition: put_in_time.F90:6
parkind1::jprb
integer, parameter jprb
Definition: parkind1.F90:32
ini_var_from_data_1d
subroutine ini_var_from_data_1d(DTCO, UG, U, USS, HPROGRAM, HATYPE, HNAME, HTYPE, HFNAM, HFTYP, PUNIF, PFIELD, OPRESENT)
Definition: ini_var_from_data.F90:237
modd_pgdwork
Definition: modd_pgdwork.F90:6
modd_data_cover_n
Definition: modd_data_covern.F90:6
modd_surf_atm_n
Definition: modd_surf_atmn.F90:6
ini_var_from_data_nat_2d
subroutine ini_var_from_data_nat_2d(DTCO, UG, U, USS, PPAR_VEGTYPE, HPROGRAM, HATYPE, HNAME, HTYPE, HFNAM, HFTYP, PUNIF, PFIELD_TIME, OPRESENT)
Definition: ini_var_from_data.F90:353
modd_surf_atm_grid_n
Definition: modd_surf_atm_gridn.F90:6
yomhook::lhook
logical lhook
Definition: yomhook.F90:15
modd_sso_n::sso_t
Definition: modd_sson.F90:41
modd_pgdwork::nsize
integer, dimension(:,:), allocatable nsize
Definition: modd_pgdwork.F90:63
modd_data_cover_n::data_cover_t
Definition: modd_data_covern.F90:43
count
static int count
Definition: memory_hook.c:21
Generated on Tue Jan 16 2018 16:23:29 for SURFEX v8.1 by   doxygen 1.8.13