C * THIS CODE IS A FORTRAN 90 VERSION OF THE OLD B3READ  
C * THE VARIABLE NAMES ARE THE SAME AS IN THE OLD VERSION AND MOST
C * OF THE STATEMENTS IN THE MAIN AND B3READ ARE THE SAME.
C *  
C * IT IS SET NOW TO READ ONE IMAGE USING THE FOLLOWING GLOBAL INPUT 
C * 
C *   'B3 file name'
C *    1 1              ! 1 image out of 1 available
C *    6 1 1 1 1 1       ! calibration table number (6) and five angles
C *                     ! latitude, longitude, cos(solar zenith), 
C *                     !  cos(satellite zenith) and phi
C *
C * THE COMPILER USED TO TEST THIS CODE IS XL FORTRAN FOR AIX
C * IF YOU USE DIFFERENT COMPILERS YOU MIGHT NEED TO CHANGE IN 
C * THE B3_KIND MODULE THE STORAGE REQUIREMENTS 
C * 
C-----------------------------------------------------------------------
C * NOTE:
C * STARTING WITH NOAA KLM SATELLITES THE AVHRR INSTRUMENT HAS AN EXTRA 
C * CHANNEL 3A (1.6 MICROMETERS) DAYTIME STORED IN THE SAME DATA STREAM
C * AS THE 3B CHANNEL (3.7 MICROMETERS) NIGHTIME.
C *
C * WE INTRODUCED IN B3 SCAN LINE DIR THE CHANNEL SWITCH FLAG FOR NOAA KLM
C * TO SIGNAL THE AVHRR CHANNELS 3A/3B SWITCHING AT SCAN LINE LEVEL. 
C * THEREFORE IN THIS CODE ICH_SWITCH IS 1 FOR CH 3A AND 0 FOR 3B.
C * 
C * CHANNEL 3B IS STORED IN CHANNEL 4 B3 AND THE SCANS THAT BELONGED TO 3A 
C * ARE FILLED WITH 255. 
C * CHANNEL 3A IS STORED IN CHANNEL 6 B3 AND THE SCANS THAT BELONGED TO 3B 
C * ARE FILLED WITH 255.  
C * THIS FLAG SHOULD BE 0 FOR ALL OTHER NOAA AND GEOSTATIONARY SATELLITES
C * VG, 22 JAN 2003
C-----------------------------------------------------------------------
C * 
C----------------------------------------------------------------------C
C *********************************************************************C
C TRANSFORMED TO FORTRAN 90 FEB, 2003 VG.
C UPDATED FOR UNIX 1/20/99 -CBP
C-----------------------------------------------------------------------
C-----------------BEGIN MAIN--------------------------------------------
      PROGRAM MAIN
        USE B3_MODULE
        USE B3_KIND
C----------------------------------------------------------------------C
C UNIX FILE SPECIFICATIONS
C----------------------------------------------------------------------C
      CHARACTER (LEN=55)                :: INFILE,OUTFILE,LUFILE
      INTEGER (KIND=INT4)               :: OUTPUT,LUNMAP
C                                                                       
C----------------------------------------------------------------------C
C  INITIALIZATION                                                       
C----------------------------------------------------------------------C
C                                                                       
      INPUT=10
      OUTPUT=20
      LUNMAP=9
      B3OUT=6      ! OUTPUT PORT
cmyfix      LUFILE='/clips/tables/lndwtr.data' 
      LUFILE='fort.9'
C----------------------------------------------------------------------C
C -- OPEN LAND WATER MAP FILE
C----------------------------------------------------------------------C
      OPEN(UNIT=LUNMAP,FILE=LUFILE, ACCESS='DIRECT',RECL=8000,FORM
     $     ='UNFORMATTED',STATUS='OLD')
C----------------------------------------------------------------------C
C -- READ THE NAME OF THE B3 IMAGE
C----------------------------------------------------------------------C
      print*," "
c-------9----------2---------3---------4---------5---------6---------7---------80
      print*,"XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
     $XXXXXXXX"
      print*,"  THIS CODE IS A FORTRAN 90 VERSION OF THE OLD B3READ PROG
     $RAM."
      print*,"  THE VARIABLE NAMES ARE THE SAME AS IN THE OLD VERSION AN
     $D MOST"
      print*,"  OF THE STATEMENTS IN THE MAIN AND B3READ ARE THE SAME."
      print*," "
c-------9----------2---------3---------4---------5---------6---------7---------80
      print*,"  IT IS SET NOW TO READ ONE IMAGE USING THE FOLLOWING GLOB
     $AL INPUT."
      print*," "
      print*,"   'B3 file name'"
      print*,"    1 1               ! total no of images, image number"
c-------9----------2---------3---------4---------5---------6---------7---------80
      print*,"    6 1 1 1 1 1       ! calibration table number (1 to 6)
     $and"
      print*,"                       ! five angles: 1 to decode"
      print*," Please enter the Input as in the above example."
      print*," "
      print*,"XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
     $XXXXXXXX"
      print*,"Enter the name of the B3 image file"
      READ(5,*)INFILE
      print*,"INFILE ",INFILE
      print*,"Enter total number of images"
      READ(5,*) NUMIMG,NUM         ! NUM IS IMAGE NUMBER EX: 2, 4,7 
C----------------------------------------------------------------------C
C  -- READ THE OUTPUT FILE NAME IF NEEDED 
C----------------------------------------------------------------------C
C----------------------------------------------------------------------C
C -- READ CALIBRATION TABLE NUMBER AND NAVIGATION FLAGS 
C----------------------------------------------------------------------C
      print*,"Enter calibration table"
      READ(5,*) ICF,(NAVFLG(I),I=1,5)
      PRINT*,'CALIBRATION TABLE TO USE=',ICF
      PRINT*,'NAVIGATION ANGLE TO DECODE=',NAVFLG
C----------------------------------------------------------------------C
C  BEGIN PROCESSING IMAGES                                           
C----------------------------------------------------------------------C
cmyfix      LUN= 10 
        DO L=1,6
      ICLFLG(L)= ICF 
        END DO
C----------------------------------------------------------------------C
C -- INITIALIZE THE 5 NAV FLAGS
C----------------------------------------------------------------------C
      DO 300 IMG=1,NUMIMG    
C----------------------------------------------------------------------C
C Here insert statement to read the b3 file name when reading more 
C files
cmyfix      WRITE(UNIT=INFILE(21:23),FMT='(I3.3)')IMG
C----------------------------------------------------------------------C
      OPEN(UNIT=B3OUT,FILE='B3_OUT.txt',FORM='FORMATTED')
      OPEN(UNIT=INPUT,FILE=INFILE,ACCESS='DIRECT', FORM='UNFORMATTED'
     $     ,IOSTAT=IOS,RECL=8000,STATUS='OLD')

      IF(IOS .NE.0) PRINT*,'ERR OPENING FILE',IOS,INFILE
C----------------------------------------------------------------------C
C -- FLAG FOR READING THE IMAGE HEADER 
C----------------------------------------------------------------------C
      INIT = 0                                                        
C----------------------------------------------------------------------C
C   INITIAL CALL B3READ                                                 
C----------------------------------------------------------------------C
      SCQUAL=0
      CALL B3READ                                                     

c     PRINT 501,DATERR                                                         
      WRITE(B3OUT,501)DATERR
  501 FORMAT('1','INITIAL READ SECTION COMPLETED  DATERR FLAG = ',I5)          
      IF(DATERR.NE.0) GO TO 1000
C----------------------------------------------------------------------C
C -- FLAG FOR LOOPING OVER SCAN LINES
C----------------------------------------------------------------------C
      INIT = 1                                                     
C----------------------------------------------------------------------C
C -- VAR IHBEG USED TO BE FIXED (=19) FOR 5 OR LESS CHANNELS. NOW, IT
C -- IS ADJUSTABLE, IF MORE THAN 5 CHANNELS(MCH) AS FOLLOWS:
C----------------------------------------------------------------------C
      IHBEG=19 +2*(MCH-5)
      DO 200 J=1,NSCANS

        CALL B3READ                                                   
       
C----------------------------------------------------------------------C
C SAMPLE MAIN PROGRAM UPDATED TO MORE EXPLICITLY HANDLE DATERR VALUE 
C CBP 1/19/00
C----------------------------------------------------------------------C
      IF(DATERR.NE.0) THEN  
          IF(DATERR.LT.0) GO TO 1100
          PRINT 700,J,SCQUAL,NTOTPX,NOFPL   
          IF(SCQUAL.GT.0) PRINT 601,SCQUAL,IMGLIN                              
          DO  I = 1,NCHANS                                                       
                IF(CHNFLG(I).NE.0) PRINT 602,I,CHNFLG(I),IMGLIN                      
          END DO                                                              
      END IF     !ON BAD SCAN LINE
C----------------------------------------------------------------------C
C----------------------------------------------------------------------C
  700 FORMAT(1X,'***************DIAGNOSTICS FOR SCAN LINE NUMBER ',I5/
     &          ' SCAN LINE QUALITY FLAG = ',I5/
     &          ' TOTAL NUMBER OF PIXELS IN SCAN LINE : ',I5/
     &       ' TOTAL NUMBER OF OFF PLANET PIXELS IN SCAN LINE : ',I5)
  601 FORMAT(1X,'SCAN LINE QUALITY FLAG',I8,'  FOR SCAN NUMBER ',I5)       
  602 FORMAT(1X,'CHANNEL ',I3,'    HAS CHANNEL QUALITY FLAG OF ',I4,        
     &             '  FOR SCAN NUMBER ',I5)                                    
C                  
C----------------------------------------------------------------------C
C AT THIS POINT YOU HAVE ONE SCAN LINE 
C----------------------------------------------------------------------C
  200 CONTINUE
      PRINT*,'SCANS: ',J-1,'OUT OF ',NSCANS
      GO TO 1100   
 1000 PRINT 1010 
 1010 FORMAT(1X,'ERROR IN INITIALIZATION ROUTINE')                             
      GO TO 300
