C * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * C * globread.f C * C * SAMPLE READ PROGRAM FOR Kuwait region subset of Northern C * Hemisphere longitude/latitude grid. C * C * Copyright 1992, University Corporation for C * Atmospheric Research, All Rights Reserved C * C * DJ (NCAR/SCD/DSS) C * ADM (NCAR/ATD/RAF) modified 6 May 91 C * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * C C Range is 0-90 longitude (37), 0-60 latitude (25) with 2.5 degree C square grids. The data start at 0, 0 and scan east along a C latitude line, then move north. C filenames are: C Y11071 jan 1991 G002.1.19910101000000.all C Y11072 feb 1991 G002.2.19910201000000.all C Y11073 mar 1991 G002.3.19910301000000.all C Y11074 apr 1991 G002.4.19910401000000.all C Y11075 may 1991 G002.5.19910501000000.all C Y11076 jun 1991 G002.6.19910601000000.all C Y11077 jul 1991 G002.7.19910701000000.all C Y11078 aug 1991 G002.8.19910801000000.all C Y11079 sep 1991 G002.9.19910901000000.all C Y11080 oct 1991 G002.10.19911001000000.all C Y11081 nov 1991 G002.11.19911101000000.all C Y11082 dec 1991 G002.12.19911201000000.all C C * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * C C PROGRAM DESCRIPTION: C C PROGRAM READON asks the user to select a month, and then C displays the data array in the first record of the selected C data file. The program loops to repeat the month selection. C C * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * C * PROGRAM READON C * C * SAMPLE READ DRIVER FOR ON84 READ OF IDM X JDM GRIDS. C * C * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * PROGRAM READON C C SET WORD SIZE OF READING MACHINE (IN BITS) PARAMETER (IWSZ=32) C C SET DIMENSIONS OF GRID TO BE READ PARAMETER (IDM=37,JDM=25) C PARAMETER (IJDM=IDM*JDM,IBD64=(384+IJDM*16+63)/64) PARAMETER (IBDM=(64*IBD64+IWSZ-1)/IWSZ,IBYT=8*IBD64) C COMMON /CON84/NQ(1),NS1,NF1,NTM,NC1,NE1,NMA,NEM,NS2,NF2, 2 NNM,NC2,NE2,NCD,NCH,NKS,NK,NUN,NRN,NNW,NYY,NMM,NDD,NII, 3 NRM,NGP,NJJ,NBB,NCSM,NBSN,NBEX,NBFR,NUN1,NUN2,NSCL,BASE, 4 SFC1,SFC2,NIDIM,NJDIM DIMENSION NBF(IBDM),VAL(IDM,JDM),DATA(IJDM),NDATA(IJDM) EQUIVALENCE(VAL,DATA) EQUIVALENCE(NDATA,DATA) C------------------------------------------------------------------- C C INITIALIZATION C IUN=1 CALL INITAL C------------------------------------------------------------------- C C START LOOP THAT WILL END WHEN EOF OR ERROR OCCURS C 5 CALL GOPEN (IUN,IBYT,FLNM,IST) C --- check for ERROR --- IF (IST.NE.0) GO TO 90 MXB=IBDM NPREC=0 NREC=0 C------------------------------------------------------------------- C C READ A RECORD C 10 CALL RON84(IUN,NBF,MXB,IST) C --- check for EOF --- IF(IST .NE. 0) GO TO 90 NREC=NREC+1 NSFC1=SFC1+.5 NSFC2=SFC2+.5 C --- display some header information C PRINT 1007 1007 FORMAT('0 REC YEAR MONTH DAY HOUR K J Q', 2 ' S1 C1E1 S2 C2E2 F1 F2') PRINT 1003,NREC,NYY,NMM,NDD,NII,NK,NJJ,NQ,NS1,NSFC1,NS2,NSFC2, 2 NF1,NF2 1003 FORMAT(1X,20I6) C------------------------------------------------------------------- C C UNPACK THE DATA C CALL UON84(NBF,NDATA,DATA,NERR) C --- skip data records that are garbled --- IF(NERR .NE. 0) GO TO 10 C------------------------------------------------------------------- C NOTE: the grid array DATA or VAL is available at this point C in the code for use in your own programs C------------------------------------------------------------------- C------------------------------------------------------------------- C C CALCULATE AVERAGE VALUE AND DETERMINE C MINIMUM AND MAXIMUM VALUES XMAX=DATA(1) XMIN=DATA(1) XAVE=DATA(1) DO 21 I=2,NJJ IF (DATA(I) .GT. XMAX) XMAX=DATA(I) IF (DATA(I) .LT. XMIN) XMIN=DATA(I) XAVE=XAVE+DATA(I) 21 CONTINUE XAVE=XAVE/NJJ NIJK=NJJ/2 PRINT 1008 1008 FORMAT(1X,' A DATA(1) DATA(J) AVERAGE', 2 ' MINIMUM MAXIMUM') PRINT 1001,BASE,DATA(1),DATA(NJJ),XAVE,XMIN,XMAX 1001 FORMAT(1X,8F12.3) C------------------------------------------------------------------- C C ----------- PRINT GRID ----------- C C GRID is in the 37x25 array VAL() C C display 14 complete longitudes (columns) C at a time (1-14, 15-28, 29-37) going west to east C DO 40 IS=1,IDM,14 IE=IS+13 IF(IE.GT.IDM) IE=IDM PRINT 1005,(I,I=IS,IE) 1005 FORMAT(1H0,9X,14I8) C C display the 25 latitudes (rows) in reverse order, north to south C DO 22 JJ=JDM,1,-1 PRINT 1006,JJ,(VAL(I,JJ),I=IS,IE) 1006 FORMAT(2X,I6,2X,14F8.1) 22 CONTINUE 40 CONTINUE C C------------------------------------------------------------------- 90 CONTINUE CLOSE(UNIT=IUN) IF (IST.EQ.0) THEN C --- Everything is running just fine GOTO 5 C --- continue loop --- ELSEIF (IST.EQ.1) THEN C ---END OF FILE REACHED PRINT 1014,NREC 1014 FORMAT('END OF FILE: NUMBER OF RECORDS = ',I9) ELSEIF (IST.EQ.2) THEN C ---ERROR ENCOUNTERED WRITE(*,'(A)')'UNRECOVERABLE ERROR: EXITING PROGRAM.' PRINT 1015,IST,NREC 1015 FORMAT('STATUS CODE = ',I8,' RECORD NUMBER = ',I9) ELSEIF (IST.EQ.4) THEN C ---USER ENTERED QUIT PRINT 1016 1016 FORMAT(' EXITING PROGRAM') ENDIF C --- exit program --- END C C -------------- END OF PROGRAM READON ---------------------- C C * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * C * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * C * C * SUBROUTINE RON84 C * C * READS NMC OFFICE NOTE 84 FORMAT. C * C * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * SUBROUTINE RON84(IUN,NBF,MXB,IST) DIMENSION NBF(MXB) C C READ STATEMENT MUST BE APPROPRIATE TO READING SYSTEM C C IUN= TAPE UNIT. NBF = TAPE READ BUFFER DIMENSIONED BY MXB. C IST = READ STATUS WHERE 0=OK, 1=EOF, AND 2 = ERROR. C C ALL PARAMETERS IN CON84 ARE RETURNED AND THEIR MEANINGS ARE EXPLAINED C IN NMC ON84. THEIR VALUES MUST NOT BE MODIFIED BY THE CALLING PROGRAM. C VALUES FOR BASE, SFC1, AND SFC2 ARE DERIVED FROM THEIR COMPONENTS IN C ID SECTION OF THE FORMAT. C NIDIM AND NJDIM ARE I AND J DIMENSIONS OF GRID WHICH HAS BEEN READ. C COMMON /CON84/NQ(1),NS1,NF1,NTM,NC1,NE1,NMA,NEM,NS2,NF2, 2 NNM,NC2,NE2,NCD,NCH,NKS,NK,NUN,NRN,NNW,NYY,NMM,NDD,NII, 3 NRM,NGP,NJJ,NBB,NCSM,NBSN,NBEX,NBFR,NUN1,NUN2,NSCL,BASE, 4 SFC1,SFC2,NIDIM,NJDIM DIMENSION ISZ(40) DIMENSION IDIM(70),JDIM(70) DATA ISZ/12,12,8,4,20,8,4,8,12,8,4,20,8,8,8,8,8,4,12,16,8, 2 8,8,8,8,8,16,16,16,1,7,24,8,8,16,5*0/ DATA IDIM/47,73,73,53,17,53,47,0,116,143, 1 216,286,74,36,108,40,39,17,0,47, 2 45,73,73,29,31,53,53,65,65,145, 3 145,327,31,181,181,228,41,145,145,181, 4 181,34,0,65,65,97,97,113,0,129, 5 129,257,257,117,35,87,87,15,1,79, 6 10*0/ DATA JDIM/51,23,24,57,30,57,51,0,44,1, 1 1,1,23,16,1,1,40,13,0,51, 2 59,19,19,27,21,57,45,65,65,37, 3 37,1,24,46,46,1,38,37,37,46, 4 46,25,0,65,65,25,25,89,0,129, 5 129,257,257,51,30,71,71,16,1,67, 6 10*0/ CALL GREAD(IUN,NBF,MXB,IBYT,IST) IF(IST .EQ. 0) GO TO 10 C check for end of file IF(IST .EQ. 1) RETURN PRINT 1001,IST,MXB 1001 FORMAT(' ERROR IN RON84 - IST,MXB ',2I8) RETURN 10 I=1 IOFF=0 20 CALL GBYTES(NBF,NQ(I),IOFF,ISZ(I),0,1) IOFF=IOFF+ISZ(I) I=I+1 IF(ISZ(I) .GT. 0) GO TO 20 IF(NC2 .GT. 524288) NC2=524288-NC2 IF(NC1 .GT. 524288) NC1=524288-NC1 IF(NE1 .GT. 128) NE1=128-NE1 IF(NE2 .GT. 128) NE2=128-NE2 SFC1=FLOAT(NC1)*10.**NE1 SFC2=FLOAT(NC2)*10.**NE2 BASE=FLOAT(NBFR)*16.**(NBEX-70) IF(NSCL .GE. 32768) NSCL=NSCL-65536 IF(NBSN .NE. 0) BASE=-BASE NIDIM=IDIM(NK+1) NJDIM=JDIM(NK+1) RETURN END C * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * C * C * SUBROUTINE UON84 C * C * UNPACKS ON84 DATA WHICH HAS BEEN READ BY RON84. C * C * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * SUBROUTINE UON84(NBF,NDATA,DATA,NERR) C C NBF IS UNMODIFIED BUFFER AS READ BY RDON84. DATA IS ARRAY TO CONTAIN C DATA WHICH MUST BE DIMENSION APPROPRIATE TO THE GRID BEING UNPACKED. C NERR IS STATUS RETURN WHERE NONZERO VALUE INDICATES THAT NBF HAS C BEEN CHANGED BY USER AFTER READ OR THEIR WAS A BAD READ. C DIMENSION NBF(1),NDATA(1),DATA(1) COMMON /CON84/NQ(1),NS1,NF1,NTM,NC1,NE1,NMA,NEM,NS2,NF2, 2 NNM,NC2,NE2,NCD,NCH,NKS,NK,NUN,NRN,NNW,NYY,NMM,NDD,NII, 3 NRM,NGP,NJJ,NBB,NCSM,NBSN,NBEX,NBFR,NUN1,NUN2,NSCL,BASE, 4 SFC1,SFC2,NIDIM,NJDIM NERR=0 IF(NK .NE. 32 .AND. NK .NE. 36) GO TO 8 C CHANGE FROM COLUMN TO ROW ORDERING IOFF=384 IK=NIDIM JK=NJDIM ISKP=16*(JK-1) DO 6 I=1,JK II=IK*(I-1)+1 CALL GBYTES(NBF,NDATA(II),IOFF,16,ISKP,IK) 6 IOFF=IOFF+16 GO TO 9 8 CALL GBYTES(NBF,NDATA,384,16,0,NJJ) 9 CONTINUE SCL2=2.**(NSCL-15) DO 10 I =1,NJJ IDT= NDATA(I) IF(IDT .GE. 32768) IDT=IDT-65536 DATA(I)=FLOAT(IDT)*SCL2+BASE 10 CONTINUE RETURN END C * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * C * C * SUBROUTINE GREAD C * C * . C * C * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * SUBROUTINE GREAD(IUN,NBF,MXB,IBYT,IST) C CHARACTER NFLNM*32 DIMENSION NBF(MXB) C APPROPRIATE SYSTEM READ MUST BE USED IN THIS SUBROUTINE C C INPUT ARGS C IUN - FORTRAN LOGICAL UNIT C NBF - BUFFER DIMENSION LARGE ENOUGH TO CONTAIN DATA RECORD C MXB - DIMENSION OF NBF C C OUTPUT ARGS C NBF - BUFFER CONTAINS RECORD READ C IBYT - NUMBER OF BYTES ACTUALLY READ C IST - STATUS OF READ 0 = GOOD READ, 1 = EOF, 2 = ERROR, 3= END OF DATA CHARACTER*30 FILNAM(12) DATA FILNAM/ 1 "G002.1.19910101000000.all","G002.2.19910201000000.all", 2 "G002.3.19910301000000.all","G002.4.19910401000000.all", 3 "G002.5.19910501000000.all","G002.6.19910601000000.all", 4 "G002.7.19910701000000.all","G002.8.19910801000000.all", 5 "G002.9.19910901000000.all","G002.10.19911001000000.all", 6 "G002.11.19911101000000.all","G002.12.19911201000000.all"/ CHARACTER*32 USERIN NRPT=NRPT+1 READ(IUN,ERR=90,REC=NRPT,IOSTAT=ISTAT)(NBF(I),I=1,MXB) IF(ISTAT.EQ.-1) GO TO 95 IF(ISTAT.NE.0) GO TO 90 C CALL SWAP4(NBF,NBF,NRECL) IBYT=8*MXB RETURN 90 CONTINUE PRINT 1001,ISTAT 1001 FORMAT(' ERROR IN GREAD - ISTAT = ',I12) IST=2 RETURN 95 IST=1 RETURN C C * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * C * C * SUBROUTINE ENTRY POINT GOPEN C * C * . C * C * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ENTRY GOPEN(IUN,IBYT,FLNM,IST) C ENTRY TO ALLOW OPEN OF FILE IF NECESSARY C NRECL=IBYT 800 WRITE(*,*) WRITE(*,'(A,A,A)') " 1) JAN", " 5) MAY", " 9) SEP" WRITE(*,'(A,A,A)') " 2) FEB", " 6) JUN", " 10) OCT" WRITE(*,'(A,A,A)') " 3) MAR", " 7) JUL", " 11) NOV" WRITE(*,'(A,A,A)') " 4) APR", " 8) AUG", " 12) DEC" PRINT 1000 1000 FORMAT(' SELECT A MONTH IN 1991 [1-12/quit]-> ',$) READ(5,'(A32)') USERIN IF (USERIN.EQ.'QUIT' .OR. USERIN.EQ.'quit') THEN IST=4 ELSE C convert to integer READ(USERIN, '(I)') I C make sure entry is from 1 to 12 IF (I.LT.1 .OR. I.GT.12) THEN WRITE(*,'(A)') 'ERROR: ENTER A NUMBER BETWEEN 1 AND 12' GOTO 800 ENDIF C WRITE(*,'(I,2X,A30)')I,FILNAM(I) C make sure file exists OPEN(IUN,FILE=FILNAM(I),ACCESS='DIRECT',RECL=NRECL, 2 FORM='UNFORMATTED',STATUS='OLD',IOSTAT=IERR) IF(IERR.NE.0) THEN IF(IERR.EQ.118) THEN WRITE(*,70)FILNAM(I) 70 FORMAT(" CANNOT FIND FILE "A30) GOTO 800 ELSE WRITE(*,80)IERR,FILNAM(I) 80 FORMAT(' ERROR OPENING FILE ='I9,' ',A30) C quit program C IST=2 ENDIF ENDIF ENDIF C 1000 FORMAT(' ENTER FILE NAME - ') C READ(5,'(A32)')NFLNM C OPEN(IUN,FILE=NFLNM,ACCESS='DIRECT',RECL=NRECL,FORM='UNFORMATTED', C 2 STATUS='OLD') NRPT=0 RETURN END C * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * C * C * SUBROUTINE SWAP C * C * . C * C * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * SUBROUTINE SWAP4(IN,IO,NN) LOGICAL*1 IN(1),IO(1),IH DO 10 I=1,NN,4 IH=IN(I) IO(I)=IN(I+3) IO(I+3)=IH IH=IN(I+1) IO(I+1)=IN(I+2) IO(I+2)=IH 10 CONTINUE RETURN END C * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * C * C * SUBROUTINE GBYTES C * C * . C * C * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * SUBROUTINE GBYTES(IN,IOUT,ISKIP,NBYTE,NSKIP,N) C THIS PROGRAM WRITTEN BY..... C DR. ROBERT C. GAMMILL, CONSULTANT C NATIONAL CENTER FOR ATMOSPHERIC RESEARCH C MAY 1972 C THIS IS THE FORTRAN VERSION OF GBYTES. COMMON/MACHIN/NBITSW,NBITSC,MASK0,MASKS(64) DIMENSION IN(1),IOUT(1) C THE STATEMENTS BETWEEN ASTERISK LINES GIVE ALL NECESSARY MACHINE C DEPENDENT INFORMATION C*********************************************************************** C THIS SPECIFICATION IS FOR SUN UNIX FORTRAN INTEGER RGHTSH,OR,AND LEFTSH(M,N)=ISHFT(M,N) RGHTSH(M,N)=ISHFT(M,-N) OR(M,N)=M.OR.N AND(M,N)=M.AND.N C*********************************************************************** C NBYTE MUST BE LESS THAN OR EQUAL TO NBITSW ICON=NBITSW-NBYTE IF(ICON.LT.0) RETURN MASK=MASKS(NBYTE) C INDEX TELLS HOW MANY WORDS INTO THE ARRAY 'IN' THE NEXT BYTE APPEARS. INDEX=ISKIP/NBITSW C II TELLS HOW MANY BITS THE BYTE IS FROM THE LEFT SIDE OF THE WORD. II=MOD(ISKIP,NBITSW) C ISTEP IS THE DISTANCE IN BITS FROM THE START OF ONE BYTE TO THE NEXT. ISTEP=NBYTE+NSKIP C IWORDS TELLS HOW MANY WORDS TO SKIP FROM ONE BYTE TO THE NEXT. IWORDS=ISTEP/NBITSW C IBITS TELLS HOW MANY BITS TO SKIP AFTER SKIPPING IWORDS. IBITS=MOD(ISTEP,NBITSW) DO 6 I=1,N C MOVER SPECIFIES HOW FAR TO THE RIGHT A BYTE MUST BE MOVED IN ORDER C TO BE RIGHT ADJUSTED. MOVER=ICON-II IF(MOVER) 2,3,4 C C 2: THE BYTE IS SPLIT ACROSS A WORD BREAK. 2 MOVEL=-MOVER MOVER=NBITSW-MOVEL NP1=LEFTSH(IN(INDEX+1),MOVEL) NP2=RGHTSH(IN(INDEX+2),MOVER) IOUT(I)=AND(OR(NP1,NP2),MASK) C IOUT(I)=AND(OR(LEFTSH(IN(INDEX+1),MOVEL),RGHTSH(IN(INDEX+2),MOVER) C 1 ),MASK) GO TO 5 C C 3: THE BYTE IS ALREADY RIGHT ADJUSTED. 3 IOUT(I)=AND(IN(INDEX+1),MASK) GO TO 5 C C 4: RIGHT ADJUST THE BYTE. 4 IOUT(I)=AND(RGHTSH(IN(INDEX+1),MOVER),MASK) C C INCREMENT II AND INDEX. 5 II=II+IBITS INDEX=INDEX+IWORDS IF(II.LT.NBITSW) GO TO 6 II=II-NBITSW INDEX=INDEX+1 6 CONTINUE RETURN END C * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * C * C * SUBROUTINE INITIAL C * C * . C * C * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * SUBROUTINE INITAL C THIS PROGRAM WRITTEN BY..... C DR. ROBERT C. GAMMILL, CONSULTANT C NATIONAL CENTER FOR ATMOSPHERIC RESEARCH C MAY 1972 C THIS ROUTINE INITIALIZES MACHIN COMMON TO DIRECT THE OPERATION OF THE C MACHINE INDEPENDENT ROUTINES. THE PRIMARY TASK IS CREATING MASKS. C INITAL MUST BE CALLED BEFORE GBYTE,GBYTES,SBYTE,SBYTES ARE CALLED. COMMON/MACHIN/NBITSW,NBITSC,MASK0,MASKS(64) C THE STATEMENTS BETWEEN ASTERISK LINES GIVE ALL NECESSARY MACHINE C DEPENDENT INFORMATION C*********************************************************************** C THIS SPECIFICATION IS FOR SUN UNIX FORTRAN. INTEGER OR C THE FOLLOWING ARITHMETIC STATEMENT FUNCTION DEFINES THE METHOD OF C LEFT SHIFTING ON THIS MACHINE. LEFTSH(M,N)=ISHFT(M,N) C THE FOLLOWING ARITHMETIC STATEMENT FUNCTION DEFINES THE METHOD OF C CARRYING OUT LOGICAL-OR ON THIS MACHINE. OR(M,N)=M.OR.N C THE FOLLOWING STATEMENT SPECIFIES HOW MANY BITS PER WORD. NBITSW=32 C*********************************************************************** MASK0=0 MASKS(1)=1 DO 1 I=2,NBITSW 1 MASKS(I)=OR(LEFTSH(MASKS(I-1),1),1) RETURN END C * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * C * C * SUBROUTINE SBYTES C * C * . C * C * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * SUBROUTINE SBYTES(IOUT,IN,ISKIP,NBYTE,NSKIP,N) C THIS PROGRAM WRITTEN BY..... C DR. ROBERT C. GAMMILL, CONSULTANT C NATIONAL CENTER FOR ATMOSPHERIC RESEARCH C JULY 1972 C THIS IS THE FORTRAN VERSIONS OF SBYTES. COMMON/MACHIN/NBITSW,NBITSC,MASK0,MASKS(64) DIMENSION IN(1),IOUT(1) C C THE STATEMENTS BETWEEN ASTERISK LINES GIVE ALL NECESSARY MACHINE C DEPENDENT INFORMATION C*********************************************************************** C THIS SPECIFICATION IS FOR SUN UNIX FORTRAN INTEGER RGHTSH,OR,AND OR(M,N)=M.OR.N AND(M,N)=M.AND.N NOT(M)=.NOT.M LEFTSH(M,N)=ISHFT(M,N) RGHTSH(M,N)=ISHFT(M,-N) C*********************************************************************** C C NBYTE MUST BE LESS THAN OR EQUAL TO NBITSW ICON=NBITSW-NBYTE IF(ICON.LT.0) RETURN MASK=MASKS(NBYTE) C INDEX TELLS HOW MANY WORDS INTO IOUT THE NEXT BYTE IS TO BE STORED. INDEX=ISKIP/NBITSW C II TELLS HOW MANY BITS IN FROM THE LEFT SIDE OF THE WORD TO STORE IT. II=MOD(ISKIP,NBITSW) C ISTEP IS THE DISTANCE IN BITS FROM ONE BYTE POSITION TO THE NEXT. ISTEP=NBYTE+NSKIP C IWORDS TELLS HOW MANY WORDS TO SKIP FROM ONE BYTE TO THE NEXT. IWORDS=ISTEP/NBITSW C IBITS TELLS HOW MANY BITS TO SKIP AFTER SKIPPING IWORDS. IBITS=MOD(ISTEP,NBITSW) DO 6 I=1,N J=AND(MASK,IN(I)) MOVEL=ICON-II IF(MOVEL) 2,3,4 C ------------ C C 2: THE BYTE IS TO BE SPLIT ACROSS A WORD BREAK. 2 MSK=MASKS(NBYTE+MOVEL) IOUT(INDEX+1)=OR(AND(NOT(MSK),IOUT(INDEX+1)),RGHTSH(J,-MOVEL)) ITEMP=AND(MASKS(NBITSW+MOVEL),IOUT(INDEX+2)) IOUT(INDEX+2)=OR(ITEMP,LEFTSH(J,NBITSW+MOVEL)) GO TO 5 C C 3: BYTE IS TO BE STORED RIGHT-ADJUSTED. 3 IOUT(INDEX+1)=OR(AND(NOT(MASK),IOUT(INDEX+1)),J) GO TO 5 C C 4: BYTE IS TO BE STORED IN MIDDLE OF WORD. SHIFT LEFT. 4 MSK=LEFTSH(MASK,MOVEL) IOUT(INDEX+1)=OR(AND(NOT(MSK),IOUT(INDEX+1)),LEFTSH(J,MOVEL)) C ------------ 5 II=II+IBITS INDEX=INDEX+IWORDS IF(II.LT.NBITSW) GO TO 6 II=II-NBITSW INDEX=INDEX+1 6 CONTINUE RETURN END C ------------------------------------------------------------------------ C end of file globread.f C ------------------------------------------------------------------------