20010912: Update to imcalib.f

Sean,

I looked in the logs and see you have downloaded both the
source and linux binary distributions for gempak.

If you want to update your source distribution, I have attatched a
copy of $GEMPAK/source/gemlib/im/imcalib.f

Here are the update instructions:

1) move your current imcalib.f routine to imcalib.f.old

cd $GEMPAK/source/gemlib/im
mv imcalib.f imcalib.f.old

2) store the attatched imcalib.f routine to: $GEMPAK/source/gemlib/im/imcalib.f

3) rebuild the gemlib.a

cd $GEMPAK/source/gemlib/im
make clean
make all
make clean

4) rebuild the programs and GUIs

cd $NAWIPS
make clean
make all
make install
make clean


The above won't take too long since all you have to do is relink programs.


Steve Chiswell
Unidata User Support

        SUBROUTINE IM_CALIB(imgfil, ioff, iret)
C************************************************************************
C* IM_CALIB                                                             *
C*                                                                      *
C* This subroutine reads the calibration block of an AREA file, and     *
C* stores the colorbar levels in the appropriate common block variables.*
C* If the calibration block is a PROD, then the pixel and data values   *
C* are retrieved for the colorbar levels.                               *
C*                                                                      *
C* IM_DROP  ( IRET )                                                    *
C*                                                                      *
C* Input parameters:                                                    *
C*      IMGFIL          CHAR*           Image file                      *
C*      IOFF            INTEGER         Calibration block offset        *
C*                                                                      *
C* Output parameters:                                                   *
C*      IRET            INTEGER         Return code                     *
C*                                        0 = normal return             *
C**                                                                     *
C* Log:                                                                 *
C* Chiz/Unidata         07/00           Created for CIMSS products      *
C*                                      Initially, only PROD is handled.*
C************************************************************************

        CHARACTER*(*)   imgfil
        INTEGER         ioff, iret

        INTEGER         iarray(16)
        CHARACTER       tval*4

        INCLUDE         'IMGDEF.CMN'

C
C*      Attempt to open the image file
C
        CALL FL_DOPN (imgfil, 1, .false., lunf, iret)
        if (iret .ne. 0) return

        istart = (ioff / 4) + 1

C
C*      See if this is a known Calibration type
C
        CALL FL_READ (lunf, istart, 1, iarray, iret)
        CALL ST_ITOC ( iarray (1), 1, tval, ier )

        if(tval .eq. 'PROD') then

           cmcalb = tval

c          debug statements
c          do i=istart,istart+7
c             CALL FL_READ (lunf, i, 1, iarray, iret)
c   
c             if (iret .ne. 0) then
c                 write(*,*) 'flread failed ',ioff,iret
c             endif
c   
c             CALL ST_ITOC ( iarray (1), 1, tval, ier )
c             if(ier.ne.0) tval = ' '
c             write(*,*) i,' ',iarray(1),tval,' ',ier
c          end do

C
C*         Read in min and max pixel and corresponding data
C*         values. Scale value is for data points.
C
           CALL FL_READ (lunf, istart+1, 1, iminval, iret)
           CALL FL_READ (lunf, istart+2, 1, imaxval, iret)
           CALL FL_READ (lunf, istart+3, 1, iminpix, iret)
           CALL FL_READ (lunf, istart+4, 1, imaxpix, iret)
           CALL FL_READ (lunf, istart+5, 1, iarray, iret)
           CALL ST_ITOC ( iarray (1), 1, tval, ier )
           if(ier .eq. 0) then
              cmbunt = tval
           else
              cmbunt = 'Unk'
           endif

           CALL FL_READ (lunf, istart+6, 1, iscaleval, iret)
C
C*         Swap calibration values if necessary, don't need to swap ascii text
C
           if(imbswp .eq. 1) then
              ier = MV_SWP4 ( 1, iminval, iminval)
              ier = MV_SWP4 ( 1, imaxval, imaxval)
              ier = MV_SWP4 ( 1, iminpix, iminpix)
              ier = MV_SWP4 ( 1, imaxpix, imaxpix)
              ier = MV_SWP4 ( 1, iscaleval, iscaleval)
           endif

           if(iscaleval .eq. 0) iscaleval = 1
          
C
C*         Determine colorbar levels and store commonblock values.
C 
           ratio = float(imaxval - iminval)/float(imaxpix - iminpix)

           immnpx = iminpix
           immxpx = imaxpix
           iminpix = iminpix + 1
           imaxpix = imaxpix + 1
           do i=1,256
              if(i.eq.iminpix) then
                 CALL ST_INCH ( iminval/iscaleval, cmblev (i), ier )
              else if(i.eq.imaxpix) then
                 CALL ST_INCH ( imaxval/iscaleval, cmblev (i), ier )
              else if((i.gt.iminpix).and.(i.lt.imaxpix)) then
                    IF ( mod ( i-1,16) .eq. 0) THEN
                        level = nint( (i-iminpix) * ratio) + iminval
                        CALL ST_INCH ( level/iscaleval, 
     +                                 cmblev (i), ier )
                    ELSE
                        cmblev (i) = ' '
                    END IF
              else
                 cmblev(i) = ' '
              endif
           end do
        endif

        CALL FL_CLOS (lunf, iret)
        iret = 0

        RETURN
        END