58 USE yomhook
,ONLY : lhook, dr_hook
59 USE parkind1
,ONLY : jprb
74 CHARACTER(LEN=6),
INTENT(IN) :: hprogram
75 CHARACTER(LEN=3),
INTENT(IN) :: hwrite
81 CHARACTER(LEN=12) :: yrecfm
82 CHARACTER(LEN=100):: ycomment
85 REAL(KIND=JPRB) :: zhook_handle
94 IF (lhook) CALL dr_hook(
'WRITESURF_TEB_CANOPY_N',0,zhook_handle)
96 ycomment=
'flag to use canopy levels'
98 hprogram,yrecfm,top%LCANOPY,iresp,hcomment=ycomment)
100 IF (.NOT. top%LCANOPY .AND. lhook) CALL dr_hook(
'WRITESURF_TEB_CANOPY_N',1,zhook_handle)
101 IF (.NOT. top%LCANOPY)
RETURN
106 ycomment=
'number of canopy levels'
108 hprogram,yrecfm,tcp%NLVL,iresp,hcomment=ycomment)
113 WRITE(yrecfm,
'(A9,I2.2,A1)')
'TEB_CAN_Z',jlayer,
' '
114 ycomment=
'altitudes of canopy levels (m)'
116 hprogram,yrecfm,tcp%XZ(:,jlayer),iresp,hcomment=ycomment)
119 IF (hwrite/=
'PRE')
THEN
124 WRITE(yrecfm,
'(A9,I2.2,A1)')
'TEB_CAN_U',jlayer,
' '
125 ycomment=
'wind at canopy levels (m/s)'
127 hprogram,yrecfm,tcp%XU(:,jlayer),iresp,hcomment=ycomment)
133 WRITE(yrecfm,
'(A9,I2.2,A1)')
'TEB_CAN_T',jlayer,
' '
134 ycomment=
'temperature at canopy levels (K)'
136 hprogram,yrecfm,tcp%XT(:,jlayer),iresp,hcomment=ycomment)
142 WRITE(yrecfm,
'(A9,I2.2,A1)')
'TEB_CAN_Q',jlayer,
' '
143 ycomment=
'humidity at canopy levels (kg/m3)'
145 hprogram,yrecfm,tcp%XQ(:,jlayer),iresp,hcomment=ycomment)
151 WRITE(yrecfm,
'(A9,I2.2,A1)')
'TEB_CAN_E',jlayer,
' '
152 ycomment=
'Tke at canopy levels (m2/s2)'
154 hprogram,yrecfm,tcp%XTKE(:,jlayer),iresp,hcomment=ycomment)
160 WRITE(yrecfm,
'(A10,I2.2)')
'TEB_CAN_MO',jlayer
161 ycomment=
'Monin-Obukhov length (m)'
163 hprogram,yrecfm,tcp%XLMO(:,jlayer),iresp,hcomment=ycomment)
168 IF (
ASSOCIATED(tcp%XLM))
THEN
170 WRITE(yrecfm,
'(A10,I2.2)')
'TEB_CAN_LM',jlayer
171 ycomment=
'mixing length (m)'
173 hprogram,yrecfm,tcp%XLM(:,jlayer),iresp,hcomment=ycomment)
179 IF (
ASSOCIATED(tcp%XLEPS))
THEN
181 WRITE(yrecfm,
'(A10,I2.2)')
'TEB_CAN_LE',jlayer
182 ycomment=
'mixing length (m)'
184 hprogram,yrecfm,tcp%XLEPS(:,jlayer),iresp,hcomment=ycomment)
191 WRITE(yrecfm,
'(A9,I2.2,A1)')
'TEB_CAN_P',jlayer,
' '
192 ycomment=
'Pressure at canopy levels (Pa)'
194 hprogram,yrecfm,tcp%XP(:,jlayer),iresp,hcomment=ycomment)
199 IF (lhook) CALL dr_hook(
'WRITESURF_TEB_CANOPY_N',1,zhook_handle)
subroutine writesurf_teb_canopy_n(DGU, U, TCP, TOP, HPROGRAM, HWRITE)