SUBROUTINE INT910(KFILDI,KFILDO,KFILIO,IP, 1 CCALL,NELEV,IWBAN,STALAT,STALON, 2 ISDATA,IPACK,NGP,KGP,NAME,NSTA,ND1,CCALLD,ND5, 3 ID,IDPARS,TRESHL,TRESHU,JD,JP,NCAT, 4 ITAU,ICHARS,IWDTH,IPREC,CFMT,ISCALD,HEAD, 5 PLAIN,L3264B,L3264W,ND4, 6 KFILRA,RACESS,NUMRA,KFILX,CFILX, 7 OUTNAM,IDATE,NDATES,NWORK,ND8, 8 JSTOP,NREPLA,NCHECK, 9 NPRINT,NVRBL,LNGTH, A NTOTBY,NTOTRC,IPINIT,ISTOP,IER) C C$$$ SUBPROGRAM DOCUMENTATION BLOCK C C SUBPROGRAM: INT910 C PRGMMR: GLAHN ORG: W/OSD21 DATE: 1999-07-01 C C ABSTRACT: INT910 PERFORMS MUCH OF THE INITIALIZATION FOR U910. C C PROGRAM HISTORY LOG: C 99-07-01 GLAHN C 00-05-17 DREWRY 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 00-06-30 MCE SUBSTITUTED ITEMP FOR IDUM IN RDSNAM CALL C BEFORE LINE 143. C 04-12-06 RLC CHANGED DICTIONARY READERS FROM GROUPED C STATION LISTS TO NON-GROUPED. THIS WAS FOR C GRIDDED MOS SO THAT WE COULD USE THE DICTIONARY C AS THE STATION LIST TO SPEED UP THE CODE. SET C KGP TO 1 AND NGP(1) TO NSTA. C 09-02-05 RLC CHANGED DO LOOP 178 TO LOOP 1,NUMRA INSTEAD OF C 1,5. ON CIRRUS THE 1,5 WAS CAUSING PROBLEMS C BECAUSE IT LOOPED INTO UNINITIALIZED PARTS OF C THE ARRAY. C 12-02-29 JEG REMOVED UNNECESSARY print STATEMENT C C USAGE: CALLED BY U910 C C DATA SET USE C INPUT FILES: C FORT.KFILDI - UNIT NUMBER OF INPUT FILE. (INPUT) C FORT.KFILD(J) - UNIT NUMBERS FOR WHERE THE STATION LIST (J=1) C AND THE STATION DIRECTORY (J=2) RESIDES. (INPUT) C FORT.KFILDT - UNIT NUMBER FOR READING THE DATE LIST. (INPUT) C FORT.KFILP - UNIT NUMBER FOR READING THE VARIABLE LIST. (INPUT) C FORT.KFILCP - UNIT NUMBER FOR PREDICTOR CONSTANT FILE. (INPUT) C FORT.KFILRA(J) - UNIT NUMBERS FOR EXTERNAL RANDOM ACCESS FILES C (J=1,5). (INPUT/OUTPUT) C OUTPUT FILES: C FORT.KFILDO - UNIT NUMBER OF OUTPUT (PRINT) FILE. (OUTPUT) C FORT.KFILIO - UNIT NUMBER OF OUTPUT TDLPACK FILE. (OUTPUT) C FORT.IP(J) - UNIT NUMBERS FOR OPTIONAL OUTPUT (J=1,25) C (SEE IP( ) UNDER "VARIABLES" BELOW.) (OUTPUT) C FORT.KFILX - UNIT NUMBER FOR WRITING FORECAST OUTPUT TO C MOS-2000 EXTERNAL RANDOM ACCESS FILE. (OUTPUT) C VARIABLES C KFILDI = UNIT NUMBER TO READ INPUT FILE 'U910.CN'. C (INPUT) C KFILDO = UNIT NUMBER OF OUTPUT (PRINT) FILE. INITIALLY, C THIS IS INPUT EQUAL TO 12. LATER, IN IPOPEN, C IF IP(1) NE 0, KFILDO IS SET = IP(1). THIS ALLOWS C CHANGING THE "DEFAULT" PRINT FILE ON THE FLY. C OTHERWISE, ON SOME SYSTEMS, THE OUTPUT FILE MIGHT C HAVE THE SAME NAME AND BE OVERWRITTEN. WHEN THE C OUTPUT FILE IS NOT THE ORIGINAL DEFAULT, THE NAME C IS GENERATED AND CAN BE DIFFERENT FOR EACH RUN. C THIS ALLOWS SAVING EACH OUTPUT AND NOT HAVING IT C OVERWRITTEN. (INPUT-OUTPUT) C KFILIO = UNIT NUMBER OF OUTPUT TDLPACK FILE. (OUTPUT) C IP(J) = EACH VALUE (J=1,25) INDICATES WHETHER (>1) C OR NOT (=0) CERTAIN INFORMATION WILL BE WRITTEN. C WHEN IP( ) > 0, THE VALUE INDICATES THE UNIT C NUMBER FOR OUTPUT. THESE VALUES SHOULD NOT BE THE C SAME AS ANY KFILX VALUES EXCEPT POSSIBLY C KFILDO, WHICH IS THE DEFAULT OUTPUT FILE. THIS IS C ASCII OUTPUT, GENERALLY FOR DIAGNOSTIC PURPOSES. C THE FILE NAMES WILL BE 4 CHARACTERS 'U910', C THEN 4 CHARACTERS FROM IPINIT, THEN 2 CHARACTERS C FROM IP(J) (E.G., 'U910HRG130'). THE ARRAY IS C INITIALIZED TO ZERO IN CASE LESS THAN THE EXPECTED C NUMBER OF VALUES ARE READ IN. EACH OUTPUT ASCII C FILE WILL BE TIME STAMPED. NOTE THAT THE TIME C ON EACH FILE SHOULD BE VERY NEARLY THE SAME, BUT C COULD VARY BY A FRACTION OF A SECOND. IT IS C INTENDED THAT ALL ERRORS BE INDICATED ON THE C DEFAULT, SOMETIMES IN ADDITION TO BEING INDICATED C ON A FILE WITH A SPECIFIC IP( ) NUMBER, SO THAT C THE USER WILL NOT MISS AN ERROR. C (1) = ALL ERRORS AND OTHER INFORMATION NOT C SPECIFICALLY IDENTIFIED WITH OTHER IP( ) C NUMBERS. WHEN IP(1) IS READ AS NONZERO, C KFILDO, THE DEFAULT OUTPUT FILE UNIT NUMBER, C WILL BE SET TO IP(1). WHEN IP(1) IS READ C AS ZERO, KFILDO WILL BE USED UNCHANGED. C (2) = THE INPUT DATES IN IDATE( ). WHEN THERE C ARE ERRORS, PRINT WILL BE TO UNIT KFILDO AS C WELL AS TO UNIT IP(2). C (3) = THE OUTPUT DATES IN IDATE( ). WHEN THERE C ARE ERRORS, OUTPUT WILL BE TO UNIT KFILDO AS C WELL AS TO UNIT IP(3). C (4) = THE INPUT STATION LIST (CALL LETTERS ONLY). C IF THERE ARE INPUT ERRORS, THE STATION LIST C WILL BE WRITTEN TO THE DEFAULT OUTPUT FILE UNIT C KFILDO AS WELL AS TO UNIT IP(4). C (5) = THE STATIONS AND STATION DIRECTORY INFORMATION C IN THE ORDER TO BE DEALT WITH IN U910. THE C STATIONS WILL BE IN ALPHABETICAL ORDER WITHIN C EACH GROUP PROVIDED THE DIRECTORY IS. IF THERE C ARE INPUT ERRORS, THE STATION LIST WILL BE C WRITTEN TO THE DEFAULT OUTPUT FILE UNIT KFILDO C AS WELL AS TO UNIT IP(5). C (6) = THE VARIABLES AS THEY ARE BEING READ IN. C THIS IS GOOD FOR CHECKOUT; FOR ROUTINE C OPERATION, IP(7), IP(8), AND/OR IP(9), C MAY BE BETTER. C (7) = THE VARIABLE LIST IN SUMMARY FORM. C IF THERE ARE ERRORS, THE VARIABLE LIST WILL C BE WRITTEN TO THE DEFAULT OUTPUT FILE C UNIT KFILDO AS WELL AS TO UNIT IP(7). C THIS LIST INCLUDES THE PARSED ID'S IN IDPARS( , ). C (8) = THE VARIABLE LIST IN SUMMARY FORM. THIS C LIST INCLUDES THE PARSED ID'S IN IDPARS( , ). C (9) = THE VARIABLE LIST IN SUMMARY FORM . THIS C DIFFERS FROM (8) IN THAT (9) DOES NOT C INCLUDE THE PARSED ID'S IN IDPARS( , ), C BUT RATHER INCLUDES THE INFORMATION TAKEN C FROM THE PREDICTOR CONSTANT FILE ON UNIT KFILCP. C (10) = NOT USED. C (11) = NOT USED. C (12) = INDICATES WHETHER (>1) OR NOT (=0) THE LIST OF C STATIONS ON THE INPUT FILES WILL BE PRINTED TO C THE FILE WHOSE UNIT NUMBER IS IP(12). C (13) = NOT USED. C (14) = NOT USED. C (15) = INDICATES WHETHER (>0) OR NOT (=0) THE DATA C WILL BE WRITTEN TO UNIT IP(15) WHEN JP(3, ) >0. C THIS PRINT IS LIKE THAT PROVIDED BY U201, AND C IS SEPARATE FROM THE OPTIONAL LISTING PROVIDED C UNDER CONTROL OF JP(2, ) WITH THE FORMAT C PROVIDED. C (16) = INDICATES WHETHER (>0) OR NOT (=0) THE DATA C WILL BE WRITTEN TO UNIT IP(16) WHEN JP(2, ) >0. C THIS PRINT IS UNDER CONTROL OF THE FORMAT C PROVIDED WITH EACH VARIABLE. C (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 BY GSTORE (K=1,NSTA). (INTERNAL) C IPACK(K) = USED IN RDSTGA TO KEEP TRACK OF THE STATIONS C FOUND BY GROUP IN THE DIRECTORY (K=1,NSTA). C ALSO USED AS WORK ARRAY IN SKIPWR. (INTERNAL) C NGP(J) = THE NUMBER OF STATIONS IN EACH GROUP (J=1,KGP). C (OUTPUT) C KGP = THE NUMBER OF GROUPS OF STATIONS TO BE PROCESSED. C MAXIMUM OF ND1. (SEE NGP( )) C NAME(K) = NAMES OF STATIONS (K=1,NSTA) (CHARACTER*20) C (OUTPUT) C NSTA = THE NUMBER OF STATIONS BEING DEALT WITH. THE C NUMBER OF VALUES IN CCALL( , ), ETC. (OUTPUT) C ND1 = MAXIMUM NUMBER OF STATIONS THAT CAN BE DEALT WITH. C (INPUT) C CCALLD(K) = 8 STATION CALL LETTERS (K=1,ND5). THIS LIST IS C USED IN RDSTGA AND RDSTGN TO RETAIN THE ORIGINAL C LIST IN CCALL( , ). IT IS ALSO USED FOR SCRATCH IN C SKIPWR. (CHARACTER*8) (OUTPUT) C ND5 = DIMENSION OF IPACK AND CCALLD( ). (INPUT) C ID(J,N) = THE INTEGER VARIABLE ID'S (J=1,4) (N=1,NVRBL). C (OUTPUT) C IDPARS(J,N) = THE PARSED, INDIVIDUAL COMPONENTS OF THE VARIABLE C ID'S CORRESPONDING TO ID( ,N) (J=1,15), (N=1,NVRBL). C (OUTPUT) C J=1--CCC (CLASS OF VARIABLE), C J=2--FFF (SUBCLASS OF VARIABLE), C J=3--B (BINARY INDICATOR), C 0 = NOT BINARY, C 1 = CUMULATIVE FROM ABOVE, VALUES GE LOWER THRESHOLD C TRESHL = 1, C 2 = CUMULATIVE FROM BELOW, VALUES LT UPPER THRESHOLD C TRESHU = 1. C 3 = DISCRETE BINARY. VALUES GE LOWER THRESHOLD AND C LT UPPER THRESHOLD = 1. C 5 = GRID BINARY. VALUES GE LOWER THRESHOLD C ONLY THE VALUE OF 0, 1, OR 5 SHOULD BE USED FOR C PREDICTORS; C 0, 1, 2, OR 3 CAN BE USED FOR PREDICTANDS. C J=4--DD (DATA SOURCE, MODEL NUMBER), C J=5--V (VERTICAL APPLICATION), C J=6--LBLBLBLB (BOTTOM OF LAYER, 0 IF ONLY 1 LAYER), C J=7--LTLTLTLT (TOP OF LAYER), C J=8--T (TRANSFORMATION), C J=9--RR (RUN TIME OFFSET, ALWAYS + AND BACK IN TIME), C J=10--OT (TIME APPLICATION), C J=11--OH (TIME PERIOD IN HOURS), C J=12--TAU (PROJECTION IN HOURS), C J=13--I (INTERPOLATION TYPE), C J=14--S (SMOOTHING INDICATOR), AND C J=15--G (GRID INDICATOR). C (OUTPUT) C TRESHL(N) = THE LOWER BINARY THRESHOLD CORRESPONDING TO IDPARS( ,N) C (N=1,ND4). (OUTPUT) C TRESHU(N) = THE UPPER BINARY THRESHOLD CORRESPONDING TO IDPARS( ,N) C (N=1,ND4). (OUTPUT) C JD(J,N) = THE BASIC INTEGER VARIABLE ID'S (J=1,4) (N=1,ND4). C THIS IS THE SAME AS ID(J,N), EXCEPT THAT THE FOLLOWING C PORTIONS ARE OMITTED: C B = IDPARS(3, ), C G = IDPARS(15, ), AND C TRESHL( ). C JD( , ) IS USED TO IDENTIFY WHICH CALCULATIONS C CAN BE MADE DIRECTLY IN U910, WHICH IS ONLY FORMING C BINARIES. THE "G" VARIABLE HAS NO MEANING IN U910, C IT BEING ONLY FOR POSSIBLE USE IN U201. (OUTPUT) C JP(J,N) = CONTROLS THE OUTPUT BY VARIABLE (N=1,ND4). C J=1--INDICATES WHETHER (>0) OR NOT (=0) VARIABLE N C WILL BE WRITTEN TO THE BINARY OUTPUT FILE C WHEN KFILIO NE 0; C J=2--INDICATES WHETHER (>0) OR NOT (=0) VARIABLE N C WILL BE WRITTEN TO UNIT IP(16) WITH THE FORMAT C PROVIDED WITH THE VARIABLE; AND C J=3--INDICATES WHETHER (>0) OR NOT (=0) VARIABLE N C WILL BE WRITTEN TO UNIT IP(15) NOT UNDER C CONTROL OF THE FORMAT PROVIDED BUT TO THE C RESOLUTION PACKED. C (OUTPUT) C NCAT(N) = A CATEGORY NUMBER FOR EACH VARIABLE (N=1,ND4). C 0 = THIS VARIABLE IS IN A SERIES, NOT THE FIRST. C M = THIS VARIABLE IS THE FIRST OF A SERIES OF C M VARIABLES. C (OUTPUT) C ITAU(N) = THE NUMBER OF HOURS TO ADD TO NDATE TO GET C THE VARIABLE N (N=1,ND4). THIS IS THE C "LOOKAHEAD" FEATURE. (OUTPUT) C ICHARS = NUMBER OF CHARACTERS FOR CALL LETTERS IN C PRINTING, MAX OF 8, MIN OF 4. (OUTPUT) C IWDTH(J) = WIDTH OF FIELD FOR PRINTING , MAXIMUM OF 30 C (J=1,ND4). (OUTPUT) C IPREC(J) = PRECISION FOR PRINTING (J=1,ND4). THIS IS THE C NUMBER OF PLACES AFTER THE DECIMAL POINT. C (OUTPUT) C CFMT(J) = FORMAT FOR PRINTING, EITHER I OR F (J=1,ND4). C (CHARACTER*1) (OUTPUT) C ISCALD(N) = THE DECIMAL SCALING CONSTANT TO USE WHEN PACKING 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 HEAD(J,N) = HEADING FOR COLUMNS WHEN PRINTING DATA (J=1,30) C (N=1,ND4). (CHARACTER*1) (OUTPUT) C PLAIN(N) = THE PLAIN LANGUAGE DESCRIPTION OF THE VARIABLES C (N=1,ND4). (CHARACTER*32) (OUTPUT) C L3264B = INTEGER WORD LENGTH IN BITS OF MACHINE BEING C USED (EITHER 32 OR 64). (INPUT) C L3264W = NUMBER OF WORDS IN 64 BITS (EITHER 1 OR 2). C (INPUT) C ND4 = MAXIMUM NUMBER OF VARIABLES THAT CAN BE DEALT WITH C IN ONE RUN. SECOND DIMENSION OF ID( , ), IDFORC( , ) C JD( , ), AND IDPARS( , ) AND DIMENSION OF TRESHL( ), C JP( ), TRESHU( ), C ITAU( ), PLAIN( ). (INPUT) C KFILRA(J) = HOLDS THE UNIT NUMBERS FOR ACCESSING THE MOS-2000 C EXTERNAL RANDOM ACCESS FILES (J=1,5). (OUTPUT) C RACESS(J) = FILE NAMES OF THE MOS-2000 EXTERNAL RANDOM ACCESS C FILES CORRESPONDING TO KFILRA(J) (J=1,5). C (CHARACTER*60) (OUTPUT) C NUMRA = THE NUMBER OF VALUES IN KFILRA( ), RACESS( ), C AND INDEXR( , ), MAX OF 5. (OUTPUT) C KFILX = THE UNIT NUMBER FOR THE OUTPUT RANDOM ACCESS C FILE. (OUTPUT) C CFILX = THE FILE NAME OF THE OUTPUT RANDOM ACCESS C FILE CORRESPONDING TO KFILX. (CHARACTER*60) C (OUTPUT) C OUTNAM = NAME OF DATA SET FOR PACKED VECTOR OUTPUT TO C BE WRITTEN TO UNIT KFILIO. THIS IS A SEQUENTIAL C FILE. (CHARACTER*60) (OUTPUT) C IDATE(J) = INITIAL DATE LIST (J=1,NDATES) WHICH MAY CONTAIN C NEGATIVE VALUES INDICATING A DATE SPAN. C THIS IS MODIFIED IN DATPRO TO CONTAIN THE COMPLETE C DATE LIST WITH THE DATES IN THE SPANS FILLED IN C (J=1,NDATES), WHERE NDATES HAS BEEN INCREASED C IF NECESSARY. DATES ARE INPUT AS YYMMDDHH AND C MODIFIED TO YYYYMMDDHH. ZEROS IN THE INPUT ARE C ELIMINATED. TERMINATOR IS 99999999. MAXIMUM C NUMBER OF DATES IS ND8. (OUTPUT) C NDATES = THE NUMBER OF DATES IN IDATE( ). (OUTPUT) C NWORK(J) = WORK ARRAY (J=1,ND8). (INTERNAL) C ND8 = MAXIMUM NUMBER OF DATES THAT CAN BE DEALT WITH. C DIMENSION OF IDATE( ) AND NWORK( ). (INPUT) C JSTOP = THE NUMBER OF ERRORS THAT WILL BE TOLERATED ON THE C TOTAL RUN BEFORE PROGRAM STOPS. (OUTPUT) C NREPLA = RECORD REPLACEMENT FLAG FOR WRITING RANDOM C ACCESS FILE. C 0 = NOT REPLACING RECORD. C 1 = REPLACING, ERROR IF RECORD NOT FOUND TO C REPLACE. C 2 = REPLACING, WRITE NEW RECORD IF RECORD NOT C FOUND TO REPLACE. C (INPUT) C NCHECK = IDENTIFICATION CHECKING FLAG FOR WRITING C RANDOM ACCESS FILE. C 0 = DON'T CHECK FOR DUPLICATES. C 1 = CHECK FOR DUPLICATES, ERROR IF FOUND. C (INPUT) C NPRINT = THE NUMBER OF CYCLES OF DATA TO PRINT UNDER C JP(2, ) AND JP(3, ) CONTROL. (OUTPUT) C NVRBL = THE NUMBER OF VARIABLES. (OUTPUT) C LNGTH = LINE LENGTH FOR PRINTING TO IP(16). (OUTPUT) C NTOTBY = THE TOTAL NUMBER OF BYTES ON THE FILE ASSOCIATED C WITH UNIT NO. KFILIO (THE OUTPUT FILE). C IT IS UPDATED BY SKIPWR. C NTOTRC = THE TOTAL NUMBER OF RECORDS IN THE FILE. IT IS C UPDATED BY SKIPWR. C IPINIT = 4 CHARACTERS USED TO HELP IDENTIFY OUTPUT ASSOCIATED C WITH THE IP( ) NUMBERS. (CHARACTER*4) (OUTPUT) C ISTOP = 0 MEANS THE PROGRAM IS RUNNING OK UP TO THIS C POINT. WHENEVER AN ERROR OCCURS THAT SHOULD C HALT THE PROGRAM AFTER INPUT DIAGNOSTICS ARE C PRINTED, ISTOP IS SET = ISTOP+1. (INPUT-OUTPUT) C IER = STATUS RETURN. C 0 = GOOD RETURN. C OTHER VALUES CAN COME FROM CALLED SUBROUTINES. C (OUTPUT) C INCCYL = THE NUMBER OF HOURS BETWEEN DATES WHEN DATE SPANNING C IS USED. (INTERNAL 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. (INTERNAL) C RUNID = INFORMATION INPUT TO IDENTIFY THE OUTPUT ON C KFILDO. (CHARACTER*72) (INTERNAL) C KFILDT = UNIT NUMBER FOR READING THE DATE LIST. (INTERNAL) C DATNAM = FILE NAME FOR READING DATE LIST. (CHARACTER*60) C (INTERNAL) C KFILD(J) = THE UNIT NUMBER FOR WHERE THE STATION LIST (J=1) C AND THE STATION DIRECTORY (J=2) RESIDES. C CORRESPONDS TO DIRNAM(J). WHEN KFILD(1) = KFILDI, C THE DEFAULT INPUT IS INDICATED, DIRNAM(1) IS NOT C USED, AND THE FILE IS NOT OPENED. KFILD(1) CAN C EQUAL KFILD(2), IN WHICH CASE THE STATION LIST IS C TAKEN FROM THE DIRECTORY (I.E., A SEPARATE STATION C LIST IS NOT PROVIDED). (INTERNAL) C DIRNAM(J) = HOLDS NAME OF DATA SET CONTAINING THE STATION C CALL LETTERS (J=1) AND STATION DIRECTORY (J=2). C IT IS EXPECTED THAT THE STATIONS IN C THE DIRECTORY BE ORDERED ALPHABETICALLY BY CALL C LETTERS. (CHARACTER*60) (INTERNAL) C KFILP = UNIT NUMBER FOR READING THE VARIABLE LIST. C (INTERNAL) C PRENAM = HOLDS DATA SET NAME FOR THE UNIT NUMBER C IN KFILP. (CHARACTER*60) (INTERNAL) C KFILCP = UNIT NUMBER FOR PREDICTOR CONSTANT FILE. THIS C CONTAINS DEFAULT VALUES FOR CERTAIN CONSTANTS FOR C BASIC NMC PREDICTORS AND OTHER PREDICTORS SANS C THRESHOLDS, ETC. THESE INCLUDE PACKING CONSTANTS, C GRIDPOINT CONSTANTS, AND NAMES. (INTERNAL) C CONNAM = HOLDS DATA SET NAME FOR THE UNIT NUMBER IN KFILCP. C (CHARACTER*60) (INTERNAL) C 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 ITEMP(J) = SCRATCH ARRAY (J=1,7). (INTERNAL) C STATE = VARIABLE SET TO STATEMENT NUMBER TO INDICATE C WHERE AN ERROR OCCURRED. (CHARACTER*4) (INTERNAL) C NEW = 1 WHEN NEW 4-LETTER CALL LETTERS ARE TO BE USED; C 0 WHEN OLD 3-LETTER CALL LETTERS ARE TO BE USED. C (INTERNAL) C KWRITE = PERTAINS ONLY TO THE SEQUENTIAL BINARY OUTPUT FILE. C 0 IF CALL LETTERS RECORD IS NOT TO BE WRITTEN. C NE 0 OTHERWISE. THIS HAS NO EFFECT UNLESS KSKIP C NE 0. IF DATA ARE SKIPPED, THE EXISTING C CALL LETTERS RECORD IS CHECKED WITH THE ONE C AVAILABLE FOR WRITING. IF THEY MATCH C THE NEW ONE IS NOT WRITTEN; HOWEVER,IF THEY C DON'T MATCH, THE NEW ONE IS WRITTEN WHEN C KWRITE = 1, BUT THE PROGRAM HALTS WITH A C DIAGNOSTIC WHEN KWRITE = 0. (INTERNAL) C NALPH = 1 WHEN THE CALL STATIONS USED ARE TO BE C ALPHABETIZED BY GROUP (MORE EXACTLY, PUT C IN THE ORDER THEY EXIST IN THE STATION DIRECTORY. C 0 WHEN THE ORDER READ IN IS TO BE PRESERVED. C (INTERNAL) C IUSE(J) = EACH VALUE J PERTAINS TO IP(J). WHEN AN IP(J) C VALUE IS USED BY THE PROGRAM, IPRINT(J) = 1; C OTHERWISE, IPRINT(J) = 0. USED BY IPRINT TO C PRINT IP( ) VALUES. C C SUBPROGRAMS CALLED: IPOPEN, IERX, DATPRO, RDI, RDSNAM, RDVR79, C TIMPR, SKIPWR, IPRINT, RDSTGN, RDSTGA C UNIQUE - NONE C LIBRARY: C MOSLIB - IPOPEN, IERX, DATPRO, RDI, RDSNAM, RDVR79, TIMPR, C SKIPWR, IPRINT, RDSTAL, RDSTAD C EXIT STATES: C COND = 0 - SUCCESSFUL RUN C 134 - ERROR IN DATE LIST C 135 - DATE TO BE SKIPPED IS NOT BEFORE THE FIRST DATE TO C BE WRITTEN C 158 - NO VARIABLE LIST PROVIDED C 159 - ERROR IN ROUTINE SKIPWR C 165 - INCONSISTENCY OF INPUT UNIT NUMBERS IN KFILRA() WITH C EITHER KFILDT, KFILD(), KFILP, KFILCP, KFILIO, OR C KFILDO C 175 - INCONSISTENCY OF INPUT NUMBERS IN KFILIO AND EITHER C KFILDT, KFILD(), KFILP, OR KFILCP C 177 - AN IP() NUMBER CONFLICTS WITH KFILRA() NUMBER 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 CHARACTER*1 CFMT(ND4),HEAD(30,ND4) CHARACTER*4 STATE,IPINIT CHARACTER*8 CCALL(ND1,6) CHARACTER*8 CCALLD(ND5) CHARACTER*20 NAME(ND1) CHARACTER*32 PLAIN(ND4) CHARACTER*60 RACESS(5) CHARACTER*60 DIRNAM(2),PRENAM,CONNAM,DATNAM,OUTNAM,CFILX CHARACTER*72 RUNID/' '/ C DIMENSION NELEV(ND1),IWBAN(ND1),STALAT(ND1),STALON(ND1), 1 ISDATA(ND1),NGP(ND1),ITIMEZ(ND1) DIMENSION ID(4,ND4),IDPARS(15,ND4),TRESHL(ND4),TRESHU(ND4), 1 JD(4,ND4),JP(ND4),NCAT(ND4),ITAU(ND4), 2 IWDTH(ND4),IPREC(ND4),ISCALD(ND4) DIMENSION IPACK(ND5) DIMENSION IDATE(ND8),NWORK(ND8) DIMENSION ITEMP(7),IP(25),IUSE(25),KFILD(2),KFILRA(5) C DATA IUSE/1,1,1,1,1,1,1,1,1,0,0,1,0,0,1,1,0,0,0,0,0,0,0,0,0/ C C THE KFILDO OUTPUT HAS BEEN TIME STAMPED IN THE DRIVER. C NOTE THAT THIS IS ON THE DEFAULT OUTPUT FILE KFILDO. C IF IP(1) NE 0, KFILDO IS SET TO IP(1) AND IS TIME STAMPED C BELOW. C STATE='105 ' C OPEN(UNIT=KFILDI,FILE='U910.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,'U910',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 'U910' 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 U910 ') 113 CONTINUE C C READ AND PRINT THE RUN IDENTIFICATION. C STATE='115 ' READ(KFILDI,115,IOSTAT=IOS,ERR=900,END=116)RUNID 115 FORMAT(A72) C LESS THAN 72 CHARACTERS WILL NOT BE CONSIDERED AN ERROR. 116 WRITE(KFILDO,117)RUNID 117 FORMAT(/' ',A72) C C PRINT TO MAKE SURE USER KNOWS WHAT MACHINE IS BEING USED. C WRITE(KFILDO,119)L3264B 119 FORMAT(/' RUNNING ON A',I3,'-BIT MACHINE.') C C READ AND PRINT CONTROL INFORMATION. C STATE='125 ' READ(KFILDI,125,IOSTAT=IOS,ERR=900,END=1250) 1 KSKIP,KWRITE,JSTOP,INCCYL,NEW,NALPH,NREPLA,NCHECK, 2 NPRINT,ICHARS,LNGTH 125 FORMAT(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 ACCEPT KSKIP AS YY OR YYYY FOR YEAR. IF IT IS ZERO, NO C SKIPPING IS DONE. C 1255 IF(KSKIP.EQ.0)GO TO 1257 IF(KSKIP/1000000.GT.1900)GO TO 1257 IF(KSKIP/1000000.GT.60)KSKIP=KSKIP+1900000000 IF(KSKIP/1000000.LE.60)KSKIP=KSKIP+2000000000 C C INSURE THAT ICHARS GE 4 AND LE 8. IF NOT, THIS WILL CAUSE A C PRINTING PROBLEM IN PRU910. C 1257 ICHARS=MIN(MAX(ICHARS,4),8) C IF(LNGTH.LT.25)THEN WRITE(KFILDO,1258)LNGTH 1258 FORMAT(/' ****LNGTH =',I3,' TOO SMALL, SET TO 25') LNGTH=25 ISTOP=ISTOP+1 ENDIF C WRITE(KFILDO,127)KSKIP,KWRITE,JSTOP,INCCYL,NEW,NALPH, 1 NREPLA,NCHECK,NPRINT,ICHARS,LNGTH,L3264B 127 FORMAT(/' KSKIP ',I10,' SKIP PAST THIS DATE ON OUTPUT FILE'/ 1 ' KWRITE',I10,' WILL DIRECTORY RECORD BE WRITTEN?', X ' 1 = YES, 0 = NO'/ 2 ' 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 ' NREPLA',I10,' REPLACEMENT IN RANDOM ACCESS FILE,', X ' 0 = NO, 1 = YES, IF FOUND, 2 = YES'/ 7 ' NCHECK',I10,' CHECK FOR DUPLICATES RANDOM ACCESS', X ' FILE, 1 = YES, 0 = NO'/ 8 ' NPRINT',I10,' NUMBER OF CYCLES OF DATA TO PRINT', X ' UNDER JP(2, ) AND JP(3, ) CONTROL'/ 9 ' ICHARS',I10,' NUMBER OF CHARACTERS FOR PRINTING', X ' CALL LETTERS WHEN PRINTING DATA'/ A ' LNGTH ',I10,' LINE LENGTH IN CHARACTERS FOR', X ' PRINTING DATA TO UNIT IP(16)'/ B ' L3264B',I10,' INTEGER WORD SIZE OF MACHINE') C C READ AND PROCESS UNIT NUMBER AND FILE NAME FOR READING C DATE LIST. FILE WILL BE OPENED AS 'OLD', UNLESS THE FILE C IS THE DEFAULT INPUT FILE. C CALL RDSNAM(KFILDI,KFILDO,KFILDT,DATNAM,IDUM,IDUM,1,N,'OLD', 1 'FORMATTED',IP,IER) IF(IER.NE.0)ISTOP=ISTOP+1 WRITE(KFILDO,130)KFILDT 130 FORMAT(/,' NCEP DATE FILE UNIT NUMBER..',/,' ',I4) C C READ AND PRINT THE DATE TO BE PROCESSED C CALL GET_NCEPDATE(KFILDT,IYR,IMO,IDA,IHR,NDATE,IER) C IF(IER.NE.0)THEN WRITE(KFILDO,131) 131 FORMAT(/' ****ERROR: CAN NOT READ NCEP DATE FILE - ', 1 'CATASTROPHIC ERROR IN INT910. STOP AT 131.') CALL W3TAGE('INT910') STOP 131 ENDIF NDATES=1 IDATE(1)=NDATE WRITE(KFILDO,132)NDATES,(IDATE(J),J=1,NDATES) 132 FORMAT(/,' ',I4,' INPUT DATE AS READ',/,(1X,10I12)) C C 130 FORMAT(/' DATE INPUT DATA SET, UNIT AND NAME.'/ C 1 (' ',I4,2X,A60)) C C READ AND PRINT UNDER CONTROL OF IP(2) AND IP(3) THE C DATES TO BE PROCESSED, MAX OF ND8. C C CALL RDI(KFILDO,IP(3),KFILDT,IDATE,ND8,ITEMP,7,'(7I10)',NDATES, C 1 99999999,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 CALL DATPRO(KFILDO,IDATE,NWORK,ND8,INCCYL,NDATES,IP(2),IP(3),IER) C C IF(IER.NE.0)THEN C WRITE(KFILDO,134) C134 FORMAT(/' ****ERROR IN DATE LIST. STOP IN U910 AT 134.') C CALL W3TAGE('INT910') C STOP 134 C ENDIF 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 INT910 AT 135.') CALL W3TAGE('INT910') STOP 135 ENDIF C C READ AND PROCESS THE UNIT NUMBERS AND FILE NAMES FOR THE C MOS-2000 EXTERNAL RANDOM ACCESS FILEA. FIVE ARE ALLOWED. C FILE WILL NOT BE OPENED. C CALL RDSNAM(KFILDI,KFILDO,KFILRA,RACESS,ITEMP,ITEMP,5,NUMRA, 1 'NOT','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 SETS.') C THE ABOVE PRINT IS FOR THE EMPTY SET. ENDIF C C CHECK FOR A MOS-2000 EXTERNAL RANDOM ACCESS FILE FOR C FORECASTS WITH UNIT NUMBER = 49. THIS WILL BE THE C OUTPUT FILE. SAVE THE FILE NAME IN CFILX. U900 C MUST HAVE AN OUTPUT EXTERNAL RANDOM ACCESS FILE; C WRITING IS U900'S ONLY PURPOSE. C DO 1432 J=1,NUMRA IF(KFILRA(J).EQ.49)GO TO 1434 1432 CONTINUE C WRITE(KFILDO,1433) 1433 FORMAT(/' ****NO UNIT NUMBER = 49 FOR RANDOM ACCESS FORECAST', 1 ' FILE.') KFILX=0 CFILX=' ' GO TO 1435 C 1434 KFILX=49 CFILX=RACESS(J) C C READ AND PROCESS UNIT NUMBER AND FILE NAME FOR VECTOR C OUTPUT. FILE WILL BE OPENED AS 'OLD'. C 1435 CALL RDSNAM(KFILDI,KFILDO,KFILIO,OUTNAM,IDUM,IDUM,1, 1 IOUT,'NEW','UNFORMATTED',IP,IER) IF(IER.NE.0)ISTOP=ISTOP+1 C IF(KFILIO.EQ.0)THEN WRITE(KFILDO,1437) 1437 FORMAT(/' NO SEQUENTIAL OUTPUT DATA SET PROVIDED;', 1 ' PACKED DATA WILL NOT BE WRITTEN.') OUTNAM=' ' ELSE WRITE(KFILDO,144)KFILIO,OUTNAM 144 FORMAT(/' SEQUENTIAL OUTPUT DATA SET, UNIT AND NAME.'/ 1 (' ',I4,2X,A60)) ENDIF C C READ AND PROCESS UNIT NUMBERS AND FILE NAMES FOR STATION LIST C (CALL LETTERS) AND STATION DIRECTORY WHICH HOLDS CALL LETTERS, C LATITUDE, LONGITUDE, WBAN NUMBER, ELEVATION, AND NAME FOR EACH C POSSIBLE STATION. THIS CAN BE A MASTER DIRECTORY, OR BE A DIRECTORY C SUPPLIED BY A USER. C CALL RDSNAM(KFILDI,KFILDO,KFILD,DIRNAM,ITEMP,ITEMP,2,N,'OLD', 1 'FORMATTED',IP,IER) C ITEMP( ) IS AN ARRAY AT LEAST 2 IN SIZE. IF(IER.NE.0)ISTOP=ISTOP+1 WRITE(KFILDO,147)(KFILD(J),DIRNAM(J),J=1,2) 147 FORMAT(/' STATION LIST AND DIRECTORY DATA SETS, UNITS AND NAMES.'/ 1 (' ',I4,2X,A60)) C C READ STATION LIST AND OTHER STATION INFORMATION. THE STATION C LIST CAN COME FROM THE DEFAULT INPUT FILE KFILDI, OR BE ON A C SEPARATE FILE AS DETERMINED BY KFILD(1). C 12/2004 - CHANGED FROM USING THE GROUP STATION READERS TO THE C NON-GROUP ONES. SET KGP TO 1 AND NGP(1) TO NSTA 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,ITIMEZ,ISDATA, 2 ND1,NSTA,IER) ELSE CALL RDSTAD(KFILDO,IP(4),IP(5),KFILD,NEW,CCALL,CCALLD, 1 NAME,NELEV,IWBAN,STALAT,STALON,ITIMEZ,ISDATA, 2 ND1,NSTA,IER) C CCALLD( ) IS TREATED HERE AS IF IT HAD THE SAME DIMENSIONS C AS CCALL( , ). THIS IS OK, BECAUSE ND5 IS GE ND1. ENDIF C IF(IER.NE.0)ISTOP=ISTOP+1 C THE DIRECTORY FILE IS READ ONLY ONCE. C C COMMENTED THE NEXT 5 LINES OUT WHEN THE GROUP DICTIONARY READERS C WERE ELIMINATED. SET KGP TO 1 AND NGP(1) TO NSTA JUST IN CASE C IT IS NEEDED LATER IN THE CODE. C C IF(KGP.GT.1)THEN C WRITE(KFILDO,1503)KGP,NSTA C1503 FORMAT(/' ',I3,' GROUPS OF STATIONS, TOTALING ',I4, C 1 ' STATIONS.') C ENDIF C KGP=1 NGP(1)=NSTA 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 C VARIABLE LIST. C CALL RDSNAM(KFILDI,KFILDO,KFILP,PRENAM,IDUM,IDUM,1,N,'OLD', 1 'FORMATTED',IP,IER) IF(IER.NE.0)ISTOP=ISTOP+1 WRITE(KFILDO,152)KFILP,PRENAM 152 FORMAT(/' VARIABLE LIST DATA SET, UNIT AND NAME.'/ 1 (' ',I4,2X,A60)) C C READ AND PROCESS UNIT NUMBER FOR THE PREDICTOR CONSTANTS 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 AND PRINT THE VARIABLES. C CALL RDVR79(KFILDO,IP(6),IP(7),IP(8),IP(9),KFILP,KFILCP, 1 ID,IDPARS,TRESHL,TRESHU,JD,JP,PLAIN, 2 ITAU,IWDTH,IPREC,CFMT,ISCALD,HEAD,NCAT,ND4, 3 NVRBL,ISTOP,IER) C D WRITE(KFILDO,1575)(HEAD(1:30,J),J=1,NVRBL) D1575 FORMAT(/' INT910, HEAD(J)'/(30A1)) IF(IER.EQ.42)THEN WRITE(KFILDO,158) 158 FORMAT(/' ****NO VARIABLE LIST PROVIDED.', 1 ' STOP IN INT910 AT 158.') CALL W3TAGE('INT910') STOP 158 C ENDIF C C SKIP RECORDS ON THE SEQUENTIAL OUTPUT FILE WHEN KSKIP NE 0. C THE STATION LIST IN ICALL( ) IS CHECKED WITH THE STATION C LIST AS THE FIRST RECORD IN THE FILE. IF THEY DO NOT C MATCH, THE PROGRAM RESPONDS TO KWRITE. WHEN RECORDS C ARE NOT SKIPPED, THE CALL LETTERS RECORD IS WRITTEN. C WHEN KFILIO = 0, SKIPWR DOES NOTHING. C KCHECK=1 CALL SKIPWR(KFILDO,KFILIO,KSKIP,KWRITE,KCHECK, 1 CCALL,ND1,NSTA, 2 CCALLD,ND5,IPACK,ND5, 3 NTOTBY,NTOTRC,L3264B,L3264W,IER) IF(IER.EQ.0)GO TO 160 WRITE(KFILDO,159)KFILIO 159 FORMAT(/' ****PROGRAM STOP AT 159 IN INT910 BECAUSE OF ERROR IN', 1 ' ROUTINE SKIPWR ON UNIT NO.',I4,'.'/ 2 ' OTHERWISE, GOOD DATA MIGHT BE OVERWRITTEN.') CALL W3TAGE('INT910') STOP 159 C STOP THE PROGRAM FOR SAFETY. OTHERWISE, GOOD DATA MIGHT C BE OVERWRITTEN. C C CHECK POSSIBLE INCONSISTENCY OF RANDOM ACCESS UNIT C NUMBERS WITH OTHERS USED BY THE PROGRAM. THIS SHOULD C PROTECT THE RANDOM ACCESS DATA SETS IN RACESS( ) C FROM BEING OVERWRITTEN. C 160 DO 170 J=1,NUMRA IF(KFILRA(J).NE.KFILDT .AND. 1 KFILRA(J).NE.KFILD(1).AND. 2 KFILRA(J).NE.KFILD(2).AND. 3 KFILRA(J).NE.KFILP .AND. 4 KFILRA(J).NE.KFILCP .AND. 5 KFILRA(J).NE.KFILIO .AND. 6 KFILRA(J).NE.KFILDO)GO TO 170 WRITE(KFILDO,165) 165 FORMAT(/' ****INCONSISTENCY IN INPUT UNIT NUMBERS IN KFILRA( )', 1 ' WITH EITHER KFILDT, KFILD( ), KFILP,', 2 ' KFILCP, KFILIO, OR KFILDO'/' STOP IN INT910 AT 165') CALL W3TAGE('INT910') STOP 165 C 170 CONTINUE C C CHECK THAT THE OUTPUT KFILIO IS NOT THE SAME AS INPUT C UNIT NUMBERS. C C IF(KFILIO.EQ.0)GO TO 180 IF(KFILIO.NE.KFILDT .AND. 1 KFILIO.NE.KFILD(1).AND. 2 KFILIO.NE.KFILD(2).AND. 3 KFILIO.NE.KFILP .AND. 4 KFILIO.NE.KFILCP)GO TO 176 WRITE(KFILDO,175) 175 FORMAT(/' ****INCONSISTENCY OF INPUT UNIT NUMBER FOR KFILIO', 1 ' WITH EITHER KFILDT, KFILD( ), KFILP,', 2 ' OR KFILCP'/' STOP IN INT910 AT 175') CALL W3TAGE('INT910') STOP 175 C C CHECK IP( ) NUMBERS WITH KFILRA( ) NUMBERS. C 176 DO 179 J=1,25 C IF(IP(J).EQ.0)GO TO 179 C DO 178 L=1,NUMRA IF(IP(J).NE.KFILRA(L))GO TO 178 WRITE(KFILDO,177)IP(J) 177 FORMAT(/' ****IP( ) NUMBER =',I3, 1 ' CONFLICTS WITH KFILRA( ) NUMBER.'/ 2 ' STOP IN INT910 AT 177.') CALL W3TAGE('INT910') STOP 177 178 CONTINUE 179 CONTINUE RETURN C C ERROR STOP BELOW IS FOR ERRORS OF CONTROL INFORMATION INPUT. 900 CALL IERX(KFILDO,KFILDO,IOS,'INT910',STATE) CALL W3TAGE('INT910') STOP 9999 END