6 SUBROUTINE get_surf_var_n (DGF, I, DGI, DGMI, DGS, DGU, DGT, DGW, F, UG, U, USS, &
8 psea, pwater, pnature, ptown, &
9 pt2m, pq2m, pqs, pz0, pz0h, pz0eff, &
10 pz0_sea, pz0_water, pz0_nature, pz0_town, &
11 pz0h_sea, pz0h_water, pz0h_nature, pz0h_town,&
12 pqs_sea, pqs_water, pqs_nature, pqs_town, &
13 ppsng, ppsnv, pzs, pseries, ptwsnow, &
14 psso_stdev, plon, plat, &
15 pbare, plai_tree, ph_tree )
76 USE modi_get_var_sea_n
77 USE modi_get_var_water_n
78 USE modi_get_var_nature_n
79 USE modi_get_var_town_n
83 USE yomhook
,ONLY : lhook, dr_hook
84 USE parkind1
,ONLY : jprb
87 USE modi_get_sso_stdev_n
99 TYPE(isba_t
),
INTENT(INOUT) :: i
106 TYPE(flake_t),
INTENT(INOUT) :: f
111 CHARACTER(LEN=6),
INTENT(IN) :: hprogram
112 INTEGER,
INTENT(IN) :: ki
113 INTEGER,
INTENT(IN) :: ks
115 REAL,
DIMENSION(:),
INTENT(OUT),
OPTIONAL :: psea
116 REAL,
DIMENSION(:),
INTENT(OUT),
OPTIONAL :: pwater
117 REAL,
DIMENSION(:),
INTENT(OUT),
OPTIONAL :: pnature
118 REAL,
DIMENSION(:),
INTENT(OUT),
OPTIONAL :: ptown
120 REAL,
DIMENSION(:),
INTENT(OUT),
OPTIONAL :: pt2m
121 REAL,
DIMENSION(:),
INTENT(OUT),
OPTIONAL :: pq2m
123 REAL,
DIMENSION(:),
INTENT(OUT),
OPTIONAL :: pqs
124 REAL,
DIMENSION(:),
INTENT(OUT),
OPTIONAL :: pz0
125 REAL,
DIMENSION(:),
INTENT(OUT),
OPTIONAL :: pz0h
126 REAL,
DIMENSION(:),
INTENT(OUT),
OPTIONAL :: pz0eff
128 REAL,
DIMENSION(:),
INTENT(OUT),
OPTIONAL :: pz0_sea
129 REAL,
DIMENSION(:),
INTENT(OUT),
OPTIONAL :: pz0_water
130 REAL,
DIMENSION(:),
INTENT(OUT),
OPTIONAL :: pz0_nature
131 REAL,
DIMENSION(:),
INTENT(OUT),
OPTIONAL :: pz0_town
133 REAL,
DIMENSION(:),
INTENT(OUT),
OPTIONAL :: pz0h_sea
134 REAL,
DIMENSION(:),
INTENT(OUT),
OPTIONAL :: pz0h_water
135 REAL,
DIMENSION(:),
INTENT(OUT),
OPTIONAL :: pz0h_nature
136 REAL,
DIMENSION(:),
INTENT(OUT),
OPTIONAL :: pz0h_town
138 REAL,
DIMENSION(:),
INTENT(OUT),
OPTIONAL :: pqs_sea
139 REAL,
DIMENSION(:),
INTENT(OUT),
OPTIONAL :: pqs_water
140 REAL,
DIMENSION(:),
INTENT(OUT),
OPTIONAL :: pqs_nature
141 REAL,
DIMENSION(:),
INTENT(OUT),
OPTIONAL :: pqs_town
143 REAL,
DIMENSION(:),
INTENT(OUT),
OPTIONAL :: ppsng
144 REAL,
DIMENSION(:),
INTENT(OUT),
OPTIONAL :: ppsnv
146 REAL,
DIMENSION(:),
INTENT(OUT),
OPTIONAL :: pzs
148 REAL,
DIMENSION(:,:),
INTENT(OUT),
OPTIONAL :: pseries
150 REAL,
DIMENSION(:),
INTENT(OUT),
OPTIONAL :: ptwsnow
151 REAL,
DIMENSION(:),
INTENT(OUT),
OPTIONAL :: psso_stdev
153 REAL,
DIMENSION(:),
INTENT(OUT),
OPTIONAL :: plon
154 REAL,
DIMENSION(:),
INTENT(OUT),
OPTIONAL :: plat
156 REAL,
DIMENSION(:),
INTENT(OUT),
OPTIONAL :: pbare
157 REAL,
DIMENSION(:),
INTENT(OUT),
OPTIONAL :: plai_tree
158 REAL,
DIMENSION(:),
INTENT(OUT),
OPTIONAL :: ph_tree
166 REAL,
DIMENSION(KI) :: zfield1, zfield2, zfield3, zfield4, zfield5, zfield6
167 REAL,
DIMENSION(KI) :: zfield7, zfield8
168 REAL,
DIMENSION(KI,KS) :: zseries
169 INTEGER,
DIMENSION(KI) :: imask
178 REAL(KIND=JPRB) :: zhook_handle
184 IF (lhook) CALL dr_hook(
'GET_SURF_VAR_N',0,zhook_handle)
189 IF (present(psea) .OR. present(pwater) .OR. present(pnature) .OR. present(ptown))
THEN
192 hprogram, ki, zfield1, zfield2, zfield3, zfield4)
194 IF (present(psea) ) psea = zfield1
195 IF (present(pwater) ) pwater = zfield2
196 IF (present(pnature)) pnature = zfield3
197 IF (present(ptown) ) ptown = zfield4
205 IF ( present(pt2m) .OR. present(pq2m) )
THEN
208 hprogram, ki, zfield1, zfield1, zfield1, zfield1, zfield1, zfield2, &
209 zfield3, zfield4, zfield4, zfield4, zfield4, zfield4, &
210 zfield4, zfield4, zfield4 )
212 IF (present(pt2m) ) pt2m = zfield2
213 IF (present(pq2m) ) pq2m = zfield3
221 IF ( present(pz0) .OR. present(pz0h) )
THEN
224 hprogram, ki, zfield1, zfield2)
226 IF (present(pz0) ) pz0 = zfield1
227 IF (present(pz0h) ) pz0h = zfield2
235 IF ( present(pqs) )
THEN
246 IF ( present(pqs_sea) .OR. present(pz0_sea) .OR. present(pz0h_sea) )
THEN
250 IF ( .NOT.present(psea) )
THEN
252 CALL
abor1_sfx(
'GET_SURF_VARN: ARGUMENT PSEA MISSING')
256 ki_sea = count(psea(:) > 0.0)
259 CALL
get_1d_mask(ki_sea, ki, psea, imask(1:ki_sea))
262 hprogram, ki_sea, zfield1(1:ki_sea), zfield2(1:ki_sea), zfield3(1:ki_sea))
264 IF(present(pqs_sea))
THEN
267 pqs_sea(imask(ji)) = zfield1(ji)
271 IF(present(pz0_sea))
THEN
274 pz0_sea(imask(ji)) = zfield2(ji)
278 IF(present(pz0h_sea))
THEN
281 pz0h_sea(imask(ji)) = zfield3(ji)
289 IF ( present(pqs_water) .OR. present(pz0_water) .OR. present(pz0h_water) )
THEN
293 IF ( .NOT.present(pwater) )
THEN
294 CALL
abor1_sfx(
'GET_SURF_VARN: ARGUMENT PWATER MISSING')
297 ki_water = count(pwater(:) > 0.0)
300 CALL
get_1d_mask(ki_water, ki, pwater, imask(1:ki_water))
303 hprogram, ki_water, u%CWATER, zfield1(1:ki_water), &
304 zfield2(1:ki_water), zfield3(1:ki_water))
306 IF(present(pqs_water))
THEN
307 pqs_water(:) = xundef
309 pqs_water(imask(ji)) = zfield1(ji)
313 IF(present(pz0_water))
THEN
314 pz0_water(:) = xundef
316 pz0_water(imask(ji)) = zfield2(ji)
320 IF(present(pz0h_water))
THEN
321 pz0h_water(:) = xundef
323 pz0h_water(imask(ji)) = zfield3(ji)
331 IF ( present(pqs_nature) .OR. present(ppsng) .OR. present(ppsnv) .OR. present(pz0eff).OR. &
332 present(ptwsnow) .OR. present(pbare) .OR. present(plai_tree) .OR. present(ph_tree) )
THEN
337 IF ( .NOT.present(pnature) )
THEN
339 CALL
abor1_sfx(
'GET_SURF_VARN: ARGUMENT PNATURE MISSING')
343 ki_nature = count(pnature(:) > 0.0)
346 CALL
get_1d_mask(ki_nature, ki, pnature, imask(1:ki_nature))
348 IF (ki_nature>0)
THEN
350 hprogram, ki_nature, zfield1(1:ki_nature), zfield2(1:ki_nature), &
351 zfield3(1:ki_nature), zfield4(1:ki_nature), &
352 zfield5(1:ki_nature), zfield6(1:ki_nature), zfield7(1:ki_nature), &
353 zfield8(1:ki_nature))
356 IF(present(pqs_nature))
THEN
357 pqs_nature(:) = xundef
359 pqs_nature(imask(ji)) = zfield1(ji)
363 IF(present(pz0_nature))
THEN
364 pz0_nature(:) = xundef
366 pz0_nature(imask(ji)) = zfield5(ji)
370 IF(present(pz0h_nature))
THEN
371 pz0h_nature(:) = xundef
373 pz0h_nature(imask(ji)) = zfield6(ji)
377 IF (present(ppsng))
THEN
380 ppsng(imask(ji)) = zfield2(ji)
384 IF (present(ppsnv))
THEN
387 ppsnv(imask(ji)) = zfield3(ji)
391 IF ( present(pz0eff) )
THEN
394 pz0eff(imask(ji)) = zfield4(ji)
398 IF(present(ptwsnow))
THEN
401 ptwsnow(imask(ji)) = zfield7(ji)
407 IF(present(pbare))
THEN
410 pbare(imask(ji)) = zfield8(ji)
412 pbare(:) = pbare(:) * u%XNATURE(:)
417 IF (present(plai_tree) .OR. present(ph_tree) )
THEN
419 CALL
get_veg_n(hprogram, ki_nature, u, i, zfield1(1:ki_nature), zfield2(1:ki_nature))
421 IF (present(plai_tree))
THEN
422 plai_tree(:) = xundef
424 plai_tree(imask(ji)) = zfield1(ji)
426 plai_tree(:) = plai_tree(:) * u%XNATURE(:)
429 IF (present(ph_tree))
THEN
432 ph_tree(imask(ji)) = zfield2(ji)
442 IF ( present(pqs_town) .OR. present(pz0_town) .OR. present(pz0h_town) )
THEN
446 IF ( .NOT.present(ptown) )
THEN
448 CALL
abor1_sfx(
'GET_SURF_VARN: ARGUMENT PTOWN MISSING')
452 ki_town = count(ptown(:) > 0.0)
455 CALL
get_1d_mask(ki_town, ki, ptown, imask(1:ki_town))
458 hprogram, ki_town, zfield1(1:ki_town), zfield2(1:ki_town), zfield3(1:ki_town))
460 IF(present(pqs_town))
THEN
463 pqs_town(imask(ji)) = zfield1(ji)
467 IF(present(pz0_town))
THEN
470 pz0_town(imask(ji)) = zfield2(ji)
474 IF(present(pz0h_town))
THEN
475 pz0h_town(:) = xundef
477 pz0h_town(imask(ji)) = zfield3(ji)
485 IF (present(pzs))
THEN
488 hprogram, ki, zfield1)
496 IF (present(pseries))
THEN
498 IF ( .NOT.present(pwater) )
THEN
499 CALL
abor1_sfx(
'GET_SURF_VARN: ARGUMENT PWATER REQUIRED FOR WATER SERIES')
502 IF ( count(pwater(:) > 0.0) > 0.0 )
THEN
505 hprogram, ki, ks, zseries)
517 IF (present(psso_stdev))
THEN
520 'ASCII ', ki, zfield1)
528 IF (present(plon).OR.present(plat))
THEN
531 hprogram, ki, zfield1, zfield2)
533 IF (present(plon) ) plon = zfield1
534 IF (present(plat) ) plat = zfield2
538 IF (lhook) CALL dr_hook(
'GET_SURF_VAR_N',1,zhook_handle)
subroutine get_series_n(F, HPROGRAM, KI, KS, PFIELD)
subroutine get_var_sea_n(DGS, HPROGRAM, KI, PQS, PZ0, PZ0H)
subroutine get_veg_n(HPROGRAM, KI, U, I, PLAI, PVH)
subroutine get_var_nature_n(I, DGI, DGMI, HPROGRAM, KI, PQS, PSNG, PSNV, PZ0EFF, PZ0, PZ0H, PTWSNOW, PBARE)
subroutine get_surf_var_n(DGF, I, DGI, DGMI, DGS, DGU, DGT, DGW, F, UG, U, USS, HPROGRAM, KI, KS, PSEA, PWATER, PNATURE, PTOWN, PT2M, PQ2M, PQS, PZ0, PZ0H, PZ0EFF, PZ0_SEA, PZ0_WATER, PZ0_NATURE, PZ0_TOWN, PZ0H_SEA, PZ0H_WATER, PZ0H_NATURE, PZ0H_TOWN, PQS_SEA, PQS_WATER, PQS_NATURE, PQS_TOWN, PPSNG, PPSNV, PZS, PSERIES, PTWSNOW, PSSO_STDEV, PLON, PLAT, PBARE, PLAI_TREE, PH_TREE)
subroutine get_sso_stdev_n(USS, HPROGRAM, KI, PSSO_STDEV)
subroutine get_var_water_n(DGF, DGW, HPROGRAM, KI, HWATER, PQS, PZ0, PZ0H)
subroutine abor1_sfx(YTEXT)
subroutine get_frac_n(U, HPROGRAM, KI, PSEA, PWATER, PNATURE, PTOWN)
subroutine get_qs_n(DGU, HPROGRAM, KI, PQS)
subroutine get_var_town_n(DGT, HPROGRAM, KI, PQS, PZ0, PZ0H)
subroutine get_luout(HPROGRAM, KLUOUT)
subroutine get_1d_mask(KSIZE, KFRAC, PFRAC, KMASK)
subroutine get_zs_n(U, HPROGRAM, KI, PZS)
subroutine get_coord_n(UG, HPROGRAM, KI, PLON, PLAT)
subroutine get_flux_n(DGU, HPROGRAM, KI, PRN, PH, PLE, PLEI, PGFLUX, PT2M, PQ2M, PHU2M, PZON10M, PMER10M, PSURFLWNET, PSURFSWNET, PCD, PEVAP, PSUBL)
subroutine get_z0_n(DGU, HPROGRAM, KI, PZ0, PZ0H)