SUBROUTINE READ_NVAP(FLNAME,IFLD,ISTAT) C C******************************************************************** C C THIS ROUTINE READS IN THE NVAP DATA IN CIRA CLIMATE DATA FORMAT. C IT ASSUMES THAT ALL FIELDS IN THE FILE HAVE THE SAME SIZE WITH C RESOLUTION = 360X180, (1 DEGREE GLOBAL RESOLUTION) C C WRITTEN BY DAVE RANDEL CIRA/CSU C IN OCTOBER, 1994 C C INPUT PARAMETERS FLNAME* : DATA FILENAME c IFLD : FIELD NUMBER C C OUTPUT PARAMETERS ISTAT : STATUS CODE C C******************************************************************** C CHARACTER FLNAME*(*) INTEGER*4 IFLD,IDT,ISTAT C CHARACTER TAPEC*4 REAL*4 OFFSET,SCALE,x CHARACTER BLANK6*6, BLANK5*5, HEADBUFF*144 BYTE BYTEBUFF(720) REAL*4 DATBUFF(360) C C--------COMMON BLOCK WHICH HOLDS THE DATA AND HEADER INFORMATION--------- C REAL DATA(360,180), HEADR(4), ZINDEF INTEGER*2 HEADI(11) CHARACTER LABEL*40 COMMON /GRDDATA/ DATA,HEADR,ZINDEF,HEADI,LABEL C C------------------------------------------------------------------------- C ISTAT = -1 IXSIZE = 360 IYSIZE = 180 C C** SET INTERGER SWAPPING TYPE AND RECL IN OPEN *********** C !* IDT = 1 ! INT*2 TESTED ON VAX VMS !* c IDT = 2 ! INT*2 - TESTED ON HP or PC !* C IDT = 3 ! INT*2 - TESTED ON SGI !* C !* C********************************************************** C C**OPEN INPUT DATA FILE C IF(IDT .EQ. 1) THEN OPEN(UNIT=101,FILE=FLNAME,FORM='UNFORMATTED', > ACCESS='DIRECT', STATUS='OLD', ERR=90, RECL=180) !FOR VAX ELSEIF(IDT .EQ. 2) THEN OPEN(UNIT=101,FILE=FLNAME,FORM='UNFORMATTED', > ACCESS='DIRECT', STATUS='OLD', ERR=90, RECL=720) !FOR HP ELSEIF(IDT .EQ. 3) THEN OPEN(UNIT=101,FILE=FLNAME,FORM='UNFORMATTED', > ACCESS='DIRECT', STATUS='OLD', ERR=90, RECL=180) !FOR SGI ENDIF C C**COMPUTE STARTING HEADER RECORD FROM INPUT FIELD NUMBER AND FIELD SIZE C ISHEAD = ( (IFLD-1) * (IYSIZE+1) ) + 1 C C**READ IN REQUESTED FIELD HEADER C READ(101,REC=ISHEAD,ERR=91) HEADBUFF READ(HEADBUFF,11)TAPEC,(HEADI(J),J=1,3),BLANK5, > (HEADI(J),J=4,11), > (HEADR(J),J=1,4), > OFFSET, SCALE, ZINDEF, BLANK6, LABEL C 11 FORMAT( A4, I3, I3, I1, A5, > I2, I3, I2, I2, I3, I2, > I4, I4, F6.2, F6.2, F7.3, F8.3, > E11.5, E11.5, E11.5, A6, A40) C c**INITIALIZE DATA ARRAY WITH ZINDEF VALUES c DO I = 1,180 DO J = 1,360 DATA(J,I) = ZINDEF ENDDO ENDDO C C**READ IN 720 BYTE DATA RECORDS, CONVERT TO REALS, FILL OUTPUT DATA ARRAY C DO I = 1,IYSIZE READ(101,REC=ISHEAD+I,ERR=92)(BYTEBUFF(J), J = 1,720) CALL CCDA_CONVRTDT(BYTEBUFF, IDT, HEADI(10), OFFSET, ZINDEF, > SCALE, DATBUFF) DO J = 1, IXSIZE DATA(J,I) = DATBUFF(J) ENDDO ENDDO C C**CLOSE FILE AND RETURN C ISTAT = 0 CLOSE(UNIT=101) RETURN C C**ERROR FOUND C 90 WRITE(6,*)'ERROR OPENING FILE' ISTAT = -1 RETURN 91 WRITE(6,*)' ERROR READING REQUESTED HEADER REC', ISHEAD WRITE(6,*)' ERROR MAY SIMPLY BE THAT LAST FIELD HAS BEEN READ' ISTAT = -3 CLOSE(UNIT=101) RETURN 92 WRITE(6,*)'ERROR READING REQUESTED DATA' ISTAT = -4 CLOSE(UNIT=101) RETURN END C C-------------------------------------------------------------------------- C SUBROUTINE CCDA_CONVRTDT(BBUF, IDT, NUMVAL, OFFSET, ZINDEF, > SCALE, DBUF) C C*************************************************************************** C C THIS ROUTINE TAKES THE BYTE ARRAY AND USING THE INPUT DATA_TYPE PUTS C ALL THE DATA IN THE RECORD INTO THE REAL ARRAY DBUF. THIS DOES THE C NECESSARY BYTE SWAPPING. C C WRITTEN BY DAVE RANDEL CIRA/CSU C IN JUNE 1992 C C*************************************************************************** C REAL*4 DBUF(360), OFFSET, SCALE, ZINDEF BYTE BBUF(720), B2A(2) INTEGER*2 INT2, NUMVAL integer*4 IDT EQUIVALENCE(INT2, B2A) C IF(NUMVAL .EQ. 0) THEN WRITE(6,*)'FROM CONVRT: NUMBER OF POINTS = 0 ' STOP 99 ENDIF IF(IDT .EQ. 1) THEN !I*2 DO I = 1,NUMVAL ISB = (I-1)*2 + 1 B2A(1) = BBUF(0+ISB) B2A(2) = BBUF(1+ISB) IF(FLOAT(INT2) .EQ. ZINDEF) THEN DBUF(I) = ZINDEF ELSE DBUF(I) = (FLOAT(INT2) * SCALE) + OFFSET ENDIF ENDDO C ELSEIF(IDT.EQ.2 .OR. IDT.EQ.3) THEN !I*2 NEEDING BYTE SWAP DO I = 1,NUMVAL ISB = (I-1)*2 + 1 B2A(1) = BBUF(1+ISB) B2A(2) = BBUF(0+ISB) IF(FLOAT(INT2) .EQ. ZINDEF) THEN DBUF(I) = ZINDEF ELSE DBUF(I) = (FLOAT(INT2) * SCALE) + OFFSET ENDIF ENDDO ELSE WRITE(6,*)'DATA TYPE CONVERSION NOT SUPPORTED ' STOP 99 ENDIF C C RETURN END