      PROGRAM READS4
C 
c   Notes to users - Program READS4 was originally developed for the CDC Cyber
c                    machines;  the following version has been modified
c                    twice - once to run on a UNIX system and read files which 
c                    were produced on this UNIX system (these changes are 
c                    identified in code as "unix conversion") ,and a second 
c                    time to read an image from the optical disk (these
c                    changes are identified as "daac conversion"). Lines
c                    of code which needed changes were commented out and new  
c                    lines added in case other systems need the original
c                    information.
c                    
c                    Some things to notice about this program:
c                     
c
c                    1.  The subroutine STUFF has been modified and now calls  
c                    C routines which are in the file GBYTES.C.    
c
c
c                    2.  The FORTRAN "open" and "read" statements have been
c                    replaced with C routines "copen" and "cread" which are in 
c                    the file io.c.
c
c                    4.  The S-4 contains 26 separate files.  This program
c                    is designed to read the header, the scale
c                    factors, and one of the data files per run.  Before using
c                    this program, the S-4 product is separated into 26 files
c                    with these names:  
c                     
C               file1  =  HEADER  
C               file2  =  SCANNER SCALE FACTORS
C               file3  =  NONSCANNER SCALE FACTORS                    
C               file4  =  NFOV INPUT DATA  
C               file5  =  NFOV 5.0 DEG. NESTED DATA  
C               file6  =  NFOV 10.0 DEG. NESTED DATA 
C               file7  =  NFOV 2.5 DEG. ZONAL DATA 
C               file8  =  NFOV 5.0 DEG. ZONAL DATA 
C               file9  =  NFOV 10.0 DEG. ZONAL DATA  
C              file10  =  NFOV GLOBAL DATA 
C              file11  =  MFOV-NF INPUT DATA 
C              file12  =  MFOV-NF 10.0 DEG. NESTED DATA  
C              file13  =  MFOV-NF 5.0 DEG. ZONAL DATA  
C              file14  =  MFOV-NF 10.0 DEG. ZONAL DATA 
C              file15  =  MFOV-NF GLOBAL DATA  
C              file16  =  WFOV-NF INPUT DATA 
C              file17  =  WFOV-NF 10.0 DEG. NESTED DATA  
C              file18  =  WFOV-NF 5.0 DEG. ZONAL DATA  
C              file19  =  WFOV-NF 10.0 DEG. ZONAL DATA 
C              file20  =  WFOV-NF GLOBAL DATA  
C              file21  =  MFOV-SF INPUT DATA 
C              file22  =  MFOV-SF 10.0 DEG. ZONAL DATA 
C              file23  =  MFOV-SF GLOBAL DATA  
C              file24  =  WFOV-SF INPUT DATA 
C              file25  =  WFOV-SF 10.0 DEG. ZONAL DATA 
C              file26  =  WFOV-SF GLOBAL DATA  
C 
C                            $SPECS INST  IRES  IMF  ICOVRG  ,IRECF  IRECL
C file4  s4_04_sc2.5_84112           1     1     2     1      2145   2145
C file10 s4_10_scglb_84112           1     2     1     3        1      1 
C file11 s4_11_mnf5.0_84112          2     1     1     1       1145   1145
C file21 s4_21_msf10_84112           2     3     1     1       145    145
C file22 s4_22_msf10z_84112          2     3     1     2        5      5 
C file23 s4_23_msfglb_84112          2     3     1     3        1      5
C file24 s4_24_wsf10_84112           2     3     2     1       145    145
C file25 s4_25_wsf10z_84112          2     3     2     2        5      5
c file26 s4_26_wsfglb_84112          2     3     2     3        1      5
C
C Above are examples of input setup file s4namls.
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C 
C  NAME  -  READS4
C  LANGUAGE - FORTRAN V                  TYPE- PROGRAM
C  VERSION - 3.0          UPDATE- 2/88   PROGRAMMER- Jill Travers
C  VERSION - 4.0          UPDATE- 2/93   PROGRAMMER- Libby Smith 
C  VERSION - 5.0          UPDATE- 3/93   PROGRAMMER- Libby Smith 
c  VERSION - 6.0	  UPDATE- 5/94	 PROGRAMMER- Enakshi Singh
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C 
C  PURPOSE:  TO READ, UNPACK AND SELECTIVELY PRINT OUT
C             PORTIONS OF THE S-4 OUTPUT PRODUCT. 
C 
C NOTE:  SEE BLOCK DATA SECTION FOR INSTRUCTIONS ON HOW TO USE
C        THIS PROGRAM.
C 
C  INPUT FILES:  NAMELIST FILES (ON UNITS 50 AND 51)
C  OUTPUT FILES:  TAPE9 TO SHOW REQUESTED DATE FROM DUMPS 
C 
C  COMMON BLOCKS:    /CHARCM/, /DATLOC/, /DESCRP/, /DATRAY/, /NMPARAM/, 
C                   /GLOBAL/, /HEADER/, /RECLOC/, /FILLOC/, /S4IO/
C               SEE BLOCK DATA FOR DESCRIPTION OF EACH COMMON BLOCK 
C 
C  NAMELISTS
C            $SPECS-
C               INST - INSTRUMENT CODE 1=SCANNER 2=NONSCANNER 
C               IRES - RESOLUTION 1=2.5 2=5.0 3=10.0 DEGREES
C               IMF  - FIELD OF VIEW
C               ICOVRG-1=REGIONAL  2=ZONAL  3=GLOBAL
C               IRECF- FIRST RECORD TO DUMP (REGION NUMBER) 
C               IRECL- LAST RECORD TO DUMP  (REGION NUMBER) 
C               IRAY - ARRAY SPECIFYING WHICH TYPE OF VALUES TO DUMP
C                      1= MONTHLY(DAY)     2= MONTHLY(HOUR) 
C                      3= DAILY            4= HOURLY
C               IDATA- ARRAY INDICATING WHICH DATA TO DUMP
C 
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C 
CCCCC  CHARACTER STATEMENTS 
C 
      CHARACTER SCNNAM*37, NSCNAM*32
      CHARACTER IHDMP(11)*30,ISCNAM(3)*8,CVAR*60 
C 
      LOGICAL IERR, DOREP,DOFILE
C 
CCCCC  COMMON BLOCKS
C 
      COMMON /CHARCM/ IHDMP,ISCNAM,CVAR 
      COMMON /DATLOC/ NSCBEG(29),NSCEND(29),ISCBEG(49),ISCEND(49),
     2                ISCMAX(7), INSMAX(16), ISCNDX(49), NSINDX(29),
     3                ISCITM, INSITM
      COMMON /DESCRP/ SCNNAM(49), NSCNAM(29)
      COMMON /DATRAY/ ISCPCK(1290),ISCFAC(675),INSPCK(720),INSFAC(360), 
     1                ISCDAT(675),RSCDAT(675),INSDAT(360),RNSDAT(360) 
      COMMON /NMPARAM/ INST, IRES, IMF, ICOVRG, IRECF, IRECL, 
     1                 IRAY(4),IDATA(9) 
      COMMON /GLOBAL/ ISUBNO,IVERSN,MSGUNT,IVAR(3),RVAR(3)
      COMMON /HEADER/ IYR,IMO,ISPACE,INSTCD 
      COMMON /RECLOC/ ISCREC(7),  LSCREC(7),
     1                INSREC(16), LNSREC(16)
      COMMON /FILLOC/ ISCFIL(7),  INSFIL(16)
      COMMON /S4IO/ IOS4, NFILE, NPKS4,IERR,DOREP, DOFILE, IDB
c +++
c daac conversion - read ERBE header'
c +++
      integer string(30)
C 
      DATA ISCNAM / 'NOAA 9', 'ERBS', 'NOAA10'/
      DATA IND  /0/ 
C 
CCCCC  DECLARE NAMELISTS OPEN AND READ CCCCCCCCCCCC 
C 
      NAMELIST /SPECS/ INST,IRES,IMF,ICOVRG,IRECF,IRECL,IRAY,IDATA
C 
C    OPEN OUTPUT FILES
C 
      OPEN (NPKS4,IOSTAT=IOS,ERR=333) 
      OPEN (IDB,IOSTAT=IOS,ERR=333) 
C 
CCCCC  READ THE NAMELIST
c
      OPEN (50,file ='s4namls',IOSTAT=IOS) 
      write(77,*) ios
      READ (50,SPECS,IOSTAT=IOS) 
      WRITE (NPKS4,SPECS,IOSTAT=IOS)
      CLOSE (50,IOSTAT=IOS)
C 
C *** INITIALIZE VALUES 
C 
      IERR = .FALSE.
      msgunt = 95
      IOS4=8
c +++
c daac conversion - read erbe header using C routines, copen and cread
c +++ 
      CALL COPEN('file1',5,IUNH)
      CALL CREAD(IUNH,30,STRING,IOS)           
      if(ios.ne.30) then
        go to 222
      endif
C 
C *** GET SCANNER SCALE FACTORS 
c +++
c  daac conversion - call C open routine instead of using FORTRAN open
c +++
C
      call copen('file2',5,isccal)
      call scnscl (isccal)
      WRITE(77,6543) 
6543  FORMAT('IERR, ',I5)
      WRITE(77,*) IERR 
      IF (IERR) GOTO 999
C 
C *** GET THE NONSCANNER SCALE FACTORS
C
      call copen('file3',5,inscal)
      CALL NSCSCL (inscal)
      IF (IERR) GOTO 999
      IF (INST.EQ.1) THEN 
        CALL SCNINIT
      ELSE
        CALL NSCINIT
      ENDIF 
C 
C *** READ THE SCANNER FILES
C 
      DO 100 IFILE = 1,7
        IF (ISCFIL(IFILE).EQ.1) THEN
          PRINT *,'*** NOW PROCESSING SCANNER FILE ***'
          CALL SCNFIL(IFILE)
          IF(IERR) GOTO 999 
        ENDIF 
  100 CONTINUE
C 
C *** READ THE NONSCANNER FILES 
C 
      DO 150 IFILE = 1,16 
        IF (INSFIL(IFILE).EQ.1) THEN 
          PRINT *,'*** NOW PROCESSING NONSCANNER FILES ***'
          CALL NSCFIL(IFILE)        
          IF(IERR) GOTO 999 
        ENDIF
  150 CONTINUE
C 
      GOTO 999
C 
 222  WRITE (NPKS4,1005) IOS
1005  FORMAT (' ',5X,'read FILE ERROR on header file ',/, 
     1             5X,'                    IOS = ',I6)
      GOTO 999
c
 333  WRITE (NPKS4,1000) IOS
1000  FORMAT (' ',5X,'OPEN FILE ERROR IN READS4 ',/, 
     1             5X,'                    IOS = ',I6)
      GOTO 999
C 
  441 WRITE (NPKS4,451) IFILE,IOS 
  451  FORMAT (' ',5X,'OPEN ERROR ON SCANNER FILE ',I1,/, 
     1             5X,'                     IOS = ',I6) 
      GOTO 999
C 
  442  WRITE (NPKS4,452) IFILE,IOS
  452  FORMAT (' ',5X,'OPEN ERROR ON NONSCANNER FILE ',I1,/,
     1             5X,'                        IOS = ',I6)
      GOTO 999
C 
  551 WRITE (NPKS4,561) IFILE,IOS 
  561  FORMAT (' ',5X,'READ ERROR ON SCANNER FILE ',I1,/, 
     1             5X,'                     IOS = ',I6) 
      GOTO 999
