C#! /bin/csh -f C# Script to drive program to read Norwegian magnetometer C# data. To use: C# (1) Change the read and write file names in the next two lines. C# (2) Modify the write format to suit your needs. Look for C# occurances of the string "WRITE (IOUN" C# (3) Various diagnostics are written to stdout (fort.6), so it C# may be best to execute each job by entering, for example, C# C# rdnormag > tro290.out Conintr cleanup C#cat << EOF > in$$ C#jan192.dat C#jan192.asc C#EOF Ccat << EOF > in$$ Cnaa391.dat Cnaa391.asc CEOF Ccat << EOF > src$$.f PROGRAM RDNORMAG C Read Norwegian magnetometer data, as obtained by Mariko Sato CHARACTER*80 INAM , ONAM PARAMETER (MSGUN=15 , INUN=11 , IOUN=12 , + LLR=3072 , LWD=4 , LLRW=LLR/LWD , + LHD=192 , LDV=LLR-LHD, NDV=LDV/2, + LSN=20 , LDU=20 , LCO=20) C LLR = Number of bytes in a logical record C LWD = Number of bytes in a computer word C LHD = Number of bytes in the logical record header C LDV = Number of bytes in the logical record data C NDV = Number of 2-byte integers in the lrec data C LSN = Number of bytes possible in station name string C LDU = Number of bytes possible in data units string C LCO = Number of bytes possible in comments string DIMENSION LREC(LLRW) CHARACTER*1 IB(LLR) EQUIVALENCE (LREC,IB) CHARACTER*1 NSTC, INST , COMP CHARACTER*(LSN) SNAM CHARACTER*(LDU) UNITS CHARACTER*(LCO) COM character*20 helpfile DIMENSION NTVLS(3) , IDV(NDV) CHARACTER*200 ERRMSG C Get the input and output file names and open READ (*,'(A,/,A)',END=1000) INAM , ONAM helpfile = onam(1:6)//'.help' open (msgun,file=helpfile,status='new') OPEN (INUN,FILE=INAM,ACCESS='DIRECT',RECL=LLR,STATUS='OLD') OPEN (IOUN,FILE=ONAM) WRITE (MSGUN,'('' RDNORMAG reading: '',A,/, + '' writing: '',A)') INAM,ONAM C Read the next logical record or quit NR = 0 100 NR = NR + 1 READ (INUN,REC=NR,END=1000) LREC ERRMSG = ' ' LEM = 0 C Unpack the header and data fields: C LLRS = stored lrecl (bytes) C LHDR = par length (bytes) C LDAT = data length (bytes) C NSTA = station number C NSTC = station sub-number (character) C SNAM = station name C SLAT = station latitude C SLON = station longitude C SHT = station height (m) C IYR = year (e.g., 1990) C IMO = month C IDA = day C IHR = hour C IMN = minute C IS = seconds C IMS = milli-seconds C NTVLS = sample interval hours,sec,msec C INST = instrument type character C COMP = component character C MISS = missing data code C UNITS = data units label C IDUC = data units code: 1=nT, 2=sec, 3=1/4 nT, 4=1/10 min. C IOS1,IOS2,IOST = Offset1, Offset2, IOST (=IOS1 + 32768*IOS2) C COM = comments string C ISTF = status flag: 0=ok; 1=no data C IDV = Integer data values CALL GINT (IB(1),1,LLRS) CALL GINT (IB(3),1,LHDR) CALL GINT (IB(5),1,LDAT) IF (LLRS .NE. LLR) THEN LEM = 13 ERRMSG = 'LLRS .ne. LLR' ENDIF IF (LHDR .NE. LHD) THEN ERRMSG(LEM+1:) = ' LHDR .ne. LHD' LEM = LEM + 14 ENDIF IF (LDAT .NE. LDV) THEN ERRMSG(LEM+1:) = ' LDAT .ne. LDV' LEM = LEM + 14 ENDIF NSTA = ICHAR (IB(7)) NSTC = IB(8) NC = MIN0 (ICHAR (IB(9)) , LSN) CALL GSTR (IB(10),NC,SNAM) SLAT = REAL(ICHAR(IB(30))) + + (REAL(ICHAR(IB(31))) + REAL(ICHAR(IB(32))) /60.) / 60. SIGN = 0. IF (IB(33) .EQ. 78) SIGN = 1. IF (IB(33) .EQ. 83) SIGN = -1. IF (SIGN .EQ. 0) THEN ERRMSG(LEM+1:) = ' Unrecognized LAT sign' LEM = LEM+22 ENDIF SLAT = SIGN * SLAT SLON = REAL(ICHAR(IB(34))) + + (REAL(ICHAR(IB(35))) + REAL(ICHAR(IB(36))) /60.) / 60. SIGN = 0. IF (IB(37) .EQ. 69) SIGN = 1. IF (IB(37) .EQ. 87) SIGN = -1. IF (SIGN .EQ. 0) THEN ERRMSG(LEM+1:) = ' Unrecognized LON sign' LEM = LEM+22 ENDIF SLON = SIGN * SLON CALL GINT (IB(38),1,SHT) CALL GINT (IB(40),1,IYR) IMO = ICHAR (IB(42)) IDA = ICHAR (IB(43)) IHR = ICHAR (IB(44)) IMN = ICHAR (IB(45)) IS = ICHAR (IB(46)) IMS = ICHAR (IB(47)) CALL GINT (IB(49),3,NTVLS) INST = IB(55) COMP = IB(56) CALL GINT (IB(57),1,MISS) NC = MIN0 (ICHAR (IB(59)) , LDU) CALL GSTR (IB(60),NC,UNITS) IDUC = ICHAR (IB(80)) CALL GINT (IB(81),1,IOS1) CALL GINT (IB(83),1,IOS2) IOST = IOS1 + IOS2*32768 NC = MIN0 (ICHAR (IB(85)) , LCO) CALL GSTR (IB(86),NC,COM) ISTF = ICHAR (IB(106)) C Unpack the data values CALL GINT (IB(LHD+1),NDV,IDV) C Print warning and maybe terminate if there was trouble unpacking IF (LEM .NE. 0) THEN IF (ISTF .EQ. 0) GO TO 1000 WRITE (MSGUN,'('' Warning: lrec'',I8,'' had no data, '', + ''status flag (ISTF) = 1'')') NR ENDIF C Print some lrecs: IF (NR .LT. 4) THEN WRITE (MSGUN,2000) NR, LLRS, LPAR, LDAT, NSTA, NSTC, SNAM, + SLAT,SLON,SHT, IYR,IMO,IDA,IHR,IMN,IS,IMS, + NTVLS, INST,COMP, MISS, UNITS,IDUC, + IOS1,IOS2,IOST, COM, ISTF C WRITE (MSGUN,2100) NDV,IDV ENDIF C If data are available, write 2 header records, then the data recs: IF (ISTF .EQ. 0) WRITE (IOUN,'(A,I8,1X,A, 1X,A,1X,A, 1X,A,2I8,/, + 7I5, 5X,3I5,5X, I8,/, + (10I7))') + SNAM,NSTA,NSTC, INST,COMP, UNITS,IDUC,IOST, + IYR,IMO,IDA,IHR,IMN,IS,IMS, NTVLS, NDV, + IDV GO TO 100 C Done reading or fatal trouble unpacking 1000 CONTINUE IF (ISTF .EQ. 0) THEN WRITE (MSGUN,2000) NR-1,LLRS, LPAR, LDAT, NSTA, NSTC, SNAM, + SLAT,SLON,SHT, IYR,IMO,IDA,IHR,IMN,IS,IMS, + NTVLS, INST,COMP, MISS, UNITS,IDUC, + IOS1,IOS2,IOST, COM, ISTF C WRITE (MSGUN,2100) NDV,IDV IF (LEM .NE. 0) THEN DO 200 I=1,LEM,80 LST = MIN0 (I+79,LEM) 200 WRITE (MSGUN,'(A)') ERRMSG(I:LST) STOP ENDIF ENDIF 2000 FORMAT (' ',/,' LOGICAL RECORD',I8,/, + ' logical record length (bytes) = ',I8,/, + ' header portion length (bytes) = ',I8,/, + ' data portion length (bytes) = ',I8,/, + ' station number, sub-number (char) = ',I8,' ',A,/, + ' station name = ',A,/, + ' station latitude, longitude, ht (m) = ',2F8.3,I8,/, + ' yr, mon, day, hr, min, sec,millisec = ',I8,6I5,/, + ' sample interval hours,sec,msec = ',3I8,/, + ' instrument type character = ',A,/, + ' component character = ',A,/, + ' missing data code = ',I8,/, + ' data units label = ',A,/, + ' data units code = ',I8, + ' (1=nT, 2=sec, 3=1/4 nT, 4=1/10 min)',/, + ' Offset1, Offset2, Offset = ',2I8,I10,/, + ' Comments = ',A,/, + ' Status flag = ',I8) 2100 FORMAT (' Number of integer data values = ',I8,/,(10I8)) END SUBROUTINE GINT (ISTR,NVALS,IVALS) C Assign adjacent bytes as 16-bit two's complement byte reversed C integers C ISTR = Input array of packed 2-byte integers C NVALS = Number of 2-byte integers to assign C IVALS = Assigned values (word aligned). CHARACTER*1 ISTR(*) DIMENSION IVALS(*) J = -1 DO 100 I=1,NVALS J = J + 2 IVALS(I) = ICHAR (ISTR(J+1))*256 + ICHAR (ISTR(J)) IF (IVALS(I) .GT. 32767) IVALS(I) = IVALS(I) - 65536 100 CONTINUE RETURN END SUBROUTINE GSTR (ISTR,LSTR,STR) C Assign adjacent bytes to character variable CHARACTER*1 ISTR(*) CHARACTER*(*) STR STR = ' ' DO 100 I=1,LSTR 100 STR(I:I) = ISTR(I) RETURN END CEOF Cf77 src$$.f -o exe$$ Cexe$$ < in$$ Ccleanup: Crm -f *{$$}*