SUBROUTINE INT140(KFILDI,KFILDO,KFILDT,KFILIN,KFILRA,
1 KFILGIS,KFILGO,KFILX,KFILD,
2 RACESS,IP,IUSE,IDATE,NDATES,PLAIN,
3 ND1,ND4,ND6,ND8,L3264B,L3264W,
4 IDPARS,ID,IOUTD,IOUTG,IOUTJ,CFILX,
5 NAMIN,MODNUM,JFOPEN,NUMIN,NUMRA,INCCYL,ISCALD,
6 NPROJ,NX,NY,XLATLL,YLONLL,XMESHL,ORIENT,XLAT,
7 MISSV,ICHARS,LNGTH,NVRBL,
8 PLAIN_ADJ,ID_ADJ,ISCALD_ADJ,NVRBL_ADJ,
8 CALLML,RCCALLD,NAME,NELEV,STALAT,STALON,
9 ISTA,IPINIT,ISTOP,IER)
C
C$$$ SUBPROGRAM DOCUMENTATION BLOCK
C
C SUBPROGRAM: INT140
C PRGMMR: WEISS ORG: W/OST22 DATE: 2005-01-01
C
C ABSTRACT: INT140 PERFORMS MUCH OF THE INITIALIZATION FOR U140,
C INCLUDING THE WRITING OF THE TDLPACK HEADER RECORD ON THE TDLPACK
C OUTPUT DATASET.
C
C PROGRAM HISTORY LOG:
C 05-01-01 WEISS
C 05-03-07 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-03-11 MALONEY ADDED MISSV FOR MISSING VALUE OPTIONS
C 12-11-01 SAMPLATSKY CHANGED NON-STANDARD SYNTAX FOR
C DATA INTIALIZATION FOR RUNID TO
C SATISFY INTEL COMPILER.
C
C USAGE: CALLED BY U140
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 ID LIST TO
C OUTPUT TO THE GRIDDED OUTPUT FILE. (INPUT)
C FORT.KFILIN(J) - UNIT NUMBERS FOR INPUT DATA, ALL IN TDLPACK
C FORMAT. INPUT CAN INCLUDE GRIDPOINT (FILES)
C DATA, PREDICTAND (OBSERVATIONS) DATA, VARIOUS
C CONSTANTS, OR MOS FORECASTS (FOR 2ND GENERATION
C MOS, POSSIBLY FOR LOCAL IMPLEMENTATION
C (J=1,NUMIN). (INPUT)
C FORT.KFILPC - UNIT NUMBER FOR READING THE LIST OF VARIABLE
C IDS ADJUSTED FOR GRIDDED ANALYSIS PROCESSING
C (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
C OUTPUT FILES:
C FORT.KFILDO - UNIT NUMBER OF OUTPUT (PRINT) FILE. (OUTPUT)
C FORT.KFILGO - UNIT NUMBER FOR THE GRIDPOINT OUTPUT
C SEQUENTIAL FILE. (OUTPUT)
C FORT.KFILX - UNIT NUMBER FOR THE GRIDPOINT OUTPUT
C RANDOM ACCESS FILE. (OUTPUT)
C FORT.KFILGIS - UNIT NUMBER OF ARC-GIS OUTPUT FILE.
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 'U140.CN'.
C (INPUT)
C KFILDO = UNIT NUMBER OF OUTPUT (PRINT) FILE. INITIALLY,
C THIS IS INPUT EQUAL TO 6. 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 KFILDT = UNIT NUMBER FOR READING THE DATE LIST. (INPUT)
C KFILIN(J) = UNIT NUMBERS FOR SEQUENTIAL INPUT DATA, ALL IN
C TDLPACK FORMAT. INPUT CAN INCLUDE GRIDPOINT (FILES)
C DATA, PREDICTAND (OBSERVATIONS) DATA, VARIOUS
C CONSTANTS, OR MOS FORECASTS (FOR 2ND GENERATION
C MOS, POSSIBLY FOR LOCAL IMPLEMENTATION
C (J=1,NUMIN). (OUTPUT)
C KFILRA = UNIT NUMBER OF THE OLD MOS EXTERNAL RANDOM
C ACCESS FILE. (OUTPUT)
C KFILGIS = UNIT NUMBER OF ARC-GIS OUTPUT FILE. (OUTPUT)
C KFILGO = UNIT NUMBER FOR THE GRIDPOINT OUTPUT
C SEQUENTIAL FILE. (OUTPUT)
C KFILX = UNIT NUMBER FOR THE GRIDPOINT OUTPUT
C RANDOM ACCESS FILE. (OUTPUT)
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) =
C KFILDI, THE DEFAULT INPUT IS INDICATED,
C DIRNAM(1) IS NOT USED, AND THE FILE IS NOT
C OPENED. KFILD(1) CAN EQUAL KFILD(2), IN WHICH
C CASE THE STATION LIST IS TAKEN FROM THE
C DIRECTORY (I.E., A SEPARATE STATION LIST IS NOT
C PROVIDED).
C RACESS = FILE NAME OF THE OLD MOS EXTERNAL RANDOM ACCESS
C FILE. ONLY ONE IS ALLOWED (CHARACTER*60). (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 'U140',
C THEN 4 CHARACTERS FROM IPINIT, THEN 2 CHARACTERS
C FROM IP(J) (E.G., 'U140HRG140'). 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 SEQUENTIAL FILE(S). IF
C THERE ARE NO INPUT SEQUENTIAL FILES, A
C MESSAGE WILL BE WRITTEN TO THE DEFAULT OUTPUT
C FILE UNIT KFILDO AS WELL AS TO UNIT IP(4).
C (5) = THE INPUT RANDOM ACCESS FILE. IF
C THERE ARE NO INPUT RANDOM ACCESS FILES, A
C MESSAGE WILL BE WRITTEN TO THE DEFAULT OUTPUT
C FILE UNIT KFILDO AS WELL AS TO UNIT IP(5).
C (6) = THE OUTPUT GIS, SEQUENTIAL, AND RANDOM
C ACCESS FILE. IF ANY OF THE OUTPUT FILES ARE
C MISSING, A MESSAGE WILL BE WRITTEN TO THE
C DEFAULT OUTPUT FILE UNIT KFILDO AS WELL AS
C TO UNIT IP(6).
C (7) = THE INPUT STATION LIST IS WRITTEN. IF THERE
C ARE INPUT ERRORS, THE STATION LIST WILL BE
C WRITTEN TO THE DEFAULT OUTPUT FILE
C UNIT KFILDO AS WELL AS TO UNIT IP(7).
C NOTE: INPUT STATION LISTS ARE NOT YET
C OPERATIONAL FOR U140./
C (8) = THE STATION DIRECTORY INFORMATION IS
C WRITTEN. IF THERE ARE INPUT ERRORS,
C THE DIRECTORY INFO WILL BE WRITTEN TO THE
C DEFAULT OUTPUT FILE UNIT KFILDO AS WELL AS
C TO UNIT IP(8).
C (9) = THE INPUT VARIABLE IDS ARE WRITTEN TO
C UNIT IP9 AS THE VARIABLES ARE READ IN.
C ARE READ IN. THIS SHOULD BE USEFUL FOR
C CHECKOUT.
C NOTE: FOR BOTH NON-ADJUSTED AND ADJUSTED
C VARIABLES.
C (10) = THE VARIABLE LIST WILL BE WRITTEN TO UNIT
C IP10 PARSED INTO ITS 15 INTEGER COMPONENTS.
C 15 INTEGER COMPONENTS. IF THERE ARE INPUT
C ERRORS, THE VARIABLE LIST WILL BE WRITTEN
C TO THE DEFAULT OUTPUT FILE UNIT KFILDO AS WELL AS
C TO UNIT IP10 IF THEY ARE DIFFERENT.
C NOTE: FOR BOTH NON-ADJUSTED AND ADJUSTED
C VARIABLES.
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.
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 PLAIN(N) = THE PLAIN LANGUAGE DESCRIPTION OF THE VARIABLES
C (N=1,ND4). (CHARACTER*32) (OUTPUT)
C ND1 = MAXIMUM NUMBER OF STATIONS THAT CAN BE DEALT WITH.
C (INPUT)
C ND4 = MAXIMUM NUMBER OF VARIABLES THAT CAN BE DEALT WITH
C IN ONE RUN. SECOND DIMENSION OF ID( , ), IDFORC( , )
C AND IDPARS( , ).
C ND6 = MAXIMUM NUMBER OF MODELS THAT CAN BE DEALT WITH
C IN ONE RUN. DIMENSION OF KFILIN( ) AND
C NAMIN( ). SET BY PARAMETER.
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 IDPARS(J,N) = THE PARSED, INDIVIDUAL COMPONENTS OF THE VARIABLE
C ID'S CORRESPONDING TO ID( ,N) GENERATED IN
C RDVR37. (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). THIS HAS NO MEANING
C EXCEPT IN U201, AND IS SET TO ZERO. THIS
C IN CASE THE SAME VARIABLE LIST IS USED IN
C U201 AND OTHER PROGRAMS, SUCH AS U600.
C ID(J,N) = THE INTEGER VARIABLE IDS (J=1,4) (N=1,ND4).
C (OUTPUT)
C IOUTD = THE GIS FILE UNIT NUMBER (OUTPUT)
C IOUTG = THE SEQUENTIAL FILE UNIT NUMBER (OUTPUT)
C IOUTJ = THE SEQUENTIAL FILE UNIT NUMBER (OUTPUT)
C CFILX = HOLDS DATA SET NAME FOR THE UNIT NUMBER IN KFILX.
C (CHARACTER*60) (OUTPUT)
C NAMIN(J) = HOLDS DATA SET NAMES FOR THE UNIT NUMBERS IN
C KFILIN(J) (J=1,NUMIN). (CHARACTER*60)
C JFOPEN(J) = FOR EACH FILE IN KFILIN(J), JFOPEN(J) IS 1 WHEN
C THE FILE IS OPEN, IS 0 WHEN IT HAS ALREADY BEEN
C USED AND IS 2 WHEN THE FILE HAS NOT BEEN OPENED
C (J=1,NUMIN).
C MODNUM(J) = THE "MODEL" NUMBER CORRESPONDING TO KFILIN(J),
C AND NAMIN(J) (J=1,NUMIN). THIS MAY NOT HAVE
C MEANING FOR SOME INPUTS, BUT IS NEEDED FOR THE
C MODEL DATA.
C NUMIN = THE NUMBER OF VALUES IN KFILIN( ), NAMES IN
C NAMIN( ), ETC. MAXIMUM OF ND6. THIS IS REDUCED
C IF THERE IS NO VARIABLE WITH A PARTICULAR
C MODEL NUMBER.
C NUMRA = THE NUMBER OF INPUT RANDOM ACCESS FILES
C NAMES TO READ (WILL ALWAYS BE ONE).
C NAM( ), AND MODEL NUMBERS IN MODNUM( ),
C MAXIMUM OF ND6. (OUTPUT)
C INCCYL = THE NUMBER OF HOURS BETWEEN DATES WHEN DATE SPANNING
C IS USED. (INTERNAL/OUTPUT)
C ISCALD(N) = THE DECIMAL SCALING CONSTANT TO USE WHEN PACKING THE
C COLLATED DATA (N=1,ND4). NO BINARY SCALING IS
C PROVIDED FOR. 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. (OUTPUT)
C NPROJ = MAP PROJECTION OF THE OUTPUT GRID.
C NX = X-EXTENT OF THE OUTPUT GRID.
C NY = Y-EXTENT OF THE OUTPUT GRID.
C XLATLL = LATITUDE OF LOWER LEFT CORNER POINT OF THE
C OUTPUT GRID.
C YLONLL = WEST LONGITUDE OF LOWER LEFT CORNER POINT
C OF THE OUTPUT GRID. DO NOT USE NEGATIVE.
C XMESHL = MESH LENGTH OF OUTPUT GRID IN KM AT XLAT DEGREES
C NORTH LATITUDE.
C ORIENT = ORIENTATION OF OUTPUT GRID IN DEGREES WEST
C LONGITUDE. DO NOT USE NEGATIVE.
C XLAT = LATITUDE OF OUTPUT GRID IN DEGREES AT WHICH
C XMESHL APPLIES. ALSO THE LATITUDE WHERE THE
C PROJECTION CUTS THE EARTH. DO NOT USE NEGATIVE.
C MISSV = THE MISSING VALUE OPTION WHERE 0=9999.
C 1 = AVERAGE OF INPUT FIELD (OUTPUT).
C ICHARS = NUMBER OF CHARACTERS FOR CALL LETTERS IN
C PRINTING, MAX OF 8, MIN OF 4. (OUTPUT)
C LNGTH = LINE LENGTH FOR PRINTING TO IP(16). (OUTPUT)
C NVRBL = THE NUMBER OF VARIABLES. (OUTPUT)
C PLAIN_ADJ(N) = THE PLAIN LANGUAGE DESCRIPTION OF THE ADJUSTED
C VARIABLES (N=1,ND4). (CHARACTER*32) (OUTPUT)
C ID_ADJ(J,N) = THE INTEGER ADJUSTED VARIABLE ID'S (J=1,4)
C (N=1,ND4).
C ISCALD_ADJ(N) = THE SCALLING FACTORS FOR THE ADJUSTED
C VARIABLES (N=1,ND4). (OUTPUT)
C NVRBL_ADJ = THE NUMBER OF ADJUSTED VARIABLES(OUTPUT)
C CALLML(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,ND1). ALL STATION
C DATA ARE KEYED TO THIS LIST. (CHARACTER*8)
C (OUTPUT)
C RCCALLD(K) = 8-CHARACTER STATION CALL LETTERS AS READ
C FROM THE INPUT LIST OF STATIONS (K=1,ND1)
C NOTE: THIS LIST IS NOT YET A REQUIREMENT
C OF U140, BUT A FILE NEEDS TO EXISTS IN
C U140.CN (OUTPUT)
C NAME(K) = NAMES OF STATIONS (K=1,ND1) (CHARACTER*20)
C NELEV(K) = ELEVATION OF STATIONS (K=1,ND1).
C STALAT(K) = LATITUDE OF STATIONS (K=1,ND1).
C STALON(K) = LONGITUDE OF STATIONS (K=1,ND1).
C ISTA = THE NUMBER OF COUNTED STATIONS IN THE STATION
C TABLE (OUTPUT).
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
C ADDITIONAL VARIABLES
C CONNAM = HOLDS DATA SET NAME FOR THE UNIT NUMBER IN KFILCP.
C (CHARACTER*60) (INTERNAL)
C DATNAM = FILE NAME FOR READING DATE LIST.
C (CHARACTER*60) (INTERNAL)
C OUTGIS = FILE NAME FOR READING THE GIS OUTPUT FILE.
C (CHARACTER*60) (INTERNAL)
C OUTGRD = FILE NAME FOR READING THE SEQUENTIAL OUTPUT FILE.
C (CHARACTER*60) (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 IOUTP = THE PREDICTOR VARIABLE LIST UNIT NUMBER (INTERNAL)
C IOUTS = THE ADJUSTED PREDICTOR VARIABLE LIST UNIT
C NUMBER (INTERNAL)
C PRENAM = HOLDS DATA SET NAME FOR THE UNIT NUMBER
C IN KFILP. (CHARACTER*60) (INTERNAL)
C PCNAM = HOLDS DATA SET NAME FOR THE UNIT NUMBER
C IN KFILPC. (CHARACTER*60) (INTERNAL)
C JD(J,N) = THE BASIC INTEGER VARIABLE IDS (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, ),
C JD( , ) IS USED IN SETPLN. THE "G" VARIABLE HAS
C HAS NO MEANING IN U370. (OUTPUT)
C JD_ADJ(J,N) = SAME AS JD, EXCEPT FOR ADJUSTED VARIABLE IDS.
C KFILP = UNIT NUMBER OF SELECTED VARIABLE IDs TO PROCESS
C TO THE GRIDDED OUTPUT FILE.
C KFILPC = UNIT NUMBER OF SELECTED VARIABLE IDs TO BE
C ADJUSTED FOR THE OUTPUT GRIDDED FILE
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 IFOUND(K) = USED TO KEEP TRACK OF THE STATIONS FOUND IN THE
C DIRECTORY (K=1,ND1).
C 0 = NOT YET FOUND,
C 1 = FOUND,
C 2 = DUPLICATE. (NOTE: NOT TESTED FOR IN U140)
C (INTERNAL: USED IN RDSTGRID)
C IWBAN(K) = WBAN NUMBERS OF STATIONS (K=1,ND1). THIS IS
C RETURNED FROM RDSTGRID, BUT IS NOT NEEDED. THERE
C ARE NO WBAN NUMBERS FOR GRIDDED MOS STATIONS.
C ITEMP(J) = SCRATCH ARRAY (J=1,7). (INTERNAL)
C NWORK(J) = A WORK ARRAY (J=1,ND8). (INTERNAL)
C IDUM = USED IN CALLING SEQUENCE TO RDSNAM. IT IS USED
C WITH THE NEXT VARIABLE BEING 1, SO THE ARRAY
C IN RDSNAM WILL BE DIMENSIONED 1. (INTERNAL)
C RUNID = INFORMATION INPUT TO IDENTIFY THE OUTPUT ON
C KFILDO. (CHARACTER*72) (INTERNAL)
C STATE = VARIABLE SET TO STATEMENT NUMBER TO INDICATE
C PRINT IP( ) VALUES. (INTERNAL)
C
C SUBPROGRAMS CALLED:
C UNIQUE - NONE
C LIBRARY:
C MOSLIB - IPRINT, IPOPEN, IERX, RDC, RDSNAM, RDSTGN, RDSTGA,
C RDVR37, TIMPR
C W3LIB - W3TAGE
C
C EXIT STATES:
C COND = 0 - SUCCESSFUL RUN
C 154 - ERROR IN DATE LIST
C 180 - NO INPUT FILES GIVEN
C 181 - ERROR IN INPUT LISTS
C 225 - NO STATION TABLE AND/OR STATION LIST
C 250 - NO PREDICTOR LIST INPUT
C 260 - NO ADJUSTED PREDICTOR LIST INPUT
C 261 - NO ID TABLE INPUT
C 264 - ERROR READING IDS
C 274 - ERROR READING ADJUSTED IDS
C 285 - INCONSISTENCY WITH INPUT UNIT NUMBERS
C 350 - INCONSISTENCY WITH INPUT UNIT NUMBERS
C 390 - INCONSISTENCY WITH INPUT UNIT NUMBERS
C 1251 - CONTROL INFORMATION NOT COMPLETE (SHOULD NOT HAPPEN)
C 1285 - INVALID MAP PROJECTION
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$$$
C
IMPLICIT NONE
C
INTEGER, PARAMETER :: NT=7
C
INTEGER :: KFILDI, KFILDO, KFILDT, KFILRA, KFILIN,
1 KFILGIS, KFILGO, KFILX, KFILD, KFILP, KFILPC,
2 IP, IUSE, ND1, ND4, ND6, ND8, L3264B, L3264W,
3 ID, JD, JD_ADJ, ID_ADJ,KFILCP,
4 NUMIN, NUMRA, IDATE, NDATES,
5 IOUTD,IOUTG,IOUTJ,IOUTP,IOUTS,
6 ITEMP, NWORK, IER
C
INTEGER :: IDPARS, MODNUM, JFOPEN
INTEGER :: ISTOP, IOS, IOSTAT, I, J, N, IDUM
INTEGER :: NPROJ, NX, NY, LNGTH, NVRBL, NVRBL_ADJ, INCCYL
INTEGER :: ISCALD, ISCALD_ADJ, ICHARS, MISSV, NELEV, IWBAN,
1 IFOUND, ISTA
INTEGER :: IHR, NDATE, IDA, IYR, IMO
C
REAL :: XLATLL,YLONLL,XMESHL,ORIENT,XLAT,STALAT,STALON
C
CHARACTER*4 :: STATE, IPINIT
CHARACTER*8 :: CALLML,RCCALLD
CHARACTER*20 :: NAME
CHARACTER*32 :: PLAIN,PLAIN_ADJ
CHARACTER*60 :: RACESS,NAMIN,DATNAM,OUTGIS,OUTGRD,CFILX,
1 DIRNAM,PRENAM,PCNAM,CONNAM
CHARACTER*72 :: RUNID
C
C
DIMENSION IDPARS(15,ND4),IDATE(ND8),ITEMP(7),NWORK(ND8)
DIMENSION KFILIN(ND6),MODNUM(ND6),JFOPEN(ND6),NAMIN(ND6)
DIMENSION KFILD(2),DIRNAM(2)
C
DIMENSION CALLML(ND1,6),RCCALLD(ND1),NAME(ND1),
1 NELEV(ND1),IWBAN(ND1),STALAT(ND1),STALON(ND1),
2 IFOUND(ND1)
C
DIMENSION IP(25),IUSE(25),ID(4,ND4),JD(4,ND4),JD_ADJ(4,ND4),
1 ID_ADJ(4,ND4),ISCALD(ND4),
2 ISCALD_ADJ(ND4),PLAIN(ND4),PLAIN_ADJ(ND4)
C
DATA KFILP/0/,KFILPC/0/,RUNID/' '/
C
C INITIALIZE ARRAYS
C
DO 90 I = 1, ND4
PLAIN(I) = ' '
PLAIN_ADJ(I) = ' '
ISCALD(I) = 0
ISCALD_ADJ(I) = 0
DO 81 J = 1, 15
IDPARS(J,I) = 0
81 CONTINUE
90 CONTINUE
DO 95 I = 1, ND1
IFOUND(I) = 0
IWBAN(I) = 0
RCCALLD(I) = ' '
95 CONTINUE
NVRBL = 0
NVRBL_ADJ = 0
C
C
C START START START START
C
C STEP 1. READ IN ALL .CN INPUT/OUTPUT PARAMETERS
C INCLUDING GRID SPECIFICATIONS.
C
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='U140.CN',STATUS='OLD',IOSTAT=IOS,ERR=900)
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( ).
C
CALL IPOPEN(KFILDO,'U140',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 'U365' 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 U140 ')
113 CONTINUE
C
STATE='115 '
READ(KFILDI,115,IOSTAT=IOS,ERR=900,END=116)RUNID
C LESS THAN 72 CHARACTERS IS NOT CONSIDERED AN ERROR.
115 FORMAT(A72)
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
C READ AND PRINT CONTROL INFORMATION.
C AND GRID SPECIFICATIONS.
C
STATE='125 '
READ(KFILDI,125,IOSTAT=IOS,ERR=900,END=1250)
1 NPROJ,NX,NY,XLATLL,YLONLL,XMESHL,ORIENT,XLAT,MISSV,
2 ICHARS,LNGTH,INCCYL
125 FORMAT(3(I10/),2(F10.4/),F10.4/,F10.5/,F10.5/,3(I10/),I10)
GO TO 135
C INCOMPLETE CONTROL INFORMATION SHOULD BE CONSIDERED AN ERROR.
C HOWEVER, A SHORT RECORD DOES NOT CAUSE AN "END" CONDITION.
C
1250 WRITE(KFILDO,1251)
1251 FORMAT(/' **** ERROR: CONTROL INFORMATION NOT COMPLETE.'/
1 ' STOP IN INT140 AT 1251.')
STOP 1251
C
C
C INSURE THAT ICHARS GE 4 AND LE 8. IF NOT, THIS WILL CAUSE A
C PRINTING PROBLEM IN DRU140.
C
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
C
135 WRITE(KFILDO,140) NPROJ,NX,NY,XLATLL,YLONLL,XMESHL,
1 ORIENT,XLAT,L3264B,ICHARS,LNGTH,INCCYL
140 FORMAT(/,' NPROJ ',I10,' MAP PROJECTION NUMBER OF OUTPUT',
X ' AND INPUT GRID'/
2 ' NX ',I10,' NX = SIZE OF OUTPUT GRID IN X',
X ' DIRECTION IN MESH UNITS'/
3 ' NY ',I10,' NY = SIZE OF OUTPUT GRID IN Y',
X ' DIRECTION IN MESH UNITS'/
4 ' XLATLL ',F10.5,' NORTH LATITUDE OF LOWER LEFT',
X ' CORNER OF OUTPUT GRID'/
5 ' YLONLL ',F10.5,' WEST LONGITUDE OF LOWER LEFT',
6 ' CORNER OF OUTPUT GRID'/
7 ' XMESHL ',F10.2,' ACTUAL GRIDLENGTH OF OUTPUT GRID',
X ' IN METERS'/
8 ' ORIENT ',F10.5,' GRID ORIENTATION OF OUTPUT GRID'/
9 ' XLAT ',F10.5,' LATITUDE AT WHICH XMESHL APPLIES',
X ' ON OUTPUT GRID'/
A ' L3264B ',I10,' INTEGER WORD SIZE OF MACHINE'/
9 ' ICHARS ',I10,' NUMBER OF CHARACTERS FOR PRINTING',
X ' THE CALL LETTERS'/
A ' LNGTH ',I10,' LINE LENGTH IN CHARACTERS FOR',
X ' PRINTING DATA TO UNIT IP(16)'/
4 ' INCCYL ',I10,' INCREMENT IN HOURS BETWEEN',
X ' DATE/TIMES')
C
C
C CHECK THE MAP PROJECTION
C
IF((NPROJ.NE.3).AND.(NPROJ.NE.5).AND.(NPROJ.NE.7)) THEN
WRITE(KFILDO,142) NPROJ
142 FORMAT(/,' **** ERROR: A MAP PROJECTION OF',I2,' IS NOT',
1 ' SUPPORTED IN U140. USE VALUES OF 3,5 OR 7.',/,
2 ' STOP IN INT140 AT 142.')
STOP 1285
ENDIF
C
C
C
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C STEP 2. READ IN ALL NAMES OF .CN INPUT FILES
C
C
C 1. READ AND PROCESS UNIT NUMBER AND FILE NAME FOR READING
C DATE LIST. FILE WILL BE OPENED AS 'OLD', UNLESS THE
C FILE 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,150)KFILDT
150 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,154)
154 FORMAT(/' ****ERROR: CAN NOT READ NCEP DATE FILE - ',
1 'CATASTROPHIC ERROR IN INT660. STOP AT 154.')
CALL W3TAGE('INT140')
STOP 154
ENDIF
NDATES=1
IDATE(1)=NDATE
WRITE(KFILDO,155)NDATES,(IDATE(J),J=1,NDATES)
155 FORMAT(/,' ',I4,' INPUT DATE AS READ',/,(1X,10I12))
C
C 2A. READ AND PROCESS UNIT NUMBERS AND FILE NAMES FOR ALL
C SEQUENTIAL TDLPACK INPUT. FILES WILL BE OPENED AS 'OLD'.
C
CALL RDSNAM(KFILDI,KFILDO,KFILIN,NAMIN,MODNUM,JFOPEN,ND6,
1 NUMIN,'OLD','UNFORMATTED',IP,IER)
IF(IER.NE.0)ISTOP=ISTOP+1
C
IF(NUMIN.EQ.0)THEN
WRITE(KFILDO,160)NUMIN
160 FORMAT(/' ',I2,' MOS-2000 SEQUENTIAL INPUT DATA SETS.')
IF((IP(4).NE.0).AND.(IP(4).NE.1))WRITE(IP(4),160)
ELSE
WRITE(KFILDO,164)NUMIN,(KFILIN(I),MODNUM(I),NAMIN(I),I=1,NUMIN)
164 FORMAT(/' ',I2,' MODEL INPUT DATA SETS, UNITS, MODEL NUMBERS,',
1 ' AND NAMES.'/(' ',I4,I3,2X,A60))
IF((IP(4).NE.0).AND.(IP(4).NE.1)) WRITE(IP(4),164)NUMIN,
1 (KFILIN(I),MODNUM(I),NAMIN(I),I=1,NUMIN)
ENDIF
C
C 2B. READ AND PROCESS THE UNIT NUMBER AND FILE NAME FOR THE
C MOS MOS-2000 EXTERNAL RANDOM ACESS FILE. ONLY ONE IS
C ALLOWED, THE FILE WILL NOT BE OPENED
C
CALL RDSNAM(KFILDI,KFILDO,KFILRA,RACESS,IDUM,IDUM,1,NUMRA,'NOT',
1 'NOTOPENED',IP,IER)
IF(IER.NE.0) ISTOP=ISTOP+1
IF(NUMRA.EQ.0)THEN
WRITE(KFILDO,170)NUMRA
170 FORMAT(/' ',I2,' MOS-2000 RANDOM ACCESS INPUT DATA SETS.')
IF((IP(5).NE.0).AND.(IP(5).NE.1))WRITE(IP(5),170)NUMRA
ELSE
WRITE(KFILDO,174)NUMRA,KFILRA,RACESS
174 FORMAT(/,' ',I2,' MOS-2000 EXTERNAL RANDOM ACCESS DATA SETS,',
1 ' UNIT, AND NAME.',/,(' ',I4,2X,A60))
IF((IP(5).NE.0).AND.(IP(5).NE.1))WRITE(IP(5),174)NUMRA,KFILRA,
1 RACESS
ENDIF
C
C
C CHECK FOR INPUT FILE INPUT
C
IF((NUMIN.EQ.0).AND.(NUMRA.EQ.0))THEN
WRITE(KFILDO,180)NUMIN,NUMRA
180 FORMAT(/' ****ERROR: NO INPUT FILES GIVEN',/,
1 /,' ',I2,' MOS-2000 SEQUENTIAL DATA SETS, AND',
2 /,' ',I2,' MOS-2000 EXTERNAL RANDOM ACCESS DATA SETS,',
3 /,' ',' WERE CHOSEN AS INPUT DATA: STOP IN INT140 AT 180')
CALL W3TAGE('INT140')
STOP 180
ELSEIF((NUMIN.GT.0).AND.(NUMRA.GT.0))THEN
WRITE(KFILDO,181)NUMIN,NUMRA
181 FORMAT(/' ****ERROR: CAN NOT HAVE A SEQ/RAND-ACC TOGETHER',/,
1 /,' ',I2,' MOS-2000 SEQUENTIAL DATA SETS, AND',
2 /,' ',I2,' MOS-2000 EXTERNAL RANDOM ACCESS DATA SETS,',
3 /,' ',' WERE CHOSEN AS INPUT DATA: STOP IN INT140 AT 181')
CALL W3TAGE('INT140')
STOP 181
ELSEIF((NUMIN.EQ.0).AND.(NUMRA.GT.0))THEN
NUMIN = NUMRA
ENDIF
C
C
C
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C STEP 3. READ IN ALL NAMES OF .CN OUTPUT FILES
C
C
C
C 1. READ AND PROCESS UNIT NUMBER AND FILE NAME FOR GIS
C OUTPUT TEXT FILE. FILE WILL BE OPENED AS 'NEW'.
C
CALL RDSNAM(KFILDI,KFILDO,KFILGIS,OUTGIS,IDUM,IDUM,1,
1 IOUTD,'NEW','FORMATTED',IP,IER)
C
C IOUT IS THE NUMBER OF VALUES READ AND IS NOT USED.
IF(IER.NE.0)ISTOP=ISTOP+1
IF(IOUTD.EQ.0)THEN
WRITE(KFILDO,190)
190 FORMAT(/' **** WARNING: NO GIS OUTPUT DATA SET PROVIDED'/)
IF((IP(6).NE.0).AND.(IP(6).NE.1))WRITE(IP(6),190)
ELSEIF(IOUTD.NE.0)THEN
WRITE(KFILDO,195)IOUTD,KFILGIS,OUTGIS
195 FORMAT(/' ',I2,' GIS OUTPUT DATA SET,',
1 ' UNIT, AND NAME.'/(' ',I4,2X,A60))
IF((IP(6).NE.0).AND.(IP(6).NE.1))WRITE(IP(6),195)IOUTD,
1 KFILGIS,OUTGIS
ENDIF
C
C 2. READ AND PROCESS UNIT NUMBER AND FILE NAME FOR
C GRIDDED SEQUENTIAL OUTPUT. FILE WILL BE OPENED
C AS 'NEW'.
C
CALL RDSNAM(KFILDI,KFILDO,KFILGO,OUTGRD,IDUM,IDUM,1,
1 IOUTG,'NEW','UNFORMATTED',IP,IER)
C IOUT IS THE NUMBER OF VALUES READ AND IS NOT USED.
IF(IER.NE.0)ISTOP=ISTOP+1
IF(IOUTG.EQ.0)THEN
WRITE(KFILDO,200)
200 FORMAT(/' **** WARNING: NO GRIDDED SEQUENTIAL OUTPUT',
1 ' DATA SET PROVIDED'/)
IF((IP(6).NE.0).AND.(IP(6).NE.1))WRITE(IP(6),200)
ELSEIF(IOUTG.NE.0)THEN
WRITE(KFILDO,205)IOUTG,KFILGO,OUTGRD
205 FORMAT(/' ',I2,' SEQUENTIAL GRIDDED OUTPUT DATA SET,',
1 ' UNIT, AND NAME.'/(' ',I4,2X,A60))
IF((IP(6).NE.0).AND.(IP(6).NE.1))WRITE(IP(6),205)IOUTG,
1 KFILGO,OUTGRD
ENDIF
C
C 3. READ AND PROCESS UNIT NUMBER AND FILE NAME OF
C OUTPUT RANDOM ACCESS FILE.
C
CALL RDSNAM(KFILDI,KFILDO,KFILX,CFILX,IDUM,IDUM,1,IOUTJ,'NOT',
1 'FORMATTED',IP,IER)
C NOTE THAT THIS FILE IS NOT OPENED.
C
IF(IER.NE.0)ISTOP=ISTOP+1
IF(IOUTJ.EQ.0)THEN
WRITE(KFILDO,210)
210 FORMAT(/' **** WARNING: NO GRIDDED RANDOM ACCESS OUTPUT',
1 ' DATA SET PROVIDED'/)
IF((IP(6).NE.0).AND.(IP(6).NE.1))WRITE(IP(6),210)
ELSEIF(IOUTJ.NE.0)THEN
WRITE(KFILDO,215)IOUTJ,KFILX,CFILX
215 FORMAT(/' ',I2,' RANDOM ACCESS GRIDDED OUTPUT DATA SET,',
1 ' UNIT, AND NAME.'/(' ',I4,2X,A60))
IF((IP(6).NE.0).AND.(IP(6).NE.1))WRITE(IP(6),215)IOUTJ,
1 KFILX,CFILX
ENDIF
C
C 4. READ AND PROCESS UNIT NUMBERS AND FILE NAMES FOR STATION
C LIST (CALL LETTERS) AND STATION DIRECTORY WHICH HOLD
C CALL LETTERS, LATITUDE, LONGITUDE, WBAN NUMBER, ELEVATION,
C AND NAME FOR EACH POSSIBLE STATION. THIS CAN BE A
C MASTER DIRECTORY, OR BE A DIRECTORY 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,220)(KFILD(J),DIRNAM(J),J=1,2)
220 FORMAT(/,' STATION LIST AND DIRECTORY DATA SETS, UNITS AND NAMES.'
1 ,/,(' ',I4,2X,A60))
IF(N.LT.2)THEN
WRITE(KFILDO,225)
225 FORMAT(/' **** ERROR: NO STATION TABLE AND/OR INPUT STATION'/
1 ' LIST DATA SET PROVIDED STOP IN INT140 AT 225')
CALL W3TAGE('INT140')
STOP 225
ENDIF
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). THE STATIONS ARE READ IN
C GROUPS. FOR EACH GROUP, THE STATION LIST CAN BE USED AS READ,
C OR ORDERED ACCORDING TO THE STATION DIRECTORY, WHICH IS
C ALPHABETICAL BY ICAO CALL LETTERS.
C
C FOR EFFICIENCY, THE STATIONS MUST BE IN ALPHABETICAL ORDER
C
C
CALL RDSTGRID(KFILDO,IP(7),IP(8),KFILD,1,CALLML,RCCALLD,
1 NAME,NELEV,IWBAN,STALAT,STALON,IFOUND,ISTA,
2 ND1,IER)
C CCALLD( ) IS TREATED HERE AS IF IT HAD THE SAME DIMENSIONS
C AS CCALL( , ). THIS IS OK, BECAUSE ND5 IS GE ND1.
C
IF(IER.NE.0)ISTOP=ISTOP+1
C THE DIRECTORY FILE IS READ ONLY ONCE.
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
C
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C STEP 4. READ IN AND PROCESS THE PREDICTOR VARIABLE LIST
C AND THE ADJUSTED PREDICTOR VARIABLE LIST
C AND THE PREDICTOR CONSTANT FILE
C
C
C
C 1. READ AND PROCESS UNIT NUMBER AND FILE NAME FOR READING
C THE PREDICTOR (OR VARIABLE) LIST.
C
CALL RDSNAM(KFILDI,KFILDO,KFILP,PRENAM,IDUM,IDUM,1,IOUTP,'OLD',
1 'FORMATTED',IP,IER)
IF(IER.NE.0) ISTOP=ISTOP+1
IF(IOUTP.EQ.0)THEN
WRITE(KFILDO,250)
250 FORMAT(/' **** ERROR: NO PREDICTOR LIST INPUT DATA SET IS',
1 ' PROVIDED',/,' STOP IN INT140 AT 250')
CALL W3TAGE('INT140')
STOP 250
ENDIF
C
C 2. READ AND PROCESS UNIT NUMBER AND FILE NAME FOR READING
C THE ADJUSTED VARIABLE IDs FOR SELECTED VARIABLES IN
C OUTPUT GRIDDED FILE.
C
CALL RDSNAM(KFILDI,KFILDO,KFILPC,PCNAM,IDUM,IDUM,1,IOUTS,
1 'OLD','FORMATTED',IP,IER)
IF(IER.NE.0) ISTOP=ISTOP+1
IF(IOUTS.EQ.0)THEN
WRITE(KFILDO,260)
260 FORMAT(/' **** ERROR: NO ADJUSTED PREDICTOR LIST INPUT'/
1 ' DATA SET PROVIDED STOP IN INT140 AT 260')
CALL W3TAGE('INT140')
STOP 260
ENDIF
C
C 3. READ AND PROCESS UNIT NUMBER FOR THE PREDICTOR CONSTANTS
C 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(N.EQ.0)THEN
WRITE(KFILDO,261)
261 FORMAT(/' **** ERROR: NO MOS-2000 ID TABLE LIST INPUT'/
1 ' DATA SET PROVIDED STOP IN INT140 AT 261')
CALL W3TAGE('INT140')
STOP 261
ENDIF
C
CCCCCCCCCCCCCCCCCCCCCCCC
CCC 1. READ VARIABLE LIST
CCCCCCCCCCCCCCCCCCCCCCCC
IF(IOUTP.NE.0)THEN
WRITE(KFILDO,262)IOUTP,KFILP,PRENAM
262 FORMAT(/' ',I2,' INPUT PREDICTOR DATA SET,',
1 ' UNIT, AND NAME.'/(' ',I4,2X,A60))
ENDIF
CALL RDVR140(KFILDO,IP(9),IP(10),0,KFILP,KFILCP,
1 ID,IDPARS,JD,ND4,PLAIN,ISCALD,
3 NVRBL,ISTOP,IER)
IF(IER.NE.0)THEN
WRITE(KFILDO,264)
264 FORMAT(/' ****PROBLEM READING IDS:',
1 ' IT IS PRUDENT TO STOP HERE IN INT140 AT 254.')
CALL W3TAGE('INT140')
STOP 264
ENDIF
C
C TEST GRIDPOINTS IDS VALUES IN THE I OR S PART OF THE ID
C TO WARN USERS IF PREPROCESSING HAS OCCURRED.
WRITE(KFILDO,266)
266 FORMAT(/,'VARIABLES READ FROM RDVR140:')
DO 270 I=1,NVRBL
IF((IDPARS(13,I).NE.0).OR.(IDPARS(14,I).NE.0))THEN
WRITE(KFILDO,265)(ID(J,I),J=1,4)
265 FORMAT(/' **** WARNING: VARIABLE ID INDICATES ',
1 ' POSSIBLE SMOOTHING ',/,4I10)
ENDIF
WRITE(KFILDO,267)(ID(J,I),J=1,4),PLAIN(I),ISCALD(I)
267 FORMAT(4I10,2X,A32,I5)
270 CONTINUE
CCCCCCCCCCCCCCCCCCCCCCCC
CCC 2. READ ADJUSTED VARIABLE LIST
CCCCCCCCCCCCCCCCCCCCCCCC
IF(IOUTS.NE.0)THEN
WRITE(KFILDO,272)IOUTS,KFILPC,PCNAM
272 FORMAT(/' ',I2,' INPUT ADJUSTED PREDICTOR DATA SET,',
1 ' UNIT, AND NAME.'/(' ',I4,2X,A60))
ENDIF
C
C THE LIST OF ADJUSTED VARIABLE IDS IS READ
C READ THE LIST OF VARIABLES NEEDING ADJUSTING
C WILL EITHER BE THE SAME OR BE A SUBSET OF THE
C THE INPUT LIST
C
CALL RDVR140(KFILDO,IP(9),IP(10),0,KFILPC,KFILCP,
1 ID_ADJ,IDPARS,JD_ADJ,ND4,PLAIN_ADJ,
3 ISCALD_ADJ,NVRBL_ADJ,ISTOP,IER)
IF(IER.NE.0)THEN
WRITE(KFILDO,274)
274 FORMAT(/' **** ERROR: PROBLEM READING ADJUSTED IDS:',
1 ' IT IS PRUDENT TO STOP HERE IN INT140 AT 151.')
CALL W3TAGE('INT140')
STOP 274
ENDIF
WRITE(KFILDO,276)
276 FORMAT(/,'ADJUSTED VARIABLES READ FROM RDVR140:')
DO 278 I=1,NVRBL_ADJ
WRITE(KFILDO,277)(ID_ADJ(J,I),J=1,4),PLAIN_ADJ(I),
1 ISCALD_ADJ(I)
277 FORMAT(4I10,2X,A32,I5)
278 CONTINUE
C
C
C
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C STEP 5. CHECK POSSIBLE INCONSISTENCY OF INPUT UNIT NUMBERS
C WITH OTHERS USED BY THE PROGRAM. THIS SHOULD
C PROTECT THE LARGE DATA SETS IN NAMIN( ) FROM
C BEING OVERWRITTEN.
C
C
C
IF(NUMRA.EQ.0)THEN
DO 300 J=1,NUMIN
IF(KFILIN(J).NE.KFILDT .AND.
1 KFILIN(J).NE.KFILGO .AND.
2 KFILIN(J).NE.KFILX .AND.
3 KFILIN(J).NE.KFILGIS .AND.
4 KFILIN(J).NE.KFILP .AND.
5 KFILIN(J).NE.KFILDI .AND.
6 KFILIN(J).NE.KFILPC .AND.
7 KFILIN(J).NE.KFILCP) GO TO 290
WRITE(KFILDO,285)KFILIN(J),KFILDT,KFILGO,KFILX,
* KFILGIS,KFILP,KFILDI,KFILPC,KFILCP
285 FORMAT(/' **** ERROR: INCONSISTENCY IN INPUT UNIT NUMBERS',
1 ' IN KFILIN( ) WITH EITHER KFILDT,KFILGO,',
2 ' KFILX,KFILGIS,KFILP,KFILDI,OR KFILPC.'/
3 ' STOP IN INT140 AT 285',/
4 ' KFILIN(J),KFILDT,KFILGO,KFILX,',
5 'KFILGIS,KFILP,KFILDI,KFILPC,KFILCP',/,9I7)
CALL W3TAGE('INT140')
STOP 285
290 CONTINUE
300 CONTINUE
ELSEIF(NUMRA.EQ.1)THEN
IF(KFILRA.NE.KFILDT .AND.
1 KFILRA.NE.KFILGO .AND.
2 KFILRA.NE.KFILX .AND.
3 KFILRA.NE.KFILGIS .AND.
4 KFILRA.NE.KFILP .AND.
5 KFILRA.NE.KFILDI .AND.
6 KFILRA.NE.KFILPC .AND.
7 KFILIN(J).NE.KFILCP) GO TO 370
WRITE(KFILDO,350)KFILRA,KFILDT,KFILGO,KFILX,
* KFILGIS,KFILP,KFILPC,KFILCP
350 FORMAT(/' **** ERROR: INCONSISTENCY IN INPUT UNIT NUMBERS',
1 ' IN KFILRA WITH EITHER KFILDT,KFILGO,',
2 ' KFILX,KFILGIS,KFILP,KFILDI,OR KFILPC.'/
3 ' STOP IN INT140 AT 350',/
4 ' KFILRA,KFILDT,KFILGO,KFILX,',
5 'KFILGIS,KFILP,KFILDI,KFILPC,KFILCP',/,9I7)
CALL W3TAGE('INT140')
STOP 350
370 CONTINUE
ENDIF
C
C
DO 400 J=1,25
C
IF(IP(J).NE.0.AND.
1 (IP(J).EQ.KFILDT .OR.
2 IP(J).EQ.KFILP .OR.
3 IP(J).EQ.KFILPC .OR.
3 IP(J).EQ.KFILCP .OR.
4 IP(J).EQ.KFILGIS .OR.
5 IP(J).EQ.KFILX .OR.
6 IP(J).EQ.KFILRA .OR.
7 IP(J).EQ.KFILDI .OR.
8 IP(J).EQ.KFILGO))THEN
WRITE(KFILDO,390)
390 FORMAT(/' **** ERROR: INCONSISTENCY IN INPUT UNIT NUMBERS',
1 ' IN IP( ) WITH EITHER KFILDT,KFILDI,KFILRA,',
2 ' KFILP,KFILPC,KFILX,KFILGIS,KFILDI,OR KFILGO.'/
3 ' STOP IN INT140 AT 390')
CALL W3TAGE('INT140')
STOP 390
ENDIF
400 CONTINUE
C
C
C
C
C
700 RETURN
C
C ERROR STOP BELOW IS FOR ERRORS OF CONTROL INFORMATION INPUT.
900 CALL IERX(KFILDO,KFILDO,IOS,'INT140',STATE)
CALL W3TAGE('INT140')
STOP 9999
END