43 USE modi_test_record_len
45 USE yomhook
,ONLY : lhook, dr_hook
46 USE parkind1
,ONLY : jprb
53 CHARACTER(LEN=12),
INTENT(IN) :: hrec
54 LOGICAL,
INTENT(INOUT) :: owfl
55 INTEGER :: ip, ivar, ifield, jfield
57 REAL(KIND=JPRB) :: zhook_handle
61 IF (lhook) CALL dr_hook(
'INIT_WRITE_TXT',0,zhook_handle)
65 IF (hrec==cvar(ip))
THEN
68 ELSEIF(hrec==cvarn(ip))
THEN
79 ELSEIF (ivar.NE.nunit0)
THEN
85 IF (cvar(1).NE.
' ') ivar=maxval(nvar(:))
88 IF (.NOT.dgu%LSELECT)
THEN
90 IF ( (hrec(5:7)/=
'_OC' ) .AND. &
91 (hrec(4:6)/=
'_OC' ) .AND. &
92 (hrec(1:3)/=
'SEA' ) .AND. &
93 (hrec(1:2)/=
'DX' ) .AND. &
94 (hrec(1:2)/=
'DY' ) .AND. &
95 (hrec(1:4)/=
'CLAY' ) .AND. &
96 (hrec(1:4)/=
'SAND' ) .AND. &
97 (hrec(1:2)/=
'ZS' ) .AND. &
98 (hrec(1:4)/=
'SSO_' ) .AND. &
99 (hrec(1:4)/=
'Q2M_' ) .AND. &
100 (hrec(1:4)/=
'RESA' ) .AND. &
101 (hrec(1:3)/=
'RI_' ) .AND. &
102 (hrec(1:5)/=
'REG_L' ) .AND. &
103 (hrec(1:3)/=
'AOS' ) .AND. &
104 (hrec(1:3)/=
'HO2' ) .AND. &
105 (hrec(1:3)/=
'RGL' ) .AND. &
106 (hrec(1:3)/=
'SWD' ) .AND. &
107 (hrec(1:3)/=
'SWU' ) .AND. &
108 (hrec(1:3)/=
'LWD' ) .AND. &
109 (hrec(1:3)/=
'LWU' ) .AND. &
110 (hrec(1:3)/=
'ALB' ) .AND. &
111 (hrec(1:2)/=
'DG' ) .AND. &
112 (hrec(1:5)/=
'DROOT' ) .AND. &
113 (hrec(1:4)/=
'DTOT' ) .AND. &
114 (hrec(1:7)/=
'RUNOFFD' ) .AND. &
115 (hrec(1:8)/=
'ROOTFRAC' ) .AND. &
116 (hrec(1:4)/=
'WSAT' ) .AND. &
117 (hrec(1:3)/=
'WFC' ) .AND. &
118 (hrec(1:5)/=
'WWILT' ) .AND. &
119 (hrec(1:4)/=
'DICE' ) .AND. &
120 (hrec(1:2)/=
'CV' ) .AND. &
121 (hrec(1:5)/=
'GAMMA' ) .AND. &
122 (hrec(1:5)/=
'RSMIN' ) .AND. &
123 (hrec(1:5)/=
'WRMAX' ) .AND. &
124 (hrec(1:5)/=
'Z0REL' ) .AND. &
125 (hrec(1:5)/=
'Z0SEA' ) .AND. &
126 (hrec(1:7)/=
'Z0WATER' ) .AND. &
127 (hrec(4:6)/=
'_ZS' ) .AND. &
128 (hrec(1:7)/=
'VEGTYPE' ) .AND. &
129 (hrec(1:5)/=
'COVER' ) .AND. &
130 (hrec(1:5)/=
'IRRIG' ) .AND. &
131 (hrec(1:4)/=
'TI_R' ) .AND. &
132 (hrec(1:3)/=
'CD_' ) .AND. &
133 (hrec(1:3)/=
'CE_' ) .AND. &
134 (hrec(1:3)/=
'CH_' ) .AND. &
135 (hrec(1:4)/=
'FMU_' ) .AND. &
136 (hrec(1:4)/=
'FMV_' ) .AND. &
137 (hrec(1:6)/=
'DRIVEG' ) .AND. &
138 (hrec(1:5)/=
'RRVEG' ) .AND. &
139 (hrec(1:8)/=
'BLD_DESC' ) .AND. &
140 (hrec(1:2)/=
'Z0' ) )
THEN
143 IF (ivar-nunit0>jpvar)
THEN
144 CALL
abor1_sfx(
'TOO MANY FIELDS TO BE WRITTEN IN THE "TEXTE" TYPE TIMESERIES')
146 cvar(ivar-nunit0) = hrec
147 nvar(ivar-nunit0) = ivar
148 OPEN(unit=ivar,file=trim(hrec)//
'.TXT',form=
'FORMATTED')
153 DO WHILE (cvarn(ip).NE.
' ')
163 DO jfield=1,
SIZE(dgu%CSELECT)
164 IF (dgu%CSELECT(jfield)==
' ')
EXIT
169 "ASCII ",hrec,lmatch)
171 IF (.NOT. lmatch )
THEN
174 IF (ivar-nunit0>jpvar)
THEN
175 CALL
abor1_sfx(
'TOO MANY FIELDS TO BE WRITTEN IN THE "TEXTE" TYPE TIMESERIES')
177 cvar(ivar-nunit0) = hrec
178 nvar(ivar-nunit0) = ivar
179 OPEN(unit=ivar,file=trim(hrec)//
'.TXT',form=
'FORMATTED')
190 IF (lhook) CALL dr_hook(
'INIT_WRITE_TXT',1,zhook_handle)
subroutine abor1_sfx(YTEXT)
subroutine init_write_txt(DGU, HREC, OWFL)
subroutine test_record_len(DGU, HPROGRAM, HREC, ONOWRITE)