c1100 PRINT 1110                                                               
 1100 WRITE(B3OUT,1110)
 1110 FORMAT(1X,'END OF DATA')               
  300 CONTINUE
      PRINT*," "
      PRINT*,"The Program Completed Successfully!!"
      PRINT*," "
      STOP                                              
      END PROGRAM MAIN    

C - TRANSFORMED INTO FORTRAN90. READS ANY NUMBER OF CHANNELS
C - UNIX COMPATIBLE 7/20/99
C---------------------------------------------------------------------
C*********************************************************************
C---------------------------------------------------------------------
C   B3READ FORTRN09   VERSION 2003                                  
C---------------------------------------------------------------------
                                                                     
      SUBROUTINE B3READ                                               
                                                                     
C---------------------------------------------------------------------
C                                                                     
C B3READ --- 10/27/2003    V. GOLEA
C            8/28/97       C. PEARL                                   
C            9/27/83       A. WOLF                                    
C            2/08/84       L. GARDER                                  
C            3/19/84       A. WOLF                                    
C            1/15/85       L. GARDER                                  
C                                                                     
C                                                                     
C---------------------------------------------------------------------
C*********************************************************************
C---------------------------------------------------------------------
C                                                                     
C  THIS SUBROUTINE CONTAINS TWO SECTIONS :                            
C                                                                     
C  INIT SECTION --- READS THE IMAGE IDENTIFICATION  RECORD, THE LOCATI
C                   GRID RECORD AND CALIBRATION RECORDS FOR THE IMAGE 
C                   AND PASSES THIS INFORMATION TO THE USER THROUGH   
C                   COMMON BLOCKS                                     
C                                                                     
C  READ SECTION --- TAKES ONE SCAN LINE'S WORTH OF INFORMATION FROM   
C                   A DATA RECORD, UNPACKS IT INTO VARIOUS ARRAYS AND 
C                   PASSES THE INFORMATION THROUGH COMMON BLOCK B3COM 
C                                                                     
C---------------------------------------------------------------------
C*********************************************************************
C---------------------------------------------------------------------
C                                                                     
C  THE SUBROUTINE REQUIRES THAT SOME ARRAYS BE INITIALIZED            
C  BY THE USER --> SEE SAMPLE INPUT IN MAIN                                                     
C  NUMBER OF CHANNELS (NCHANS) IT IS READ FROM THE IMAGE ID AND USED TO 
C  ALLOCATE THE ARRAYS                                            
C  ICLFLG(NCHANS) :
C       DETERMINES WHICH CALIBRATION TABLE IS READ PER CHANNEL 
C             0 - CHANNEL NOT AVAILABLE                               
C             1 - NOMINAL RADIANCE VALUES (WATTS/M2 - STERADIAN)      
C             2 - NORMALIZED RADIANCE VALUES                          
C             3 - ABSOLUTE RADIANCE VALUES                            
C             4 - NOMINAL ALBEDO OR TEMPERATURE (VISIBLE OR THERMAL)  
C             5 - NORMALIZED ALBEDO OR TEMPERATURE                    
C             6 - ABSOLUTE ALBEDO OR TEMPERATURE                      
C  NAVFLG(NCHANS) :
C       NAVIGATION ANGLE FLAG ARRAY DETERMINES WHICH ANGLES TO DECODE                                 
C             0 - ANGLE NOT DECODED                                   
C             1 - ANGLE DECODED                                       
C                                                                     
C  NOTE                                                               
C    A PATTERN OF (1 1 0 0 0) WOULD CORRESPOND TO A REQUEST TO DECODE 
C    THE FIRST TWO ANGLES AND NONE OF THE OTHERS.  THESE ARRAYS AND   
C    A FEW OTHER VARIABLES ARE INITIALIZED IN THE BLOCK DATA SECTION  
C    INCLUDED WITH THE SUBROUTINE.                                    
C                                                                     
C---------------------------------------------------------------------
C*********************************************************************
C---------------------------------------------------------------------
C                                                                     
C  I*4   MCH --------- HOLDS THE NUMBER THAT USED FOR ALLOCATING ARRAYS
C                      IT IS = 5 WHEN THE NUMBER OF CHANNELS IS <= 5
C                      IT IS = NCHANS WHEN THE NUMBER OF CHANNELS IS > 5
C                      (due to format changes since the start of ISCCP)                                               
C  I*4   LUN --------- LOGICAL UNIT NUMBER                            
C  I*4   INIT -------- INITIALIZATION FLAG                            
C                      0 - FIRST READ OF DATA SET                     
C                      1 - SCAN LINE READ                             
C  R*4   ALATLO ------ LOW VALUE FOR LATITUDE WINDOW SELECTION        
C  R*4   ALATHI ------ HIGH VALUE FOR LATITUDE WINDOW SELECTION       
C  I*4   NSCANS ------ NUMBER OF SCAN LINES IN THE IMAGE              
C  I*4   NTOTPX ------ NUMBER OF PIXELS IN EACH SCAN LINE             
C  I*4   NCHANS ------ NUMBER OF ACTIVE CHANNELS                      
C  I*4   IMAGNO ------ IMAGE SEQUENCE NUMBER                          
C  I*4   IBGTIM ------ BEGINNING SCAN LINE GMT  (HHMMSS)              
C  I*4   IENTIM ------ ENDING SCAN LINE GMT  (HHMMSS)                 
C  I*4   IBGDAT ------ BEGINNING SCAN LINE DATE (YYDDD)               
C  I*4   IENDAT ------ ENDING SCAN LINE DATE (YYDDD)                  
C  I*4   NIMGRC ------ NUMBER OF DATA RECORDS IN THE IMAGE            
C  I*4   CALFLG(NCHANS) ------ CALIBRATION FLAG FOR THE VISIBLE CHANNEL       
C                      0 - CALIBRATION NOT PRESENT                    
C                      1 - CALIBRATION PRESENT                        
C  I*4   IPBDSC ------ PERCENTAGE OF THE IMAGE CONTAINING BAD SCANS   
C  I*4   JULIAN ------ JULIAN DAY (1-366)                             
C  I*4   IYEAR ------- YEAR                                           
C  I*4   MONTH ------- MONTH (1-12)                                   
C  I*4   IDAY -------- DAY (1-31)                                     
C  I*4   IHOUR ------- GMT OF IMAGE                                   
C  I*4   MINS -------- GMT OF IMAGE                                   
C  I*4   IDORN ------- DAY/NIGHT FLAG                                 
C                      0 - DAY TIME IMAGE                             
C                      1 - FULL NIGHT TIME IMAGE (NO VISIBLE DATA)    
C  I*4   ICLFLG(NCHANS) --- CALIBRATION TABLE FLAGS                        
C  I*4   NAVFLG(5) --- NAVIGATION ANGLE FLAGS                         
C  I*4   CHNLID(NCHANS) --- CHANNEL ID (INTEGER VALUE)                     
C  I*4   ICHAAV(NCHANS) --- CHANNEL AVAILABILITY FLAGS                     
C                      1 - PRESENT                                    
C                      0 - NOT PRESENT                                
C  I*4   NSATID ------ SATELLITE CODE NUMBER                          
C  I*4   NSPCID ------ SPC CODE NUMBER                                
C  C*4   SATID(2) ---- SATELLITE ID (EBCDIC)                          
C  C*4   SPCID(2) ---- SPC ID (EBCDIC)                                
C  C*4   CHNID(NCHANS) --- CHANNEL IDENTIFICATION (EBCDIC)                 
C                                                                     
C---------------------------------------------------------------------
C*********************************************************************
C*********************************************************************
C---------------------------------------------------------------------
C  I*4   NOFPL ------ THE NUMBER OF OFF PLANET PIXELS IN THE SCAN LINE
C  I*4   MTIME ------ GMT OF THE SCAN LINE (HHMMSS)                   
C  I*4   DATERR ----- ERROR FLAG RETURNED FROM B3READ                 
C                     -4 - B3 INIT ERROR CALIBRATION NOT AVAILABLE    
C                     -3 - B3 INIT ERROR                              
C                     -2 - I/O ERROR                                  
C                     -1 - END OF DATA                                
C                      0 - NO ERROR                                   
C                      1 - ERROR IN DATA NON ZERO SCAN LINE QUALITY   
C                      2 - CHANNEL QUALITY FLAG NON ZERO              
C  I*4   SCQUAL ----- SCAN LINE QUALITY INDICATOR                     
C                      0 - GOOD                                       
C                      1 - BAD SCAN LINE                              
C                      2 - NAVIGATION ERROR                           
C                      3 - NAVIGATION FIT ERROR                       
C                      4 - BAD SCAN LINE HEADER INFORMATION           
C                      5 - BAD RECORD HEADER INFORMATION              
C                      FOR POLAR SATELLITES
C                      6 - BAD TIME FOR B2 SCAN
C                      7 - B2 CALIBRATION ERRORS
C                      8 - B2 EARTH LOCATION ERRORS
C  I*4   CHNFLG(NCHANS) -- CHANNEL QUALITY INDICATOR                       
C                     -2 - DATA ALL 0 OR 255                          
C                     -1 - NOT PRESENT                                
C                      0 - GOOD                                       
C                     >0 - BAD BUT PRESENT                            
C                      FOR POLAR SATELLITES
C                      2 - NOMINAL SLOPE OR INTERCEPT IS 0
C                      3 - REFLECTED SUNLIGHT
C                      4 - NOMINAL CALIBRATION PROBLEMS         
C                      
C  I*4   IMGLIN ----- SCAN LINE NUMBER                                
C  I*4   LOCGRD(18,36) - LOCATION GRID                                
C  R*4   CALVAL(256,NCHANS) - CALIBRATION TABLE                            
C  R*4   DATNAV(5,MAXPIX) - ARRAY CONTAINING NAVIGATED ANGLES         
C  I*2   PLANFL(MAXPIX) - ARRAY CONTAINING PLANETARY FLAGS            
C                     -1 - OFF PLANET                                 
C                      0 - ON PLANET / DAYTIME                        
C                      1 - ON PLANET / NIGHT TIME                     
C  I*2   LNDWTR(MAXPIX) - ARRAY CONTAINING LAND/WATER FLAGS FOR       
C                         EACH PIXEL IN SCAN LINE                     
C                      1 - WATER                                      
C                      2 - LAND                                       
C                      3 - COAST                                      
C  I*2   DATBUF(NCHANS,MAXPIX) :
C               ARRAY CONTAINING DATA VALUES FOR EACH     
C                           CHANNEL                                   
C                                                                     
C---------------------------------------------------------------------
C*********************************************************************
C*********************************************************************
C---------------------------------------------------------------------
C                                                                     
C    LWX025  -  THE RIGHT STUFF FOR ALL LAND/WATER LOVERS             
C                                                                     
C            + INPUT   > ALAT  (-90./+90.)                            
C                        ALON  (0./360. EAST)                         
C            + OUTPUT  > LNDFLG =  1   WATER                          
C                               =  2   LAND                           
C                               =  3   COAST                          
C                                                                     
C---------------------------------------------------------------------
C*********************************************************************
C*********************************************************************
C---------------------------------------------------------------------
C                                                                     
C             VARIABLE DICTIONARY B3READ SUBROUTINE                   
C                                                                     
C---------------------------------------------------------------------
C*********************************************************************
C---------------------------------------------------------------------
C                                                                     
C  I*4  ALON --------- LONGITUDE OF PIXEL                             
C  I*4  BYPIX -------- NUMBER OF BYTES PER PIXEL FOR DATA RANGE       
C  I*4  CALDEX(4) ---- INDEX TO BEGINNING WORD OF DIFFERENT CALIBRATIO
C                      TABLES IN A CALIBRATION RECORD                 
C  C*1  CBUF(8000) --- BYTE BUFFER FOR INPUT RECORD                   
C  C*1  CHARWD(2) ---- CHARACTER STORAGE ARRAY FOR BYTE MANIPULATION  
C  C*4  CHBUF4(2000) - WORD BUFFER FOR INPUT RECORD                   
C  C*4  CHNRNG(10,NCHANS) - CHANNEL RANGES (BANDWIDTHS FOR EACH CHANNEL)   
C  I*4  CINDEX ------- CALIBRATION RECORD INDEX                       
C  R*4  COEF1 -------- CALIBRATION NORMALIZATION COEFFICIENT          
C  R*4  COEF2 -------- CALIBRATION NORMALIZATION COEFFICIENT          
C  R*4  COEF3 -------- CALIBRATION NORMALIZATION COEFFICIENT          
C  R*4  COEF4 -------- CALIBRATION NORMALIZATION COEFFICIENT          
C  R*4  COEF5 -------- CALIBRATION NORMALIZATION COEFFICIENT          
C  R*4  CSCALE ------- CALIBRATION COEFFICIENT SCALE FACTOR           
C  I*4  CSIDEX ------- CALIBRATION RECORD INDEX                       
C  I*4  CSODEX(6) ---- CALIBRATION RECORD INDEX                       
C  I*4  DATCOD ------- CODE ASSIGNED TO DATA RANGE                    
C                      -1 - OFF PLANET                                
C                       0 - ON PLANET / DAY                           
C                       1 - ON PLANET / NIGHT                         
C  R*4  DEL1 --------- NAVIGATION PARAMETER                           
C  R*4  DEL2 --------- NAVIGATION PARAMETER                           
C  I*4  FWORD -------- WORD OF STORAGE FOR BYTE MANIPULATION          
C  R*4  F0 ----------- NAVIGATION PARAMETER                           
C  I*2  HBUF(4000) --- HALF-WORD BUFFER FOR INPUT RECORD              
C  I*4  HINDEX ------- POINTER TO HBUF (HALF-WORD INPUT BUFFER)       
C  I*2  HLFWRD ------- HALF-WORD STORAGE FOR BYTE MANIPULATION        
C  I*2  HWORD(2) ----- HALF-WORD STORAGE FOR BYTE MANIPULATION        
C  I*4  IASLON ------- LOCATION INFO (EQUATOR CROSSING OR SSP LONG.)  
C  I*4  IASGMT ------- GMT OF EQUATOR CROSSING OR SSP                 
C  I*4  ICKCAL(MCH) 
C              ------- COUNTER FOR CHECKING CALIBRATION TABLE VALUES  
C  I*4  IDSLON ------- LOCATION INFO (EQUATOR CROSSING OF SSP LON)    
C  I*4  IDSGMT ------- GMT OF EQUATOR CROSSING OR SSP                 
C  I*4  ID1 ---------- SCALED INTEGER DEL1 NAVIGATION PARAMETER       
C  I*4  ID2 ---------- SCALED INTEGER DEL2 NAVIGATION PARAMETER       
C  I*4  IF0 ---------- SCALED INTEGER F0 NAVIGATION PARAMETER         
C  I*4  IHBEG -------- INITIAL VALUE OF POINTER TO HALF-WORD INPUT    
C                      RECORD                                         
C  I*4  ILATHI ------- SCALED MAXIMUM LATITUDE VALUE IN INPUT RECORD  
C  I*4  ILATLO ------- SCALED MINIMUM LATITUDE VALUE IN INPUT RECORD  
C  I*4  ILONHI ------- SCALED RIGHTMOST LONGITUDE VALUE IN INPUT RECOR
C  I*4  ILONLO ------- SCALED LEFTMOST LONGITUDE VALUE IN INPUT RECORD
C  I*4  INAVER ------- NAVIGATION FIT ERROR FOR EACH CHANNEL          
C  I*4  INITLW ------- INITIALIZATION FLAG FOR LAND/WATER             
C  I*4  INTFLG(0:1) -- INITIALIZATION FLAG FOR INIT SECTION           
C  I*4  IPLPNT ------- PLANETARY FLAG ARRAY POINTER                   
C  I*4  IPTSCN ------- POINTER TO NEXT SCAN (HALF-WORD BUFFER)        
C  I*4  IPXBEG ------- BEGINNING PIXEL NUMBER OF NAVIGATION RANGE     
C  I*4  IPXEND ------- ENDING PIXEL NUMBER OF NAVIGATION RANGE        
C  I*4  IRANGE ------- POINTER TO BEGINNING PIXEL OF DATA RANGE       
C  I*4  IRECNO ------- INPUT RECORD NUMBER                            
C  I*4  IRECTY ------- INPUT RECORD TYPE                              
C  I*4  ISCALE(MCH) ---- SCALE FACTORS FOR CALIBRATION TABLES           
C  I*4  ISCNAV(5) ---- SCALE FACTORS FOR NAVIGATION FIT ERRORS        
C  I*4  ISOURC(20,MCH) - SOURCE FOR CALIBRATION INFORMATION             
C  I*4  IUNITS(20,MCH) - PHYSICAL UNITS FOR CALIBRATION TABLES          
C  I*4  LNDWON -------                                                
C  I*4  LPOINT ------- POINTER TO FIRST BYTE OF RAW DATA              
C  I*4  MANGS -------- COUNT OF NAVIGATION ANGLES DECODED             
C  I*4  MAXPIX ------- MAXIMUM SIZE OF SCAN LINE (500 PIXELS)         
C  I*4  MCHAN -------- LARGEST POSSIBLE CHANNEL CODE NUMBER           
C  I*4  NANGS -------- NUMBER OF POSSIBLE NAVIGATION ANGLES           
C  I*4  NAVRNG(5) ---- NUMBER OF NAVIGATION RANGES                    
C  I*4  NBYHW -------- NUMBER OF BYTES PER HALF-WORD (2)              
C  I*4  NDATRG ------- NUMBER OF DATA RANGES                          
C  I*4  NINRCS ------- INPUT RECORD COUNTER                           
C  I*4  NOISE(MCH) ----- NOISE ESTIMATE FOR EACH CHANNEL                
C                      -1 - NOT AVAILABLE                             
C  I*4  NOMGMT ------- NOMINAL GMT OF IMAGE (HHMMSS)                  
C  I*4  NOPIX -------- NUMBER OF PIXELS IN DATA RANGE                 
C  I*4  NTOHER ------- CHANNEL IDENTIFICATION                         
C  R*4  NRCOEF(5,MCH) -- CALIBRATION NORMALIZATION COEFFICIENTS         
C  I*4  PRJDAT ------- PROJECT DATE                                   
C  R*4  RLATHI ------- MAXIMUM LATITUDE VALUE IN INPUT RECORD         
C  R*4  RLATLO ------- MINIMUM LATITUDE VALUE IN INPUT RECORD         
C  R*4  RLONHI ------- RIGHTMOST LONGITUDE VALUE IN INPUT RECORD      
C  R*4  RLONLO ------- LEFTMOST LONGITUDE VALUE IN INPUT RECORD       
C  R*4  RMUHI -------- MAXIMUM MU ANGLE VALUE IN INPUT RECORD         
C  R*4  RMULO -------- MINIMUM MU ANGLE VALUE IN INPUT RECORD         
C  R*4  RMU0HI ------- MAXIMUM MU0 ANGLE VALUE IN INPUT RECORD        
C  R*4  RMU0LO ------- MINIMUM MU0 ANGLE VALUE IN INPUT RECORD        
C  R*4  SCALE -------- SCALE FACTOR FOR NAVIGATION PARAMETERS         
C  R*4  SCALNV ------- SCALE FACTOR FOR RECORD ID LATITUDE AND        
C                      LONGITUDE MAX/MIN INFORMATION                  
C  R*4  SCLNVM ------- SCALE FACTOR FOR RECORD ID MU AND MU0          
C                      MAX/MIN INFORMATION                            
C  I*4  MCH    ------- TOTAL POSSIBLE CHANNELS                        
C  I*4  WBUF(2000) --- WORD BUFFER FOR INPUT RECORD                   
C  I*4  WINDEX ------- POINTER TO INPUT RECORD (WORD BUFFER)          
C                                                                     
C---------------------------------------------------------------------
C*********************************************************************
C--------------------------------------------------------------------
        USE B3_MODULE
        USE B3_KIND


