SUBROUTINE SNO2GET(SCVH,IYR,IMN,IDY, JMAP,INSNOSAB, LIST) C 00049000 C ABSTRACT: READS AND VERIFIES INTEGRAPH "SNOW CARDS" FILE FROM 00049100 C NESDIS/SAB WEEKLY 190-KM N.H. SNOW/ICE ANAL ON CEMSCS. C CONVERTS ABOVE I3 INTEGER FILE OF 0'S AND 1'S TO REAL 00049200 C C INPUT ARGUMENTS: C JMAP - 89X89 WORK ARRAY C INSNOSAB - UNIT NO. FOR NESDIS WEEKLY SNOW/ICE ANAL C LIST - UNIT NO. FOR PRINT C OUTPUT ARGUMENTS: C SCVH - REAL SNOW/ICE ANAL FLAGS OF ZEROE'S AND ONE'S C IYR - YEAR OF ANAL C IMN - MONTH OF ANAL C IDY - DAY OF ANAL C REAL SCVH(89,89) INTEGER JMAP(89,89) C INTEGER JROW 00054000 INTEGER ICOLS(24) 00054100 C 00054400 CHARACTER*80 CARD 00054500 CHARACTER*10 CENDOF 00054600 CHARACTER*11 CNESDI 00054700 CHARACTER*6 CWEEK C 00056100 DATA IMAX,JMAX / 89,89 / 00056200 C 00056300 DATA CENDOF / 'ENDOF FILE' / 00056400 DATA CNESDI / 'NESDIS SNOW' / 00056500 DATA CWEEK / 'WEEKLY' / C REWIND INSNOSAB 00057400 C 00057500 C ... READ 1ST OF 3 HEADER CARDS BEFORE THE "FIRST" DATA CARD 00057600 READ(INSNOSAB,105,ERR=911,END=911) CARD 00057700 105 FORMAT(A) 00057800 IF(CARD(1:10) .EQ. CENDOF) GO TO 911 00057900 IF(CARD(1:11) .NE. CNESDI) GO TO 911 00058000 READ(CARD,15,END=911) IYR0,IMN0,IDY0 15 FORMAT(26X,I2,1X,I2,1X,I2) WRITE(LIST,102) IYR0, IMN0, IDY0 102 FORMAT(1H ,' IYR0=',I4,' IMN0=',I4,' IDY0=',I4) C C ... 2ND HEADER CARD HAS YEAR + WEEK (YYWW) 00058900 READ(INSNOSAB,105,ERR=911,END=911) CARD 00059000 IF(CARD(1:10) .EQ. CENDOF) GO TO 911 00059100 READ(CARD,17,END=911) IYR,IWK 00059200 17 FORMAT(2I2) 00059300 WRITE(LIST,108) IYR, IWK 108 FORMAT(1H ,' IYR =',I4,20x,' IWK=',I4) 00059600 C 00061000 C ... 3RD HEADER CARD HAS DATES OF START AND END OF WEEK 00061100 C ... MOST APPROPRIATE PRODUCT VALID TIME IS END OF WEEK C 00061500 READ(INSNOSAB,105,ERR=911,END=911) CARD 00061600 IF(CARD(1:10) .EQ. CENDOF) GO TO 911 00061700 IF(CARD(22:27).NE. CWEEK ) GO TO 911 READ(CARD,18,END=911) IYR,IMN,IDY 00061800 18 FORMAT(9X,I2,1X,I2,1X,I2) 00061900 WRITE(LIST,109) IYR, IMN, IDY 109 FORMAT(1H ,' IYR =',I4,' IMN =',I4,' IDY =',I4) IF((IYR.NE.IYR0).OR.(IMN.NE.IMN0).OR.(IDY.NE.IDY0)) GO TO 911 C 00062400 C ... INITIALIZE JMAP WITH ZEROS 00060400 DO 433 J = 1,JMAX 00060500 DO 422 I = 1,IMAX 00060600 JMAP(I,J) = 0 00060700 422 CONTINUE 00060800 433 CONTINUE 00060900 C 00062500 C ... NOW WE START THE LOOP ON READING DATA CARDS ... 00062600 C 00062700 20 CONTINUE 00062800 READ(INSNOSAB,105,ERR=911,END=911) CARD 00062900 IF(CARD(1:10) .EQ. CENDOF) GO TO 911 00063000 READ(CARD,1000,END=911)JROW,ICOLS 00063100 1000 FORMAT(I3,3X,24I3) 00063200 C 00063400 IF(JROW .LT. 1) GO TO 50 00063500 IF(JROW .GT. JMAX) GO TO 50 00063600 C ... JROW IS WITHIN BOUNDS ... 00063700 C ... ICOLS HAVE IBEGIN/IEND PAIRS 00063800 DO 477 K = 1,24,2 00063900 IF(ICOLS(K) .LE. 0) GO TO 20 00064000 C ... NO MORE INFO ON CARD IF IBEGIN = 0 00064100 C ... WHICH IS THE USUAL EXIT FROM THIS LOOP 00064200 C 00064300 IF(ICOLS(K) .GT. IMAX) GO TO 20 00064400 C ... WHICH REJECTS IBEGIN OFF GRID 00064500 IF(ICOLS(K+1) .LE. 0) ICOLS(K+1)=IMAX 00064600 C ... WHICH RESETS IEND TO IMAX IF IEND =< 0 00064700 IF(ICOLS(K+1) .GT. IMAX) ICOLS(K+1)=IMAX 00064800 C ... WHICH RESETS IEND TO IMAX IF IEND > IMAX 00064900 C 00065000 C ... CALL SNOW1 ; TO MARK MAP ARRAYS ... 00065100 M1 = ICOLS(K) 00065200 M2 = ICOLS(K+1) - 1 00065300 DO 466 I = M1,M2 00065400 JMAP(I,JROW) = 1 00065500 466 CONTINUE 00065600 477 CONTINUE 00065700 C 00065800 GO TO 20 00065900 C 00066000 50 CONTINUE 00066100 C C ... COMES HERE ON A -1 CARD SIGNALLING END OF DATA 00066200 16 CONTINUE 00066300 READ(INSNOSAB,105,ERR=944,END=944) CARD 00066400 IF(CARD(1:10) .EQ. CENDOF) GO TO 944 00066500 READ(CARD,17,END=944) I,J 00066600 IF(I .LT. 0) GO TO 19 00066700 C ... SOME ADSNO IN HERE ... 00066800 GO TO 16 00066900 C 00067000 19 CONTINUE 00067100 21 CONTINUE 00067200 READ(INSNOSAB,105,ERR=955,END=955) CARD 00067300 IF(CARD(1:10) .EQ. CENDOF) GO TO 955 00067400 READ(CARD,17,END=955) I,J 00067500 C 00067600 IF(I .LT. 0) GO TO 23 00067700 C ... SOME DELETES IN HERE ... 00067800 GO TO 21 00067900 C 00068000 23 CONTINUE 00068100 C CKEN DO 60 J=1,89 DO 60 I=1,89 SCVH(I,J) = JMAP(I,J) 60 CONTINUE C 00068200 RETURN 00068400 C C.............ERROR MESSAGES BELOW....................... C 00068500 911 CONTINUE 00068600 WRITE(LIST,915) 00068700 915 FORMAT(1H ,'UNEXPECTED FILE STRUCTURE ENCOUNTERED') 00068800 CALL EXIT(11) C 00070000 944 CONTINUE 00070100 WRITE(LIST,945) 00070200 945 FORMAT(1H ,'ERROR STOP. WHERE IS 2ND -1 CARD?') 00070300 CALL EXIT(22) C 00070500 955 CONTINUE 00070600 WRITE(LIST,956) 00070700 956 FORMAT(1H ,'ERROR STOP. WHERE IS 3RD -1 CARD?') 00070800 CALL EXIT(33) C END C