SUBROUTINE U155CK(KFILDO,KFILIO,KFILDI,KFILIN,NUMIN, 1 KFILD,KFILRA,NUMRA,IP,IPIN,KFIL10, 2 KFILVO,KFILOG,KFILAN) C C JUNE 2004 GLAHN MDL MOS-2000 C ADAPTED FROM U600CK C OCTOBER 2004 GLAHN ADDED SOME CHECKS C SEPTEMBER 2005 GLAHN ADDED A FEW COMMAS PER TRIMARCO C NOVEMBER 2007 GLAHN CORRECTED KFILOG TO KFILVO IN C DO 220 LOOP C JUNE 2014 GLAHN INSERTED CALL TO W3TAGE BEFORE STOPS C NOVEMBER 2014 GLAHN REVISED W3TAG PER JUDY C C PURPOSE C U155CK CHECKS INCONSISTENCIES OF UNIT NUMBERS FOR U155. C******************************************************************** C NOTE THAT KFILAN( ) IN CALLING PROGRAM IS NOT DIMENSIONED C HERE, SO ONLY KFILAN(1) IS CHECKED. THE DIMENSIONING WAS C ADDED FOR THE IBM. IF CHECKING FOR THE IBM IS NECESSARY, C IT CAN BE ADDED. C******************************************************************** C C DATA SET USE C KFILDO - UNIT NUMBER OF OUTPUT (PRINT) FILE. (INPUT) C C VARIABLES C KFILDO = UNIT NUMBER OF OUTPUT (PRINT) FILE. C (INPUT) C KFILIO = UNIT NUMBER FOR PRIMARY GRIDDED OUTPUT. C (INPUT) C KFILDI = UNIT NUMBER OF INPUT FILE. SET BY DATA C STATEMENT. (INPUT) C KFILIN(J) = UNIT NUMBERS OF TDLPACK INPUT (J=1,NUMIN). C (INPUT) C NUMIN = NUMBER OF VALUES IN KFILIN( ). (INPUT) C KFILD(J) = UNIT NUMBER FOR STATION LIST AND DIRECTORY C (J=1,2). (INPUT) C KFILRA(J) = UNIT NUMBERS FOR READING RANDOM ACCESS DATA C (J=1,NUMRA). (INPUT) C NUMRA = NUMBER OF VALUES IN KFILRA( ). (INPUT) C IP(J) = UNIT NUMBERS FOR OPTIONAL OUTPUT (J=1,IPIN) C (INPUT) C IPIN = NUMBER OF VALUES IN IP( ). (INPUT) C KFIL10 = UNIT NUMBER FOR INTERNAL MOS-2000 STORAGE. C (INPUT) C KFILVO = UNIT NUMBER FOR GRIDDED DATA IN VECTOR FORMAT. C (INPUT) C KFILOG = UNIT NUMBER FOR DISPOSABLE GIIDDED OUTPUT. C (INPUT) C KFILAN = UNIT NUMBER FOR READING THE INDIVIDUAL .CN C ANALYSIS FILES. (INPUT) C 1 2 3 4 5 6 7 X C C NONSYSTEM SUBROUTINES USED C NONE C DIMENSION IP(IPIN),KFILRA(NUMRA),KFILIN(NUMIN),KFILD(2) C C CHECK POSSIBLE INCONSISTENCY OF INPUT UNIT NUMBERS WITH C OTHERS USED BY THE PROGRAM. C DO 120 J=1,NUMIN DO 119 L=1,NUMRA C IF(KFILIN(J).EQ.KFILRA(L))THEN WRITE(KFILDO,115) 115 FORMAT(/' ****INCONSISTENCY IN INPUT UNIT NUMBERS IN', 1 ' KFILIN( ) WITH KFILRA( )') WRITE(KFILDO,116)(KFILIN(M),M=1,NUMIN) 116 FORMAT(' KFILIN =',38I3/(' ',38I3)) WRITE(KFILDO,117)(KFILRA(M),M=1,NUMRA) 117 FORMAT(' KFILRA =',38I3) WRITE(KFILDO,118) 118 FORMAT(' STOP IN U155CK AT 118') CALL W3TAGE('U155CK') STOP 118 ENDIF C 119 CONTINUE 120 CONTINUE C DO 140 J=1,NUMIN DO 139 L=1,IPIN C IF(KFILIN(J).EQ.IP(L))THEN WRITE(KFILDO,135) 135 FORMAT(/' ****INCONSISTENCY IN INPUT UNIT NUMBERS IN', 1 ' KFILIN( ) WITH IP( )') WRITE(KFILDO,136)(KFILIN(M),M=1,NUMIN) 136 FORMAT(' KFILIN =',38I3/(' ',38I3)) WRITE(KFILDO,137)(IP(M),M=1,IPIN) 137 FORMAT(' IP =',38I3) WRITE(KFILDO,138) 138 FORMAT(' STOP IN U155CK AT 138') CALL W3TAGE('U155CK') STOP 138 ENDIF C 139 CONTINUE 140 CONTINUE C DO 160 J=1,NUMRA DO 159 L=1,IPIN C IF(KFILRA(J).EQ.IP(L))THEN WRITE(KFILDO,155) 155 FORMAT(/' ****INCONSISTENCY IN INPUT UNIT NUMBERS IN', 1 ' KFILRA( ) WITH IP( )') WRITE(KFILDO,156)(KFILRA(M),M=1,NUMRA) 156 FORMAT(' KFILRA =',38I3) WRITE(KFILDO,157)(IP(M),M=1,IPIN) 157 FORMAT(' IP =',38I3) WRITE(KFILDO,158) 158 FORMAT(' STOP IN U155CK AT 158') CALL W3TAGE('U155CK') STOP 158 ENDIF C 159 CONTINUE 160 CONTINUE C DO 180 J=1,NUMIN C IF(KFILIN(J).EQ.KFILIO.OR. 1 KFILIN(J).EQ.KFILDI.OR. 2 KFILIN(J).EQ.KFILDO.OR. 3 KFILIN(J).EQ.KFIL10.OR. 4 KFILIN(J).EQ.KFILVO.OR. 5 KFILIN(J).EQ.KFILOG.OR. 6 KFILIN(J).EQ.KFILAN)THEN WRITE(KFILDO,175) 175 FORMAT(/' ****INCONSISTENCY IN INPUT UNIT NUMBERS IN', 1 ' KFILIN( ) WITH', 2 ' KFILIO, KFILDI, KFILDO,', 3 ' KFIL10, KFILVO, KFILOG, OR KFILAN') WRITE(KFILDO,176)(KFILIN(M),M=1,NUMIN) 176 FORMAT(' KFILIN =',38I3/(' ',38I3)) WRITE(KFILDO,177)KFILIO,KFILDI,KFILDO, 1 KFIL10,KFILVO,KFILOG,KFILAN 177 FORMAT(' KFILIO, KFILDI, KFILDO,', 1 ' KFIL10, KFILVO, KFILOG, KFILAN = ',7I3) WRITE(KFILDO,178) 178 FORMAT(' STOP IN U155CK AT 178') CALL W3TAGE('U155CK') STOP 178 ENDIF C 180 CONTINUE C DO 200 J=1,NUMRA C IF(KFILRA(J).EQ.KFILIO.OR. 1 KFILRA(J).EQ.KFILDI.OR. 2 KFILRA(J).EQ.KFILDO.OR. 3 KFILRA(J).EQ.KFIL10.OR. 4 KFILRA(J).EQ.KFILVO.OR. 5 KFILRA(J).EQ.KFILOG.OR. 6 KFILRA(J).EQ.KFILAN)THEN WRITE(KFILDO,195) 195 FORMAT(/' ****INCONSISTENCY IN INPUT UNIT NUMBERS IN', 1 ' KFILRA( ) WITH', 2 ' KFILIO, KFILDI, KFILDO,', 3 ' KFIL10, KFILVO, KFILOG, OR KFILAN') WRITE(KFILDO,196)(KFILRA(M),M=1,NUMRA) 196 FORMAT(' KFILRA =',38I3) WRITE(KFILDO,197)KFILIO,KFILDI,KFILDO, 1 KFIL10,KFILVO,KFILOG,KFILAN 197 FORMAT(' KFILIO, KFILDI, KFILDO,', 1 ' KFIL10, KFILVO, KFILOG, KFILAN = ',7I3) WRITE(KFILDO,198) 198 FORMAT(' STOP IN U155CK AT 198') CALL W3TAGE('U155CK') STOP 198 ENDIF C 200 CONTINUE C DO 220 J=1,IPIN C IF((IP(J).EQ.KFILIO.AND.KFILIO.NE.0).OR. 1 IP(J).EQ.KFILDI.OR. 2 IP(J).EQ.KFIL10.OR. 3 (IP(J).EQ.KFILVO.AND.KFILVO.NE.0).OR. 4 (IP(J).EQ.KFILAN.AND.KFILAN.NE.0).OR. 5 (IP(J).EQ.KFILOG.AND.KFILOG.NE.0))THEN C NOTE THAT IP( ) = KFILDO IS ALLOWED. ALSO, BOTH C IP( ) AND KFILOG, KFILVO, AND KFILAN CAN BE ZERO. WRITE(KFILDO,215) 215 FORMAT(/' ****INCONSISTENCY IN INPUT UNIT NUMBERS IN', 1 ' IP( ) WITH', 2 ' KFILIO, KFILDI,', 3 ' KFIL10, KFILVO, KFILOG, OR KFILAN') WRITE(KFILDO,216)(IP(M),M=1,IPIN) 216 FORMAT(' IP =',38I3) WRITE(KFILDO,217)KFILIO,KFILDI, 1 KFIL10,KFILVO,KFILOG,KFILAN 217 FORMAT(' KFILIO, KFILDI,', 1 ' KFIL10, KFILVO, KFILOG, KFILAN = ',6I3) WRITE(KFILDO,218) 218 FORMAT(' STOP IN U155CK AT 218') CALL W3TAGE('U155CK') STOP 218 ENDIF C 220 CONTINUE C C IF(KFILIO.NE.0.AND. 1 (KFILIO.EQ.KFILDI.OR. 1 KFILIO.EQ.KFILDO.OR. 2 KFILIO.EQ.KFIL10.OR. 3 KFILIO.EQ.KFILVO.OR. 4 KFILIO.EQ.KFILOG.OR. 5 KFILIO.EQ.KFILAN))THEN WRITE(KFILDO,225) 225 FORMAT(/' ****INCONSISTENCY IN INPUT UNIT NUMBER', 1 ' KFILIO WITH', 2 ' KFILDI, KFILDO,', 3 ' KFIL10, KFILVO, KFILOG, OR KFILAN') WRITE(KFILDO,226)KFILIO 226 FORMAT(' KFILIO =',I3) WRITE(KFILDO,227)KFILDI,KFILDO, 1 KFIL10,KFILVO,KFILOG,KFILAN 227 FORMAT(' KFILDI, KFILDO,', 1 ' KFIL10, KFILVO, KFILOG, KFILAN = ',6I3) WRITE(KFILDO,228) 228 FORMAT(' STOP IN U155CK AT 228') CALL W3TAGE('U155CK') STOP 228 ENDIF C IF(KFILDI.EQ.KFILDO.OR. 1 KFILDI.EQ.KFIL10.OR. 2 KFILDI.EQ.KFILVO.OR. 3 KFILDI.EQ.KFILOG)THEN C NOTE THAT KFILDI AND KFILAN CAN BE THE SAME, C BECAUSE ALL OTHER USE OF KFILDI HAS COMPLETED C WHEN THE INDIVIDUAL .CN FILES ARE READ. WRITE(KFILDO,235) 235 FORMAT(/' ****INCONSISTENCY IN INPUT UNIT NUMBER', 1 ' KFILDI WITH', 2 ' KFILDO,', 3 ' KFIL10, KFILVO, KFILOG, OR KFILAN') WRITE(KFILDO,236)KFILDI 236 FORMAT(' KFILDI =',I3) WRITE(KFILDO,237)KFILDO,KFIL10,KFILVO,KFILOG,KFILAN 237 FORMAT(' KFILDO,', 1 ' KFIL10, KFILVO, KFILOG, KFILAN = ',5I3) WRITE(KFILDO,238) 238 FORMAT(' STOP IN U155CK AT 238') CALL W3TAGE('U155CK') STOP 238 ENDIF C IF(KFILDO.EQ.KFIL10.OR. 1 KFILDO.EQ.KFILVO.OR. 2 KFILDO.EQ.KFILOG.OR. 3 KFILDO.EQ.KFILAN)THEN WRITE(KFILDO,245) 245 FORMAT(/' ****INCONSISTENCY IN INPUT UNIT NUMBER', 1 ' KFILDO WITH', 2 ' KFIL10, KFILVO, KFILOG, OR KFILAN') WRITE(KFILDO,246)KFILDO 246 FORMAT(' KFILDO =',I3) WRITE(KFILDO,247) KFIL10,KFILVO,KFILOG,KFILAN 247 FORMAT(' KFIL10, KFILVO, KFILOG, KFILAN = ',4I3) WRITE(KFILDO,248) 248 FORMAT(' STOP IN U155CK AT 248') CALL W3TAGE('U155CK') STOP 248 ENDIF C IF(KFIL10.EQ.KFILVO.OR. 1 KFIL10.EQ.KFILOG.OR. 2 KFIL10.EQ.KFILAN)THEN WRITE(KFILDO,265) 265 FORMAT(/' ****INCONSISTENCY IN INPUT UNIT NUMBER', 1 ' KFIL10 WITH KFILVO, KFILOG, OR KFILAN') WRITE(KFILDO,266)KFIL10 266 FORMAT(' KFIL10 =',I3) WRITE(KFILDO,267)KFILVO,KFILOG,KFILAN 267 FORMAT(' KFILVO, KFILOG, KFILAN = ',3I3) WRITE(KFILDO,268) 268 FORMAT(' STOP IN U155CK AT 268') CALL W3TAGE('U155CK') STOP 268 ENDIF C IF(((KFILVO.NE.0.OR.KFILOG.NE.0).AND.KFILVO.EQ.KFILOG).OR. 1 KFILVO.EQ.KFILAN)THEN C KFILVO AND KFILOG CAN BE ZERO, BUT NOT KFILAN. WRITE(KFILDO,275) 275 FORMAT(/' ****INCONSISTENCY IN INPUT UNIT NUMBER', 1 ' KFILVO WITH KFILOG OR KFILAN') WRITE(KFILDO,276)KFILVO 276 FORMAT(' KFILVO =',I3) WRITE(KFILDO,277)KFILOG,KFILAN 277 FORMAT(' KFILOG, KFILAN = ',2I3) WRITE(KFILDO,278) 278 FORMAT(' STOP IN U155CK AT 278') CALL W3TAGE('U155CK') STOP 278 ENDIF C IF(KFILOG.EQ.KFILAN)THEN WRITE(KFILDO,285) 285 FORMAT(/' ****INCONSISTENCY IN INPUT UNIT NUMBER', 1 ' KFILOG WITH KFILAN') WRITE(KFILDO,286)KFILOG 286 FORMAT(' KFILOG =',I3) WRITE(KFILDO,287)KFILAN 287 FORMAT(' KFILAN =',I3) WRITE(KFILDO,288) 288 FORMAT(' STOP IN U155CK AT 288') CALL W3TAGE('U155CK') STOP 288 ENDIF C DO 400 J=1,2 DO 300 L=1,NUMIN C IF(KFILD(J).EQ.KFILIN(L))THEN WRITE(KFILDO,295) 295 FORMAT(/' ****INCONSISTENCY IN INPUT UNIT NUMBERS IN', 1 ' KFILIN( ) WITH KFILD( )') WRITE(KFILDO,296)(KFILIN(M),M=1,NUMIN) 296 FORMAT(' KFILIN =',38I3/(' ',38I3)) WRITE(KFILDO,297)(KFILD(M),M=1,2) 297 FORMAT(' KFILD =',38I3/(' ',38I3)) WRITE(KFILDO,298) 298 FORMAT(' STOP IN U155CK AT 298') CALL W3TAGE('U155CK') STOP 298 ENDIF C 300 CONTINUE C DO 310 L=1,IPIN C IF(KFILD(J).EQ.IP(L))THEN WRITE(KFILDO,305) 305 FORMAT(/' ****INCONSISTENCY IN INPUT UNIT NUMBERS IN', 1 ' IP( ) WITH KFILD( )') WRITE(KFILDO,306)(KFILD(M),M=1,2) 306 FORMAT(' KFILD =',38I3/(' ',38I3)) WRITE(KFILDO,307)(IP(M),M=1,IPIN) 307 FORMAT(' IPIN =',38I3) WRITE(KFILDO,308) 308 FORMAT(' STOP IN U155CK AT 308') CALL W3TAGE('U155CK') STOP 308 ENDIF C 310 CONTINUE C DO 320 L=1,NUMRA C IF(KFILD(J).EQ.KFILRA(L))THEN WRITE(KFILDO,315) 315 FORMAT(/' ****INCONSISTENCY IN INPUT UNIT NUMBERS IN', 1 ' KFILRA( ) WITH KFILD( )') WRITE(KFILDO,316)(KFILD(M),M=1,2) 316 FORMAT(' KFILD =',38I3/(' ',38I3)) WRITE(KFILDO,317)(KFILRA(M),M=1,NUMRA) 317 FORMAT(' KFILRA =',38I3) WRITE(KFILDO,318) 318 FORMAT(' STOP IN U155CK AT 318') CALL W3TAGE('U155CK') STOP 318 ENDIF C 320 CONTINUE C IF(KFILD(J).EQ.KFILIO.OR. 1 KFILD(J).EQ.KFILDI.OR. 2 KFILD(J).EQ.KFILDO.OR. 3 KFILD(J).EQ.KFIL10.OR. 4 KFILD(J).EQ.KFILVO.OR. 5 KFILD(J).EQ.KFILOG.OR. 6 KFILD(J).EQ.KFILAN)THEN WRITE(KFILDO,325) 325 FORMAT(/' ****INCONSISTENCY IN INPUT UNIT NUMBERS IN', 1 ' KFILD( ) WITH', 2 ' KFILIO, KFILDI, KFILDO,', 3 ' KFIL10, KFILVO, KFILOG, OR KFILAN') WRITE(KFILDO,326)(KFILD(M),M=1,2) 326 FORMAT(' KFILD =',38I3/(' ',38I3)) WRITE(KFILDO,327)KFILIO,KFILDI,KFILDO, 1 KFIL10,KFILVO,KFILOG,KFILAN 327 FORMAT(' KFILIO, KFILDI, KFILDO,', 1 ' KFIL10, KFILVO, KFILOG, KFILAN = ',7I3) WRITE(KFILDO,328) 328 FORMAT(' STOP IN U155CK AT 328') CALL W3TAGE('U155CK') STOP 328 ENDIF C 400 CONTINUE C C CHECK RANDOM ACCESS UNITS 42-49. C DO 404 L=1,NUMRA C IF(KFILRA(L).LT.42.OR.KFILRA(L).GT.49)THEN WRITE(KFILDO,402)(KFILRA(J),J=1,NUMRA) 402 FORMAT(/' ****RANDOM ACCESS UNIT NUMBER NOT IN RANGE 42-49.', 1 ' NUMBERS ARE',10I6) WRITE(KFILDO,403) 403 FORMAT(' STOP IN U155CK AT 403') CALL W3TAGE('U155CK') STOP 403 ENDIF C 404 CONTINUE C C CHECK ALL UNIT NUMBERS EXCEPT KFILRA( ) ARE NOT 42-49. C IF((KFILD(1).GE.42.AND.KFILD(1).LE.49).OR. 1 (KFILD(2).GE.42.AND.KFILD(2).LE.49).OR. 2 (KFILDI.GE.42.AND.KFILDI.LE.49).OR. 3 (KFIL10.GE.42.AND.KFIL10.LE.49).OR. 4 (KFILVO.GE.42.AND.KFILVO.LE.49).OR. 5 (KFILOG.GE.42.AND.KFILOG.LE.49).OR. 6 (KFILAN.GE.42.AND.KFILAN.LE.49).OR. 7 (KFILDO.GE.42.AND.KFILDO.LE.49))THEN WRITE(KFILDO,405) 405 FORMAT(/' ****ONE OR MORE UNIT NUMBERS ARE INCORRECTLY IN THE', 1 ' RANGE 42-49 RESERVED FOR RANDOM ACCESS FILES.') WRITE(KFILDO,406) 406 FORMAT(' STOP IN U155CK AT 406') CALL W3TAGE('U155CK') STOP 406 ENDIF C DO 410 L=1,NUMIN IF(KFILIN(L).GE.42.AND.KFILIN(L).LE.49)THEN WRITE(KFILDO,408)(KFILIN(J),J=1,NUMIN) 408 FORMAT(/' ****ONE OR MORE KFILIN( ) UNIT NUMBERS ARE', 1 ' INCORRECTLY IN THE RANGE 42-49 RESERVED FOR RANDOM', 2 ' ACCESS FILES.'/ 3 ' KFILIN( ) NUMBERS ARE:',30I3/(27X,30I3)) WRITE(KFILDO,409) 409 FORMAT(' STOP IN U155CK AT 409') CALL W3TAGE('U155CK') STOP 409 ENDIF C 410 CONTINUE C DO 420 L=1,IPIN IF(IP(L).GE.42.AND.IP(L).LE.49)THEN WRITE(KFILDO,418)(IP(J),J=1,IPIN) 418 FORMAT(/' ****ONE OR MORE IP( ) UNIT NUMBERS ARE', 1 ' INCORRECTLY IN THE RANGE 42-49 RESERVED FOR RANDOM', 2 ' ACCESS FILES.'/ 3 ' IP( ) NUMBERS ARE:',30I3) WRITE(KFILDO,419) 419 FORMAT(' STOP IN U155CK AT 419') CALL W3TAGE('U155CK') STOP 419 ENDIF C 420 CONTINUE C RETURN END