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