EPA-AA-TSS-IM85-2
Technical Report
Multiple Stringency Version of
MOBILE3 Users Guide
By
David J. Brzezinski
April 198S.
NOTICE
Technical Reports do not necessarily represent final EPA
decisions or positions. They are intended to present
technical analysis of issues using data which are
currently available. The purpose in the release of such
reports is to facilitate the exchange of technical
information and to inform the public of technical
developments which may form the basis for a final EPA
decision, position or regulatory action.
Technical Support Staff
Emission Control Technology Division.
Office of Mobile Sources
Office of Air and Radiation
U. S. Environmental Protection Agency
-------
-2-
1.0 BACKGROUND
MOBILES, as with all of the EPA mobile source models, uses
a single stringency to identify the first year failure rate of
Tech I (pre-catalyst) and Tech II (oxidation catalyst) vehicles
in the Inspection and Maintenance (I/M) program to be modeled.
This single number most often covers a wide range of
technologies and vehicle classes when applied to an I/M program
which inspects many model years and all vehicle types. Unless
the cutpoints used are carefully balanced, the actual failure
rate may vary greatly from model year to model year and vehicle
class to vehicle class. This single stringency input was meant
to reduce the amount of input information necessary to model an
I/M scenario.
It is possible for MOBILES to use a separate stringency
for each model year of each vehicle class. The only barrier
has been the need to modifiy the input stream and appropriate
subroutines to accept and utilize user supplied information.
Such modifications have now been done and the results are
described in this report. No other changes in the MOBILES code
have been made other than the changes necessary to accept the
multiple stringencies. Therefore, this version of MOBILES is
not different from the original release of MOBILES for non-I/M
cases and differs only in its flexibility for evaluating I/M
cases.
-------
-3-
2.0 INPUTS
It is assumed for purposes of this report that the user is
familiar with using MOBILES and has available the MOBILES Users
Guide.* This report, therefore, addresses only the new inputs
and modifications to the existing inputs.
The only input flag modified is the stringency level
described in Section 2.2.3 of the MOBILER3 Users Guide.
Usually the second field of the I/M characteristics record
indicates the stringency to use for all model years and vehicle
classes. In the Multiple Stringency MOBILES, the use of this
flag has been modified to indicate the number of stringencys
the user wishes to input. The valid range for of this flag is
now therefore 1 to 99.
Immediately following the I/M characteristics record in
the input stream should follow the new stringency input data.
This information must precede the anti-tamper ing program (ATP)
characteristics record. The user must input stringency
description records totaling the number indicated in the second
field of the I/M characteristics record. Too many or too few
stringency description records will result in an error
message. Each stringency description record must contain the
following information:
1. Vehicle class (1-3)
2. First model year of stringency group
3. Last model year of stringency group
4. Stringency (10-50)
The format for this record is II,IX,12,IX,12,IX,12.
The vehicle class indicates the vehicle type for which the
stringency will apply. Only passenger cars (LDGV: 1) and
light-duty trucks. (LDGT1: 2 and LDGT2: 3) are valid vehicle
types.
The first and last model years for the stringency group
indicate inclusively the model years for which this stringency
record will apply. Only the last two digits of the model year
.are input in each case. If the same model year is used for the
first and last model year, then the stringency will only apply
to that one model year. If a single stringency is to be used
*"Users Guide to MOBILES (Mobile Source Emissions Model)",
EPA-460/3-84-002.
-------
-4-
for all model years of that vehicle type, the first and last
model years must cover all of the model years for which
stringency applies. For LDGV, this is 1951 through 1980. For
LDGT1 and LDGT2, this is 1951 through 1983. Last model years
beyond these ranges will cause an error message.
Model year ranges for a stringency must be chosen with
care. Overlapping model year ranges for the same vehicle class
will result in an error message.
Since a stringency record cannot apply to more than one
vehicle type, there must be at least one stringency record for
each vehicle type subject to the I/M program specified in the
I/M characteristics record. If a vehicle class or model year
is not given a stringency, the model will assume the stringency
is zero and put a warning in the output.
The last field of the stringency record is the stringency
itself. Stringency is defined as the first year failure rate
in percent for the idle hydrocarbon (IHC) and idle carbon
monoxide (ICO) concentration cutpoints used in the program.
The stringency input in this field must correspond to the
stringency for the model year group defined by the first and
last model years specified in the second and third fields.
-------
-5-
3.0 ERRORS AND WARNINGS
If a stringency record specifies an invalid (greater than
3) vehicle type, an error 84 will occur:
- out of bounds, I/M Stringency for classes 1-3 only
If a stringency record specifies a model year beyond the
valid range of model years for that vehicle class, an error 85
or 86 will occur:
- inappropriate first/last MYR for stringency
If a model year is specified in more than one stringency
record for a vehicle class, an error 86 will occur:
- inappropriate last MYR for stringency
This error will indicate the stringency record for the model
year range whose last model year is duplicated elsewhere.
If the stringency input is not between 10 and 50, an error
33 will occur:
- out of bounds, stringency (10 to 50)
All of the above errors are .fatal and will cause the
MOBILES run to terminate.
If a vehicle cla'ss or model year covered by the I/M
program which uses stringency has not had a stringency
specified using a stringency record, the model will assume that
the stringency is zero and will issue a warning in the output:
Warning: I/M stringency for (MYR) class is zero
This warning will not prevent completion of the MOBILES
computations.
-------
-6-
4.0 EXAMPLE
The example input stream shows a case where nine
stringencies are specified in the second field of the I/M
characteristics record. The I/M characteristics record is then
immediately followed by the nine stringency records. In- this
example three stringency records are used -to define stringency
levels for each of the three vehicle classes. The third
stringency record demonstrates the technique to specify a
stringency for a single model year. Note that the model years
covered by the stringencies cover all of the model years which
must be covered and do so without overlap.
The output echoes the user input stringency information in
the I/M program description.
-------
-7-
Example Input Stream for Multiple Stingency MOBILES
MOBILES : 1
1
83
1
1
1
2
2
2
3
3
3
1
1 1
09
51
75
80
51
75
80
51
79
81
88
1
1
74
79
80
74
79
83
78
80
83
19
1 :
51
10
20
10
10
20
10
10
20
10
.6
MULTIPLE STRINGENCY MOBILES
2 1 .1 4 4 2 1 1
20 4 1 2 1
75.0 20.6 27.3 20.6
I PROMPT
PROJID
Input/Output Flags
I/M. Characteristics
Stringency Record
Stringency Record
Stringency Record
Stringency Record
Stringency Record
Stringency Record
Stringency Record
Stringency Record
Stringency Record
Scenario Record
-------
-8-
.Example Output Using Multiple Stringency MOBILES
MOBILES : MULTIPLE STRINGENCY MOBILES
I/M program selected:
Start year (January 1):
Number of input stringencys:
Mechanic training program?:
First model year covered:
Last model year covered:
Vehicle types covered:
1981 t later MYR test type:
1981 & later MYR test cutpoints:
1983
9
No
1951
2020
LDGV, LDGT1, LDGT2
Idle
1.2% ICO / 220 ppm IHC
Vehicle Class 1 -
Vehicle Class 1 -
Vehicle Class 1 -
Vehicle Class 2 -
Vehicle Class 2 -
Vehicle Class 2 -
Vehicle Class 3 -
Vehicle Class 3 -
Vehicle Class' 3 -
Model Years 1951
Model Years 1975
Model Years 1980
Model Years 1951
Model Years 1975
Model Years 1980
Model Years 1951
Model Years 1979
Model Years 1981
through 1974 use 10%
through 1979 use 20%
through 1980 use 10%
through 1974 use 10%
through 1979 use 20%
through 1983 use 10%
through 1978 use 10%
through 1980 use 20%
through 1983 use 10%
Stringency
Stringency
Stringency
Stringency
Stringency
Stringency
Stringency
Stringency
Stringency
Total HG.emission factors include evapora'tive HC emission factors.
Cal.
Year:
1988
I/M
Anti-tarn.
Veh.
Veh.
VMT
Type:
Sod. :
Mix:
LDGV
19.6
0.643
LDGT1
19.6
0.121
Region: Low Altitude: 500. Ft.
Program: Yes Ambient Temp:.- 75.0 (F)
Program: No Operating Mode:
LDGT2
19.6
0.087
LDGT HDGV
19.6
0.041
LDDV
19.6
0.036
LDDT
19.6
0.015
20.6 /
HDDV
19.6
0.050
27:
MC
19.
0.
3 /'20
Ail
6
007
.6
Ve
Composite
Total HC:
*Svap HC:
Exhst CO:
2xhst NOX:
Emission Factors (Gm/Mile)
,2.25 4.15 5.14 4.57 8.75
0.85 1.33 1.74 1.50 4.60
14.25 26.49 28.36 27.27 91.06
1.56 2.72 3.05 2.86 5.32
0.40 0.62 3.94
0.0 0.0 0.0
1-.32 1.53 , 11.63
1.17 1.45 17.74
6.02 3.02
2.26 '
19.81 19.3.2
0.65 2.78
-------
-9-
5.0 COMPUTER CODE CHANGES
The Appendix contains a listing of the subroutines and
functions which contain the changes in the MOBILES computer
code necessary to allow the use of multiple stringency. Any
changes in the code are indicated by a verticle bar near the
MOBILES Users Guide line number. The subroutines and functions
with changes are:
1. Subroutine ONESEC
2. Subroutine QUITER
3. Function PCLEFT
4. Subroutine OUTIMP
Subroutine ONESEC contains the input code and input checks
for the stringency records. Subroutine QUITER contains the
error code output logic. Function PCLEFT chooses the
appropriate stringency to use for choosing the I/M program
credit for each model year of each vehicle class. This
function is where the new input information is actually
utilized. Subroutine OUTIMP was modified to write the user
input in the MOBILES output.
In subroutine PCLEFT, the model sorts through all of the
input stringency records for each model year of each vehicle
class covered by the I/M program once for HC and once for CO.
If the model year and vehicle class combination is not covered
by a stringency record and that combination is covered by the
I/M program as specified in the I/M characteristics record,
then the stringency i's assumed to be zero and PCLEFT is
returned as one.
-------
Appendix
Multiple Stringency MOBILE3 :
Computer Code Changes Necessary
to Allow Multiple Stringency Input
-------
Page 1
3000
3000.6
3000.7
3001
3002
3003
3004
3005
3006
3007
3008
3009
3010
3011
3012
3013
3014
3015
3016
3017
3018
3019
3020
3021
3022
3023
3024
3025
3026
3027
3028
3029
3030
3031
3032
3033"
3034
3035
3036
3037
3039
3040
3041
3042
3043
3044
3044.2
3044.4
3044.6
3044.8
3045
3046
3047
3048
3049
3050
3051
C
C
.C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
.C
C
C
C
C
C
C.
C
C
C
SUBROUTINE ONESEC (INERR,*)
This Subroutine has been modified to use multiple stringencies
ONESEC checks if control flags indicate One-time Data. It then reads in,
validates, and stores the data.
Called by MAIN.
Calls CCEVAX, GETATP, GET IMC, GETVMT, NEWERQ, QUITER and YRTEST.
Input on call:
parameter list: INERR
common blocks:
/ FLAGS 1 / I PROMT , TAMFLG , VMFLAG
/FLAGS2/ MYMRFG.NEWFLG, IMFLAG, ATPFLG
/FLAGS3/ ICEVFG
/IOUCOM/ IOUGEN.IOUASK
/SYSCOM/ MAXVEH
/YEARS4/ IY 1941, IY 1960, IY2020
Output on return:
parameter list: INERR
common blocks:
/BASETR/ ZMLTAM.DRTAM
/CEVCOM/ USRTPD.USRMPD
/IMPAR1/ ICYIM,ISTRIN,IMTFLG,MODYR1,MODYR2
/IMPAR2/ ILDT, ITEST, ICUTS.NUDATA.NLIM, IMNAME
/MYRSAV/ AMAR, JULMYR
/NEWCOM/ NEWPAR,BERNEW,NEWFIT,NEWCT
,
Local array subscripts:
NAMMMR(2,2,8) - NAMMMR ( ICH, IG, IV )
Local variable / array dictionary:
Name Type Description
CHKMYR R myr mix check: sum of the myr fractions - 1.0 +/- i.E-6
(a normalized myr distribution has been entered for each IV)
DRNEW R new emission rate's deterioration rate (slope)
MYF I my of first (JDX order) AMAR / JULMYR to be entered on READ
MYL I . my of last (JDX order) AMAR / JULMYR to be entered on READ
NAMMMR R*8 prompts for replacement AMAR & JULMYR, by JDX & IV
NVEH I vehicle class for stringency input
NMYF I first model year of stringency grouping
NMYL I last model year of stringency grouping
NSTR I stringency for MYR/CLASS grouping
NEWMYF I new emission rate's first my of affected range
NEWMYL I new emission rate's last my of affected range
NEWPOL I new 'emission rate's pollutant code
NEWREG I new emission rate's region code
NEWVEH I new emission rate's vehicle type code
SUMMYR R sum of myr for IV; used to normalize user entered JULMYR
2EROML R user entered tampering zml to be checked: ZEROML <- 1.0
-------
Page 2
3052
3053
3054
3055
3056
3057
3058
3059
3060
3061
3062
3063
3064
3065
3066
3067
3068
| 3068. 5
3069
3070
3071
3072
3073
3074
3075
3076
3077
3078
3079
3080
3081
3082
3083
3084
3085
3086
3087
3088
3089
3090
3091
3092
309.3
3094
.3095
3096
3097
3098
3099
3100
3101
3102
3103
3104
3105
3106
3107
3108
3109
C ZMLNEW R new emission rate's zero mile level (intercept)
r*
\~
C
C
INTEGER TAMFLG,SPDFLG,VMFLAG,ALHFLG,ATPFLG,PRTFLG
REAL JULMYR
C
COMMON /BASETR/ BTR(7,2),ZMLTAM(7,2,4) ,DRTAM(7,2,4)
COMMON /CEVCOM/ USRTPD(8) ,USRMPD(8)
COMMON /FLAGS 1/ IPROMT.TAMFLG.SPDFLG.VMFLAG
COMMON /FLAGS2/ MYMRFG.NEWFLG, IMFLAG, ALHFLG.ATPFLG
COMMON /FLAGS3/ IFORM, PRTFLG, ICEVFG, IDLFLG.NMHFLG
COMMON /IMPAR1/ ICYIM, ISTRIN, IMTFLG.MODYR1 ,MODYR2
COMMON /IMPAR2/ ILDT, ITEST, ICUTS.NUDATA.NLIM, IMNAME(20,9)
COMMON /IOUCOM/ IOUAER, IOUIMD, IOUGEN, IOUREP, IOUERR, IOUASK
COMMON /MYRSAV/ AMAR (20 , 8) , JULMYR (20 , 8) , NEWCUM
COMMON /NEWCOM/ NEWPAR(5 , 100) ,BERNEW(2, 100) ,NEWFIT(100) .NEWCT
COMMON /NEWTOO/ NEWSTR (4 , 1 00)
COMMON /SYSCOM/ MAXVEH , MAXLTW , MAXPOL , MAXREG , INITPR
COMMON /YEARS4/ IY1941 , IY1960, IY2020
C
REAL*8 NAMMMR (2 , 2 , 8)
C
DATA NAMMMR/
* '1-10 for1 , ' LDGV: ' ,
* '11-20 fo'.'r LDGV: ',
* ' 1-10 for' , ' LDGT1: ' ,
* ' 11-20 fo'.'r LDGT1:1,
* '1-10 for ' , ' LDGT2 1 ' ,
* '11-20 fo', 'r LDGT2:1 ,
* '1-10 for' , ' HDGV: ',
* ' 11-20 fo1 , 'r HDGV: ' ,
* ' 1-10 for', ' LDDV: ' ,
* '11-20 fo', 'r LDDV: ' ,
* '1-10 for', ' LDDT: ',
* ' 11-20 fo', 'r LDDT: ',
* ' 1-10 for', ' HDDV: ' ,
* ' n-20 fo', 'r HDDV: ',
* ' 1-10 for', ' Me: ',
*. '11-20 fo', 'r Me: '/
C
C Process flags.
C
IF(TAMFLG.EQ.l) GOTO 20
IF(IMFLAG.EQ.2) GOTO 10
C .
IF(IPROMT.EQ.2) WRITE (IOUASK, 200)
200 FORMAT (' ',' Enter tampering intercepts (zero mile levels)')
IF(IPROMT.EQ.2) WRITE (IOUASK, 205)
205 FORMAT (' ' , 'for non-I/M case only:')
READ (IOUGEN, 1 00 , END-99) ( (ZMLTAM (ID, 1 , IVTAM) , ID- 1 , 7) , IVTAM- 1
100 FORMAT (7F8. 4)
IF(IPROMT.EQ.2) WRITE (IOUASK, 2 10)
210 FORMAT (' ',' Enter tampering slopes (deterioration rates)')
IF (IPROMT. EQ. 2) WRITE (IOUASK, 205)
READ(IOUGEN, 1 10.END-99) ((DRTAM(ID, 1 , IVTAM) , ID-1 ,7) .IVTAM-1 ,
110 FORMAT (7F9. 5)
GOTO 12
C
,4)
4)
-------
3110
3111
3112
3113
3114
3115
3116
3117
3118
3-119
3120
3121
3122
3123
3124
3125
3126
3127
3128
3129 .
3130
3131
3132
3133
3134
3135
3136
3137
3138
3139
3140
3141
3142
3143
3144
3145
3146
3147
3148
3149
3150
3151
3152
3153
3154
3155
3156
3157
3158
3159
3160
3161
3162
3153
3164
3165
3166
3167
3168
C
C
C
C
C
C
C
C
C
C
C
C
C
C
Page 3
10 IF(IPROKT.EQ.2) WRITE(IOUASK,200)
IF(IPROMT.EQ.2) WRITE (IOUASK,2 15).
215 FORMAT(' ','for non-I/M and I/M cases:')
READ(lOUGEN,100,END-99) ZMLTAM
IF(IPROMT.EQ.2) WRITE(IOUASK,210)
IF(IPROKT.EQ.2) WRITE(IOUASK,215)
READ(IOUGEN,110,END-99) DRTAM
Insure tampering zero mile levels (intercepts) do not exceed unity.
There is no range check for deterioration rates.
12 DO 14 IVTAM-1,4
DO 14 IM-1.IMFLAG
DO 14 ID-1,7
ZEROML-ZMLTAM(ID,IM,IVTAM)
IF(ZEROML.GT.1.0) CALL QUITER(ZEROML,0,50,INERR)
14 CONTINUE
Checfc for user supplied vmt mix to be used for all scenarios of this run.
20 IF(VMFLAG.EQ.3) CALL GETVMT(INERR,&99)
ChecJc for user supplied my mileage accrual rates and / or registration
distributions.
IF(MYMRFG.EQ.I) GOTO 44
IF(MYMRFG.EQ.3) GOTO 26
IF(IPROMT.EQ.2) WRITE(IOUASK,220)
220 FORMAT(/)
DO 22 IV-1.MAXVEH
DO 22 IG-1,2
IF(IPROMT.EQ.2) WRITE(IOUASK,230) (NAMMMR(lCH,IG,IV),ICH-1,2)
230 FORMAT(' '/Enter MYM ages *,2A8)
MYF-1
IF(IG.EQ.2) MYF-11
MYL-10
IF(IG.EQ.2) MYL-20
READ(IOUGEN,130,END-99) (AMAR(JDX,IV),JDX-MYF.MYL)
130 FORMAT(10F5.3)
22 CONTINUE
DO 24 IV-1.MAXVEH
DO 24 JDX-1,20
IF(AMAR(JDX,IV).LT.O.) CALL QUITER(AMAR(JDX,IV),0,19,INERR)
24 CONTINUE
IF(MYMRFG.EQ.2) GOTO 36
26 IF(IPROMT.EQ.2) WRITE(IOUASK,220)
DO 32 IV-1.MAXVEH
DO 28 IG-1,2
IF(IPROMT.EQ.2) WRITE(IOUASK,235) (NAMMMR(ICH,IG,IV),ICH-1,2)
235 FORMAT(' ','Enter KYR ages ',2A8)
MYF-1
IF(IG.EQ.2) MYF-11
MYL-10
IF(IG.EQ.2) MYL-20
READ(IOUGEN,130,END-99) (JULMYR(JDX,IV),JDX-MYF.MYL)
28 CONTINUE
-------
Page 4
3169
3170
3171
3172
3173
3174
3175
3175
3177
3178
3179
3180
318.1
3182
3183
3184
3185
3186
3187
3188
3189
3190
3191
3192
3193
3194
3195
3196
3197
3198
3199
3200
3201
3202
3203
3204
3205
3206
3207
3208
3209
3210
3211
3212
.3213
3214
3215
3216
3217
3218
3219
3220
3221
3222
3223
3224
3225
3226
3227
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
CHKMYR-0.0
DO 30 JDX-1,20
CHKMYR-JULMYR(JDX,IV)+CHKMYR .
30 CONTINUE
IF(CHKMYR-.00001.GT.1..OR.CHKMYR+.00001.LT.1.)
* CALL QUITER(CHKMYR,0,49,INERR)
32 CONTINUE
DO 34 IV-1.MAXVEH
DO 34 JDX-1,20'
IF(JULMYR(JDX,IV).LT.O.) CALL QUITER(JULMYR(JDX,IV),0,20,INERR)
34 CONTINUE
36 DO 38 IV-1.MAXVEH
Skip 0 with non-0 checks if user supplies MYR only and on HDDV pass:
the BD values are 0.0's for all 20 my's (HDDMYM has not yet been called)
IF(KYMRFG.EQ.3.AND.IV.EQ.7) GOTO 38
DO 38 JDX-1,20
IF(AMAR(JDX,IV).LE.0.0.AND.JULMYR(JDX,IV).GT.0.0)
* CALL QUITER(JULMYR(JDX,IV),0,21,INERR)
IF (Am (JDX,IV).CT.0.0.AND.JULMYR (JDX, IV) .EQ.0.0)
* CALL QUITER(AMAR(JDX,IV),0,22,INERR)
38 CONTINUE
Check vehicle equalities (LDGV.LDDV), (LDGTl.LDDT) mod yr regs.
DO 40 JDX-1,20
IF(JULMYR(JDX,l).NE.JULMYR(JDX,5)) CALL QUITER(0.,JDX,65,INERR)
IF(JULMYR(JDX,2).NE.JULMYR(JDX,6)) CALL QUITER(0.,JDX,66,INERR)
40 CONTINUE
Normalize JULMYR.
44 DO 50 IV-1.MAXVEH
SUMMYR=0.0
DO 46 JDX-1,20
SUMMYR-JULMYR(JDX,IV)+SUMMYR
46 CONTINUE
IF(SUMMYR.EQ.O.) SUMMYR-1.
DO 50 JDX-1,20
JULMYR(JDX,IV)-JULMYR(JDX,IV)/SUMMYR
50 CONTINUE
Here read in e.f. modification data.
IF(NEWFLG.EQ.1) GOTO 60
IF(IPROMT.EQ.2) WRITE(IOUASK,240)
240 FORMAT('0','Enter no. of new e.f. intercept/slope pairs (12)')
READ(IOUGEN,140,END-99) NEWCT
140 FORMAT(12)
IF(NEWCT.LT.1.OR.NEWCT.GT.100) CALL QUITER(0.,NEWCT,23,INERR)
-------
Page 5
3228 DO 55 IFAC-1.NEWCT
2229 IF(IPROMT.EQ.2) WRITE(IOUASK,250)
3230 250 FORMATC ','Enter region,veh. type,pollutant,first my,1/
3231 * ' ','last ray,new intercept (A), and new slope (B)')
3232 READ(IOUGEN,150,END-99) NEWREG,NEWVEH,NEVPOL,
3233 * NEWMYF,NEWMYL,ZMLNEW.DRNEW
3234 150 FORMAT(11,1X,I1,1X,I1,1X.I2,1X,12,1X.F6.2,1X.F6.2)
3235 IF (NEWREG. NE. LAND. NEWREG. NE. 2)
3236 * CALL QUITER(0.,NEWREG,62,INERR)
3237 IF(NEWVEH.LT.LOR.NEWVEH.GT.8) CALL QUITER(0.,NEWVEH,25,INERR)
3238 . IF(NEWPOL.LT.LOR.NEWPOL.GT.3) CALL QUITER(0. .NEWPOL.26, INERR)
3239 CALL YRTEST(NEWMYF,27,IY1941,IY2020,INERR)
3240 CALL YRTEST(NEWMYL,28,IY1941,IY2020,INERR)
3241 IF(NEWMYL.LT.NEWMYF) CALL QUITER(0.,0,29,INERR)
3242 IF(ZMLNEW.LE.O.) CALL QUITER(ZMLNEW,0,30,INERR)
3243 IF(DRNEW.LT.O.) CALL QUITER(DRNEW,0,31,INERR)
3244 C
3245 C Store alternate equation data.
3246 C
3247 . NEWPAR(1,IFAC)-NEWREG
3248 NEWPAR(2,IFAC)-NEWVEH
3249 NEWPAR(3,IFAC)-NEWPOL
3250 NEWPAR(4,IFAC)-NEWMYF
3251 NEWPAR(5,IFAC)-NEWMYL
3252 BERNEW(1,IFAC)-ZMLNEW
3253 BERNEW(2,IFAC)-DRNEW
3254 55 CONTINUE
3255 CALL NEWERQ(INERR)
3256 C
3257 C If IMFLAG-2, read in I/M program parameters.
3258 C
3259 60 IF(IMFLAG.EQ.1) GOTO 70
3260 NLIM-0
3261 IF(IPROMT.EQ.2) WRITE(IOUASK,260)
3262 260 FORMATC'0','Enter I/M Start Year, # of stringencies, m.t. flag,1/
3263 * ' ','first model year and last model year of prog, benefits,'/
3264 * ' ','vehicle, test type, cutpoints and newdata flags')
3265 READ(IOUGEN,160,END-99)
3266 * ICYIM,ISTRIN,IMTFLG,MODYR1,MODYR2,ILDT,ITEST,ICUTS,NUDATA
3257 160 FORMAT(2(I2,1X),I1,1X,2(I2,1X),3(I1,1X),I1)
3268 C
3269 C Check. I/M inputs.
3270 C
3271 CALL YRTEST(ICYIM,32,IY1960,IY2020,INERR)
3272 IF(ISTRIN.LT.I) CALL QUITER(0.,ISTRIN,33,INERR)
3273 IF(IMTFLG.LT.LOR.IMTFLG.GT.2) CALL QUITER(0., IMTFLG, 34, INERR)
3274 CALL YRTEST(MODYR1,35,IY1941,IY2020,INERR)
3275 CALL YRTEST(MODYR2,36,IY1941,IY2020,INERR)
3276 . . IF(MODYR1.GT.MODYR2) CALL QUITER(0.,0,37,INERR)
3277 IF(ILDT.LT.LOR.ILDT.GT.4) CALL QUITER(0.,ILDT,72,INERR)
3278 IF(ITEST.LT.LOR.ITEST.GT.3) CALL QUITER(0., ITEST, 73, INERR)
3279 IF(ICUTS.LT.LOR.ICUTS.GT.3) CALL QUITER(0., ICUTS,82, INERR)
3280 IF(NUDATA.LT.LOR.NUDATA.GT.4) CALL QUITER(0. .NUDATA, 74, INERR)
3281 IF (NUDATA. GT.O CALL GETIMC(&99)
3281.02 C
328L04 C This is where the new stringencies are read.
328L06 C
3281.08 IY1980 - 1980
3281.1 IY1983 - 1983
-------
Page 6
3281.12 C
2281.14 IF(IPROKT.EQ.2) WRITE(IOUASK,261) ISTRIN
3281.16 261 FORMAT('0VEnter for each of the ',12,' stringencies :',/,
3281.18 *'OThe vehicle type code ( 1:LDGV, 2:LDGT1, 3:LDGT2 ),',/,
3281.2 *' The first model year of the grouping,',/,
3281.22 *' The last model year of the grouping,'/,
3281.24 *' The first year failure rate (stringency).')
3281.26 C
3281.28 DO 61 IM-1,ISTRIN . .
3281.3 READ(IOUGEN,161,END-99) NVEH,NMYF,NMYL,NSTR
3281.32 161 FORMAT(I1,2(1X,I2),1X,I2)
3281.34 C
3281.36 C Check the stringency input parameters
3281.38 C
3281.4 IF(NVEH.GT.3) CALL QUITER(0.,NVEH,84,INERR)
3281.42 IF(NVEH.EQ.I) CALL YRTEST(NMYF,85,IY1941,IY1980,INERR)
3281.44 IF(NVEH.GT.1) CALL YRTEST(NMYF,85,IY1941,IY1983,INERR)
3281.46 IF(NVEH.EQ.l) CALL YRTEST(NMYL,86,NMYF,IY1980,INERR)
3281.48 IF(NVEH.GT.1) CALL YRTEST(NMYL,86,NMYF,IY1983,INERR)
3281.5 IF(NSTR.LT.10.0R.NSTR.GT.50) CALL QUITER(0.,NSTR,33,INERR)
3281.52 C
3281.54 C Store new stringency information
3281.56 C
3281.58 NEWSTR(1,IM) - NVEH
3281.6 NEWSTR(2,IM) - NMYF
3281.62 NEWSTR(3,IM) - NMYL
3281.64 NEWSTR(4,IM) - NSTR
3281.66 C
3281.68 61 CONTINUE
3281.7 C
3281.72 C Check the MYR group ranges for overlaps
3281.74 C
3281.76 DO 62 IM-1,ISTRIN
3281.78 DO 62 IN-1,ISTRIN
3281.8 IF(NEWSTR(1,IM).NE.NEWSTR(1,IN)) GOTO 62
3281.82 IF(IK.EQ.IN) GOTO 62
3281.84 IF(NEWSTR(3,IM).LT.NEWSTR(2,IN)) GOTO 62
3281.86 IF(NEWSTR(3,IM).LT.NEWSTR(3,IN))
3281.88 * CALL QUITER(0.,NEWSTR(3,IM),86,INERR)
3281.9 62 CONTINUE
3281.92 C
3283 C Anti-tampering program -> get parameters and effectiveness rates.
3284 C
3285 70 IF(ATPFLG.EQ.2) CALL GETATP(INERR,&99)
.3286 C
3287 . IF(ICEVFG.LT.3) GOTO 90
3288 C
3289 C Read trips/day and miles/day.
3290 C
3291 IF(IPROMT.EQ.2) WRITE(IOUASK,270)
3292 270 FORMAT('0','Enter average trips/day')
3293 READ(IOUGEN,170,END-99) USRTPD
3294 170 FORMAT(8F5.1)
3295 C
3296 DO 80 IV-1.MAXVEH
3297 IF(USRTPD(IV).LT.O.) CALL QUITER(USRTPD(lV),0,54,INERR)
3298 80 CONTINUE
3299 C
3300 IF(IPROMT.EQ.2) WRITE(IOUASK,280)
-------
Page 7
3301 280 FORMAT('0','Enter average miles/day1)
3302 READ(lOUGEN,170,END-99) USRMPD .
3303 C
3304 DO 85 IV-1.MAXVEH
3305 IF(USRMPD(IV).LT.O.) CALL QUITER(USRMPD(lV),0,55,INERR)
3306 85 CONTINUE
3307 CALL CCEVAX
3308 90 RETURN
3309 C
3310 C EOF on any attempted read -> take alternate return 1 -> run aborts.
3311 C
3312 99 RETURN 1
3313 END
-------
Page 8
1 1000
1 1000.3
11000.6
1 1001
11002
11003
1 1004
1 1005
1 1006
1 1007
11008
1 1009
11010
1 101 1
1 1012
1 1013
1 1014
1 1015,
11016
1 1017
11018
11019
11020
11021
11022
11023
11024
11025
11026
11027
1 1028
11029
1 1030
11031
11032
11033
11 f\ ^ A
1 034
11035
1 1036
11037
11038
1 1039
1 1040
1 1041
1 1042
1 1043
1 1044
1 1045
11046
1 1047
1 1048
11049
11050
11051
1 1052
1 1053
1 1054
11055
1 1056
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
c
C
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
SUBROUTINE QUITER (RVALUE, IVALUE, MESSAG, INERR)
This Subroutine has been modified to use multiple stringencies
QUITER prints error and warning messages on unit IOUERR.
Called by CONSEC, CRANKC, DIURNL, EFCALX, GETATP, HOTSOK, IERPTR,
IEXMPT, IGEPTR, IGLPTR, IGPPTR, IGSFPT, IGTPTR, IGUPTR,
ISPPTR, ISPPT8, ITCPTR, NEWERQ, ONESEC, PARSEC, TFCALX,
TPD, XMPD and YRTEST.
Input on call:
parameter list: RVALUE, I VALUE, MESSAG, INERR
common blocks:
/IOUCOM/ IOUREP, IOUERR, IOUASK
/NEWCOM/ NEWPAR
/NEWEQU/ MAXEQU
/YEARS4/ IY 194 1,111960, I Y2020
Output on return:
parameter list: INERR
Warning: there is a conditional branch to STOP at statement number 98.
Local array subscripts:
IOBMSG(5) - IOBMSG ( ICH )
NAMFLG(15) - NAMFLG ( ICH )
NAMFNC (16) - NAMFNC ( ICH )
NAMVEH(8) - NAMVEH ( IV )
Local variable / array dictionary:
Name Type Description
IOBMSG I character string vector: 'out of bounds for'
KAXMES I maximum message code value ( - 83 in MOBILES release version)
MCODE I - MESSAG - message code, unless < 0 or > MAXMES -> - 1
NAMFLG R*8 control flag names + 'Unknown'
NAMFNC R*8 function names (to identify subprogram source of error)
NAMVEH R*8 vehicle type names
Notes:
The error message for the new function ITCPTR was installed.
Error/warning code related to INFLAG, TRKFLG & UNFFLG removed and replaced
with code for TAMFLG & ATPFLG. Error code 73 refers to ITEST, not IOPTN.
Error codes 82 (refers to ICUTS) and 83 (refers to interpolated altitude)
added. MAXMES accordingly was increased to 83, leaving MESSAG values
84-97 available for future additions to QUITER' s messages.
COMMON /IOUCOM/ IOUAER, IOUIMD, IOUGEN, IOUREP, IOUERR, IOUASK
COMMON /NEWCOM/ NEWPAR (5 , 1 00) , BERNEW (2 , 1 00) , NEWFIT ( 1 00) , NEWCT
COMMON /NEWEQU/ MAXEQU
COMMON /YEARS4/ IY 1941 , IY1960, IY2020
-------
Page 9
1 1057
1 1058
11059
1 1060
11061
1 1062
1 1063
11064
1 1065
1 1066
1 1067
1 1068
11069
1 1070
11071
1 1072
1 1073
1 1074
1 1075
11076 .
11077
11078
11079
11080
1 1081
11082
1 1083
1.1084
11085
11086
11087
11088
11089
1 1090
1 1091
1 1092
11093
11094
1 1095
11096
11097
1 1098
1 1099
1 1100
1 1 101
1 1102
11103
1 1 104
1 1105
11106
11107
1 1108
| 11109
11110
11111
11112
11113
11114
11115
DIMENSION IOBKSG(5)
C
REAL*8 NAMFLG ( 1 5) , NAMVEH (8) , NAMFNC ( 1 6)
-C
DATA NAMFLG/
* ' Unknown ' ,
* ' IPROMT ' ,
* ' TAMFLG ' ,
* ' SPDFLG ' ,
* ' VMFLAG ' ,
* ' MYMRFG ' ,
* ' NEWFLG ' ,
* ' IMFLAG ' ,
* ' ALHFLG ' ,
* ' ATPFLG ' ,
* ' IFORM ' ,
* ' PRTFLG ' ,
* ' ICEVFG ' ,
* ' IDLFLG ' ,
* ' NHMFLG '/
C
DATA NAMVEH/
* ' LDGV ' ,
* 'LDGT1 ',
* ' LDGT2 ' ,
* 'HDGV
* ' LDDV ' ,
* ' LDDT ' ,
* ' HDDV
* 'KG '/
C
DATA NAMFNC/
* ' HOTSOK ' , .
* ' TPD ' ,
* ' DIURNL ' ,
* ' XMPD ',
* ' CRANKC ' ,
* ' IGEPTR ' ,
* ' IGUPTR ' ,
* ' IGLPTR ',
* ' IGTPTR ' ,
* . ' IGPPTR ' ,
* ' IERPTR ' ,
* ' ISPPTR ' ,
* ' ISPPT8 ' ,
* ' IEXMPT ' ,
* ' ITCPTR ' ,
* ' IGSFPT '/
. C
DATA IOBMSG/
* ' ou ' , ' t of , ' bou ' , ' nds ' , ' f or ' /
C
DATA MAXMES/86/
c
MCODE-MESSAG
C
C Trap unknown errors.
C
IF(MCODE.LT.I.OR.MCODE.GT.MAXMES) MCODE-1
-------
Page 10
11116
11117
11118
11119
11120
11121
11122
1 1123
11124
11125
1 1126
11127
11128
11129
11130
11131
1 1132
11133
11134
11135
[11136
1 1137
11138
11139
11140
11141
11142
11143
11144
11145
1 1146
1 1147
11148
1 1 149
11150
1 1151
11152
11153
11154
11155
1 1156
11157
11158
11159
1.1 16Q
1 1 161
11162
11163
11164
11165
11166
11167
11168
1 1169
11170
1 1 171
1 1172
1 1 173
1 1 174
C
C
C
Test for warnings.
C
C
C
IF(MCODE.NE.16.AND.MCODE.NE.21.AND.MCODE.NE.22.AND.MCODE.NE.31
* . .AND.MCODE.NE.49.AND.MCODE.NE.52.AND.MCODE.NE.53
* .AND.MCODE.NE.56.AND.MCODE.NE.59.AND.MCODE.NE.71)
* WRITE(IOUERR,300)
300 FORMATC -',T2, ' *** Error:1)
Branch to the appropriate error / warning message.
GOTO(
*
*
*
*
*
*
10,
1 1
21,
31,
41,
51,
61,
71,
81,
1 1
22,
32,
42,
52,
62,
72,
82,
1 1 ,
23,
33,
43,
53,
63,
73,
83,
1 1 ,
1 1
24,
34,
44,
54,
64,
74,
84,
11 ,
11
25,
35,
45,
55,
65,
75,
85,
11 i
26,
36,
46,
56,
66,
76,
86
11 ,
.17,
27,
37,
47,
57,
67,
77,
11 i
18,
27,
38,
48,
58,
68,
78,
11 i
19,
29,
39,
49,
59,
69,
79,
11 i
20,
30,
40,
50,
60,
70,
80,
),MCODE
10 WRITE(IOUERR,310) MESSAG.NAMFLG(MCODE)
310 FORMAT(' + ',1 OX,'Message code (,I4,A8)
GOTO 98
11 WRITE(IOUERR,311) IVALUE,IOBMSG,NAMFLG(MCODE)
311 FORMATC + 1 , 10X,I4,5A4,'flag',A8)
IF(MCODE.EQ.2) WRITE (IOUERR,312)
312 FORMATC ','Prompt/mode type (1 to 4) must be corrected before1,
* ' your next run.')
GOTO 98
16 WRITE(IOUERR,316) RVALUE
316 FORMATC ','Warning: ',G10.3,' speed reduced to 55 m.p.h.',
* ' maximum')
GOTO 99
17 WRITE(IOUERR,317) RVALUE,IOBMSG
317 FORMATC + 1,10X.G10.3,5A4,'VMTMIX (0. to 1.)')
GOTO 98
18 WRITE(IOUERR,318) RVALUE
318 FORMAT('+',10X.G10.3,' sum of VMTMIX is not equal to 1.')
GOTO 98
19 WRITE(IOUERR,319) RVALUE
319 FORMAT('+',10X.G10.3,' negative model year mileage')
GOTO 98
20 WRITE(IOUERR,320) RVALUE
320 FORMATC + ', 10X.G10.3,' negative model year registration')
GOTO 98
21 WRITE(IOUERR,321) RVALUE
321 FORMATC ','Warning: ',G10.3,' registration with zero mileage')
GOTO 99
22 WRITE(IOUERR,322) RVALUE
322 FORMATC ','Warning: '.G10.3,' mileage with zero registration1)
GOTO 99
23 WRITE(IOUERR,323) IVALUE,IOBMSG
323 FORMAT(' + ',1 OX,14,5A4,'e.f. changes (1 to 100 pairs)1)
GOTO 98
24 WRITE(IOUERR,324) IVALUE,IOBMSG
324 FORMAT(' + ',1 OX,14,5A4,'region (1,2,3 only)1)
-------
Page i1
-, 1175 GOTO 98
11176 25 WRITE(IOUERR,325) IVALUE,I03HSG .
11177 325 FORMAT('+',10X,14,5A4,'vehicle.type (l to 8)')
1178 GOTO 98
1179 26 WRITE(IOUERR,326) IVALUE,IOBMSG
1180 326 FORMAT(' + ',1 OX,14,5A4,'pollutant (1 to 3)')
1181 GOTO 98
1182 27 WRITE(IOUERR,327) IVALUE,IOBMSG,IY1941,IY2020
1183 327 FORMAT('+',10X,I4,5A4,'year (',14,' to ',14,')')
1184 GOTO 98
1185 29 WRITE(IOUERR,329)
1186 329 FORMAT(' + ',1 OX,' last year cannot be less than first year')
1187 GOTO 98
11188 30 WRITE(IOUERR,330) RVALUE
11189 330 FORMAT('+',10X,G10.3,' intercept must be positive')
11190 GOTO 98 .
11191 31 WRITE(IOUERR,331) RVALUE
11192 331 FORMAT(' ','Warning: '.G10.3,' negative slope for ageing vehicle')
11193 GOTO 99
11194 . 32 WRITE(IOUERR,327) IVALUE,IOBMSG,IY1960,IY2020
11195 GOTO 98
11196 33 WRITE(IOUERR,333) IVALUE,IOBMSG
11197 333 FORMAT('+',10X,14,5A4,'stringency (10 to 50)')
11198 GOTO 98
11199 34 WRITE(IOUERR,334) IVALUE,IOBMSG
11200 334 FORMAT(' + ',1 OX,14,5A4,'mechanics training (1 to 2)')
11201 GOTO 98
11202 35 WRITE(IOUERR,335) IVALUE,IOBMSG,IY1941,IY2020
11203 335 FORMAT('+',10X,I4,5A4,'MODYR1 (',14,' to ',14,')')
11204 . GOTO 98
11205 36 WRITE(IOUERR,336) IVALUE,IOBMSG,IY1941,IY2020
11206 336 FORMAT(' + ',10X,I4,5A4, 'MODYR2 C/I4,' to ',14,')')
11207 GOTO 98
11208 37 WRITE(IOUERR,337)
11209 337 FORMAT('+',10X,' MODYR1 cannot be greater than MODYR21)
11210 GOTO 98
11211 38 WRITE(IOUERR,327) IVALUE,I03MSG,IY1960,IY2020
11212 GOTO 98
11213 39 WRITE(IOUERR,339) RVALUE. .
11214 339 FORMAT('-i-',-lOX,Gl0.3,' speed must be positive1)
11215 GOTO 98
11216 40 WRITE(IOUERR,340) RVALUE
11217 340 FORMAT('+',10X,G10.3,' .valid temperature.is 0-110 deg. (F)')
11218 GOTO 98
11219 41 WRITE(IOUERR,341) RVALUE,IOBMSG
11220 341 FORMAT('+.',10X,G10.3,5A4,'PCCN (0. to 100.)')
11221 GOTO 98
11222 42 WRITE(IOUERR,342) RVALUE,IOBMSG
11223 . 342 FORMAT('+',10X.G10.3.5A4,'PCHC (0. to 100.)')
11224 GOTO 98
11225 43 WRITE(IOUERR,343) RVALUE,IOBMSG
11226 343 FORMAT('+',10X,G10.3,5A4,'PCCC (0. to 100.)')
11227 GOTO 98
11228 44 WRITE(IOUERR,344) RVALUE,IOBMSG
M229 344 FORMATC + ', 10X.G10.3.5A4, 'AC (0. to 1.)')
11230 GOTO 98
11231 45 WRITE(IOUERR,345) RVALUE,IOBMSG
11232 345 FORMAT C-t-'.l OX, G10.3,5A4, 'extra load (0. to 1.)')
11233 GOTO 98
-------
Page 12
11234 46 WRITE(IOUERR,346) RVALUE,IOBKSG
11235 346 FORMAT('+' ,10X,G10.3,5A4, 'trailers (0. to 1.)').'
1 1236 GOTO 98
11237 47 WRITE(IOUERR,347) RVALUE,IOBMSG
11238 347 FORMAT(' + ',1 OX,G10.3,5A4,'humidity (20. to 140.)')
11239 GOTO 98
11240 48 WRITE(IOUERR,348) NAMVEH(IVALUE)
11241 348 FORMATC + ',10X,' there are no sales for vehicle ',A8)
11242 GOTO 98 . .
11243 49 WRITE(IOUERR,349) RVALUE
11244 349 FORMAT(' ','Warning:'',010.3,' MYR sura not - 1. (will normalize)')
11245 GOTO 99
11246 50 WRITE(IOUERR,350) RVALUE,IOBMSG
11247 350 FORMAT(' + ',1 OX,G10.3,5A4,'tampering rate intercept (up to 1.0)')
11248 GOTO 98
11249 51 WRITE(IOUERR,351) IVALUE.MAXEQU
11250 351 FORMAT('+',10X,'equation1,13,' causes more than1,13,
11251 * ' allowed for any 1 reg/mode/pol.')
11252 GOTO 98
11253 52 WRITE(IOUERR,352) RVALUE
,11254 352 FORMATC '/Warning: ' ,010.3,' speed increased',
11255 * ' to 5 m.p.h. minimum")
11256 GOTO 99
11257 53 WRITE(IOUERR,353)
11258 353 FORMAT('0','You must correct all flags before you run again.')
11259 GOTO 98
11260 54 WRITE(IOUERR,354) RVALUE
11261 354 FORMATC + ', 10X.G10.3,' average trips/day cannot be negative')
11262 GOTO 98
11263 55 WRITE(IOUERR,355) RVALUE
11264 355 FORMAT ('»', 10X.G10.3,' average miles/day cannot be negative')
11265 ' GOTO 98
11266 56 WRITE(IOUERR,356)
11267 356 FORMATC ','Comment: A/C correction factor will be calculated.'
11268 * /' ',T11,'Value of inputted AC usage parameter is ignored.')
11269 GOTO 99
11270 57 WRITE(IOUERR,357)
11271 357 FORMAT('+',10X,'WB temp cannot be greater than DB temp1)
11272 GOTO 98
11273 58 WRITE(IOUERR,358) RVALUE,IOBMSG
11274 358 FORMAT('+',10X.G10.3,5A4,'altitude (-200 to 10,000 ft.)')
11275 GOTO 98
11276 59 WRITE(IOUERR,359) IVALUE,(NEWPAR(lPAR,IVALUE),IPAR-1,3)
11277 359 FORMATC ','Warning: equation1,13,' zeroes all idle coefficients',
11278 * ' (and total) for IR=',I1,', IV-1-,II,1, IP-',I1)
11279 . GOTO 99
11280 60 WRITE(IOUERR,360) RVALUE,INERR,NAMFNC(IVALUE)
11281 360 FORMAT('»', 10X.G10.3,' default used for',IS/ in function',A8)
11282 GOTO 98
11283 61 WRITE(IOUERR,361) INERR.NAMFNC(IVALUE)
11284 361 FORMATC+ ' ,10X,' default used for',15,' in index function',AS)
11285 GOTO 98
11286 62 WRITE(IOUERR,362) IVALUE,IOBMSG
11287 362 FORMAT('',10X, 14,5A4,'new e.f. region (1,2,3 only)')
11288 GOTO 98
11289 63 WRITE(IOUERR,363) RVALUE,IOBMSG
11290 363 FORMAT('+',10X,G10.3,5A4,'(0. <- PCHC+PCCC < 100.)')
11291 GOTO 98
11292 . 64 WRITE(IOUERR,364) RVALUE,IOBMSG
-------
Page 13
11293 364 FORMATC + 1 ,10X.G10.3.5A4, ' (0. <- PCHC+PCCC-PCCN <- 100.)')
11294 GOTO 98
11295 65 WRITE(IOUERR,365) IVALUE
11296 365 FORMAT(' + ',10X,' MYR of LDDV not equal to LDGV for JDX-',I2)
11297 GOTO 98
11298 66 WRITE(IOUERR,366) IVALUE
11299 366 FORMATC + 1 , 10X, ' MYR of LDDT not equal to LDGT1 for JDX-',I2)
1 1300 GOTO 98
11301 67 WRITE(IOUERR,367) KAMVEH(IVALUE)
11302 367 FORMAT('+',10X,' EFFTP>0. and GSF-0. for vehicle ',A8)
11303 . GOTO 98
11304 68 WRITE(IOUERR,368) NAMVEH(lVALUE)
11305 368 FORMAT(' +',10X,' EFFTP<-0. and VKTMIX>0. for vehicle ',A8)
11306 GOTO 98
11307 69 WRITE(IOUERR,369) NAMVEH(IVALUE)
11308 369 FORMATC + ',10X,' EFIDLE>0. and GSF-0. for vehicle ' ,A8)
11309 GOTO 98
11310 70 WRITE(IOUERR,370) NAMVEH(IVALUE)
11311 370 FORMAT('+',10X,' EFIDLE<-0. and VKTMIX>0. for vehicle ' ,A8)
11312 . GOTO 98
11313 71 WRITE(IOUERR,371) IOUREP,IOUERR,IOUASK -
11314 371 FORMATC ','Comment: Current output unit numbers are',
11315 * ' IOUREP-', 11,.' IOUERR-',11, ' IOUASK-',11)
11316 GOTO 99
11317 72 WRITE(IOUERR,372) IVALUE,IOBMSG
11318 372 FORMAT('+',10X,I4,5A4,'I/M vehicle type (1 to 4)')
1319 GOTO 98
1320 73 WRITE(IOUERR,373) IVALUE,IOBMSG
1321 373 FORMAT('+',10X,14,5A4,'short test type flag (1 to 3)')
1322 GOTO 98
1323 74 WRITE(IOUERR,374) IVALUE,IOBMSG
1324 374 FORMAT('+',10X,I4,5A4,'new I/M data flag (1 to 4)')
11325 GOTO 98
11326 75 WRITE(IOUERR,375) IVALUE,IOBMSG
11327 375 FORMAT('*', 10X, 14,5A4,'anti-tampering program start year')
11328 GOTO 98
11329 76 WRITE(IOUERR,376) IVALUE,IOBMSG '
11330 376 FORMATC+',10X,I4.5A4,'anti-tampering program 1st model year')
11331 GOTO 98 ...
11332 77 WRITE(IOUERR,377) IVALUE,IOBMSG
11333 377 FORMAT('+',10X,14,5A4,'anti-tampering program last model year')
11334 GOTO 98
11335 78 WRITE(IOUERR,378) IVALUE,IOBMSG
11336 378 FORMATC + ', 10X.I4.5A4,'anti-tampering vehicle type (1 to 2)')
11337 GOTO 98
11338 79 WRITE(IOUERR,379) RVALUE,IOBMSG
11339 379 FORMAT('*', 10X.G10.3.5A4, 'evap ATP effectiveness rate (0. to 1.)')
11340 GOTO 98
11341 . 80 WRITE(IOUERR,380) RVALUE,IOBMSG
11342 380 FORKAT('+',lOX,Gl0.3,5A4,'exh ATP effectiveness rate (0. to 1.)')
11343 GOTO 98
11344 81 WRITE(IOUERR,381) RVALUE,IOBMSG
11345 381 FORMAT('+',10X,G10.3,5A4,'AER matrix file column sum (0. to 1.)')
11346 ' GOTO 98
11347 82 WRITE(IOUERR,382) IVALUE,IOBMSG
11348 382 FORMAT('+',10X,I4,5A4,'1981+ vehicles cutpoints flag (1 to 3)')
11349 GOTO 98
11350 83 WRITE(IOUERR,383) RVALUE,IOBMSG
11351 C
-------
Page 14
11352 C Use F, not G, format because PARSEC checfc of entered altitude aborts
11353 c scenario if altitude < -200 or > 10000 feet (see QUITER message 58).
11354 C
11355 383 FORMAT('+ ',10X,F6.0,5A4,'altitude (region - 3 -> alt. < 1500.)')
11355.1 GOTO 98
11355.2 84 WRITE(IOUERR,384) IVALUE,IOBMSG
11355.3 384 FORMAT('+',10X,14,5A4,'I/M stringency for classes 1-3 only')
11355.4 GOTO 98 .
11355.5 85 WRITE(IOUERR,385) IVALUE
11355.6 385 FORMAT (' + ',10X.I4,' is inappropriate first MYR for stringency')
11355.7 GOTO 98
11355.8 86 WRITE(IOUERR,386) IVALUE
11355.9 386 FORMAT('+',10X,14,' is inappropriate last MYR for stringency1)
11356 C .
11357 C Messages 60 and 61 produce excessive output if not stopped here.
11358 C
11359 98 IF(MCODE.EQ.1.OR.MCODE.EQ.2.0R.MCODE.EQ.53.0R.MCODE.EQ.60
11360 * .OR.MCODE.EQ.61) STOP
11361 INERR-INERR+1
11362 C
11363 99 RETURN
11364 END
-------
Page 15
40000
40000.09
40000. 18
40000.27
40001
40002
40003
40004
40005
40006
40007
40008
40009
40010
40011
40012
40013
40014
40015
40016 .
40017
40018
40019
40020
40021
40022
40023
40024
40025
40026
40027
40028
40029
A f\f\ ^ f*
40030
40031
40032
40033
40034
40035
40036
40037
40037.5
40038
40039
40040
40041
40042
40043
40044
40045
40046
40047
40048
40049
40050
40051
40052
40053
40054
FUNCTION PCLEFT(MY,ICY,IP,IV)
c
C This Subroutine has been modified to use multiple stringencies
-C
C
C PCLEFT determines the basic emission factor multiplicative adjustment
C ( percentage left of BEF * PCLEFT ) for the effects of an inspection /
C maintanance (I/M) program, after checking whether or not I/M applies to
C factor being computed by the calling function.
C
C Called by BEF.
C
C Input on call:
C
C parameter list: MY, ICY, IP, IV
C common blocks:
C /FLAGS2/ IMFLAG
C /IMCR12/ CRED12
C /IMCR4P/ CRED4P
C /IMPAR1/ ICYIM,ISTRIN,IKTFLG,MODYR1,MODYR2
C /IKPAR2/ ILDT.ITEST.ICUTS
C
C Output on return:
C
C function: PCLEFT
C
C Local array subscripts:
C
C MYGIM(10,3) - MYGIM ( ITECH, IVIM )
C
C Local variable / array dictionary:
C
C Name Type . Description
C AGE 1ST I age of the vehicle at first inspection
C BY I benefit year for technology 1 or 2 vehicle
C IBY I benefit year for technology 4 plus vehicle
the
C IREM I remainder - stringency - greatest multiple of 10 < stringency
C ISTRN I stringency index into technology 1 or 2 credits .array
C ITECH I -emissions control technology as f (model year, vehicle type)
C MYGIM I model year groups for I/M pollution control technologies
C NSTR . I local stringency for MYR/CLASS grouping
C REM R IREM converted to REAL value
C
C Notes:
C
C PCLEFT has been completely rewritten. Credits are now read in and stored
C as type REAL. Technology IV+ modeling is changed. For example, there are
.C 7 technology categories covered (4 thru 10) and IOPTN has been replaced
C IOPTN and ICUTS.
C -
C
INTEGER ALHFLG.ATPFLG
C
COMMON /FLAGS2/ MYMRFG , NEWFLG , IMFLAG, ALHFLG.ATPFLG
COMMON /IMCR12/ CRED12(19,20,5,2,2)
COMMON /IMCR4P/ CRED4P(19,2,7, 3, 3)
COMMON /IMPAR1/ ICYIM, ISTRIN, IMTFLG.MODYR1 ,MODYR2
COMMON /IMPAR2/ ILDT, ITEST, ICUTS, NUDATA.NLIM, IMNAME(20,9)
by
-------
40054.2
40054.5
40055
40056
40057
40058
40059
40060
40061
40062
40063
40064
40065
40066
40067
40068
40069
40070
40071
40072
40073
40074
40075
40076
40077
40078
40079
40080
40081
40082
40083
40084
4C085
40086
40087
40088
40089
40090
40091
40092
40093
40094
40095
40096
40097
40098
40099
40100
' 40101
40102
40103
40104
40105
40106
40107
40108
40109
40110
401 1 1
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
c
C
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
c
Page 16
COMMON /IOUCOM/ IOUAER,IOUIMD,IOUGEN,IOUREP,IOUERR.IOUASK
COMMON /NEWTOO/ NEWSTR(4,100)
INTEGER BY,IBY,AGE1ST,MYGIM(10,3)
ITECH - 4 does not occur for LDGT1/2 -> repeat last year (1983) of previous
my group -> value 4 will never be selected t>y technology search loop.
DATA MYGIM/ . .
ITECH: 1 2 3 4 s 6 7 8 910
LDGV
* 1974, 1979, 1980, 1981, 1982, 1983, 1984, 1986, 1989, 2020,
LDGT1
* 1974, 1980, 1983, 1983, 1984, 1985, 1986, 1987, 1989, 2020,
LDGT2
* 1978, 1980, 1983, 1983, 1984, 1985, 1986, 1987, 1989, 2020/
Initialize PCLEFT to "no reduction" value - 1.0.
PCLEFT -1.0
If factor being calculated by BEF is not covered by I/M, then RETURN.
IF(IMFLAG.EQ.1.OR.IP.EQ.3.0R.IV.GT.3.0R.
* (IV.GT.1.AND.ILDT.EQ.1).OR.
* (IV.EQ.3.AND.ILDT.EQ.2).OR.
* (IV.EQ.2.AND.ILDT.EQ.3).OR.
* ICY.EQ.MY.OR.ICY.LE.ICYIM.OR.
* MY.LT.MODYR1.0R.MY.GT.MODYR2) GOTO 99
Find the benefit year:
BY=ICY-ICYIM
IF(MY.GT.ICYIM) BY-ICY-MY
IF(BY.GT.19) BY-19
Find the age of the vehicle at first inspection.
AGE1ST=1
IF(MY.LT.ICYIM) AGE1ST-ICYIM-MY-M
Determine technology by model year and vehicle type. Note that because
MYGIM(10,IV) = 2020 for IV-1,2,3 - ICY upper bound (see PARSEC), a match in
the technology serch loop has to occur. As with all the my index arrays in
MOBILES, insure in any my changes that 2020 remains a my group upper bound.
DO 10 ITECH-1,10
IF(MY.LE.MYGIM(ITECH,IV)) GOTO 20
10 CONTINUE
Technology 3 does not exist as a separate category in the credits arrays.
The percent reduction for technology 3 - that for technology 2.
20 IF (ITECH.EQ.3) ITECH-2
Select correct I/M credits for TECH 1 & 2.
Interpolate between 10,20,30,40 & 302 stringency.
IF(ITECH.GT.2) GOTO 40
-------
Page 17
4011 1 .05
40 1 1 1 . 1
40111 . 15
40111.2
40111.25
40111 .3
40111.35
40111.4
401 1.45
401 1.5
401 1.55
401 1.6
401 1.65
40111.7
40111.75
4011 1 .8
40111.85
40111.9
40113
40114
40115
40116
40117
40118
40119
40120
40121
40122
40123
40124
40125
40126
40127
40128
40129
40130
40131
40132
40133
40134
40135
40136
40137
40138
40139
40140
40141
40142
40143
40144
40145
40146
40147
40148
40149
40150
40151
40152
40153
40154
40155
C
C
C
C
C
C
C
C
C
C
. C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
.C
C
C
C
C
C
C
C
Determine which stringency to use for this MYR/CLASS grouping
NSTR " 0
DO 21 IM-1.ISTRIN
NMYF - NEWSTR(2,IM)
NMYL - NEWSTR(3,IM)
IF(MY.GE. NMYF. AND.
* MY. LE. NMYL. AND.
* IV.EQ.NEWSTR(1,IM)) NSTR - NEWSTR(4,IM)
21 CONTINUE
Check for missing stringencies
IF(NSTR.LE.O.AND.IP.EQ.l) WRITE (IOUERR, 12 1) MY, IV, NSTR
121 FORMAT (' Warning: I/M stringency for ',14,' class ',11,' - ',12)
IF(NSTR.LT.IO) GOTO 99
22 IREM-NSTR-(NSTR/10)*10
REM-IREM*. 1
I STRN- (NSTR- IREM) / 1 0
Without mechanic training
IF(IMTFLG.EQ.2) GOTO 30
PCRED-CRED 1 2 (BY , AGE 1 ST , ISTRN , ITECH , IP)
IF (ISTRN . LT . 5 . AND . IREM . GT . 0) PCRED-
* (CRED 1 2 (BY , AGE 1 ST , ISTRN+ 1 , ITECH , IP) -PCRED) *REM+PCRED
GOTO 50
With mechanic training
30 PCRED-CRED 1 2 (20-BY, 21 -AGE 1ST, ISTRN, ITECH, IP)
IF(ISTRN.LT.5.AND.IREM.GT.O) PCRED-
* (CRED 1 2 (20-BY , 2 1 -AGE 1 ST , ISTRN+ 1 , ITECH , IP) -PCRED) *REM+PCRED
GOTO 50
Select I/M credits for TECH 4-10 vehicles.
ITEST - 1 idle test
2 2500 rpm idle test
. 3 loaded test
ICUTS - 1 0.52 ICO./ 100 ppm IHC
2 1.2% ICO / 220 ppm IHC
3 3.02 ICO / 300 ppm IHC
IP-i (HC emissions)
IP-2 (CO emissions)
40 IBY - BY + AGE 1ST - 1
PCRED-CRED4P (IBY , IP , ITECH-3 , ICUTS , ITEST)
Set I/M benefit.
50 PCLEFT -1.0- PCRED
99 RETURN
END
-------
Page 18
62000
62000.3
62000.6
62001
62002
62003
62004
62005
62006
62007
62008
62009
62010
62011
62012
62013
62014
62015
62016
62017
62018
62019
62020
62021
62022
62023
C*5 rt"} A
62024
62025
62026
62027
62028
62029
62030
62031
62032
62033
62034
62035
62036
62037
62038
62039
62040
62041
62042
62043
62044
62044.5
62045
62046
62047
62048
62049
62050
62051
62052
62053
62054
62055
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
SUBROUTINE OUTIMP
This Subroutine has been modified to use multiple stringencies
OUTIMP prints the I/M program parameters and the alternate I/M credits
set name, if it was entered.
Called by OUTHD3 and OUTHD4.
Input on call:
common blocfcs:
/IMPAR1/ ICYIM,ISTRIN,IMTFLG,MODYR1,MODYR2
/ IMPAR2/ ILDT , ITEST , ICUTS , NLIM , IMNAKE
/IOUCOM/ IOUREP
/STRING/ NOYES, COMMA
Local array subscripts:
CUTCO(3) - CUTCO ( ICUTS )
CUTHC (3) ~ CUTHC ( ICUTS )
TTYPE (4, 3) - TTYPE ( ICH, ITEST )
Local variable / array dictionary:
Name Type Description
CUTCO R labels for testing cuts for CO, in percents
CUTHC R labels for testing cuts for HC, in ppm IHC
ICO I ICO label
LDGT I LDGT label
LDGV I LDGV label
ONE R number 1 as character
PPKIHC R*8 ppm IHC label
SLASH R character '/'
TTYPE R test type description
TWO R number 2 as character
Notes:
Output formats were updated to reflect new I/M methodology, including
replacing IOPTN with ITEST and ICUTS.
COMMON /IMPAR1/ ICYIM, ISTRIN, IMTFLG.MODYR1 ,MODYR2
. COMMON /IMPAR2/ ILDT, ITEST, ICUTS, NUDATA, NLIM, IMNAME (20, 9)
COMMON /IOUCOM/ IOUAER, IOUIMD, IOUGEN, IOUREP, IOUERR, IOUASK
COMMON /NEWTOO/ NEWSTR (4 , 1 00)
COMMON /STRING/ NOYES (2) .COMMA, PERIOD
DIMENSION TTYPE(4,3) ,CUTCO(3) ,CUTHC(3)
REAL*8 PPMIHC
DATA LDGV, LDGT, ONE, TWO /' LDGV1, 'LDGT' , 'l ','2 '/
DATA TTYPE/ ' Idle ' , ' ' , ' ' , ' ' ,
2 '2500',' rpm1,1 / I', 'die ',
3 'Load'.'ed /',' Idl'.'e '/
DATA CUTCO/ ' 0. 5% ' , ' 1 . 2X ' , ' 3 . 0'i ' / , ICO/ ' ICO ' /
DATA SLASH/' / '/
-------
Page 19
62056
62057
62058
62059
62060
62061
62062
62063
62054
62065
62066
62067
62068
62069
62070
62071
62072
62073
62074
62075 .
62076
62076. 1
62076.2
62076.3
62076.4
62076.5
62076.6
62076.7
62076.8
62076.9
62077
62078
62079
62080
62081
62082
62083
62084
62085
62086
62087
DATA CUTHC/1 100',' 220',' 300' /.PPMIHC/' ppm IHC'/
C
WRITE (IOUREP, 200) ICYIM, ISTRIN.NOYES(lMTFLG) .MODYR1 .MODYR2
200 FORMATCo1 , 'I/M program selected:'/
* '0',' Start year (January 1): ',I4/
* ' ',' Number of input stringencies: ',I2,/
* ' ',' Mechanic training program?: ",A4/
* ' ',' First model year covered: ',I4/
* ' ',' Last model year covered: .',14)
C ;
IF (ILDT. EQ. 1) WRITE (IOUREP, 2 10) LDGV
IF(ILDT.EQ.2)WRITE(IOUREP,210) LDGV , COMMA , LDGT , ONE
IF(ILDT.EQ.3)WRITE(IOUREP,210) LDGV , COMMA , LDGT , TWO
IF (ILDT. EQ. 4) WRITE (IOUREP, 2 10) LDGV , COMMA , LDGT , ONE , COMMA , LDGT , TWO
210 FORMAT (' ',' Vehicle types covered: ',
* A4,A2,A4,A1,A2,A4,A1)
C
WRITE (IOUREP, 220) (TTYPE(lCH, ITEST) , ICH-1 ,4) ,
* CUTCO(ICUTS) , ICO, SLASH, CUTHC(ICUTS) , PPMIHC
220 FORMATC ',' 1981 & later MYR test type: ' ,4A4/
* ' ',' 1981 & later MYR test cutpoints: ' ,2A4,A2,A4,A8)
C
C Output of stringencies input
C
WRITE (IOUREP, 230)
DO 21 IM-1.ISTRIN
WRITE (IOUREP, 221) (NEWSTR(J, IM) , J-1 ,4)
221 FORMATC Vehicle Class ',11,' - Model Years ',14,' through ',
*I4,' use ',12, "i Stringency')
21 CONTINUE
C
IF(NLIM.EQ.O) GOTO 99
WRITE (IOUREP, 2 30).
230 FORMATC ')
DO 10 LINES- 1.NLIM
WRITE (IOUREP, 2 40) (IMNAME(N, LINES) ,N-1 ,20)
240 FORMATC ' ,20A4)
10 CONTINUE
C
99 RETURN
END
------- |