63 USE modi_write_file_isbamap
70 nmaskt, xtotbv_in_mesh, nnpix,&
71 nfreq_maps_wg, xbv_in_mesh,nnbv_in_mesh
76 USE yomhook
,ONLY : lhook, dr_hook
77 USE parkind1
,ONLY : jprb
85 TYPE(isba_t
),
INTENT(INOUT) :: i
89 INTEGER,
INTENT(IN) :: ki
90 INTEGER,
INTENT(IN) :: kstep
91 LOGICAL,
DIMENSION(:),
INTENT(INOUT) :: gtopd
96 INTEGER :: jj, ji , jmesh, jcat
97 REAL,
DIMENSION(KI) :: zw
98 REAL,
DIMENSION(KI) :: zwsat_full
100 REAL,
DIMENSION(KI) :: zwg_old
101 REAL,
DIMENSION(KI) :: zdg_full
103 REAL,
DIMENSION(KI,NNCAT) :: zcount, zw_cat
105 CHARACTER(LEN=5) :: ystep
108 REAL(KIND=JPRB) :: zhook_handle
110 IF (lhook) CALL dr_hook(
'TOPD_TO_ISBA',0,zhook_handle)
119 zwg_old(:) = xwg_full(:)
130 IF ( (xdtopt(jj,ji) /= xundef).AND. (nmaskt(jj,ji) /= nundef) )
THEN
131 zw_cat(nmaskt(jj,ji),jj) = zw_cat(nmaskt(jj,ji),jj) + xwtopt(jj,ji)
132 zcount(nmaskt(jj,ji),jj) = zcount(nmaskt(jj,ji),jj) + 1.0
141 IF (xtotbv_in_mesh(jmesh)/=0.0 .AND. xtotbv_in_mesh(jmesh)/=xundef )
THEN
144 IF (xtotbv_in_mesh(jmesh)==xbv_in_mesh(jmesh,jcat))
THEN
146 IF (gtopd(jcat).AND. nnbv_in_mesh(jmesh,jcat) /=0.)
THEN
147 IF (xbv_in_mesh(jmesh,jcat)>=ug%XMESH_SIZE(jmesh)*0.75.AND. zcount(jmesh,jcat)/=0.)
THEN
148 zw(jmesh) = zw_cat(jmesh,jcat) / zcount(jmesh,jcat)
149 ELSEIF(zcount(jmesh,jcat)/=0.)
THEN
150 zw(jmesh) = zw_cat(jmesh,jcat) / zcount(jmesh,jcat)
154 zw(jmesh)=zwg_old(jmesh)
159 IF(zw(jmesh)==0.0) jcat_in=0
162 IF (xtotbv_in_mesh(jmesh)>=ug%XMESH_SIZE(jmesh)*0.75)
THEN
164 IF (gtopd(jcat).AND. zcount(jmesh,jcat)/=0.)
THEN
165 zw(jmesh) = zw(jmesh) + zw_cat(jmesh,jcat) / zcount(jmesh,jcat) *&
166 min(1.0,(xbv_in_mesh(jmesh,jcat)/ug%XMESH_SIZE(jmesh)))
171 IF (zw(jmesh)==0.) zw(jmesh)=zwg_old(jmesh)
174 IF (gtopd(jcat).AND. zcount(jmesh,jcat)/=0.)
THEN
175 zw(jmesh) = zw(jmesh) + zw_cat(jmesh,jcat) / zcount(jmesh,jcat)*&
176 min(1.0,(xbv_in_mesh(jmesh,jcat)/ug%XMESH_SIZE(jmesh)))
181 IF (zw(jmesh)==0.) zw(jmesh)=zwg_old(jmesh)
187 zw(jmesh)=zwg_old(jmesh)
191 xwg_full(:) = max(zw(:),xwgmin)
198 WHERE ( xwg_full(:) > zwsat_full(:) .AND. xwg_full(:)/=xundef )
200 xwsupsat(:) = xwg_full(:) - zwsat_full(:)
201 xwg_full(:) = zwsat_full(:)
204 IF ( (nfreq_maps_wg/=0 .AND. mod(kstep,nfreq_maps_wg)==0) .OR.&
205 ( kstep==nnb_topd_step) )
THEN
208 WRITE(ystep,
'(I1)') kstep
209 ELSEIF (kstep < 100)
THEN
210 WRITE(ystep,
'(I2)') kstep
211 ELSEIF (kstep < 1000)
THEN
212 WRITE(ystep,
'(I3)') kstep
213 ELSEIF (kstep < 10000)
THEN
214 WRITE(ystep,
'(I4)') kstep
216 WRITE(ystep,
'(I5)') kstep
219 CALL
open_file(
'ASCII ',nunit,hfile=
'carte_w'//ystep,hform=
'FORMATTED',haction=
'WRITE')
227 IF (lhook) CALL dr_hook(
'TOPD_TO_ISBA',1,zhook_handle)
subroutine topd_to_isba(I, UG, U, KI, KSTEP, GTOPD)
subroutine write_file_isbamap(UG, KUNIT, PVAR, KI)
subroutine close_file(HPROGRAM, KUNIT)
subroutine open_file(HPROGRAM, KUNIT, HFILE, HFORM, HACTION, HACCESS, KRECL)