c-----------------------------------------------------------------------
c
c  Name:
c      SUBROUTINE MASCAL
c
c  Purpose:
c      Compute MAS IR band calibration slope and intercept with
c      correction for non-unit blackbody emissivity.
c
c  Usage:
C      CALL MASCAL( BAND, BB1C, BB2C, BB1T, BB2T, HEADT, 
C    &   SLOPE, INTERCEPT )
c 
c  Input:
c      BAND      MAS IR band number (26-50)
c      BB1C      Digital counts for blackbody 1
c      BB2C      Digital counts for blackbody 2
c      BB1T      Temperature for blackbody 1 (Kelvin)
c      BB2T      Temperature for blackbody 2 (Kelvin)
c      HEADT     Estimated head temperature (Kelvin) [function TEMBCK]
c
c  Output:
c      SLOPE     Calibration slope (Watts per square meter per
c                steradian per micron per count)
c      INTERCEPT Calibration intercept (Watts per square meter per
c                steradian per micron)
c      
c  Revised:
c      Liam.Gumley@ssec.wisc.edu
c      $Id: mascal.f,v 1.5 1999/11/12 16:39:35 gumley Exp $
c
c-----------------------------------------------------------------------

      subroutine mascal( band, bb1c, bb2c, bb1t, bb2t, headt,
     &  slope, intercept )

      implicit none
      
c ... arguments

      integer band, bb1c, bb2c
      real bb1t, bb2t, headt, slope, intercept
      
c ... local variables

      real emis( 50 ), masrad, rad1, rad2, radbck
      external masrad

c ... effective blackbody emissivity for all 50 MAS bands

      data emis / 25 * 1.0,
     &  0.98095, 0.98104, 0.98115, 0.98124, 0.98134,
     &  0.98145, 0.98155, 0.98164, 0.98175, 0.98184,
     &  0.98194, 0.98203, 0.98213, 0.98223, 0.98233,
     &  0.98243, 0.94590, 0.94102, 0.93890, 0.93782,
     &  0.93668, 0.93668, 0.93700, 0.93764, 0.93858 /

c ... set default return values

      slope = 0.0
      intercept = 0.0
      
c ... check input arguments

      if( band .lt. 26 .or. band .gt. 50 ) then
        write(*,*) 'Warning in subroutine MASCAL'
        write(*,*) 'Input argument BAND was out of the range [26,50]'
        write(*,*) 'Offending value was ', band
        write(*,*) 'Slope and Intercept set to zero in MASCAL'
        return
      endif
      
      if( bb1c .le. 0 .or. bb1c .ge. 100000 ) then
        write(*,*) 'Warning in subroutine MASCAL'
        write(*,*) 'Input argument BB1C was out of the range [0,100000]'
        write(*,*) 'Offending value was ', bb1c
        write(*,*) 'Slope and Intercept set to zero in MASCAL'
        return
      endif

      if( bb2c .le. 0 .or. bb2c .ge. 100000 ) then
        write(*,*) 'Warning in subroutine MASCAL'
        write(*,*) 'Input argument BB2C was out of the range [0,100000]'
        write(*,*) 'Offending value was ', bb2c
        write(*,*) 'Slope and Intercept set to zero in MASCAL'
        return
      endif

      if( bb1c .ge. bb2c ) then
        write(*,*) 'Warning in subroutine MASCAL'
        write(*,*) 'Input argument BB1C was GE than BB2C'
        write(*,*) 'Offending values were ', bb1c, bb2c
        write(*,*) 'Slope and Intercept set to zero in MASCAL'
        return
      endif

      if( bb1t .le. 180.0 .or. bb1t .ge. 320.0 ) then
        write(*,*) 'Warning in subroutine MASCAL'
        write(*,*) 'Input argument BB1T was out of the range ' //
     &    '[180.0,320.0]'
        write(*,*) 'Offending value was ', bb1t
        write(*,*) 'Slope and Intercept set to zero in MASCAL'
        return
      endif

      if( bb2t .le. 180.0 .or. bb2t .ge. 320.0 ) then
        write(*,*) 'Warning in subroutine MASCAL'
        write(*,*) 'Input argument BB2T was out of the range ' //
     &    '[180.0,320.0]'
        write(*,*) 'Offending value was ', bb2t
        write(*,*) 'Slope and Intercept set to zero in MASCAL'
        return
      endif

      if( bb1t .ge. bb2t ) then
        write(*,*) 'Warning in subroutine MASCAL'
        write(*,*) 'Input argument BB1T was GE than BB2T'
        write(*,*) 'Offending values were ', bb1t, bb2t
        write(*,*) 'Slope and Intercept set to zero in MASCAL'
        return
      endif

      if( headt .le. 180.0 .or. headt .ge. 320.0 ) then
        write(*,*) 'Warning in subroutine MASCAL'
        write(*,*) 'Input argument HEADT was out of the range ' //
     &    '[180.0,320.0]'
        write(*,*) 'Offending value was ', headt
        write(*,*) 'Slope and Intercept set to zero in MASCAL'
        return
      endif

c ... initialize planck function temperature correction coefficients
c ... (must be done before calling MASRAD or MASBRT)

      call initcf()

c ... convert blackbody and head temperatures to radiance

      rad1 = masrad( band, bb1t )
      rad2 = masrad( band, bb2t )
      radbck = masrad( band, headt )

c ... compute emissivity corrected calibration slope and intercept

      slope = emis( band ) * ( ( rad2 - rad1 ) / real( bb2c - bb1c ) )
      intercept = rad1 + ( radbck - rad1 ) * ( 1.0 - emis( band ) ) -
     &  slope * real( bb1c )

      end