C*********************************************************************
C---------------------------------------------------------------------
C                                                                     
C                          INIT SECTION                               
C                                                                     
C---------------------------------------------------------------------
C*********************************************************************
C---------------------------------------------------------------------
C                                                                     
C BEGIN                                                               
C                                                                     
C---------------------------------------------------------------------
C---  CHECK WHETHER STDOUT IS UNDEFINED, AND MAKE IT LUNIT 6 IF IT IS:
C----------------------
      IF (B3OUT .NE. 8) B3OUT = 6
      DATERR = 0
      IF((INIT.LT.0).OR.(INIT.GT.1)) GO TO 10000                      
      IF(INTFLG(INIT).EQ.0) GO TO 10000                               
      IF(INIT.EQ.1) GO TO 1000                                        
      INTFLG(1) = 1                                                   
      SCALE = 2. ** 22                                                
      NINRCS = 0                                                      
      IREC=0
C---------------------------------------------------------------------
C FIRST READ IMAGE ID                                                 
C---------------------------------------------------------------------
       IREC=IREC+1
       READ(INPUT,REC=IREC,IOSTAT=IRC)WBUF
       IF(IRC < 0)GO TO 4100
       IF(IRC > 0) GO TO 5000  

      NCHANS = WBUF(10)                                               
c     PRINT*,'THE NUMBER OF CHANNELS IN B3 IMAGE NCHANS=',NCHANS
      WRITE(B3OUT,*)'THE NUMBER OF CHANNELS IN B3 IMAGE NCHANS=',NCHANS
