C Copyright(c) 2005, Space Science and Engineering Center, UW-Madison C Refer to "McIDAS Software Acquisition and Distribution Policies" C in the file mcidas/data/license.txt C *** $Id: kbxabis.dlm,v 1.3 2008/07/25 17:07:56 rickk Tst $ *** C$ Name: C$ kbxini - Calibration module for Simulated ABI data C$ C$ Interface: C$ integer function C$ kbxini(character*4 input_cal,character*4 output_cal,integer io_size(*)) C$ C$ Input: C$ input_cal - Input calibration type ('RAW') C$ output_cal - Output calibration type ('TEMP','ALB','RAD','RAW','BRIT') C$ io_size - Source and destination byte depth C$ io_size(1) - Source pixel size (2) C$ io_size(2) - Destination pixel size (1,2,4) C$ C$ Output: C$ Error messages if return value is not 0. (To be backward compatible C$ with the existing API, the return value does not indicate which C$ error was encountered.) C$ C$ Return values: C$ 0 - success C$ -1 - error C$ C$ Remarks: C$ Note also that for ADDE we need to comment out all SDEST and DDEST C$ calls, since messages cannot be sent to "stdout" pipe mixed with data. C$ C$ EDEST messages will be sent to "stderr" and can be left in, but will C$ not be returned to a remote client. C$ C$ C$ Categories: C$ image C$ display C$ calibration C$ met/science integer function kbxini(input_cal,output_cal,io_size) implicit none c c --- input parametes c character*4 input_cal ! input calibration type (RAW) character*4 output_cal ! output cal type (TEMP,ALB,RAD,RAW,BRIT) integer io_size(*) ! source and destination byte depth c c --- local variables c c --- ABI Simulated Data calibration block character*4 cal_input ! input calibration type (RAW) character*4 cal_output ! output cal type (TEMP, ALB, RAD, RAW, BRIT) integer src_byte_size ! number of bytes for source pixel integer dest_byte_size ! number of bytes for destination pixel integer cal_flag ! 0= from AREA, 1= from server integer cal_block(64) ! cal block - includes directory and tables common/abis/ & cal_input, & cal_output, & src_byte_size, & dest_byte_size, & cal_flag, & cal_block c c --- set local variables to fill common block c cal_input = input_cal cal_output = output_cal c c --- Verify that the input calibration type c if (cal_input(1:3) .ne. 'RAW') then kbxini = -1 c c --- Verify that the output calibration type c elseif ((cal_output(1:4) .ne. 'TEMP') .and. & (cal_output(1:3) .ne. 'RAD') .and. & (cal_output(1:3) .ne. 'RAW') .and. & (cal_output(1:3) .ne. 'ALB') .and. & (cal_output(1:4) .ne. 'BRIT')) then kbxini = -1 else src_byte_size = io_size(1) dest_byte_size = io_size(2) cal_flag = 0 kbxini = 0 endif return end C$ Name: C$ kbxcal - Converts input DN to output of correct byte size & dimensions C$ C$ Interface: C$ integer function C$ kbxcal(integer prefix(*), integer area_dir(*), integer num_pixels, C$ integer band, integer ibuf(*) ) C$ C$ Input: C$ prefix - Line prefix calibration information C$ area_dir - Area directory associated with the IBUF data C$ num_pixels - Number of pixels in IBUF array C$ band - Band number for data in IBUF array C$ ibuf - array of data to be converted C$ C$ Output: C$ ibuf - array of converted data C$ C$ Return values: C$ 0 - success C$ -1 - failure to build a calibration lookup table C$ (output will always be returned in IBUF, even with an C$ invalid or unbuilt table) C$ C$ Remarks: C$ KBXINI determines if the conversion is permitted, by putting C$ constraints on the conversion types. Here, the type is assumed C$ already validated, and the only decision is whether to build a C$ table for a new valid type or use the table already existing. C$ Since data is always returned, it is the user's responsibility to C$ test return value KBXCAL for 0 to guarantee returned data is valid. C$ C$ Categories: C$ image C$ display C$ calibration C$ met/science integer function kbxcal(prefix,area_dir,num_pixels,band,ibuf) implicit none include 'areaparm.inc' ! defines NUMAREAOPTIONS integer MAX_VAL ! Maxium raw value parameter (MAX_VAL=200000) c c --- input parameters c integer prefix(*) ! line prefix information to determine detector integer area_dir(*) ! area directory integer num_pixels ! number of pixels in ibuf array integer band ! band number integer ibuf(*) ! I/O array containing pixels to be modified c c --- external functions c real rad_to_temp ! converts temperature to radiance character*12 cfi character*4 clit c c --- local variables c character*4 vis_type integer alb_table(MAX_VAL) ! albedo table determined from raw values to send to MPIXTB integer albedo_brit(MAX_VAL) ! brightness table determined from albedoes to send to MPIXTB integer area_number ! area number found in area directory integer cal_offset ! offset into calibration block integer i ! do loop index integer ir_band_offset ! offset into ir tables to find band temp table integer ir_table_offset ! offset into cal block to find ir tables integer j ! do loop index integer last_area ! last area used for araget integer last_band ! last area used for araget integer rad_table(MAX_VAL) ! radiance table determined from temperatures integer temp_brit(MAX_VAL) ! brightness table determined from temperatures integer temp_table(MAX_VAL) ! temperature table determined from raw values real albedo ! albedo read in from calibration table real radiance ! radiance returned from rad_to_temp real scale_factor ! scaling factor to convert raw to either radiance or albedo real temperature ! temperature read in from calibration table logical ir_data ! flag indicating ir data requested logical vis_data ! flag indicating visible data requested c --- ABI Simulated Data calibration block character*4 cal_input ! input calibration type RAW character*4 cal_output ! output cal type (TEMP, ALB, RAD, RAW, BRIT) integer src_byte_size ! number of bytes for source pixel integer dest_byte_size ! number of bytes for destination pixel integer cal_flag ! 0= from AREA, 1=from server integer cal_block(64) ! cal block - includes directory and tables common/abis/ & cal_input, & cal_output, & src_byte_size, & dest_byte_size, & cal_flag, & cal_block data last_area /-1/ data last_band /-1/ kbxcal = 0 c c --- set ir_data/vis_data flag c if (band .le. 6) then vis_data = .TRUE. ir_data = .FALSE. else vis_data = .FALSE. ir_data = .TRUE. endif c c --- read in calibration block c area_number = area_dir(33) cal_offset = area_dir(63) if (last_area .ne. area_number) then if( cal_flag.eq.0 ) then call araget(area_number,cal_offset,256,cal_block) endif endif last_area = area_number c c --- Determine scaling factor c scale_factor = float(cal_block(1 + band)) if ((vis_data) .and. (last_band .ne. band)) then scale_factor = 100. do 30 i=1,MAX_VAL albedo = float(i) / scale_factor alb_table(i) = nint(albedo * 100.) albedo_brit(i) = nint(0.5+25.5*sqrt(albedo)) 30 continue endif c c --- if data is from ir band c --- create temp, radiance and brit lookup tables c if ((ir_data) .and. (last_band .ne. band)) then c c --- create temperature, radiance and brightness tables c do 110 i=1,MAX_VAL radiance = float(i) / scale_factor temperature = rad_to_temp(radiance,band) temp_table(i) = nint(temperature * 100.) rad_table(i) = nint(radiance * 1000.) call gryscl(temperature,temp_brit(i)) 110 continue endif c c --- Convert ibuf to appropriate quantity c if (vis_data) then if (cal_output(1:3) .eq. 'RAW') then call mpixel(num_pixels,src_byte_size, & dest_byte_size,ibuf) elseif (cal_output(1:3) .eq. 'ALB') then call mpixtb(num_pixels,src_byte_size, & dest_byte_size,ibuf,alb_table) elseif (cal_output(1:4) .eq. 'BRIT') then call mpixtb(num_pixels,src_byte_size, & dest_byte_size,ibuf,albedo_brit) endif endif if (ir_data) then if (cal_output(1:3) .eq. 'RAW') then call mpixel(num_pixels,src_byte_size, & dest_byte_size,ibuf) elseif (cal_output(1:3) .eq. 'RAD') then call mpixtb(num_pixels,src_byte_size, & dest_byte_size,ibuf,rad_table) elseif (cal_output(1:4) .eq. 'TEMP') then call mpixtb(num_pixels,src_byte_size, & dest_byte_size,ibuf,temp_table) elseif (cal_output(1:4) .eq. 'BRIT') then call mpixtb(num_pixels,src_byte_size, & dest_byte_size,ibuf,temp_brit) endif endif last_band = band return end C$ Name: C$ kbxopt - Returns auxiliary parameters for setup or sets internal state C$ C$ Interface: C$ integer function C$ kbxopt(character*4 option, integer param_in(*), integer param_out(*)) C$ C$ Input: C$ option - Option ('KEYS', 'INFO', 'CALB' ) C$ param_in - Array of input parameters C$ C$ Output: C$ param_out - Array of output parameters C$ (The number of input and output parameters is determined C$ by the option or function executed. The calling routine C$ is responsible for having arrays large enough to send C$ and receive output for the option or function requested.) C$ C$ Return values: C$ 0 - success C$ -1 - Invalid function requested C$ -3 - Error in breakpoint table (table cannot be set up) C$ C$ Remarks: C$ Check the d.pgm code to see how the various functions are used. C$ C$ Categories: C$ image C$ display C$ calibration C$ met/science integer function kbxopt(option,param_in,param_out) implicit none c c --- input parameters c character*4 option ! option integer param_in(*) ! input parameters c c --- output parameters c integer param_out(*) ! output parameters c c --- external functions c integer brkset ! checks SU table integer ischar ! checks for character string integer lit ! four byte integer representation of char*4 c c --- local variables c character*8 su_file ! stretch table file integer band ! band number logical ir_data ! flag indicating ir data requested logical vis_data ! flag indicating visible data requested c c --- ABI Simulated Data calibration block c character*4 cal_input ! input calibration type (RAW) character*4 cal_output ! output cal type (TEMP, ALB, RAD, RAW, BRIT) integer src_byte_size ! number of bytes for source pixel integer dest_byte_size ! number of bytes for destination pixel integer cal_flag ! 0=from AREA, 1=from server integer cal_block(64) ! cal block - includes directory and tables common/abis/ & cal_input, & cal_output, & src_byte_size, & dest_byte_size, & cal_flag, & cal_block kbxopt = 0 if (option .eq. 'KEYS') then c c --- param_in contains frame directory - set ir_data/vis_data flag c band = param_in(4) if (band .le. 6) then vis_data = .TRUE. ir_data = .FALSE. else vis_data = .FALSE. ir_data = .TRUE. endif if (vis_data) then param_out(1) = 3 param_out(2) = lit('RAW ') param_out(3) = lit('ALB ') param_out(4) = lit('BRIT') elseif (ir_data) then param_out(1) = 4 param_out(2) = lit('RAW ') param_out(3) = lit('RAD ') param_out(4) = lit('TEMP') param_out(5) = lit('BRIT') endif c c --- Check for a stretch table (SU) c if (ischar(param_in(38)) .eq. 1) then call movwc(param_in(38),su_file) if (brkset(su_file,cal_input) .ne. 0) then kbxopt = -3 endif endif elseif (option .eq. 'BRKP') then c c --- param_in(1) is the su table name c call movwc(param_in(1),su_file) if (brkset(su_file,cal_input) .ne. 0) then kbxopt = -3 endif elseif (option .eq. 'INFO') then c c --- param_in contains frame directory - set ir_data/vis_data flag c band = param_in(4) if (band .le. 6) then vis_data = .TRUE. ir_data = .FALSE. else vis_data = .FALSE. ir_data = .TRUE. endif if (vis_data) then param_out(1) = 3 param_out(2) = lit('RAW ') param_out(3) = lit('ALB ') param_out(4) = lit('BRIT') param_out(5) = lit(' ') param_out(6) = lit(' % ') param_out(7) = lit(' ') param_out(8) = 1 param_out(9) = 100 param_out(10) = 1 elseif (ir_data) then param_out(1) = 4 param_out(2) = lit('RAW ') param_out(3) = lit('RAD ') param_out(4) = lit('TEMP') param_out(5) = lit('BRIT') param_out(6) = lit(' ') param_out(7) = lit('MW**') param_out(8) = lit(' K ') param_out(9) = lit(' ') param_out(10)= 1 param_out(11)= 1000 param_out(12)= 100 param_out(13)= 1 endif c --- param_in contains calibration block from server elseif (option .eq. 'CALB') then cal_flag = 1 call movw( 64, param_in, cal_block ) else kbxopt = -1 endif return end C$ Name: C$ rad_to_temp - Converts radiance to temperature C$ C$ Interface: C$ real function C$ rad_to_temp(real radiance, integer band) C$ C$ Input: C$ radiance - radiance C$ band - band number C$ C$ Return values: C$ C$ temperature - temperature - units of Kelvin * 100 C$ C$ C$ Remarks: C$ C$ Categories: C$ calibration real function rad_to_temp(radiance,band) implicit none c c - symbolic constants & shared data c integer NUM_BANDS parameter (NUM_BANDS=10) integer NUM_CONST parameter (NUM_CONST=2) c c --- input parameters c real radiance ! radiance integer band ! band number c c --- local variables c integer iband ! band number real fk1(NUM_BANDS) ! derived constants for each band real fk2(NUM_BANDS) ! derived constants for each band real temperature ! temperature value returned real tc(NUM_CONST,NUM_BANDS) ! derived temp constants for each band real adjusted_rad ! radiance adjusted by derived constants data fk1 /0.20080E+06, 0.50371E+05, 0.35501E+05, 0.30099E+05, & 0.19378E+05, 0.13442E+05, 0.10740E+05, 0.84860E+04, & 0.64038E+04, 0.50680E+04/ data fk2/0.36892E+04, 0.23267E+04, 0.20706E+04, 0.19598E+04, & 0.16922E+04, 0.14980E+04, 0.13900E+04, 0.12850E+04, & 0.11699E+04, 0.10822E+04/ data tc/0.51139, 0.99928, & 2.11916, 0.99543, & 0.33222, 0.99921, & 0.07096, 0.99982, & 0.17913, 0.99949, & 0.10525, 0.99967, & 0.13202, 0.99956, & 0.24744, 0.99912, & 0.26205, 0.99898, & 0.07139, 0.99970/ c c --- subtract 6 from band to match index into arrays for constants c iband = band - 6 adjusted_rad = fk2(iband) / alog(fk1(iband) / (radiance)) temperature = (adjusted_rad - tc(1,iband) / tc(2,iband)) rad_to_temp = temperature return end