7 kemis_nbr,hemis_name,tppronos,kch,kluout,kverb)
37 USE modi_ch_open_inputb
48 USE yomhook
,ONLY : lhook, dr_hook
49 USE parkind1
,ONLY : jprb
58 TYPE(sv_t),
INTENT(INOUT) :: sv
60 INTEGER,
INTENT(IN) :: kemis_nbr
61 CHARACTER(LEN=12),
DIMENSION(KEMIS_NBR),
INTENT(IN) :: hemis_name
63 INTEGER,
INTENT(IN) :: kch
64 INTEGER,
INTENT(IN) :: kluout
65 INTEGER,
INTENT(IN) :: kverb
69 CHARACTER(LEN=256) :: yinpline
75 CHARACTER(LEN=32) :: ypro_name, yemis_name
77 CHARACTER(LEN=6),
DIMENSION(:),
POINTER :: cnames
80 REAL(KIND=JPRB) :: zhook_handle
87 IF (lhook) CALL dr_hook(
'BUILD_PRONOSLIST_N',0,zhook_handle)
96 CALL ch_open_inputb(
"AGREGATION", kch , kluout)
108 READ(kch,
'(A)',iostat=ierr) yinpline
111 yinpline = trim(adjustl(yinpline))
112 IF (len_trim(yinpline) == 0) cycle
113 IF (yinpline ==
'END_AGREGATION')
EXIT
118 indx = index(yinpline,
' ')
119 ypro_name = yinpline(1:indx-1)
124 IF (cnames(ji) == ypro_name)
THEN
130 IF (.NOT. gfound)
THEN
131 WRITE(kluout,*)
'BUILD_PRONOSLIST ERROR : ',trim(ypro_name),&
132 ' not found in pronostic variables list !'
133 CALL
abor1_sfx(
'BUILD_PRONOSLISTN: VARIABLE NOT FOUND')
140 DO WHILE(
ASSOCIATED(current))
141 IF (current%NAMINDEX == indx_pro)
THEN
142 inbcoeff = current%NBCOEFF
146 current=>current%NEXT
148 IF (.NOT. gfound)
THEN
151 current%NAMINDEX = indx_pro
160 yinpline = adjustl(yinpline(indx:))
161 indx = index(yinpline,
' ')
163 inbcoeff = inbcoeff+1
164 IF (inbcoeff > jpnbcoeffmax)
THEN
165 WRITE(kluout,*)
'FATAL ERROR : Number of aggregation coefficients for ',&
166 trim(ypro_name),
' exceeds constant JPNBCOEFFMAX = ',jpnbcoeffmax
167 WRITE(kluout,*)
'=> You should increase the JPNBCOEFFMAX value in modd_type_efutil.f90'
168 CALL
abor1_sfx(
'BUILD_PRONOSLISTN: NUMBER OF AGGREGATION COEFFICIENTS TOO BIG')
170 READ(yinpline(1:indx-1),*) current%XCOEFF(inbcoeff)
173 yinpline = adjustl(yinpline(indx:))
174 indx = index(yinpline,
' ')
175 yemis_name = yinpline(1:indx-1)
180 IF (trim(hemis_name(ji)) == trim(yemis_name))
THEN
182 current%NEFINDEX(inbcoeff) = ji
186 IF (.NOT. gfound)
THEN
187 WRITE(kluout,*)
'ERROR : ',trim(yemis_name),&
188 ' not found in emission variables list !'
189 CALL
abor1_sfx(
'BUILD_PRONOSLISTN: UNKNOWN EMISSION VARIABLE')
192 current%NBCOEFF = inbcoeff
199 WRITE(kluout,*)
'BUILD_PRONOSLIST: Aggregation results'
201 DO WHILE(
ASSOCIATED(current))
202 WRITE(kluout,*)
'Emission for Atmospheric Chemical Species ',trim(cnames(current%NAMINDEX)),
' (index ',&
203 current%NAMINDEX,
' in CSV)'
204 WRITE(kluout,*)
'is aggregated with the following weights from the Emission Inventory Species:'
205 DO ji=1,current%NBCOEFF
206 WRITE(kluout,*) current%XCOEFF(ji),hemis_name(current%NEFINDEX(ji))
208 current=>current%NEXT
212 IF (lhook) CALL dr_hook(
'BUILD_PRONOSLIST_N',1,zhook_handle)
250 CHARACTER(len=*),
INTENT(INOUT) :: htext
254 CHARACTER,
PARAMETER :: yptab = char(9)
256 REAL(KIND=JPRB) :: zhook_handle
263 IF (lhook) CALL dr_hook(
'TAB2SPACE',0,zhook_handle)
264 DO ji=1,len_trim(htext)
265 IF (htext(ji:ji) == yptab) htext(ji:ji) =
' '
267 IF (lhook) CALL dr_hook(
'TAB2SPACE',1,zhook_handle)
subroutine abor1_sfx(YTEXT)
subroutine tab2space(HTEXT)
subroutine build_pronoslist_n(SV, KEMIS_NBR, HEMIS_NAME, TPPRONOS, KCH, KLUOUT, KVERB)