C---------------------------------------------------------------------
C THE DATA FROM 1996 FORWARD WAS SAVED WITH A IMAGE ID 
C DESIGNED TO HOLD 5 CHANNELS THEREFORE WHEN THE SATELLITE HAs LESS THEN 5
C THE EXTRA FIELDS ARE EMPTY.  FOR THIS REASON WE DO THE FOLLOWING:
C---------------------------------------------------------------------
        IF(NCHANS<5)    MCH=5
        IF(NCHANS>=5)   MCH=NCHANS
C------------------------ARRAY ALLOCATION SECTION--------------------
C---------------ARRAY ALLOCATION SECTION------------------------------
       CALL ALOC_ARRAY
C----------------------END ARRAY ALLOCATION --------------------------- 
       IREC=1
       READ(INPUT,REC=IREC,IOSTAT=IRC)WBUF
       IF(IRC < 0)GO TO 4100
       IF(IRC > 0) GO TO 5000  
C---------------------------------------------------------------------
C RECORD NUMBER, IMAGE NUMBER, RECORD TYPE                            
C---------------------------------------------------------------------
      IRECNO = WBUF(1)                                                
      IMAGNO = HBUF(3)                                                
      IRECTY = HBUF(4)
C---------------------------------------------------------------------
      IF(NCHANS < 0) GO TO 10100                                     

C-----------------------------------------------------------------------
C - FILL THE VARS FOR IMAGEID TO PRINT
C-----------------------------------------------------------------------

        CALL IMAGE_ID

C-----------------------------------------------------------------------
C-----------------------------------------------------------------------
      IF(NSCANS <= 0.OR.NIMGRC <= 0) GO TO 10100                      
                                                                      
C---------------------------------------------------------------------
C DETERMINE MONTH AND DAY FROM JULIAN DATE                            
C---------------------------------------------------------------------
      CALL JULCNV (JULIAN,IYEAR,MONTH,IDAY,PRJDAT)                    
C---------------------------------------------------------------------
C FIND HOUR AND MINUTES FROM GMT IN MILITARY TIME                     
C---------------------------------------------------------------------
      IHOUR = NOMGMT/10000                                            
      MINS = (NOMGMT - IHOUR*10000)/100                               
C---------------------------------------------------------------------
C PRINT IMAGE IDENTIFICATION INFORMATION                              
C---------------------------------------------------------------------
      WRITE(B3OUT,175) IMAGNO,SPCID,NSPCID,SATID,NSATID,JULIAN,IYEAR, 
     &          MONTH,IDAY,NOMGMT,IHOUR,MINS                          
  175 FORMAT('1',T10,'IMAGE DESCRIPTION'/                             
     &           T10,'================='//                            
     & T10,'IMAGE SEQUENCE NUMBER : ',I5/                             
     & T10,'SPC ID ',2A4,' CODE ',I5,T40,'SATELLITE ID ',2A4,' CODE',I5/
     & T10,'JULIAN DAY (DDD):',I4,3X,'YEAR (YYYY):',I5,'  MONTH :',I3,
     &     '  DAY :',I3/                                              
     & T10,'NOMINAL GMT (HHMMSS) :',I7,'  HOUR :',I3,' MINS :',I4)    
      WRITE(B3OUT,176) NIMGRC,NSCANS,IPBDSC,IBGTIM,IENTIM,IBGDAT,IENDAT,
     &          NTOTPX                                                
  176 FORMAT(1X,T10,'NUMBER OF DATA RECORDS :',I6/                    
     &    1X,T10,'NUMBER OF SCAN LINES :',I6,/                        
     &    1X,T10,'PERCENTAGE BAD SCAN LINES :',I6/                    
     &    1X,T10,'GMT (HHMMSS) OF BEGINNING SCAN LINE : ',I8,         
     &       '  ENDING :',I8/                                         
     &    1X,T10,'DATE (YYDDD) OF BEGINNING SCAN LINE :',I8,          
     &       '  ENDING :',I8/                                         
     &    1X,T10,'NUMBER OF PIXELS / SCAN LINE :',I8)                 
C---------------------------------------------------------------------
C PRINT CHANNEL ID'S                                                  
C---------------------------------------------------------------------
      WRITE(B3OUT,177) NCHANS                                         
  177 FORMAT(1X,T10,'NUMBER OF ACTIVE CHANNELS :',I8)                 
      DO 179 I = 1,NCHANS                                             
cmyfix
      CALL ETOA( CHNID(I), CHNID(I), 4 )
      WRITE(B3OUT,178) I,CHNID(I),(CHNRNG(J,I),J=1,10),CHNLID(I)      
  178 FORMAT(1X,T10,'CHANNEL ',I2,5X,A4,5X,10A4,' CODE : ',I5)        
  179 CONTINUE                                                        
        DO I=1,NCHANS
      WRITE(B3OUT,180) I, CALFLG(I)                   
  180 FORMAT(1X,T10,'CHANNEL = ',I2,4X,'CALIBRATION FLAGS : ',I5)    
        END DO
      WRITE(B3OUT,181) IDORN                                          
  181 FORMAT(1X,T10,'DAY OR NIGHT  FLAG ',I5)                         
      WRITE(B3OUT,182) IASLON,IASGMT,IDSLON,IDSGMT                    
  182 FORMAT(1X,T10,'ASCENDING EQUATOR CROSSING LONGITUDE ',I8,       
     &     '  GMT ',I8/1X,T10,                                        
     &     'DESCENDING EQUATOR CROSSING LONGITUDE ',I8,'  GMT ',I8)   
C---------------------------------------------------------------------
C RESET CALVAL                                                        
C---------------------------------------------------------------------
      DO 200 ICH = 1,MCH                                            
      DO 200 I = 1,256                                                
        CALVAL(I,ICH) = 0.0                                       
  200 CONTINUE                                                        
C---------------------------------------------------------------------
C INITIALIZE DATNAV AND DATBUF                                        
C---------------------------------------------------------------------
      DO 350 IPIX = 1,MAXPIX                                          
      DO 300 IANG = 1,NANGS                                           
              DATNAV(IANG,IPIX) = -1000.0                                     
  300 CONTINUE                                                        
      DO 350 ICHAN = 1,MCH                                         
              DATBUF(ICHAN,IPIX) = 255                                        
  350 CONTINUE
C---------------------------------------------------------------------
C*********************************************************************
C---------------------------------------------------------------------
C READ LOCATION GRID RECORD                                           
C---------------------------------------------------------------------
       IREC=IREC+1
       READ(INPUT,REC=IREC,IOSTAT=IRC)WBUF
       IF(IRC < 0)GO TO 4100
       IF(IRC > 0) GO TO 5000 

      IGRDPT = 2
      DO 360 ILON = 1,36                                              
      DO 360 ILAT = 1,18                                              
      IGRDPT = IGRDPT + 1                                             
      LOCGRD(ILAT,ILON) = WBUF(IGRDPT)                                
  360 CONTINUE                                                        