C 
  552 WRITE (NPKS4,562) IFILE,IOS 
  562  FORMAT (' ',5X,'READ ERROR ON NONSCANNER FILE ',I1,/,
     1             5X,'                        IOS = ',I6)
      GOTO 999
c
  661 WRITE (NPKS4,671) IFILE,IOS 
  671  FORMAT (' ',5X,'CLOSE ERROR ON SCANNER FILE ',I1,/,
     1             5X,'                      IOS = ',I6)
      GOTO 999
C 
  662 WRITE (NPKS4,672) IFILE,IOS 
  672  FORMAT (' ',5X,'CLOSE ERROR ON NONSCANNER FILE ',I1,/, 
     1             5X,'                         IOS = ',I6) 
      GOTO 999
C 
  777 WRITE (NPKS4,1100) IOS
 1100  FORMAT (' ',5X,'CLOSE FILE ERROR IN READS4 ',/,
     1             5X,'                     IOS = ',I6) 
c
 5000  FORMAT (' ',5X,'S4 TAPE DUMP FOR ',I2,'-',I2,/,
     1          ' SATELLITE CODE = ',I1)
C 
C *** TERMINATE PROCESSING
C 
  999 ITERM = 0 
C
      END 
C 
C 
      BLOCK DATA S4BLK
