57 USE yomhook
,ONLY : lhook, dr_hook
58 USE parkind1
,ONLY : jprb
60 USE modi_put_zs_inland_water_n
62 USE modi_put_zs_nature_n
66 USE modi_put_zs_surf_atm_n
68 USE modi_put_zs_town_n
69 USE modi_get_size_full_n
78 TYPE(flake_t),
INTENT(INOUT) :: f
79 TYPE(isba_t
),
INTENT(INOUT) :: i
85 CHARACTER(LEN=6),
INTENT(IN) :: hprogram
86 INTEGER,
INTENT(IN) :: ki
87 REAL,
DIMENSION(KI),
INTENT(IN) :: pzs
93 REAL(KIND=JPRB) :: zhook_handle
96 IF (lhook) CALL dr_hook(
'PUT_ZS_N',0,zhook_handle)
107 IF (u%NSIZE_WATER > 0 .AND. u%CWATER/=
'NONE' .AND. u%CWATER/=
'FLUX') CALL
pack_zs(u%NSIZE_WATER,u%NR_WATER,
'W')
112 IF (u%NSIZE_NATURE > 0 .AND. u%CNATURE/=
'NONE' .AND. u%CNATURE/=
'FLUX') CALL
pack_zs(u%NSIZE_NATURE,u%NR_NATURE,
'N')
117 IF (u%NSIZE_TOWN > 0 .AND. u%CTOWN/=
'NONE' .AND. u%CTOWN/=
'FLUX') CALL
pack_zs(u%NSIZE_TOWN,u%NR_TOWN,
'T')
122 IF (u%NSIZE_SEA > 0 .AND. u%CSEA/=
'NONE' .AND. u%CSEA/=
'FLUX') CALL
pack_zs(u%NSIZE_SEA,u%NR_SEA,
'S')
124 IF (lhook) CALL dr_hook(
'PUT_ZS_N',1,zhook_handle)
130 INTEGER,
INTENT(IN) :: ksize
131 INTEGER,
POINTER,
DIMENSION(:) :: kmask
132 CHARACTER(LEN=1),
INTENT(IN) :: ytype
134 REAL,
DIMENSION(KSIZE) :: zp_zs
136 REAL(KIND=JPRB) :: zhook_handle
140 IF (lhook) CALL dr_hook(
'PUT_ZS_N:PACK_ZS',0,zhook_handle)
142 IF (.NOT.
ASSOCIATED(kmask))
THEN
143 ALLOCATE(kmask(ksize))
146 hprogram,u%NDIM_FULL,u%NSIZE_FULL)
148 CALL
get_1d_mask( ksize, u%NSIZE_FULL, u%XWATER, kmask)
149 ELSEIF (ytype==
'N')
THEN
150 CALL
get_1d_mask( ksize, u%NSIZE_FULL, u%XNATURE, kmask)
151 ELSEIF (ytype==
'T')
THEN
152 CALL
get_1d_mask( ksize, u%NSIZE_FULL, u%XTOWN, kmask)
153 ELSEIF (ytype==
'S')
THEN
154 CALL
get_1d_mask( ksize, u%NSIZE_FULL, u%XSEA, kmask)
160 zp_zs(jj) = pzs(kmask(jj))
165 hprogram,ksize,zp_zs,u%CWATER)
166 ELSEIF (ytype==
'N')
THEN
168 hprogram,ksize,zp_zs)
169 ELSEIF (ytype==
'T')
THEN
171 hprogram,ksize,zp_zs)
172 ELSEIF (ytype==
'S')
THEN
174 hprogram,ksize,zp_zs)
177 IF (lhook) CALL dr_hook(
'PUT_ZS_N:PACK_ZS',1,zhook_handle)
subroutine put_zs_nature_n(I, HPROGRAM, KI, PZS)
subroutine put_zs_inland_water_n(F, W, HPROGRAM, KI, PZS, HWATER)
subroutine put_zs_n(F, I, S, U, TOP, W, HPROGRAM, KI, PZS)
subroutine put_zs_sea_n(S, HPROGRAM, KI, PZS)
subroutine put_zs_surf_atm_n(U, HPROGRAM, KI, PZS)
subroutine get_1d_mask(KSIZE, KFRAC, PFRAC, KMASK)
subroutine put_zs_town_n(TOP, HPROGRAM, KI, PZS)
subroutine get_size_full_n(U, HPROGRAM, KDIM_FULL, KSIZE_FULL)
subroutine pack_zs(KSIZE, KMASK, YTYPE)