cmyfix      PRINT 361                                                
      WRITE(B3OUT,361)
  361 FORMAT('1',T50,'LOCATION GRID'//)                               
      DO 370 ILON = 1,36                                              
      WRITE(B3OUT,369) (LOCGRD(ILAT,ILON),ILAT=1,18)                  
  369 FORMAT(1X,18(I7))                                               
  370 CONTINUE                                                        
C---------------------------------------------------------------------
C*********************************************************************
C---------------------------------------------------------------------
C                                                                     
C  READ CHANNEL CALIBRATION RECORDS                                   
C                                                                     
C  CHECK CALIBRATION FLAG TO DETERMINE WHICH CALIBRATION TABLE IS     
C  DESIRED FOR EACH CHANNEL,  PICK UP SCALE FACTOR AND SCALED INTEGERS
C  FROM RECORD.  DIVIDE SCALED INTEGERS BY SCALE FACTOR TO RETRIEVE   
C  PHYSICAL VALUES CORRESPONDING TO EACH COUNT VALUE AND STORE IN THE 
C  CALVAL ARRAY.                                                      
C                                                                     
C---------------------------------------------------------------------
C*********************************************************************
C---------------------------------------------------------------------
C READ CALIBRATION RECORDS                                            
C---------------------------------------------------------------------
      DO 550 ICAL = 1,NCHANS                                          
      ICHAN = CHNLID(ICAL)                                            
C---------------------------------------------------------------------
C INITIALIZE CALIBRATION CHECK ARRAY                                  
C---------------------------------------------------------------------
      ICKCAL(ICHAN) = 0                                               
       IREC=IREC+1
       READ(INPUT,REC=IREC,IOSTAT=IRC)WBUF
cmyfix       IF(IRC .NE.0)PRINT*,'RC AT CAL TABLE READ',IRC
       print*,'RC AT CAL TABLE READ',IRC
       IF(IRC < 0)GO TO 4100
       IF(IRC > 0) GO TO 5000 

      IRECNO = WBUF(1)                                                
      IMAGNO = HBUF(3)                                                
      IRECTY = HBUF(4)                                                
      IF(WBUF(3) == 0) THEN                                           
cmyfix
      WRITE(B3OUT,399)ICHAN
cmyfix         PRINT 399,ICHAN                                              
  399    FORMAT(//1X,'CALIBRATION TABLES FOR CHANNEL ',I6,            
     1          '  ARE NOT AVAILABLE'/)                               
         ICKCAL(ICHAN) = 256                                          
         GO TO 550                                                    
      ENDIF                                                           
C---------------------------------------------------------------------
C -- THE VALUES FOR ICLFLG ARE READ FROM INPUT FILE AND ARE SET BY THE USER
C---------------------------------------------------------------------
      IND = ICLFLG(ICHAN)                                             
      IF(IND.LT.1.OR.IND.GT.6) IND = 1                                
C-------------------                                                  
C---------------------------------------------------------------------
C PICK UP TEXTUAL INFORMATION -- PHYSICAL UNITS OF TABLE AND SOURCE   
C---------------------------------------------------------------------
      CSIDEX = CSODEX(IND)                                            
      DO I = 1,20                                                
        IUNITS(I,ICHAN) = WBUF(CSIDEX-1+I)                            
        ISOURC(I,ICHAN) = WBUF(CSIDEX+19+I)                           
        IF(IASCFLAG /= 1)CALL ETOA(IUNITS(I,ICHAN),IUNITS(I,ICHAN),4)
        IF(IASCFLAG /= 1)CALL ETOA(ISOURC(I,ICHAN),ISOURC(I,ICHAN),4)
      END DO
C---------------------------------------------------------------------
C PICK UP CALIBRATION TABLES                                          
C---------------------------------------------------------------------
      CINDEX = CALDEX(IND)                                            
      ISCALE(ICHAN) = WBUF(CINDEX)                                    
      IF(ISCALE(ICHAN) <= 0) THEN                                     
cmyfix         PRINT 401,IND,ICHAN                                          
      WRITE(B3OUT,401)IND,ICHAN
  401    FORMAT(//1X,'CALIBRATION TABLE # ',I5,'   FOR CHANNEL ',     
     &         I5,'  IS NOT AVAILABLE'//)                             
         DATERR = -4                                                  
      ENDIF                                                           
      CSCALE = ISCALE(ICHAN)                                          
      COEF1 = WBUF(CINDEX+1)                                          
      NRCOEF(1,ICHAN) = COEF1 / 10000.                                
      COEF2 = WBUF(CINDEX+2)                                          
      NRCOEF(2,ICHAN) = COEF2 / CSCALE                                
      COEF3 = WBUF(CINDEX+3)                                          
      NRCOEF(3,ICHAN) = COEF3 / CSCALE                                
      COEF4 = WBUF(CINDEX+4)                                          
      NRCOEF(4,ICHAN) = COEF4 / CSCALE                                
      COEF5 = WBUF(CINDEX+5)                                          
      NRCOEF(5,ICHAN) = COEF5 / CSCALE                                
      DO 500 I = 1,256                                                
        IVAL = WBUF(CINDEX+5+I)                                       
        VAL = IVAL                                                    
C--------------------------------------------------------------------
C IF A VALUE IN A CAL TABLE IS 0 INCREASE THE COUNTER ICKCAL
C--------------------------------------------------------------------
        IF(IVAL == 0) ICKCAL(ICHAN) = ICKCAL(ICHAN) + 1               
        CALVAL(I,ICHAN) = VAL / CSCALE                          
  500 CONTINUE                                                        
  450 CONTINUE                                                        

  550 CONTINUE                                                        
      DO 600 ICAL = 1,NCHANS                                          
      ICHAN = CHNLID(ICAL)                                            
      IF(ICKCAL(ICHAN) == 256) THEN                                   
cmyfix
c         PRINT 551,ICHAN                                              
      WRITE(B3OUT,551)ICHAN
  551    FORMAT(//1X,' * * *   CALIBRATION TABLE FOR CHANNEL ',I5,    
     &         ' IS NOT AVAILABLE   * * *'//)                         
         DATERR = -4                                                  
      ENDIF                                                           
  600 CONTINUE                                                        
      WRITE(B3OUT,601)                                                
  601 FORMAT(//1X,T10,'CALIBRATION INFORMATION '/)                    

      DO 620 ICAL = 1,NCHANS                                          
      ICHAN = CHNLID(ICAL)                                            
      print*,"ICHAN ",ICHAN
      WRITE(B3OUT,606) ICHAN,ICLFLG(ICHAN)                            
  606 FORMAT(1X,T10,'CHANNEL ',I5,5X,'TABLE ',I5)                     
      WRITE(B3OUT,607) (IUNITS(I,ICHAN),I=1,20)                       
  607 FORMAT(1X,T10,' UNITS : ',20(A4))                               
      WRITE(B3OUT,608) (ISOURC(I,ICHAN),I=1,20)                       
  608 FORMAT(1X,T10,' SOURCE : ',20(A4))                              
      WRITE(B3OUT,609) (NRCOEF(I,ICHAN),I=1,5)                        
  609 FORMAT(1X,T10,' COEFS : ',5(F8.4,2X))                           
       print*,"NCHANS ",NCHANS
  620 CONTINUE                                                        
C---------------------------------------------------------------------
C PRINT CALIBRATION TABLES                                            
C---------------------------------------------------------------------
cmyfix
c     PRINT 651                                            
      WRITE(B3OUT,651)
  651 FORMAT('1',T55,'CALIBRATION TABLE'/                          
     &           T55,'====================='//                        
     &       1X,'   COUNT',T60,'CHANNEL'//                            
     &       1X,'___________',T29,'      1       ','      2       ',  
     &           '      3       ','      4       ',                   
     &           '      5       ','      6       ',
     &          /T29,6('   -------    ')/)          
      DO 655 ICT = 1,256                                              
      NCT = ICT - 1                                                   
      PRINT 652, NCT,(CALVAL(ICT,ICH),ICH=1,NCHANS)        
cmyfix      WRITE(B3OUT,652)NCT,(CALVAL(ICT,ICH),ICH=1,MCHAN)
        print*,"NCT ",NCT
        print*,"ICHAN ",ICHAN
        print*,"NCHANS ",NCHANS
        print*,"MCHAN ",MCHAN
c      STOP25
      WRITE(B3OUT,652)NCT,(CALVAL(ICT,ICH),ICH=1,MCHAN)
  652 FORMAT(1X,I5,T29,6(F9.2,5X))                                    
  655 CONTINUE                                                        

  650 CONTINUE                                                        
C---------------------------------------------------------------------
C CHECK ANGLE FLAGS                                                   
C---------------------------------------------------------------------
  660 MANGS = 0                                                       

      DO I = 1,NANGS                                              
        IF((NAVFLG(I).LT.0).OR.(NAVFLG(I).GT.1)) THEN                   
                DATERR = -3                                                   
cmyfix
c               PRINT 670,I,NAVFLG(I)                                         
                WRITE(B3OUT,670)I,NAVFLG(I)
                RETURN                                                        
        ENDIF                                                           
        MANGS = MANGS + NAVFLG(I)                                       
      END DO                                                        

  670 FORMAT(//,1X,'*** WARNING   NAVFLG NOT PROPERLY SET',2I8,/)   

      IPTSCN = 0                                                      
C---------------------------------------------------------------------
C TEST LATITUDE WINDOW SELECTION                                      
C---------------------------------------------------------------------
      IF((ALATLO.EQ.-90.).AND.(ALATHI.EQ.+90.)) GO TO 800             
cmyfix      PRINT 701, ALATLO,ALATHI                                        
      WRITE(B3OUT,701)ALATLO,ALATHI
  701 FORMAT(/,20X,'LAT WINDOW SELECTION LOGIC FOR LAT RANGE',2F8.2,/)
C---------------------------------------------------------------------
C READ SUCCESSIVE B3 RECORDS UNTIL EITHER ALATLO OR ALATHI IS REACHED 
C---------------------------------------------------------------------
  750  CONTINUE
       IREC=IREC+1
       READ(INPUT,REC=IREC,IOSTAT=IRC)WBUF
       IF(IRC .NE.0)PRINT*,'RC AT LAT/LON HI LO READ',IRC
       IF(IRC .LT. 0)GO TO 4000
       IF(IRC .GT.0) GO TO 5000 

      NINRCS = NINRCS + 1                                             
      ILATLO = HBUF(7)                                                
      ILATHI = HBUF(8)                                                
      ILONLO = HBUF(9)                                                
      ILONHI = HBUF(10)                                               
      RLATLO = ILATLO * SCALNV                                        
      RLATHI = ILATHI * SCALNV                                        
      RLONLO = ILONLO * SCALNV                                        
      RLONHI = ILONHI * SCALNV                                        
      IF(RLATHI.LT.ALATLO) GO TO 750                                  
      IF(RLATLO.GT.ALATHI) GO TO 750                                  
cmyfix      PRINT 751,ALATLO,ALATHI,NINRCS,NIMGRC,RLATLO,RLATHI             
      WRITE(B3OUT,751)ALATLO,ALATHI,NINRCS,NIMGRC,RLATLO,RLATHI
  751 FORMAT(/,2X,'FOR GIVEN LAT WINDOW RANGE',2F8.2,2X,'AFTER',I5,   
     1  2X,'OF A TOTAL ',I5,2X,'INPUT RECORDS WE HAVE REACHED',2F8.2, 
     2  2X,'LAT RANGE',/)                                             
C---------------------------------------------------------------------
C TO ACCOMODATE THE FLEXIBLE STRUCTURE OF THE SCAN DIRECTORY 
C IHBEG IS VARIABLE AS FOLLOWS: IHBEG=19+2*(MCH-5)
C IT IS THE LENGTH OF THE SCAN LINE DIRECTORY
C---------------------------------------------------------------------
      IPTSCN = IHBEG                                                  
C---------------------------------------------------------------------
C SET LAND/WATER TEST FLAG                                            
C---------------------------------------------------------------------
  800 IF((NAVFLG(1).EQ.1).AND.(NAVFLG(2).EQ.1)) THEN                  
        LNDWON = 1                                                    
        print *,'initlw=',initlw
        IF(INITLW.EQ.1) RETURN                                        
C---------------------------------------------------------------------
C*********************************************************************
C---------------------------------------------------------------------
C INIT LAND/WATER                                                     
C---------------------------------------------------------------------
C*********************************************************************
C---------------------------------------------------------------------
C                                                                     
C      * * * *           NB - INPUT FILE IS LUN 9         * * * *     
C                                                                     
C---------------------------------------------------------------------
C*********************************************************************
C---------------------------------------------------------------------
C                                                                     
        INITLW = 1                                                    
C                                                                     
C---------------------------------------------------------------------
C*********************************************************************
C---------------------------------------------------------------------
C                                                                     
C     CAUTION: IF YOU ARE NOT INTERESTED IN LAND/WATER FEATURE,       
C     PLEASE COMMENT OUT UNTIL THE LINE BEFORE THE ELSE STATEMENT                       
C                                                                     
        LUNMAP = 9                                                    
        DO 850 IBUF = 1,23                                            
         READ(LUNMAP,REC=IBUF,IOSTAT=IRC)(BUFFER(IWD,IBUF),IWD=1,4000)
          IF(IRC < 0)GO TO 20100
          IF(IRC > 0) GO TO 20200

  850   CONTINUE
        CLOSE(LUNMAP)
cmyfix        PRINT 851                                              
              WRITE(B3OUT,851)
  851   FORMAT(/'---< LNDWTR MAPS INITIALIZED >---'/)                 
      ELSE                                                            
        LNDWON = 0                                                    
cmyfix        PRINT 852                                                     
        WRITE(B3OUT,852)
  852   FORMAT(//,10X,'SINCE LAT/LON INFORMATION IS NOT TO BE DECODED',
     1         '  NO LAND WATER FLAGS ARE AVAILABLE',/)               
      ENDIF                                                           
      RETURN                                                          
C                                                                     
C---------------------------------------------------------------------
C*********************************************************************
C---------------------------------------------------------------------
C                                                                     
C                             READ SECTION                            
C                                                                     
C---------------------------------------------------------------------
C*********************************************************************
C---------------------------------------------------------------------
C FETCH NEXT SCAN LINE                                                
C---------------------------------------------------------------------
 1000 IF(IPTSCN.EQ.0) GO TO 1100                                      
      HINDEX = IPTSCN                                                 
      GO TO 1200                                                      
C---------------------------------------------------------------------
C READ B3 FORMAT INPUT RECORD                                         
C---------------------------------------------------------------------
 1100 CONTINUE
       IREC=IREC+1
        
cmyfix       READ(INPUT,REC=IREC,IOSTAT=IRC)WBUF
       READ(INPUT,REC=IREC,IOSTAT=IRC)WBUF
       IF(IRC .NE.0)PRINT*,'RC AT RECORD ',IREC,'IS ',IRC
       IF(IRC < 0)GO TO 4000
       IF(IRC > 0)GO TO 5000  
      NINRCS = NINRCS + 1    
C---------------------------------------------------------------------
C INITIALIZE HALF-WORD POINTER                                        
C RECORD IDENTIFICATION 2.8.4.1.
C---------------------------------------------------------------------
      HINDEX = IHBEG                                                  
      ILATLO = HBUF(7)                                                
      ILATHI = HBUF(8)                                                
      ILONLO = HBUF(9)                                                
      ILONHI = HBUF(10)                                               
      RLATLO = ILATLO * SCALNV                                        
      RLATHI = ILATHI * SCALNV                                        
      RLONLO = ILONLO * SCALNV                                        
      RLONHI = ILONHI * SCALNV                                        
      RMULO = HBUF(11)                                                
      RMULO = RMULO * SCLNVM                                          
      RMUHI = HBUF(12)                                                
      RMUHI = RMUHI * SCLNVM                                          
      RMU0LO = HBUF(13)                                               
      RMU0LO = RMU0LO * SCLNVM                                        
      RMU0HI = HBUF(14)                                               
      RMU0HI = RMU0HI * SCLNVM                                        
C---------------------------------------------------------------------
C FETCH SCAN LINE DIRECTORY                                           
C---------------------------------------------------------------------
 1200 NOFPL=0                                                         
C---------------------------------------------------------------------
C POINTER TO NEXT SCAN LINE                                           
C---------------------------------------------------------------------
      IPTSCN = HBUF(HINDEX)                                           
C---------------------------------------------------------------------
C SCAN LINE NUMBER                                                    
C---------------------------------------------------------------------
      IMGLIN = HBUF(HINDEX+1)                                         
C---------------------------------------------------------------------
C -- READ THE FLAG FOR SWITCH CHAN 3A AND 3B. 1 FOR 3A AND 0 FOR 3B
C -- IT IS FILLED FOR NOAA-16 AND FORWARD, FOR THE REST IS 0
C---------------------------------------------------------------------
      HINDEX = HINDEX + 2                                             
        ICH_SWITCH=HBUF(HINDEX)
C       PRINT*,'ICH_SWITCH=',ICH_SWITCH
C---------------------------------------------------------------------
C PICK UP LOGICAL POINTER TO FIRST DATA BYTE   (SKIP UNUSED HALF-WORD)
C---------------------------------------------------------------------
      HINDEX = HINDEX + 1                                             
      LPOINT = HBUF(HINDEX)                                           
      HINDEX = HINDEX + 1                                             
C---------------------------------------------------------------------
C NUMBER OF NAVIGATION RANGES FOR EACH ANGLE                          
C---------------------------------------------------------------------
      DO 1300 NAV = 1,NANGS                                           
      NAVRNG(NAV) = HBUF(HINDEX)                                      
      HINDEX = HINDEX + 1                                             
 1300 CONTINUE                                                        
C---------------------------------------------------------------------
C NUMBER OF DATA RANGES                                               
C---------------------------------------------------------------------
      NDATRG = HBUF(HINDEX)                                           
C---------------------------------------------------------------------
C UNPACK SCAN LINE QUALITY FLAG AND CHANNEL QUALITY FLAGS             
C IF BAD SCAN LINE PRINT FLAG SET DATERR FLAG AND RETURN              
C---------------------------------------------------------------------
      HINDEX = HINDEX+1                                               
      SCQUAL = HBUF(HINDEX)                                           
      HINDEX = HINDEX + 1                                             
      IF(SCQUAL.GT.0) GO TO 6000                                      
      DO ICH =1,MCH
      CHNFLG(ICH) = HBUF(HINDEX)                                      
      HINDEX = HINDEX + 1                                             
      END DO

      DO 1500 ICH = 1,NCHANS                                          
      IF(CHNFLG(ICH).NE.0) THEN                                       
         DATERR = 2                                                   
         GO TO 1510                                                   
      ENDIF                                                           
 1500 CONTINUE                                                        
C---------------------------------------------------------------------
C GMT OF SCAN LINE                                                    
C---------------------------------------------------------------------
 1510 CONTINUE 
C      MTIME = WBUF(WINDEX)                                            
C -- NOW, SINCE WE HAVE MORE THAN 5 CHANNELS FOR NOAA-16 FORWARD
C -- WE NEED TO DO THIS:
        IF(MCH>=6) HINDEX=HINDEX+(MCH-5)
                WINDEX=HINDEX/2+1
                MTIME = WBUF(WINDEX)
                HINDEX = HINDEX + 2
      IF(MTIME<0)PRINT*,'ERROR IN SCAN LINE GMT, 
     &   CHECK LINE  1415 TO 1428'
C---------------------------------------------------------------------
C FETCH SCAN LINE PARAMETERS AND RENAVIGATE ANGLES                    
C---------------------------------------------------------------------
      IF(NANGS.EQ.0) GO TO 2100                                       
      DO 2000 NAV = 1,NANGS                                           
      IF(NAVFLG(NAV).EQ.0) GO TO 1900                                 
      NNAV = NAVRNG(NAV)                                              
      IF(NNAV.EQ.0) GO TO 2000                                        
      DO 1700 INAVRN = 1,NNAV                                         
      IPXBEG = HBUF(HINDEX)                                           
      IPXEND = HBUF(HINDEX+1)                                         
      HINDEX = HINDEX + 2                                             
      WINDEX = (HINDEX-1) / NBYHW + 1                                 
      IF0 = WBUF(WINDEX)                                              
      ID1 = WBUF(WINDEX+1)                                            
      ID2 = WBUF(WINDEX+2)                                            
      HINDEX = NBYHW * (WINDEX+3) - 1                                 
      F0 = IF0                                                        
      F0 = F0 / SCALE                                                 
      DATNAV(NAV,IPXBEG) = F0                                         
      DEL1 = ID1 / SCALE                                              
      DEL2 = ID2 / SCALE                                              
      IF(IPXBEG.EQ.IPXEND) GO TO 1700                                 
      IPXBEG = IPXBEG + 1                                             
      DO 1600 IPIX = IPXBEG,IPXEND                                    
      IF0 = IF0 + ID1                                                 
      ID1 = ID1 + ID2                                                 
      F0 = IF0                                                        
      F0 = F0 / SCALE                                                 
      DATNAV(NAV,IPIX) = F0                                           
 1600 CONTINUE                                                        
 1700 CONTINUE                                                        
      IF(NAV.NE.2) GO TO 2000                                         
C---------------------------------------------------------------------
C CORRECT LONGITUDE TO A 0-360 DEGREE RANGE                           
C---------------------------------------------------------------------
      DO 1800 IPIX = 1,NTOTPX                                         
      ALON = DATNAV(2,IPIX)                                           
      IF(ALON.LT.0..AND.ALON.GT.-500.0) ALON = ALON + 360.            
      DATNAV(2,IPIX) = ALON                                           
 1800 CONTINUE                                                        
      GO TO 2000                                                      
 1900 WINDEX = WINDEX + 4 * NAVRNG(NAV)                               
      HINDEX = HINDEX + 8 * NAVRNG(NAV)                               
 2000 CONTINUE                                                        
      GO TO 2300                                                      
C---------------------------------------------------------------------
C IF NO ANGLES ARE DECODED ---- INCREMENT POINTERS                    
C---------------------------------------------------------------------
 2100 DO 2200 NAV = 1,NANGS                                           
      WINDEX = WINDEX + 4 * NAVRNG(NAV)                               
      HINDEX = HINDEX + 8 * NAVRNG(NAV)                               
 2200 CONTINUE                                                        
C---------------------------------------------------------------------
C INITIALIZE DATA POINTERS                                            
C---------------------------------------------------------------------
 2300 IPLPNT = 0                                                      
C---------------------------------------------------------------------
C FETCH DATA DIRECTORY                                                
C---------------------------------------------------------------------
      DO 3000 IDAT = 1,NDATRG                                         
C---------------------------------------------------------------------
C NUMBER OF BYTES / PIXEL                                             
C---------------------------------------------------------------------
      BYPIX = HBUF(HINDEX)                                            
C---------------------------------------------------------------------
C POINTER TO FIRST DATA BYTE
C---------------------------------------------------------------------
      IRANGE = HBUF(HINDEX+1)                                         
C---------------------------------------------------------------------
C DATA CODE FOR RANGE (0 PLANET DAY,1 ON PLANET NIGHT ,-1 OFF PLANET)                                   
C---------------------------------------------------------------------
      DATCOD = HBUF(HINDEX+2)                                         
C---------------------------------------------------------------------
C NUMBER OF PIXELS IN RANGE                                           
C---------------------------------------------------------------------
      NOPIX = HBUF(HINDEX+3)                                          
      HINDEX = HINDEX + 4                                             
C---------------------------------------------------------------------
C PRE-LOAD PLANETARY FLAGS                                            
C IF NIGHT OR DAY ON PLANET GO TO 2450
C---------------------------------------------------------------------
      IF(DATCOD.GE.0) GO TO 2450                                      
C---------------------------------------------------------------------
C OFF-PLANET PIXELS                                                   
C---------------------------------------------------------------------
      NOFPL = NOFPL + NOPIX                                           
      DO 2400 IPIX = 1,NOPIX                                          
      PLANFL(IPLPNT+IPIX) = DATCOD                                    
      LNDWTR(IPLPNT+IPIX) = 0                                         
C---------------------------------------------------------------------
C TO SET ALL OFF-PLANET PIXEL VALUES TO 255 LOOP LABELED 2350 TO FILL 
C INSTEAD OF UNPACK ORIGINAL VALUES                                   
C---------------------------------------------------------------------
C     DO 2350 ICHAN = 1,MCH                                        
C     DATBUF(ICHAN,IPLPNT+IPIX) = 255                                 
C2350  CONTINUE                                                        
C---------------------------------------------------------------------
C DECODE OFF PLANET ORIGINAL VALUES
C---------------------------------------------------------------------
      DO 2350 ICHAN = 1,NCHANS                                        
      CHARWD(2) = CBUF(IRANGE+ICHAN-1)                                
      JCHAN = CHNLID(ICHAN)                                           
      DATBUF(JCHAN,IPLPNT+IPIX) = HLFWRD
 2350 CONTINUE                                                        
C---------------------------------------------------------------------
      IRANGE = IRANGE + NCHANS                                        
      DO 2370 NAV = 1,NANGS                                           
      DATNAV(NAV,IPLPNT+IPIX) = -1000.                                
 2370 CONTINUE                                                        
 2400 CONTINUE                                                        
      GO TO 2950 ! IF OFF PLANET SKIP                                                      
C---------------------------------------------------------------------
C ON-PLANET PIXELS                                                    
C---------------------------------------------------------------------
 2450 DO 2900 IPIX = 1,NOPIX                                          
      PLANFL(IPLPNT+IPIX) = DATCOD                                    
      LNDWTR(IPLPNT+IPIX) = 0                                         
C---------------------------------------------------------------------
C DECODE DATA                                                         
C---------------------------------------------------------------------
      IF(BYPIX.LE.0) GO TO 2900  ! IF 0 BYTES/PIXEL                                      
C---------------------------------------------------------------------
C FOR NOAA-16 SPLIT CHANNELS FOUR IN 3B ( B3 CHA 4) AHD 3A (B3 CH 6)
C---------------------------------------------------------------------
      DO 2500 ICHAN = 1,NCHANS                                        
      CHARWD(2) = CBUF(IRANGE+ICHAN-1)                                
      JCHAN = CHNLID(ICHAN)                                           
        DATBUF(JCHAN,IPLPNT+IPIX) = HLFWRD
 2500 CONTINUE                                                        
      IRANGE = IRANGE + NCHANS                                        
C---------------------------------------------------------------------
C TEST IF LAND/WATER COMPUTATION IS POSSIBLE                          
C---------------------------------------------------------------------
      IF(LNDWON.EQ.0) GO TO 2900                                      
C---------------------------------------------------------------------
C OFF-PLANET TEST                                                     
C---------------------------------------------------------------------
      IF(DATCOD.LT.0) GO TO 2900                                      
C---------------------------------------------------------------------
C LAND/WATER FLAG RETRIEVAL                                           
C---------------------------------------------------------------------
C*********************************************************************
C---------------------------------------------------------------------
C                                                                     
C     CAUTION:                                                        
C                                                                     
C---------------------------------------------------------------------
C     IF YOU WISH TO SKIP LAND/WATER FLAG RETRIEVAL,  COMMENT OUT UP  
C     TO AND INCLUDING   2850 CONTINUE                                
C---------------------------------------------------------------------
C*********************************************************************
C---------------------------------------------------------------------
C     BEGIN PROCESSING - INITIAL CHECK OF PRIMAP    (85% PASSES)      
C---------------------------------------------------------------------
C                                                                     
      ALAT = DATNAV(1,IPLPNT+IPIX)                                    
      ALON = DATNAV(2,IPLPNT+IPIX)                                    
      LATBIN = ALAT * 0.5 + 46.0                                      
      LONBIN = ALON * 0.5 + 1.0                                       
      IF(LATBIN.LT.1) LATBIN=1                                        
      IF(LATBIN.GT.90) LATBIN=90                                      
      IF(LONBIN.LT.1) LONBIN=1                                        
      IF(LONBIN.GT.180) LONBIN=180                                    
      IF(PRIMAP(LONBIN,LATBIN).GT.10) GO TO 2600                      
      LNDFLG = PRIMAP(LONBIN,LATBIN)                                  
      GO TO 2850                                                      
C---------------------------------------------------------------------
C ENTER LEVEL 2; 1.0X1.0 DEGREE RESOLUTION                            
C---------------------------------------------------------------------
 2600 RKLAT = (LATBIN-1) * 2                                          
      LATPL = ALAT - RKLAT + 90.0                                     
      IF ( LATPL .GT. 1 ) LATPL = 1                                   
      LATPL = LATPL * 2                                               
      RKLON = (LONBIN-1) * 2                                          
      LONPL = ALON - RKLON                                            
      IF ( LONPL .GT. 1 ) LONPL = 1                                   
      IPNTR = PRIMAP(LONBIN,LATBIN) + LONPL + LATPL                   
      IF(LEV100(IPNTR).GT.10) GO TO 2700                              
      LNDFLG = LEV100(IPNTR)                                          
      GO TO 2850                                                      
C---------------------------------------------------------------------
C ENTER LEVEL 3; 0.5X0.5 DEGREE RESOLUTION                            
C---------------------------------------------------------------------
 2700 RKLAT = RKLAT + LATPL / 2                                       
      LATPL = (ALAT-RKLAT+90.0) * 2.0                                 
      IF ( LATPL .GT. 1 ) LATPL = 1                                   
      LATPL = LATPL * 2                                               
      RKLON = RKLON + LONPL                                           
      LONPL = (ALON-RKLON) * 2.0                                      
      IF ( LONPL .GT. 1 ) LONPL = 1                                   
      IPNTR = LEV100(IPNTR) + LONPL + LATPL                           
      HWORD(2) = LEV050(IPNTR)                                        
      IF(FWORD.GT.10) GO TO 2800                                      
      LNDFLG = FWORD                                                  
      GO TO 2850                                                      
C---------------------------------------------------------------------
C ENTER LEVEL 4; .25X.25 DEGREE RESOLUTION                            
C---------------------------------------------------------------------
 2800 RKLAT = RKLAT + (LATPL/2) * 0.5                                 
      LATPL = (ALAT-RKLAT+90.0) * 4.0                                 
      IF ( LATPL .GT. 1 ) LATPL = 1                                   
      LATPL = LATPL * 2                                               
      RKLON = RKLON + LONPL * 0.5                                     
      LONPL = (ALON-RKLON) * 4.0                                      
      IF ( LONPL .GT. 1 ) LONPL = 1                                   
      IPNTR = FWORD + LONPL + LATPL                                   
      LNDFLG = LEV025(IPNTR)                                          
C---------------------------------------------------------------------
C SAVE LAND/WATER FLAG                                                
C---------------------------------------------------------------------
 2850 LNDWTR(IPLPNT+IPIX) = LNDFLG                                    
C---------------------------------------------------------------------
C*********************************************************************
C---------------------------------------------------------------------
 2900 CONTINUE                                                        
C---------------------------------------------------------------------
C AUGMENT IPLPNT                                                      
C---------------------------------------------------------------------
 2950 IPLPNT = IPLPNT + NOPIX                                         
 3000 CONTINUE                                                        
      RETURN                                                          
C---------------------------------------------------------------------
C NORMAL END OF DATA                                                  
C---------------------------------------------------------------------
 4000 WRITE(B3OUT,4001) NINRCS                                        
 4001 FORMAT(//,10X,'END OF INPUT DATA',I8,//)                        
      INIT = 0                                                        
      DATERR = -1                                                     
      RETURN                                                          
C---------------------------------------------------------------------
C PREMATURE END OF DATA                                               
C---------------------------------------------------------------------
cmyfix 4100 PRINT 4101                                                      
 4100 WRITE(B3OUT,4101)
 4101 FORMAT(//,10X,'PREMATURE END OF IMAGE '//)                      
      INIT = 0                                                        
      DATERR = -3                                                     
      RETURN                                                          
C---------------------------------------------------------------------
C I/O ERROR                                                           
C---------------------------------------------------------------------
cmyfix 5000 PRINT 5001,NINRCS                                               
 5000 WRITE(B3OUT,5001)NINRCS
 5001 FORMAT(/,20X,'I/O ERROR',I8,//)                                 
      DATERR = -2                                                     
      RETURN                                                          
 6000 WRITE(B3OUT,6001) SCQUAL                                        
 6001 FORMAT(1X,'* * BAD SCAN LINE * * QUALITY INDICATOR =',I4,' *')  
      DATERR = 1                                                      
C---------------------------------------------------------------------
C FILL SCAN LINE WITH NON-DATA                                        
C---------------------------------------------------------------------
      DO 7500 IPIX = 1,NTOTPX                                         
      DO 7100 IANG = 1,NANGS                                          
      DATNAV(IANG,IPIX) = -1000.0                                     
 7100 CONTINUE                                                        
      DO 7200 ICHAN = 1,MCH                                        
      DATBUF(ICHAN,IPIX) = 255                                        
 7200 CONTINUE                                                        
 7500 CONTINUE                                                        
      RETURN                                                          
C---------------------------------------------------------------------
C INIT ERROR                                                          
C---------------------------------------------------------------------
cmyfix10000 PRINT 10001,INIT                                                
10000 WRITE(B3OUT,10001)INIT
10001 FORMAT(/,10X,'WARNING: USER HAS NOT SET INIT FLAG ',I8,/)       
      DATERR = -3                                                     
      RETURN                                                          
cmyfix10100 PRINT 10101,NCHANS,NSCANS,NIMGRC                                
10100 WRITE(B3OUT,10101)NCHANS,NSCANS,NIMGRC
10101 FORMAT(/1X,'IMAGE IDENTIFICATION RECORD CONTAINS BAD INFORMATION',
     1       //1X,' NCHANS = ',I4,'   NSCANS = ',I5,'   NIMGRC = ',I5/)
      DATERR = -3                                                     
      RETURN                                                          
C---------------------------------------------------------------------
C*********************************************************************
C---------------------------------------------------------------------
C IF USING THE LAND WATER FLAG ROUTINE THE FOLLOWING 8 STATEMENTS     
C MUST BE UNCOMMENTED                                                 
C---------------------------------------------------------------------
C LAND/WATER INIT ERRORS                                              
C---------------------------------------------------------------------
cmyfix20100 PRINT 20101                                                     
20100 WRITE(B3OUT,20101)
20101 FORMAT(/,10X,'----ERROR: LNDWTR MAP INIT ----'/)                
      DATERR = -3                                                     
      RETURN                                                          
cmyfix20200 PRINT 20201                                                     
20200 WRITE(B3OUT,20201)
20201 FORMAT(/,10X,'----END OF FILE: LAND/WATER MAP ---'/)            
      DATERR = -3                                                     
      RETURN                                                          
      END SUBROUTINE B3READ
C---------------------------------------------------------------------
C**********************************************************************C
C* NAME:         ICHAR_                                               *C
C* DESCRIPTION:  FUNCTION TO HANDLE CHANGE IN ICHAR BEHAVIOR WITH     *C
C*               v8 OF THE IBM xlf90 COMPILER                         *C
C**********************************************************************C
C**********************************************************************C
C**********************************************************************C
      INTEGER FUNCTION ICHAR_(C)
      CHARACTER C
      INTEGER TMP
      TMP = ICHAR(C)
      IF(TMP.GE.0) THEN
         ICHAR_=TMP
      ELSE
         ICHAR_=256+TMP
      ENDIF
      RETURN
      END

C*********************************************************************
C---------------------------------------------------------------------
C CONVERT EBCDIC TO ASCII

      SUBROUTINE ETOA( EBCSTRING, ASCSTRING, LENGTH )
      CHARACTER*1 EBCSTRING(LENGTH)
      CHARACTER*1 ASCSTRING(LENGTH)
       
      CHARACTER*1 ASCTAB(0:255)/
     $ ' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',
     $ ' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',
     $ ' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',
     $ ' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',
     $ ' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',
     $ ' ',' ',' ',' ',' ','.','<','(','+','|','&',' ',' ',' ',
     $ ' ',' ',' ',' ',' ',' ','!','$','*',')',';','^','-','/',
     $ ' ',' ',' ',' ',' ',' ',' ',' ',' ',',','%','_','>','?',
     $ ' ',' ',' ',' ',' ',' ',' ',' ',' ','`',':','#','@','\',
cmyfix
     $ '=','"',' ','a','b','c','d','e','f','g','h','i',' ',' ',
     $ ' ',' ',' ',' ',' ','j','k','l','m','n','o','p','q','r',
     $ ' ',' ',' ',' ',' ',' ',' ','~','s','t','u','v','w','x',
     $ 'y','z',' ',' ',' ','[',' ',' ',' ',' ',' ',' ',' ',' ',
     $ ' ',' ',' ',' ',' ',' ',' ',']',' ',' ','{','A','B','C',
     $ 'D','E','F','G','H','I',' ',' ',' ',' ',' ',' ','}','J',
     $ 'K','L','M','N','O','P','Q','R',' ',' ',' ',' ',' ',' ',
     $ '\\',' ','S','T','U','V','W','X','Y','Z',' ',' ',' ',' ',
     $ ' ',' ','0','1','2','3','4','5','6','7','8','9',' ',' ',
     $ ' ',' ',' ',' '/

      DO I=1,LENGTH
         ASCSTRING(I) = ASCTAB(ICHAR_(EBCSTRING(I)))
      END DO
      RETURN
      END SUBROUTINE ETOA


C---------------------------------------------------------------------
C*********************************************************************
C---------------------------------------------------------------------
      SUBROUTINE HSTPRN (NBINS,HIST)                                   
C                                                                     
C     HISTOGRAM PRINTOUT                                              
C                                                                     
      INTEGER HIST(1)                                                 
      CHARACTER*1 PRNT(100)                                           
      CHARACTER*1 BLNK,XXXX                                           
      DATA BLNK /' '/                                                
      DATA XXXX /'X'/                                                 
C                                                                     
C     BEGIN                                                           
C                                                                     
      MAX=0                                                           
      ISUM=0                                                          
      IFRSBN=0                                                        
      DO 100 IBIN=1,NBINS                                             
      IVAL=HIST(IBIN)                                                 
      ISUM=ISUM+IVAL                                                  
      IF(IVAL.GT.MAX) MAX=IVAL                                        
      IF(IVAL.EQ.0) GO TO 100                                         
      LASTBN=IBIN                                                     
      IF(IFRSBN.EQ.0) IFRSBN=IBIN                                     
  100 CONTINUE                                                        
      IF(MAX.EQ.0) RETURN                                             
      AMAX=MAX                                                        
      SUM=ISUM                                                        
      ISUM=0                                                          
      DO 700 IBIN=IFRSBN,LASTBN                                       
      HEIT=HIST(IBIN)                                                 
      IHEIT=100.0*(HEIT/AMAX)                                         
      DO 600 IPRN=1,100                                               
      PRNT(IPRN)=BLNK                                                 
      IF(IPRN.LE.IHEIT) PRNT(IPRN)=XXXX                               
  600 CONTINUE                                                        
      ISUM=ISUM+HIST(IBIN)                                            
      TOT=100.0*(ISUM/SUM)                                            
      IF(TOT.LT.0.1) GO TO 700                                        
      PRINT 601,IBIN,HIST(IBIN),TOT,PRNT                              
  601 FORMAT(1X,I4,1X,I8,1X,F11.2,1X,'.',100A1)                       
      IF(TOT.GT.99.5) RETURN                                          
  700 CONTINUE                                                         
      RETURN                                                           
      END SUBROUTINE HSTPRN
C---------------------------------------------------------------------
C*********************************************************************
C---------------------------------------------------------------------
      SUBROUTINE JULCNV (JULIAN,IYEAR,MONTH,IDAY,PRJDAT)               
C-----------------------------------------------------------------------
C                                                                       
C JULIAN DAY TO  MONTH-DAY CONVERSION  ROUTINE                          
C                                                                       
C-----------------------------------------------------------------------
      DIMENSION MNTAB(12)                                               
      INTEGER PRJDAT                                                    
      DATA MNTAB /31,28,31,30,31,30,31,31,30,31,30,31/                  
C-----------------------------------------------------------------------
C BEGIN                                                                 
C-----------------------------------------------------------------------
      MNTAB(2) = 28                                                     
      IF(MOD(IYEAR,4).EQ.0) MNTAB(2) = 29                               
      MONTH = 0                                                         
      IDAY = 0                                                          
      IF(JULIAN.EQ.0) GO TO 800                                         
      ISUM = 0                                                          
      DO 500 MNTH = 1,12                                                
      ISUM = ISUM + MNTAB(MNTH)                                         
      IF(JULIAN.GT.ISUM) GO TO 500                                      
      MONTH = MNTH                                                      
      ISUM = ISUM - MNTAB(MNTH)                                         
      IDAY = JULIAN - ISUM                                              
C-----------------------------------------------------------------------
C COMPUTE PROJECT DATE                                                  
C-----------------------------------------------------------------------
      PRJDAT = -365 - 181                                               
      DO 100 IYR = 1982,IYEAR-1                                         
      JUL = 365                                                         
      IF(MOD(IYR,4).EQ.0) JUL = 366                                     
      PRJDAT = PRJDAT + JUL                                             
  100 CONTINUE                                                          
      PRJDAT = PRJDAT + JULIAN                                          
      RETURN                                                            
  500 CONTINUE                                                          
C-----------------------------------------------------------------------
C JULIAN DATE ERROR                                                     
C-----------------------------------------------------------------------
  800 PRINT 801,JULIAN,IYEAR                                            
  801 FORMAT(/,10X,'JULCNV ERROR    JULIAN',I5,2X,'YEAR',I8,/)          
      PRJDAT = -1                                                       
      RETURN                                                            
      END SUBROUTINE JULCNV
