program rsunql28 c c read MSTG data on a Sun computer system with UNIX operating c system, group 3. c because UNIX doesn't use record stucture within files c this program simulates it using direct access operations c C-----gbyte/s is a machine dependent routine, the C language version c for a 32 bit machine is the best for Sun computing systems c IMPLICIT INTEGER(A-E,G-Z) C PARAMETER(MAX=10,RPTOFF=1,FMISS=-9999.,INDEXCK=5,BPR=384,ID=3 +,BPW=32,DIMBUF=(1006*64-1)/BPW+1,DIMPK=(BPR-1)/BPW+1,DIMUN=37) C COMMON /MSTG1/FUNITS(37),FBASE(37),BITS(37),OFFSET(37) C DIMENSION BUF(dimbuf),PK(dimpk),UN(dimun),FTRUE(dimun) C C-----2 DIMENSIONAL FTRUE DIMENSION FTRUE2(4,8) EQUIVALENCE (FTRUE(6),FTRUE2) C DATA FUNITS/1., 1., 1., 1., 1. +,1.E-2, 1.E-2, 1.E-2, 0.1 +,1.E-2, 1.E-2, 1.E-2, 0.1 +,1., 1., 1., 1. +,1.E-2, 1.E-2, 1.E-2, 0.1 +,2., 2., 2., 2. +,0.1, 0.1, 0.1, 0.1 +,0.2, 0.2, 0.2, 0.2 +,0.2, 0.2, 0.2, 0.2/ C DATA FBASE/1799., 0., 0., 0., 0. +,-501., -8801., -1., -1. +,-501., -8801., -1., -1. +,0., 0., 0., 0. +,-1., -1., -1., -1. +,0., 0., 0., 0. +,-1., -1., -1., -1. +,-.5, -.5, -.5, -.5 +,-.5, -.5, -.5, -.5/ C DATA BITS/8,4,14,10,12,16*16,16*4/ C DATA OFFSET +/ 16, 24, 28, 42, 52, 64, 80, 96,112,128 +,144,160,176,192,208,224,240,256,272,288 +,304,320,324,328,332,336,340,344,348,352 +,356,360,364,368,372,376,380/ C DATA BUF/dimbuf*0/ data iunit/10/ C c open UNIX data file - direct access mode c each direct access will get one MSTG record open(unit=iunit,file='/tmp/grp3_1960', * form='unformatted', access='direct',recl=48) c write(*,1) 1 format('1 ****** beginning output for ql28.noblk.sun *****') c 100 CALL GETRPT(iunit,FMISS,FUNITS,FBASE,BITS,OFFSET,INDEXCK,ID +,BPR,BPW,BUF,dimbuf,PK,dimpk,UN,dimun,FTRUE,JEOF) IF(JEOF.NE.0)GOTO 900 C c print the first max records if(buf(2).lt.max)then CALL WRMSTG1(FTRUE) endif go to 100 C 900 PRINT *,' REPORTS ',BUF(2),', EOF ',JEOF stop END C======================================================================= SUBROUTINE WRMSTG1(FTRUE) IMPLICIT INTEGER(A-E,G-Z) DIMENSION FTRUE(37) PRINT 100,(FTRUE(I),I=1,5) +,((FTRUE(5+(J-1)*4+I),J=1,8),I=1,4) 100 FORMAT(/' YEAR ',F5.0,' MONTH ',F3.0,' BOX2 ',F6.0 +,' BOX10 ',F4.0,' CHECKSUM ',F6.0/ +9X,7X,'3',7X,'M',7X,'N',7X,'E',7X,'D',7X,'H',7X,'X',7X,'Y'/ +1X,'S ',2F8.2,F8.0,F8.2,F8.0,3F8.1/ +1X,'A ',2F8.2,F8.0,F8.2,F8.0,3F8.1/ +1X,'Q ',2F8.2,F8.0,F8.2,F8.0,3F8.1/ +1X,'R ',2F8.1,F8.0,F8.1,F8.0,3F8.1) END C======================================================================= SUBROUTINE GETRPT(iunit,FMISS,FUNITS,FBASE,BITS,OFFSET,INDEXCK,ID +,BPR,BPW,BUF,dimbuf,PK,dimpk,UN,dimun,FTRUE,JEOF) C C-----RETURN FLOATING POINT VALUES IN FTRUE C C INPUT C iunit - RCDIN UNIT C FMISS - MISSING VALUE C FUNITS(dimun) - UNITS FOR UNCODING C FBASE(dimun) - BASE FOR UNCODING C BITS(dimun) - BITS FOR UNPACKING C OFFSET(dimun) - OFFSET FOR UNPACKING C INDEXCK - UN(INDEXCK) = CHECKSUM C ID - GROUP NUMBER FOR IDENTIFICATION CHECKSUM C BPR - BITS PER REPORT C BPW - BITS PER WORD C OUTPUT C BUF(dimbuf) - RCDIN BUFFER C PK(dimpk) - PACKED REPORT C UN(dimun) - UNPACKED REPORT C FTRUE(dimun) - TRUE VALUES C JEOF = end of file indicator, 0=no, -1=yes C IMPLICIT INTEGER(A-E,G-Z) DIMENSION FUNITS(dimun),FBASE(dimun),BITS(dimun),OFFSET(dimun) +,BUF(dimbuf),PK(dimpk),UN(dimun),FTRUE(dimun) C CALL RCDIN(iunit,BUF,dimbuf,PK,dimpk,BPR,BPW,JEOF) if(jeof.eq.-1)return C C unpack with gbyte and rescale values CK=ID DO 230 I=1,dimun CALL GBYTE(PK(OFFSET(I)/BPW+1),UN(I),MOD(OFFSET(I),BPW),BITS(I)) IF(I.EQ.INDEXCK)GOTO 210 IF(UN(I).EQ.0)GOTO 220 FTRUE(I)=(UN(I)+FBASE(I))*FUNITS(I) CK=CK+UN(I) GOTO 230 210 FTRUE(INDEXCK)=UN(INDEXCK) GOTO 230 220 FTRUE(I)=FMISS 230 CONTINUE c c checksum verification c IF(MOD(CK,2**BITS(INDEXCK)-1).EQ.UN(INDEXCK))RETURN C C-----ERROR PRINT *,' SUBROUTINE GETRPT -- CHECKSUM ERROR, iunit = ',iunit +,', REPORT = ',BUF(2) PRINT *,' FTRUE = ',FTRUE 800 STOP C 900 END C======================================================================= SUBROUTINE RCDIN(iunit,BUF,dimbuf,RCD,dimrcd,BPR,BPW,JEOF) C C-----RETURN ONE LOGICAL RECORD IN RCD C C INPUT C iunit - BUFFER IN UNIT C BPR - BITS PER RECORD C BPW - BITS PER WORD C OUTPUT C BUF(dimbuf) - PHYSICAL RECORD C RCD(dimrcd) - LOGICAL RECORD C JEOF = end of file indicator, 0=no, 1=yes C C BUF(1) = gbytes offset, always 0 in this case C BUF(2) = record count C BUF(3) = C BUF(4) = C BUF(5) = record LENGTH IN BITS C BUF(6) = C IMPLICIT INTEGER(A-E,G-Z) DIMENSION BUF(dimbuf),RCD(dimrcd) data irdata/1/ C c read from UNIX data file 10 read(iunit,rec=irdata,end=900)(buf(i),i=7,18) irdata=irdata + 1 c c write the first part of the input record in hexidecimal c just to check the bytes c c write(6,202)(buf(i),i=7,18) c202 format(5z12) c jeof=0 100 BUF(1)=0 BUF(5)=384 BUF(3)=BUF(3)+1 C C-----GBYTE CALL GBYTES(BUF(6+1),RCD,0,BPW,0,dimrcd) BUF(2)=BUF(2)+1 RETURN c end of file has been detected set jeof to -1 900 continue jeof = -1 return END