SUBROUTINE INT660(KFILDI,KFILDO,KFILIO,IP,
1 CCALL,NELEV,IWBAN,STALAT,STALON,
2 ISDATA,IPACK,NGP,KGP,NAME,NSTA,ND1,CCALLD,ND5,
3 ID,IDPARS,TRESHL,TRESHU,JD,JP,
4 ITAU,ICHARS,IWDTH,IPREC,CFMT,ISCALD,HEAD,
5 PLAIN,L3264B,L3264W,ND4,
6 KFILIN,MODNUM,NAMIN,JFOPEN,NUMIN,ND6,
7 KFILRA,RACESS,NUMRA,OUTNAM,
8 IDATE,NDATES,NWORK,ND8,
9 IOPT,KSKIP,NSKIP,JSTOP,PXMISS,NPRINT,
A NVRBL,LNGTH,
B NTOTBY,NTOTRC,IPINIT,ISTOP,IER)
C
C$$$ SUBPROGRAM DOCUMENTATION BLOCK
C
C SUBPROGRAM: INT660
C PRGMMR: GLAHN ORG: W/OSD21 DATE: 1998-01-01
C
C ABSTRACT: INT660 PERFORMS MUCH OF THE INITIALIZATION FOR U660.
C
C PROGRAM HISTORY LOG:
C 98-01-01 GLAHN
C 01-03-02 MALONEY ADDED NCEP DOCBLOCK. CHANGED CODE SO THAT
C THE DATE IS READ FROM THE NCEP DATE FILE WITH
C A CALL TO GET_NCEPDATE. ADDED CALLS TO W3TAGE.
C 05-06-14 MALONEY CHANGED DICTIONARY READERS FROM GROUPED
C STATION LISTS TO NON-GROUPED. THIS WAS FOR
C GRIDDED MOS SO THAT WE COULD USE THE DICTIONARY
C AS THE STATION LIST TO SPEED UP THE CODE. SET
C KGP TO 1 AND NGP(1) TO NSTA.
C
C USAGE: CALLED BY U660
C
C DATA SET USE
C INPUT FILES:
C FORT.KFILDI - UNIT NUMBER OF INPUT FILE. (INPUT)
C FORT.KFILD(J) - UNIT NUMBERS FOR WHERE THE STATION LIST (J=1)
C AND THE STATION DIRECTORY (J=2) RESIDES. (INPUT)
C FORT.KFILDT - UNIT NUMBER FOR READING THE DATE LIST. (INPUT)
C FORT.KFILP - UNIT NUMBER FOR READING THE VARIABLE LIST. (INPUT)
C FORT.KFILCP - UNIT NUMBER FOR PREDICTOR CONSTANT FILE. (INPUT)
C FORT.KFILRA(J) - UNIT NUMBERS FOR EXTERNAL RANDOM ACCESS FILES
C (J=1,5). (INPUT/OUTPUT)
C OUTPUT FILES:
C FORT.KFILDO - UNIT NUMBER OF OUTPUT (PRINT) FILE. (OUTPUT)
C FORT.KFILIO - UNIT NUMBER OF OUTPUT MDLPACK FILE. (OUTPUT)
C FORT.IP(J) - UNIT NUMBERS FOR OPTIONAL OUTPUT (J=1,25)
C (SEE IP( ) UNDER "VARIABLES" BELOW.) (OUTPUT)
C
C VARIABLES
C KFILDI = UNIT NUMBER TO READ INPUT FILE 'U660.CN'.
C (INPUT)
C KFILDO = UNIT NUMBER OF OUTPUT (PRINT) FILE. INITIALLY,
C THIS IS INPUT EQUAL TO 12. 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. (INPUT-OUTPUT)
C KFILIO = UNIT NUMBER OF OUTPUT MDLPACK FILE. (OUTPUT)
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 'U660',
C THEN 4 CHARACTERS FROM IPINIT, THEN 2 CHARACTERS
C FROM IP(J) (E.G., 'U660HRG130'). 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 U660. 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 VARIABLES 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. THIS
C LIST INCLUDES THE PARSED ID'S IN IDPARS( , ).
C (9) = THE VARIABLE LIST IN SUMMARY FORM . THIS
C 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 ON UNIT KFILCP.
C (10) = INDICATES WHETHER (>1) OR NOT (=0) THE LIST OF
C FIELDS READ FOR DAY 1 WILL BE PRINTED TO THE FILE
C WHOSE UNIT NUMBER IS IP(10).
C (11) = THE VARIABLE ID'S OF THE ARCHIVED FIELDS
C ACTUALLY NEEDED, IN ORDER AS THEY APPEAR ON
C THE ARCHIVE TAPES.
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 (14) = INDICATES WHETHER (>0) OR NOT (=0) A DIAGNOSTIC
C WILL BE PROVIDED ON UNIT IP(14) WHEN THERE ARE
C NO DATA FOR A DESIRED DATE/TIME ON A PARTICULAR
C INPUT FILE. THIS MIGHT HAPPEN FOR EACH DATE/TIME
C AND A LOT OF OUTPUT BE CREATED.
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 (23) = INDICATES WHETHER (>0) OR NOT (=0) STATEMENTS
C ABOUT EOF AND FILE OPENINGS AND CLOSINGS WILL
C BE OUTPUT FOR PRINTING ON UNIT IP(23).
C (24) = INDICATES WHETHER (>0) OR NOT (=0) A LISTING
C OF WHERE THE VARIABLES ARE TO BE FOUND IS
C CREATED FOR PRINTING ON UNIT IP(24). THESE
C ARE THE VALUES OF NWHERE.
C (OUTPUT)
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 (OUTPUT)
C NELEV(K) = ELEVATION OF STATIONS (K=1,NSTA). (OUTPUT)
C IWBAN(K) = WBAN NUMBERS OF STATIONS (K=1,NSTA). (OUTPUT)
C STALAT(K) = LATITUDE OF STATIONS (K=1,NSTA). (OUTPUT)
C STALON(K) = LONGITUDE OF STATIONS (K=1,NSTA). (OUTPUT)
C ISDATA(K) = USED IN RDSTGA TO KEEP TRACK OF THE STATIONS
C FOUND IN THE DIRECTORY (K=1,NSTA). (INTERNAL)
C IPACK(K) = USED IN RDSTGA TO KEEP TRACK OF THE STATIONS
C FOUND BY GROUP IN THE DIRECTORY (K=1,NSTA).
C ALSO USED AS WORK ARRAY IN SKIPWR. (INTERNAL)
C NGP(J) = THE NUMBER OF STATIONS IN EACH GROUP (J=1,KGP).
C (OUTPUT)
C KGP = THE NUMBER OF GROUPS OF STATIONS TO BE PROCESSED.
C MAXIMUM OF ND1. (SEE NGP( ))
C NAME(K) = NAMES OF STATIONS (K=1,NSTA) (CHARACTER*20)
C (OUTPUT)
C NSTA = THE NUMBER OF STATIONS BEING DEALT WITH. THE
C NUMBER OF VALUES IN CCALL( , ), ETC. (OUTPUT)
C ND1 = MAXIMUM NUMBER OF STATIONS THAT CAN BE DEALT WITH.
C (INPUT)
C CCALLD(K) = 8 STATION CALL LETTERS (K=1,ND5). THIS LIST IS
C USED IN RDSTGA AND RDSTGN TO RETAIN THE ORIGINAL
C LIST IN CCALL( , ). IT IS ALSO USED FOR SCRATCH IN
C SKIPWR. (CHARACTER*8) (OUTPUT)
C ND5 = DIMENSION OF CCALLD( ). (INPUT)
C ID(J,N) = THE INTEGER VARIABLE ID'S (J=1,4) (N=1,NVRBL).
C (OUTPUT)
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 (OUTPUT)
C TRESHL(N) = THE LOWER BINARY THRESHOLD CORRESPONDING TO IDPARS( ,N)
C (N=1,ND4). (OUTPUT)
C TRESHU(N) = THE UPPER BINARY THRESHOLD CORRESPONDING TO IDPARS( ,N)
C (N=1,ND4). (OUTPUT)
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 U660, WHICH IS ONLY FORMING
C BINARIES. THE "G" VARIABLE HAS NO MEANING IN U660,
C IT BEING ONLY FOR POSSIBLE USE IN U201. (OUTPUT)
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;
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 (OUTPUT)
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. (OUTPUT)
C ICHARS = NUMBER OF CHARACTERS FOR CALL LETTERS IN
C PRINTING, MAX OF 8, MIN OF 4. (OUTPUT)
C IWDTH(J) = WIDTH OF FIELD FOR PRINTING , MAXIMUM OF 30
C (J=1,ND4). (OUTPUT)
C IPREC(J) = PRECISION FOR PRINTING (J=1,ND4). THIS IS THE
C NUMBER OF PLACES AFTER THE DECIMAL POINT.
C (OUTPUT)
C CFMT(J) = FORMAT FOR PRINTING, EITHER I OR F (J=1,ND4).
C (CHARACTER*1) (OUTPUT)
C ISCALD(N) = THE DECIMAL SCALING CONSTANT TO USE WHEN PACKING THE
C COLLATED DATA (N=1,ND4). ISCALD COMES FROM THE VARIABLE
C CONSTANT FILE, MODIFIED TO BE 2 FOR GRID BINARIES,
C AND 0 FOR BINARIES. ZERO WHEN NOT FOUND IN THE
C FILE. NO BINARY SCALING IS
C PROVIDED FOR. (OUTPUT)
C HEAD(J,N) = HEADING FOR COLUMNS WHEN PRINTING DATA (J=1,30)
C (N=1,ND4). (CHARACTER*1) (OUTPUT)
C PLAIN(N) = THE PLAIN LANGUAGE DESCRIPTION OF THE VARIABLES
C (N=1,ND4). (CHARACTER*32) (OUTPUT)
C L3264B = INTEGER WORD LENGTH IN BITS OF MACHINE BEING USED
C (EITHER 32 OR 64). (INPUT)
C L3264W = NUMBER OF WORDS IN 64 BITS (EITHER 1 OR 2).
C (INPUT)
C ND4 = MAXIMUM NUMBER OF VARIABLES THAT CAN BE DEALT WITH
C IN ONE RUN. SECOND DIMENSION OF ID( , ), IDFORC( , )
C JD( , ), AND IDPARS( , ) AND DIMENSION OF TRESHL( ),
C JP( ), TRESHU( ),
C ITAU( ), PLAIN( ). (INPUT)
C KFILIN(J) = UNIT NUMBERS FOR INPUT DATA, ALL IN MDL MOS-2000
C FORMAT. INPUT CAN INCLUDE BOTH INTERPOLATED
C PREDICTOR FILES AND PREDICTAND DATA (J=1,ND6).
C (OUTPUT)
C MODNUM(J) = THE "MODEL" NUMBER CORRESPONDING TO KFILIN(J),
C AND NAMIN(J) (J=1,ND6). (OUTPUT)
C NAMIN(J) = HOLDS DATA SET NAMES FOR THE UNIT NUMBERS
C IN KFILIN(J) (J=1,ND6). (CHARACTER*60) (OUTPUT)
C JFOPEN(J) = FOR EACH FILE IN MODNUM(J), JFOPEN(J) IS SET
C TO 1 FOR J=1, MEANING THE FILE IS OPEN AND IS
C SET TO 2 FOR J GT 1 (IF ANY) MEANING THE FILE
C IS AVAILABLE, BUT NOT OPEN (J=1,NUMIN). (OUTPUT)
C NUMIN = THE NUMBER OF VALUES IN KFILIN( ),AND NAMES IN
C NAMIN( ). MAXIMUM OF ND6. (OUTPUT)
C ND6 = MAXIMUM NUMBER OF INPUT DATA SETS (MODELS) THAT
C CAN BE DEALT WITH. INCLUDED BOTH PREDICTORS
C AND PREDICTANDS. (INPUT)
C KFILRA(J) = UNIT NUMBERS FOR READING CONSTANT DATA (J=1,5).
C (OUTPUT)
C RACESS(J) = FILE NAMES FOR CONSTANT DATA READ ON UNIT
C NOS. KFILRA(J) (J=1,5). (CHARACTER*60) (OUTPUT)
C NUMRA = NUMBER OF VALUES IN KFILRA( ) AND RACESS( ).
C (OUTPUT)
C OUTNAM = NAME OF DATA SET FOR PACKED VECTOR OUTPUT.
C (CHARACTER*60) (OUTPUT)
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. (OUTPUT)
C NDATES = THE NUMBER OF DATES IN IDATE( ). (OUTPUT)
C NWORK(J) = WORK ARRAY (J=1,ND8). (INTERNAL)
C ND8 = MAXIMUM NUMBER OF DATES THAT CAN BE DEALT WITH.
C DIMENSION OF IDATE( ) AND NWORK( ). (INPUT)
C IOPT = USED TO INDICATE DESIRED PROCESSING (IF ANY) IN CHNGID.
C SEE CHNGID FOR VALUES AND THEIR MEANINGS. (OUTPUT)
C KSKIP = WHEN NONZERO, INDICATES THAT THE OUTPUT FILE
C IS TO BE MOVED FORWARD UNTIL ALL DATA FOR
C DATE KSKIP HAVE BEEN SKIPPED. KSKIP IS INPUT
C AS YYMMDDHH OR YYYYMMDDHH AND THEN USED AS
C YYYYMMDDHH. (OUTPUT)
C KWRITE = 0 IF CALL LETTERS RECORD IS NOT TO BE WRITTEN.
C NE 0 OTHERWISE. THIS HAS NO EFFECT UNLESS KSKIP
C NE 0. IF DATA ARE SKIPPED, THE EXISTING
C CALL LETTERS RECORD IS CHECKED WITH THE ONE
C AVAILABLE FOR WRITING. IF THEY MATCH
C THE NEW ONE IS NOT WRITTEN; HOWEVER,IF THEY
C DON'T MATCH, THE NEW ONE IS WRITTEN WHEN
C KWRITE = 1, BUT THE PROGRAM HALTS WITH A
C DIAGNOSTIC WHEN KWRITE = 0.
C NSKIP = THE NUMBER OF ERRORS THAT WILL BE TOLERATED ON DAY 1
C WITHOUT HALTING. (OUTPUT)
C JSTOP = THE NUMBER OF ERRORS THAT WILL BE TOLERATED ON THE
C TOTAL RUN BEFORE PROGRAM STOPS. (OUTPUT)
C PXMISS = THE VALUE OF A SECONDARY MISSING VALUE TO INSERT
C WHEN THE SECONDARY MISSING VALUE IS 9997.
C THIS ALLOWS MAINTAINING A 9997, TREATING IT AS
C ZERO, AS 9999, OR AS SOME OTHER VALUE. (OUTPUT)
C NPRINT = THE NUMBER OF CYCLES OF DATA TO PRINT UNDER
C JP(2, ) AND JP(3, ) CONTROL. (OUTPUT)
C NVRBL = THE NUMBER OF VARIABLES. (OUTPUT)
C LNGTH = LINE LENGTH FOR PRINTING TO IP(16). (OUTPUT)
C NTOTBY = THE TOTAL NUMBER OF BYTES ON THE FILE ASSOCIATED
C WITH UNIT NO. KFILIO (THE OUTPUT FILE).
C IT IS UPDATED BY SKIPWR.
C NTOTRC = THE TOTAL NUMBER OF RECORDS IN THE FILE. IT IS
C UPDATED BY SKIPWR.
C IPINIT = 4 CHARACTERS USED TO HELP IDENTIFY OUTPUT ASSOCIATED
C WITH THE IP( ) NUMBERS. (CHARACTER*4) (OUTPUT)
C ISTOP = 0 MEANS THE PROGRAM IS RUNNING OK UP TO THIS
C POINT. WHENEVER AN ERROR OCCURS THAT SHOULD
C HALT THE PROGRAM AFTER INPUT DIAGNOSTICS ARE
C PRINTED, ISTOP IS SET = ISTOP+1. (INPUT-OUTPUT)
C IER = STATUS RETURN.
C 0 = GOOD RETURN.
C OTHER VALUES CAN COME FROM CALLED SUBROUTINES.
C (OUTPUT)
C RUNID = INFORMATION INPUT TO IDENTIFY THE OUTPUT ON
C KFILDO. (CHARACTER*72) (INTERNAL)
C KFILDT = UNIT NUMBER FOR READING THE DATE LIST. (INTERNAL)
C DATNAM = FILE NAME FOR READING DATE LIST. (CHARACTER*60)
C (INTERNAL)
C KFILD(J) = THE UNIT NUMBER FOR WHERE THE STATION LIST (J=1)
C AND THE STATION DIRECTORY (J=2) RESIDES.
C CORRESPONDS TO DIRNAM(J). WHEN KFILD(1) = KFILDI,
C THE DEFAULT INPUT IS INDICATED, DIRNAM(1) IS NOT
C USED, AND THE FILE IS NOT OPENED. KFILD(1) CAN
C EQUAL KFILD(2), IN WHICH CASE THE STATION LIST IS
C TAKEN FROM THE DIRECTORY (I.E., A SEPARATE STATION
C LIST IS NOT PROVIDED). (INTERNAL)
C DIRNAM(J) = HOLDS NAME OF DATA SET CONTAINING THE STATION
C CALL LETTERS (J=1) AND STATION DIRECTORY (J=2).
C IT IS EXPECTED THAT THE STATIONS IN
C THE DIRECTORY BE ORDERED ALPHABETICALLY BY CALL
C LETTERS. (CHARACTER*60) (INTERNAL)
C KFILP = UNIT NUMBER FOR READING THE PREDICTOR AND
C PREDICTAND (OR VARIABLE) LIST. (INTERNAL)
C PRENAM = HOLDS DATA SET NAME FOR THE UNIT NUMBER
C IN KFILP. (CHARACTER*60) (INTERNAL)
C KFILCP = UNIT NUMBER FOR PREDICTOR CONSTANT FILE. THIS
C CONTAINS DEFAULT VALUES FOR CERTAIN CONSTANTS FOR
C BASIC NMC PREDICTORS AND OTHER PREDICTORS SANS
C THRESHOLDS, ETC. THESE INCLUDE PACKING CONSTANTS,
C GRIDPOINT CONSTANTS, AND NAMES. (INTERNAL)
C CONNAM = HOLDS DATA SET NAME FOR THE UNIT NUMBER IN KFILCP.
C (CHARACTER*60) (INTERNAL)
C ITEMP(J) = SCRATCH ARRAY (J=1,7). (INTERNAL)
C STATE = VARIABLE SET TO STATEMENT NUMBER TO INDICATE
C WHERE AN ERROR OCCURRED. (CHARACTER*4) (INTERNAL)
C NEW = 1 WHEN NEW 4-LETTER CALL LETTERS ARE TO BE USED;
C 0 WHEN OLD 3-LETTER CALL LETTERS ARE TO BE USED.
C (INTERNAL)
C NALPH = 1 WHEN THE CALL STATIONS USED ARE TO BE
C ALPHABETIZED BY GROUP (MORE EXACTLY, PUT
C IN THE ORDER THEY EXIST IN THE STATION DIRECTORY.
C 0 WHEN THE ORDER READ IN IS TO BE PRESERVED.
C (INTERNAL)
C IUSE(J) = EACH VALUE J PERTAINS TO IP(J). WHEN AN IP(J)
C VALUE IS USED BY THE PROGRAM, IPRINT(J) = 1;
C OTHERWISE, IPRINT(J) = 0. USED BY IPRINT TO
C PRINT IP( ) VALUES. (INTERNAL)
C
C
C SUBPROGRAMS CALLED:
C UNIQUE - NONE
C LIBRARY:
C MOSLIB - IPOPEN, IERX, DATPRO, RDI, RDSNAM, RDVR66, TIMPR,
C SKIPWR, IPRINT, RDSTAL, RDSTAD
C W3LIB - W3TAGE
C
C EXIT STATES:
C COND = 0 - SUCCESSFUL RUN
C 131 - ERROR READING NCEP DATE FILE
C 135 - DATE TO BE SKIPPED IS NOT BEFORE THE FIRST DATE TO
C BE WRITTEN
C 158 - NO VARIABLE LIST PROVIDED
C 159 - ERROR IN ROUTINE SKIPWR
C 165 - INCONSISTENCY OF INPUT UNIT NUMBERS IN KFILRA() WITH
C EITHER KFILDT, KFILD(), KFILP, KFILCP, KFILIO, OR
C KFILDO
C 9999 - ERROR IN CONTROL INFORMATION INPUT
C
C REMARKS: NONE
C
C ATTRIBUTES:
C LANGUAGE: FORTRAN 90 (xlf90 compiler)
C MACHINE: IBM SP
C
C$$$
CHARACTER*1 CFMT(ND4),HEAD(30,ND4)
CHARACTER*4 STATE,IPINIT
CHARACTER*8 CCALL(ND1,6)
CHARACTER*8 CCALLD(ND5)
CHARACTER*20 NAME(ND1)
CHARACTER*32 PLAIN(ND4)
CHARACTER*60 NAMIN(ND6),RACESS(5)
CHARACTER*60 DIRNAM(2),PRENAM,CONNAM,DATNAM,OUTNAM
CHARACTER*72 RUNID/' '/
C
DIMENSION NELEV(ND1),IWBAN(ND1),STALAT(ND1),STALON(ND1),
1 ISDATA(ND1),IPACK(ND1),NGP(ND1),ITIMEZ(ND1)
DIMENSION ID(4,ND4),IDPARS(15,ND4),TRESHL(ND4),TRESHU(ND4),
1 JD(4,ND4),JP(ND4),ITAU(ND4),
2 IWDTH(ND4),IPREC(ND4),ISCALD(ND4)
DIMENSION KFILIN(ND6),MODNUM(ND6),JFOPEN(ND6)
DIMENSION IDATE(ND8),NWORK(ND8)
DIMENSION ITEMP(7),IP(25),IUSE(25),KFILD(2),KFILRA(5)
C
DATA IUSE/1,1,1,1,1,1,1,1,1,1,1,1,0,1,1,1,0,0,0,0,0,0,1,1,0/
C
C THE KFILDO OUTPUT HAS BEEN TIME STAMPED IN THE DRIVER.
C NOTE THAT THIS IS ON THE DEFAULT OUTPUT FILE KFILDO.
C IF IP(1) NE 0, KFILDO IS SET TO IP(1) AND IS TIME STAMPED
C BELOW.
C
STATE='105 '
C OPEN(UNIT=KFILDI,FILE='U660.CN',STATUS='OLD',IOSTAT=IOS,ERR=900)
C
C READ AND PROCESS THE PRINT UNIT NUMBERS. FIRST,
C INITIALIZE IP( ) IN CASE NOT ALL 25 VALUES ARE READ.
C
DO 105 J=1,25
IP(J)=0
105 CONTINUE
C
STATE='108 '
READ(KFILDI,108,IOSTAT=IOS,ERR=900,END=109)IPINIT,(IP(J),J=1,25)
108 FORMAT(A4,25I3)
C LESS THAN 25 IP( ) VALUES WILL NOT BE INDICATED AS AN ERROR.
C SOME IP( ) VALUES ARE NOT USED; SEE IUSE( ).
CALL IPOPEN(KFILDO,'U660',IPINIT,IP,IER)
C WHEN IP(1) NE 0, KFILDO HAS BEEN SET TO IP(1).
C A FILE WILL BE OPENED FOR EVERY DIFFERENT VALUE IN IP( ).
C THE FILE NAMES WILL BE 4 CHARACTERS 'U660' THEN 4 CHARACTERS
C FROM IPINIT, THEN 2 CHARACTERS FROM IP(J). IPINIT MIGHT BE
C 'HRG1' INDICATING THE PERSONS INITIALS PLUS A SEQUENCE NUMBER.
IF(IER.NE.0)ISTOP=ISTOP+1
109 WRITE(KFILDO,110)IPINIT
110 FORMAT(/,' IPINIT = ',A4)
CALL IPRINT(KFILDO,IP,IUSE)
C
C TIME STAMP ALL ASCII OUTPUT OTHER THAN KFILDO.
C THIS IS NOT DONE IN IPOPEN BECAUSE SOME PROGRAMS
C MIGHT NOT WANT SOME FILE TO BE TIME STAMPED.
C
DO 113 J=1,25
IF(IP(J).EQ.0.OR.IP(J).EQ.KFILDO)GO TO 113
IF(J.EQ.1)GO TO 112
C
DO 111 I=1,J-1
IF(IP(J).EQ.IP(I))GO TO 113
111 CONTINUE
C
112 CALL TIMPR(IP(J),IP(J),'START U660 ')
113 CONTINUE
C
C READ AND PRINT THE RUN IDENTIFICATION.
C
STATE='115 '
READ(KFILDI,115,IOSTAT=IOS,ERR=900,END=116)RUNID
115 FORMAT(A72)
C LESS THAN 72 CHARACTERS WILL NOT BE CONSIDERED AN ERROR.
116 WRITE(KFILDO,117)RUNID
117 FORMAT(/,' ',A72)
C
C PRINT TO MAKE SURE USER KNOWS WHAT MACHINE IS BEING USED.
C
WRITE(KFILDO,119)L3264B
119 FORMAT(/,' RUNNING ON A',I3,'-BIT MACHINE.')
C
C READ AND PRINT CONTROL INFORMATION.
C
STATE='125 '
READ(KFILDI,125,IOSTAT=IOS,ERR=900,END=1250)
1 KSKIP,KWRITE,NSKIP,JSTOP,IOPT,NEW,NALPH,PXMISS,NPRINT,
2 ICHARS,LNGTH
125 FORMAT(7(I10,/),F10.0,/,(I10))
GO TO 1255
C INCOMPLETE CONTROL INFORMATION SHOULD BE CONSIDERED AN ERROR.
C HOWEVER, A SHORT RECORD DOES NOT CAUSE AN "END" CONDITION.
1250 WRITE(KFILDO,1251)
1251 FORMAT(/,' ****CONTROL INFORMATION NOT COMPLETE.')
ISTOP=ISTOP+1
C
C ACCEPT KSKIP AS YY OR YYYY FOR YEAR. IF IT IS ZERO, NO
C SKIPPING IS DONE.
C
1255 IF(KSKIP.EQ.0)GO TO 1257
IF(KSKIP/1000000.GT.1900)GO TO 1257
IF(KSKIP/1000000.GT.60)KSKIP=KSKIP+1900000000
IF(KSKIP/1000000.LE.60)KSKIP=KSKIP+2000000000
C
C INSURE THAT ICHARS GE 4 AND LE 8. IF NOT, THIS WILL CAUSE A
C PRINTING PROBLEM IN PRU660.
C
1257 ICHARS=MIN(MAX(ICHARS,4),8)
C
IF(LNGTH.LT.25)THEN
WRITE(KFILDO,1258)LNGTH
1258 FORMAT(/,' ****LNGTH =',I3,' TOO SMALL, SET TO 25')
LNGTH=25
ISTOP=ISTOP+1
ENDIF
WRITE(KFILDO,127)KSKIP,KWRITE,NSKIP,JSTOP,IOPT,NEW,NALPH,
1 PXMISS,NPRINT,ICHARS,LNGTH,L3264B
127 FORMAT(/,' KSKIP ',I10,' SKIP PAST THIS DATE ON OUTPUT FILE',/
1 ,' KWRITE',I10,' WILL DIRECTORY RECORD BE WRITTEN?',
X ' 1 = YES, 0 = NO',/
2 ,' NSKIP ',I10,' NUMBER OF ERRORS THAT WILL BE',
X ' TOLERATED ON DAY 1 BEFORE STOPPING',/
3 ,' JSTOP ',I10,' NUMBER OF ERRORS THAT WILL BE',
X ' TOLERATED ON TOTAL RUN BEFORE STOPPING',/
4 ,' IOPT ',I10,' DESIRED CHNGID PROCESSING INDICATOR',/
5 ,' NEW ',I10,' NEW ICAO CALL LETTERS, 1 = YES,',
X ' 0 = NO',/
6 ,' NALPH ',I10,' ALPHABETIZE CALL LETTERS ACCORDING',
X ' TO DIRECTORY, 1 = YES, 0 = NO',/
7 ,' PXMISS',F10.4,' SECONDARY MISSING VALUE TO INSERT',
X ' FOR 9997',/
8 ,' NPRINT',I10,' NUMBER OF CYCLES OF DATA TO PRINT',
X ' UNDER JP(2, ) AND JP(3, ) CONTROL',/
9 ,' ICHARS',I10,' NUMBER OF CHARACTERS FOR PRINTING',
X ' CALL LETTERS WHEN PRINTING DATA',/
A ,' LNGTH ',I10,' LINE LENGTH IN CHARACTERS FOR',
X ' PRINTING DATA TO UNIT IP(16)',/
B ,' L3264B',I10,' INTEGER WORD SIZE OF MACHINE')
C
C READ AND PROCESS UNIT NUMBER AND FILE NAME FOR READING
C DATE LIST. FILE WILL BE OPENED AS 'OLD', UNLESS THE FILE
C IS THE DEFAULT INPUT FILE.
C
CALL RDSNAM(KFILDI,KFILDO,KFILDT,DATNAM,IDUM,IDUM,1,N,'OLD',
1 'FORMATTED',IP,IER)
IF(IER.NE.0)ISTOP=ISTOP+1
WRITE(KFILDO,130)KFILDT
130 FORMAT(/,' NCEP DATE FILE UNIT NUMBER..',/,' ',I4)
C
C READ AND PRINT THE DATE TO BE PROCESSED
C
CALL GET_NCEPDATE(KFILDT,IYR,IMO,IDA,IHR,NDATE,IER)
C
IF(IER.NE.0)THEN
WRITE(KFILDO,131)
131 FORMAT(/' ****ERROR: CAN NOT READ NCEP DATE FILE - ',
1 'CATASTROPHIC ERROR IN INT660. STOP AT 131.')
CALL W3TAGE('INT660')
STOP 131
ENDIF
NDATES=1
IDATE(1)=NDATE
WRITE(KFILDO,132)NDATES,(IDATE(J),J=1,NDATES)
132 FORMAT(/,' ',I4,' INPUT DATE AS READ',/,(1X,10I12))
C
C MAKE SURE DATA WON'T BE WRITTEN WITH A DATE EQUAL TO OR LESS
C THAN THE DATE SKIPPED.
IF(KSKIP.GE.IDATE(1))THEN
WRITE(KFILDO,135)KSKIP,IDATE(1)
135 FORMAT(/,' ****DATE TO BE SKIPPED ',I11,' IS NOT BEFORE THE',
1 ' FIRST DATE TO BE WRITTEN ',I11,
2 '. STOP IN INT660 AT 135.')
CALL W3TAGE('INT660')
STOP 135
ENDIF
C
C READ AND PROCESS UNIT NUMBERS AND FILE NAMES FOR ALL MDLPACK
C INPUT. FILES WILL BE OPENED AS 'OLD'.
C
CALL RDSNAM(KFILDI,KFILDO,KFILIN,NAMIN,MODNUM,JFOPEN,ND6,NUMIN,
1 'OLD','UNFORMATTED',IP,IER)
C ONLY THE FIRST FILE IS OPENED.
IF(IER.NE.0)ISTOP=ISTOP+1
C
IF(NUMIN.EQ.0)THEN
WRITE(KFILDO,141)NUMIN
141 FORMAT(/,' ',I2,' MODEL INPUT DATA SETS.')
ELSE
WRITE(KFILDO,142)NUMIN,(KFILIN(M),NAMIN(M),M=1,NUMIN)
142 FORMAT(/,' ',I2,' MODEL INPUT DATA SETS, UNITS AND NAMES.',/
1 ,(' ',I4,2X,A60))
ENDIF
C
C READ AND PROCESS THE UNIT NUMBER AND FILE NAME FOR THE
C MOS-2000 EXTERNAL RANDOM ACCESS FILE. FIVE ARE ALLOWED,
C FILE WILL NOT BE OPENED.
C
CALL RDSNAM(KFILDI,KFILDO,KFILRA,RACESS,ITEMP,ITEMP,5,NUMRA,'NOT',
1 'NOTOPENED',IP,IER)
C ITEMP( ) IS AN ARRAY AT LEAST 5 IN SIZE.
IF(IER.NE.0)ISTOP=ISTOP+1
C
IF(NUMRA.NE.0)THEN
WRITE(KFILDO,143)NUMRA,(KFILRA(J),RACESS(J),J=1,NUMRA)
143 FORMAT(/,' ',I2,' MOS-2000 EXTERNAL RANDOM ACCESS DATA SETS,',
1 ' UNITS, AND NAMES.',/,(' ',I4,2X,A60))
ELSE
WRITE(KFILDO,1430)NUMRA
1430 FORMAT(/,' ',I2,' MOS-2000 EXTERNAL RANDOM ACCESS DATA SET.')
C THE ABOVE PRINT IS FOR THE EMPTY SET.
ENDIF
C
C READ AND PROCESS UNIT NUMBER AND FILE NAME FOR VECTOR
C OUTPUT. FILE WILL BE OPENED AS 'OLD'. THEREFORE, THE FILE
C SHOULD EXIST. HOWEVER, U660 WILL OPEN IT ANYWAY AND PROCEED
C WITH AN ERROR INDICATED BY IER NE 0.
C
CALL RDSNAM(KFILDI,KFILDO,KFILIO,OUTNAM,IDUM,IDUM,1,
1 IOUT,'NEW','UNFORMATTED',IP,IER)
IF(IER.NE.0)ISTOP=ISTOP+1
C
IF(KFILIO.EQ.0)THEN
WRITE(KFILDO,1435)
1435 FORMAT(/,' NO OUTPUT DATA SET PROVIDED;',
1 ' PACKED OUTPUT WILL NOT BE WRITTEN.')
OUTNAM=' '
ELSE
WRITE(KFILDO,144)KFILIO,OUTNAM
144 FORMAT(/,' OUTPUT DATA SET, UNIT AND NAME.',/
1 ,(' ',I4,2X,A60))
ENDIF
C
C READ AND PROCESS UNIT NUMBERS AND FILE NAMES FOR STATION LIST
C (CALL LETTERS) AND STATION DIRECTORY WHICH HOLDS CALL LETTERS,
C LATITUDE, LONGITUDE, WBAN NUMBER, ELEVATION, AND NAME FOR EACH
C POSSIBLE STATION. THIS CAN BE A MASTER DIRECTORY, OR BE A DIRECTORY
C SUPPLIED BY A USER.
C
CALL RDSNAM(KFILDI,KFILDO,KFILD,DIRNAM,ITEMP,ITEMP,2,N,'OLD',
1 'FORMATTED',IP,IER)
C ITEMP( ) IS AN ARRAY AT LEAST 2 IN SIZE.
IF(IER.NE.0)ISTOP=ISTOP+1
WRITE(KFILDO,147)(KFILD(J),DIRNAM(J),J=1,2)
147 FORMAT(/,' STATION LIST AND DIRECTORY DATA SETS, UNITS AND NAMES.'
1 ,/,(' ',I4,2X,A60))
C
C READ STATION LIST AND OTHER STATION INFORMATION. THE STATION
C LIST CAN COME FROM THE DEFAULT INPUT FILE KFILDI, OR BE ON A
C SEPARATE FILE AS DETERMINED BY KFILD(1).
C 06/2005 - CHANGED FROM USING GROUP STATION READERS
C RDSTGN AND RDSTGA TO NON-GROUP READERS RDSTAL AND RDSTAD.
C SET KGP TO 1 AND NGP(1) TO NSTA.
C
NSTA=0
KGP=0
C
IF(NALPH.EQ.0)THEN
CALL RDSTAL(KFILDO,IP(4),IP(5),KFILD,NEW,CCALL,
1 NAME,NELEV,IWBAN,STALAT,STALON,ITIMEZ,ISDATA,
2 ND1,NSTA,IER)
ELSE
CALL RDSTAD(KFILDO,IP(4),IP(5),KFILD,NEW,CCALL,CCALLD,
1 NAME,NELEV,IWBAN,STALAT,STALON,ITIMEZ,ISDATA,
2 ND1,NSTA,IER)
C CCALLD( ) IS TREATED HERE AS IF IT HAD THE SAME DIMENSIONS
C AS CCALL( , ). THIS IS OK, BECAUSE ND5 IS GE ND1.
ENDIF
C
IF(IER.NE.0)ISTOP=ISTOP+1
C THE DIRECTORY FILE IS READ ONLY ONCE.
C
C COMMENTED THE NEXT 5 LINES OUT WHEN THE GROUP DICTIONARY READERS
C WERE ELIMINATED. SET KGP TO 1 AND NGP(1) TO NSTA JUST IN CASE
C IT IS NEEDED LATER IN THE CODE.
C
C IF(KGP.GT.1)THEN
C WRITE(KFILDO,1503)KGP,NSTA
C1503 FORMAT(/,' ',I3,' GROUPS OF STATIONS, TOTALING ',I4,
C 1 ' STATIONS.')
C ENDIF
C
KGP=1
NGP(1)=NSTA
C
IF(KFILD(1).NE.KFILDI)CLOSE(UNIT=KFILD(1))
CLOSE(UNIT=KFILD(2))
C THE FILES ARE CLOSED WHEN THEY ARE NOT THE SAME AS
C THE DEFAULT INPUT FILE. THE DIRECTORY IS NEVER THE DEFAULT.
C
C READ AND PROCESS UNIT NUMBER AND FILE NAME FOR READING PREDICTOR
C AND PREDICTAND (OR VARIABLE) LIST.
C
CALL RDSNAM(KFILDI,KFILDO,KFILP,PRENAM,IDUM,IDUM,1,N,'OLD',
1 'FORMATTED',IP,IER)
IF(IER.NE.0)ISTOP=ISTOP+1
WRITE(KFILDO,152)KFILP,PRENAM
152 FORMAT(/,' VARIABLE LIST DATA SET, UNIT AND NAME.',/,
1 (' ',I4,2X,A60))
C
C READ AND PROCESS UNIT NUMBER FOR THE PREDICTOR CONSTANTS DIRECTORY.
C
CALL RDSNAM(KFILDI,KFILDO,KFILCP,CONNAM,IDUM,IDUM,1,N,'OLD',
1 'FORMATTED',IP,IER)
IF(IER.NE.0)ISTOP=ISTOP+1
IF(KFILCP.NE.0)WRITE(KFILDO,157)KFILCP,CONNAM
157 FORMAT(/,' VARIABLE CONSTANT DIRECTORY, UNIT AND NAME.',/,
1 (' ',I4,2X,A60))
C
C READ AND PRINT THE VARIABLES, BOTH PREDICTORS
C AND PREDICTANDS.
C
CALL RDVR66(KFILDO,IP(6),IP(7),IP(8),IP(9),KFILP,KFILCP,
1 ID,IDPARS,TRESHL,TRESHU,JD,JP,PLAIN,
2 ITAU,IWDTH,IPREC,CFMT,ISCALD,HEAD,ND4,
3 NVRBL,ISTOP,IER)
C
D WRITE(KFILDO,1575)(HEAD(1:30,J),J=1,NVRBL)
D1575 FORMAT(/,' INT660 HEAD(J)',/,(30A1))
IF(IER.EQ.42)THEN
WRITE(KFILDO,158)
158 FORMAT(/,' ****ALTHOUGH THE HP VERSION SEEMS TO RUN TO',
1 ' COMPLETION WITH NO PREDICTORS OR NO PREDICTANDS,'/,
2 ' IT IS PRUDENT TO STOP HERE IN INT660 AT 158.')
CALL W3TAGE('INT660')
STOP 158
C
ENDIF
C
C SKIP RECORDS ON THE OUTPUT FILE WHEN KSKIP NE 0.
C THE STATION LIST IN ICALL( ) IS CHECKED WITH THE STATION
C LIST AS THE FIRST RECORD IN THE FILE. IF THEY DO NOT
C MATCH, THE PROGRAM RESPONDS TO KWRITE. WHEN RECORDS
C ARE NOT SKIPPED, THE CALL LETTERS RECORD IS WRITTEN.
C WHEN KFILIO = 0, SKIPWR DOES NOTHING.
C
KCHECK=1
CALL SKIPWR(KFILDO,KFILIO,KSKIP,KWRITE,KCHECK,
1 CCALL,ND1,NSTA,
2 CCALLD,ND5,IPACK,ND5,
3 NTOTBY,NTOTRC,L3264B,L3264W,IER)
IF(IER.EQ.0)GO TO 160
WRITE(KFILDO,159)
159 FORMAT(/,' ****PROGRAM STOP AT 159 BECAUSE OF ERROR IN',
1 ' ROUTINE SKIPWR. OTHERWISE, GOOD DATA MIGHT',
2 ' BE OVERWRITTEN.')
CALL W3TAGE('INT660')
STOP 159
C STOP THE PROGRAM FOR SAFETY. OTHERWISE, GOOD DATA MIGHT
C BE OVERWRITTEN.
C
C CHECK POSSIBLE INCONSISTENCY OF INPUT UNIT NUMBERS WITH
C OTHERS USED BY THE PROGRAM. THIS SHOULD PROTECT THE LARGE
C DATA SETS IN NAMIN( ) FROM BEING OVERWRITTEN.
C
160 DO 170 J=1,NUMIN
IF(KFILIN(J).NE.KFILDT .AND.
1 KFILIN(J).NE.KFILRA(1).AND.
2 KFILIN(J).NE.KFILRA(2).AND.
3 KFILIN(J).NE.KFILRA(3).AND.
4 KFILIN(J).NE.KFILRA(4).AND.
5 KFILIN(J).NE.KFILRA(5).AND.
6 KFILIN(J).NE.KFILD(1) .AND.
7 KFILIN(J).NE.KFILD(2) .AND.
8 KFILIN(J).NE.KFILP .AND.
9 KFILIN(J).NE.KFILCP .AND.
A KFILIN(J).NE.KFILIO)GO TO 170
WRITE(KFILDO,165)
165 FORMAT(/,' ****INCONSISTENCY IN INPUT UNIT NUMBERS IN KFILIN( )',
1 ' WITH EITHER KFILDT, KFILRA( ), KFILD( ), KFILP,',
2 ' KFILCP, OR KFILIO',/,' STOP IN INT660 AT 165')
CALL W3TAGE('INT660')
STOP 165
C
170 CONTINUE
C
RETURN
C
C ERROR STOP BELOW IS FOR ERRORS OF CONTROL INFORMATION INPUT.
900 CALL IERX(KFILDO,KFILDO,IOS,'INT660',STATE)
CALL W3TAGE('INT660')
STOP 9999
END