Guide to access COADS MSTG data on Sun/UNIX system - modification of standard program QQ22 -- - Steve Worley, Oct. 1989 -- 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 within data blocks, so end of logical record marks (line feeds) are not inserted when blocked data is taken from tape. 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=coadsg3 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 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 rsunqq22 c c read coads mstg data on sun - c because UNIX doesn't use record stucture within files c this program simulates it using direct access operations c C-----READ AND PRINT MSUG2 AND MSTG2 GROUPS 1-8 C C-----RPTIN, BUFFER IN, UNIT, LENGTH, GBYTE/S, DATE AND TIME ARE C MACHINE-DEPENDENT ROUTINES AND FUNCTIONS. SEE COADS RELEASE 1 C SUPPLEMENT H FOR A DESCRIPTION OF THEIR BEHAVIOR. BPW IS A C PARAMETER WHICH MUST BE SET TO THE NUMBER OF BITS PER MACHINE C WORD. GROUP IS A PARAMETER WHICH MUST BE SET TO THE GROUP C NUMBER. C ===1=========2=========3========4=========5=========6=========7== C C -----------REVISION HISTORY--------------------------------------- C LEVEL AUTHOR DATE DESCRIPTION C ===== ====== ========== ==================== C .01A. SL 87/05/14. ORIGINAL VERSION. C ------------------------------------------------------------------ C C ===1=========2=========3========4=========5=========6=========7== IMPLICIT INTEGER(A-E,G-Z) C PARAMETER(MAX=10,RPTOFF=0,FMISS=-9999.,INDEXCK=6,BPR=384,ID=0 +,BPW=32,DIM BUF=(1006*64-1)/BPW+1,DIM PK=(BPR-1)/BPW+1,DIM UN=38 +,GROUP=3,tape=10) C COMMON /MSTG2/FUNITS(38),FBASE(38),BITS(38),OFFSET(38) C DIMENSION BUF(DIM BUF),PK(DIM PK),UN(DIM UN),FTRUE(DIM UN) C C-----2 DIMENSIONAL FTRUE DIMENSION FTRUE2(4,8) EQUIVALENCE (FTRUE(7),FTRUE2) C DATA LEVEL/4H.01A/,BUF/DIM BUF*0/ C c open UNIX data file - direct access mode c -- each direct access record is equivalent to MSTG blocksize open(unit=tape,file='bindgr3',form='unformatted', * access='direct',recl=7200) c write(*,1) 1 format('1 ****** beginning output for rsunqq22 *****') c CALL DATA(GROUP) 100 CALL GETRPT(10,FMISS,FUNITS,FBASE,BITS,OFFSET,INDEXCK,ID +,BPR,BPW,RPTOFF,BUF,DIM BUF,PK,DIM PK,UN,DIM UN,FTRUE,JEOF) IF(JEOF.NE.0)GOTO 900 C CALL WRMSTG2(FTRUE,GROUP) IF(BUF(2).LT.MAX)GOTO 100 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(tape,FMISS,FUNITS,FBASE,BITS,OFFSET,INDEXCK,ID +,BPR,BPW,RPTOFF,BUF,DIM BUF,PK,DIM PK,UN,DIM UN,FTRUE,JEOF) C C-----RETURN FLOATING POINT VALUES IN FTRUE C C INPUT C tape - RCDIN UNIT C FMISS - MISSING VALUE C FUNITS(DIM UN) - UNITS FOR UNCODING C FBASE(DIM UN) - BASE FOR UNCODING C BITS(DIM UN) - BITS FOR UNPACKING C OFFSET(DIM UN) - 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 RPTOFF - 0=FALSE 1=TRUE C OUTPUT C BUF(DIM BUF) - RCDIN BUFFER C PK(DIM PK) - PACKED REPORT C UN(DIM UN) - UNPACKED REPORT C FTRUE(DIM UN) - TRUE VALUES C JEOF - 0=FALSE 1=TRUE C IMPLICIT INTEGER(A-E,G-Z) DIMENSION FUNITS(DIM UN),FBASE(DIM UN),BITS(DIM UN),OFFSET(DIM UN) +,BUF(DIM BUF),PK(DIM PK),UN(DIM UN),FTRUE(DIM UN) C 100 CALL RCDIN(tape,BUF,DIM BUF,PK,DIM PK,BPR,BPW,JEOF) 110 IF(JEOF-1)200,900,800 C C-----GBYTE AND CONVERT TO TRUE 200 CK=ID DO 230 I=1,DIM UN 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, TAPE = ',TAPE +,', REPORT = ',BUF(2) PRINT *,' FTRUE = ',FTRUE 800 STOP C 900 END C======================================================================= SUBROUTINE RCDIN(tape,BUF,DIM BUF,RCD,DIM RCD,BPR,BPW,JEOF) C C-----RETURN ONE LOGICAL RECORD IN RCD C C INPUT C tape - BUFFER IN UNIT C BPR - BITS PER RECORD C BPW - BITS PER WORD C OUTPUT C BUF(DIM BUF) - PHYSICAL RECORD C RCD(DIM RCD) - LOGICAL RECORD C JEOF - 0=FALSE 1=TRUE C C BUF(1) = GBYTE OFFSET C BUF(2) = LOGICAL RECORD COUNT C BUF(3) = PHYSICAL RECORD COUNT C BUF(4) = C BUF(5) = BLOCK LENGTH IN BITS C BUF(6) = C IMPLICIT INTEGER(A-E,G-Z) DIMENSION BUF(DIM BUF),RCD(DIM RCD) data irdata/1/ C IF(BUF(1)+BPR.LE.BUF(5))GOTO 200 C-----BUFFER IN c c read from UNIX data file 10 read(tape,rec=irdata)(buf(i),i=7,1806) 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,31) c202 format(5z12) c jeof=0 100 BUF(1)=0 BUF(5)=57600 BUF(3)=BUF(3)+1 C C-----GBYTE 200 CALL GBYTES +(BUF(6+BUF(1)/BPW+1) ,RCD ,MOD(BUF(1),BPW) ,BPW ,0 ,DIM RCD) IF(RCD(1).EQ.0.AND.RCD(2).EQ.0)GOTO 10 BUF(1)=BUF(1)+BPR BUF(2)=BUF(2)+1 RETURN C C-----ERROR 800 PRINT *,' SUBROUTINE RCDIN -- BUFFER IN ERROR, TAPE = ',TAPE +,', BLOCK = ',BUF(3)+1 STOP 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 -----