40 USE modd_topodyn, ONLY : nncat, ccat, nnpt, nline, nnmc, npmax,&
44 nnb_stp_stock,nnb_stp_restart,xwtopt,&
45 xrun_torout,xdr_torout
47 USE modi_read_topd_file
48 USE modi_read_file_isbamap
58 USE yomhook
,ONLY : lhook, dr_hook
59 USE parkind1
,ONLY : jprb
69 CHARACTER(LEN=6),
INTENT(IN) :: hprogram
70 INTEGER,
INTENT(IN) :: ki
77 INTEGER :: jstp,jcat,jpix
78 REAL,
DIMENSION(:),
ALLOCATABLE :: zas
79 REAL,
DIMENSION(:),
ALLOCATABLE :: zwtopt
80 CHARACTER(LEN=50),
DIMENSION(:),
ALLOCATABLE :: yfiletop
81 LOGICAL :: lstock, lwg, lasat
83 REAL :: zcnt_undef,zsum1,zsum2, zdenom
84 REAL(KIND=JPRB) :: zhook_handle
86 IF (lhook) CALL dr_hook(
'RESTART_COUPL_TOPD',0,zhook_handle)
92 WRITE(*,*)
'Read STOCK file ',nnb_stp_stock
93 nnb_stp_stock = min(nnb_stp_stock, nnb_topd_step + nnb_stp_restart)
95 INQUIRE(file=
'stocks_init.txt', exist=lstock)
96 INQUIRE(file=
'surfcont_init.map', exist=lasat)
99 WRITE(iluout,*)
'You asked to run in restart mode but stock file is missing'
100 CALL
abor1_sfx(
"RESTART_COUPL_TOPD_n: stock file is missing")
101 ELSEIF (.NOT.lasat)
THEN
102 WRITE(iluout,*)
'You asked to run in restart mode but contributive area file is missing'
103 CALL
abor1_sfx(
"RESTART_COUPL_TOPD_n: contributive area file is missing")
106 CALL
open_file(
'ASCII ',nunit,
'stocks_init.txt',
'FORMATTED',haction=
'READ ')
107 DO jstp=1,nnb_stp_stock
108 READ(nunit,*) xrun_torout(1:nncat,jstp),xdr_torout(1:nncat,jstp)
116 IF (xrun_torout(jcat,nnb_stp_stock)/=0.)
THEN
118 zcorr_stock = xrun_torout(jcat,nnb_stp_stock) - xrun_torout(jcat,nnb_stp_stock-1)
119 DO jstp = nnb_stp_stock+1,nnb_topd_step
120 xrun_torout(jcat,jstp) = max(0.,xrun_torout(jcat,jstp-1)+zcorr_stock)
125 IF (xdr_torout(jcat,nnb_stp_stock)/=0.)
THEN
127 zcorr_stock = xdr_torout(jcat,nnb_stp_stock) - xdr_torout(jcat,nnb_stp_stock-1)
128 DO jstp = nnb_stp_stock+1,nnb_topd_step
129 xdr_torout(jcat,jstp) = max(0.,xdr_torout(jcat,jstp-1)+zcorr_stock)
136 WRITE(*,*)
'Write pixels water content files'
138 ALLOCATE(zwtopt(npmax))
139 ALLOCATE(yfiletop(nncat))
143 yfiletop(jcat)=trim(ccat(jcat))//
'_xwtop_init.map'
144 INQUIRE(file=yfiletop(jcat), exist=lwg)
147 WRITE(iluout,*)
'You asked to run in restart mode but pixels water content file is missing'
148 WRITE(iluout,*)
'for catchment : ',ccat(jcat)
149 CALL
abor1_sfx(
"RESTART_COUPL_TOPD_n: pixels water content file is missing")
153 zsum1=sum(xwtopt(jcat,:),mask=xwtopt(jcat,:)/=xundef)
155 CALL
read_topd_file(
'ASCII ',yfiletop(jcat),
'FORMATTED',nnpt(jcat),zwtopt)
157 DO jpix=1,
SIZE(nline(jcat,:))
158 IF ( nline(jcat,jpix)/=0 .AND. nline(jcat,jpix)/=xundef )
THEN
159 IF (zwtopt(jpix) /= xundef) xwtopt(jcat,nline(jcat,jpix)) = zwtopt(jpix)
163 zsum2=sum(xwtopt(jcat,:),mask=xwtopt(jcat,:)<xundef)
165 IF ( abs(zsum2-zsum1)>100. )
THEN
168 DO jj=1,
SIZE(nline,2)
169 IF ( nline(jcat,jj)/=0 )
THEN
170 IF ( xwtopt(jcat,nline(jcat,jj))/=xundef ) zcnt_undef = zcnt_undef + 1.
174 IF (zcnt_undef/=0.)
THEN
175 zdenom = (zsum2-zsum1)/zcnt_undef
176 DO jj=1,
SIZE(nline,2)
177 IF ( nline(jcat,jj)/=0 )
THEN
178 IF ( xwtopt(jcat,nline(jcat,jj))/=xundef )
THEN
179 xwtopt(jcat,nline(jcat,jj)) = xwtopt(jcat,nline(jcat,jj)) - zdenom
184 zsum2=sum(xwtopt(jcat,:),mask=xwtopt(jcat,:)<xundef)
194 WRITE(*,*)
'Read Asat files'
196 CALL
open_file(
'ASCII ',nunit,
'surfcont_init.map',
'FORMATTED',haction=
'READ ')
204 IF (lhook) CALL dr_hook(
'RESTART_COUPL_TOPD',1,zhook_handle)
subroutine read_topd_file(HPROGRAM, HFILE, HFORM, KNPT, PTOPD_READ)
subroutine read_file_isbamap(UG, KUNIT, PVAR, KI)
subroutine restart_coupl_topd(UG, U, HPROGRAM, KI)
subroutine abor1_sfx(YTEXT)
subroutine close_file(HPROGRAM, KUNIT)
subroutine get_luout(HPROGRAM, KLUOUT)
subroutine open_file(HPROGRAM, KUNIT, HFILE, HFORM, HACTION, HACCESS, KRECL)