58 USE modi_writesurf_gr_snow
61 USE yomhook
,ONLY : lhook, dr_hook
62 USE parkind1
,ONLY : jprb
75 CHARACTER(LEN=6),
INTENT(IN) :: hprogram
76 CHARACTER(LEN=3),
INTENT(IN) :: hpatch
82 CHARACTER(LEN=12) :: yrecfm
83 CHARACTER(LEN=100):: ycomment
84 CHARACTER(LEN=14) :: yform
85 CHARACTER(LEN=4 ) :: ylvl
89 REAL,
DIMENSION(:),
ALLOCATABLE :: zwork
92 REAL(KIND=JPRB) :: zhook_handle
99 IF (lhook) CALL dr_hook(
'WRITESURF_TEB_GARDEN_N',0,zhook_handle)
100 ALLOCATE(zwork(
SIZE(gdm%TGD%CUR%XTG,1)))
103 DO jlayer=1,gdm%TGDO%NGROUND_LAYER
104 WRITE(ylvl,
'(I2)') jlayer
105 yrecfm=hpatch//
'GD_TG'//adjustl(ylvl(:len_trim(ylvl)))
106 yrecfm=adjustl(yrecfm)
107 yform=
'(A11,I1.1,A4)'
108 IF (jlayer >= 10) yform=
'(A11,I2.2,A4)'
109 WRITE(ycomment,fmt=yform)
'X_Y_GD_TG',jlayer,
' (K)'
110 zwork=gdm%TGD%CUR%XTG(:,jlayer)
112 hprogram,yrecfm,zwork,iresp,hcomment=ycomment)
118 DO jlayer=1,gdm%TGDO%NGROUND_LAYER
119 WRITE(ylvl,
'(I2)') jlayer
120 yrecfm=hpatch//
'GD_WG'//adjustl(ylvl(:len_trim(ylvl)))
121 yrecfm=adjustl(yrecfm)
122 yform=
'(A11,I1.1,A8)'
123 IF (jlayer >= 10) yform=
'(A11,I2.2,A8)'
124 WRITE(ycomment,fmt=yform)
'X_Y_GD_WG',jlayer,
' (m3/m3)'
125 zwork=gdm%TGD%CUR%XWG(:,jlayer)
127 hprogram,yrecfm,zwork,iresp,hcomment=ycomment)
133 DO jlayer=1,gdm%TGDO%NGROUND_LAYER
134 WRITE(ylvl,
'(I2)') jlayer
135 yrecfm=hpatch//
'GD_WGI'//adjustl(ylvl(:len_trim(ylvl)))
136 yrecfm=adjustl(yrecfm)
137 yform=
'(A11,I1.1,A8)'
138 IF (jlayer >= 10) yform=
'(A11,I2.2,A8)'
139 WRITE(ycomment,yform)
'X_Y_GD_WGI',jlayer,
' (m3/m3)'
140 zwork=gdm%TGD%CUR%XWGI(:,jlayer)
142 hprogram,yrecfm,zwork,iresp,hcomment=ycomment)
149 yrecfm=hpatch//
'GD_WR'
150 yrecfm=adjustl(yrecfm)
151 ycomment=
'X_Y_GD_WR (kg/m2)'
153 hprogram,yrecfm,gdm%TGD%CUR%XWR(:),iresp,hcomment=ycomment)
157 IF (gdm%TVG%CPHOTO/=
'NON' .AND. gdm%TVG%CPHOTO/=
'AGS' .AND. gdm%TVG%CPHOTO/=
'AST')
THEN
158 yrecfm=hpatch//
'GD_LAI'
159 yrecfm=adjustl(yrecfm)
160 ycomment=
'X_Y_GD_LAI (m2/m2)'
162 hprogram,yrecfm,gdm%TGDPE%CUR%XLAI(:),iresp,hcomment=ycomment)
165 IF (gdm%TVG%CPHOTO==
'NIT')
THEN
167 DO jnbiomass=1,gdm%TVG%NNBIOMASS
168 WRITE(ylvl,
'(I1)') jnbiomass
169 yrecfm=hpatch//
'GD_BIOMA'//adjustl(ylvl(:len_trim(ylvl)))
170 yrecfm=adjustl(yrecfm)
171 yform=
'(A11,I1.1,A8)'
172 WRITE(ycomment,fmt=yform)
'X_Y_BIOMASS',jnbiomass,
' (kg/m2)'
174 hprogram,yrecfm,gdm%TGD%CUR%XBIOMASS(:,jnbiomass),iresp,hcomment=ycomment)
178 DO jnbiomass=2,gdm%TVG%NNBIOMASS
179 WRITE(ylvl,
'(I1)') jnbiomass
180 yrecfm=hpatch//
'GD_RESPI'//adjustl(ylvl(:len_trim(ylvl)))
181 yrecfm=adjustl(yrecfm)
182 yform=
'(A16,I1.1,A10)'
183 WRITE(ycomment,fmt=yform)
'X_Y_RESP_BIOMASS',jnbiomass,
' (kg/m2/s)'
185 hprogram,yrecfm,gdm%TGD%CUR%XRESP_BIOMASS(:,jnbiomass),iresp,hcomment=ycomment)
192 yrecfm=hpatch//
'GD_RES'
193 yrecfm=adjustl(yrecfm)
194 ycomment=
'X_Y_GD_RESA (s/m)'
196 hprogram,yrecfm,gdm%TGD%CUR%XRESA(:),iresp,hcomment=ycomment)
202 hprogram,yrecfm,hpatch,gdm%TGD%CUR%TSNOW)
203 IF (lhook) CALL dr_hook(
'WRITESURF_TEB_GARDEN_N',1,zhook_handle)
subroutine writesurf_gr_snow(DGU, U, HPROGRAM, HSURFTYPE, HPREFIX, TPSNOW)
subroutine writesurf_teb_garden_n(DGU, U, GDM, HPROGRAM, HPATCH)