SUBROUTINE U910(KFILDI,KFILDO,ICALL,CCALL,
1 ISDATA,SDATA,NGP,XDATA,MWORK,NAME,ND1,ND2,
2 ID,IDPARS,TRESHL,TRESHU,JD,JP,
3 ITAU,IWDTH,WDTH,IPREC,PREC,CFMT,NCAT,
4 ISCALD,PRINT,HEAD,IPLAIN,PLAIN,L3264B,L3264W,ND4,
5 AA,ICALLD,CCALLD,IPACK,DATA,IWORK,ND5,
6 IS0,IS1,IS2,IS4,ND7,
7 IDATE,NWORK,ND8,
8 LSTORE,ND9,
9 CORE,ND10,NBLOCK)
C$$$ SUBPROGRAM DOCUMENTATION BLOCK ***
C
C SUBPROGRAM: U910
C PRGMMR: GLAHN ORG: W/OSD211 DATE: 98-07-01
C
C ABSTRACT: PROGRAM U910 IS USED TO READ DATA FROM A MOS-2000
C EXTERNAL RANDOM ACCESS FILE, PERFORM COMPUTATIONS, AND
C WRITE THE RESULTS BACK TO THAT SAME FILE, AS WELL
C AS TO A SEQUENTIAL. DATA CAN BE PRINTED. THE PRINTING
C FORMAT IS GOVERNED BY USER INPUT; THE WRITING PRECISION
C IS THE SAME AS INPUT. THIS PROGRAM SHOULD
C RUN ON EITHER THE HP UNIX PLATFORM WHICH USES 32-BIT
C INTEGERS OR THE CRAY UNIX PLATFORM WHICH USES 64-BIT
C INTEGERS. THE ONLY DIFFERENCE IS THAT THE DRIVER
C DRU910 IS COMPILED WITH THE PARAMETER STATEMENT:
C PARAMETER (L3264B=32) FOR THE 32-BIT MACHINE AND
C PARAMETER (L3264B=64) FOR THE 64-BIT MACHINE.
C
C PROGRAM HISTORY LOG:
C 00-05-04 GLAHN
C 00-05-15 ERICKSON ADDED NCEP DOCBLOCK.
C 00-07-03 MCE/JPD/DR ADDED AA TO CALL OF U910;
C CHANGED CK ON NPRINT (AROUND 200);
C ADDED LOGIC TO WRITE PROBABILITY
C FORECASTS FOR MULTIPLE CATEGORIES
C TO THE RANDOM ACCESS FILE.
C 12-09-24 ENGLE ADDED CALL TO WRTDLMC TO WRITE STATION
C CALL LETTERS TO RANDOMA ACCESS FILE.
C 12-11-06 GHIRARDELLI MERGED IN SMALL DIFFERENCES FROM LAMP
C VERSION.
C
C USAGE: CALL U910(KFILDI,KFILDO,ICALL,CCALL,ISDATA,SDATA,NGP,
C XDATA,MWORK,NAME,ND1,ND2,ID,IDPARS,TRESHL,
C TRESHU,JD,JP,ITAU,IWDTH,WDTH,IPREC,PREC,CFMT,
C NCAT,ISCALD,PRINT,HEAD,IPLAIN,PLAIN,L3264B,L3264W,
C ND4,ICALLD,CCALLD,IPACK,DATA,IWORK,ND5,IS0,IS1,
C IS2,IS4,ND7,IDATE,NWORK,ND8,LSTORE,ND9,CORE,
C ND10,NBLOCK)
C INPUT ARGUMENT LIST:
C KFILDI - UNIT NUMBER TO READ INPUT FILE 'U910.CN'.
C SET BY DATA STATEMENT TO 5 IN DRU910.
C KFILDO - UNIT NUMBER OF OUTPUT (PRINT) FILE. THIS IS SET
C BY DATA STATEMENT TO 12 IN DRU910. LATER, IN IPOPEN,
C IF IP(1) NE 0, KFILDO IS SET = IP(1). THIS ALLOWS
C CHANGING THE "DEFAULT" PRINT FILE ON THE FLY.
C OTHERWISE, ON SOME SYSTEMS, THE OUTPUT FILE MIGHT
C HAVE THE SAME NAME AND BE OVERWRITTEN. WHEN THE
C OUTPUT FILE IS NOT THE ORIGINAL DEFAULT, THE NAME
C IS GENERATED AND CAN BE DIFFERENT FOR EACH RUN.
C THIS ALLOWS SAVING EACH OUTPUT AND NOT HAVING IT
C OVERWRITTEN.
C ICALL(L,K,J) - CALL LETTERS, EQUIVALENCED TO CCALL( , )
C (L=1,2) (K=1,ND1) (J=1,6).
C CCALL(K,J) - 8-CHARACTER STATION CALL LETTERS (OR GRIDPOINT
C LOCATIONS FOR GRID DEVELOPMENT) TO PROVIDE
C OUTPUT FOR (J=1) AND 5 POSSIBLE OTHER STATION
C CALL LETTERS (J=2,6) THAT CAN BE USED INSTEAD
C IF THE PRIMARY (J=1) STATION CANNOT BE FOUND
C IN AN INPUT DIRECTORY (K=1,NSTA). ALL STATION
C DATA ARE KEYED TO THIS LIST. (CHARACTER*8)
C ISDATA(K) - WORK ARRAY (K=1,NSTA).
C SDATA(K) - WORK ARRAY (K=1,NSTA). USED AS STALAT( ) IN INT910.
C NGP(J) - THE NUMBER OF STATIONS IN EACH GROUP (J=1,KGP).
C XDATA(K,L) - THE ARRAY USED TO HOLD DATA FOR OUTPUT (K=1,NSTA)
C (L=1,ND2). USED AS STALON( ) IN INT910.
C MWORK(J) - WORK ARRAY (J=1,ND1).
C NAME(K) - NAMES OF STATIONS (K=1,NSTA). (CHARACTER*20)
C ND1 - MAXIMUM NUMBER OF STATIONS THAT CAN BE DEALT WITH.
C STORAGE SPACE IS HIGHLY DEPENDENT ON ND1.
C ND2 - MAXIMUM NUMBER OF VARIABLES TO BE DEALT WITH
C IN A SERIES. THIS IS MAINLY FOR A GROUP OF
C PROBABILITY FORECASTS.
C ID(J,N) - THE INTEGER VARIABLE ID'S (J=1,4) (N=1,NVRBL).
C IDPARS(J,N) - THE PARSED, INDIVIDUAL COMPONENTS OF THE VARIABLE
C ID'S CORRESPONDING TO ID( ,N) (J=1,15), (N=1,NVRBL).
C (OUTPUT)
C J=1--CCC (CLASS OF VARIABLE),
C J=2--FFF (SUBCLASS OF VARIABLE),
C J=3--B (BINARY INDICATOR),
C 0 = NOT BINARY,
C 1 = CUMULATIVE FROM ABOVE, VALUES GE LOWER THRESHOLD
C TRESHL = 1,
C 2 = CUMULATIVE FROM BELOW, VALUES LT UPPER THRESHOLD
C TRESHU = 1.
C 3 = DISCRETE BINARY. VALUES GE LOWER THRESHOLD AND
C LT UPPER THRESHOLD = 1.
C 5 = GRID BINARY. VALUES GE LOWER THRESHOLD
C ONLY THE VALUE OF 0, 1, OR 5 SHOULD BE USED FOR
C PREDICTORS;
C 0, 1, 2, OR 3 CAN BE USED FOR PREDICTANDS.
C J=4--DD (DATA SOURCE, MODEL NUMBER),
C J=5--V (VERTICAL APPLICATION),
C J=6--LBLBLBLB (BOTTOM OF LAYER, 0 IF ONLY 1 LAYER),
C J=7--LTLTLTLT (TOP OF LAYER),
C J=8--T (TRANSFORMATION),
C J=9--RR (RUN TIME OFFSET, ALWAYS + AND BACK IN TIME),
C J=10--OT (TIME APPLICATION),
C J=11--OH (TIME PERIOD IN HOURS),
C J=12--TAU (PROJECTION IN HOURS),
C J=13--I (INTERPOLATION TYPE),
C J=14--S (SMOOTHING INDICATOR), AND
C J=15--G (GRID INDICATOR).
C TRESHL(N) - THE LOWER BINARY THRESHOLD CORRESPONDING TO IDPARS( ,N)
C (N=1,ND4).
C TRESHU(N) - THE UPPER BINARY THRESHOLD CORRESPONDING TO IDPARS( ,N)
C (N=1,ND4).
C JD(J,N) - THE BASIC INTEGER VARIABLE ID'S (J=1,4) (N=1,ND4).
C THIS IS THE SAME AS ID(J,N), EXCEPT THAT THE FOLLOWING
C PORTIONS ARE OMITTED:
C B = IDPARS(3, ),
C G = IDPARS(15, ), AND
C TRESHL( ).
C JD( , ) IS USED TO IDENTIFY WHICH CALCULATIONS
C CAN BE MADE DIRECTLY IN U910, WHICH IS ONLY FORMING
C BINARIES. THE "G" VARIABLE HAS NO MEANING IN U910,
C IT BEING ONLY FOR POSSIBLE USE IN U201.
C JP(J,N) - CONTROLS THE OUTPUT BY VARIABLE (N=1,ND4).
C J=1--INDICATES WHETHER (>0) OR NOT (=0) VARIABLE N
C WILL BE WRITTEN TO THE BINARY OUTPUT FILE
C WHEN KFILIO NE 0;
C J=2--INDICATES WHETHER (>0) OR NOT (=0) VARIABLE N
C WILL BE WRITTEN TO UNIT IP(16) WITH THE FORMAT
C PROVIDED WITH THE VARIABLE; AND
C J=3--INDICATES WHETHER (>0) OR NOT (=0) VARIABLE N
C WILL BE WRITTEN TO UNIT IP(15) NOT UNDER
C CONTROL OF THE FORMAT PROVIDED BUT TO THE
C RESOLUTION PACKED.
C ITAU(N) - THE NUMBER OF HOURS TO ADD TO NDATE TO GET
C THE VARIABLE N (N=1,ND4). THIS IS THE
C "LOOKAHEAD" FEATURE.
C IWDTH(N) - WIDTH OF FIELD FOR PRINTING (N=1,ND4).
C WDTH(N) - WIDTH OF FIELD FOR PRINTING (N=1,ND4). COMPUTED
C AND USED ONLY IN PRU660. (CHARACTER*2)
C IPREC(N) - PRECISION FOR PRINTING (N=1,ND4). THIS IS THE
C NUMBER OF PLACES AFTER THE DECIMAL POINT.
C PREC(N) - CHARACTER REPRESENTATION OF IPREC(J) (N=1,ND4).
C COMPUTED AND USED ONLY IN PRU660. (CHARACTER*1)
C CFMT(N) - FORMAT FOR PRINTING, EITHER I OR F (N=1,ND4).
C NCAT(N) - A CATEGORY NUMBER FOR EACH VARIABLE (N=1,ND4).
C 0 = THIS VARIABLE IS IN A SERIES, NOT THE FIRST.
C M = THIS VARIABLE IS THE FIRST OF A SERIES OF
C M VARIABLES.
C ISCALD(N) - THE DECIMAL SCALING CONSTANT TO USE WHEN PACKING THE
C COLLATED DATA (N=1,ND4). ISCALD COMES FROM THE
C VARIABLE CONSTANT FILE, MODIFIED TO BE 2 FOR GRID
C BINARIES, AND 0 FOR BINARIES. ZERO WHEN NOT FOUND
C IN THE FILE. NO BINARY SCALING IS PROVIDED FOR.
C PRINT(N) - FURNISHED TO PRU660 FOR PRINTING (N=1,ND4).
C HEAD(J,N) - HEADING FOR COLUMNS WHEN PRINTING DATA (J=1,30)
C (N=1,ND4). (CHARACTER*1)
C AA(L,K) = THE ARRAY TO HOLD DATA FOR PRINTING WITH PRU660
C (L=1,ND2) (K=1,NSTA)
C IPLAIN(L,J,N) - 32 CHARACTERS (L=1,L3264W) (J=1,4) OF PLAIN
C LANGUAGE DESCRIPTION OF VARIABLES (N=1,ND4).
C NOTE THAT THIS REQUIRES TWO 32-BIT WORDS TO HOLD
C THE DESCRIPTION BUT ONLY ONE 64-BIT WORD.
C EQUIVALENCED TO PLAIN( ).
C PLAIN(N) - THE PLAIN LANGUAGE DESCRIPTION OF THE VARIABLES
C (N=1,ND4). EQUIVALENCED TO IPLAIN( , , ).
C (CHARACTER*32)
C L3264B - INTEGER WORD LENGTH IN BITS OF MACHINE BEING USED
C (EITHER 32 OR 64). SET BY PARAMETER IN DRU910.
C L3264W - NUMBER OF WORDS IN 64 BITS (EITHER 1 OR 2).
C CALCULATED BY PARAMETER, BASED ON L3464B.
C ND4 - MAXIMUM NUMBER OF VARIABLES THAT CAN BE DEALT WITH
C IN ONE RUN.
C ICALLD(L,K) - 8 STATION CALL LETTERS AS CHARACTERS IN AN INTEGER
C VARIABLE (L=1,L3264W) (K=1,ND5).
C NOTE THAT THIS REQUIRES TWO 32-BIT WORDS TO HOLD
C THE DESCRIPTION BUT ONLY ONE 64-BIT WORD.
C NEEDED IN CONST6 FOR ARGUMENT TO RDTDLM.
C EQUIVALENCED TO CCALLD( ).
C CCALLD(K) - 8 STATION CALL LETTERS (K=1,ND5). THIS LIST IS
C USED IN RDSTAD TO RETAIN THE ORIGINAL LIST IN
C CCALL( , ).
C IPACK(J) - PACKED DATA READ FROM THE INPUT FILE(S)
C (J=1,ND5).
C DATA(J) - WORK ARRAY (J=1,ND5).
C IWORK(J) - WORK ARRAY (J=1,ND5). USED AS IWBAN( ) IN
C INT910.
C ND5 - THE MAXIMUM NUMBER OF STATION CALL LETTERS ON
C THE INPUT FILES. DIMENSION OF IWORK( ),
C DATA( ), AND IPACK( ) AND SECOND DIMENSION OF
C ICALLD( , ).
C MUST BE GE THE LARGEST RECORD ON THE INPUT
C VECTOR FILE(S). MUST ALSO BE GE ND1.
C IT IS A SEPARATE DIMENSION FROM ND1, SO THAT
C ONLY THOSE ARRAYS REQUIRING INPUT FROM INPUT
C FILES ARE THIS LARGE.
C IS0(J) - MOS-2000 GRIB SECTION 0 ID'S (J=1,4).
C IS1(J) - MOS-2000 GRIB SECTION 1 ID'S (J=1,21+).
C IS2(J) - MOS-2000 GRIB SECTION 2 ID'S (J=1,12).
C IS4(J) - MOS-2000 GRIB SECTION 4 ID'S (J=1,4).
C ND7 - DIMENSION OF IS0( ), IS1( ), IS2( ), AND IS4( ).
C NOT ALL LOCATIONS ARE USED. MAXIMUM SIZE IS FOR
C IS1( ) = 22 PLUS 32 CHARACTERS (ONE CHARACTER PER
C WORD) OF PLAIN TEXT = 54.
C IDATE(J) - INITIAL DATE LIST (J=1,NDATES) WHICH MAY CONTAIN
C NEGATIVE VALUES INDICATING A DATE SPAN.
C THIS IS MODIFIED IN DATPRO TO CONTAIN THE COMPLETE
C DATE LIST WITH THE DATES IN THE SPANS FILLED IN
C (J=1,NDATES), WHERE NDATES HAS BEEN INCREASED
C IF NECESSARY. DATES ARE INPUT AS YYMMDDHH AND
C MODIFIED TO YYYYMMDDHH. ZEROS IN THE INPUT ARE
C ELIMINATED. TERMINATOR IS 99999999. MAXIMUM
C NUMBER OF DATES IS ND8.
C NWORK(J) - WORK ARRAY (J=1,ND8).
C ND8 - MAXIMUM NUMBER OF DATES THAT CAN BE DEALT WITH.
C LSTORE(L,J) - THE ARRAY HOLDING INFORMATION ABOUT THE DATA
C STORED IN THE MOS-2000 STORAGE SYSTEM
C (L=1,12) (J=1,LITEMS).
C L=1,4--THE 4 ID'S FOR THE DATA.
C L=5 --LOCATION OF STORED DATA. WHEN IN CORE,
C THIS IS THE LOCATION IN CORE( ) WHERE
C THE DATA START. WHEN ON DISK,
C THIS IS MINUS THE RECORD NUMBER WHERE
C THE DATA START.
C L=6 --THE NUMBER OF 4-BYTE WORDS STORED.
C L=7 --2 FOR DATA PACKED IN TDL GRIB, 1 FOR NOT.
C L=8 --THE DATE/TIME OF THE DATA IN FORMAT
C YYYYMMDDHH.
C L=9 --NUMBER OF TIMES DATA HAVE BEEN RETRIEVED.
C L=10 --NOT USED.
C L=11 --THE NUMBER OF THE FIRST PREDICTOR IN THE SORTED
C LIST IN ID( ,N) (N=1,VRBL) FOR WHICH THIS
C VARIABLE IS NEEDED, WHEN IT DOES NOT NEED
C TO BE STORED AFTER DAY 1. WHEN THE VARIABLE
C MUST BE STORED (TO BE ACCESSED THROUGH OPTION)
C FOR ALL DAYS, ID(11,N) IS 7777 + THE NUMBER
C OF THE FIRST PREDICTOR IN THE SORTED LIST
C FOR WHICH THIS VARIABLE IS NEEDED.
C L=12 --MOT USED.
C ND9 - MAXIMUM NUMBER OF FIELDS STORED IN LSTORE( , ).
C SECOND DIMENSION OF LSTORE( , ).
C CORE(J) - SPACE ALLOCATED FOR SAVING PACKED DATA
C (J=1,ND10). WHEN THIS SPACE IS EXHAUSTED,
C SCRATCH DISK WILL BE USED.
C ND10 - THE MEMORY IN WORDS ALLOCATED TO THE SAVING OF
C PACKED DATA IN CORE( ). WHEN THIS
C SPACE IS EXHAUSTED, SCRATCH DISK WILL BE USED.
C NBLOCK - BLOCK SIZE IN WORDS OF INTERNAL MOS-2000 DISK STORAGE.
C SINCE MUCH, IF NOT ALL, INTERNAL STORAGE WILL BE OF
C PACKED DATA, THE NUMBER OF BYTES WILL BE THE SAME FOR
C EITHER A 32- OR 64-BIT MACHINE. THEREFORE, THE BLOCK
C SIZE IS SET BY PARAMETER TO VARY WITH L3264B. IN THE
C PARAMETER STATEMENT, THE 6400 IS ARBITRARY, AND CAN BE
C CHANGED. PERFORMANCE SHOULD NOT BE HIGHLY DEPENDENT
C ON THIS. HOWEVER, IF TOO LARGE, SPACE WILL BE WASTED,
C AND IF TOO SMALL MANY RECORDS WILL BE NECESSARY TO
C HOLD EACH RECORD. THE 6400 ACCOMMODATES 800 BYTES
C ON EITHER A 32- OR 64-BIT MACHINE. SET BY PARAMETER
C IN DRU910.
C
C OUTPUT ARGUMENT LIST: NONE. ALL INPUT TO OTHER SUBROUTINES.
C
C DATA SET USE
C INPUT FILES:
C FORT.KFILDI - UNIT NUMBER OF INPUT FILE. SET BY DATA
C STATEMENT IN DRU910. (INPUT)
C FORT.KFIL10 - UNIT NUMBER OF TDL MOS-2000 INTERNAL FILE
C SYSTEM ACCESS. SET BY DATA STATEMENT.
C (INPUT-OUTPUT)
C FORT.KFILD(J) - UNIT NUMBERS FOR WHERE THE STATION LIST (J=1)
C AND THE STATION DIRECTORY (J=2) RESIDES.
C (INPUT)
C FORT.KFILDT - UNIT NUMBER FOR READING THE DATE LIST.
C (INPUT)
C FORT.KFILP - UNIT NUMBER FOR READING THE VARIABLE LIST.
C (INPUT)
C FORT.KFILCP - UNIT NUMBER FOR VARIABLE CONSTANT FILE.
C (INPUT)
C FORT.KFILRA(J) - UNIT NUMBERS FOR EXTERNAL RANDOM ACCESS FILES
C (J=1,5). (INPUT/OUTPUT)
C
C OUTPUT FILES:
C FORT.KFILDO - UNIT NUMBER OF OUTPUT (PRINT) FILE. SET BY
C DATA STATEMENT IN DRU910. (OUTPUT)
C FORT.KFIL10 - UNIT NUMBER OF TDL MOS-2000 INTERNAL FILE
C SYSTEM ACCESS. SET BY DATA STATEMENT.
C (INPUT-OUTPUT)
C FORT.KFILIO - UNIT NUMBER OF SEQUENTIAL OUTPUT TDLPACK FILE.
C (OUTPUT)
C FORT.IP(J) - UNIT NUMBERS FOR OPTIONAL OUTPUT (J=1,25)
C (SEE IP( ) UNDER "VARIABLES" BELOW.) (OUTPUT)
C FORT.KFILRA(J) - UNIT NUMBERS FOR EXTERNAL RANDOM ACCESS FILES
C (J=1,5). (INPUT/OUTPUT)
C
C VARIABLES
C KFIL10 - UNIT NUMBER OF TDL MOS-2000 FILE SYSTEM ACCESS.
C SET BY DATA STATEMENT.
C KFILIO - UNIT NUMBER OF SEQUENTIAL OUTPUT TDLPACK FILE.
C (INPUT)
C IPINIT - 4 CHARACTERS USED TO HELP IDENTIFY OUTPUT ASSOCIATED
C WITH THE IP( ) NUMBERS. (CHARACTER*4)
C IP(J) - EACH VALUE (J=1,25) INDICATES WHETHER (>1)
C OR NOT (=0) CERTAIN INFORMATION WILL BE WRITTEN.
C WHEN IP( ) > 0, THE VALUE INDICATES THE UNIT
C NUMBER FOR OUTPUT. THESE VALUES SHOULD NOT BE THE
C SAME AS ANY KFILX VALUES EXCEPT POSSIBLY
C KFILDO, WHICH IS THE DEFAULT OUTPUT FILE. THIS IS
C ASCII OUTPUT, GENERALLY FOR DIAGNOSTIC PURPOSES.
C THE FILE NAMES WILL BE 4 CHARACTERS 'U910',
C THEN 4 CHARACTERS FROM IPINIT, THEN 2 CHARACTERS
C FROM IP(J) (E.G., 'U910HRG130'). THE ARRAY IS
C INITIALIZED TO ZERO IN CASE LESS THAN THE EXPECTED
C NUMBER OF VALUES ARE READ IN. EACH OUTPUT ASCII
C FILE WILL BE TIME STAMPED. NOTE THAT THE TIME
C ON EACH FILE SHOULD BE VERY NEARLY THE SAME, BUT
C COULD VARY BY A FRACTION OF A SECOND. IT IS
C INTENDED THAT ALL ERRORS BE INDICATED ON THE
C DEFAULT, SOMETIMES IN ADDITION TO BEING INDICATED
C ON A FILE WITH A SPECIFIC IP( ) NUMBER, SO THAT
C THE USER WILL NOT MISS AN ERROR.
C (1) = ALL ERRORS AND OTHER INFORMATION NOT
C SPECIFICALLY IDENTIFIED WITH OTHER IP( )
C NUMBERS. WHEN IP(1) IS READ AS NONZERO,
C KFILDO, THE DEFAULT OUTPUT FILE UNIT NUMBER,
C WILL BE SET TO IP(1). WHEN IP(1) IS READ
C AS ZERO, KFILDO WILL BE USED UNCHANGED.
C (2) = THE INPUT DATES IN IDATE( ). WHEN THERE
C ARE ERRORS, PRINT WILL BE TO UNIT KFILDO AS
C WELL AS TO UNIT IP(2).
C (3) = THE OUTPUT DATES IN IDATE( ). WHEN THERE
C ARE ERRORS, OUTPUT WILL BE TO UNIT KFILDO AS
C WELL AS TO UNIT IP(3).
C (4) = THE INPUT STATION LIST (CALL LETTERS ONLY).
C IF THERE ARE INPUT ERRORS, THE STATION LIST
C WILL BE WRITTEN TO THE DEFAULT OUTPUT FILE UNIT
C KFILDO AS WELL AS TO UNIT IP(4).
C (5) = THE STATIONS AND STATION DIRECTORY INFORMATION
C IN THE ORDER TO BE DEALT WITH IN U910. THE
C STATIONS WILL BE IN ALPHABETICAL ORDER WITHIN
C EACH GROUP PROVIDED THE DIRECTORY IS. IF THERE
C ARE INPUT ERRORS, THE STATION LIST WILL BE
C WRITTEN TO THE DEFAULT OUTPUT FILE UNIT KFILDO
C AS WELL AS TO UNIT IP(5).
C (6) = THE VARIABLE IDS AS THEY ARE BEING READ IN.
C THIS IS GOOD FOR CHECKOUT; FOR ROUTINE
C OPERATION, IP(7), IP(8), AND/OR IP(9),
C MAY BE BETTER.
C (7) = THE VARIABLE LIST IN SUMMARY FORM.
C IF THERE ARE ERRORS, THE VARIABLE LIST WILL
C BE WRITTEN TO THE DEFAULT OUTPUT FILE
C UNIT KFILDO AS WELL AS TO UNIT IP(7).
C THIS LIST INCLUDES THE PARSED ID'S IN IDPARS( , ).
C (8) = THE VARIABLE LIST IN SUMMARY FORM.
C THIS LIST INCLUDES THE PARSED ID'S IN
C IDPARS( , ).
C (9) = THE VARIABLE LIST IN SUMMARY FORM.
C THIS DIFFERS FROM (8) IN THAT (9) DOES NOT
C INCLUDE THE PARSED ID'S IN IDPARS( , ),
C BUT RATHER INCLUDES THE INFORMATION TAKEN
C FROM THE PREDICTOR CONSTANT FILE.
C (10) = NOT USED.
C (11) = NOT USED
C (12) = INDICATES WHETHER (>1) OR NOT (=0) THE LIST OF
C STATIONS ON THE INPUT FILES WILL BE PRINTED TO
C THE FILE WHOSE UNIT NUMBER IS IP(12).
C (13) = NOT USED.
C (14) = NOT USED.
C (15) = INDICATES WHETHER (>0) OR NOT (=0) THE DATA
C WILL BE WRITTEN TO UNIT IP(15) WHEN JP(3, ) >0.
C THIS PRINT IS LIKE THAT PROVIDED BY U201, AND
C IS SEPARATE FROM THE OPTIONAL LISTING PROVIDED
C UNDER CONTROL OF JP(2, ) WITH THE FORMAT
C PROVIDED.
C (16) = INDICATES WHETHER (>0) OR NOT (=0) THE DATA
C WILL BE WRITTEN TO UNIT IP(16) WHEN JP(2, ) >0.
C THIS PRINT IS UNDER CONTROL OF THE FORMAT
C PROVIDED WITH EACH VARIABLE.
C JSTOP - THE NUMBER OF ERRORS THAT WILL BE TOLERATED ON THE
C TOTAL RUN BEFORE PROGRAM STOPS.
C NREPLA - RECORD REPLACEMENT FLAG FOR WRITING RANDOM
C ACCESS FILE.
C 0 = NOT REPLACING RECORD.
C 1 = REPLACING, ERROR IF RECORD NOT FOUND TO
C REPLACE.
C 2 = REPLACING, WRITE NEW RECORD IF RECORD NOT
C FOUND TO REPLACE.
C NCHECK - IDENTIFICATION CHECKING FLAG FOR WRITING
C RANDOM ACCESS FILE.
C 0 = DON'T CHECK FOR DUPLICATES.
C 1 = CHECK FOR DUPLICATES, ERROR IF FOUND.
C NPRINT - THE NUMBER OF CYCLES OF DATA TO PRINT UNDER
C JP(2, ) CONTROL.
C NDATES - THE NUMBER OF DATES IN IDATE( ).
C KFILRA(J) - HOLDS THE UNIT NUMBERS FOR ACCESSING THE MOS-2000
C EXTERNAL RANDOM ACCESS FILES (J=1,5).
C RACESS(J) - FILE NAMES OF THE MOS-2000 EXTERNAL RANDOM ACCESS
C FILES CORRESPONDING TO KFILRA(J) (J=1,5).
C (CHARACTER*60)
C NUMRA - THE NUMBER OF VALUES IN KFILRA( ) AND RACESS( ).
C KFILX - THE UNIT NUMBER FOR THE OUTPUT RANDOM ACCESS
C FILE. (OUTPUT)
C CFILX - THE FILE NAME OF THE OUTPUT RANDOM ACCESS
C FILE CORRESPONDING TO KFILX. (CHARACTER*60)
C (OUTPUT)
C OUTNAM - NAME OF DATA SET FOR PACKED VECTOR OUTPUT TO
C BE WRITTEN TO UNIT KFILIO. (CHARACTER*60)
C NSTA - THE NUMBER OF STATIONS BEING DEALT WITH. THE
C NUMBER OF VALUES IN CCALL( , ), ETC. MAXIMUM
C OF ND1.
C KGP - THE NUMBER OF GROUPS OF STATIONS TO BE PROCESSED.
C MAXIMUM OF ND1.
C LNGTH - LINE LENGTH FOR PRINTING TO IP(16). (OUTPUT)
C ICHARS - NUMBER OF CHARACTERS FOR CALL LETTERS IN
C PRINTING, MIN OF 4, MAX OF 8. INT910 ASSURES
C THIS RANGE.
C NVRBL - THE NUMBER OF VARIABLES.
C ISTOP(J) - FOR J=1, ISTOP IS INCREMENTED BY 1 EACH TIME
C AN ERROR OCCURS THAT MAY BE FATAL.
C FOR J=2, ISTOP IS INCREMENTED BY 1 WHENEVER AN
C INPUT DATA RECORD IS NOT FOUND.
C MINPK - MINIMUM GROUP SIZE WHEN PACKING THE INTERPOLATED
C VALUES. SET IN DATA STATEMENT TO 14, THE AGREED
C ON VALUE FOR MOS-2000.
C LASTL - THE LAST LOCATION IN CORE( ) USED. THIS MAY BE
C MODIFIED, ALONG WITH ITEMS, IF COMPACTION IS
C DONE BY GCPAC. INITIALIZED TO ZERO ON FIRST
C ENTRY TO GSTORE. ALSO SET TO ZERO IN U910 IN
C CASE GSTORE IS NOT ENTERED.
C LASTD - TOTAL NUMBER OF PHYSICAL RECORDS ON DISK. INITIALIZED
C TO ZERO ON FIRST ENTRY TO GSTORE. ALSO SET TO
C ZERO IN U910 IN CASE GSTORE IS NOT ENTERED.
C NSTORE - THE NUMBER OF TIMES GSTORE HAS BEEN ENTERED.
C NFETCH - THE NUMBER OF TIMES GFETCH HAS BEEN ENTERED.
C NTOTBY - THE TOTAL NUMBER OF BYTES ON THE FILE ASSOCIATED
C WITH UNIT NO. KFILIO (THE OUTPUT FILE).
C IT IS INITIALIZED BY SKIPWR AND UPDATED AS
C DATA ARE WRITTEN. (THIS DOES NOT ACCOUNT FOR
C ANY BYTES WRITTEN BY THE SYSTEM THAT ARE NOT
C PART OF THE FORTRAN WRITES. THIS IS PROBABLY
C 8 BYTES PER RECORD.)
C NTOTRC - THE TOTAL NUMBER OF RECORDS IN THE FILE. IT IS
C INITIALIZED BY SKIPWR AND UPDATED AS DATA ARE
C WRITTEN.
C NCOMBO - REQUIRED BY GFETCH. NOT ACTUALLY USED.
C NRRDAT - REQUIRED BY GFETCH. THE VALUE SET BY DATA
C STATEMENT WILL CAUSE THE DATA STORED TO BE KEPT
C FROM DAY TO DAY.
C ISTAB - RETURNED FROM OPTX, BUT NOT USED.
C
C
C SUBPROGRAMS CALLED:
C UNIQUE: - INT910
C LIBRARY:
C MDLLIB90 - GSTORE, PACKV, PRU660, SETMIS, TRAIL, RDTDLM, WRTDLM,
C UPDAT, OPTX, WRTDLR, CLFILM
C
C EXIT STATES:
C COND = 0 - SUCCESSFUL RUN
C 120 - ONE OR MORE STATIONS NOT FOUND IN THE DIRECTORY.
C THIS IS NOT FATAL. (FROM OPTX).
C 135 - MISMATCH OF CALL LETTERS TO BE WRITTEN AND THOSE
C ON RANDOM ACCESS FILE.
C 141 - ERROR WRITING STATION DIRECTORY ON RANDOM ACCESS FILE.
C 155 - THE DIRECTORY DID NOT EXIST. THIS IS NOT AN ERROR.
C (FROM RDTDLM).
C 238 - TOTAL NUMBER OF ERRORS ALLOWED HAS BEEN EXCEEDED.
C 1090 - ERROR READING STATION DIRECTORY.
C
C REMARKS: NONE.
C
C ATTRIBUTES:
C LANGUAGE: FORTRAN 90 (xlf90 compiler)
C MACHINE: IBM SP
C
C$$$
C
CHARACTER*1 CFMT(ND4),HEAD(30,ND4),PREC(ND4)
CHARACTER*2 WDTH(ND4)
CHARACTER*4 IPINIT
CHARACTER*8 CCALL(ND1,6)
CHARACTER*8 CCALLD(ND5)
CHARACTER*20 NAME(ND1)
CHARACTER*32 PLAIN(ND4)
CHARACTER*60 OUTNAM,RACESS(5),CFILX
C
DIMENSION ISDATA(ND1),SDATA(ND1),NGP(ND1),MWORK(ND1)
DIMENSION ICALL(L3264W,ND1,6)
DIMENSION XDATA(ND1,ND2)
DIMENSION ID(4,ND4),IDPARS(15,ND4),TRESHL(ND4),TRESHU(ND4),
1 JD(4,ND4),JP(3,ND4),ITAU(ND4),
2 IWDTH(ND4),IPREC(ND4),NCAT(ND4),
3 ISCALD(ND4),PRINT(ND4)
DIMENSION IPLAIN(L3264W,4,ND4)
DIMENSION AA(ND2*ND1)
DIMENSION IPACK(ND5),ICALLD(L3264W,ND5),
1 IWORK(ND5),DATA(ND5)
DIMENSION IS0(ND7),IS1(ND7),IS2(ND7),IS4(ND7)
DIMENSION IDATE(ND8),NWORK(ND8)
DIMENSION LSTORE(12,ND9)
DIMENSION CORE(ND10)
DIMENSION KFILRA(5)
DIMENSION IP(25),ISTOP(2),LD(4)
C
DATA ISTOP/0,0/
DATA KFIL10/99/
DATA IP/25*0/
DATA LASTL/0/,
1 LASTD/0/
DATA NFETCH/0/,
1 NSTORE/0/
DATA MINPK/14/
DATA NTOTBY/0/,
1 NTOTRC/0/
DATA NCOMBO/999/
DATA NRRDAT/2100010100/
C
C READ CONTROL INFORMATION.
C
CALL INT910(KFILDI,KFILDO,KFILIO,IP,
1 CCALL,MWORK,IWORK,SDATA,XDATA,
2 ISDATA,IPACK,NGP,KGP,NAME,NSTA,ND1,CCALLD,ND5,
3 ID,IDPARS,TRESHL,TRESHU,JD,JP,NCAT,
4 ITAU,ICHARS,IWDTH,IPREC,CFMT,ISCALD,HEAD,
5 PLAIN,L3264B,L3264W,ND4,
7 KFILRA,RACESS,NUMRA,KFILX,CFILX,
7 OUTNAM,IDATE,NDATES,NWORK,ND8,
8 JSTOP,NREPLA,NCHECK,
9 NPRINT,NVRBL,LNGTH,
A NTOTBY,NTOTRC,IPINIT,ISTOP(1),IER)
C NOTE THAT MWORK( ), IWORK( ), SDATA( ), AND XDATA( ),
C ARE THE SAME AS NELEV( ), IWBAN( ), STALAT( ), AND
C STALON( ), RESPECTIVELY, IN INT710.
C NOTE THAT FOR IWORK, ND5 MUST BE MAINTAINED AS GE ND1.
C
C WHEN FORECASTS ARE TO BE WRITTEN TO THE RANDOM ACCESS
C FILE, READ CALL LETTERS IF THEY EXIST AND CHECK THEM
C TO MAKE ADDITION OF RECORDS POSSIBLE.
C
IF(KFILX.EQ.0)GO TO 145
C
LD(1)=400001000
LD(2)=0
LD(3)=0
LD(4)=0
CINTEL
C CALL RDTDLM(KFILDO,KFILX,CFILX,LD,ICALLD,ND1*L3264W,NVALUE,
C 1 L3264B,IER)
CALL RDTDLMC(KFILDO,KFILX,CFILX,LD,CCALLD,ND1*L3264W,NVALUE,
1 L3264B,IER)
CINTEL
C
IF(IER.EQ.155)THEN
C THE DIRECTORY DID NOT EXIST. THIS IS NOT AN ERROR.
WRITE(KFILDO,1115)CFILX
1115 FORMAT(' THE DIRECTORY DOES NOT EXIST ON FILE ',A60,/,
1 ' SO WRITE THE CALL LETTERS.')
GO TO 140
C
ELSEIF(IER.NE.0)THEN
WRITE(KFILDO,112)IER
112 FORMAT(' ERROR READING STATION DIRECTORY',
1 ' IN RANDOM ACCESS FILE IN U910 AT 112. IER =',I4)
C CALL W3TAGE('U910')
STOP 1090
ENDIF
C
NVALUE=NVALUE/L3264W
C THE CALL LETTERS ARE 8 BYTES EACH. THIS IS TWO WORDS
C ON A 32-BIT MACHINE. THE NUMBER OF WORDS WRITTEN AND
C READ MUST ACCOUNT FOR THIS. THE ACTUAL NUMBER OF CALL
C LETTERS IS NVALUE/L3264W.
C
C CALL LETTERS WERE READ. DO THEY MATCH?
C
IF(NVALUE.EQ.NSTA)GO TO 125
WRITE(KFILDO,120)NVALUE,NSTA,
1 (CCALL(J,1),CCALLD(J),J=1,MAX(NVALUE,NSTA))
120 FORMAT(/,' ****NUMBER OF CALL LETTERS READ FROM',
1 ' RANDOM ACCESS OUTPUT FILE =',I5,/,
1 ' DOES NOT EQUAL THE NUMBER TO BE WRITTEN =',I5,
2 '. STOP IN U910 AT 120.',/,(' ',A8,1X,A8))
C VALUES BEYOND NVALUE IN CCALL( , ) WILL NOT BE
C CHARACTER ORIENTED, AND PROBABLY NOT PRINTABLE AS A8.
C CALL W3TAGE('U910')
STOP 120
C
125 MATCH=0
C
DO 130 J=1,NSTA
IF(CCALL(J,1).EQ.CCALLD(J))GO TO 130
WRITE(KFILDO,126)CCALL(J,1),CCALLD(J)
126 FORMAT(/,' ****MISMATCH OF CALL LETTERS TO BE WRITTEN',
1 ' AND THOSE ON RANDOM ACCESS FILE.',2(2X,A8))
MATCH=1
130 CONTINUE
C
IF(MATCH.EQ.0)GO TO 145
WRITE(KFILDO,134)(CCALL(J,1),CCALLD(J),J=1,NSTA)
134 FORMAT(/,' TO WRITE ON CONSTANT FILE',/,
1 (' ',A8,2X,A8))
WRITE(KFILDO,135)
135 FORMAT(/,' STOP IN U910 AT 135.' )
C CALL W3TAGE('U910')
STOP 135
C
C WRITE CALL LETTERS RECORD WHEN SUCH A RECORD DOES
C NOT EXIST.
C
CINTEL
C 140 CALL WRTDLM(KFILDO,KFILX,CFILX,LD,ICALL,NSTA*L3264W,
C 1 0,0,L3264B,IER)
140 CALL WRTDLMC(KFILDO,KFILX,CFILX,LD,CCALL,NSTA*L3264W,
1 0,0,L3264B,IER)
CINTEL
C THE CALL LETTERS ARE 8 BYTES EACH. THIS IS TWO WORDS
C ON A 32-BIT MACHINE. THE NUMBER OF WORDS WRITTEN AND
C READ MUST ACCOUNT FOR THIS.
C
IF(IER.NE.0)THEN
WRITE(KFILDO,141)IER
141 FORMAT(/,' ****ERROR WRITING STATION DIRECTORY',
1 ' ON RANDOM ACCESS FILE IN U910 AT 141. IER =',I4)
C CALL W3TAGE('U910')
STOP 141
ENDIF
C
C FILL THE INDEX ISDATA( ) FOR STORING BY GSTORE.
C
145 DO 150 K=1,NSTA
ISDATA(K)=K
150 CONTINUE
C
CALL GSTORE(KFILDO,KFIL10,LD,NCOMBO,LSTORE,ND9,LITEMS,
1 ISDATA,NSTA,1,NRRDAT,0,
2 CORE,ND10,LASTL,NBLOCK,LASTD,NSTORE,L3264B,IER)
C NOTE THAT ISDATA( ) IS INTEGER. ALTHOUGH THE CORRESPONDING
C VARIABLE IN GSTORE IS REAL, THIS IS OK.
C
DO 300 ND=1,NDATES
C
C SET UP SOME VALUES FOR LOADING IS1( ) WHEN PACKING.
C
NDATE=IDATE(ND)
NYR=NDATE/1000000
NMO=NDATE/10000-NYR*100
NDA=NDATE/100-NYR*10000-NMO*100
NHR=NDATE-NYR*1000000-NMO*10000-NDA*100
C
C PROCESS ONE VARIABLE AT A TIME IN VRBL91.
C
DO 250 N=1,NVRBL
IF(NCAT(N).EQ.0)GO TO 250
C WHEN NCAT(N) = 0, THE VARIABLE HAS ALREADY BEEN
C RETURNED IN XDATA( ,J) (J=1,NCAT(N)).
C
C SET MDATE FOR THIS VARIABLE.
C
IF(ITAU(N).EQ.0)THEN
MDATE=NDATE
ELSE
CALL UPDAT(NDATE,ITAU(N),MDATE)
ENDIF
C
C
C COMPUTE THIS VARIABLE; NCAT( ) PROBABILITIES
C ARE HANDLED.
C NOTE THAT 9997 AS WELL AS 9999 MUST BE HANDLED.
C THE DATA WILL BE RETURNED READY TO USE, EXCEPT
C FOR POSSIBLE BINARY FORMULATION, IN XDATA( ,N).
C
CALL OPTX(KFILDO,KFIL10,IP(12),KFILRA,RACESS,NUMRA,
1 ID(1,N),IDPARS(1,N),TRESHL(N),JD(1,N),ITAU(N),
2 NDATE,MDATE,CCALL,ISDATA,XDATA,ND1,NCAT(N),NSTA,
3 ICALLD,CCALLD,IPACK,IWORK,DATA,ND5,
4 LSTORE,ND9,LITEMS,CORE,ND10,
5 LASTL,LASTD,NBLOCK,NSTORE,NFETCH,
6 IS0,IS1,IS2,IS4,ND7,
7 L3264B,L3264W,ISTAB,IER)
C
IF(IER.NE.0)THEN
C
IF(IER.EQ.120)THEN
ISTOP(1)=ISTOP(1)+1
C IER = 120 FROM FINDST IN CONST IN OPTX MEANS ONE OR MORE
C STATIONS NOT FOUND IN THE DIRECTORY. THIS IS NOT FATAL.
IER=0
ELSE
ISTOP(2)=ISTOP(2)+1
C AN ERROR IN OPTX WILL GENERATE A DIAGNOSTIC AND DATA IN
C XDATA( , ) HAVE BEEN SET TO 9999. ISTOP(2) IS INCREMENTED,
C EVEN WHEN IER = 47, WHICH JUST MEANS DATA COULD NOT
C BE FOUND. (IT IS POSSIBLE THAT ERRORS OTHER THAN JUST
C MISSING DATA OCCURRED.)
ENDIF
C
ENDIF
C
C PRINT THE DATA AS NECESSARY. ONLY THOSE VARIABLES
C FOR WHICH JP(2, ) NE 0 WILL BE PRINTED. NOTE THAT
C AN ERROR WITH IER NE 0 FROM OPTX WILL STILL DROP THROUGH
C HERE.
C
IF(NPRINT.LT.ND)GO TO 200
D WRITE(KFILDO,170)N,NSTA,KGP,NGP(1),NCAT(N)
D170 FORMAT(/,' U910 AT 170--N,NSTA,KGP,NGP(1),NCAT(N)',5I8)
C
DO 180 L=1,NCAT(N)
IF(JP(2,N+L-1).NE.0)GO TO 190
180 CONTINUE
C
C A DROP THROUGH HERE MEANS NO PRINT IS NECESSARY IN PRU660.
C AA( , ) IS USED ONLY IN PRU660.
GO TO 200
C
190 ICOUNT=1
C
DO 195 K=1,NSTA
DO 194 L=1,NCAT(N)
AA(ICOUNT)=XDATA(K,L)
ICOUNT=ICOUNT+1
194 CONTINUE
195 CONTINUE
C
CALL PRU660(KFILDO,IP(16),CCALL,NSTA,NGP,KGP,JP(1,N),IDATE(ND),
1 LNGTH,ICHARS,IWDTH(N),WDTH(N),IPREC(N),PREC(N),
2 CFMT(N),HEAD(1,N),
3 AA,PRINT(N),NCAT(N),ISTOP(1),IER)
C ISTOP(1) IS NOT ACTUALLY USED IN PRU660.
C
C SET XMISSS = 0. OR 9997. DEPENDING ON WHETHER A 9997.
C APPEARS IN THE DATA TO BE PACKED. SET XMISSP = 0.
C OR 9999. DEPENDING ON WHETHER A 9999. OR 9997. APPEAR
C IN THE DATA TO BE PACKED.
C
200 DO 245 L=1,NCAT(N)
NL=N+L-1
C
IF(JP(1,NL).EQ.0)GO TO 245
CALL SETMIS(KFILDO,XDATA(1,L),NSTA,XMISSP,XMISSS)
C
C PACK AND WRITE THE DATA. THE DATA ARE ALWAYS PACKED
C AND WRITTEN TO THE MOS-2000 RANDOM ACCESS FILE.
C THEY ARE WRITTEN TO THE SEQUENTIAL FILE ONLY IF JP(1,N) GT 0.
C
CALL PACKV(KFILDO,KFILIO,ID(1,NL),IDPARS(1,NL),
1 JP(1,NL),ISCALD(NL),0,
2 IPLAIN(1,1,NL),PLAIN(NL),NDATE,NYR,NMO,NDA,NHR,
3 CCALL,ISDATA,XDATA(1,L),ND1,NSTA,IPACK,ND5,MINPK,
4 IS0,IS1,IS2,IS4,ND7,XMISSP,XMISSS,
5 IP(15),LWORDS,NTOTBY,NTOTRC,
6 L3264B,L3264W,ISTOP(1),IER)
IF(KFILX.EQ.0)GO TO 210
CALL WRTDLR(KFILDO,KFILX,CFILX,IS1(9),ICALL,CCALL,ND1,NSTA,
1 ICALLD,CCALLD,ND5,IPACK,LWORDS,
2 NREPLA,NCHECK,L3264B,L3264W,IER)
IF(IER.EQ.0)GO TO 245
ISTOP(1)=ISTOP(1)+1
C AN ERROR IN WRTDLR WILL PRINT A DIAGNOSTIC.
210 IF(ISTOP(1).LE.JSTOP)GO TO 250
C
C TOTAL ERRORS ALLOWED HAVE BEEN EXCEEDED.
C
WRITE(KFILDO,238)ISTOP(1),N,IDATE(ND)
238 FORMAT(/,' NUMBER OF ERRORS =',I6,' AFTER VARIABLE NO.',I4,
1 ' DATE',I11,' EXCEEDS JSTOP.',
2 ' STOP IN U910 AT 238.')
WRITE(KFILDO,806)NSTORE
WRITE(KFILDO,807)NFETCH
C CALL W3TAGE('U910')
STOP 238
245 CONTINUE
C
250 CONTINUE
C
300 CONTINUE
C
C WRITE TRAILER RECORD AND EOF UNLESS KFILIO = 0. IF THERE
C IS AN ERROR, TRAIL WILL PRODUCE A DIAGNOSTIC.
C
IF(KFILIO.NE.0)THEN
CALL TRAIL(KFILDO,KFILIO,L3264B,L3264W,NTOTBY,NTOTRC,IER)
ENDFILE KFILIO
ENDIF
C
C CLOSE RANDOM ACCESS FILE.
C
CALL CLFILM(KFILDO,KFILX,IER)
C
C CLOSE UP SHOP.
C
WRITE(KFILDO,806)NSTORE
806 FORMAT(/,' THE MOS-2000 INTERNAL FILE HAS BEEN ACCESSED BY',
1 ' GSTORE',I11,' TIMES.')
WRITE(KFILDO,807)NFETCH
807 FORMAT(' THE MOS-2000 INTERNAL FILE HAS BEEN ACCESSED BY',
1 ' GFETCH',I11,' TIMES.')
IF(KFILIO.EQ.0)GO TO 8079
WRITE(KFILDO,8075)NTOTBY,NTOTRC,OUTNAM
8075 FORMAT(/,' A TOTAL OF ',I11,' BYTES IN ',I7,' RECORDS NOW',
1 ' EXIST ON FILE ',A60)
8079 IF(ISTOP(1).NE.0)WRITE(KFILDO,808)ISTOP(1)
808 FORMAT(/,' AT LEAST ISTOP(1) =',I6,
1 ' ERRORS HAVE OCCURRED ON THIS RUN.')
IF(ISTOP(2).NE.0.AND.ISTOP(1).EQ.0)WRITE(KFILDO,809)ISTOP(2)
809 FORMAT(/,' AT LEAST ISTOP(2) =',I6,
1 ' DATA RECORDS NOT FOUND ON THIS RUN.')
IF(ISTOP(2).NE.0.AND.ISTOP(1).NE.0)WRITE(KFILDO,8090)ISTOP(2)
8090 FORMAT(' AT LEAST ISTOP(2) =',I6,
1 ' DATA RECORDS NOT FOUND ON THIS RUN.')
IF(ISTOP(1).EQ.0.AND.ISTOP(2).EQ.0)WRITE(KFILDO,810)
810 FORMAT(/,' NO ERRORS HAVE BEEN DETECTED ON THIS RUN.')
WRITE(KFILDO,811)
811 FORMAT(' ')
RETURN
END