Guide to access COADS MSTG data on Sun/UNIX system - modification of standard program QQ22 -- - Steve Worley, Oct. 1990 -- UNIX operating systems care very little about record and block structure and therefore don't automatically do some things a user might expect. For instance, simple UNIX file copy commands don't use the concept of logical records and data blocks. COADS MSTG data tapes are structured with 150 logical records (48 bytes) per data block (7200 bytes). Below is an outline for loading a COADS MSTG file onto disk and a Fortran access program for the data. There is subroutine call GBYTES that needs special attention. GBYTES is written in the C language and is used to access binary bit strings of varying length. Key Steps: I After you have mounted and positioned the tape at the load point issue the command: dd if=/dev/tapedevice of=datafile ibs=7200 example: dd if=/dev/rmt4 of=coadsdat ibs=7200 II Edit this ASCII file placing all the Fortran code in a separate file; say with name, rdcoads.f. Edit the open statement in rdcoads.f to reflex the data file name you chose in step I. III Edit this ASCII file placing subroutine GBYTES in a separate file; say with name, gbytes32.c IV Fortran compile and link the program and GBYTES with the command: f77 -o rcoads rdcoads.f gbytes32.c Some Unix environments require a two step compile when mixing C and Fortran -- if you get "bad magic number" error from the f77 command above try: cc -c gbytes32.c then f77 -o rcoads rdcoads.f gbytes32.o V Run program rcoads. It will print out the COADS data in the first MAX records (see the parameter statement in the main program for MAX setting). --------fortran program -- program sunqq22 c c read MSTG data on a Sun computer system with UNIX operating c system. 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,FMISS=-9999.,INDEXCK=6,BPR=384,ID=0 +,BPW=32,dimbuf=(bpr/bpw+6),dimpk=(BPR-1)/BPW+1,dimun=38 +,GROUP=3,iunit=10) C COMMON /MSTG2/FUNITS(38),FBASE(38),BITS(38),OFFSET(38) C DIMENSION BUF(dimbuf),PK(dimpk),UN(dimun),FTRUE(dimun) C C-----2 DIMENSIONAL FTRUE DIMENSION FTRUE2(4,8) EQUIVALENCE (FTRUE(7),FTRUE2) C DATA BUF/dimbuf*0/ C c open UNIX data file - direct access mode c each direct access will get one MSTG record open(unit=iunit,file='coadsdat', * form='unformatted', access='direct',recl=48) c write(*,1) 1 format('1 ****** beginning output for sunqq22 *****') c CALL DATA(GROUP) 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 WRMSTG2(FTRUE,GROUP) go to 100 endif C 900 PRINT *,' REPORTS ',BUF(2),', EOF ',JEOF END C======================================================================= SUBROUTINE WRMSTG2(FTRUE,GROUP) IMPLICIT INTEGER(A-E,G-Z) DIMENSION FTRUE(38) GOTO (1,2,3,4,5,6,7,8), GROUP 1 ASSIGN 101 TO IFMT GOTO 100 2 ASSIGN 102 TO IFMT GOTO 100 3 ASSIGN 103 TO IFMT GOTO 100 4 ASSIGN 104 TO IFMT GOTO 100 5 ASSIGN 105 TO IFMT GOTO 100 6 ASSIGN 106 TO IFMT GOTO 100 7 ASSIGN 107 TO IFMT GOTO 100 8 ASSIGN 108 TO IFMT 100 PRINT IFMT,(FTRUE(I),I=1,6) +,((FTRUE(6+(J-1)*4+I),J=1,8),I=1,4) 101 FORMAT(/' YEAR ',F5.0,' MONTH ',F3.0,' BOX2 ',F6.0 +,' BOX10 ',F4.0,' GROUP ',F3.0,' CHECKSUM ',F6.0/ +8X,'3',7X,'M',7X,'N',7X,'E',7X,'D',7X,'H',7X,'X',7X,'Y'/ +1X,'S',2F8.2,F8.0,F8.2,2F8.0,2F8.1/ +1X,'A',2F8.2,F8.0,F8.2,2F8.0,2F8.1/ +1X,'P',2F8.2,F8.0,F8.2,2F8.0,2F8.1/ +1X,'Q',2F8.2,F8.0,F8.2,2F8.0,2F8.1) 102 FORMAT(/' YEAR ',F5.0,' MONTH ',F3.0,' BOX2 ',F6.0 +,' BOX10 ',F4.0,' GROUP ',F3.0,' CHECKSUM ',F6.0/ +8X,'3',7X,'M',7X,'N',7X,'E',7X,'D',7X,'H',7X,'X',7X,'Y'/ +1X,'W',2F8.2,F8.0,F8.2,2F8.0,2F8.1/ +1X,'U',2F8.2,F8.0,F8.2,2F8.0,2F8.1/ +1X,'V',2F8.2,F8.0,F8.2,2F8.0,2F8.1/ +1X,'C',2F8.1,F8.0,F8.1,2F8.0,2F8.1) 103 FORMAT(/' YEAR ',F5.0,' MONTH ',F3.0,' BOX2 ',F6.0 +,' BOX10 ',F4.0,' GROUP ',F3.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) 104 FORMAT(/' YEAR ',F5.0,' MONTH ',F3.0,' BOX2 ',F6.0 +,' BOX10 ',F4.0,' GROUP ',F3.0,' CHECKSUM ',F6.0/ +9X,7X,'3',7X,'M',7X,'N',7X,'E',7X,'D',7X,'H',7X,'X',7X,'Y'/ +1X,'W ',2F8.2,F8.0,F8.2,F8.0,3F8.1/ +1X,'U ',2F8.2,F8.0,F8.2,F8.0,3F8.1/ +1X,'V ',2F8.2,F8.0,F8.2,F8.0,3F8.1/ +1X,'P ',2F8.2,F8.0,F8.2,F8.0,3F8.1) 105 FORMAT(/' YEAR ',F5.0,' MONTH ',F3.0,' BOX2 ',F6.0 +,' BOX10 ',F4.0,' GROUP ',F3.0,' CHECKSUM ',F6.0/ +9X,7X,'3',7X,'M',7X,'N',7X,'E',7X,'D',7X,'H',7X,'X',7X,'Y'/ +1X,'C ',2F8.1,F8.0,F8.1,F8.0,3F8.1/ +1X,'R ',2F8.1,F8.0,F8.1,F8.0,3F8.1/ +1X,'W*U ',2F8.1,F8.0,F8.1,F8.0,3F8.1/ +1X,'W*V ',2F8.1,F8.0,F8.1,F8.0,3F8.1) 106 FORMAT(/' YEAR ',F5.0,' MONTH ',F3.0,' BOX2 ',F6.0 +,' BOX10 ',F4.0,' GROUP ',F3.0,' CHECKSUM ',F6.0/ +9X,7X,'3',7X,'M',7X,'N',7X,'E',7X,'D',7X,'H',7X,'X',7X,'Y'/ +1X,'S-A ',2F8.2,F8.0,F8.2,F8.0,3F8.1/ +1X,'(S-A)*W ',2F8.1,F8.0,F8.1,F8.0,3F8.1/ +1X,'QS-Q ',2F8.2,F8.0,F8.2,F8.0,3F8.1/ +1X,'(QS-Q)*W',2F8.1,F8.0,F8.1,F8.0,3F8.1) 107 FORMAT(/' YEAR ',F5.0,' MONTH ',F3.0,' BOX2 ',F6.0 +,' BOX10 ',F4.0,' GROUP ',F3.0,' CHECKSUM ',F6.0/ +9X,7X,'3',7X,'M',7X,'N',7X,'E',7X,'D',7X,'H',7X,'X',7X,'Y'/ +1X,'U*A ',2F8.1,F8.0,F8.1,F8.0,3F8.1/ +1X,'V*A ',2F8.1,F8.0,F8.1,F8.0,3F8.1/ +1X,'U*Q ',2F8.1,F8.0,F8.1,F8.0,3F8.1/ +1X,'V*Q ',2F8.1,F8.0,F8.1,F8.0,3F8.1) 108 FORMAT(/' YEAR ',F5.0,' MONTH ',F3.0,' BOX2 ',F6.0 +,' BOX10 ',F4.0,' GROUP ',F3.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,'W*U ',2F8.1,F8.0,F8.1,F8.0,3F8.1/ +1X,'W*V ',2F8.1,F8.0,F8.1,F8.0,3F8.1) END C======================================================================= SUBROUTINE DATA(GROUP) IMPLICIT INTEGER(A-E,G-Z) C COMMON /MSTG2/FUNITS(38),FBASE(38),BITS(38),OFFSET(38) C DATA FUNITS/1.,1.,1.,1.,1.,1. + ,.01,.01,.1,.1 + ,.01,.01,.1,.1 + ,1.,1.,1.,1. + ,.01,.01,.1,.1 + ,2.,2.,2.,2. + ,.1,.1,.1,.1 + ,.2,.2,.2,.2 + ,.2,.2,.2,.2/ C DATA FBASE/1799.,0.,0.,0.,0.,0. + ,-501.,-8801.,-30001.,-30001. + ,-501.,-8801.,-30001.,-30001. + ,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,4,8 + ,16,16,16,16 + ,16,16,16,16 + ,16,16,16,16 + ,16,16,16,16 + ,4,4,4,4 + ,4,4,4,4 + ,4,4,4,4 + ,4,4,4,4/ C DATA OFFSET/16,24,28,42,52,56 + ,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 GOTO (1,2,3,4,5,6,7,8), GROUP C 1 FUNITS(7)=.01 FUNITS(8)=.01 FUNITS(9)=.01 FUNITS(10)=.01 FUNITS(11)=.01 FUNITS(12)=.01 FUNITS(13)=.01 FUNITS(14)=.01 FUNITS(19)=.01 FUNITS(20)=.01 FUNITS(21)=.01 FUNITS(22)=.01 FUNITS(27)=2. FUNITS(28)=2. FUNITS(29)=2. FUNITS(30)=2. FBASE(7)=-501. FBASE(8)=-8801. FBASE(9)=86999. FBASE(10)=-1. FBASE(11)=-501. FBASE(12)=-8801. FBASE(13)=86999. FBASE(14)=-1. FBASE(27)=-.5 FBASE(28)=-.5 FBASE(29)=-.5 FBASE(30)=-.5 RETURN C 2 FUNITS(7)=.01 FUNITS(8)=.01 FUNITS(9)=.01 FUNITS(10)=.1 FUNITS(11)=.01 FUNITS(12)=.01 FUNITS(13)=.01 FUNITS(14)=.1 FUNITS(19)=.01 FUNITS(20)=.01 FUNITS(21)=.01 FUNITS(22)=.1 FUNITS(27)=2. FUNITS(28)=2. FUNITS(29)=2. FUNITS(30)=2. FBASE(7)=-1. FBASE(8)=-10221. FBASE(9)=-10221. FBASE(10)=-1. FBASE(11)=-1. FBASE(12)=-10221. FBASE(13)=-10221. FBASE(14)=-1. FBASE(27)=-.5 FBASE(28)=-.5 FBASE(29)=-.5 FBASE(30)=-.5 RETURN C 3 FUNITS(7)=.01 FUNITS(8)=.01 FUNITS(9)=.01 FUNITS(10)=.1 FUNITS(11)=.01 FUNITS(12)=.01 FUNITS(13)=.01 FUNITS(14)=.1 FUNITS(19)=.01 FUNITS(20)=.01 FUNITS(21)=.01 FUNITS(22)=.1 FBASE(7)=-501. FBASE(8)=-8801. FBASE(9)=-1. FBASE(10)=-1. FBASE(11)=-501. FBASE(12)=-8801. FBASE(13)=-1. FBASE(14)=-1. RETURN C 4 FUNITS(7)=.01 FUNITS(8)=.01 FUNITS(9)=.01 FUNITS(10)=.01 FUNITS(11)=.01 FUNITS(12)=.01 FUNITS(13)=.01 FUNITS(14)=.01 FUNITS(19)=.01 FUNITS(20)=.01 FUNITS(21)=.01 FUNITS(22)=.01 FBASE(7)=-1. FBASE(8)=-10221. FBASE(9)=-10221. FBASE(10)=86999. FBASE(11)=-1. FBASE(12)=-10221. FBASE(13)=-10221. FBASE(14)=86999. RETURN C 5 FUNITS(7)=.1 FUNITS(8)=.1 FUNITS(9)=.1 FUNITS(10)=.1 FUNITS(11)=.1 FUNITS(12)=.1 FUNITS(13)=.1 FUNITS(14)=.1 FUNITS(19)=.1 FUNITS(20)=.1 FUNITS(21)=.1 FUNITS(22)=.1 FBASE(7)=-1. FBASE(8)=-1. FBASE(9)=-30001. FBASE(10)=-30001. FBASE(11)=-1. FBASE(12)=-1. FBASE(13)=-30001. FBASE(14)=-30001. RETURN C 6 FUNITS(7)=.01 FUNITS(8)=.1 FUNITS(9)=.01 FUNITS(10)=.1 FUNITS(11)=.01 FUNITS(12)=.1 FUNITS(13)=.01 FUNITS(14)=.1 FUNITS(19)=.01 FUNITS(20)=.1 FUNITS(21)=.01 FUNITS(22)=.1 FBASE(7)=-6301. FBASE(8)=-10001. FBASE(9)=-4001. FBASE(10)=-10001. FBASE(11)=-6301. FBASE(12)=-10001. FBASE(13)=-4001. FBASE(14)=-10001. RETURN C 7 FUNITS(7)=.1 FUNITS(8)=.1 FUNITS(9)=.1 FUNITS(10)=.1 FUNITS(11)=.1 FUNITS(12)=.1 FUNITS(13)=.1 FUNITS(14)=.1 FUNITS(19)=.1 FUNITS(20)=.1 FUNITS(21)=.1 FUNITS(22)=.1 FBASE(7)=-20001. FBASE(8)=-20001. FBASE(9)=-10001. FBASE(10)=-10001. FBASE(11)=-20001. FBASE(12)=-20001. FBASE(13)=-10001. FBASE(14)=-10001. RETURN C 8 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 ---------gbytes.c -------------- #include /* Tools for storage/retrieval of arbitrary size bytes from 32 bit words gbytes(p,u,q,b,s,n) gbyte (p,u,q,b) sbytes(p,u,q,b,s,n) sbyte (p,u,q,b) q >= 0 number of bits to be skipped preceeding first byte in p 0 < b < sword byte size s >= 0 number of bits to be skipped between bytes n >= 0 number of bytes to be packed/unpacked gbytes unpacks n b bit bytes from p into u, starting by skipping q bits in p, then skipping s bits between bytes. gbyte unpacks one such byte. sbytes packs n b bit bytes from u into p, starting by skipping q bits in p, then skipping s bits between bytes. sbyte packs one such byte. */ # define SWORD 32 /* Word size in bits */ # define MASK 0xffffffffffffffff /* Mask of sword bits */ # define G1BYTE(p,q,b) ((b==32 ? MASK : ~(MASK<>(SWORD-(q+b)))) /* Get 1 word contained byte */ # define MASK1(q,b) (b==32 ? MASK : (~(MASK<= SWORD) { j = jq/SWORD; /* number of words offset */ jq %= SWORD; /* odd bits of offset */ } else { j=0; } qb = jq + jb; if (qb > SWORD) { qb = SWORD - jq; jb -= qb; lb = (G1BYTE(p[j],jq,qb)) << jb; jq = 0; j++; /* increment to next word */ } else lb = 0; *u = lb + (G1BYTE(p[j],jq,jb)); } sbytes_(p,u,q,b,s,n) long p[],u[],*q,*b,*s,*n; { int sbyte_(); gsbytes(p,u,q,b,s,n,sbyte_); } sbyte_(p,u,q,b) long p[],*u,*q,*b; { long qb,j,jq,jb,rb; jq = *q; jb = *b; if (jq >= SWORD) { j = jq / SWORD; /* number of words offset */ jq %= SWORD; /* odd bit offset */ } else { j = 0; } qb = jq + jb; if (qb > SWORD) { qb = SWORD - jq; jq = SWORD - jb; jb -= qb; p[j] = ((p[j] >> qb) << qb) + (G1BYTE(*u,jq,qb)); jq = 0; j++; /* point to next word */ } rb = G1BYTE(*u,SWORD-jb,jb); p[j] = (p[j] & ~MASK1(jq,jb)) + (rb << SWORD-(jb+jq)); } ------- end of file -----