SUBROUTINE INT150(KFILDI,KFILDO,KFILIO,KFILOG,KFILOV,KFILQC,IP, 1 KFILID, 2 CCALL,NELEV,IWBAN,STALAT,STALON, 3 ISDATA,IPACK,NAME,NSTA,ND1,CCALLD,ND5, 4 ID,IDPARS,THRESH,JD,INCDD,JP,NPRED, 5 ISCALD,SMULT,SADD,ORIGIN,CINT,PLAIN,UNITS, 6 L3264B,ND4, 7 KFILIN,MODNUM,NAMIN,JFOPEN,NUMIN,ND6, 8 KFILRA,RACESS,NUMRA,OUTNAM,OUTDIS,OUTVEC,OUTQCV, 9 IDATE,NDATES,NWORK,ND8,INCCYL, A KSKIP,NSKIP,JSTOP,PXMISS,ORIENT,XLAT, B ALATL,ALONL,NXL,NYL,NXPL,NYPL, C MESHB,BMESH,MESHL,XMESHL,MESHD,DMESH,IOPTB, D IU400A,IU400B,IU400D, E IU450,IU451,IU452,IU453,IU454, F ISTOP,IER) C$$$ MAIN PROGRAM DOCUMENTATION BLOCK *** C C SUBPROGRAM: INT150 C PRGMMR: WIEDENFELD ORG: OST21 DATE: 2005-08-09 C C ABSTRACT: INT150 PERFORMS MUCH OF THE INITIALIZATION FOR U150. C C PROGRAM HISTORY LOG: C JULY 2000 GLAHN TDL LAMP-2000 C DECEMBER 2000 GLAHN ADDED DIAGNOSTIC AT 1285 C DECEMBER 2000 GLAHN CHANGED OPT( ) TO OPTB( ) C JANUARY 2001 GLAHN ADDED PRINT OF MODNUM( ) AT 142 C FEBRUARY 2001 GLAHN ADDED READING KFILOV C FEBRUARY 2001 GLAHN ADDED READING KFILQC; REMOVED C STATEMENT NUMBER 128 C FEBRUARY 2001 GLAHN ADDED READING AUGLST AND IP(8) C MARCH 2001 GLAHN ADDED DIAGNOSTIC FOR NO SUBSETTING; C ADDED KFILKY C MAY 2001 GLAHN TRUNCATED ALATL, ALONL TO THREE C DECIMAL PLACES C AUGUST 2001 GLAHN ELIMINATED AUGLST; ELIMINATED KFILCP, C KFILD FROM CALL C JANUARY 2002 GLAHN ADDED IU453 TO CALL AND READ/PRINT C JUNE 2002 GLAHN ADDED INCDD TO CALL C AUGUST 2002 GLAHN UPDATED COMMENTS REGARDING IU454 C DECEMBER 2002 RUDACK MODIFIED FORMAT STATEMENTS TO ADHERE C TO THE F90 COMPILER STANDARDS FOUND ON C THE IBM SYSTEM. C DECEMBER 2002 RUDACK MODIFIED THE CALL TO RDSNAM SO THAT THE C GRIDDED ARCHIVE FILE IS OPENED AS 'NEW' C RATHER THAN 'OLD'. C DECEMBER 2002 RUDACK ADDED INITIALIZATION LOOPS FOR ARRAYS C HOLDING INPUT FILE UNIT NUMBERS. C JULY 2004 WIEDENFELD PREPARE TO RUN FOR OPERATIONS. TOOK C OUT CALL TO RDI FOR DATE ADDED CALL TO C GET_NCEPDATE. C AUGUST 2005 WIEDENFELD MODODIFIED FOR NCEP OPERATIONS. C 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. C (INPUT) C FORT.KFILDT - UNIT NUMBER FOR READING THE DATE LIST. C (INPUT) C FORT.KFILP - UNIT NUMBER FOR READING THE VARIABLE LIST. c (INPUT) C FORT.KFILCP - UNIT NUMBER FOR VARIABLE CONSTANT FILE. C (INPUT) C C OUTPUT FILES: C FORT.KFILDO - UNIT NUMBER OF OUTPUT (PRINT) FILE. (OUTPUT) C FORT.IP(J) - UNIT NUMBERS FOR OPTIONAL OUTPUT (J=1,25) C (SEE IP( ) UNDER "VARIABLES" BELOW.) (OUTPUT) C FORT.KFILIO - UNIT NUMBER OF OUTPUT TDLPACK FILE. ZERO C MEANS OUTPUT WILL NOT BE WRITTEN. (OUTPUT) C FORT.KFILOG - UNIT NUMBER FOR DISPOSABLE TDLPACK GRIDPOINT C OUTPUT. THIS IS FOR DIFFERENT PASSES OF THE C ANALYSES AND THEIR SMOOTHINGS. (OUTPUT) C FORT.KFILOV - UNIT NUMBER OF OUTPUT VECTOR FILE CONTAINING C TOSSED OR QUESTIONABLE OBS AS MISSING. (OUTPUT) C FORT.KFILQC - UNIT NUMBER OF OUTPUT VECTOR FILE CONTAINING C QUALITY CONTROLLED OBS AFTER THE FINAL ANALYSIS C PASS. (OUTPUT) C C VARIABLES C KFILDI = UNIT NUMBER TO READ INPUT FILE 'lmp_grdmodl.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 C ALLOWS CHANGING THE "DEFAULT" PRINT FILE ON C THE FLY. OTHERWISE, ON SOME SYSTEMS, THE C OUTPUT FILE MIGHT HAVE THE SAME NAME AND BE C OVERWRITTEN. WHEN THE OUTPUT FILE IS NOT THE C ORIGINAL DEFAULT, THE NAME IS GENERATED AND C CAN BE DIFFERENT FOR EACH RUN. THIS ALLOWS C SAVING EACH OUTPUT AND NOT HAVING IT C OVERWRITTEN. (INPUT-OUTPUT) C KFILIO = UNIT NUMBER OF OUTPUT TDLPACK FILE. ZERO C MEANS OUTPUT WILL NOT BE WRITTEN. (OUTPUT) C KFILOG = UNIT NUMBER FOR DISPOSABLE TDLPACK GRIDPOINT C OUTPUT. THIS IS FOR DIFFERENT PASSES OF THE C ANALYSES AND THEIR SMOOTHINGS. (OUTPUT) C KFILOV = UNIT NUMBER OF OUTPUT VECTOR FILE CONTAINING C TOSSED OR QUESTIONABLE OBS AS MISSING. (OUTPUT) C KFILQC = UNIT NUMBER OF OUTPUT VECTOR FILE CONTAINING C QUALITY CONTROLLED OBS AFTER THE FINAL ANALYSIS C PASS. (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 C THE SAME AS ANY KFILX VALUES EXCEPT POSSIBLY C KFILDO, WHICH IS THE DEFAULT OUTPUT FILE. THIS C IS ASCII OUTPUT, GENERALLY FOR DIAGNOSTIC C PURPOSES. THE FILE NAMES WILL BE 4 CHARACTERS C 'U150', THEN 4 CHARACTERS FROM IPINIT, THEN C 2 CHARACTERS FROM IP(J) (E.G., 'U150HRG130'). C THE ARRAY IS INITIALIZED TO ZERO IN CASE LESS C THAN THE EXPECTED NUMBER OF VALUES ARE READ IN. C EACH OUTPUT ASCII FILE WILL BE TIME STAMPED. C NOTE THAT THE TIME ON EACH FILE SHOULD BE VERY C NEARLY THE SAME, BUT COULD VARY BY A FRACTION C OF A SECOND. IT IS INTENDED THAT ALL ERRORS C BE INDICATED ON THE DEFAULT, SOMETIMES IN C ADDITION TO BEING INDICATED ON A FILE WITH A C SPECIFIC IP( ) NUMBER, SO THAT THE USER WILL C NOT MISS AN ERROR. NOTE THAT SUBROUTINE C IPRINT SETS IP(J) = 0 WHEN IUSE(J) = 0. IF C IP(J) WAS READ AS NON ZERO, A FILE WITH C UNIT NUMBER IP(J) WILL HAVE BEEN OPENED, BUT C WILL NOT BE TIME STAMPED. 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 C ONLY) WHEN THE STATION LIST IS NOT FROM C THE DIRECTORY (I.E., KFILD(1) NE KFILD(2)). C HOWEVER, IF THERE ARE INPUT ERRORS, THE C STATION LIST WILL ALWAYS BE WRITTEN TO THE C DEFAULT OUTPUT FILE UNIT KFILDO AS WELL AS C TO UNIT IP(4). C (5) = THE STATIONS AND STATION DIRECTORY C INFORMATION IN THE ORDER TO BE DEALT WITH C IN U150. THE STATIONS WILL BE IN C ALPHABETICAL ORDER WHEN NALPH = 1, PROVIDED C THE DIRECTORY IS; WHEN NALPH NE 1, THE ORDER C IS AS READ. IF THERE ARE INPUT ERRORS, THE C STATION LIST WILL BE WRITTEN TO THE DEFAULT C OUTPUT FILE UNIT KFILDO AS WELL AS TO UNIT C IP(5). C (6) = THE VARIABLES AS THEY ARE BEING READ IN. C THIS IS GOOD FOR CHECKOUT; FOR ROUTINE C OPERATION, IP(7), 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 C IDPARS( , ). C (8) = THE INPUT CONTROL FILE NAMES AND C THE AUGMENTED ID LIST. 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 C KFILCP. C (10) = INDICATES WHETHER (>1) OR NOT (=0) THE C LIST OF FIELDS READ FOR DAY 1 WILL BE C PRINTED TO THE FILE WHOSE UNIT NUMBER IS C IP(10). C (11) = INDICATES WHETHER (>0) OR NOT (=0) C THE VARIABLE ID'S OF THE ARCHIVED FIELDS C ACTUALLY NEEDED, IN ORDER AS THEY APPEAR ON C THE THE FIRST DAY OF THE ARCHIVE FILES C WILL BE PRINTED. THIS IS THE CONTENTS OF C MSTORE( , ). C (12) = INDICATES WHETHER (>1) OR NOT (=0) THE C LIST OF STATIONS ON THE INPUT FILES WILL BE C PRINTED TO THE FILE WHOSE UNIT NUMBER IS C IP(12). SINCE HOURLY DATA WILL PROBABLY C BE READ AND THE STATION LIST CHANGES C HOURLY, THIS CAN BE VOLUMINOUS OUTPUT. C THE PRINT OCCURS IN SUBROUTINE FINDST. C FINDST ALSO PRINTS A LIST OF STATIONS C NOT FOUND ON THE INPUT FILE (EACH HOUR C READ) UNLESS COMPILED WITH /D OPTION. C (13) = INDICATES WHETHER (>0) OR NOT (=0) C THE CONTENTS OF LSTORE( , ) WILL BE C WRITTEN TO UNIT IP(13) AFTER COMPRESSION C AFTER EACH DAY NUMBER (CYCLE) LE LSTPRT, C WHICH IS SET IN DATA STATEMENT. C (14) = INDICATES WHETHER (>0) OR NOT (=0) A C DIAGNOSTIC WILL BE PROVIDED ON UNIT IP(14) C WHEN THERE ARE NO DATA FOR A DESIRED C DATE/TIME ON A PARTICULAR INPUT FILE. C THIS MIGHT HAPPEN FOR EACH DATE/TIME AND C A LOT OF OUTPUT BE CREATED. C (15) = INDICATES WHETHER (>0) OR NOT (=0) A C LIST OF THE X AND Y POSITIONS OF THE STATIONS C FOR THE BASIC LAMP GRID WILL BE PROVIDED ON C IP(15). C (16) = INDICATES WHETHER (>0) OR NOT (=0) C A STATEMENT WILL BE OUTPUT TO IP(16) C WHEN A SEQUENTIAL FILE IS WRITTEN THROUGH C PAWOTG. C (17) = INDICATES WHETHER (>0) OR NOT (=0) A C LISTING OF STATIONS, THEIR X/Y POSITIONS, C THEIR DATA VALUES, AND LTAGS WILL BE WRITTEN C AT THE END OF SUBROUTINE ESP TO IP(17). C (18) = INDICATES WHETHER (>0) OR NOT (=0) THE C AVERAGE DEGREE OF FIT BETWEEN THE DATA C AND THE ANALYSIS WILL BE WRITTEN TO IP(18). C IN ADDITION, WITH THE /D COMPILER OPTION, A C LISTING OF STATIONS, THEIR X/Y POSITIONS, C DATA VALUES, LTAGS, ANALYSIS (INTERPOLATED) C VALUES, AND DIFFERENCES BETWEEN THE DATA C AND THE ANALYSIS VALUES WILL BE WRITTEN C IN SUBROUTINE ESP TO IP(18). C (19) = SAME AS (18) EXCEPT IT APPLIES TO THE C SMOOTHED ANALYSIS. IF THE ANALYSIS IS NOT C SMOOTHED, IP19 IS NOT WRITTEN TO. C (20) = INDICATES WHETHER (>0) OR NOT (=0) A C LISTING OF STATIONS, THEIR X/Y POSITIONS, C DATA VALUES, LTAGS, ANALYSIS (INTERPOLATED) C VALUES, AND DIFFERENCES BETWEEN THE DATA C AND THE ANALYSIS VALUES WILL BE WRITTEN C IN SUBROUTINE BCD TO IP(20) FOR ONLY C THE SUBSETTED AREA FOR GRIDPRINTING. C IF IOPT( ) IS NOT USED, IP(20) IS NOT C ACTIVATED. C (21) = INDICATES WHETHER (>0) OR NOT (=0) THE C AVERAGE DEGREE OF FIT BETWEEN THE DATA AND C THE ANALYSIS WILL BE WRITTEN TO UNIT IP(21) C FOR THE UNSMOOTHED AND, IF SMOOTHED, THE C SMOOTHED ANALYSIS. THIS PRODUCES ONLY C ONE LINE PER PASS FOR EACH ANALYSIS BEING C DONE (E.G., U400A, U400B, ETC.) C (22) = UNIT NUMBER OF GRIDPRINTED MAPS, IF C OTHER THAN KFILDO. OPTIONAL PRINTING C IS INDICATED IN ROUTINES. C (23) = INDICATES WHETHER (>0) OR NOT (=0) C STATEMENTS ABOUT EOF AND FILE OPENINGS C AND CLOSINGS WILL BE OUTPUT FOR PRINTING C ON UNIT IP(23). C (OUTPUT) C KFILID = UNIT NUMBER SET = KFILP. USED IN AUGIDS C CALLED FROM U150. (OUTPUT) C IPINIT = 4 CHARACTERS, USUALLY A USER'S INITIALS PLUS C A RUN NUMBER, TO APPEND TO 'U150' TO IDENTIFY C A PARTICULAR SEGMENT OF OUTPUT INDICATED BY A C SUFFIX IP(J). THE RUN NUMBER ALLOWS MULTIPLE C RUNS OF U150 AND WRITING OF UNIQUELY NAMED C FILES, PROVIDED THE USER USES A DIFFERENT RUN C NUMBER FOR EACH RUN. (CHARACTER*4) (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 RDSTAL TO KEEP TRACK OF THE STATIONS C FOUND IN THE DIRECTORY (K=1,NSTA). (INTERNAL) C IPACK(K) = USED IN RDSTAL AND RDSTAD (K=1,NSTA). C (INTERNAL) 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 IS C USED IN RDSTAL AND RDSTAD . (CHARACTER*8) C (INTERNAL) C ND5 = DIMENSION OF CCALLD( ). (INPUT) C ID(J,N) = THE INTEGER VARIABLE ID'S (J=1,4) (N=1,NPRED). C (OUTPUT) C IDPARS(J,N) = THE PARSED, INDIVIDUAL COMPONENTS OF THE C VARIABLE ID'S CORRESPONDING TO ID( ,N) C (J=1,15), (N=1,NPRED). (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 C THRESHOLD TRESHL = 1, C 2 = CUMULATIVE FROM BELOW, VALUES LT UPPER C THRESHOLD TRESHU = 1. C 3 = DISCRETE BINARY. VALUES GE LOWER C THRESHOLD AND LT UPPER THRESHOLD = 1. C 5 = GRID BINARY. VALUES GE LOWER THRESHOLD C ONLY THE VALUE OF 0, 1, OR 5 SHOULD BE USED C FOR 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 C 1 LAYER), C J=7--LTLTLTLT (TOP OF LAYER), C J=8--T (TRANSFORMATION), C J=9--RR (RUN TIME OFFSET, ALWAYS + AND BACK C 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 G WILL BE 0 ON INPUT. U150 USES OTHER C VALUES INTERNALLY (ONLY) TO INDICATE C GRID LENGTH. C (OUTPUT) C THRESH(N) = THE UPPER BINARY THRESHOLD CORRESPONDING TO C IDPARS( ,N) (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 PORTIONS C PERTAINING TO PROCESSING ARE OMITTED: C B = IDPARS(3, ), C T = IDPARS(8,), C I = IDPARS(13, ), C S = IDPARS(14, ), C G = IDPARS(15, ), AND C THRESH( ). C JD( , ) IS USED TO IDENTIFY THE BASIC MODEL FIELDS C AS READ FROM THE ARCHIVE. (OUTPUT) C JD(J,N) = THE BASIC INTEGER VARIABLE ID'S (J=1,4) C (N=1,ND4). THIS IS THE SAME AS ID(J,N), C EXCEPT THAT THE FOLLOWING 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 U150, WHICH IS ONLY C FORMING BINARIES. (ACTUALLY T, I, AND S ARE C ALSO OMITTED BUT NOT USED IN U150.) (OUTPUT) C JP(J,N) = INDICATES WHETHER A PARTICULAR VARIABLE N MAY C HAVE GRIDPRINTS (J=1), INTERMEDIATE TDLPACK C OUTPUT (J=2), OR PRINT OF VECTOR RECORDS IN C PACKV (J=3) (N=1,ND4). PACKV IS FOR THE C DATA SHOWING T0SSED DATA AS MISSING AND C QUESTIONABLE DATA AS MISSING. THIS IS C AN OVERRIDE FEATURE FOR THE PARAMETERS FOR C GRIDPRINTING AND TDLPACKING IN EACH VARIABLE'S C CONTROL FILE. (OUTPUT) C NPRED = THE NUMBER OF ENTRIES IN ID( , ), ETC. WHILE C THIS NAME, USED IN U201, IS NOT VERY DESCRIPTIVE C FOR U150, IT IS USED TO BE CONSISTENT WITH C OTHER SOFTWARE. (OUTPUT) C ISCALD(N) = THE DECIMAL SCALING CONSTANT TO USE WHEN PACKING C THE COLLATED DATA (N=1,ND4). ISCALD COMES FROM C THE VARIABLE CONSTANT FILE, MODIFIED TO BE 2 FOR C GRID BINARIES, AND 0 FOR BINARIES. ZERO WHEN C NOT FOUND IN THE FILE. NO BINARY SCALING IS C PROVIDED FOR. (OUTPUT) C SMULT(N) = THE MULTIPLICATIVE FACTOR WHEN CONTOURING OR C GRIDPRINTING THE DATA (N=1,ND4). C TAKEN FROM THE VARIABLE CONSTANT FILE. (OUTPUT) C SADD(N) = THE ADDITIVE FACTOR WHEN CONTOURING OR C GRIDPRINTING THE DATA (N=1,ND4). C TAKEN FROM THE VARIABLE CONSTANT FILE. (OUTPUT) C ORIGIN(N) = THE CONTOUR ORIGIN, APPLIES TO THE UNITS IN C UNITS(N) (N=1,ND4). C TAKEN FROM THE VARIABLE CONSTANT FILE. (OUTPUT) C CINT(N) = THE CONTOUR INTERVAL, APPLIES TO THE UNITS IN C UNITS(N) (N=1,ND4). C TAKEN FROM THE VARIABLE CONSTANT FILE. (OUTPUT) C PLAIN(N) = THE PLAIN LANGUAGE DESCRIPTION OF THE VARIABLES C (N=1,ND4). (CHARACTER*32) (OUTPUT) C TAKEN FROM THE VARIABLE CONSTANT FILE. (OUTPUT) C UNITS(N) = THE UNITS OF THE DATA THAT APPLY AFTER C MULTIPLYING BY SMULT(N) AND ADDING SADD(N) C (N=1,ND4). TAKEN FROM THE VARIABLE CONSTANT FILE. C (CHARACTER*12) (OUTPUT) C L3264B = INTEGER WORD LENGTH IN BITS OF MACHINE BEING C USED (EITHER 32 OR 64). (INPUT) C ND4 = MAXIMUM NUMBER OF VARIABLES THAT CAN BE DEALT C WITH IN ONE RUN. SECOND DIMENSION OF ID( , ), C IDFORC( , ) JD( , ), JP( , ), AND IDPARS( , ) C AND DIMENSION OF THRESH( ), PLAIN( ) UNITS( ), C ORIGIN( ), CINT( ), SMULT( ), AND SADD( ). C (INPUT) C KFILIN(J) = UNIT NUMBERS FOR INPUT DATA, ALL IN TDL MOS-2000 C FORMAT (J=1,ND6). C UNIT NUMBERS GE 80 ARE RESERVED FOR GRID DATA; C UNIT NUMBERS LT 80 ARE RESERVED FOR VECTOR DATA. C (OUTPUT) C MODNUM(J) = THE "MODEL" NUMBER CORRESPONDING TO KFILIN(J), C AND NAMIN(J) (J=1,ND6). FOR VECTOR DATA, C MODDUM( ) = 0. (OUTPUT) C NAMIN(J) = HOLDS DATA SET NAMES FOR THE UNIT NUMBERS C IN KFILIN(J) (J=1,ND6). (CHARACTER*60) C (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). C (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,6). C THE ACCESS ROUTINES ALLOW 6 RANDOM ACCESS C FILES. HOWEVER, IT UNLIKELY U150 WILL NEED C MORE THAN 1 OR 2. (OUTPUT) C RACESS(J) = FILE NAMES FOR CONSTANT DATA READ ON UNIT C NOS. KFILRA(J) (J=1,6). (CHARACTER*60) C (OUTPUT) C NUMRA = NUMBER OF VALUES IN KFILRA( ) AND RACESS( ). C (OUTPUT) C OUTNAM = NAME OF DATA SET FOR OUTPUT GRIDS. C (CHARACTER*60) (OUTPUT) C OUTDIS = NAME OF DATA SET FOR DISPOSABLE GRIDS IN TDLPACK C FORMAT. (CHARACTER*60) (OUTPUT) C OUTVEC = NAME OF DATA SET FOR VECTOR DATA IN TDLPACK C FORMAT. (CHARACTER*60) (OUTPUT) C IDATE(J) = INITIAL DATE LIST (J=1,NDATES) WHICH MAY CONTAIN C NEGATIVE VALUES INDICATING A DATE SPAN. THIS C 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 INCCYL = THE NUMBER OF HOURS BETWEEN DATES WHEN DATE C SPANNING IS USED. (INTERNAL/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 NSKIP = THE NUMBER OF ERRORS THAT WILL BE TOLERATED ON C DAY 1 WITHOUT HALTING. (OUTPUT) C JSTOP = THE NUMBER OF ERRORS THAT WILL BE TOLERATED ON C THE 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 ORIENT = ORIENTATION OF GRID IN WEST LONGITUDE. (INPUT) C XLAT = NORTH LATITUDE AT WHICH GRIDLENGTH IS SPECIFIED. C (INPUT) C ALATL = NORTH LATITUDE OF LOWER LEFT CORNER POINT C OF A 1/4 B GRID OF THE SIZE ETC. SPECIFIED C BY NXL, NYL, NXPL, AND NYPL. CALCULATED WITH C IJLLPS AND TRUNCATED TO THOUSANDTHS OF DEGREES C TO AGREE WITH AVN ARCHIVE. (OUTPUT) C ALONL = WEST LONGITUDE OF LOWER LEFT CORNER POINT C OF A 1/4 B GRID OF THE SIZE ETC. SPECIFIED C BY NXL, NYL, NXPL, AND NYPL. CALCULATED WITH C IJLLPS AND TRUNCATED TO THOUSANDTHS OF DEGREES C TO AGREE WITH AVN ARCHIVE. (OUTPUT) C NXL = THE SIZE OF THE PRIMARY GRID FOR THIS RUN C IN THE X DIRECTION AT ONE-QUARTER BEDIENT C MESH LENGTH. (OUTPUT) C NYL = THE SIZE OF THE PRIMARY GRID FOR THIS RUN C IN THE Y DIRECTION AT ONE-QUARTER BEDIENT C MESH LENGTH. (OUTPUT) C NXPL = POLE POSITION OF THE PRIMARY GRID FOR THIS RUN C IN RELATION TO LOWER LEFT CORNER OF GRID AT C (1,1) IN THE X DIRECTION. (OUTPUT) C NYPL = POLE POSTION OF THE PRIMARY GRID FOR THIS RUN C IN RELATION TO LOWER LEFT CORNER OF GRID AT C (1,1) IN THE Y DIRECTION. (OUTPUT) C MESHB = THE NOMINAL MESH LENGTH OF 1/4 BEDIENT GRID. C 1/4 BEDIENT AT 60 N IS 95.25 KM WHICH IS ABOUT C 80 KM OVER THE U.S. MESH = 80 CORRESPONDS TO C 95.25 STORED WITH THE GRIDS. NXL, NYL, ETC. C ARE IN RELATION TO THIS. (INPUT) C BMESH = ACTUAL MESH LENGTH CORRESPONDING TO MESHB. C (OUTPUT) C MESHL = NOMINAL MESH LENGTH OF QUALITY CONTROL C (SUBSETTED) GRID FOR CONTINUOUS VARIABLES. C (OUTPUT) C XMESHL = ACTUAL MESH LENGTH CORRESPONDING TO MESHL. C (OUTPUT) C MESHD = NOMINAL MESH LENGTH OF QUALITY CONTROL C (SUBSETTED) GRID FOR DISCONTINUOUS VARIABLES. C (OUTPUT) C DMESH = ACTUAL MESH LENGTH CORRESPONDING TO MESHD. C (OUTPUT) C IOPTB(J) = SUBSETTING VALUES USED IN GRIDPRINTING (J=1,8) C IN RELATION TO THE QUARTER BEDIENT MESHB. C INITIALIZED FROM NXGMIN, ETC. (OUTPUT) C IU400A = 1 INDICATES TO RUN U400A; 0 OTHERWISE. (OUTPUT) C IU400B = 1 INDICATES TO RUN U400B; 0 OTHERWISE. (OUTPUT) C IU400D = 1 INDICATES TO RUN U400D; 0 OTHERWISE. (OUTPUT) C IU450 = 1 INDICATES TO RUN U450; 0 OTHERWISE. (OUTPUT) C IU451 = 1 INDICATES TO RUN U451; 0 OTHERWISE. (OUTPUT) C IU452 = 1 INDICATES TO RUN U452; 0 OTHERWISE. (OUTPUT) C IU453 = 1 INDICATES TO RUN U453; 0 OTHERWISE. (OUTPUT) C IU454 = 1 INDICATES TO RUN U454; 2 TO RUN U455; C 0 OTHERWISE. (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. C (INTERNAL) C DATNAM = FILE NAME FOR READING DATE LIST. CORRESPONDS C TO KFILDT. (CHARACTER*60) (INTERNAL) C KFILCP = UNIT NUMBER FOR VARIABLE CONSTANT FILE. THIS C CONTAINS DEFAULT VALUES FOR CERTAIN CONSTANTS C FOR BASIC NMC VARIABLES AND OTHER VARIABLES C SANS THRESHOLDS, ETC. THESE INCLUDE PACKING C CONSTANTS, GRIDPOINT CONSTANTS, AND NAMES. C (OUTPUT) C KFILD(J) = THE UNIT NUMBERS FOR WHERE THE STATION LIST C (J=1) 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 C NOT PROVIDED). (INTERNAL) C KFILP = UNIT NUMBER FOR READING THE VARIABLE LIST. C THESE ARE THE VARIABLES FOR WHICH ANALYSES C OR MODEL RESULTS ARE TO BE CALCULATED. C (OUTPUT) C PRENAM = HOLDS DATA SET NAME FOR THE UNIT NUMBER C FOR THE VARIABLE LIST. CORRESPONDS TO C KFILP. (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 CONNAM = HOLDS DATA SET NAME FOR THE VARIABLE CONSTANT C FILE. CORRESPONDS TO KFILCP. (CHARACTER*60) C (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) C (INTERNAL) C NEW = 1 WHEN NEW 4-LETTER CALL LETTERS ARE TO BE C USED; C 0 WHEN OLD 3-LETTER CALL LETTERS ARE TO BE C USED. C (INTERNAL) C NALPH = 1 WHEN THE CALL STATIONS USED ARE TO BE C ALPHABETIZED, OR MORE EXACTLY, PUT C IN THE ORDER THEY EXIST IN THE STATION C 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, IUSE(J) = 1; C OTHERWISE, IUSE(J) = 0. USED BY IPRINT TO C PRINT IP( ) VALUES. NOTE THAT SUBROUTINE C IPRINT SETS IP(J) = 0 WHEN IUSE(J) = 0. IF C IP(J) WAS READ AS NON ZERO, A FILE WITH C UNIT NUMBER IP(J) WILL HAVE BEEN OPENED, BUT C WILL NOT BE TIME STAMPED. (INTERNAL) C NXGMIN = THE MINIMUM NX VALUE FOR GRIDPRINTING. C IOPT( ) IN PRTGR ALLOWS SUBSETTING OF THE C ANALYSIS AREA FOR GRIDPRINTING. THIS APPLIES C TO THE LAMP GRID BEING DEALT WITH, WHICH WAS C SPECIFIED IN TERMS OF A NOMINAL 80-KM GRID. C THE GRIDPRINTED MAP WILL ALWAYS BE OVER THIS C SUBSETTED AREA AT THE MESH LENGTH MESHL, NO C MATTER WHAT THE MESH LENGTH IS OF THE MAP C GRIDPRINTED. THIS MAY MEAN INTERPOLATING OR C THINNING BEFORE GRIDPRINTING. (INTERNAL) C NXGMAX = THE MAXIMUM NX VALUE FOR GRIDPRINTING. C SEE NXGMIN( ). (INTERNAL) C NYGMIN = THE MINIMUM NY VALUE FOR GRIDPRINTING. C SEE NXGMIN( ). (INTERNAL) C NYGMAX = THE MAXIMUM NY VALUE FOR GRIDPRINTING. C SEE NXGMIN( ). (INTERNAL) C KFILKY = WHEN 0, KFILOG WILL BE SET TO 0, INDICATING C NO SUBSET WRITING. DO THIS WHEN SUBSET AREA C IS INCONSISTENT. C INCDD = INCREMENT TO ADD TO LAMPNO FOR WRITING FORECAST. C C SUBPROGRAMS CALLED: C IPOPEN, IERX, DATPRO, RDI, RDSNAM, RDSTAL, RDSTAD, RDLVRB, C TIMPR C UNIQUE - NONE C MOSLIB - IPOPEN, IERX, DATPRO, RDI, RDSTAL, RDSTAD, TIMPR, C RDLVRB C LMPlIB - NONE C C EXIT STATES: C COND = 0 - SUCCESSFUL RUN C 133 - CANNOT OPEN NCEP DATE FILE. C 135 - CANNOT READ NCEP DATE FILE. C 158 - NO PREDICTORS OR PREDICTANDS IN LIST. C (PROBLEM WITH ID LIST) C 165 - INCONSISTENCY BETWEEN UNIT NUMBERS FOR C KFILIN() AND ALL OF THE OTHER UNIT NUMBERS C 1575 - FATAL ERROR IN RDLVRB C 1595 - SEA LEVEL PRESSURE ID IS IN ID LIST C BEFORE SAT DEFICT ID. C 1605 - INCONSISTENCY BETWEEN UNIT NUMBERS FOR C KFILDI AND EITHER KFILDO OR KFILIO C 1606 - INCONSISTENCY BETWEEN UNIT NUMBERS FOR C KFILP AND KFILDO OR KFILIO. C 1607 - INCONSISTENCY BETWEEN UNIT NUMBERS FOR C KFILCP AND KFILDO OR KFILIO. C 9999 - CANNOT OPEN THE CONTROL lmp_grdmodl.cn C C 1 2 3 4 5 6 7 X C CHARACTER*4 STATE,IPINIT CHARACTER*8 CCALL(ND1,6) CHARACTER*8 CCALLD(ND5) CHARACTER*12 UNITS(ND4) CHARACTER*20 NAME(ND1) CHARACTER*32 PLAIN(ND4) CHARACTER*60 NAMIN(ND6),RACESS(6) CHARACTER*60 DIRNAM(2),PRENAM,CONNAM,DATNAM,OUTNAM,OUTDIS, 1 OUTVEC,OUTQCV CHARACTER*72 RUNID/' '/ C DIMENSION NELEV(ND1),IWBAN(ND1),STALAT(ND1),STALON(ND1), 1 ISDATA(ND1) DIMENSION ID(4,ND4),IDPARS(15,ND4),THRESH(ND4),JD(4,ND4), 1 JP(3,ND4),ISCALD(ND4), 2 SMULT(ND4),SADD(ND4),ORIGIN(ND4),CINT(ND4) DIMENSION IPACK(ND5) DIMENSION KFILIN(ND6),MODNUM(ND6),JFOPEN(ND6) DIMENSION IDATE(ND8),NWORK(ND8) DIMENSION ITEMP(7),IP(25),IUSE(25),KFILD(2),KFILRA(6),IOPTB(8) C DATA IUSE/1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,0/ C C INITIALIZE ARRAYS HOLDING FILE UNIT NUMBERS. C DO 98 J=1,ND6 KFILIN(J)=0 98 CONTINUE C DO 99 J=1,6 KFILRA(J)=0 99 CONTINUE C DO 100 J=1,2 KFILD(J)=0 100 CONTINUE 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='U150.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,'U150',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 'U150' 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) C C PRINT THE IP VALUES. WHEN IUSE(J) = 0, THE CORRESPONDING C IP(J) VALUE IS CONSIDERED TO NOT BE USED, AND IP(J) IS C SET TO 0. IF IP(J) WAS READ AS NON ZERO, THE FILE WITH C THAT UNIT NUMBER HAS BEEN OPENED IN IPOPEN, BUT WILL C NOT BE TIME STAMPED BELOW, BECAUSE IP(J) IS NOW ZERO. C 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 U150 ') 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,NSKIP,JSTOP,INCCYL,NEW,NALPH,PXMISS, 2 NXL,NYL,NXPL,NYPL,MESHL,MESHD, 3 NXGMIN,NXGMAX,NYGMIN,NYGMAX, 4 IU400A,IU400B,IU400D, 5 IU450,IU451,IU452,IU453,IU454,INCDD 125 FORMAT(6(I10/),F10.0/18(I10/),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. KSKIP REFERS TO THE OUTPUT SEQUENTIAL C FILE. 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 GET TRUE MESH LENGTH, BASED ON NOMINAL VALUE MESHL C OF THE BASIC LAMP GRID AND THE GRID FOR DISCONTINUOUS C VARIABLES. C 1257 CALL MSHXMS(KFILDO,MESHL,TRASH,XMESHL) CALL MSHXMS(KFILDO,MESHD,TRASH,DMESH) CALL MSHXMS(KFILDO,MESHB,TRASH,BMESH) C C COMPUTE THE LOWER LEFT CORNER LATITUDE AND LONGITUDE BASED ON C NXPL AND NYPL OF THE POLE POSITION OF A POLAR STEREOGRAPHIC C MAP PROJECTION ORIENTED AT ORIENT ON 1/4 B GRID. NOTE THAT C NXPL AND NYPL ARE INPUT ACCORDING TO A 1/4 B GRID, NO MATTER C WHAT THE FINAL GRID MESH LENGTH MESHL IS. MESHB IS THE C NOMINAL QUARTER BEDIENT MESH LENGTH; BMESH IS THE ACTUAL. C CALL IJLLPS(1.,1.,BMESH,ORIENT,XLAT,FLOAT(NXPL),FLOAT(NYPL), 1 ALATL,ALONL) ALATL=NINT(ALATL*1000)/1000. ALONL=NINT(ALONL*1000)/1000. C RESOLUTION OF LL LAT/LON IS ONLY TO THOUSANDTHS OF DEGREES C TO AGREE WITH TDLPACK ARCHIVES (E.G., AVN ARCHIVE). C THEN THE OUTPUT GRIDS, IF OVER THE SAME AREA, WILL C AGREE WITH THE ARCHIVE. THIS MAKES A DIFFERENCE OF ONLY C A FEW TENS OF FEET IN LOCATION. C WRITE(KFILDO,128)KSKIP,NSKIP,JSTOP,INCCYL,NEW,NALPH, 1 PXMISS,L3264B, 2 ALATL,ALONL,NXL,NYL,NXPL,NYPL,MESHB,MESHL,XMESHL, 3 MESHD,DMESH, 4 IU400A,IU400B,IU400D,IU450,IU451,IU452,IU453,IU454,INCDD 128 FORMAT(/' KSKIP ',I10,' SKIP PAST THIS DATE ON OUTPUT FILE'/ 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 ' INCCYL',I10,' INCREMENT IN HOURS BETWEEN DATE/TIMES'/ 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 ' L3264B',I10,' INTEGER WORD SIZE OF MACHINE'/ 9 ' ALATL ',F10.4,' NORTH LATITUDE OF LOWER LEFT CORNER', X ' OF LAMP GRID'/ A ' ALONL ',F10.4,' WEST LONGITUDE OF LOWER LEFT CORNER', X ' OF LAMP GRID'/ B ' NXL ',I10,' NXL = SIZE OF LAMP GRID IN X DIRECTION', X ' IN 1/4 B UNITS'/ C ' NYL ',I10,' NYL = SIZE OF LAMP GRID IN Y DIRECTION', X ' IN 1/4 B UNITS'/ D ' NXPL ',I10,' NXPL = POLE POSITION OF LAMP GRID IN X', X ' DIRECTION IN 1/4 B UNITS'/ E ' NYPL ',I10,' NYPL = POLE POSTION OF LAMP GRID IN Y', X ' DIRECTION IN 1/4 B UNITS'/ F ' MESHB ',I10,' NOMINAL GRIDLENGTH OF A QUARTER', X ' BEDIENT GRID'/ G ' MESHL ',I10,' NOMINAL GRIDLENGTH OF QUALITY CONTROL', X ' GRID FOR CONTINUOUS VARIABLES'/ H ' XMESHL',F10.5,' ACTUAL GRIDLENGTH CORRESPONDING TO', X ' MESHL'/ I ' MESHD ',I10,' NOMINAL GRIDLENGTH OF QUALITY CONTROL', X ' GRID FOR DISCONTINUOUS VARIABLES'/ J ' DMESH ',F10.5,' ACTUAL GRIDLENGTH CORRESPONDING TO', X ' MESHD'/ K ' IU400A',I10,' RUNNING U400A'/ L ' IU400B',I10,' RUNNING U400B'/ M ' IU400D',I10,' RUNNING U400D'/ N ' IU450 ',I10,' RUNNING U450'/ O ' IU451 ',I10,' RUNNING U451'/ P ' IU452 ',I10,' RUNNING U452'/ P ' IU453 ',I10,' RUNNING U453'/ Q ' IU454 ',I10,' RUNNING U454, U455, OR U456'/ R ' INCDD ',I10,' INCREMENT FOR LAMPNO FOR FORECASTS') C CALL CHKSIZ(KFILDO,MESHL,NXL,NYL,NXPL,NYPL,ISTOP) C C SET IOPTB( ). C IF(NXGMIN.GT.0.AND.NXGMIN.LE.NXL.AND. 1 NYGMIN.GT.0.AND.NYGMIN.LE.NYL.AND. 2 NXGMAX.GT.0.AND.NXGMAX.LE.NXL.AND. 3 NYGMAX.GT.0.AND.NYGMAX.LE.NYL)THEN C IF THESE ARE INCONSISTENT OR IMPLY NO SUBSETTING C (E.G., MXGMIN = 0), THEN IOPTB( ) DEFAULTS TO ZERO, C AS SET IN DATA STATEMENT. IOPTB(6) DEFINES C LINEAR INTERPOLATION BETWEEN GRIDPOINTS FOR C DETERMINING THE ZEBRA STRIPES. THE DEFAULT C VALUES OF IOPTB( ) ARE SET TO ZERO IN U150. IOPTB(1)=1 IOPTB(2)=NXGMIN IOPTB(3)=NXGMAX IOPTB(4)=NYGMIN IOPTB(5)=NYGMAX IOPTB(6)=1 KFILKY=1 ELSE C IF(NXGMIN.NE.0)THEN WRITE(KFILDO,1285)NXGMIN,NXGMAX,NYGMIN,NYGMAX 1285 FORMAT(/' ****SUBSETTING VALUES INCONSISTENT', 1 ' WITH LAMP GRID.', 2 ' NXGMIN, NXGMAX, NYGMIN, NYGMAX ARE',4I7/ 3 ' DISPOSABLE GRIDS WILL NOT BE WRITTEN,', 4 ' AND STATISTICS WILL NOT BE CALCULATED', 5 ' OVER A SUBSETTED AREA.'/ 6 ' ANY GRIDPRINTS WILL BE OVER THE WHOLE', 7 ' LAMP GRID AND AT THE LAMP MESHL MESH LENGTH.') ISTOP=ISTOP+1 KFILKY=0 C KFILOG WILL BE SET TO ZERO, ELSE THERE WILL C LIKELY BE TROUBLE IN SUBROUTINE CUT. ELSE WRITE(KFILDO,1286) 1286 FORMAT(/' NO SUBSETTING OF GRIDS WILL BE DONE.') ENDIF C ENDIF C C PRINT IOPTB( ) VALUES IF OTHER THAN ZERO. C IF(IOPTB(1).EQ.0.AND.KFILKY.NE.0)THEN C WHEN THE AREA DEFINITION IS INCONSISTENT, THE PRINT BELOW C HAS ALREADY BEEN DONE. WRITE(KFILDO,1295) 1295 FORMAT(/' ANY GRIDPRINTS WILL BE OVER THE WHOLE LAMP GRID', 1 ' AND AT THE LAMP MESHL MESH LENGTH.') ELSEIF(IOPTB(1).NE.0)THEN WRITE(KFILDO,1296)(IOPTB(J),J=2,5) 1296 FORMAT(/' ANY GRIDPRINTS AND/OR TDLPACKS FOR QUALITY', 1 ' CONTROL WILL BE OVER THE AREA DEFINED'/ 2 ' BY THE GRIDPOINTS BELOW IN TERMS OF THE QUARTER', 3 ' BEDIENT GRID.'/ 4 ' ALL GRIDPRINTS AND TDLPACKS FOR CONTINUOUS', 5 ' VARIABLES WILL BE AT THE MESHL MESH LENGTH.'/ 6 ' ALL GRIDPRINTS AND TDLPACKS FOR NON-CONTINUOUS', 7 ' VARIABLES WILL BE AT THE MESHD MESH LENGTH.'/ 8 ' NXGMIN',I10,' MINIMUM NX VALUE'/ 9 ' NXGMAX',I10,' MAXIMUM NX VALUE'/ A ' NYGMIN',I10,' MINIMUM NY VALUE'/ 8 ' NYGMAX',I10,' MAXIMUM NY VALUE') ENDIF 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,DATNAM 130 FORMAT(/' DATE INPUT DATA SET, UNIT AND NAME.'/ 1 (' ',I4,2X,A60)) C C C READ AND PRINT THE DATE TO BE PROCESSED CALL GET_NCEPDATE(KFILDT,IYR,IMO,IDA,IHR,MDATE,IER) C IF(KFILDT.NE.KFILDI)CLOSE(UNIT=KFILDT) C KFILDT IS CLOSED WHEN IT IS NOT THE SAME AS THE DEFAULT C INPUT FILE. C IF(IER.NE.0)THEN WRITE(KFILDO,133) 133 FORMAT(/' ****ERROR: CAN NOT READ NCEP DATE FILE - ', 1 'CATASTROPHIC ERROR IN 201. STOP AT 134.') CALL W3TAGE('INT150') STOP 133 ENDIF C C SET NDATE TO 1 SINCE OPERATIONALLY THERE WILL NEVER BE C MORE THEN ONE DATE. C NDATES = 1 IDATE(1) = MDATE WRITE(KFILDO,134)NDATES,(IDATE(J),J=1,NDATES) 134 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 INT150 AT 135.') CALL W3TAGE('INT150') STOP 135 ENDIF C C READ AND PROCESS UNIT NUMBERS AND FILE NAMES FOR ALL TDLPACK 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(J),MODNUM(J),NAMIN(J),J=1,NUMIN) 142 FORMAT(/' ',I2,' MODEL INPUT DATA SETS, UNITS, MODEL NUMBERS,', 1 ' AND NAMES.'/(' ',I4,I3,2X,A60)) ENDIF C C READ AND PROCESS THE UNIT NUMBER AND FILE NAME FOR THE C MOS-2000 EXTERNAL RANDOM ACCESS FILE. ONLY ONE IS ALLOWED, C AND THE DEFAULT UNIT NUMBER = 95 WILL BE USED. C FILE WILL NOT BE OPENED. C CALL RDSNAM(KFILDI,KFILDO,KFILRA,RACESS,ITEMP,ITEMP,6,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 GRIDDED C OUTPUT. FILE WILL BE OPENED AS 'NEW'. C CALL RDSNAM(KFILDI,KFILDO,KFILIO,OUTNAM,IDUM,IDUM,1, 1 IOUT,'NEW','UNFORMATTED',IP,IER) C IOUT IS THE NUMBER OF VALUES READ AND IS NOT USED. 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 GRIDDED 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 NUMBER AND FILE NAME FOR DISPOSABLE C GRIDDED OUTPUT. FILE WILL BE OPENED AS 'NEW'. C CALL RDSNAM(KFILDI,KFILDO,KFILOG,OUTDIS,IDUM,IDUM,1, 1 IOUT,'NEW','UNFORMATTED',IP,IER) C IOUT IS THE NUMBER OF VALUES READ AND IS NOT USED. IF(IER.NE.0)ISTOP=ISTOP+1 IF(KFILKY.EQ.0)KFILOG=0 C IF(KFILOG.EQ.0)THEN WRITE(KFILDO,1445) 1445 FORMAT(/' NO DISPOSABLE OUTPUT DATA SET PROVIDED;', 1 ' PACKED GRIDDED OUTPUT WILL NOT BE WRITTEN.') C IF(KFILKY.EQ.0)THEN WRITE(KFILDO,1446) 1446 FORMAT(' THIS IS BECAUSE THE SUBSETTING VALUES', 1 ' PROVIDED ARE INCONSISTENT.') ENDIF C OUTDIS=' ' ELSE WRITE(KFILDO,145)KFILOG,OUTDIS 145 FORMAT(/' DISPOSABLE GRIDDED OUTPUT DATA SET, UNIT AND NAME.'/ 1 (' ',I4,2X,A60)) ENDIF C C READ AND PROCESS UNIT NUMBER AND FILE NAME FOR DISPOSABLE C VECTOR OUTPUT. FILE WILL BE OPENED AS 'NEW'. C CALL RDSNAM(KFILDI,KFILDO,KFILOV,OUTVEC,IDUM,IDUM,1, 1 IOUT,'NEW','UNFORMATTED',IP,IER) C IOUT IS THE NUMBER OF VALUES READ AND IS NOT USED. IF(IER.NE.0)ISTOP=ISTOP+1 C IF(KFILOV.EQ.0)THEN WRITE(KFILDO,146) 146 FORMAT(/' NO VECTOR OUTPUT DATA SET PROVIDED;', 1 ' VECTOR OUTPUT WILL NOT BE WRITTEN.') OUTVEC=' ' ELSE WRITE(KFILDO,1465)KFILOV,OUTVEC 1465 FORMAT(/' VECTOR OUTPUT DATA SET, UNIT AND NAME.'/ 1 (' ',I4,2X,A60)) ENDIF C C READ AND PROCESS UNIT NUMBER AND FILE NAME FOR QUALITY C CONTROLLED OBS OUTPUT. FILE WILL BE OPENED AS 'NEW'. C CALL RDSNAM(KFILDI,KFILDO,KFILQC,OUTQCV,IDUM,IDUM,1, 1 IOUT,'NEW','UNFORMATTED',IP,IER) C IOUT IS THE NUMBER OF VALUES READ AND IS NOT USED. IF(IER.NE.0)ISTOP=ISTOP+1 C IF(KFILQC.EQ.0)THEN WRITE(KFILDO,147) 147 FORMAT(/' NO QUALITY CONTROLLED OBS OUTPUT DATA SET', 1 ' PROVIDED; VECTOR OUTPUT WILL NOT BE WRITTEN.') OUTQCV=' ' ELSE WRITE(KFILDO,1475)KFILQC,OUTQCV 1475 FORMAT(/' QUALITY CONTROLLED OBS OUTPUT DATA SET,', 1 ' UNIT AND NAME.'/(' ',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. C WRITE(KFILDO,150)(KFILD(J),DIRNAM(J),J=1,2) 150 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). THE STATION LIST C CAN BE USED AS READ, OR ORDERED ACCORDING TO THE STATION C DIRECTORY, WHICH IS ALPHABETICAL BY ICAO CALL LETTERS. C NSTA=0 C IF(NALPH.EQ.0)THEN CALL RDSTAL(KFILDO,IP(4),IP(5),KFILD,NEW,CCALL, 1 NAME,NELEV,IWBAN,STALAT,STALON,ISDATA,IPACK, 2 ND1,NSTA,IER) ELSE CALL RDSTAD(KFILDO,IP(4),IP(5),KFILD,NEW,CCALL,CCALLD, 1 NAME,NELEV,IWBAN,STALAT,STALON,ISDATA,IPACK, 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. C ISDATA( ) AND IPACK( ) ARE WORK ARRAYS IN RDSTAL AND RDSTAD. ENDIF 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 READ AND PROCESS UNIT NUMBER AND FILE NAME FOR READING VARIABLE C 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 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(KFILCP.NE.0)WRITE(KFILDO,157)KFILCP,CONNAM 157 FORMAT(/' VARIABLE CONSTANT DIRECTORY, UNIT AND NAME.'/ 1 (' ',I4,2X,A60)) C C READ GRIDPOINT VARIABLE LIST FOR WHICH OUTPUT IS WANTED. C NOTE THAT THERE IS NO VECTOR OUTPUT. C CALL RDLVRB(KFILDO,IP(6),IP(7),IP(9),KFILP,KFILCP, 1 ID,IDPARS,THRESH,JD,JP,ISCALD,SMULT,SADD, 2 ORIGIN,CINT,PLAIN,UNITS,ND4,NPRED,ISTOP,IER) C NPRED IS THE NUMBER OF ANALYSES TO DO AND IS THE NUMBER C OF IDS READ INTO ID( , ). C IF(IER.NE.0)THEN C WHILE THE PROGRAM COULD PROCEED WITH IER NE 0 FROM C RDLVRB, IT IS DOUBTFUL THE RUN WOULD BE CONSIDERED C GOOD. WRITE(KFILDO,1575) 1575 FORMAT(/' FATAL ERROR IN RDLVRB.', 1 ' STOP IN INT150 AT 1575.') CALL W3TAGE('INT150') STOP 1575 ENDIF C IF(KFILP.NE.KFILDI)CLOSE(UNIT=KFILP) C FILE KFILP IS CLOSED WHEN IT IS NOT THE SAME AS C THE DEFAULT INPUT FILE. C 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 INT150 AT 158.') CALL W3TAGE('INT150') STOP 158 C ENDIF C C ENSURE THAT IF SATURATION DEFICIT IS TO BE ANALYZED, C SEA LEVEL PRESSURE IS IN THE LIST AND PRECEDES IT. C LAMP SLP PRESSURE ANALYSIS IS USED IN SD ANALYSIS. C DO 160 N=1,NPRED C IF(ID(1,N).EQ.003410005.AND.IDPARS(12,N).EQ.0)THEN C THIS MUST BE AN ANALYSIS, NOT A FORECAST. C DO 159 L=1,N-1 IF(ID(1,L).EQ.001201005.AND.IDPARS(12,L).EQ.0)GO TO 160 C THIS MUST BE AN ANALYSIS, NOT A FORECAST. 159 CONTINUE C WRITE(KFILDO,1595) 1595 FORMAT(/' ****SEA LEVEL PRESSURE CCCFFFBDD = ', 1 '001201005 WITH TAU = 0'/ 2 ' MUST PRECEED SATURATION DEFICIT CCCFFFBDD = ', 3 '003410005 WITH TAU = 0'/ 4 ' IN INPUT LIST. STOP IN INT150 AT 1595') CALL W3TAGE('INT150') STOP 1595 ENDIF C 160 CONTINUE C IF(KFILDI.EQ.KFILDO.OR. 2 KFILDI.EQ.KFILIO)THEN WRITE(KFILDO,1605) 1605 FORMAT(/' ****INCONSISTENCY IN INPUT UNIT NUMBER IN KFILDI', 1 ' WITH EITHER KFILDO OR KFILIO.'/ 2 ' STOP IN U150 AT 1605') CALL W3TAGE('INT150') STOP 1605 ENDIF C IF(KFILP.NE.0 .AND. 1 (KFILP.EQ.KFILDO.OR. 3 KFILP.EQ.KFILIO))THEN WRITE(KFILDO,1606) 1606 FORMAT(/' ****INCONSISTENCY IN INPUT UNIT NUMBER IN KFILP', 1 ' WITH EITHER KFILDO, OR KFILIO.'/ 2 ' STOP IN U150 AT 1606') CALL W3TAGE('INT150') STOP 1606 ENDIF C IF(KFILCP.NE.0 .AND. 1 (KFILCP.EQ.KFILDO.OR. 3 KFILCP.EQ.KFILIO))THEN WRITE(KFILDO,1607) 1607 FORMAT(/' ****INCONSISTENCY IN INPUT UNIT NUMBER IN KFILCP', 1 ' WITH EITHER KFILDO OR KFILIO.'/ 2 ' STOP IN U150 AT 1607') CALL W3TAGE('INT150') STOP 1607 ENDIF 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. NOTE THAT C RDSNAM HAS ALREADY CHECKED IP( ) NUMBERS WITH ANY UNIT C NUMBERS IT READS. C 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.KFILRA(6).AND. 7 KFILIN(J).NE.KFILD(1) .AND. 8 KFILIN(J).NE.KFILD(2) .AND. 9 KFILIN(J).NE.KFILP .AND. A KFILIN(J).NE.KFILCP .AND. B KFILIN(J).NE.KFILIO .AND. C KFILIN(J).NE.KFILOG .AND. D KFILIN(J).NE.KFILOV .AND. E KFILIN(J).NE.KFILQC)GO TO 170 WRITE(KFILDO,165) 165 FORMAT(/' ****INCONSISTENCY IN INPUT UNIT NUMBERS IN KFILIN( )', 1 ' WITH EITHER KFILDT, KFILRA( ), KFILD( ), KFILP,', 2 ' KFILCP, KFILOG, KFILOV, KFILQC, OR KFILIO'/ 3 ' STOP IN INT150 AT 165') CALL W3TAGE('INT150') STOP 165 C 170 CONTINUE C KFILID=KFILP C KFILID IS USED IN AUGIDS CALLED FROM U150. RETURN C C ERROR STOP BELOW IS FOR ERRORS OF CONTROL INFORMATION INPUT. 900 CALL IERX(KFILDO,KFILDO,IOS,'INT150',STATE) CALL W3TAGE('INT150') STOP 9999 END