SURFEX  V8_0
Surfex V8_0 release
 All Classes Files Functions Variables
pgd_teb_garden_par.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 ! #########
6  SUBROUTINE pgd_teb_garden_par (DTCO, UG, U, USS, TG, GDM, &
7  hprogram)
8 ! ##############################################################
9 !
10 !!**** *PGD_TEB_GARDEN_PAR* monitor for averaging and interpolations of cover fractions
11 !!
12 !! PURPOSE
13 !! -------
14 !!
15 !! METHOD
16 !! ------
17 !!
18 !
19 !! EXTERNAL
20 !! --------
21 !!
22 !! IMPLICIT ARGUMENTS
23 !! ------------------
24 !!
25 !! REFERENCE
26 !! ---------
27 !!
28 !! AUTHOR
29 !! ------
30 !!
31 !! A. Lemonsu Meteo-France
32 !!
33 !! MODIFICATION
34 !! ------------
35 !!
36 !! Original 09/2009
37 !!
38 !----------------------------------------------------------------------------
39 !
40 !* 0. DECLARATION
41 ! -----------
42 !
43 !
44 !
45 USE modd_data_cover_n, ONLY : data_cover_t
46 USE modd_surf_atm_grid_n, ONLY : surf_atm_grid_t
47 USE modd_surf_atm_n, ONLY : surf_atm_t
48 USE modd_surf_atm_sso_n, ONLY : surf_atm_sso_t
49 USE modd_teb_grid_n, ONLY : teb_grid_t
50 USE modd_surfex_n, ONLY : teb_garden_model_t
51 !
52 USE modd_data_cover_par, ONLY : nvegtype
53 USE modd_surf_par, ONLY : xundef
54 !
55 USE modd_pgdwork, ONLY : catype
56 !
57 USE modi_get_luout
58 USE modi_open_namelist
59 USE modi_close_namelist
60 USE modi_pgd_field
61 USE modi_abor1_sfx
62 !
63 USE mode_pos_surf
64 !
65 !
66 USE yomhook ,ONLY : lhook, dr_hook
67 USE parkind1 ,ONLY : jprb
68 !
69 IMPLICIT NONE
70 !
71 !* 0.1 Declaration of arguments
72 ! ------------------------
73 !
74 !
75 TYPE(data_cover_t), INTENT(INOUT) :: dtco
76 TYPE(surf_atm_grid_t), INTENT(INOUT) :: ug
77 TYPE(surf_atm_t), INTENT(INOUT) :: u
78 TYPE(surf_atm_sso_t), INTENT(INOUT) :: uss
79 TYPE(teb_grid_t), INTENT(INOUT) :: tg
80 TYPE(teb_garden_model_t), INTENT(INOUT) :: gdm
81 !
82  CHARACTER(LEN=6), INTENT(IN) :: hprogram ! Type of program
83 !
84 !
85 !* 0.2 Declaration of local variables
86 ! ------------------------------
87 !
88 INTEGER :: iluout ! output listing logical unit
89 INTEGER :: ilunam ! namelist file logical unit
90 LOGICAL :: gfound ! true if namelist is found
91 LOGICAL :: gno_par_garden ! true no fraction is prescribed
92 INTEGER :: jtime ! loop counter on time
93 !
94 !* 0.3 Declaration of namelists
95 ! ------------------------
96 !
97 INTEGER :: ntime_gd
98 INTEGER, PARAMETER :: nground_max = 20
99 INTEGER, PARAMETER :: nvegtype_max = 19
100 INTEGER, PARAMETER :: ntime_max = 12
101 !
102 ! type of vegetation
103 !
104  CHARACTER(LEN=4) :: ctyp_garden_hveg ! type of high vegetation
105  CHARACTER(LEN=4) :: ctyp_garden_lveg ! type of low vegetation
106  CHARACTER(LEN=4) :: ctyp_garden_nveg ! type of bare soil
107 !
108 ! uniform value
109 !
110 REAL :: xunif_frac_hveg ! fractions of high vegetation
111 REAL :: xunif_frac_lveg ! fractions of low vegetation
112 REAL :: xunif_frac_nveg ! fractions of bare soil
113 REAL,DIMENSION(NTIME_MAX) :: xunif_lai_hveg ! LAI of high vegetation
114 REAL,DIMENSION(NTIME_MAX) :: xunif_lai_lveg ! LAI of low vegetation
115 REAL :: xunif_h_hveg ! height of trees
116 !
117 ! name of files containing data
118 !
119  CHARACTER(LEN=28) :: cfnam_frac_hveg ! fractions of high vegetation
120  CHARACTER(LEN=28) :: cfnam_frac_lveg ! fractions of low vegetation
121  CHARACTER(LEN=28) :: cfnam_frac_nveg ! fractions of bare soil
122  CHARACTER(LEN=28),DIMENSION(NTIME_MAX) :: cfnam_lai_hveg ! LAI of high vegetation
123  CHARACTER(LEN=28),DIMENSION(NTIME_MAX) :: cfnam_lai_lveg ! LAI of low vegetation
124  CHARACTER(LEN=28) :: cfnam_h_hveg ! height of trees
125 !
126 ! type of files containing data
127 !
128  CHARACTER(LEN=28) :: cftyp_frac_hveg ! fractions of high vegetation
129  CHARACTER(LEN=28) :: cftyp_frac_lveg ! fractions of low vegetation
130  CHARACTER(LEN=28) :: cftyp_frac_nveg ! fractions of bare soil
131  CHARACTER(LEN=28),DIMENSION(NTIME_MAX) :: cftyp_lai_hveg ! LAI of high vegetation
132  CHARACTER(LEN=28),DIMENSION(NTIME_MAX) :: cftyp_lai_lveg ! LAI of low vegetation
133  CHARACTER(LEN=28) :: cftyp_h_hveg ! height of trees
134 !
135 REAL(KIND=JPRB) :: zhook_handle
136 !
137 namelist/nam_data_teb_garden/ ntime_gd, &
138  ctyp_garden_hveg, ctyp_garden_lveg, &
139  ctyp_garden_nveg, &
140  xunif_frac_hveg, xunif_frac_lveg, xunif_frac_nveg, &
141  xunif_lai_hveg , xunif_lai_lveg , &
142  xunif_h_hveg , &
143  cfnam_frac_hveg, cfnam_frac_lveg, cfnam_frac_nveg, &
144  cfnam_lai_hveg , cfnam_lai_lveg , &
145  cfnam_h_hveg , &
146  cftyp_frac_hveg, cftyp_frac_lveg, cftyp_frac_nveg, &
147  cftyp_lai_hveg , cftyp_lai_lveg , &
148  cftyp_h_hveg
149 
150 !-------------------------------------------------------------------------------
151 !
152 !* 1. Initializations
153 ! ---------------
154 !
155 IF (lhook) CALL dr_hook('PGD_TEB_GARDEN_PAR',0,zhook_handle)
156 
157 ntime_gd = 12
158 !
159  ctyp_garden_hveg = 'TEBD' ! Temperate broadleaf trees (forest)
160  ctyp_garden_lveg = 'PARK' ! Grassland
161  ctyp_garden_nveg = 'NO ' ! No vegetation
162 !
163 xunif_frac_hveg = xundef
164 xunif_frac_lveg = xundef
165 xunif_frac_nveg = xundef
166 xunif_lai_hveg = xundef
167 xunif_lai_lveg = xundef
168 xunif_h_hveg = xundef
169 !
170  cfnam_frac_hveg = ' '
171  cfnam_frac_lveg = ' '
172  cfnam_frac_nveg = ' '
173  cfnam_lai_hveg = ' '
174  cfnam_lai_lveg = ' '
175  cfnam_h_hveg = ' '
176 !
177  cftyp_frac_hveg = ' '
178  cftyp_frac_lveg = ' '
179  cftyp_frac_nveg = ' '
180  cftyp_lai_hveg = ' '
181  cftyp_lai_lveg = ' '
182  cftyp_h_hveg = ' '
183 !
184 !-------------------------------------------------------------------------------
185 gdm%DTGD%NTIME = 12
186 !-------------------------------------------------------------------------------
187 !
188 !* 2. Input file for cover types
189 ! --------------------------
190 !
191  CALL get_luout(hprogram,iluout)
192  CALL open_namelist(hprogram,ilunam)
193 !
194  CALL posnam(ilunam,'NAM_DATA_TEB_GARDEN',gfound,iluout)
195 IF (gfound) READ(unit=ilunam,nml=nam_data_teb_garden)
196 !
197  CALL close_namelist(hprogram,ilunam)
198 !
199 IF (ntime_gd==1) THEN
200  xunif_lai_hveg(2:) = xunif_lai_hveg(1)
201  xunif_lai_lveg(2:) = xunif_lai_lveg(1)
202 ELSE IF (ntime_gd/=12) THEN
203  CALL abor1_sfx( 'Namelist NAM_DATA_TEB_GARDEN: NTIME_GD must be equal to 1 or 12')
204 END IF
205 !-------------------------------------------------------------------------------
206 !
207 !* 3. Coherence check
208 ! ---------------
209 !
210 gdm%TGDO%LPAR_GARDEN = (xunif_frac_hveg /= xundef .OR. len_trim(cfnam_frac_hveg) >0 )&
211  .AND. (xunif_frac_lveg /= xundef .OR. len_trim(cfnam_frac_lveg) >0 )&
212  .AND. (xunif_frac_nveg /= xundef .OR. len_trim(cfnam_frac_nveg) >0 )
213 
214 gno_par_garden = (xunif_frac_hveg == xundef .AND. len_trim(cfnam_frac_hveg)==0)&
215  .AND. (xunif_frac_lveg == xundef .AND. len_trim(cfnam_frac_lveg)==0)&
216  .AND. (xunif_frac_nveg == xundef .AND. len_trim(cfnam_frac_nveg)==0)
217 
218 IF ( .NOT. gdm%TGDO%LPAR_GARDEN .AND. .NOT. gno_par_garden ) THEN
219  WRITE(iluout,*) ' Error for fraction of high, low and no vegetation fractions in gardens '
220  WRITE(iluout,*) ' You need to specify the three of them ... or none. '
221  CALL abor1_sfx( 'Namelist NAM_DATA_TEB_GARDEN: you need to specify all of HVEG, LVEG, NVEG fractions or NONE of them')
222 END IF
223 !
224 IF (gno_par_garden) THEN
225  IF (lhook) CALL dr_hook('PGD_TEB_GARDEN_PAR',1,zhook_handle)
226  RETURN
227 END IF
228 !
229 !-------------------------------------------------------------------------------
230 !
231 gdm%DTGD%NTIME = ntime_gd
232 !
233 ALLOCATE(gdm%DTGD%XDATA_FRAC_HVEG (tg%NDIM ))
234 ALLOCATE(gdm%DTGD%XDATA_FRAC_LVEG (tg%NDIM ))
235 ALLOCATE(gdm%DTGD%XDATA_FRAC_NVEG (tg%NDIM ))
236 ALLOCATE(gdm%DTGD%XDATA_LAI_HVEG (tg%NDIM,gdm%DTGD%NTIME))
237 ALLOCATE(gdm%DTGD%XDATA_LAI_LVEG (tg%NDIM,gdm%DTGD%NTIME))
238 ALLOCATE(gdm%DTGD%XDATA_H_HVEG (tg%NDIM ))
239 !
240 gdm%TGDP%CTYPE_HVEG = ctyp_garden_hveg
241 gdm%TGDP%CTYPE_LVEG = ctyp_garden_lveg
242 gdm%TGDP%CTYPE_NVEG = ctyp_garden_nveg
243 !
244 !-------------------------------------------------------------------------------
245 !
246 !* 3. Uniform fields are prescribed
247 ! -----------------------------
248 !
249  catype = 'ARI'
250 !
251  CALL pgd_field(dtco, ug, u, uss, &
252  hprogram,'FRAC_HVEG: fraction of high vegetation','TWN',cfnam_frac_hveg, &
253  cftyp_frac_hveg,xunif_frac_hveg,gdm%DTGD%XDATA_FRAC_HVEG(:))
254 !
255  CALL pgd_field(dtco, ug, u, uss, &
256  hprogram,'FRAC_LVEG: fraction of low vegetation' ,'TWN',cfnam_frac_lveg, &
257  cftyp_frac_lveg,xunif_frac_lveg,gdm%DTGD%XDATA_FRAC_LVEG(:))
258 !
259  CALL pgd_field(dtco, ug, u, uss, &
260  hprogram,'FRAC_NVEG: fraction of bare soil' ,'TWN',cfnam_frac_nveg, &
261  cftyp_frac_nveg,xunif_frac_nveg,gdm%DTGD%XDATA_FRAC_NVEG(:))
262 !
263 !
264 DO jtime=1,gdm%DTGD%NTIME
265 !
266  CALL pgd_field(dtco, ug, u, uss, &
267  hprogram,'LAI_HVEG: LAI of high vegetation','TWN',cfnam_lai_hveg(jtime), &
268  cftyp_lai_hveg(jtime),xunif_lai_hveg(jtime),gdm%DTGD%XDATA_LAI_HVEG(:,jtime))
269 !
270  CALL pgd_field(dtco, ug, u, uss, &
271  hprogram,'LAI_LVEG: LAI of low vegetation','TWN',cfnam_lai_lveg(jtime), &
272  cftyp_lai_lveg(jtime),xunif_lai_lveg(jtime),gdm%DTGD%XDATA_LAI_LVEG(:,jtime))
273 !
274 !
275 ENDDO
276 !
277 !
278  CALL pgd_field(dtco, ug, u, uss, &
279  hprogram,'H_HVEG: height of trees','TWN',cfnam_h_hveg, &
280  cftyp_h_hveg,xunif_h_hveg,gdm%DTGD%XDATA_H_HVEG(:))
281 IF (lhook) CALL dr_hook('PGD_TEB_GARDEN_PAR',1,zhook_handle)
282 !
283 !-------------------------------------------------------------------------------
284 !
285 END SUBROUTINE pgd_teb_garden_par
modd_surf_atm_sso_n::surf_atm_sso_t
Definition: modd_surf_atm_sson.F90:40
modd_surf_atm_n::surf_atm_t
Definition: modd_surf_atmn.F90:42
pgd_field
subroutine pgd_field(DTCO, UG, U, USS, HPROGRAM, HFIELD, HAREA, HFILE, HFILETYPE, PUNIF, PFIELD, OPRESENT)
Definition: pgd_field.F90:6
mode_pos_surf
Definition: mode_pos_surf.F90:6
modd_surf_atm_grid_n
Definition: modd_surf_atm_gridn.F90:6
modd_pgdwork
Definition: modd_pgdwork.F90:6
modd_surfex_n
Definition: modd_surfexn.F90:5
modd_teb_grid_n
Definition: modd_teb_gridn.F90:6
modd_data_cover_n
Definition: modd_data_covern.F90:6
modd_data_cover_par
Definition: modd_data_cover_par.F90:6
modd_surf_atm_grid_n::surf_atm_grid_t
Definition: modd_surf_atm_gridn.F90:39
modd_surfex_n::teb_garden_model_t
Definition: modd_surfexn.F90:149
abor1_sfx
subroutine abor1_sfx(YTEXT)
Definition: abor1_sfx.F90:6
modd_teb_grid_n::teb_grid_t
Definition: modd_teb_gridn.F90:39
close_namelist
subroutine close_namelist(HPROGRAM, KLUNAM)
Definition: close_namelist.F90:6
mode_pos_surf::pos::posnam
subroutine posnam(KULNAM, HDNAML, OFOUND, KLUOUT)
Definition: mode_pos_surf.F90:25
get_luout
subroutine get_luout(HPROGRAM, KLUOUT)
Definition: get_luout.F90:6
modd_surf_atm_sso_n
Definition: modd_surf_atm_sson.F90:6
modd_data_cover_n::data_cover_t
Definition: modd_data_covern.F90:43
modd_surf_par
Definition: modd_surf_par.F90:6
open_namelist
subroutine open_namelist(HPROGRAM, KLUNAM, HFILE)
Definition: open_namelist.F90:6
pgd_teb_garden_par
subroutine pgd_teb_garden_par(DTCO, UG, U, USS, TG, GDM, HPROGRAM)
Definition: pgd_teb_garden_par.F90:6
modd_surf_atm_n
Definition: modd_surf_atmn.F90:6
Generated on Fri May 13 2016 09:31:05 for SURFEX by   doxygen 1.8.5