SUBROUTINE INT660(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, 4 ITAU,ICHARS,IWDTH,IPREC,CFMT,ISCALD,HEAD, 5 PLAIN,L3264B,L3264W,ND4, 6 KFILIN,MODNUM,NAMIN,JFOPEN,NUMIN,ND6, 7 KFILRA,RACESS,NUMRA,OUTNAM, 8 IDATE,NDATES,NWORK,ND8, 9 IOPT,KSKIP,NSKIP,JSTOP,PXMISS,NPRINT, A NVRBL,LNGTH, B NTOTBY,NTOTRC,IPINIT,ISTOP,IER) C C$$$ SUBPROGRAM DOCUMENTATION BLOCK C C SUBPROGRAM: INT660 C PRGMMR: GLAHN ORG: W/OSD21 DATE: 1998-01-01 C C ABSTRACT: INT660 PERFORMS MUCH OF THE INITIALIZATION FOR U660. C C PROGRAM HISTORY LOG: C 98-01-01 GLAHN C 01-03-02 MALONEY ADDED NCEP DOCBLOCK. CHANGED CODE SO THAT C THE DATE IS READ FROM THE NCEP DATE FILE WITH C A CALL TO GET_NCEPDATE. ADDED CALLS TO W3TAGE. C 05-06-14 MALONEY 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 C USAGE: CALLED BY U660 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 MDLPACK FILE. (OUTPUT) C FORT.IP(J) - UNIT NUMBERS FOR OPTIONAL OUTPUT (J=1,25) C (SEE IP( ) UNDER "VARIABLES" BELOW.) (OUTPUT) C C VARIABLES C KFILDI = UNIT NUMBER TO READ INPUT FILE 'U660.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 MDLPACK 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 'U660', C THEN 4 CHARACTERS FROM IPINIT, THEN 2 CHARACTERS C FROM IP(J) (E.G., 'U660HRG130'). 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 U660. 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) = INDICATES WHETHER (>1) OR NOT (=0) THE LIST OF C FIELDS READ FOR DAY 1 WILL BE PRINTED TO THE FILE C WHOSE UNIT NUMBER IS IP(10). C (11) = THE VARIABLE ID'S OF THE ARCHIVED FIELDS C ACTUALLY NEEDED, IN ORDER AS THEY APPEAR ON C THE ARCHIVE TAPES. 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 (14) = INDICATES WHETHER (>0) OR NOT (=0) A DIAGNOSTIC C WILL BE PROVIDED ON UNIT IP(14) WHEN THERE ARE C NO DATA FOR A DESIRED DATE/TIME ON A PARTICULAR C INPUT FILE. THIS MIGHT HAPPEN FOR EACH DATE/TIME C AND A LOT OF OUTPUT BE CREATED. 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 (23) = INDICATES WHETHER (>0) OR NOT (=0) STATEMENTS C ABOUT EOF AND FILE OPENINGS AND CLOSINGS WILL C BE OUTPUT FOR PRINTING ON UNIT IP(23). C (24) = INDICATES WHETHER (>0) OR NOT (=0) A LISTING C OF WHERE THE VARIABLES ARE TO BE FOUND IS C CREATED FOR PRINTING ON UNIT IP(24). THESE C ARE THE VALUES OF NWHERE. 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 IN RDSTGA TO KEEP TRACK OF THE STATIONS C FOUND IN THE DIRECTORY (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 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 U660, WHICH IS ONLY FORMING C BINARIES. THE "G" VARIABLE HAS NO MEANING IN U660, 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; 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 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 THE C COLLATED DATA (N=1,ND4). ISCALD COMES FROM THE VARIABLE C CONSTANT FILE, MODIFIED TO BE 2 FOR GRID BINARIES, C AND 0 FOR BINARIES. ZERO WHEN NOT FOUND IN THE C FILE. 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 USED C (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 KFILIN(J) = UNIT NUMBERS FOR INPUT DATA, ALL IN MDL MOS-2000 C FORMAT. INPUT CAN INCLUDE BOTH INTERPOLATED C PREDICTOR FILES AND PREDICTAND DATA (J=1,ND6). C (OUTPUT) C MODNUM(J) = THE "MODEL" NUMBER CORRESPONDING TO KFILIN(J), C AND NAMIN(J) (J=1,ND6). (OUTPUT) C NAMIN(J) = HOLDS DATA SET NAMES FOR THE UNIT NUMBERS C IN KFILIN(J) (J=1,ND6). (CHARACTER*60) (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). (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,5). C (OUTPUT) C RACESS(J) = FILE NAMES FOR CONSTANT DATA READ ON UNIT C NOS. KFILRA(J) (J=1,5). (CHARACTER*60) (OUTPUT) C NUMRA = NUMBER OF VALUES IN KFILRA( ) AND RACESS( ). C (OUTPUT) C OUTNAM = NAME OF DATA SET FOR PACKED VECTOR OUTPUT. C (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 IOPT = USED TO INDICATE DESIRED PROCESSING (IF ANY) IN CHNGID. C SEE CHNGID FOR VALUES AND THEIR MEANINGS. (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 KWRITE = 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. C NSKIP = THE NUMBER OF ERRORS THAT WILL BE TOLERATED ON DAY 1 C WITHOUT HALTING. (OUTPUT) C JSTOP = THE NUMBER OF ERRORS THAT WILL BE TOLERATED ON THE C 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 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 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 PREDICTOR AND C PREDICTAND (OR VARIABLE) LIST. (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 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 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. (INTERNAL) C C C SUBPROGRAMS CALLED: C UNIQUE - NONE C LIBRARY: C MOSLIB - IPOPEN, IERX, DATPRO, RDI, RDSNAM, RDVR66, TIMPR, C SKIPWR, IPRINT, RDSTAL, RDSTAD C W3LIB - W3TAGE C C EXIT STATES: C COND = 0 - SUCCESSFUL RUN C 131 - ERROR READING NCEP DATE FILE 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 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$$$ 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 NAMIN(ND6),RACESS(5) CHARACTER*60 DIRNAM(2),PRENAM,CONNAM,DATNAM,OUTNAM CHARACTER*72 RUNID/' '/ C DIMENSION NELEV(ND1),IWBAN(ND1),STALAT(ND1),STALON(ND1), 1 ISDATA(ND1),IPACK(ND1),NGP(ND1),ITIMEZ(ND1) DIMENSION ID(4,ND4),IDPARS(15,ND4),TRESHL(ND4),TRESHU(ND4), 1 JD(4,ND4),JP(ND4),ITAU(ND4), 2 IWDTH(ND4),IPREC(ND4),ISCALD(ND4) DIMENSION KFILIN(ND6),MODNUM(ND6),JFOPEN(ND6) 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,1,1,1,0,1,1,1,0,0,0,0,0,0,1,1,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='U660.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,'U660',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 'U660' 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 U660 ') 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,NSKIP,JSTOP,IOPT,NEW,NALPH,PXMISS,NPRINT, 2 ICHARS,LNGTH 125 FORMAT(7(I10,/),F10.0,/,(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 PRU660. 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 WRITE(KFILDO,127)KSKIP,KWRITE,NSKIP,JSTOP,IOPT,NEW,NALPH, 1 PXMISS,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 ,' 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 ,' IOPT ',I10,' DESIRED CHNGID PROCESSING INDICATOR',/ 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 ,' 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 INT660. STOP AT 131.') CALL W3TAGE('INT660') 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 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 INT660 AT 135.') CALL W3TAGE('INT660') STOP 135 ENDIF C C READ AND PROCESS UNIT NUMBERS AND FILE NAMES FOR ALL MDLPACK 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(M),NAMIN(M),M=1,NUMIN) 142 FORMAT(/,' ',I2,' MODEL INPUT DATA SETS, UNITS AND NAMES.',/ 1 ,(' ',I4,2X,A60)) ENDIF C C READ AND PROCESS THE UNIT NUMBER AND FILE NAME FOR THE C MOS-2000 EXTERNAL RANDOM ACCESS FILE. FIVE ARE ALLOWED, C FILE WILL NOT BE OPENED. C CALL RDSNAM(KFILDI,KFILDO,KFILRA,RACESS,ITEMP,ITEMP,5,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 VECTOR C OUTPUT. FILE WILL BE OPENED AS 'OLD'. THEREFORE, THE FILE C SHOULD EXIST. HOWEVER, U660 WILL OPEN IT ANYWAY AND PROCEED C WITH AN ERROR INDICATED BY IER NE 0. C 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,1435) 1435 FORMAT(/,' NO OUTPUT DATA SET PROVIDED;', 1 ' PACKED 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 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 06/2005 - CHANGED FROM USING GROUP STATION READERS C RDSTGN AND RDSTGA TO NON-GROUP READERS RDSTAL AND RDSTAD. C SET KGP TO 1 AND NGP(1) TO NSTA. C NSTA=0 KGP=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 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 PREDICTOR C AND PREDICTAND (OR 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 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, BOTH PREDICTORS C AND PREDICTANDS. C CALL RDVR66(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,ND4, 3 NVRBL,ISTOP,IER) C D WRITE(KFILDO,1575)(HEAD(1:30,J),J=1,NVRBL) D1575 FORMAT(/,' INT660 HEAD(J)',/,(30A1)) 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 INT660 AT 158.') CALL W3TAGE('INT660') STOP 158 C ENDIF C C SKIP RECORDS ON THE 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) 159 FORMAT(/,' ****PROGRAM STOP AT 159 BECAUSE OF ERROR IN', 1 ' ROUTINE SKIPWR. OTHERWISE, GOOD DATA MIGHT', 2 ' BE OVERWRITTEN.') CALL W3TAGE('INT660') STOP 159 C STOP THE PROGRAM FOR SAFETY. OTHERWISE, GOOD DATA MIGHT C BE OVERWRITTEN. 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. C 160 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.KFILD(1) .AND. 7 KFILIN(J).NE.KFILD(2) .AND. 8 KFILIN(J).NE.KFILP .AND. 9 KFILIN(J).NE.KFILCP .AND. A KFILIN(J).NE.KFILIO)GO TO 170 WRITE(KFILDO,165) 165 FORMAT(/,' ****INCONSISTENCY IN INPUT UNIT NUMBERS IN KFILIN( )', 1 ' WITH EITHER KFILDT, KFILRA( ), KFILD( ), KFILP,', 2 ' KFILCP, OR KFILIO',/,' STOP IN INT660 AT 165') CALL W3TAGE('INT660') STOP 165 C 170 CONTINUE C RETURN C C ERROR STOP BELOW IS FOR ERRORS OF CONTROL INFORMATION INPUT. 900 CALL IERX(KFILDO,KFILDO,IOS,'INT660',STATE) CALL W3TAGE('INT660') STOP 9999 END