C 
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C 
CCCCC  DEFINITIONS AND INITIALIZATIONS OF VARIABLES USED IN THE 
CCCCC  READS4 PROGRAM.
CCCCC 
CCCCC       1. CAN ACCESS 1 FILE AT A TIME
CCCCC 
CCCCC       2.  CAN ACCESS A RANGE OF RECORDS IN EACH 
CCCCC           FILE
CCCCC 
CCCCC       3.  CAN ACCESS 1 DATA ITEMS, ALL DATA ITEMS, OR ONLY
CCCCC           CERTAIN DATA ITEMS IN THE INDICATED RECORDS.
CCCCC 
CCCCC       4.  CAN CREATE FORMATTED LISTINGS OR UNFORMATTED
CCCCC           LISTINGS OF THE PROCESSED RECORDS.
CCCCC 
C 
CCC COMMON BLOCKS USED
C 
C                    /DATLOC/ 
C 
C     NSCBEG(29)--------BEGINNING POSITIONS OF THE DATA ITEMS IN THE
C                       NONSCANNER RECORDS. 
C     NSCEND(29)--------ENDING POSITIONS OF THE DATA ITEMS IN THE 
C                       NONSCANNER RECORDS. 
C     ISCBEG(49)--------BEGINNING POSITIONS OF THE DATA ITEMS IN THE
C                       SCANNER RECORDS.
C     ISCEND(49)--------ENDING POSITIONS OF THE DATA ITEMS IN THE 
C                       SCANNER RECORDS.
C     ISCMAX(7)---------MAXIMUM POSSIBLE NUMBER OF DATA RECORDS (OR 
C                       REGIONS) IN EACH OF THE SCANNER DATA FILES. 
C     INSMAX(16)--------MAXIMUM POSSIBLE NUMBER OF DATA RECORDS (OR 
C                       REGIONS IN EACH OF THE NONSCANNER DATA FILES. 
C     ISCNDX(49)--------CONTAINS THE NUMBER(S) OF THE SCANNER DTA 
C                       ITEMS TO BE ACCESSED.  THESE NUMBERS ARE
C                       OBTAINED BY LOOKING AT THE DATA STATEMENTS
C                       FOR THE ARRAY SCNNAM AND CHOOSING THE 
C                       APPROPRIATE SUBSCRIPTS. 
C      NSINDX(29)-------CONTAINS THE NUMBER(S) OF THE NONSCANNER DATA 
C                       ITEMS TO BE ACCESSED.  THESE NUMBERS ARE
C                       OBTAINED BY LOOKING AT THE DATA STATEMENTS
C                       FOR THE ARRAY NSCNAM  AND CHOOSING THE
C                       APPROPRIATE SUBSCRIPTS. 
C     ISCITM-----------VARIABLE WHICH IS SET TO THE NUMBER OF 
C                      ITEMS TO BE ACCESSED IN THE SCANNER RECORDS
C                      DURING A GIVEN RUN.
C     INSITM-----------VARIABLE WHICH IS SET TO THE NUMBER OF 
C                      ITEMS TO BE ACCESSED IN THE NONSCANNER RECORDS 
C                      DURING A GIVEN RUN.
C 
C                          /DATRAY/ 
C 
C     ISCPCK(1290)----------ARRAY CONTAINING THE PACKED SCANNER RECORDS
C                          AND SCALE FACTORS. 
C     ISCFAC(675)----------ARRAY CONTAINING THE UNPACKED SCANNER SCALE
C                          FACTORS. 
C     INSPCK(720)-----------INPUT ARRAY CONTAINING THE PACKED NONSCANNER 
C                          RECORDS AND SCALE FACTORS. 
C     INSFAC(360)----------ARRAY CONTAINING THE UNPACKED NONSCANNER 
C                          SCALE FACTORS. 
C     ISCDAT(675)----------INTERMEDIATE ARRAY CONTAINING THE UNPACKED 
C                          BUT UNSCALED SCANNER DATA VALUES.
C     RSCDAT(675)----------ARRAY CONTAINING THE UNPACKED AND SCALED 
C                          DATA VALUES. 
C     INSDAT(360)----------INTERMEDIATE ARRAY CONTAINING THE UNPACKED 
C                          BUT UNSCALED NONSCANNER DATA VALUES. 
C     RNSDAT(360)----------ARRAY CONTAINING THE UNPACKED AND SCALED 
C                          NONSCANNER DATA VALUES.
C 
C                    /DESCRP/ 
C 
C     SCNNAM(49)--------CHARACTER STRINGS DESCRIBING THE DATA ITEMS IN
C                       THE SCANNER FILES.
C     NSCNAM(29)--------CHARACTER STRINGS DESCRIBING THE DATA ITEMS IN
C                       THE NONSCANNER FILES. 
C 
C                       /FILLOC/
C 
C     ISCFIL(7)----------ARRAY WITH EACH ELEMENT REPRESENTING ONE 
C                        OF THE SCANNER FILES.  THESE ELEMENTS ARE
C                        SET TO ONE IF IT IS DESIRED TO ACCESS THE
C                        FILE OR TO 0 OTHERWISE.
C     INSFIL(16)---------ARRAY WITH EACH ELEMENT REPRESENTING ONE 
C                        OF THE NONSCANNER FILES.  THESE ELEMENTS 
C                        ARE SET TO ONE IF IT IS DESIRED TO ACCESS
C                        THE FILE OR TO 0 OTHERWISE.
C 
C                        /FILVAL/ 
C 
C     DFALT(3)------------ARRAY CONTAINING FILL/DEFAULT VALUES FOR
C                         PACKED DATA.
C                             32 BITS = 2147483647.0
C                             16 BITS =      32767.0  **
C                              8 BITS =        127.0
C 
C      **  ONE NOW BEING USED DUE TO CHANGE TO USING ERBE UTILITIES 
C 
C                        /RECLOC/ 
C 
C     ISCREC(7)----------EACH ELEMENT IN THE ARRAY IS SET TO THE FIRST
C                        PHYSICAL RECORD TO BE ACCESSED IN THAT FILE. 
C                        NOTE THAT THE REGION NUMBERS DO NOT
C                        NECESSARILY CORRESPOND TO THE RECORD NUMBER
C                        SINCE SOME REGIONS MAY BE MISSING. 
C     INSREC(16)---------SAME AS FOR ISCREC BUT FOR THE NONSCANNER
C                        RECORDS. 
C     LSCREC(7)----------EACH ELEMENT IN THE ARRAY IS SET TO THE LAST 
C                        PHYSICAL RECORD TO BE ACCESSED IN THAT 
C                        FILE.  AGAIN, PHYSICAL RECORD NUMBERS DO 
C                        NOT NECESSARILY CORRESPOND TO REGION NUMBER. 
C     LNSREC(16)---------SAME AS FOR LSCREC BUT FOR THE NONSCANNER
C                        RECORDS. 
C 
C                    /S4IO/ 
C 
C     IOS4--------------INPUT FILE. 
C     NFILE-------------OUTPUT FILE CONTAINING UNFORMATTED OUTPUT.
C     NPKS4-------------OUTPUT FILE CONTAINING FORMATTED OUTPUT.
C     IERR--------------ERROR INDICATOR.  LOGICAL SET TO TRUE OR FALSE. 
C     DOREP-------------PROGRAM PRODUCES A FORMATTED LISTING OF THE 
C                       PROCESSED RECORDS WHEN DOREP SET TO TRUE. 
C     DOFILE------------PROGRAM PRODUCES AN UNFORMATTED LISTING OF
C                       PROCESSED DATA RECORDS WHEN DOFILE SET TO 
C                       TRUE. 
C 
C                    /UNPDAT/ 
C 
C     IBITNO(3)---------THE DATA WAS PACKED USING 32-BIT, 16-BIT, AND 
C                       8-BIT WORDS.  THIS ARRAY IS USED IN UNPACKING 
C                       THE DATA. 
C     ISTPOS(3,2)-------INDICATES THE LOCATIONS OF THE FIRST WORD 
C                       FOR THE 32-BIT, 16-BIT, 
C                       AND 8-BIT WORDS FOR EACH OF THE TWO BASIC 
C                       TYPES OF DATA FILES.
C                               1.  SCANNER 
C                               2.  NONSCANNER
C     LSTPOS(3,2)-------INDICATES THE LOCATIONS OF THE LAST WORDS FOR 
C                       32-BIT, 16-BIT, 8-BIT WORDS FOR EACH OF 
C                       THE TWO BASIC TYPES OF DATA FILES:  
C                               1.  SCANNER 
C                               2.  NONSCANNER
C     NUMBTYP-----------THE NUMBER OF X-BIT WORD TYPES.  FOR S-4
C                       THERE ARE THREE:  32-BIT, 16-BIT, AND 8-BIT 
C                       WORDS.
C 
C 
      CHARACTER SCNNAM*37, NSCNAM*32
      LOGICAL IERR,DOREP,DOFILE 
C 
      COMMON /S4IO/ IOS4, NFILE,  NPKS4, IERR, DOREP, DOFILE, IDB 
      COMMON /UNPDAT/IBITNO(3),ISTPOS(3,2),LSTPOS(3,2),NUMBTYP
      COMMON /DATLOC/ NSCBEG(29),NSCEND(29),ISCBEG(49),ISCEND(49),
     2                ISCMAX(7), INSMAX(16), ISCNDX(49), NSINDX(29),
     3                ISCITM, INSITM
      COMMON /DATRAY/ ISCPCK(1290),ISCFAC(675),INSPCK(720),INSFAC(360), 
     1                ISCDAT(675),RSCDAT(675),INSDAT(360),RNSDAT(360) 
      COMMON /GLOBAL/ ISUBNO,IVERSN,MSGUNT,IVAR(3),RVAR(3)
      COMMON /HEADER/ IYR,IMO,ISPACE,INSTCD 
      COMMON /RECLOC/ ISCREC(7),  LSCREC(7),
     1                INSREC(16), LNSREC(16)
      COMMON /FILLOC/ ISCFIL(7),  INSFIL(16)
      COMMON /FILVAL/ DFALT(3)
      COMMON /DESCRP/ SCNNAM(49), NSCNAM(29)
C 
CCCCC  DATA STATEMENTS
C 
CCCCCCCCCCCCCCCCCCC  START OF DYNAMIC ITEMS  CCCCCCCCCCCCCCCCCCCCCCCCCC 
C 
CCC  IF BOTH LOGICAL VARIABLES BELOW ARE SET TO TRUE, TWO 
CCC  SEPARATE FILES WILL BE CREATED.  DOREP CAUSES A
CCC  FORMATTED FILE (LABELLED VALUES ARE PRINTED OUT IN 
CCC  THE SAME ORDER AS THEY ARE STORED IN THE RECORDS). 
CCC  DOFILE     CAUSES AN UNFORMATTED FILE (VALUES ARE PRINTED
CCC  WITHOUT LABELS IN ONE LARGE GROUP).  ALL THE ABOVE 
CCC  VALUES HAVE BEEN UNPACKED AND SCALED.
CCC  DOFILE     WILL PRINT OUT ALL VALUES IN A GIVEN RECORD WHILE 
CCC  DOREP WILL PRINT OUT ONLY THOSE VALUES SELECTED BELOW. 
C 
        DATA  DOREP  /.TRUE./ 
C 
        DATA  DOFILE     /.FALSE./
C 
CCCC  DETERMINE WHICH FILES TO ACCESS BY SETTING THE APPROPRIATE
CCCC  VALUES TO 1 AND THE REMAINDER TO 0.  THE ARRAY ISCFIL REPRESENTS
CCCC  THE SCANNER FILES AND THE ARRAY INSFIL REPRESENTS THE NONSCANNER
CCCC  FILES.
C 
      DATA ISCFIL / 0,  0,  0,  0,  0,  0,  0/
      DATA INSFIL / 0,  0,  0,  0,  0,
     2              0,  0,  0,  0,  0,
     3              0,  0,  0,
     4              0,  0,  0                /
C 
CCC  DETERMINE THE FIRST AND LAST RECORDS 
CCC  IN THE DESIRED RANGE FOR EACH FILE CHOSEN.  ARRAY ISCREC 
CCC  CONTAINS THE FIRST RECORD NUMBERS FOR THE SCANNER RECORDS AND
CCC  ARRAY LSCREC CONTAINS THE LAST RECORD NUMBERS FOR THE SCANNER
CCC  RECORDS.  ARRAY INSREC CONTAINS THE FIRST RECORD NUMBERS FOR 
CCC  THE NONSCANNER RECORDS AND ARRAY LNSREC CONTAINS THE LAST
CCC  RECORD NUMBERS FOR THE NONSCANNER FILES. 
C 
      DATA ISUBNO/7/, IVERSN/3/ 
      DATA IYR, IMO, ISPACE,INSTCD /0,0,1,3/
      DATA ISCREC /0,0,0,0,0,0,0 /
      DATA LSCREC /0, 0, 0, 0, 0, 0, 0 /
      DATA INSREC / 0,0,0,0,0,
     2              0,0,0,0,0,
     3              0,0,0,
     4              0,0,0     / 
      DATA LNSREC / 0, 0, 0, 0, 0,
     1              0, 0, 0, 0, 0,
     3               0,  0,  0, 
     4               0,  0,  0        / 
C 
CCC  NOTE:  THE PHYSICAL RECORD NUMBERS AND THE REGION NUMBERS WILL 
CCC         NOT CORRESPOND WHEN THERE ARE MISSING REGIONS IN THE DATA.
CCC         SEE THE REGIONAL REPORTS TO DETERMINE THE CORRESPONDENCE
CCC         BETWEEN REGION NUMBER AND RECORD NUMBER.
C 
CCC  DETERMINE WHICH DATA ITEMS ARE TO BE ACCESSED.  SEE THE DATA 
CCC  STATEMENTS BELOW FOR DESCRIPTIONS OF THE DATA ITEMS.  ENTER
CCC  THE CORRESPONDING SUBSCRIPT NUMBERS IN THE ARRAY BELOW.  USE THE 
CCC  SUBSCRIPT NUMBERS FROM THE SCNNAM ARRAY IN THE ISCNDX ARRAY
CCC  FOR SCANNER DATA ITEMS.   USE THE SUBSCRIPT NUMBERS FROM THE 
CCC  NSCNAM ARRAY IN THE NSINDX ARRAY FOR THE NONSCANNER DATA 
CCC  ITEMS. 
C
      DATA ISCNDX /49*0/
      DATA NSINDX /29*0/
C 
CCC INDICATE THE TOTAL NUMBER OF ITEMS TO BE ACCESSED 
CCC HERE FOR SCANNER AND/OR NONSCANNER. 
CCC SET ISCITM TO 49 IF ALL THE SCANNER ITEMS ARE TO BE 
CCC ACCESSED.  SET INSITM TO 28 IF ALL THE NONSCANNER ITEMS 
CCC ARE TO BE ACCESSED. 
C 
      DATA ISCITM /0/ 
      DATA INSITM /0/ 
C 
CCCCCCCCCCCCCC    END OF DYNAMIC ITEMS CCCCCCCCCCCCCCCCCCCCC
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 
C 
CCC THE ITEMS BELOW ARE CONSTANTS AND SHOULD NOT BE CHANGED.
C 
      DATA ISCMAX /10082, 2592, 648, 72, 36, 18, 3 /
      DATA INSMAX /2592, 648, 36, 18, 2,
     1             2592, 648, 36, 18, 2,
     2              648,  18,  1, 
     3              648,  18,  1 /
      DATA IBITNO /32, 16, 8/ 
      DATA ISTPOS /1,91,436,
     1             1,61,241/
      DATA LSTPOS /90,435,675,
     1             60,240,360/
      DATA NUMBTYP / 3 /
      DATA SCNNAM(1)/ 'FILE ID                              '/
      DATA SCNNAM(2) /'TSOLRD-MONTHLY(DAY)                  '/
      DATA SCNNAM(3) /'NET-MONTHLY(DAY)                     '/
      DATA SCNNAM(4) /'NETCS-MONTHLY(DAY)                   '/
      DATA SCNNAM(5) /'TSOLRDCS-MONTHLY(DAY)                '/
      DATA SCNNAM(6) /'NET-MONTHLY(HR)                      '/
      DATA SCNNAM(7) /'TSOLRH-MONTHLY(HR)                   '/
      DATA SCNNAM(8) /'NETCS-MONTHLY(HR)                    '/
      DATA SCNNAM(9) /'TSOLRHCS-MONTHLY(HR)                 '/
      DATA SCNNAM(10)/'SOLARD-DAILY                         '/
      DATA SCNNAM(11)/'SOLARH-MONTHLY HOURLY                '/
      DATA SCNNAM(12)/'SOLARHCS-MONTHLY HOURLY              '/
      DATA SCNNAM(13)/'SPARES                               '/
      DATA SCNNAM(14) /'REGION NUMBER                        '/ 
      DATA SCNNAM(15) /'DATE: YYMM                           '/ 
      DATA SCNNAM(16) /'SPACECRAFT ID                        '/ 
      DATA SCNNAM(17) /'LW-MONTHLY(DAY)                      '/ 
      DATA SCNNAM(18) /'SW-MONTHLY(DAY)                      '/ 
      DATA SCNNAM(19) /'ALBEDO-MONTHLY(DAY)                  '/ 
      DATA SCNNAM(20) /'LWCS-MONTHLY(DAY)                    '/ 
      DATA SCNNAM(21) /'SWCS-MONTHLY(DAY)                    '/ 
      DATA SCNNAM(22) /'ALBEDOCS-MONTHLY(DAY)                '/ 
      DATA SCNNAM(23) /'LW-MONTHLY(HOUR)                     '/ 
      DATA SCNNAM(24) /'SW-MONTHLY(HOUR)                     '/ 
      DATA SCNNAM(25) /'ALBEDO-MONTHLY(HOUR)                 '/ 
      DATA SCNNAM(26) /'LWCS-MONTHLY(HOUR)                   '/ 
      DATA SCNNAM(27) /'SWCS-MONTHLY(HOUR)                   '/ 
      DATA SCNNAM(28) /'ALBEDOCS-MONTHLY(HOUR)               '/ 
      DATA SCNNAM(29) /'LW-DAILY                             '/ 
      DATA SCNNAM(30) /'SW-DAILY                             '/ 
      DATA SCNNAM(31) /'ALBEDO-DAILY                         '/ 
      DATA SCNNAM(32) /'LWCS-DAILY                           '/ 
      DATA SCNNAM(33) /'SWCS-DAILY                           '/ 
      DATA SCNNAM(34) /'ALBEDOCS-DAILY                       '/ 
      DATA SCNNAM(35) /'LW-MONTHLY HOURLY                    '/ 
      DATA SCNNAM(36) /'SW-MONTHLY HOURLY                    '/ 
      DATA SCNNAM(37) /'ALBEDO-MONTHLY HOURLY                '/ 
      DATA SCNNAM(38) /'LWCS-MONTHLY HOURLY                  '/ 
      DATA SCNNAM(39) /'SWCS-MONTHLY HOURLY                  '/ 
      DATA SCNNAM(40) /'ALBEDOCS-MONTHLY HOURLY              '/ 
      DATA SCNNAM(41) /'NDLW-DAILY                           '/ 
      DATA SCNNAM(42) /'NDSW-DAILY                           '/ 
      DATA SCNNAM(43) /'NDLWCS-DAILY                         '/ 
      DATA SCNNAM(44) /'NDSWCS-DAILY                         '/ 
      DATA SCNNAM(45) /'NHLW-MONTHLY HOURLY                  '/ 
      DATA SCNNAM(46) /'NHSW-MONTHLY HOURLY                  '/ 
      DATA SCNNAM(47) /'NHLWCS-MONTHLY HOURLY                '/ 
      DATA SCNNAM(48) /'NHSWCS-MONTHLY HOURLY                '/ 
      DATA SCNNAM(49) /'SCANNER GEOGRAPHIC SCENE TYPE        '/ 
      DATA NSCNAM(1) /'FILE ID                         '/ 
      DATA NSCNAM(2) /'TSOLRD-MONTHLY(DAY)             '/ 
      DATA NSCNAM(3) /'MNET-MONTHLY(DAY)               '/ 
      DATA NSCNAM(4) /'MNET-MONTHLY(HR)                '/ 
      DATA NSCNAM(5) /'TSOLRH-MONTHLY(HR)              '/ 
      DATA NSCNAM(6) /'SOLARD-DAILY                    '/ 
      DATA NSCNAM(7) /'SOLARH-MONTHLY HOURLY           '/ 
      DATA NSCNAM(8) /'REGION NUMBER                   '/ 
      DATA NSCNAM(9) /'DATE:  YYMM                     '/ 
      DATA NSCNAM(10)/'SPACECRAFT ID                   '/ 
      DATA NSCNAM(11)/'LW-MONTHLY(DAY)                 '/ 
      DATA NSCNAM(12)/'SW-MONTHLY(DAY)                 '/ 
      DATA NSCNAM(13)/'ALBEDO-MONTHLY(DAY)             '/ 
      DATA NSCNAM(14)/'LW-MONTHLY(HR)                  '/ 
      DATA NSCNAM(15)/'SW-MONTHLY(HR)                  '/ 
      DATA NSCNAM(16)/'ALBEDO-MONTHLY(HR)              '/ 
      DATA NSCNAM(17)/'LW-DAILY                        '/ 
      DATA NSCNAM(18)/'SW-DAILY                        '/ 
      DATA NSCNAM(19)/'ALBEDO-DAILY                    '/ 
      DATA NSCNAM(20)/'LW-MONTHLY HOURLY               '/ 
      DATA NSCNAM(21)/'SW-MONTHLY HOURLY               '/ 
      DATA NSCNAM(22)/'ALBEDO-MONTHLY HOURLY           '/ 
      DATA NSCNAM(23)/'NONSCANNER GEOGRAPHIC SCENE TYPE'/ 
      DATA NSCNAM(24)/'NDLW-DAILY                      '/ 
      DATA NSCNAM(25)/'NDSW-DAILY                      '/ 
      DATA NSCNAM(26)/'NHLW-MONTHLY HOURLY             '/ 
      DATA NSCNAM(27)/'NHSW-MONTHLY HOURLY             '/ 
      DATA NSCNAM(28)/'DEAD SCANNER FLAGS             '/
      DATA NSCNAM(29)/'SPARES                       '/
      DATA NSCBEG /1,2,3,4,5,6,37,61,62,63,64,65,66,67,68,69, 
     1             70,101,132,163,187,211,235,241,272,303,327,351,354/
      DATA NSCEND /1,2,3,4,5,36,60,61,62,63,64,65,66,67,68,69,
     1             100,131,162,186,210,234,235,271,302,326,350,353,360/ 
      DATA ISCBEG /1,2,3,4,5,6,7,8,9,10,41,65,89,91,92,93,94,95,
     1             96,97,98,99,100,101,102,103,104,105,106, 
     2             137,168,199,230,261,292,316,340,364,388, 
     3             412,436,467,498,529,560,584,608,632,656 /
      DATA ISCEND /1,2,3,4,5,6,7,8,9,40,64,88,90,91,92,93,94,95,
     1             96,97,98,99,100,101,102,103,104,105,136,167, 
     2             198,229,260,291,315,339,363,387,411,435,466,   
     3             497,528,559,583,607,631,655,656  / 
      DATA IOS4, NPKS4, NFILE,IDB /8, 9,10,15/
      DATA DFALT /2147483647.0, 32767.0, 127.0/ 
C 
      END 
C 
C
      SUBROUTINE SCNINIT
C 
C    THE PURPOSE OF THIS SUBROUTINE IS TO INITIALIZE ALL ARRAYS 
C    AND VARIABLES TO BE USED TO DUMP A SCANNER DATA RECORD 
C 
C    COMMON BLOCKS:  /S4IO/, /UNPDAT/, /DATLOC/, /DATRAY/, /RECLOC/,
C                    /FILLOC/, /NMPARAM/
C 
C    KEY LOCAL VARIABLES: 
C 
C                   ISCFLNO - ARRAY CONTAINING WHICH SCANNER FILE TO DUMP 
C                   ISCRAY  - ARRAY CONTAINING SCANNER DATA ITEMS TO DUMP 
C                   ISCRAYC - ARRAY CONTAINING SCANNER CLEAR SKY DATA 
C                             ITEMS TO DUMP 
C 
      LOGICAL IERR, DOREP, DOFILE 
C 
      COMMON /S4IO/ IOS4, NFILE,  NPKS4, IERR, DOREP, DOFILE, IDB 
      COMMON /UNPDAT/IBITNO(3),ISTPOS(3,2),LSTPOS(3,2),NUMBTYP
      COMMON /DATLOC/ NSCBEG(29),NSCEND(29),ISCBEG(49),ISCEND(49),
     2                ISCMAX(7), INSMAX(16), ISCNDX(49), NSINDX(29),
     3                ISCITM, INSITM
      COMMON /DATRAY/ ISCPCK(1290),ISCFAC(675),INSPCK(720),INSFAC(360), 
     1                ISCDAT(675),RSCDAT(675),INSDAT(360),RNSDAT(360) 
      COMMON /RECLOC/ ISCREC(7),  LSCREC(7),
     1                INSREC(16), LNSREC(16)
      COMMON /FILLOC/ ISCFIL(7),  INSFIL(16)
      COMMON /NMPARAM/ INST, IRES, IMF, ICOVRG, IRECF,
     2                 IRECL, IRAY(4), IDATA(9) 
C 
      DIMENSION ISCFLNO(3,3), ISCRAY(4,9), ISCRAYC(4,9) 
C 
      DATA ISCFLNO /1, 4, 7,
     2              2, 5, 7,
     3              3, 6, 7 / 
      DATA ISCRAY / 17, 23, 29, 35, 
     2              18, 24, 30, 36, 
     3               3,  6,  0,  0, 
     4               2,  7, 10, 11, 
     5              19, 25, 31, 37, 
     6               0,  0, 42,  0, 
     7               0,  0, 41,  0, 
     8               0,  0,  0, 46, 
     9               0,  0,  0, 45  / 
      DATA ISCRAYC / 20, 26, 32, 38,
     2               21, 27, 33, 39,
     3                4,  8,  0,  0,
     4                5,  9, 10, 12,
     5               22, 28, 34, 40,
     6                0,  0, 44,  0,
     7                0,  0, 43,  0,
     8                0,  0,  0, 48,
     9                0,  0,  0, 47  /
C
CCCCCCCCCCCCCCCCC   BEGIN  SCNINIT  CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 
C 
      ISUB = ISCFLNO (ICOVRG,IRES)
      ISCFIL(ISUB) = 1
      ISCNDX(1) = 1 
      ISCNDX(2) = 14
      ISCNDX(3) = 49
C 
      K=3 
C 
      IF ((IMF.EQ.1).OR.(IMF.EQ.3)) THEN
        DO 100 I=1,4 
          IF (IRAY(I).EQ.1) THEN
            DO 200 J=1,9
              IF (IDATA(J).EQ.1) THEN
                IF (ISCRAY(I,J).NE.0) THEN 
                  K = K+1
                 ISCNDX (K) = ISCRAY (I,J)
               ENDIF
             ENDIF
  200      CONTINUE
          ENDIF 
  100    CONTINUE 
      ENDIF 
C 
      IF ((IMF.EQ.2).OR.(IMF.EQ.3)) THEN
        DO 300 I=1,4
          IF (IRAY(I).EQ.1) THEN
            DO 400 J=1,9 
              IF (IDATA(J).EQ.1) THEN
                IF (ISCRAYC(I,J).NE.0) THEN
                  K = K+1
                  ISCNDX(K) = ISCRAYC(I,J) 
                ENDIF
              ENDIF
  400       CONTINUE 
          ENDIF 
  300   CONTINUE
      ENDIF 
C 
      ISCITM = K      
      ISCREC (ISUB) = IRECF 
      LSCREC (ISUB) = IRECL 
C
      RETURN
      END 
C 
C
      SUBROUTINE NSCINIT
C 
C    THE PURPOSE OF THIS SUBROUTINE IS TO INITIALIZE THE ARRAYS AND 
C    VARIABLES USED TO DUMP NONSCANNER DATA 
C 
C    COMMON BLOCKS:  /DATLOC/, /S4IO/, /UNPDAT/, /DATRAY/, /RECLOC/,
C                    /FILLOC/, /NMPARAM/
C 
C    KEY LOCAL VARIABLES: 
C 
C                   INSRAY - ARRAY CONTAINING NONSCANNER DATA ITEMS TO
C                            BE DUMPED
C                   INFFLIM- ARRAY CONTAINING FILE NUMBERS FOR NUMERICAL
C                            FILTER MFOV
C                   INFFLIW- ARRAY CONTAINING FILE NUMBERS FOR NUMERICAL
C                            FILTER WFOV
C                   ISFFIL - ARRAY CONTAINING FILE NUMBERS FOR SHAPE FACTOR 
C 
      LOGICAL IERR,DOREP, DOFILE
      COMMON /S4IO/ IOS4, NFILE,  NPKS4, IERR, DOREP, DOFILE, IDB 
      COMMON /UNPDAT/IBITNO(3),ISTPOS(3,2),LSTPOS(3,2),NUMBTYP
      COMMON /DATLOC/ NSCBEG(29),NSCEND(29),ISCBEG(49),ISCEND(49),
     2                ISCMAX(7), INSMAX(16), ISCNDX(49), NSINDX(29),
     3                ISCITM, INSITM
      COMMON /DATRAY/ ISCPCK(1290),ISCFAC(675),INSPCK(720),INSFAC(360), 
     1                ISCDAT(675),RSCDAT(675),INSDAT(360),RNSDAT(360) 
      COMMON /RECLOC/ ISCREC(7),  LSCREC(7),
     1                INSREC(16), LNSREC(16)
      COMMON /FILLOC/ ISCFIL(7),  INSFIL(16)
      COMMON /NMPARAM/ INST, IRES, IMF, ICOVRG, IRECF,
     2                 IRECL, IRAY(4), IDATA(9) 
C 
      DIMENSION INSRAY(4,9) 
      DIMENSION INFFILM(3,2), INFFILW(3,2), ISFFIL(3,2) 
      DATA INFFILM / 1, 3, 5, 
     2               2, 4, 5  / 
      DATA INFFILW / 6, 8, 10,
     2               7, 9, 10   / 
      DATA ISFFIL  / 11, 12, 13,
     2               14, 15, 16  /
      DATA INSRAY / 11, 14, 17, 20, 
     2              12, 15, 18, 21, 
     3               3,  4,  0,  0, 
     4               2,  5,  6,  7, 
     5              13, 16, 19, 22, 
     6               0,  0, 25,  0, 
     7               0,  0, 24,  0, 
     8               0,  0,  0, 27, 
     9               0,  0,  0, 26  / 
C 
CCCCCCCCCCCCCCCCC   BEGIN  NSCINIT  CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 
C 
      IF ((IMF.EQ.1).AND.(IRES.NE.3)) THEN
        ISUB = INFFILM(ICOVRG,IRES) 
      ELSE
     2  IF ((IMF.EQ.2).AND.(IRES.NE.3)) THEN
          ISUB = INFFILW(ICOVRG,IRES) 
      ELSE
     2  IF (IRES.EQ.3) THEN 
          ISUB = ISFFIL(ICOVRG,IMF) 
      ENDIF 
C 
      INSFIL(ISUB) = 1
      NSINDX(1) = 1 
      NSINDX(2) = 8 
      NSINDX(3) = 23
      NSINDX(4) = 28
      K=4 
      DO 100 I=1,4 
        IF (IRAY(I).EQ.1) THEN 
          DO 200 J=1,9
            IF (IDATA(J).EQ.1) THEN
              IF (INSRAY(I,J).NE.0) THEN 
                K = K+1
                NSINDX (K) = INSRAY (I,J)
              ENDIF
            ENDIF
  200     CONTINUE
        ENDIF 
  100 CONTINUE 
C 
      INSITM = K
      INSREC (ISUB) = IRECF 
      LNSREC (ISUB) = IRECL 
C 
      RETURN
      END 
C 
C 
      SUBROUTINE SCNSCL (isccal)
C 
C 
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C 
C   PURPOSE:  TO UNPACK AND PRINT OUT THE SCANNER SCALE FACTORS 
C             AND MAKE THEM READY FOR USE WITH THE SCANNER DATA.
C 
C   COMMON BLOCKS:  /DATRAY/, S4IO/, /FILVAL/, /UNPDAT/ 
C 
C 
CCCCC  LOGICAL STATEMENTS 
C 
      LOGICAL IERR, DOREP,DOFILE
      DIMENSION LOC(4), NUM(4)      
      COMMON /DATRAY/ ISCPCK(1290),ISCFAC(675),INSPCK(720),INSFAC(360), 
     1                ISCDAT(675),RSCDAT(675),INSDAT(360),RNSDAT(360) 
      COMMON /S4IO/ IOS4, NFILE, NPKS4, IERR,  DOREP, DOFILE, IDB 
      COMMON /FILVAL/ DFALT(3)
      COMMON /UNPDAT/IBITNO(3),ISTPOS(3,2),LSTPOS(3,2),NUMBTYP
      dimension itemp(1050), itemp2(240)
C 
      IOPT = 0
      LOC(1) = 1
      LOC(2) = 91 
      LOC(3) = 436
      LOC(4) = 0
      NUM(1) = 90 
      NUM(2) = 345
      NUM(3) = 240
      NUM(4) = 0 
      call cread(isccal,1050,itemp,ios)
      if (ios.ne.1050) go to 333
      call cread(isccal,240,itemp2,ios) 
      if (ios.ne.240) go to 333
      do 10 i = 1,263
        iscpck(i) = itemp (i)
10    continue
      k = 0
      do 20 j = 264,323
        k = k + 1
        iscpck (j) = itemp2 (k)
20    continue
      CALL STUFF(DFALT(2),IOPT,ISCPCK,LOC,NUM,ISCFAC,NTOT) 
C 
CCCCC  WRITE OUT SCALE FACTORS
C 
      WRITE (NPKS4,555) 
  555 FORMAT (' ',5X,'  SCANNER SCALE FACTORS',/)
      WRITE (NPKS4,*) ISCFAC
      GOTO 999
C 
CCCCC  ERROR MESSAGES 
C 
  222 WRITE (NPKS4,225) IOS 
  225 FORMAT (1X,' ATTEMPTED TO READ SCANNER SCALE FACTORS--IOS = ',I4)
      IERR = .TRUE. 
      GOTO 999
C 
  333 WRITE (NPKS4,335) IOS 
  335 FORMAT (1X,' HIT END OF FILE ON SCANNER ', 
     1               'SCALE FACTOR READ--IOS=',I4)
      IERR = .TRUE. 
C 
  999 RETURN
      END 
C 
      SUBROUTINE NSCSCL (inscal)
C 
C 
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C 
C   PURPOSE:  TO UNPACK AND PRINT OUT THE NONSCANNER SCALE FACTORS
C             AND MAKE THEM READY FOR USE WITH THE NONSCANNER DATA. 
C 
C   COMMON BLOCKS:   /DATRAY/, /S4IO/, /UNPDAT/, /FILVAL/ 
C 
C 
CCCCC  LOGICAL STATEMENTS 
C 
      LOGICAL IERR, DOREP,  DOFILE
      DIMENSION LOC(4), NUM(4)
      COMMON /DATRAY/ ISCPCK(1290),ISCFAC(675),INSPCK(720),INSFAC(360), 
     1                ISCDAT(675),RSCDAT(675),INSDAT(360),RNSDAT(360) 
      COMMON /S4IO/ IOS4, NFILE, NPKS4, IERR, DOREP, DOFILE, IDB
      COMMON /UNPDAT/IBITNO(3),ISTPOS(3,2),LSTPOS(3,2),NUMBTYP
      COMMON /FILVAL/ DFALT(3) 
C 
CCCCC  BEGIN NSCSCL PROCESSING
C 
      IOPT = 0
      LOC(1) = 1
      LOC(2) =61
      LOC(3) =241
      LOC(4) = 0
      NUM(1) = 60 
      NUM(2) =180 
      NUM(3) =120 
      NUM(4) = 0
      call cread(inscal,720,inspck,ios)
      if (ios.ne.720) go to 333
C 
CCCCC  UNPACK THE SCALE FACTOR RECORD 
C 
      CALL STUFF(DFALT(2),IOPT,INSPCK,LOC,NUM,INSFAC,NTOT)  
C 
CCCCC  WRITE OUT SCALE FACTORS
C 
      WRITE (NPKS4,550) 
  550 FORMAT ('0') 
      WRITE (NPKS4,555) 
  555 FORMAT (' ',5X,'  NONSCANNER SCALE FACTORS ',/)
      WRITE (NPKS4,*) INSFAC
      GOTO 999
C 
CCCCC  ERROR MESSAGES 
C 
  222 WRITE (NPKS4,225) IOS 
  225 FORMAT (1X,' ATTEMPTED TO READ NONSCANNER ', 
     1            'SCALE FACTORS--IOS = ',I4) 
      IERR = .TRUE. 
      GOTO 999
C 
  333 WRITE (NPKS4,335) IOS 
  335 FORMAT (1X,' HIT END OF FILE ON NONSCANNER ',
     1            'SCALE FACTOR READ--IOS=',I4) 
      IERR = .TRUE. 
C 
  999 RETURN
      END 
C 
C 
      SUBROUTINE SCNFIL (IFILE ) 
C 
C 
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C 
C   PURPOSE:  TO PROCESS THE DESIRED RECORDS OF ANY GIVEN 
C             SCANNER FILE. 
C 
C   INPUT PARAMETERS:   IFILE - FILE NUMBER TO BE DUMPED
C 
C   COMMON BLOCKS: /DATLOC/, /DATRAY/, /DESCRP/, /RECLOC/, /S4IO/ 
C 
      CHARACTER SCNNAM*37, NSCNAM*32, UNXFILE*6, nxfiles(7)*6
      LOGICAL IERR, IEOF, DOREP,  DOFILE
      COMMON /DATLOC/ NSCBEG(29), NSCEND(29), ISCBEG(49), ISCEND(49), 
     2                ISCMAX(7), INSMAX(16), ISCNDX(49), NSINDX(29),
     3                ISCITM,     INSITM
      COMMON /DATRAY/ ISCPCK(1290),ISCFAC(675),INSPCK(720),INSFAC(360), 
     2                ISCDAT(675),RSCDAT(675),INSDAT(360),RNSDAT(360) 
      COMMON /DESCRP/ SCNNAM(49), NSCNAM(29)
      COMMON /RECLOC/ ISCREC(7),  LSCREC(7),
     2                INSREC(16), LNSREC(16)
      COMMON /S4IO/  IOS4,NFILE, NPKS4, IERR, DOREP, DOFILE,IDB 
c +++
c daac conversion - insert 7 filenames for scanner files
c +++
      data nxfiles/'file4','file5','file6','file7','file8',
     1             'file9','file10'/       
C 
CCCCC  BEGIN SCANNER FILE PROCESSING
C 
      IEOF = .FALSE.
      unxfile=nxfiles(ifile)
      indx = 5
      if (ifile .eq. 7) indx = 6
      call copen(unxfile,indx,isscl)
      WRITE (NPKS4,1000) IFILE
C 
CCCCC  DETERMINE RANGE OF RECORDS TO BE LOOKED AT 
C 
      IFREC = ISCREC (IFILE)
      ILREC = LSCREC (IFILE)
C 
      DO 100 ICNT = IFREC,ILREC 
  103   CALL SCNREC (IEOF, isscl) 
        IF (IERR) GOTO 999 
        IF (IEOF) GOTO 900 
        IF (ILREC.LT.RSCDAT(91)) GOTO 850 
        IF (RSCDAT(91).LT.IFREC) GOTO 103 
        IF((RSCDAT(91).GE.IFREC).AND.(RSCDAT(91).LE.ILREC)) THEN
          IF (DOREP) THEN 
C            WRITE (NPKS4,1100) ICNT
            WRITE (NPKS4,1100)
            DO 150 INDX = 1,ISCITM
              ITEM = ISCNDX(INDX) 
              WRITE (NPKS4,1200) SCNNAM(ITEM) 
              JBEG = ISCBEG(ITEM) 
              JEND = ISCEND(ITEM) 
              WRITE (NPKS4,*) (RSCDAT(I),I=JBEG,JEND) 
              WRITE (NPKS4,*) 
              WRITE (IDB,*) (RSCDAT(I),I=JBEG,JEND) 
  150       CONTINUE
          ENDIF 
        ENDIF 
  100 CONTINUE
C 
      GOTO 999
C 
  333 IERR = .TRUE. 
      WRITE (NPKS4,1300) IFILE, IOS 
      GOTO 999
C 
 850  WRITE (NPKS4,1350) 
     
  900 IEOF = .FALSE.
      WRITE (NPKS4,1400) IFILE
      CLOSE (IOS4,IOSTAT=IOS,ERR=955) 
      GOTO 999
C 
  955 IERR = .TRUE. 
      WRITE (NPKS4,1500) IFILE
C 
999   RETURN
C 
CCCCC  FORMAT STATEMENTS
C 
 1000 FORMAT ('1',10X,'SCANNER FILE ',I1,//) 
 1100 FORMAT (' ',15X,'START OF A NEW RECORD ',/) 
 1200 FORMAT (' ',5X,A37)
 1300 FORMAT (' ',5X,'OPEN FILE ERROR ON SCANNER FILE ',I1,/,
     1            5X,'                         IOS = ',I6,/) 
 1350 FORMAT(' ',5X,'**** REGION READ IS PAST REGION DESIRED ****',/)
 1400 FORMAT (' ',5X,'HAVE REACHED EOF ON SCANNER FILE ',I1,/) 
 1500 FORMAT (' ',5X,'CLOSE ERROR ON SCANNER FILE ',I1,/)
C 
      END 
C 
C 
      SUBROUTINE NSCFIL (IFILE ) 
C 
C 
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C 
C   PURPOSE:  TO PROCESS THE DESIRED RECORDS OF ANY GIVEN 
C             NONSCANNER FILE.
C 
C   INPUT PARAMETERS:  IFILE - FILE NUMBER TO DUMP
C 
C   COMMON BLOCKS:  /DATLOC/, /DATRAY/, /DESCRP/, /RECLOC/, /S4IO/
C 
      CHARACTER SCNNAM*37, NSCNAM*32, UNXFILE*6, nxfiles(16)*6
      LOGICAL IERR, IEOF, DOREP, DOFILE 
      COMMON /DATLOC/ NSCBEG(29), NSCEND(29), ISCBEG(49), ISCEND(49), 
     2                ISCMAX(7), INSMAX(16), ISCNDX(49), NSINDX(29),
     3                ISCITM,     INSITM
      COMMON /DATRAY/ ISCPCK(1290),ISCFAC(675),INSPCK(720),INSFAC(360), 
     2                ISCDAT(675),RSCDAT(675),INSDAT(360),RNSDAT(360) 
      COMMON /DESCRP/ SCNNAM(49), NSCNAM(29)
      COMMON /RECLOC/ ISCREC(7),  LSCREC(7),
     2                INSREC(16), LNSREC(16)
      COMMON /S4IO/ IOS4, NFILE, NPKS4, IERR,  DOREP, DOFILE, IDB 
c +++
c daac conversion - insert 7 filenames for scanner files
c +++
      data nxfiles/'file11','file12','file13','file14','file15',
     1             'file16','file17','file18','file19','file20',
     2             'file21','file22','file23','file24','file25',
     3             'file26'/
C 
CCCCC  BEGIN NONSCANNER FILE PROCESSING 
C 
           
      IEOF = .FALSE.
      unxfile = nxfiles(ifile)       
      call copen(unxfile,6,inscl)        
c     NFILE = IFILE + 7 
      NFILE = IFILE + 10 
      WRITE (NPKS4,1000) IFILE, NFILE 
C 
CCCCC  DETERMINE RANGE OF RECORDS TO BE LOOKED AT 
C 
      IFREC = INSREC (ifile)
      ILREC = LNSREC (ifile)

C 
      DO 100 ICNT = IFREC,ILREC 
  103   CALL NSCREC (IEOF,inscl)
        IF (IERR) GOTO 999
        IF (IEOF) GOTO 900
        IF (ILREC.LT.RNSDAT(61)) GOTO 850
        IF (RNSDAT(61).LT.IFREC) GOTO 103
        IF((RNSDAT(61).GE.IFREC).AND.(RNSDAT(61).LE.ILREC)) THEN
          WRITE(NPKS4,105) RNSDAT(62),RNSDAT(63) 
 105      FORMAT ('DATA DATE= ',F5.0,'SATELLITE= ',F2.0) 
          DO 150 INDX = 1,INSITM
            ITEM = NSINDX(INDX) 
            WRITE (NPKS4,1200) NSCNAM(ITEM) 
            JBEG = NSCBEG(ITEM) 
            JEND = NSCEND(ITEM) 
            WRITE (NPKS4,*) (RNSDAT(I),I=JBEG,JEND) 
            WRITE (NPKS4,*) 
            WRITE (IDB,*) (RNSDAT(I),I=JBEG,JEND) 
  150     CONTINUE
        ENDIF 
  100 CONTINUE
C 
      GOTO 999
C 
  333 IERR = .TRUE. 
      WRITE (NPKS4,1300) IFILE, IOS 
      GOTO 999
C 
  850  WRITE(NPKS4,1350) 
       call cread(inscl,720,inspck,ios)
       if(ios.ne.720) go to 333
C
  900 IEOF = .FALSE.
      WRITE (NPKS4,1400) IFILE
      GOTO 999
C 
  955 IERR = .TRUE. 
      WRITE (NPKS4,1500) IFILE
C 
  999 RETURN
C 
CCCCC  FORMAT STATEMENTS
C 
 1000 FORMAT ('1',10X,'NONSCANNER FILE ',I2,'; TAPE FILE ',I2,/) 
 1100 FORMAT (' ',15X,'RECORD NUMBER ',I5) 
 1200 FORMAT (' ',20X,A37,/) 
 1300 FORMAT (' ',5X,'OPEN FILE ERROR ON NONSCANNER FILE ',I1,/, 
     1             5X,'                            IOS = ',I6,/)
 1350 FORMAT (' ',5X,'*** REGION READ IS PAST DESIRED REGION ***',/)
 1400 FORMAT (' ',5X,'HAVE REACHED EOF ON NONSCANNER FILE ',I1,/)
 1500 FORMAT (' ',5X,'CLOSE ERROR ON NONSCANNER FILE ',I1,/) 
C 
      END 
C 
C 
      SUBROUTINE SCNREC (IEOF, isscl)
C 
C 
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C 
C  PURPOSE:  TO UNPACK A SCANNER DATA RECORD AND SCALE THE VALUES.
C 
C  COMMON BLOCKS:  /S4IO/, /FILVAL/, /UNPDAT/, /DATRAY/ 
C 
      LOGICAL IERR, IEOF, DOREP, DOFILE 
      DIMENSION LOC(4), NUM(4)
      COMMON /S4IO/ IOS4, NFILE, NPKS4, IERR, DOREP, DOFILE, IDB
      COMMON /FILVAL/ DFALT(3)
      COMMON /UNPDAT/ IBITNO(3), ISTPOS(3,2),LSTPOS(3,2),NUMBTYP
      COMMON /DATRAY/ ISCPCK(1290),ISCFAC(675),INSPCK(720),INSFAC(360), 
     1                ISCDAT(675),RSCDAT(675),INSDAT(360),RNSDAT(360) 
      dimension itemp (1050), itemp2 (240)
C 
CCCCC  BEGIN SCNREC PROCESSING
C 
      IOPT = 0
      LOC(1) = 1
      LOC(2) = 91 
      LOC(3) = 436
      LOC(4) = 0
      NUM(1) = 90 
      NUM(2) = 345
      NUM(3) = 240
      NUM(4) = 0
      IEOF = .FALSE.
c
      call cread (isscl, 1050, itemp,ios)
      if (ios.ne.1050) go to 333
      call cread (isscl, 240, itemp2, ios)
      if (ios.ne.240) go to 333
      do 10 i = 1,263
        iscpck(i) = itemp (i)
10    continue
      k = 0
      do 20 j = 264,323
        k = k + 1
        iscpck (j) = itemp2 (k)
20    continue
      CALL STUFF (DFALT(2),IOPT,ISCPCK,LOC,NUM,ISCDAT,NTOT) 
      DO 200 I=1,675
        RSCDAT(I) = FLOAT(ISCDAT(I))
 200  CONTINUE
C
CCCCC  CALCULATE SCALED VALUES
C 
      DO 230 I=1,NUMBTYP
        IFST = ISTPOS(I,1)
        ILST = LSTPOS(I,1)
        DO 250 J=IFST,ILST
          IF (RSCDAT(J).NE.DFALT(I))
     1    RSCDAT(J) = RSCDAT(J) / FLOAT(ISCFAC(J)) 
  250   CONTINUE
  230 CONTINUE
C 
      IF (DOFILE) THEN
        WRITE (NFILE,1100)
        WRITE (NFILE,1100)
 1100   FORMAT (5X) 
        WRITE (NFILE,*) RSCDAT
      ENDIF 
C 
      GOTO 999
C 
CCCCC  ERROR MESSAGES 
C 
  222 WRITE (NPKS4,225) IOS 
  225  FORMAT (1X,' ATTEMPTED TO READ DATA RECORD--IOS = ',I4)
      IERR = .TRUE. 
      GOTO 999
C 
  333 WRITE (NPKS4,335) IOS 
  335  FORMAT (1X,' HIT END OF FILE ON DATA RECORD READ-IOS=',I4) 
      IEOF = .TRUE. 
C 
  999 RETURN
      END 
C
C 
      SUBROUTINE NSCREC (IEOF,inscl)
C 
C 
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C 
C  PURPOSE:  TO UNPACK A NONSCANNER DATA RECORD AND SCALE THE VALUES. 
C            THE FOURTH RECORD ON THE SECOND FILE ON THE RAT. 
C 
C    COMMON BLOCKS:  /S4IO/, /FILVAL/, /UNPDAT/, /DATRAY/ 
C 
C 
      LOGICAL IERR, IEOF, DOREP, DOFILE 
      DIMENSION LOC(4), NUM(4)
      COMMON /S4IO/ IOS4, NFILE, NPKS4, IERR, DOREP, DOFILE, IDB
      COMMON /FILVAL/ DFALT(3)
      COMMON /UNPDAT/ IBITNO(3),ISTPOS(3,2),LSTPOS(3,2),NUMBTYP 
      COMMON /DATRAY/ISCPCK(1290),ISCFAC(675),INSPCK(720),INSFAC(360),
     1               ISCDAT(675),RSCDAT(675),INSDAT(360),RNSDAT(360)
C
CCCCC  BEGIN NSCREC PROCESSING
C 
      IOPT = 0
      LOC(1) = 1
      LOC(2) = 61 
      LOC(3) = 241
      LOC(4) = 0
      NUM(1) = 60 
      NUM(2) = 180
      NUM(3) = 120
      NUM(4) = 0
      IEFLAG = 0
      IEOF = .FALSE.
130   call cread(inscl,720,inspck,ios)
      if (ios.ne.720) then
        go to 333
      endif
      CALL STUFF(DFALT(2),IOPT,INSPCK,LOC,NUM,INSDAT,NTOT)
C
       DO 200 I=1,360
        RNSDAT(I) = FLOAT(INSDAT(I))
  200 CONTINUE
C 
CCCCC  CALCULATE SCALED VALUES
C 
      DO 230 I=1,NUMBTYP
        IFST = ISTPOS(I,2)
        ILST = LSTPOS(I,2)
        DO 250 J=IFST,ILST
           IF (RNSDAT(J).NE.DFALT(I))
     1       RNSDAT(J) = RNSDAT(J) / FLOAT(INSFAC(J))
  250   CONTINUE
  230 CONTINUE
      IF (DOFILE) THEN
        WRITE (NFILE,1100)
        WRITE (NFILE,1100)
 1100   FORMAT (5X) 
        WRITE (NFILE,*) RNSDAT
      ENDIF 
C
      GOTO 999
C 
CCCCC  ERROR MESSAGES 
C 
  222 WRITE (NPKS4,225) IOS 
  225 FORMAT (1X,' ATTEMPTED TO READ DATA RECORD--IOS = ',I4)
      IERR = .TRUE. 
      GOTO 999
C 
  333 IF (IEFLAG.EQ.0) THEN 
        IEFLAG = 1
        IEOF = .FALSE.
        GOTO 130
      ELSE
        WRITE (NPKS4,335) IOS 
  335   FORMAT (1X,' HIT END OF FILE ON DATA RECORD READ-IOS=',I4) 
        IEOF = .TRUE. 
      ENDIF 
C 
  999 RETURN
      END 
C
C
        SUBROUTINE STUFF
     I               (DFAULT,IOPT,IDATA,LOC,NUM,
     O                LDATA,NTOT) 
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C 
C   NAME - STUFF                            MODULE -G.E.8.6.16
C   LANGUAGE - FTN V                        TYPE - SUBROUTINE 
C   VERSION - 3.0        DATE - 03/14/83    PROGRAMMER - ED HOWERTON
C 
C   PURPOSE - TO PACK OR UNPACK AN INTEGER ARRAY INTO AN OUTPUT INTEGER 
C             ARRAY ACCORDING TO USER-SPECIFIED WORD SIZES (ANY COMBO 
C             OF 32-, 16-, 8-, AND/OR 4-BIT WORDS) AND CONVERT BETWEEN
C             SUBSYSTEM-DEFINED DEFAULT VALUES AND WORD-SIZE-DEPENDENT
C             (2**(N-1)-1, WHERE N=NUMBER OF BITS PER WORD) DEFAULTS. 
C 
C   INPUT PARAMETERS -
C     DFAULT   SUBSYSTEM-DEFINED DEFAULT VALUE (REAL).
C 
C              PACKING OPERATION           + UNPACKING OPERATION
C              -----------------           + -------------------
C     IOPT     =1                          + =0 
C                                          +
C     IDATA    ARRAY OF DATA VALUES TO BE  + ARRAY OF INTEGERS TO BE
C                PACKED(INTEGER).          +   UNPACKED.
C                                          +
C     LOC      4-ELEMENT INTEGER ARRAY     + 4-ELEMENT INTEGER ARRAY
C                CONTAINING THE START LO-  +   CONTAINING THE START LO- 
C                CATIONS IN IDATA OF       +   CATIONS IN LDATA WHERE 
C                VALUES TO BE PACKED AT    +   THE UNPACKED WORDS OF THE
C                THE FOLLOWING RATES:      +   FOLLOWING SIZES WILL BE
C                                          +   STORED:  
C                LOC(1)  32 BITS/WORD.     +   LOC(1)  32-BIT WORDS.
C                LOC(2)  16 BITS/WORD.     +   LOC(2)  16-BIT WORDS.
C                LOC(3)   8 BITS/WORD.     +   LOC(3)   8-BIT WORDS.
C                LOC(4)   4 BITS/WORD.     +   LOC(4)   4-BIT WORDS.
C                                          +
C     NUM      4-ELEMENT INTEGER ARRAY     + 4-ELEMENT INTEGER ARRAY
C                CONTAINING THE NO. OF     +   CONTAINING THE NO. OF
C                VALUES IN IDATA TO BE     +   WORDS OF THE FOLLOWING 
C                PACKED AT THE FOLLOWING   +   SIZES TO BE UNPACKED:  
C                RATES:                    +
C                NUM(1)  32 BITS/WORD.     +   NUM(1)  32-BIT WORDS.
C                NUM(2)  16 BITS/WORD.     +   NUM(2)  16-BIT WORDS.
C                NUM(3)   8 BITS/WORD.     +   NUM(3)   8-BIT WORDS.
C                NUM(4)   4 BITS/WORD.     +   NUM(4)   4-BIT WORDS.
C 
C                NOTE: IF A WORD-SIZE IS NOT USED, SET THE APPROPRIATE
C                      ELEMENT IN NUM=0.
C 
C   OUTPUT PARAMETERS - 
C     LDATA    INTEGER ARRAY CONTAINING THE OUTPUT FROM THE PACKING OR
C                UNPACKING OPERATION. 
C     NTOT     NUMBER OF 60-BIT WORDS IN LDATA USED IN THE PACKING OR 
C                UNPACKING OPERATION (WILL BE NEGATIVE IF AN INTERNAL 
C                CONSISTENCY CHECK WITH SPREAD/SESPRD FAILS). 
C 
C   KEY LOCAL PARAMETERS -
C     ISTRT    POINTER INDICATING WHERE IN THE PACKED ARRAY TO EITHER 
C                START INSERTING (PACKING) OR EXTRACTING (UNPACKING)
C                DATA.
C     IRETCK   TOTALS THE NO.OF 60-BIT WORDS USED BY SPREAD/SESPRD. 
C 
C   SUBROUTINES CALLED -
C     ERBE SUBROUTINE     - ONETWO  (G.E.8.6.11)
C     ERBE SUBROUTINE     - SPREAD  (G.E.8.6.4) 
C     ERBE SUBROUTINE     - SESPRD  (G.E.8.6.5) 
C 
C   EXIT STATES - 
C     NORMAL RETURN (NTOT MAY BE NEGATIVE, INDICATING AN ERROR).
C 
C   RESTRICTIONS -
C     (1)  ASSUMES THAT CONTIGUOUS LOCATIONS OF LDATA WILL BE PACKED OR 
C             THAT CONTIGUOUS LOCATIONS OF IDATA WILL BE UNPACKED.
C     (2)  ON A PACKING OPERATION, THE USER MUST BE SURE THAT VALUES
C             IN THE INPUT ARRAY IDATA DO NOT OVERFLOW THE INTENDED 
C             WORD SIZE.  I.E.,(EXCEPT FOR DEFAULTS) THE RANGES 
C             (OVERFLOW/UNDERFLOW) ARE AS FOLLOWS (SIGNED INTEGERS):  
C                32-BIT  <  IABS( 2147483648 )
C                16-BIT  <  IABS(      32768 )
C                 8-BIT  <  IABS(        128 )
C                 4-BIT  <  IABS(          8 )
C 
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C 
C*****
      PARAMETER ( IANAL = 0 ) 
      DIMENSION IDATA(*),LOC(4),NUM(4),LDATA(*) 
C 
C *** INITIALIZE
C 
      IDFALT=NINT(DFAULT) 
      IEXP=6
      ISTRT=1 
      IRETCK=0
      NTOT=0
C 
C *** LOOP THRU FOUR WORD-SIZES 
C 
      DO 100 I=1,4
C 
        NWORDS=0 
        IRET=0 
C 
C     ** CHECK FOR USAGE OF THIS WORD-SIZE -- IF SO, CONTINUE; IF NOT,
C                                             INCREMENT LOOP. 
        IF(NUM(I).GT.0)THEN
C 
C        ** CALCULATE WORD-SIZE (ITWO), AND NUMBER OF 60-BIT WORDS
C           NEEDED FOR THE PACK OR UNPACK (NWORDS). 
C 
          ITWO=2**(IEXP-I)
          NBITS=NUM(I)*ITWO 
          NWORDS=NBITS/32 
          NPAD=NBITS-NWORDS*32
          IF(NPAD.GT.0)THEN 
            NWORDS=NWORDS+1
          ENDIF 
          K=LOC(I)
C 
C        ** CALCULATE WORD-SIZE-DEPENDENT DEFAULT (ITEST).
C 
          ITEST=2**(ITWO-1)-1 
          IF(IOPT.EQ.1)THEN 
            NTOT=NTOT+NWORDS 
C 
C              ** CONVERT DEFAULTS (EXCEPT 4-BIT) 
C 
            IF(I.LT.4)THEN 
              JSTOP=K+NUM(I)-1
              DO 40 J=K,JSTOP 
                IF(IDATA(J).EQ.IDFALT)THEN 
                  IDATA(J)=ITEST
                ENDIF
   40         CONTINUE
            ENDIF
            CALL SPREAD(IDATA(K),LDATA(ISTRT),32,ITWO,NUM(I),IRET) 
          ELSE
            NTOT=NTOT+NUM(I) 
            CALL SESPRD(IDATA(ISTRT),LDATA(K),ITWO,32,NWORDS,IRET) 
            IF(I.LT.4)THEN 
              JSTOP=K+NUM(I)-1
              DO 60 J=K,JSTOP 
                IF(LDATA(J).EQ.ITEST)THEN
                  LDATA(J)=IDFALT 
                ENDIF
   60         CONTINUE
            ENDIF
          ENDIF 
C 
C           ** INCREMENT ISTRT AND IRETCK 
C 
          ISTRT=ISTRT+NWORDS
          IRETCK=IRETCK+IRET
        ENDIF
  100 CONTINUE
C 
C  ** CHECK NO.OF 60-BIT WORDS USED AS RETURNED BY SPREAD/SESPRD VS.
C           NO. CALCULATED BY STUFF.
C 
      IF(NTOT.NE.IRETCK)THEN
        NTOT=-NTOT 
      ENDIF 
C 
      RETURN
      END 
C
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
c         IDENT  SPREAD 
c         ENTRY  SPREAD 
c SPREAD    DATA   0
c 
c NAME - SPREAD                            MODULE - G.E.8.6.4 
c LANGUAGE - COMPASS                      TYPE - SUBROUTINE 
c VERSION - 3.0        DATE - 05/27/82     PROGRAMMER - 
c                                          SAMUEL A. MCPHERSON
c                                          ACD/CMB/COS
c---------------------------------------------------------------------
c Version - ???        Date - 9 Oct 92          Programmer - Scott R. Quier (SAIC)
c---------------------------------------------------------------------
c
c Version -++++        Date - 10/05/92     Programmer - Scott R. Quier, SAIC
c 
Cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c PURPOSE:     THIS FORTRAN (FTN) CALLABLE SUBROUTINE WAS 
c              WRITTEN FOR NASA, LANGLEY RESEARCH CENTER
c              HAMPTON, VIRGINIA
c COMMENTS: 
c        THIS ROUTINE WILL TAKE DATA FROM THE INPUT ARRAY(B1) AND 
c        RE-FORMAT THE DATA INTO THE OUT ARRAY (B2).
c 
c        B1 = FWA OF INPUT ARRAY
c        B2 = FWA OF OUT ARRAY
c        B3= NUMBER OF BITS/ITEM IN INPUT ARRAY 
c        B4 = NUMBER OF BITS/ITEM IN OUT ARRAY
c        B5 = NUMBER OF WORDS IN INPUT ARRAY (B1) 
c        B6 = NUMBER OF WORDS PLACED IN OUTPUT ARRAY(B2)
c 
c        CALL SPREAD(IN,IOUT,BITSIN,BITSOUT,INWORDS,OUTWORDS) 
c 
c        IF BITSOUT > BITSIN, DATA MOVED INTO THE OUT ARRAY WILL BE 
c        RIGHT JUSTIFIED WITH ZERO FILL TO THE LEFT.
c 
c        ON EACH CALL TO SPREAD, EITHER BITSIN OR BITSOUT MUST BE SET 
c        TO 60. IF BITSOUT IS SET TO 60, A UNPACK OPERATION IS PERFORMED. 
c        IF BITSIN IS SET TO 60, A PACK OPERATION IS PERFORMED. 
c 
c        B6(OUTWORDS)   ON RETURN WILL CONTAIN THE NUMBER OF OUT WORDS
c 
c 
c        B2 MUST BE DIMENSIONED BY (60/B3*NWORDS) 
c 
c         SX7    A0 
c         SA7    SAVEA0 
c         SA3    A1 
c         SB1    X3 
c         SA3    A3+1 
c         SB2    X3 
c         SA3    A3+1 
c         SB3    X3 
c         SA3    A3+1 
c         SB4    X3 
c         SA3    A3+1 
c         SB5    X3 
c         SA3    A3+1 
c         SB6    X3 
c         SA5    B6 
c         SX6    A5 
c         SA6    SAVADD 
c         SA1    B1-1              IN ARRAY - 1 
c         SA2    B2-1              OUT ARRAY - 1
c         SX6    A2 
c         SA6    SAVOUT 
c         SA3    B3 
c         SB3    X3                NUMBER OF BITS IN IN 
c         SA4    B4 
c         SB4    X4                NUMBER OF BITS IN OUT
c         SA5    B5                NUMBER OF WORDS
c         SB5    X5 
c         MX3    1
c         SB1    B3-1 
c         AX3    B1,X3             IN MASK
c         SB2    60 
c         MX7    0
c          GE      B3,B4,PACKIT 
cNEXT      SA1    A1+1 
c         SB5    B5-1 
c         NG     B5,EXIT
c         SB1    60 
cPACK      GE     B2,B4,CONT 
c         SA2    A2+1 
c         SA7    A2 
c         SB2    60 
c         MX7    0                 ZERO OUT WORD
c          LT     B1,B3,CONTX 
cCONT      BX6    X1*X3
c         SB6    B4-B3
c         LX7    B6,X7
c         BX7    X7+X6
c         LX7    B3,X7
c         LX1    B3,X1
c         SB1    B1-B3             REMAINING IN BITS
c         SB2    B2-B4             REMAINING OUT
c         GE     B1,B3,PACK 
c         ZR     B1,NEXT
c         GE     B2,B4,CONTX
c         SA2    A2+1 
c         SA7    A2 
c         SB2    60 
c         MX7    0
cCONTX     MX0    1
c         SB6    B1-1 
c         AX0    B6,X0
c         BX6    X1*X0             PICK UP REMAINING IN WORD
c         LX6    B3,X6
c         SA1    A1+1 
c         SB5    B5-1 
c         NG     B5,EXIT1 
c         SB6    B3-B1
c         MX0    1
c         SB7    B6-1 
c         AX0    B7,X0             PICK UP FIRST OF NEXT WORD 
c         BX5    X1*X0
c         SB1    B3-B1
c         LX5    B1,X5
c         BX6    X5+X6
c         LX7    B4,X7
c         BX7    X7+X6
c         LX1    B6,X1
c         SB1    B6 
c         SB6    60 
c         SB1    B6-B1
c         SB2    B2-B4
c         EQ     PACK 
cPACKIT     MX3    1 
c          SB1    B4-1
c          AX3    B1,X3 
c          LX3    B4               MASK FOR IN
c          SB2    60
cLOOP1      SA1    A1+1
c          SB5    B5-1             DECREMENT # OF IN WORDS
c          NG     B5,ENDIT
c          BX6    X1*X3            MASK OUT DATA
c          SB2    B2-B4            # BITS REMAINING IN OUT
c          NG     B2,LOOP2
c          LX7    B4
c          BX7    X7+X6            ADD MASKED DATA
c          EQ     LOOP1 
cLOOP2      SB2    B2+B4            # BITS IN UPPER PART OF WORD 
c          EQ     B2,B0,STORE1
c          LX7    B2,X7 
c          MX4    1 
c          SB1    B4-B2            # BITS IN LOWER PART OF DATA 
c          SB6    B1-1
c          AX4    B6,X4 
c          LX4    B1
c          BX5    X4*X6            SAVE LOWER PART OF DATA
c          AX6    B1,X6            SHIFT OUT LOWER PART OF DATA 
c          BX7    X7+X6            ADD UPPER PART TO STORE
c          BX6    X5
c          SB7    60
c          SB2    B7-B1 
c          EQ     STORE 
cSTORE1     SB7     60 
c          SB2    B7-B4 
cSTORE      SA2    A2+1
c          SA7    A2
c          BX7    X6
c          EQ     LOOP1 
cENDIT      SB5    60
c          LX7    B2
c          EQ     EXIT
cEXIT1      BX7    X6
cEXIT      SA2    A2+1 
c         SA7    A2 
c         SX1    A2                STORE RETURN NWORDS
c         SA3    SAVOUT 
c         IX6    X1-X3
c         SA5    SAVADD 
c         SA4    X5 
c         SA6    A4 
c         SA5    SAVEA0 
c         SA0    X5 
c         EQ     SPREAD 
cSAVEA0    DATA   0
cSAVADD    DATA   0
cSAVOUT    DATA   0
cABORT     SA2    =3LABT 
c         BX6    X2 
c         SA6    1
c         END 
c-----------------------------------------------------------
c  This routine will take data from the input array (isrc) and
c  call appropriate NCAR routines (gbytes, sbytes) to re-format
c  the data into the output array (idest).
c
c Input Parameters:
c
c  isrc    :  The input bit stream 
c  inbts   :  Length, in bits, of the input data words 
c  iotbts  :  Length, in bits, of the output data words
c  numpck  :  Number of 32-bit words in the input buffer 
c             to be packed/unpacked
c
c Output Parameters:
c  idest   :  The output bit stream 
c  numdon  :  Number of 32-bit words actually stuffed 
c             into the output buffer
c-----------------------------------------------------------
c  Subroutines Called:
c    gbytes : NCAR "C" routine to handle data bit wise manipulation
c             for the data unpacking operation.
c    sbytes : NCAR "C' routine to handle data bit wise manipulation
c             for the data packing operation
c-----------------------------------------------------------
c Exit States:
c  idest   :  Holds the results of the unpack/pack operation
c  numdon  :  The number of 32-bit words packed/unpacked.  On
c             error, this will hold a zero (0) as an error flag.
c-----------------------------------------------------------
c Restrictions:
c 
c  -  For pack operation, we can only handle (2 ** 27) - 1
c     data elements at a time.  
c  -  For pack, numpck must be less than (2 ** 28) - 1.  
c     This is driven by the way in which we calculate the 
c     number of bytes to be processed.
c-----------------------------------------------------------

      subroutine spread
     i                 (isrc, 
     o                  idest,
     i                  inbts, iotbts, numpck,
     o                  numdon)
      integer isrc*4
      dimension isrc(*)
      integer idest*4
      dimension idest(*)
      integer inbts*4
      integer iotbts*4
      integer numpck*4
      integer numdon*4
      integer mxupck
      integer mxpack


c
c  *** For pack operations, we can only handle mxupck data
c  *** elements.  ((2 ** 27) - 1).
c  *** For pack operation, we can only handle mxpack data 
c  *** elements.  ((2 ** 28) - 1).
c  *** These constants are placed here for ease of changing the 
c  *** code if the machine word size ever changes.
c
      mxupck = ((2 ** 27) - 1)
      mxpack = ((2 ** 28) - 1)

c
c ***  We should do all our error checking right here.  It 
c ***  sure will make the reading of the code that much easier
c ***  and shorten the time it takes to determine if there 
c ***  is a problem with the incoming data.
c ***  By the numbers...
c ***  -  Make sure we have something to do
c ***  -  Make sure both word sizes are in bounds
c ***  -  For pack operation, we can only handle (2 ** 27) - 1
c ***     data elements at a time.  For pack, numpck must be
c ***     less than (2 ** 28) - 1.  This is driven by the 
c ***     way in which we calculate the number of bytes
c ***     to be processed.
c ***  -  Ensure we will be doing either an unpack or a pack
c ***     operation.
c
      if(numpck .gt. 0 .and.
     1   inbts  .gt. 0 .and. inbts .lt. 33 .and.
     2   iotbts .gt. 0 .and. iotbts .lt. 33. and.
     3   ((iotbts .eq. 32 .and. numpck .lt. 134217727) .or.
     4   (inbts .eq. 32 .and. numpck .lt. 268435455))) then

c

	 numdon = (numpck * iotbts) / inbts
c
c ***     Determine if we are doing an unpack or a pack.
c
	 if(iotbts .eq. 32) then

c
c ***        We are doing an unpack
c
	    call gbytes(isrc, idest, 0, inbts, 0, numdon)
	 else

c
c ***        There is potential for problem here.  The data
c ***        going into the destination words must be of
c ***        small enough size to fit.  Else, the user will
c ***        be very disappointed.
c

	    call sbytes(idest, isrc, 0, iotbts, 0, numpck)
	 end if
      else
c
c ***     For some reason, we had errors in the input parameters.
c ***     I guess the using application will have to figure out
c ***     what went wrong.
c
	 numdon = 0
      end if
      return
      end
      SUBROUTINE SESPRD 
     1  (IN,IOUT,INBITS,ITBITS,INWRDS,ITWRDS) 
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C 
C   NAME - SESPRD                           MODULE  - G.E.8.6.5 
C   LANGUAGE - FTN V                        TYPE - SUBROUTINE 
C   VERSION - 3.0        DATE - 10/26/82    PROGRAMMER - C. E. HOWERTON 
c-----------------------------------------------------------------------
c   Version - ???        Date - 10/08/92    Programmer - Scott R. Quier (SAIC)
c-----------------------------------------------------------------------
C 
C   PURPOSE -  TAKE BIT STRING DATA FROM THE INPUT ARRAY (IN),
C              DO SIGN EXTEND FOR UNPACK OPERATIONS,
C              AND PLACE IT IN THE OUTPUT ARRAY (IOUT). 
C 
C   INPUT PARAMETERS -
C         IN     := INPUT ARRAY FROM WHICH DATA ARE REMOVED.
C         INBITS := BIT LENGTH OF DATA IN THE INPUT ARRAY.
C                   (ON PACK OPERATION, INBITS = 60)
C         ITBITS := BIT LENGTH OF DATA IN THE OUTPUT ARRAY. 
C                   (ON UNPACK OPERATION, ITBITS = 60)
C         INWRDS := NUMBER OF 60-BIT WORDS IN THE INPUT ARRAY.
C                   DIMENSION OF THE OUTPUT ARRAY MUST BE AT
C                   LEAST ((ITBITS * INWRDS) / INBITS)
C 
C   OUTPUT PARAMETERS - 
C          IOUT   := ARRAY TO WHICH DATA RE MOVED.
C          ITWRDS := NUMBER OF 60-BIT WORDS USED FROM INPUT ARRAY.
C 
C   KEY LOCAL PARAMETERS -
C        LBIT := LOCATION OF SIGN BIT 
C        N    := LOOP CONTROL 
C 
C   ROUTINES CALLED - 
C        SUBROUTINE SPREAD (ERBE G.E.8.6.4) 
C 
C   EXIT STATES - NORMAL RETURN 
C 
C---RESTRICTIONS -  ASSUMES 60-BIT WORDS. 
c                   Really assumes 32-bit words, due to the machine
c                   word size.
C 
C 
C 
C 
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C 
C                      *** BEGIN SESPRD *** 
C 
C*****
      PARAMETER ( IANAL = 0 ) 
      integer shift
C 
C$    IF ( IANAL .EQ. 1 ) THEN
c---     COMMON /UTLCNT/ NCALLS(60) 
C$    ENDIF 
C*****
      DIMENSION IN(*), IOUT(*)
C$    IF ( IANAL .EQ. 1 ) THEN
c---     NCALLS( 35 ) = NCALLS( 35 ) + 1
C$    ENDIF 
C 
C 
C     *** USE SUBROUTINE SPREAD TO DO BIT MANIPULATION
C 
      CALL SPREAD (IN,IOUT,INBITS,ITBITS,INWRDS,ITWRDS) 
C 
C     *** CHECK FOR UNPACK OPERATION
C 
c---  IF (ITBITS .EQ. 60) THEN
      if (itbits .eq. 32) then
C         *** UNPACK OPERATION
C         *** DO SIGN EXTEND
C 
c---      LBIT = 60 - INBITS
          LBIT = 32 - INBITS
          N = (ITBITS * INWRDS) / INBITS
          DO 100 I = 1,N
cmy fix 01/29/2007  don't need to do this when not on the NOS system
c              IOUT(I) = SHIFT(SHIFT(IOUT(I),LBIT),-(LBIT)) 
c
  100     CONTINUE
      ENDIF 
      RETURN
      END 
      integer function shift(
     i                       idata, ifactor)

c**********************************************************************
c   Name - shift                         Module -
c   Language - FORTRAN                   Type - function
c   Version - ??      Date - 13 Oct 92   Programmer - S.R. Quier (SAIC)
c  
c   Purpose -
c    SHIFT(a1,a2) is a specific function that returns a shifted result.
c    The argument a1 is the data to be shifted.  Argument a2 is the 
c    number of binary positions a1 will be shifted and the direction
c    of the shift.  If a2 is greater than zero, the shift will be left
c    circular.  If a2 is less than zero, the shift will be right with
c    sign extension and end drop off.  If a2 is zero, no shift will
c    be accomplished.
c  
c   Key Local Parameters -
c     integer icount  : The number of binary positions to shift idata
c     integer ibit31  : The value of most-significant bit
c     integer loop    : Just a loop counter
c
c  
c   Subroutines Called -
c    iabs()
c    min0()
c    bit()
c    setbit()
c    lshift()
c    rshift()
c  
c   Exit States -
c
c   Restrictions -
c    ifactor must be non-zero, in the range of -32 -> 32.  If not,
c    then the operation will either be ignored (if ifactor .eq. 0) or
c    ifactor will be adjusted to either 32 or -32 (depending on sign
c    of incoming ifactor).
c  
c**********************************************************************
      integer idata
      integer ifactor
c     integer ishift

      integer icount
      logical ibit31
      logical bit
      integer loop

c
c **** Need to load the value
c
      shift = idata
c
c **** Make sure the user wants us to do something
c
      if(ifactor .ne. 0) then
c
c **** Adjust magnitude of shift
c
	  ifactor = isign(min0(iabs(ifactor),32), ifactor)
c
c **** Get the number of bit to shift the data
c
	  icount = iabs(ifactor)
c
c **** Determine direction of shift
c
	  if(ifactor .gt. 0) then
c
c **** Do the left circular shift
c
	      do 100 loop = 1, icount
c
c **** Save most significant bit
c
		  ibit31 = bit(31, shift)
c
c **** Do the shift
c
		  shift = lshift(shift, 1)
c
c **** Perform the end-carry of most-significant bit
c **** to the least significant bit position.
c
		  call setbit(0, shift, ibit31)
100           continue
	  else
c
c **** For the right arithmatic shift, with sign extension
c **** and end drop off, we do not need to work black magic,
c **** the Sun FORTRAN does it for us.
c
	      shift = rshift(idata, icount)
	  end if
      end if
      return
      end
