SUBROUTINE INT755(KFILDI,KFILDO,KFILIO,KFILVO,KFILOG,KFILCP, 1 KFILOV,KFIL10,IP, 2 CCALL,ELEV,IWBAN,STALAT,STALON,ISDATA,IPACK, 3 NAME,IQUAL,LNDSEA,ITYPE,NSTA,ND1, 4 CCALLD,ND5,NAREA, 5 ID,IDPARS,THRESH,JD,JP,NCEPNO,MODNO,NPRED, 6 ISCALD,IWRITS,IWRITA,IWRITF, 7 ANLTAB,INLTAB,PLAIN,ND4, 8 L3264B,KFILIN,MODNUM,NAMIN,JFOPEN,NUMIN,ND6, 9 KFILRA,RACESS,NUMRA,GOTNAM,OUTDIS, A OUTVEC,VOTNAM, B IDATE,NDATES,NWORK,ND8,INCCYL, C MTABLE,MPLAIN,IDCNT,ND16, D NSKIP,JSTOP,PXMISS,NPROJ,ORIENT,XLAT, E ALATL,ALONL,NX,NY, F MESH,BMESH, G IOPER,IPRTEL,MINVEC,MINMOD, H ISTOP,IER) C C MARCH 2017 GLAHN TDL MOS-2000 C JULY 2017 GLAHN REMOVED IREG C JULY 2017 GLAHN MODIFIED TO READ CORRESPONDENCE C TABLE; ADDED MD16, MTABLE( , ), C MPLAIN, IDCNT TO CALL; ADDED TABNAM, C KFILT C NOVEMBER 2017 GLAHN REMOVED KFILAN, ANLNAM C DECEMBER 2017 GLAHN CHANGED COMMENT FOR KFILOV C JUNE 2018 GLAHN ADDED IOPER C OCTOBER 2020 GHIRARDELLI COMMENTED OUT USE OF KSKIP SINCE C IT IS NEVER DEFINED C C PURPOSE C INT755 PERFORMS MUCH OF THE INITIALIZATION FOR U755. C C DATA SET USE C KFILDI - UNIT NUMBER OF INPUT FILE. (INPUT) C KFILDO - UNIT NUMBER OF OUTPUT (PRINT) FILE. (OUTPUT) C IP(J) - UNIT NUMBERS FOR OPTIONAL OUTPUT (J=1,25) C (SEE IP( ) UNDER "VARIABLES" BELOW.) (OUTPUT) C KFILD(J) - UNIT NUMBERS FOR WHERE THE STATION LIST (J=1) C AND THE STATION DIRECTORY (J=2) RESIDES. C (INPUT) C KFILDT - UNIT NUMBER FOR READING THE DATE LIST. C (INPUT) C KFILP - UNIT NUMBER FOR READING THE VARIABLE LIST. c (INPUT) C KFILCP - UNIT NUMBER FOR VARIABLE CONSTANT FILE. C (INPUT) C KFILT - UNIT NUMBR FOR READING MTABLE( , ) FROM C 'CTABLE' C C VARIABLES C KFILDI = UNIT NUMBER TO READ INPUT FILE 'U755.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 GRIDDED OUTPUT TDLPACK FILE. C ZERO MEANS OUTPUT WILL NOT BE WRITTEN. C (OUTPUT) C KFILVO = UNIT NUMBER OF OUTPUT ASCII FILE WITH C LATITUDES, LONGITUDES, AND DATA FOR GMOS_PLOT. C ZERO MEANS OUTPUT WILL NOT BE WRITTEN. C (NOT CURRENTLY USED. COULD INTERPOLATE TO C STATIONS AND OUTPUT.) C (OUTPUT) C KFILOG = UNIT NUMBER FOR DISPOSABLE TDLPACK GRIDPOINT C OUTPUT. (OUTPUT) C KFILOV = UNIT NUMBER OF OUTPUT VECTOR FILE. C INTERPLATION TO STATIONS CAN BE DONE AND C THE OUTPUT PACKED AND WRITTEN. (OUTPUT) C KFIL10 = UNIT NUMBER FOR INTERNAL RANDOM ACCESS FILE. C (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 'U755', THEN 4 CHARACTERS FROM IPINIT, THEN C 2 CHARACTERS FROM IP(J) (E.G., 'U755HRG130'). 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 U755. 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 (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 (15) = INDICATES WHETHER (>0) OR NOT (=0) A C LIST OF THE X AND Y POSITIONS OF THE STATIONS C FOR THE BASIC 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 (18) = INDICATES WHETHER (>0) OR NOT (=0) C EQUATIONS READ WILL BE WRITTEN TO IP(18). 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 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 ELEV(K) = ELEVATIONS OF STATIONS IN METERS (K=1,NSTA). C THESE ARE READ FROM THE STATION DICTIONARY C BY RDSTQN OR RDSTQA IN FT, BUT ARE CONVERTED C TO METERS BY THOSE READERS. (OUTPUT) C IWBAN(K) = WBAN NUMBERS OF STATIONS (K=1,NSTA). C STALAT(K) = LATITUDE OF STATIONS (K=1,NSTA). (OUTPUT) C STALON(K) = LONGITUDE OF STATIONS (K=1,NSTA). (OUTPUT) C ISDATA(K) = WORK ARRAY. USED IN RDSTAL TO KEEP TRACK OF C THE STATIONS FOUND IN THE DIRECTORY (K=1,NSTA). C (INTERNAL) C IPACK(K) = WORK ARRAY. USED IN RDSTAL AND RDSTAD C (K=1,NSTA). (INTERNAL) C NAME(K) = NAMES OF STATIONS (K=1,NSTA). (CHARACTER*20) C (OUTPUT) C IQUAL(K,I) = THE QUALITY VALUES FROM THE STATION DICTIONARY C FOR FIVE POSSIBLE DATA TYPES (K=1,ND1) (I=1,5). C (OUTPUT) C LNDSEA(K) = LAND/SEA INFLUENCE FLAG FOR EACH STATION C (K=1,ND1). C 0 = WILL BE USED FOR ONLY OCEAN WATER (=0) C GRIDPOINTS. C 3 = WILL BE USED FOR ONLY INLAND WATER (=3) C GRIDPOINTS. C 6 = WILL BE USED FOR BOTH INLAND WATER (=3) C AND LAND (=9) GRIDPOINTS. C 9 = WILL BE USED FOR ONLY LAND (=9) GRIDPOINTS. C (OUTPUT) C ITYPE(K) = TYPE OF STATION (K=1,ND1). 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 C WITH. (INPUT) C CCALLD(K) = WORK ARRAY. 8 STATION CALL LETTERS (K=1,ND5). C THIS IS USED IN RDSTAL AND RDSTAD. C (CHARACTER*8) (INTERNAL) C ND5 = DIMENSION OF CCALLD( ) AND IPACK( ). (INPUT) C NAREA = THE AREA OVER WHICH THE ANALYSIS IS MADE: C 1 = CONUS, C 2 = ALASKA, C 3 = HAWAII, 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. U755 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) C (N=1,ND4). THIS IS THE SAME AS ID(J,N), C EXCEPT THAT THE PORTIONS PERTAINING TO C 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 C FIELDS AS READ FROM THE ARCHIVE. DERIVED FROM C IDPARS( ) IN SUBROUTINE BASICP. (OUTPUT) C FIELDS AS READ FROM THE ARCHIVE. C JP(J,N) = INDICATES WHETHER A PARTICULAR VARIABLE N MAY C HAVE INTERMEDIATE TDLPACK OUTPUT (J=2), OR C PRINT OF VECTOR RECORDS IN PACKV (J=3) C (N=1,ND4). THIS IS AN OVERRIDE FEATURE FOR C THE PARAMETERS FOR TDLPACKING IN EACH C VARIABLE'S CONTROL FILE. (OUTPUT) C NCEPNO(J) = TO PROVIDE FOR UP TO 6 GRIDS THAT MIGHT BE C NEEDED IN MERGING LAMP AND HRRR OR RAP, IT HAS C BEEN DIMENSIONED NCEPNO(J) (J=1,6). (OUTPUT) C MODNO = DD FOR WRITING OUTPUT. (OUTPUT) C NPRED = THE NUMBER OF ENTRIES IN ID( , ), ETC. WHILE C THIS NAME, USED IN U201, IS NOT VERY DESCRIPTIVE C FOR U755, IT IS USED TO BE CONSISTENT WITH C OTHER SOFTWARE. (OUTPUT) C ISCALD(N) = THE DECIMAL SCALING CONSTANT TO USE WHEN PACKING C THE DATA (N=1,ND4). ISCALD COMES FROM C THE VARIABLE CONSTANT FILE, MODIFIED TO BE 2 FOR C GRID BINARIES, AND 0 FOR POINT BINARIES. ZERO C WHEN NOT FOUND IN THE FILE. NO BINARY SCALING C IS PROVIDED FOR. (OUTPUT) C IWRITS(N) = 1 WHEN ANALYSIS FOR VARIABLE N IS TO BE WRITTEN C TO INTERNAL STORAGE BEFORE POSTPROCESSING; C 0 OTHERWISE (N=1,ND4). (OUTPUT) C IWRITA(N) = 1 WHEN ASCII DATA FOR VARIABLE N IS TO BE WRITTEN C TO FILE UNIT NUMBER KFIOVO; 0 OTHERWISE (N=1,ND4). C (OUTPUT) C IWRITF(N) = 1 WHEN FINAL POSTPROCESSED ANALYSIS FOR VARIABLE N C IS TO BE WRITTEN TO INTERNAL STORAGE; 0 OTHERWISE C (N=1,ND4). THE POSTPROCESSED VARIABLE IS C DISTINGUISHED FROM THE NON-POSTPROCESSED C INTERNALLY WITH A "1" IN THE "G" LOCATON OF THE ID. C (OUTPUT) C ANLTAB(N) = THE CONTROL FILE NAME FOR THE VARIABLE C (N=1,NPRED). (CHARACTER*17) (OUTPUT) C INLTAB(N) = UNIT NUMBER FOR CONTROL FILE ANLTAB(N) REQUIRED C BY THE IBM. (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 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( ), AND PLAIN( ). C (INPUT) C L3264B = INTEGER WORD LENGTH IN BITS OF MACHINE BEING C USED (EITHER 32 OR 64). (INPUT) C KFILIN(J) = UNIT NUMBERS FOR INPUT DATA, ALL IN TDL MOS-2000 C TDLPACK 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 WHEN THE FILE IS OPEN AND IS SET TO 2 C WHEN THE FILE IS NOT OPEN BUT IS AVAILABLE C (J=1,NUMIN). (OUTPUT) C NUMIN = THE NUMBER OF VALUES IN KFILIN( ) AND JFOPEN( ) C AND NAMES IN NAMIN( ). MAXIMUM OF ND6. C (OUTPUT) C ND6 = MAXIMUM NUMBER OF INPUT DATA SETS (MODELS) THAT C CAN BE DEALT WITH. (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 U755 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 GOTNAM = NAME OF DATA SET FOR OUTPUT GRIDS CORRESPONDING C TO UNIT NO. KFILIO. (CHARACTER*60) (OUTPUT) C VOTNAM = NAME OF DATA SET FOR OUTPUT ASCII DATA IN FORMAT C CORRESPONDING TO UNIT NO. KFILVO. C (CHARACTER*60) (OUTPUT) C OUTDIS = NAME OF DATA SET FOR DISPOSABLE GRIDS IN TDLPACK C FORMAT CORRESPONDING TO UNIT NUMBER KFILOG. C (CHARACTER*60) (OUTPUT) C OUTVEC = NAME OF DATA SET FOR VECTOR DATA IN TDLPACK C FORMAT CORRESPONDING OT UNIT NUMBER KFILOV. C (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 MTABLE(I,J) = CORRESPONDENCE TABLE BETWEEN VECTOR PREDICTOR C ID (J=1) AND GRIDDED ID TO READ TO EVALUATE C (J=2), I=1,ND16). MTABLE(I,3) IS CALCULATED TO C INDICATE WHETHER OR NOT A BINARY MUST BE MADE. C (OUTPUT) C MPLAIN(I) = DEFINITION OF THE VARIABLES IN MTABLE(I,J), C (I=1,ND16). (CHARACTER*32) (OUTPUT) C IDCNT = NUMBER OF ENTRIES IN MTABLE( , ) AND MPLAIN( ). C (OUTPUT) C ND16 = MAXIMUM OF IDCNT. DIMENSION OF MPLAIN AND C FIRST DIMENSION OF MTABLE( , ). (INPUT) 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 NRPOJ = MAP PROJECTION. (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 GRID OF THE SIZE NX, NY. TRUNCATED C TO TEN THOUSANDTHS OF DEGREES. NOTE THAT THE C MOS-2000 ARCHIVE IS ONLY TO THOUSANDTHS OF C DEGREES. (OUTPUT) C ALONL = WEST LONGITUDE OF LOWER LEFT CORNER POINT C OF A GRID OF THE SIZE NX, NY. TRUNCATED C TO TEN THOUSANDTHS OF DEGREES. NOTE THAT THE C MOS-2000 ARCHIVE IS ONLY TO THOUSANDTHS OF C DEGREES. (OUTPUT) C NX = THE SIZE OF THE ANALYSIS GRID FOR THIS RUN C IN THE X DIRECTION IN MESH UNITS. (OUTPUT) C NY = THE SIZE OF THE ANALYSIS GRID FOR THIS RUN C IN THE Y DIRECTION IN MESH UNITS. (OUTPUT) C MESH = THE NOMINAL MESH LENGTH IN KM OF THE ANALYSIS C GRID SPECIFIED BY NX, NY AT LATITUDE XLAT. C FOR INSTANCE, NOMINAL 80 CORRESPONDS C TO 95.25 KM FOR POLAR STEREOGRAPHIC. FOR C ALL ROUTINES TO WORK, THIS VALUE MUST BE C 1, 3, 5, 10, 20, 40, 80, 160, OR 320. C THE LOWER NUMBERS ARE INTEGERS APPROXIMATING C EVEN FRACTIONS OF BEDIENTS. (OUTPUT) C BMESH = ACTUAL MESH LENGTH IN KM CORRESPONDING TO C MESH. THE FINAL NX BY NY ANALYSIS OUTPUT C WILL BE AT MESH LENGTH BMESH. (OUTPUT) C IOPER = 1 FOR OPERATIONS; 0 FOR DEVELOPMENT. CONTROLS C HOW EQUATIONS HEADER IS READ AND USED. (OUTPUT) C IPRTEL = NOT USED. (BY INCLUDING THIS HERE, IT COULD C BE IMPLEMENTED FOR SOMETHING WITHOUT DISTURBING C PREVIOUSLY PREPARED .CN FILES.) (OUTPUT) C MINVEC = THE MINIMUM NUMBER OF HOURS OF DATA TO SAVE C FOR VECTOR DATA. (OUTPUT) C MINMOD = THE MINIMUM NUMBER OF HOURS OF DATA TO SAVE C FOR GRIDPOINT DATA. (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 IPINIT = 4 CHARACTERS, USUALLY A USER'S INITIALS PLUS C A RUN NUMBER, TO APPEND TO 'U755' TO IDENTIFY C A PARTICULAR SEGMENT OF OUTPUT INDICATED BY A C SUFFIX IP(J). THE RUN NUMBER ALLOWS MULTIPLE C RUNS OF U755 AND WRITING OF UNIQUELY NAMED C FILES, PROVIDED THE USER USES A DIFFERENT RUN C NUMBER FOR EACH RUN. (CHARACTER*4) (OUTPUT) 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 CONNAM = HOLDS DATA SET NAME FOR THE VARIABLE CONSTANT C FILE. CORRESPONDS TO KFILCP. (CHARACTER*60) C (INTERNAL) 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 DIRNAM(J) = HOLDS NAME OF DATA SET CONTAINING THE STATION C CALL LETTERS (J=1) AND STATION DIRECTORY (J=2). C CORRESPONDS TO UNIT NO. KFILD(J). IT IS C EXPECTED THAT THE STATIONS IN THE DIRECTORY C BE ORDERED ALPHABETICALLY BY CALL LETTERS. C (CHARACTER*60) (INTERNAL) C KFILP = UNIT NUMBER FOR READING THE VARIABLE LIST. C THESE ARE THE VARIABLES FOR WHICH ANALYSES C ARE TO BE MADE. (OUTPUT) C PRENAM = HOLDS DATA SET NAME FOR THE UNIT NUMBER C FOR THE VARIABLE LIST. CORRESPONDS TO C KFILP. (CHARACTER*60) (INTERNAL) C ITEMP(J) = SCRATCH ARRAY (J=1,7). (INTERNAL) C STATE = VARIABLE SET TO STATEMENT NUMBER TO INDICATE C WHERE AN ERROR OCCURRED. (CHARACTER*4) 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 KFILT = UNIT NUMBR FOR READING MTABLE( , ) FROM C 'CTABLE', C TABNAM = NAME OF FILE HOLDING MTABLE( , ). C (CHARACTER*60) (INTERNAL) C ICOMPT(J) = READ FROM .CN BUT NOT USED (J=1,ND4). C (AUTOMATIC) (INTERNAL) C 1 2 3 4 5 6 7 X C C NONSYSTEM SUBROUTINES USED C IPOPEN, IERX, DATPRO, RDI, RDSNAM, RDSTAL, RDSTAD, TIMPR, C IPRINT, ACTUAL, CHKSIZ, RDV155 C CHARACTER*4 STATE,IPINIT CHARACTER*8 CCALL(ND1,6) CHARACTER*8 CCALLD(ND5) CHARACTER*17 ANLTAB(ND4) CHARACTER*20 NAME(ND1) CHARACTER*32 PLAIN(ND4) CHARACTER*32 MPLAIN(ND16+1) CHARACTER*60 NAMIN(ND6),RACESS(6) CHARACTER*60 DIRNAM(2),PRENAM,CONNAM,DATNAM,GOTNAM,OUTDIS, 1 OUTVEC,VOTNAM,TABNAM CHARACTER*72 RUNID/' '/ C DIMENSION ELEV(ND1),IWBAN(ND1),STALAT(ND1),STALON(ND1), 1 ISDATA(ND1),IQUAL(ND1,5),LNDSEA(ND1),ITYPE(ND1) DIMENSION ID(4,ND4),IDPARS(15,ND4),THRESH(ND4),JD(4,ND4), 1 JP(3,ND4),ISCALD(ND4),IWRITS(ND4),IWRITA(ND4), 2 IWRITF(ND4),INLTAB(ND4),ICOMPT(ND4) DIMENSION IPACK(ND5) DIMENSION KFILIN(ND6),MODNUM(ND6),JFOPEN(ND6) DIMENSION IDATE(ND8),NWORK(ND8) DIMENSION MTABLE(ND16+1,3) DIMENSION ITEMP(7),IP(25),IUSE(25),KFILD(2),KFILRA(6), 1 NCEPNO(6) 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,1,1/ C KFILP=0 KFILAN=500 C KFILAN IS ONLY FOR ENTRY INTO UCK155. 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 ' COPS OPEN(UNIT=KFILDI,FILE='U755.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( ). C CALL IPOPEN(KFILDO,'U755',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 'U755' 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 U755 ') 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 NSKIP,JSTOP,INCCYL,NEW,NALPH,PXMISS,NAREA, 2 NPROJ,ORIENT,XLAT,MESH, 3 NX,NY,ALATL,ALONL, 4 (NCEPNO(J),J=1,6),MODNO,MINVEC,MINMOD,IOPER,IPRTEL 125 FORMAT(5(I10/),F10.0/I10/I10/2(F10.0/),3(I10/),2(F10.0/), 1 10(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 CHECK MAP PROJECTION NPROJ IS ONE OF THREE ACCOMMODATED. C 1255 IF(NPROJ.EQ.3.OR.NPROJ.EQ.5.OR.NPROJ.EQ.7)THEN GO TO 1257 ELSE WRITE(KFILDO,1256)NPROJ 1256 FORMAT(/' ****MAP PROJECTION NUMBER NPROJ =',i4, 1 ' NOT 3, 5, OR 7. FATAL ERROR IN INT755.') CALL W3TAGE('INT755') STOP 1256 ENDIF C C GET TRUE MESH LENGTH CORRESPONDING TO MESH. C 1257 CALL ACTUAL(KFILDO,MESH,BMESH,TRASH,NPROJ,IER) C IF(IER.NE.0)THEN WRITE(KFILDO,1258)MESH,IER 1258 FORMAT(' FATAL ERROR IN INT155 NEAR 1258. ', 1 'NOMINAL MESH LENGTH =',I4,' IER =',I4) CALL W3TAGE('INT755') STOP 1258 ENDIF C C CALCULATE UPPER RIGHT GRIDPOINT OF ANALYSIS GRID. MESH C LENGTH MUST BE IN M. C IF(NPROJ.EQ.3)THEN CALL LMIJLL(KFILDO,FLOAT(NX),FLOAT(NY),BMESH*1000.,ORIENT, 1 XLAT,ALATL,ALONL,URLAT,URLON,IER) ELSEIF(NPROJ.EQ.5)THEN CALL PSIJLL(KFILDO,FLOAT(NX),FLOAT(NY),BMESH*1000.,ORIENT, 1 XLAT,ALATL,ALONL,URLAT,URLON) ELSE CALL MCIJLL(KFILDO,FLOAT(NX),FLOAT(NY),BMESH*1000.,XLAT, 1 ALATL,ALONL,URLAT,URLON) ENDIF C ALATL=NINT(ALATL*10000.)/10000. ALONL=NINT(ALONL*10000.)/10000. URLAT=NINT(URLAT*10000.)/10000. URLON=NINT(URLON*10000.)/10000. C RESOLUTION OF LAT/LON IS ONLY TO TEN THOUSANDTHS OF C DEGREES. THE TDLPACK ARCHIVES (E.G., AVN ARCHIVE) IS TO C THOUSANDTHS OF DEGREES, SO ACCOMMODATION WILL HAVE TO C BE MADE WHEN CHECKING. TRUNCATING TO DEGREES*10000 MAKES C A DIFFERENCE OF ONLY ABOUT 11 METERS. C WRITE(KFILDO,128)NSKIP,JSTOP,INCCYL,NEW,NALPH, 1 PXMISS,L3264B,NAREA,NPROJ,ORIENT,XLAT,MESH, 2 ALATL,ALONL,URLAT,URLON,NX,NY, 4 (NCEPNO(J),J=1,6),MODNO,MINVEC,MINMOD,IOPER,IPRTEL 128 FORMAT(/' NSKIP ',I10,' NUMBER OF ERRORS THAT WILL BE', X ' TOLERATED ON DAY 1 BEFORE STOPPING'/ 2 ' JSTOP ',I10,' NUMBER OF ERRORS THAT WILL BE', X ' TOLERATED ON TOTAL RUN BEFORE STOPPING'/ 3 ' INCCYL',I10,' INCREMENT IN HOURS BETWEEN DATE/TIMES'/ 4 ' NEW ',I10,' NEW ICAO CALL LETTERS, 1 = YES,', X ' 0 = NO'/ 5 ' NALPH ',I10,' ALPHABETIZE CALL LETTERS ACCORDING', X ' TO DIRECTORY, 1 = YES, 0 = NO'/ 6 ' PXMISS',F10.4,' SECONDARY MISSING VALUE TO INSERT', X ' FOR 9997'/ 7 ' L3264B',I10,' INTEGER WORD SIZE OF MACHINE'/ 8 ' NAREA ',I10,' AREA OF ANALYSIS'/ 9 ' NPROJ ',I10,' MAP PROJECTION'/ A ' ORIENT',F10.4,' MAP ORIENTATION'/ B ' XLAT ',F10.4,' LATITUDE OF MESH LENGTH'/ C ' MESH ',I10,' MESH = MESH LENGTH OF BASIC GRID', X ' SPECIFIED BY NX, NY'/ D ' ALATL ',F10.4,' ALATL = NORTH LATITUDE OF LOWER LEFT', X ' CORNER OF ANALYSIS GRID'/ E ' ALONL ',F10.4,' ALONL = WEST LONGITUDE OF LOWER LEFT', X ' CORNER OF ANALYSIS GRID'/ F ' URLAT ',F10.4,' URLAT = NORTH LATITUDE OF UPPER', X ' RIGHT CORNER OF ANALYSIS GRID'/ G ' URLON ',F10.4,' URLON = WEST LONGITUDE OF UPPER', X ' RIGHT CORNER OF ANALYSIS GRID'/ H ' NX ',I10,' NX = SIZE OF ANALYSIS GRID IN X', X ' DIRECTION IN MESH UNITS'/ I ' NY ',I10,' NY = SIZE OF ANALYSIS GRID IN Y', X ' DIRECTION IN MESH UNITS'/ J ' NCEPNO',I10,' MODEL NUMBER(S) FOR GRIDDED DATA'/ K ' ',I10,' '/ L ' ',I10,' '/ M ' ',I10,' '/ N ' ',I10,' '/ O ' ',I10,' '/ P ' MODNO ',I10,' DD IN CCCFFFBDD FOR OUTPUT'/ Q ' MINVEC',I10,' MINIMUM NUMBER OF HOURS TO SAVE', X ' VECTOR DATA'/ R ' MINMOD',I10,' MINIMUM NUMBER OF HOURS TO SAVE', X ' MODEL DATA'/ S ' IOPER ',I10,' 1 = OPERATIONAL RUN; 0 OTHERWISE'/ T ' IPRTEL',I10,' NOT USED') 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 1299 CALL RDSNAM(KFILDI,KFILDO,KFILDT,DATNAM,IDUM,IDUM,1,N,'OLD', 1 'FORMATTED',IP,IER) IF(IER.NE.0)ISTOP=ISTOP+1 COPS WRITE(KFILDO,130)KFILDT,DATNAM WRITE(KFILDO,130)KFILDT 130 FORMAT(/' NCEP DATE FILES UNIT NUMBER..',/,' ',I4) COPS 130 FORMAT(/' DATE INPUT DATA SET, UNIT AND NAME.'/ COPS 1 (' ',I4,2X,A60)) C READ AND PRINT UNDER CONTROL OF IP(2) AND IP(3) THE C DATES TO BE PROCESSED, MAX OF ND8. C CALL GET_NCEPDATE(KFILDT,IYR,IMO,IDA,IHR,NDATE,IER) COPS CALL RDI(KFILDO,IP(3),KFILDT,IDATE,ND8,ITEMP,7,'(7I10)',NDATES, COPS 1 99999999,IER) COPSC ITEMP( ) IS AN ARRAY AT LEAST 7 IN SIZE. COPS IF(KFILDT.NE.KFILDI)CLOSE(UNIT=KFILDT) COPSC KFILDT IS CLOSED WHEN IT IS NOT THE SAME AS THE DEFAULT COPSC INPUT FILE. COPS CALL DATPRO(KFILDO,IDATE,NWORK,ND8,INCCYL,NDATES,IP(2),IP(3),IER) C IF(IER.NE.0)THEN WRITE(KFILDO,134) COPS 134 FORMAT(/' ****ERROR IN DATE LIST. FATAL ERROR IN INT155', COPS 1 ' AT 134.') COPS ISTOP=ISTOP+1 COPS IER=777 COPS GO TO 160 COPS ENDIF 134 FORMAT(/' ****ERROR: CAN NOT READ NCEP DATE FILE - ', 1 'CATASTROPHIC ERROR IN 155. STOP AT 134.') CALL W3TAGE('INT155') STOP 134 ENDIF NDATES = 1 IDATE(1) = NDATE WRITE(KFILDO,1351)NDATES,(IDATE(J),J=1,NDATES) 1351 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. THIS IS OK WHEN KSKIP = 0. C IF(KSKIP.GE.IDATE(1))THEN C WRITE(KFILDO,135)KSKIP,IDATE(1) C 135 FORMAT(/' ****DATE TO BE SKIPPED ',I11,' IS NOT BEFORE THE', C 1 ' FIRST DATE TO BE WRITTEN ',I11, C 2 '. FATAL ERROR IN INT155 AT 135.') C ISTOP=ISTOP+1 C IER=777 C GO TO 160 C ENDIF C C READ AND PROCESS UNIT NUMBERS AND FILE NAMES FOR ALL TDLPACK C INPUT. FILES WILL BE OPENED AS 'OLD'. C write(KFILDO,*)'adam ND6: ',ND6 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. 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,GOTNAM,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,1432) 1432 FORMAT(/' NO GRIDDED OUTPUT DATA SET PROVIDED;', 1 ' PACKED GRIDDED OUTPUT WILL NOT BE WRITTEN.') GOTNAM=' ' ELSE WRITE(KFILDO,1433)KFILIO,GOTNAM 1433 FORMAT(/' OUTPUT GRIDDED DATA SET, UNIT AND NAME.'/ 1 (' ',I4,2X,A60)) ENDIF C C READ AND PROCESS UNIT NUMBER AND FILE NAME FOR ASCII DATA C OUTPUT FOR GMOS_PLOT PLOTTING. FILE WILL BE OPENED C AS 'NEW'. C CALL RDSNAM(KFILDI,KFILDO,KFILVO,VOTNAM,IDUM,IDUM,1, 1 IOUT,'NEW','FORMATTED',IP,IER) C IOUT IS THE NUMBER OF VALUES READ AND IS NOT USED. IF(IER.NE.0)ISTOP=ISTOP+1 C IF(KFILVO.EQ.0)THEN WRITE(KFILDO,1435) 1435 FORMAT(/' NO ASCII OUTPUT DATA SET PROVIDED;', 1 ' DATA FOR GMOS_PLOT FOR PLOTTING', 2 ' WILL NOT BE WRITTEN.') VOTNAM=' ' ELSE WRITE(KFILDO,144)KFILVO,VOTNAM 144 FORMAT(/' ASCII OUTPUT DATA SET FOR PLOTTING, 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 C IF(KFILOG.EQ.0)THEN WRITE(KFILDO,1445) 1445 FORMAT(/' NO DISPOSABLE OUTPUT DATA SET PROVIDED,', 1 ' SUBSETTING VALUES ARE INCONSISTENT, OR', 2 ' NXGMIN = 0 SIGNIFYING NONE TO BE WRITTEN.') 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. C 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 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 C 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. 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 RDSTQS(KFILDO,IP(4),IP(5),KFILD,NEW,CCALL, 1 NAME,IQUAL,ELEV,IWBAN,STALAT,STALON, 2 ISDATA,ITYPE,IPACK,ND1,NSTA,IER) ELSE CALL RDSTQT(KFILDO,IP(4),IP(5),KFILD,NEW,CCALL,CCALLD, 1 NAME,IQUAL,ELEV,IWBAN,STALAT,STALON, 2 ISDATA,ITYPE,IPACK,ND1,NSTA,IER) C CCALLD( ) IS TREATED HERE AS IF IT HAD THE SAME C DIMENSIONS AS CCALL( , ). THIS IS OK, BECAUSE ND5 IS C GE ND1. ISDATA( ) AND IPACK( ) ARE WORK ARRAYS IN C RDSTAL AND RDSTAD. ENDIF C IF(IER.NE.0)ISTOP=ISTOP+1 C C PARSE 6-DIGIT VALUES IN IQUAL( ,1) INTO FIVE SINGLE DIGIT C VALUES AND INTO LNDSEA( ). THE RIGHTMOST DIGIT IN C IQUAL( ,1) GOES INTO LNDSEA( ), THE NEXT ONE TO THE LEFT C GOES INTO IQUAL(N,1) AND THE NEXT ONE TO THE LEFT GOES INTO C IQUAL(N,2), ETC. ONLY 5 FLAGS CAN BE ACCOMMODATED. C DO 151 K=1,NSTA IQ=IQUAL(K,1) LNDSEA(K)=IQ-(IQ/10)*10 C DO 1505 L=2,6 IQUAL(K,L-1)=(IQ-(IQ/10**L)*10**L)/10**(L-1) 1505 CONTINUE C CCCC WRITE(KFILDO,1506)IQ,LNDSEA(K),(IQUAL(K,L),L=1,5) CCCC 1506 FORMAT(/' IN INT755--IQ,LANDSEA(K),(IQUAL(K,L),L=1,5)',7I7) C 151 CONTINUE 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 NUMBR AND FILE NAME FOR READING THE C CORRESPONDENCE TABLE THAT RELATES THE VECTOR PREDICTAND ID C TO THE GRIDDED ID USED TO EVALUATE THE TERM. C CALL RDSNAM(KFILDI,KFILDO,KFILT,TABNAM,IDUM,IDUM,1,N,'OLD', 1 'FORMATTED',IP,IER) IF(IER.NE.0)ISTOP=ISTOP+1 C IF(KFILT.EQ.0)THEN WRITE(KFILDO,152) 152 FORMAT(/' UNIT NUMBER FOR READING CORRESPONDENCE TABLE = 0.', 1 ' FATAL ERROR. STOP IN INT755 AT 152.') CALL W3TAGE('INT755') STOP 152 ENDIF C C READ CORRESPONDENCE TABLE. ZERO MTABLE( , ). C DO 154 IDCNT=1,ND16+1 DO 153 J=1,3 MTABLE(IDCNT,J)=0. 153 CONTINUE 154 CONTINUE C STATE='156 ' DO 158 IDCNT=1,ND16+1 READ(KFILT,156,IOSTAT=IOS,ERR=900,END=900) 1 (MTABLE(IDCNT,J),J=1,2),MPLAIN(IDCNT) 156 FORMAT(2I10,2X,A32) CCCCC WRITE(KFILDO,156)(MTABLE(IDCNT,J),J=1,2),MPLAIN(IDCNT) C IF(MTABLE(IDCNT,1).EQ.999999)THEN WRITE(KFILDO,157)IDCNT-1,((MTABLE(I,J),J=1,3),MPLAIN(I), 1 I=1,IDCNT-1) 157 FORMAT(/I4,' ENTRIES IN VECTOR TO GRIDDED IDS', 1 ' CORRESPONDENCE TABLE. THE EQUATIONS WERE', 2 ' DEVELOPED ON VECTOR DATA,'/' BUT THE INPUT', 3 ' TO THE GRIDDED FORECASTS ARE GRIDS.', 4 /(3X,2I10.9,I3,2X,A32)) GO TO 160 ELSE IF(MOD(MTABLE(IDCNT,1),1000)/100.EQ.1.AND. 1 MOD(MTABLE(IDCNT,2),1000)/100.EQ.0)THEN MTABLE(IDCNT,3)=1 C WHEN THE ID IN THE EQUATION HAS B = 1 AND THE ID C READ DOES NOT, THEN IT MUST BE MADE INTO A BINARY. C OTHERWISE, THE VALUE IS USED AS READ. NOTE THAT C B=2 CANNOT BE USED FOR MAKING A BINARY FOR A C PREDICTOR. ELSE MTABLE(IDCNT,3)=0 ENDIF C ENDIF C 158 CONTINUE C ON EXIT, TERMINATOR HAS NOT BEEN FOUND. C WRITE(KFILDO,159) 159 FORMAT(/' ****FULL CORRESPONDENCE TABLE NOT READ. TERMINATOR', 1 ' NOT FOUND. FATAL ERROR. STOP IN INT755 AT 159.') CALL W3TAGE('INT755') STOP 159 C 160 IDCNT=IDCNT-1 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,162)KFILP,PRENAM 162 FORMAT(/' VARIABLE LIST DATA SET, UNIT AND NAME.'/ 1 (' ',I4,2X,A60)) C C READ AND PROCESS UNIT NUMBER FOR THE VARIABLE 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,165)KFILCP,CONNAM 165 FORMAT(/' VARIABLE CONSTANT DIRECTORY, UNIT AND NAME.'/ 1 (' ',I4,2X,A60)) C C READ VARIABLE LIST FOR WHICH FORECASTS ARE TO BE MADE. C CALL RDV755(KFILDO,IP(6),IP(7),IP(9),KFILP,KFILCP,ID,IDPARS, 1 THRESH,JD,JP,ANLTAB,INLTAB,ISCALD, 2 IWRITS,IWRITA,ICOMPT,IWRITF, 3 PLAIN,ND4, 4 NPRED,ISTOP,IER) C NPRED IS THE NUMBER OF VARIABLES TO MAKE FORECASTS FOR C AND IS THE NUMBER OF IDS READ INTO ID( , ). C IF(IER.NE.0)THEN WRITE(KFILDO,168) 168 FORMAT(/' FATAL ERROR IN RDV155', 1 ' IN INT755 AT 159.') CALL W3TAGE('INT755') STOP 168 ENDIF C C CHECK POSSIBLE INCONSISTENCY OF UNIT NUMBERS. NOTE THAT C RDSNAM HAS ALREADY CHECKED IP( ) NUMBERS WITH ANY UNIT C NUMBERS IT READS. HOWEVER, THEY ARE RECHECKED IN U755CK. C IPIN=25 CALL U155CK(KFILDO,KFILIO,KFILDI,KFILIN,NUMIN, 1 KFILD,KFILRA,NUMRA,IP,IPIN,KFIL10, 2 KFILVO,KFILOG,KFILAN) 180 RETURN C C ERROR STOP BELOW IS FOR ERRORS OF CONTROL INFORMATION INPUT. C 900 CALL IERX(KFILDO,KFILDO,IOS,'INT755',STATE) WRITE(KFILDO,901) 901 FORMAT(/' ****FATAL SYSTEM ROUTINE ERROR IN INT755.') CALL W3TAGE('INT755') STOP 901 END