CCooperative Institute for Research in the Atmosphere Colorado State University Fort Collins, Colorado 80523 ISCCP Sector Processing Center GOES data from GOES NEXT series of satellites. G.G. Campbell, K.R. Dean, T.H. Vonder Haar 970 491 8448 campbell@cira.colostate.edu dean@cira.colostate.edu With help from R. Gartner, D. Whitcome and M. Hiatt. This effort is sponsored by NOAA under grant number NA37BJ0202. October, 1994 Revised November 1996 Revised August 1997 Revised July 1998 - Added GOES-10 Copy of this text and additional information is availabel at: http://www.cira.colostate.edu/climate/isccp/isccpspc.htm The tapes will be organized with 1 file for each time slot collected and one header file in ASCII at the beginning of the tape. The first 80 characters on the tape should look like: CSU.B#.####.v.yydddh1.yydddh2{ISCG#:..} ASCII text including this text. in long records. The ISCCP processor and navigation code will be included in this as well. The data format of the ISCCP GOES 8 and 9 data prepared at CIRA is a mixture of MCIDAS format and documentation data transmitted directly from the satellite. The basic structure of the data set is a header containing sector specifications, navigation constants and calibration coefficients. This is followed by scan lines of data from the multispectral imager interlaced by pixel. Some of the ISCCP data products prepared by CIRA will have either data from two imager sensors - channel 4 (infrared) and channel 1 ( visible ) - or data from all five imager sensors plus two additional variance images.Each scan line is preceded by an 80 byte header which includes the time of the scan. It is important to note that the image data can have discontinuities in time because the full disk image collection is interrupted by other activities. For climate studies where each pixel is treated independently this is not significant. For spatial structure studies, time discontinuities will lead to cloud edge effects which might be worth consideration. A C program to read the disk file version of this data is appended to this documentation which at least prints out various parameters. A short IDL script is included for those who want a quick look at the data. For the computer used to construct this data the following word sizes apply: long int 32 bits short int 16 bits char 8 bits Little endian byte order applies so byte swapping may be required to transport to other computers. The data can be used directly on VAX and PC systems. Swapping will be required for SUN's for instance. Because of the mixture of 2 byte and 4 byte integers, care must be used in the swap. Swapping the image data is not needed because they are bytes. The header has several sections all in one record: A. Mcidas header: 256 bytes. B. Mcidas navigation: 2560 bytes. C. Calibration: 512 bytes. D. Block 0 direct satellite transmission 8040 bytes. E. ISCCP ASCII header: 2504 bytes. The following physical records concatenate many data records into one physical record: DATA [80 Byte header, da[], 80 byte header, da[]...] A. MCIDAS header [256 bytes] MCIDAS_DATDIR_AREA_HDR_T;. long int area_status; long int version_num; code version long int sat_id_num; 70=GOES8 visir, 72=GOES9 visir.. long int img_date; long int img_time; long int north_bound; Full resolution lime number long int west_vis_pixel; Full resolution element number long int z_coor; long int num_line; Lines in image long int num_elem; Elements/scan line for each channel long int bytes_per_pixel; [1=ISCCP counts, 2=RAW data] long int line_res; Full resolution spacing between lines. long int elem_res; Full resolution spacing between elements. long int num_chan; Number of channels long int num_byte_ln_prefix; Scan line prefix length [80] long int proj_num; long int creation_date; long int creation_time; long int sndr_filter_map; Bit code representing the channels present long int img_id_num; long int id[4]; char comment[32]; long int pri_key_calib; Byte position for calibration start long int pri_key_nav; Byte position for data start=length of header long int sec_key_nav; long int val_code; Good data indicator. long int pdl[8]; long int band8; long int act_img_date; long int act_img_time; long int act_start_scan; long int len_prefix_doc; long int len_prefix_calib; long int len_prefix_lev; char src_type[4]; char calib_type[4]; long int avg_or_sample; long int poes_signal; long int poes_up_down; char orig_src_type[4]; long int reserved[7]; B. Navigation header [2560 bytes]. This contains the navigation parameters used by the Mcidas software and the sample codes in this documentation. The Block 0 real numbers might supply more accuracy if one can figure out how to handle the GOULD real numbers. I can not fully describe the navigation procedure. The best I can do is supply the NOAA/NESDIS program which converts line-element to latitude-longitude. The use of double precision may not be needed. The version supplied below utilizes the integers in the Mcidas header to define the navigation constants. There is a similar program which deals with the block 0 parameters. I must rely on NOAA/NESDIS to verify the accuracy of this program. A map was superimposed upon the image using the sample code. By eye it match OK but not exactly with the continental edge. Bigger errors are apparent with full resolution visible data. The prediction of these parameters is still under development by NESDIS (10/94) so these may provide very good navigation in the future. I have some components of this code in C if it is needed. C. Calibration header [512 bytes]. There is a very large document on calibration for GOES 8, 3000 pages. I have not digested it, but this is my impression of how GOES 8 calibration should be applied. The raw signal from the satellite is adjusted at Wallops into a calibrated count for transmission in the GVAR format. Coefficients are included in the Block 0 indicating how to convert the 10 bit counts to real radiances and then to temperatures. Similarly the visible counts can be converted into a "radiance". These coefficients are moved into the 512 byte Mcidas calibration header for use with the standard Mcidas software. These are stored as GOULD real numbers (4 bytes). For wide distribution the real numbers in this header will be copied into the ISCCP header as ASCII, see below. I will quote the following from Chan Johnson at SSEC [chadj@ssec.wisc.edu]. GOES-8 performs on board real-time calibration of the infrared detectors. The ground station at Wallops Island uses sensor readings from space and blackbody looks and computes calibration coefficients, applies these coefficients to the raw counts, and computes true radiances. Radiance values are 10-bits in length for the imager and 13- bits for the sounder. Scaling factors are applied to the true radiance values to obtain a scaled radiance which is 10-bits for the imager and 16- bits for the sounder. This scaled radiance is the value sent to users in the GVAR transmission and are stored in 2 byte words (16-bits) in the McIDAS area. The scaling factors are supplied in the Imager Documentation Block 0 words 6667-6778 for the imager, and Sounder Documentation Block 11 SAD #32 words 3991-4566 for the sounder. Visible data is normalized (to reduce striping) in real-time by the SPS (Sensor Processing System) at Wallops Island. Raw counts are 10-bit imager and 13-bit sounder and are transmitted to users as 10- bit and 16-bit data respectively. SSEC GVAR ingestor shifts imager visible raw values left 5 bits to occupy 15 bits. These data are stored in 2 byte words in the McIDAS area. The 13-bit sounder visible data is shifted left 3-bits in the SPS and transmitted as 16-bit words. To obtain the raw imager visible counts divide the raw McIDAS pixel by 32. To obtain the raw sounder visible counts divide the raw McIDAS pixel value by 8. The GVAR transmission also includes visible bias, first order gain, and second order gain calibration coefficients to compute visible radiance's. An albedo conversion factor is supplied to allow computation of albedos from these visible radiance's. These coefficients are in words 6399-6498 of Imager Documentation Block 0 for the imager and in words 3075-3126 of Sounder Documentation Block 11 for the sounder. Visible calibration consists of the bias, first order gain, and second order gain coefficients for each visible detector and are used to calculate visible radiance's from visible counts. An albedo factor is also stored to obtain albedos from the calculated visible radiance's. IR counts are calibrated by the ground station at Wallops Island and scaled via scaling factors, then transmitted in the GVAR signal as scaled radiance's. IR calibration consists of a bias scaling factor and a first order gain scaling factor. The imager codicil is 49 four byte words in length. Words 1-25 contain the imager visible coefficients; words 1-8 bias (one per detector); words 9-16 first order gain (one per detector); words 17-24 second order gain (one per detector); and word 25 is the albedo conversion factor (one for all detectors). Words 26-41 contain IR scaling factors for channels 2 through 5 for both side 1 and side 2 set of detectors. This array contains 16 elements; 4 sets of 4 elements. The first and second set of 4 elements are the bias scaling factors with the first set for side 1 and the second set for side 2. The third and fourth set of 4 elements are the gain scaling factors for side 1 and side 2 respectively. Within each group of 4 elements are the scaling factors for each IR channel in the following order: 1. Channel 4 2. Channel 5 3. Channel 2 4. Channel 3 Side 1 and Side 2 scaling factors should never differ since they are channel dependent and not detector dependent. For this reason, the calibration module only applies the scaling factors from side 1. Visible Visible bias, first order gain, second order gain, and albedo factor calibration coefficients are extracted from the codicil. There is one set of each coefficient for each visible detector. One albedo factor is used for all detectors. The average of all coefficients for the detectors is calculated and the visible radiance is calculated by the following equation: VR = Q2*(c**2) + Q1*c + B Where: VR = visible radiance Q2 = second order gain (average of all detectors) Q1 = first order gain (average of all detectors) B = bias (average of all detectors) c = raw counts = TableIndex/16 (Imager) = TableIndex/4 (Sounder) = TableIndex/4 (Sounder) GOES-8 Imager Detector Bias(B) First Order Gain (Q1) Second Order Gain (Q2) 1 -15.411599 0.552808 0.000000 2 -15.304399 0.550187 0.000000 3 -15.389000 0.553974 0.000000 4 -15.268399 0.550833 0.000000 5 -15.311099 0.550945 0.000000 6 -15.273000 0.552190 0.000000 7 -15.353399 0.550459 0.000000 8 -15.330000 0.550728 0.000000 GOES-9 Imager Detector Bias(B) First Order Gain (Q1) Second Order Gain (Q2) 1 -16.221497 0.554953 0.000000 2 -16.307190 0.557680 0.000000 3 -16.232590 0.549236 0.000000 4 -16.785690 0.563654 0.000000 5 -16.484085 0.557521 0.000000 6 -16.166595 0.551351 0.000000 7 -16.104889 0.556095 0.000000 8 -16.674286 0.560408 0.000000 GOES-10 Imager Detector Bias(B) First Order Gain (Q1) Second Order Gain (Q2) 1 -16.365692 0.560560 0.000000 2 -16.302185 0.556353 0.000000 3 -16.232590 0.556657 0.000000 4 -16.434998 0.558215 0.000000 5 -16.335693 0.558336 0.000000 6 -16.312393 0.557174 0.000000 7 -16.377197 0.556313 0.000000 8 -17.007996 0.561354 0.000000 Albedos ranging from 0-100 percent are calculated by the following equation: ALB = VR * AF Where: ALB = Albedo (ranging from 0.0 to 0.100) VR = Visible Radiance AF = Albedo Factor Infrared Infrared counts are calibrated by the SPS in real- time to obtain true radiance values. The SPS also applies bias and gain scaling factors to the 10- bit imager and 13-bit sounder true radiance's to obtain 10-bit and 16-bit scaled radiance values respectively. The scaled radiance's and scaling factors are transmitted to users in the GVAR data stream. True radiance's are obtained from the scaled radiance's by the following equation: R = (SR - B) / G Where: R = True radiance (mW/[m2-sr-cm-1]) SR = Scaled radiance B = Bias scaling factor G = Gain scaling factor Radiances are converted to brightness temperatures via the following equation: TEMP = (TT - TC1) / TC2 Where: TEMP = Brightness temperature in degrees K TT = FK2 / alog(expn) expn = (FK1 / R) + 1 TC1 and TC2 are channel dependent bias and gain adjustments to the inverse Planck function to account for the spectral bandwidth of the channel. FK1, FK2, TC1, and TC2 are channel dependent coefficients as follows: GOES-8 Imager ( New Numbers 19 Dec 1995 ) CH FK1 FK2 TC(1) TC(2) 2 199986.19 3684.27 0.6357 0.9991 3 38792.39 2132.72 0.6060 0.9986 4 9737.93 1345.37 0.3735 0.9987 5 6944.64 1201.99 0.2217 0.9992 GOES-9 Imager ( 19 Dec 1995 ) CH FK1 FK2 TC(1) TC(2) 2 198807.83 3677.02 0.5864 0.9992 3 38732.41 2131.62 0.4841 0.9989 4 9717.21 1344.41 0.3622 0.9988 5 6899.47 1199.38 0.2014 0.9992 GOES-10 Imager ( Jul 1998 ) CH FK1 FK2 TC(1) TC(2) 2 198406.98 3674.55 0.6222 0.9991 3 39086.36 2138.09 0.6144 0.9986 4 9774.44 1347.05 0.2779 0.9991 5 6828.63 1195.26 0.2114 0.9992 For ISCCP the 10 bit counts are further scaled into 8 bit counts in a linear fashion with the scale factors listed in the ISCCP header section. Also to simplify translation problems, the block 0 coefficients are decoded and stored as ASCII in the ISCCP header. Following are sample numbers extracted from GOES-8 data on 1994 day 250. index real value VIS 0 -15.411600 Bias detector 1 1 -15.304400 2 2 -15.389000 3 3 -15.268400 4 4 -15.311100 5 5 -15.273000 6 6 -15.353400 7 7 -15.330000 8 8 0.552808 Scale Q1 9 0.550187 10 0.553975 11 0.550833 12 0.550946 13 0.552190 14 0.550459 15 0.550728 16 0.000000 Second order Q2 17 0.000000 18 0.000000 19 0.000000 20 0.000000 21 0.000000 22 0.000000 23 0.000000 IR 25 15.685400 side 1 bias channel 4 26 15.333200 5 27 68.216705 2 28 29.128693 3 29 15.685400 side 2 bias 30 15.333200 31 68.216705 32 29.128693 33 5.228500 side 1 scale factors 34 5.027300 35 227.388901 36 38.838303 37 5.228500 side 2 scale factors 38 5.027300 39 227.388901 40 38.838303 The following equations should then apply to the ISCCP 8 bit numbers stored on the tapes. I am not sure what the scaled albedo represents. A C routine to print out the 8 bit to Temperature or Radiance follows. It decodes the cal coefficients from the ASCII values coded into the header. These numbers are also available in GOULD real numbers in the standard MCIDAS calibration block. But the Mcidas numbers do not reflect the conversion to 8 bits and the scaling. I might try to fix this so that Mcidas can convert counts into physical units. As of 10/12/94 that is not implemented. void caltab(ISCHEAD *outisc) { /* use the calibration numbers to print out a list of temperatures and albedoes */ short int c,c8,j,out_sensor[6]; float B,Q1,Q2,VR,ALB,AF,G,FK1,FK2,TC1,TC2,TT,TEMP,R,expn,SR; float xcal10[50]; float scale,offset; int in,n75,i; n75=sizeof(outisc->cal10)/12; B=0.F; Q1=0.F; Q2=0.F; /* sprintf(outisc->sens[in],"%d %d %d %d %d %d ",*/ for (i=0; i < n75; i++) { sscanf(outisc->cal10[i],"%f ",&xcal10[i]); printf(" read cal %f %d \n",xcal10[i],i); } sscanf(outisc->sens[0],"%d %d %d %d %d %d",&out_sensor[0], &out_sensor[1],&out_sensor[2],&out_sensor[3], &out_sensor[4],&out_sensor[5]); for (i=0 ; i< 6; i++) printf(" %d",out_sensor[i]); printf(" outsen \n"); for (i=0 ; i< 4; i++) /* average over the 4 sensors included in the average */ { /* j = inp[0]->sensor[i+2]-1; */ j = out_sensor[i+2]-1; printf(" j %d %f",j,xcal10[j]); B = B + xcal10[j]; Q1 = Q1 + xcal10[j+8]; Q2 = Q2 + xcal10[j+16]; } AF = xcal10[24]; B=B/4.F; Q1=Q1/4.F; Q2=Q2/4.F; sscanf(outisc->scale[0],"%f",&scale); sscanf(outisc->offset[0],"%f",&offset); printf(" B,Q, %f %f %f %f %f %f \n",B,Q1,Q2,AF,scale,offset); for (c8 = 0; c8 < 256 ; c8++) { c = c8 / scale + offset +1.5F;/* 2. for round off */ VR = Q2*c*c + Q1*c + B; if(VR > 0.0F) ALB = VR * AF; else { VR=0.F; ALB=0.F; } printf(" %d %d %f %f \n",c8,c,VR,ALB); } for (in=1; in < 5; in++) { switch (in) { case 1: B = xcal10[27]; G = xcal10[35]; FK1=199943.56F; FK2=3684.01F; TC1=0.6514F; TC2=0.9990F; break; case 2: B = xcal10[28]; G = xcal10[36]; FK1=38782.06F; FK2=2132.53F; TC1=0.5891F; TC2=0.9986F; break; case 3: B = xcal10[25]; G = xcal10[33]; FK1=9740.34F; FK2=1345.48F; TC1=0.3919F; TC2=0.9987F; break; case 4: B = xcal10[26]; G = xcal10[34]; FK1=6945.75F; FK2=1202.05F; TC1=0.2372F; TC2=0.9991F; break; } printf(" channel %d \n",in+1); sscanf(outisc->scale[in],"%f",&scale); sscanf(outisc->offset[in],"%f",&offset); printf(" %d %f %f %f %f \n",in,B,G,scale,offset); for (c8 = 0; c8 < 256; c8++) { SR = c8 / scale + offset + 1.5F; /* SR = c8 / inp[in]->scle[0] + inp[in]->scle[1]+1.5F; */ /* first convert 8 bit back to 10 bit with proper round off */ R = (SR - B) / G; if(R > 0.0F) { expn = (FK1 / R) + 1.F; TT = FK2 / log(expn); TEMP = (TT - TC1) / TC2; } else { TEMP=0.F; R=0.F; } printf(" %d %f %f %f \n",c8,SR,R,TEMP); } } } D. Block 0. Refer to NESDIS documentation. Reference to the block 0 NESDIS documentation for a fuller explanation of the contents of the parameters. This provides the raw information about navigation, calibration and instrument status. It is used to derive the other header components. The real numbers are somewhat inconvenient being provided in GOULD format. There should be enough information in the other headers so that one does not need this information but this is provided for reference. All the block 0 BCD times have been 'flipped'. This was done so the MCIDAS and other routines at CIRA could access these easily. AFTER FEB 1, 1999 THE BLOCK 0 IS NOT FLIPPED. IF ONE IS USING THE BLOCK 0 INFORMATION PLEASE CHECK THE CONTENTS FOR FLIPPING (GOOD LUCK). THIS WAS INSTITUTED UP STREAM FROM THE ISCCP PROCESSING. GGG 2/99 E. Averaging information special for ISCCP. Long string of ASCII text containing the following information [ISCHEAD]. char text[80]; TEXT output file name char scale[7][12] GV10 = counts/scale+offset for each channel present char offset[7][12]; This is the 10 to 8 bit conversion char sampx[7][12]; Full resolution spacing between pixels char averx[7][12]; Number of pixels included in average char sampy[7][12]; Full resolution spacing between lines char avery[7][12]; Number of lines included in average char sens[7][80]; Sensor numbers included char primary_secondary[80]; Primary or secondary sensor set. char McCal[50][12]; Mcidas calibration header in ASCII. char news[80]; TEXT End of First Record of File Data The parameter (long int pri_key_nav;) points to the first byte of the data section for the disk files. The following bytes in the disk file are arranged as [80 byte header, (data ch1,ch2,ch3,ch4..)]. Mcidas will not work directly from the tape. To use MCIDAS one needs to read the data from tape striping off the 8 byte physical record headers and writing out the data as a long string of bytes [called a stream_lf file in VAX conventions]. This file can also be accessed in C or FORTRAN from a PC. Some of the programs even work on my home PC using the NT Microsoft FORTRAN and C compilers. NOTICE THAT THE 3480 TAPE FORMAT WITH FIXED BLOCK SIZES DOES NOT INCLUDE THE PHYSICAL HEADER FILES. 10 LOGICAL RECORDS ARE LOCATED IN EACH BLOCK ON THE TAPE. HOPEFULLY THIS WILL SIMPLIFY READING THE TAPE. GGG 2/99 For the tape each physical record starts with an 8 byte header containing 4 16 bit words [little endian]. This is followed by many logical records with each of which starts with an 80 byte header followed by interlaced sets of pixels for one scan line. This is repeated over and over until the end of file. prefi2(1)=number of bytes in this header prefi2(2)=number of logical records or scan lines to follow prefi2(3)=number of bytes in this tape record prefi2(4)=logical OR of the 16 bit groups for the whole record which provides a parity check { ISC_LINE_PREFIX, da(num_chan,nx) }*prefi2(2) The 80 byte line header looks like the following. This is a generalization of the individual channel headers so some of the parameters do not apply. Of most significance will be the val_code and the time. The biggest problem for FORTRAN users will be the time. One needs to unpack each 4 bit group. typedef struct { unsigned short linesize; /* 16+nwide*num_chan+64 */ unsigned short line_number; /* scan line number full res units*/ unsigned short west; /* west edge in vis pixel units */ unsigned short nwide; /* number of pixels in one channel */ unsigned short chan_id; /* channel id (100+num_chan) */ unsigned short xave; /* visible average interval in x */ unsigned short num_chan; /* number of channels */ unsigned short xstep; /* step size in full vis pixel units */ long val_code; /* good data code (0=good, other=some bad)*/ IMGR_SCAN_STATUS_T imgr; MC_BCD_TIME_T time; /* 4 bits/digit = time from satellite */ GVAR_HDR_ISC blk_hdr; BLOCKS_1TO10_LINE_DOC_2BYTE_ISC imgr_2; } ISC_LINE_PREFIX; ______________________following is a byte map of the headers_____ ______________the navigation information is only useful in the__ ____context of the program to use it. which is listed far below___ /* Byte map of the ISCCP GOES header. */ #include #include #include #include #include typedef struct /* all the BCD times have this form [8 bytes total] each group of 4 bits needs to be extracted to find the digit of the time In FORTRAN use mod(i,4) and i/4 or shifts and masks to break this up. Sample code is supplied else where. */ { unsigned char hour_10 : 4; unsigned char day_1 : 4; unsigned char day_10 : 4; unsigned char day_100 : 3; unsigned char flywheel : 1; unsigned char year_1 : 4; unsigned char year_10 : 4; unsigned char year_100 : 4; unsigned char year_1000 : 4; unsigned char msec_1 : 4; unsigned char msec_10 : 4; unsigned char msec_100 : 4; unsigned char sec_1 : 4; unsigned char sec_10 : 4; unsigned char min_1 : 4; unsigned char min_10 : 4; unsigned char hour_1 : 4; } MC_BCD_TIME_T; typedef struct /* something to do with the nav package 8 bytes */ { long mag; long ang; } MC_NAV_ONA_ATT_SINU_T; typedef struct /* 20 bytes nav info */ { long ord_apl; long ord_1st; long mag; long ang; long ang_frm_ep; } MC_NAV_ONA_ATT_MONO_T; typedef struct /* nav info 16+120+4+80 bytes*/ { long exp_mag; long exp_time; long mean_att; long num_sinu; MC_NAV_ONA_ATT_SINU_T sinu[15]; long num_mono; MC_NAV_ONA_ATT_MONO_T mono[4]; } MC_NAV_ONA_ATT_T; /* now begin looking to the right for a list of the byte positions and there corresponding parameter name and other info */ typedef struct /* the first 256 bytes */ { /* little endian byte order */ long int area_status; /* 1 4 */ long int version_num; /* 5 8 */ long int sat_id_num; /* 9 12 */ long int img_date; /* 13 16 yyddd */ long int img_time; /* 17 20 hhmmss */ long int north_bound; /* 21 24 full res vis units */ long int west_vis_pixel; /* 25 28 full res vis units */ long int z_coor; long int num_line; /* 33 36 */ long int num_elem; /* 37 40 */ long int bytes_per_pixel; /* 41 44 generally =1 */ long int line_res; /* 45 48 in full res vis units */ long int elem_res; /* 49 52 in full res vis units */ long int num_chan; /* 53 56 num of types interlaced This can vary 4=IR only 5=vis+IR 5=IR+SD #4, 7=Vis+IR+SDIR+SDVIS */ long int num_byte_ln_prefix; /* 57 60 length of scan line header on every logical data record [=80] */ long int proj_num; long int creation_date; long int creation_time; long int sndr_filter_map; /* 73 76 every bit indicates a different channel = sum (2**(chan number-1)) thus if channels 1,2,3,4,5 are present = 1+2+4+8+16=31 */ long int img_id_num; long int id[4]; char comment[32]; /* 97 128 ASCII comment */ long int pri_key_calib; /* 129 132 location of calibration block in header these are the GOULD reals duplicated in ASCII later */ long int pri_key_nav; /* 133 136 length of all headers combined = location of data start (13272) */ long int sec_key_nav; /* 137 140 length of AREA header (256) */ long int val_code; /* 141 144 good data code [0] */ long int pdl[8]; long int band8; long int act_img_date; long int act_img_time; long int act_start_scan; long int len_prefix_doc; long int len_prefix_calib; long int len_prefix_lev; char src_type[4]; char calib_type[4]; long int avg_or_sample; long int poes_signal; long int poes_up_down; char orig_src_type[4]; long int reserved[7]; /* .. 256 */ } MCIDAS_DATDIR_AREA_HDR_T; typedef struct { /* x=sec_key_nav=256 */ float cal[128]; /* x+1 x+512 GOULD Real numbers */ /* this is duplicated in ASCII later*/ } MCIDAS_CAL_HDR; typedef struct /* y = sec_key_nav+512 = 768 A FORTRAN version of this structure is supplied with the sample navigation program. */ { char nav_type[4]; char ID [4]; long imc_status; /* 0:on 1024:off */ long z1[2]; long int ref_rad_dist; /* y+25 y+28 */ long int ref_lat; /* y+29 y+32 */ long int ref_orb_yaw; /* y+33 y+36 */ long int ref_att_roll; /* y+37 y+40 */ long int ref_att_pitch; /* y+41 y+44 */ long int ref_att_yaw; /* y+45 y+48 */ MC_BCD_TIME_T epoch_time; /* y+49 y+56 16 4 bit groups */ long int start_time; /* y+57 y+60 */ long int IMC_corr_roll; /* y+61 y+64 */ long int IMC_corr_pitch; /* y+65 y+68 */ long int IMC_corr_yaw; /* y+69 y+72 */ long int ref_long_change[13]; /* y+73 y+124 */ long int ref_rad_dist_change[11]; /* y+125 y+168 */ long int sine_lat[9]; /* y+169 y+204 */ long int sine_orb_yaw[9]; /* y+205 y+240 */ long int solar_rate; /* y+241 y+244 */ long int exp_start_time; /* y+245 y+248 */ MC_NAV_ONA_ATT_T roll_att; /* y+249 y+468 */ long int spare2[10]; /* y+469 y+508 */ char more1[4]; /* y+509 y+512 */ char gvar1[4]; /* y+513 y+516 */ MC_NAV_ONA_ATT_T pitch_att; /* y+517 y+736 */ MC_NAV_ONA_ATT_T yaw_att; /* y+737 y+956 */ long int spare3[16]; /* y+957 y+1020 */ char more2[4]; /* y+1021 y+1024*/ char gvar2[4]; /* y+1025 y+1028 */ MC_NAV_ONA_ATT_T roll_misalgn; /* y+1029 y+1248 */ MC_NAV_ONA_ATT_T pitch_misalgn; /* y+1249 y+1468 */ long int img_date; /* y+1269 y+1472 */ long int img_time; /* y+1473 y+1476*/ long int instr; /* y+1477 y+1480 */ long int spare4[13]; /* y+1481 y+1532 */ char more3[4]; /* y+1533 y+1536 */ char gvar3[4]; /* y+1537 y+1540 */ long int spare5[126]; /* y+1541 y+2044 */ char more4[4]; /* y+2045 y+2048 */ char gvar4[4]; /* y+2049 y+2052 */ long int spare6[127]; /* y+2053 y+2560 */ } MCIDAS_NX_NAV_GVAR_HDR_T; typedef struct { char dum[8040]; /* This info is described in stru.h and is a copy of the raw satellite transmission header included here for completeness in case we forgot something. Hopefully this is not needed */ } BLOCK_0_IMGR_DOC_T; typedef struct /* z = 11368 = location of isc header start */ { /* this is beyond the normal 1 channel gvar header */ char text[80]; /* z+1 z+80 */ char scale[7][12]; /* z+81 z+164 the scale factors for up to 7 channels f10.3 format */ char offset[7][12]; /* z+164 z+248 the offset for up to 7 channels f10.3 format */ char sampx[7][12]; /* z+249 z+332 sampling west-east */ char averx[7][12]; /* z+333 z+416 average interval in x */ char sampy[7][12]; /* z+417 z+500 sampling north-south */ char avery[7][12]; /* z+501 z+584 average interval in y */ char sens[7][80]; /* z+585 z+1144 sensor id's */ char primary_secondary[80]; /* z+1145 z+1224 primary or secondary sensors */ char cal10[50][12]; /* z+1225 z+1824 50 ASCII calibration terms translated from the GOULD real numbers */ char news[80]; /* z+1825 z+1904 information */ char calextra[50][12]; /* z+1905 z+2524 spares */ } ISCHEAD; typedef struct /* the header occurs in the following order */ { MCIDAS_DATDIR_AREA_HDR_T mc; /* 1> 256 bytes */ MCIDAS_CAL_HDR cal; /* 256+1>256 +512 bytes */ MCIDAS_NX_NAV_GVAR_HDR_T nav; /* 768+1>768 +2560 bytes */ BLOCK_0_IMGR_DOC_T blk0; /* 3328+1>3328 +8040 bytes */ ISCHEAD isc; /* 11968+1>11968 +1904 bytes */ } ALL_MCHD; void caltab(ISCHEAD *outisc) { /* use the calibration numbers to print out a list of temperatures and albedoes */ /* move this into a separate routine */ short int c,c8,j,out_sensor[6]; float B,Q1,Q2,VR,ALB,AF,G,FK1,FK2,TC1,TC2,TT,TEMP,R,expn,SR; float B4,G4; float xcal10[50]; float scale,offset; int in,n75,i; n75=sizeof(outisc->cal10)/12; B=0.F; Q1=0.F; Q2=0.F; /* sprintf(outisc->sens[in],"%d %d %d %d %d %d ",*/ for (i=0; i < n75; i++) { sscanf(outisc->cal10[i],"%f ",&xcal10[i]); printf(" read cal %f %d \n",xcal10[i],i); /* ????? */ } sscanf(outisc->sens[0],"%d %d %d %d %d %d",&out_sensor[0], &out_sensor[1],&out_sensor[2],&out_sensor[3], &out_sensor[4],&out_sensor[5]); for (i=0 ; i< 6; i++) printf(" %d",out_sensor[i]); printf(" outsen \n"); for (i=0 ; i< 4; i++) /* average over the 4 sensors included in the average */ { /* j = inp[0]->sensor[i+2]-1; */ j = out_sensor[i+2]-1; printf(" j %d %f",j,xcal10[j]); B = B + xcal10[j]; Q1 = Q1 + xcal10[j+8]; Q2 = Q2 + xcal10[j+16]; } AF = xcal10[24]; B=B/4.F; /* average over the 4 vis sensors used */ Q1=Q1/4.F; Q2=Q2/4.F; sscanf(outisc->scale[0],"%f",&scale); sscanf(outisc->offset[0],"%f",&offset); printf(" B,Q, %f %f %f \n %f %f %f \n",B,Q1,Q2,AF,scale,offset); for (c8 = 0; c8 < 256 ; c8++) { c = c8 / scale + offset +1.5F; /* 2. for round off */ VR = Q2 * c * c + Q1 * c + B; if(VR > 0.0F) ALB = VR * AF; else { VR=0.F; ALB=0.F; } printf(" %d %d %f %f \n",c8,c,VR,ALB); } printf(" 8 bit count| mean 10 bit count| radiance| albedo [sic] \n"); for (in=1; in < 5; in++) { switch (in) { case 1: B = xcal10[27]; G = xcal10[35]; FK1=199943.56F; FK2=3684.01F; TC1=0.6514F; TC2=0.9990F; break; case 2: B = xcal10[28]; G = xcal10[36]; FK1=38782.06F; FK2=2132.53F; TC1=0.5891F; TC2=0.9986F; break; case 3: B = xcal10[25]; G = xcal10[33]; FK1=9740.34F; FK2=1345.48F; TC1=0.3919F; TC2=0.9987F; B4=B; G4=G; break; case 4: B = xcal10[26]; G = xcal10[34]; FK1=6945.75F; FK2=1202.05F; TC1=0.2372F; TC2=0.9991F; break; } printf(" channel %d \n",in+1); sscanf(outisc->scale[in],"%f",&scale); sscanf(outisc->offset[in],"%f",&offset); printf(" %d %f %f %f %f \n",in,B,G,scale,offset); for (c8 = 0; c8 < 256; c8++) { SR = c8 / scale + offset + 1.5F; /* SR = c8 / inp[in]->scle[0] + inp[in]->scle[1]+1.5F; */ /* first convert 8 bit back to 10 bit with proper round off */ R = (SR - B) / G; if(R > 0.0F) { expn = (FK1 / R) + 1.F; TT = FK2 / log(expn); TEMP = (TT - TC1) / TC2; } else { TEMP=0.F; R=0.F; } printf(" %d %f %f %f \n",c8,SR,R,TEMP); } printf(" 8 bit count| mean 10 bit count| radiance| temperature\n"); } /* now do something for the s.d. values */ sscanf(outisc->scale[5],"%f",&scale); sscanf(outisc->offset[5],"%f",&offset); printf(" vis s.d. scale offset %f %f %f \n",scale,offset,Q1); /* retrieve the s.d. */ if( strstr(outisc->news,"sqrt(sqrt") == NULL) return; for (c8 = 0; c8 < 256; c8++) { SR = c8 / scale + offset; R = (SR * SR) * Q1; printf(" %d %f \n",c8,R); } printf(" s.d. vis radiance \n"); sscanf(outisc->scale[6],"%f",&scale); sscanf(outisc->offset[6],"%f",&offset); printf(" ch4 s.d. scale offset %f %f %f \n",scale,offset,G4); for (c8 = 0; c8 < 256; c8++) { SR = c8 / scale + offset; R = (SR * SR) * G4; printf(" %d %f \n",c8,R); } printf(" s.d. IR radiance \n"); } void main () /* the following simple program was used to verify the sizes and byte positions listed above you are welcome to use it*/ { FILE *fp; short int *hd; char *da; ALL_MCHD m; int i,j,k; printf(" sizeof mc %d \n ",sizeof(m.mc)); printf(" sizeof cal %d \n ",sizeof(m.cal)); printf(" sizeof nav %d \n ",sizeof(m.nav)); printf(" sizeof blk0 %d \n ",sizeof(m.blk0)); printf(" sizeof isc %d \n ",sizeof(m.isc)); printf(" sizeof all header %d \n",sizeof(m)); i=&m.nav; j=&m.nav.solar_rate; k=&m.nav.instr; printf(" loc %d %d %d %d \n",i,j-i+1,k-i+1); /* for a test lets read one file */ if ( (fp = fopen ("d:\\camp\\temp\\94297114.b27", "rb")) == NULL ) { printf ("\nCannot find file "); exit(1); } fread (&m,sizeof(m),1,fp); printf(" pri key calib %d \n",m.mc.pri_key_calib); printf(" pri key nav %d \n",m.mc.pri_key_nav); printf(" sec key nav %d \n",m.mc.sec_key_nav); printf(" len prefix doc %d \n",m.mc.len_prefix_doc); printf(" len prefix calib %d \n",m.mc.len_prefix_calib); printf(" len prefix lev %d \n",m.mc.len_prefix_lev); printf(" num byte ln prefix %d \n",m.mc.num_byte_ln_prefix); printf(" text %s \n",m.isc.text); printf(" news %s \n",m.isc.news); /* now use the calibration table to print out the conversion between bytes and counts for this case */ caltab(&m.isc); /* now we can read some data for fun from a disk file using tape input requires one keep track of the physical record headers as well */ i=m.mc.num_byte_ln_prefix/2; /* get the line header length */ hd = (short int *) malloc(i); fread(hd,i,2,fp); /* read the line header */ for (j =0 ; j < 8; j++) printf(" %d",*(hd+j)); /* print the first 8 numbers */ printf(" line header \n"); /* there are two ways to calculate the length of the data record */ i=*(hd) - m.mc.num_byte_ln_prefix; /* from the line header */ j=m.mc.bytes_per_pixel*m.mc.num_chan*m.mc.num_elem; /* from the file header */ printf(" line length %d %d \n",i,j); da = (char *) malloc(i); fread(da,i,1,fp); /* now loop over the line header and data to get the image da is actually a array da[m.mc.num_chan][m.mc.num_elem] */ /* the following is a copy of the output for the above program sizeof mc 256 sizeof cal 512 sizeof nav 2560 sizeof blk0 8040 sizeof isc 1904 sizeof all header 13272 loc 1298128 241 1477 0 pri key calib 6789 pri key nav 13272 sec key nav 256 len prefix doc 76 len prefix calib 0 len prefix lev 0 num byte ln prefix 80 text i:\camp\temp\94297114514i_garrett.B17 news s.d. = log10(var) 2684 -7 6481 372 107 7 7 48 line header line length 2604 2604 */ } ______________________The following is an IDL script for display____________ For those users with IDL the following .pro will read and display the data files from disk. function swap,lon i=lon byteorder,i,/lswap return,i end pro mcread,unit,nx,ny,ipzero,prefix,bytes,nch,ichanl,res,print=print ; ; Mcidas read header G.G. Campbell 6/94 CIRA/CSU ; The Mcidas data is organized as: ; HEADER first byte = 0 ; CALIBRATION first byte = ; NAVIGATION first byte = pri_key_calib ; DATA: prefix, pixels first byte = pri_key+nav ; prefix, pixels ; to use this open the file [position at byte 0 for multiple reads] x={mchead,area_status:0L,version_num:0L,sat_id_num:0L,img_date:0L, $ img_time:0L,north_bound:0L,west_vis_pixel:0L,z_coor:0L, $ num_line:0L,num_elem:0L,bytes_per_pixel:0L,line_res:0L, $ elem_res:0L,num_chan:0L,num_byte_ln_prefix:0L,proj_num:0L, $ creation_date:0L,creation_time:0L,sndr_filter_map:0L,img_id_num:0L, $ id:lonarr(4),comment:string(' ',format='(a32)'), $ pri_key_calib:0L, $ ; end of calibration block pri_key_nav:0L, $ ; end of navigation block sec_key_nav:0L,val_code:0L,pdl:lonarr(8),band8:0L,act_img_date:0L, $ act_img_time:0L,act_start_scan:0L,len_prefix_doc:0L, $ len_prefix_calib:0L, $ len_prefix_lev:0L,src_type:' ',calib_type:' ', $ avg_or_sample:0L,poes_signal:0L,poes_up_down:0L,orig_src_type:' ', $ reserved:lonarr(7)} readu,unit,x if(x.sat_id_num lt 0 or x.sat_id_num gt 1000) then begin print,' swap bytes needed',x.area_status x.area_status=swap(x.area_status) x.version_num=swap(x.version_num) x.sat_id_num=swap(x.sat_id_num) x.img_date=swap(x.img_date) x.img_time=swap(x.img_time) x.north_bound=swap(x.north_bound) x.west_vis_pixel=swap(x.west_vis_pixel) x.z_coor=swap(x.z_coor) x.num_line=swap(x.num_line) x.num_elem=swap(x.num_elem) x.bytes_per_pixel=swap(x.bytes_per_pixel) x.line_res=swap(x.line_res) x.elem_res=swap(x.elem_res) x.num_chan=swap(x.num_chan) x.num_byte_ln_prefix=swap(x.num_byte_ln_prefix) x.proj_num=swap(x.proj_num) x.creation_date=swap(x.creation_date) x.creation_time=swap(x.creation_time) x.sndr_filter_map=swap(x.sndr_filter_map) x.img_id_num=swap(x.img_id_num) x.id=swap(x.id) x.pri_key_calib=swap(x.pri_key_calib) x.pri_key_nav=swap(x.pri_key_nav) x.sec_key_nav=swap(x.sec_key_nav) x.val_code=swap(x.val_code) x.pdl=swap(x.pdl) x.band8=swap(x.band8) x.act_img_date=swap(x.act_img_date) x.act_img_time=swap(x.act_img_time) x.act_start_scan=swap(x.act_start_scan) x.len_prefix_doc=swap(x.len_prefix_doc) x.len_prefix_calib=swap(x.len_prefix_calib) x.len_prefix_lev=swap(x.len_prefix_lev) x.avg_or_sample=swap(x.avg_or_sample) x.poes_signal=swap(x.poes_signal) x.poes_up_down=swap(x.poes_up_down) endif if(n_elements(print) gt 0) then help,/structure,x ipzero=x.pri_key_nav print,' ipzero',ipzero,x.pdl,x.id,x.num_chan,x.sndr_filter_map nch=x.num_chan nx=x.num_elem ny=x.num_line res=[x.elem_res,x.line_res] prefix=x.num_byte_ln_pre bytes=x.bytes_per_pixel if(nch gt 1) then begin ncc=-1 ; must decode the sndr_filter_map ichanl=intarr(nch)-1 for k=0,30 do begin if(x.sndr_filter_map/long(2L^k) mod 2L) then begin ncc=ncc+1 ichanl(ncc)=k+1 print,' channels ',ncc,ichanl(ncc),k endif endfor endif else begin ichanl=x.img_id_num endelse print,nx,ny,ipzero,prefix,bytes,ichanl ; nx=width of image in pixels ; ny=height of image in lines ; ipzero=starting byte of image [including prefix] ; bytes=bytes per pixel [1 or 2] ; ichanl=image channel number [1,2,3,4,5, 21=s.d. of 1, 24=s.d. of 4] end pro mc ; ; sample script to read isccp Mcidas files and display each channel ; This should work for any MCIDAS file ; ; G.G. Campbell 8/94 CIRA/CSU ; fil='/d3/ggc/TEST.B27' print,' enter file name ' read,fil openr,unit,fil,/get_lun mcread,unit,nx,ny,ipzero,prefix,bytes,nch,ichanl,res,print=1 hd=intarr(prefix/2) dm=bytarr(nch,nx) img=bytarr(nx,ny,nch) point_lun,unit,ipzero j=ny more: readu, unit, hd,dm j=j-1 for k=0,nch-1 do begin img(*,j,k)=dm(k,*) endfor if(j gt 0) then goto,more CLOSE, unit FREE_LUN, unit for k=0,nch-1 do begin print,' channel ',ichanl(k) ; quick and dirty display of the image arrays ; opening a window with scroll bars would be a better method. tv,img(*,*,k) wait,5 endfor end _____________________________following are some C and FORTRAN codes________ for navigation and calibration. The navigation routines come directly from NESDIS and have had some rudimentary test. I have confidence that they will provide 4 km accuracy. ============================================================================== ============================================================================== /* Byte map of the ISCCP GOES header. G.G. Campbell 11/94 For code to utilize this information see the FORTRAN code G8NAV3.FOR to see examples. The navigation is just a large black box to me, but it uses the headers*/ #include #include #include #include #include typedef struct /* all the BCD times have this form [8 bytes total] each group of 4 bits needs to be extracted to find the digit of the time In FORTRAN use mod(i,4) and i/4 or shifts and masks to break this up. Sample code is supplied else where. */ { unsigned char hour_10 : 4; /* bits 1 4 */ unsigned char day_1 : 4; /* bits 5 8 */ unsigned char day_10 : 4; /* bits 9 12 */ unsigned char day_100 : 3; /* bits 13 15 */ unsigned char flywheel : 1; /* bit 16 */ unsigned char year_1 : 4; /* bits 17 20 */ unsigned char year_10 : 4; /* one had best test this routine */ unsigned char year_100 : 4; /* and look for dates between 1994 and 2000 */ unsigned char year_1000 : 4; unsigned char msec_1 : 4; unsigned char msec_10 : 4; unsigned char msec_100 : 4; unsigned char sec_1 : 4; unsigned char sec_10 : 4; /* these have been flipped from the raw transmission */ unsigned char min_1 : 4; /* for use on PC's and VAX's */ unsigned char min_10 : 4; unsigned char hour_1 : 4; } MC_BCD_TIME_T; /* total of 8 bytes */ typedef struct /* something to do with the nav package 8 bytes */ { long mag; long ang; } MC_NAV_ONA_ATT_SINU_T; typedef struct /* 20 bytes nav info */ { long ord_apl; long ord_1st; long mag; long ang; long ang_frm_ep; } MC_NAV_ONA_ATT_MONO_T; typedef struct /* nav info 16+120+4+80 bytes*/ { long exp_mag; long exp_time; long mean_att; long num_sinu; MC_NAV_ONA_ATT_SINU_T sinu[15]; long num_mono; MC_NAV_ONA_ATT_MONO_T mono[4]; } MC_NAV_ONA_ATT_T; /* now begin looking to the right for a list of the byte positions and there corresponding parameter name and other info */ typedef struct /* the first 256 bytes */ { /* little endian byte order */ long int area_status; /* 1 4 */ long int version_num; /* 5 8 */ long int sat_id_num; /* 9 12 */ long int img_date; /* 13 16 yyddd */ long int img_time; /* 17 20 hhmmss */ long int north_bound; /* 21 24 full res vis units */ long int west_vis_pixel; /* 25 28 full res vis units */ long int z_coor; long int num_line; /* 33 36 */ long int num_elem; /* 37 40 */ long int bytes_per_pixel; /* 41 44 generally =1 */ long int line_res; /* 45 48 in full res vis units */ long int elem_res; /* 49 52 in full res vis units */ long int num_chan; /* 53 56 num of types interlaced This can vary 4=IR only 5=vis+IR 5=IR+SD #4, 7=Vis+IR+SDIR+SDVIS */ long int num_byte_ln_prefix; /* 57 60 length of scan line header on every logical data record [=80] */ long int proj_num; long int creation_date; long int creation_time; long int sndr_filter_map; /* 73 76 every bit indicates a different channel = sum (2**(chan number-1)) thus if channels 1,2,3,4,5 are present = 1+2+4+8+16=31 */ long int img_id_num; long int id[4]; char comment[32]; /* 97 128 ASCII comment */ long int pri_key_calib; /* 129 132 location of calibration block in header these are the GOULD reals duplicated in ASCII later */ long int pri_key_nav; /* 133 136 length of all headers combined = location of data start (13272) */ long int sec_key_nav; /* 137 140 length of AREA header (256) */ long int val_code; /* 141 144 good data code [0] */ long int pdl[8]; long int band8; long int act_img_date; long int act_img_time; long int act_start_scan; long int len_prefix_doc; long int len_prefix_calib; long int len_prefix_lev; char src_type[4]; char calib_type[4]; long int avg_or_sample; long int poes_signal; long int poes_up_down; char orig_src_type[4]; long int reserved[7]; /* .. 256 */ } MCIDAS_DATDIR_AREA_HDR_T; typedef struct { /* x=sec_key_nav=256 */ float cal[128]; /* x+1 x+512 GOULD Real numbers */ /* this is duplicated in ASCII later*/ } MCIDAS_CAL_HDR; typedef struct /* y = sec_key_nav+512 = 768 A FORTRAN version of this structure is supplied with the sample navigation program. */ { char nav_type[4]; /* y+1 y+4 */ char IMC_status[4]; /* y+5 y+8 */ long int spare1[3]; /* y+9 y+20 */ long int ref_long; /* y+21 y+24 */ long int ref_rad_dist; /* y+25 y+28 */ long int ref_lat; /* y+29 y+32 */ long int ref_orb_yaw; /* y+33 y+36 */ long int ref_att_roll; /* y+37 y+40 */ long int ref_att_pitch; /* y+41 y+44 */ long int ref_att_yaw; /* y+45 y+48 */ MC_BCD_TIME_T epoch_time; /* y+49 y+56 16 4 bit groups */ long int start_time; /* y+57 y+60 */ long int IMC_corr_roll; /* y+61 y+64 */ long int IMC_corr_pitch; /* y+65 y+68 */ long int IMC_corr_yaw; /* y+69 y+72 */ long int ref_long_change[13]; /* y+73 y+124 */ long int ref_rad_dist_change[11]; /* y+125 y+168 */ long int sine_lat[9]; /* y+169 y+204 */ long int sine_orb_yaw[9]; /* y+205 y+240 */ long int solar_rate; /* y+241 y+244 */ long int exp_start_time; /* y+245 y+248 */ MC_NAV_ONA_ATT_T roll_att; /* y+249 y+468 */ long int spare2[10]; /* y+469 y+508 */ char more1[4]; /* y+509 y+512 */ char gvar1[4]; /* y+513 y+516 */ MC_NAV_ONA_ATT_T pitch_att; /* y+517 y+736 */ MC_NAV_ONA_ATT_T yaw_att; /* y+737 y+956 */ long int spare3[16]; /* y+957 y+1020 */ char more2[4]; /* y+1021 y+1024*/ char gvar2[4]; /* y+1025 y+1028 */ MC_NAV_ONA_ATT_T roll_misalgn; /* y+1029 y+1248 */ MC_NAV_ONA_ATT_T pitch_misalgn; /* y+1249 y+1468 */ long int img_date; /* y+1269 y+1472 */ long int img_time; /* y+1473 y+1476*/ long int instr; /* y+1477 y+1480 */ long int spare4[13]; /* y+1481 y+1532 */ char more3[4]; /* y+1533 y+1536 */ char gvar3[4]; /* y+1537 y+1540 */ long int spare5[126]; /* y+1541 y+2044 */ char more4[4]; /* y+2045 y+2048 */ char gvar4[4]; /* y+2049 y+2052 */ long int spare6[127]; /* y+2053 y+2560 */ } MCIDAS_NX_NAV_GVAR_HDR_T; typedef struct { char dum[8040]; /* This info is described in stru.h and is a copy of the raw satellite transmission header included here for completeness in case we forgot something. Hopefully this is not needed*/ } BLOCK_0_IMGR_DOC_T; typedef struct /* z = 11368 = location of isc header start */ { /* this is beyond the normal 1 channel gvar header */ char text[80]; /* z+1 z+80 */ char scale[7][12]; /* z+81 z+164 the scale factors for up to 7 channels f10.3 format */ char offset[7][12]; /* z+164 z+248 the offset for up to 7 channels f10.3 format */ char sampx[7][12]; /* z+249 z+332 sampling west-east */ char averx[7][12]; /* z+333 z+416 average interval in x */ char sampy[7][12]; /* z+417 z+500 sampling north-south */ char avery[7][12]; /* z+501 z+584 average interval in y */ char sens[7][80]; /* z+585 z+1144 sensor id's */ char primary_secondary[80]; /* z+1145 z+1224 primary or secondary senors */ char cal10[50][12]; /* z+1225 z+1824 50 ASCII calibration terms translated from the GOULD real numbers */ char news[80]; /* z+1825 z+1904 information */ char extra[50][12]; /* z+1905 z+2504 spare */ } ISCHEAD; typedef struct { char chd[128]; /* optional */ } CIRA_HD; /* cira extra info */ typedef struct /* the header occurs in the following order */ { MCIDAS_DATDIR_AREA_HDR_T mc; /* 1> 256 bytes */ MCIDAS_CAL_HDR cal; /* 256+1>256 +512 bytes */ MCIDAS_NX_NAV_GVAR_HDR_T nav; /* 768+1>768 +2560 bytes */ BLOCK_0_IMGR_DOC_T blk0; /* 3328+1>3328 +8040 bytes */ CIRA_HD cira_hd; /* 11368+1>11368 + 128 bytes (?) */ ISCHEAD isc; /* 11368+1>11368 +2504 bytes or 11492+1>11492 +2504 */ } ALL_MCHD; typedef struct { unsigned char south_north : 1; /* refer to the NESDIS documentation */ unsigned char east_west : 1; /* for an explanation of these bits */ unsigned char prio2_frame : 1; unsigned char prio1_frame : 1; unsigned char pixels_lost : 1; unsigned char frame_break : 1; unsigned char frame_end : 1; unsigned char frame_start : 1; /* byte 1 */ unsigned char ir_calib_active : 1; unsigned char vis_norm_active : 1; unsigned char secondary_active : 1; unsigned char star_sense_break : 1; unsigned char lost_telemetry : 1; unsigned char lost_trailer : 1; unsigned char lost_header : 1; unsigned char IMC_active : 1; /* byte 2*/ unsigned char ir_det7_not_valid : 1; unsigned char ir_det6_not_valid : 1; unsigned char ir_det5_not_valid : 1; unsigned char ir_det4_not_valid : 1; unsigned char ir_det3_not_valid : 1; unsigned char ir_det2_not_valid : 1; unsigned char ir_det1_not_valid : 1; unsigned char spare1 : 1; /* byte 3 */ unsigned char vis_det8_not_valid : 1; unsigned char vis_det7_not_valid : 1; unsigned char vis_det6_not_valid : 1; unsigned char vis_det5_not_valid : 1; unsigned char vis_det4_not_valid : 1; unsigned char vis_det3_not_valid : 1; unsigned char vis_det2_not_valid : 1; unsigned char vis_det1_not_valid : 1; /* byte 4*/ } IMGR_SCAN_STATUS_T; typedef struct { unsigned char block_id; unsigned char word_size; unsigned short word_count; unsigned short prod_id; unsigned char repeat_flag; unsigned char version; unsigned char data_valid; unsigned char asc_bin; unsigned char spare1; unsigned char range; unsigned short block_count; unsigned short spare2; } GVAR_HDR_ISC; /* 16 bytes */ typedef struct { short sat_id; /* SPCID */ short sps_source; /* SPSID */ short active_det_set; /* LSIDE */ short det_num; /* LIDET */ short channel; /* LICHA */ short imgr_stat1; /* L1SCAN */ short imgr_stat2; /* L2SCAN */ short pixel_offset; /* LZCOR */ long scan; /* RISCT Relative scan line number from start of frame in 8 km units */ long num_pixels; /* LPIXELS */ long num_words; /* LWORDS */ short spare[2]; /* spare - not used */ } BLOCKS_1TO10_LINE_DOC_2BYTE_ISC; /* 32 bytes */ typedef struct { unsigned short linesize; /* 16+nwide*num_chan+64 1 2 */ unsigned short line_number; /* scan number relative to frame 3 4 */ unsigned short west; /* west edge in vis pixel unit 5 6 */ unsigned short nwide; /* number of pixels in one channel 7 8 */ unsigned short chan_id; /* channel id (100+num_chan) 9 10 */ unsigned short xave; /* visible average interval in x 11 12 */ unsigned short num_chan; /* number of channels 13 14 */ unsigned short xstep; /* step size in vis pixel units 15 16 */ long val_code; /* good data code (!0 some bad) 17 20 */ IMGR_SCAN_STATUS_T imgr; /* status bits 21 24 */ MC_BCD_TIME_T time; /* 4 bits/digit = time 25 32 */ GVAR_HDR_ISC blk_hdr; /* line documentation 33 48 */ BLOCKS_1TO10_LINE_DOC_2BYTE_ISC imgr_2; /* documentation 49 80 */ } ISC_LINE_PREFIX; void caltab(ISCHEAD *outisc) { /* use the calibration numbers to print out a list of temperatures and albedoes */ /* move this into a separate routine */ short int c,c8,j,out_sensor[6]; float B,Q1,Q2,VR,ALB,AF,G,FK1,FK2,TC1,TC2,TT,TEMP,R,expn,SR; float B4,G4; float xcal10[50]; float scale,offset; int in,n75,i; n75=sizeof(outisc->cal10)/12; B=0.F; Q1=0.F; Q2=0.F; /* sprintf(outisc->sens[in],"%d %d %d %d %d %d ",*/ for (i=0; i < n75; i++) { sscanf(outisc->cal10[i],"%f ",&xcal10[i]); printf(" read cal %f %d \n",xcal10[i],i); } sscanf(outisc->sens[0],"%d %d %d %d %d %d",&out_sensor[0], &out_sensor[1],&out_sensor[2],&out_sensor[3], &out_sensor[4],&out_sensor[5]); for (i=0 ; i< 6; i++) printf(" %d",out_sensor[i]); printf(" outsen \n"); for (i=0 ; i< 4; i++) /* average over the 4 sensors included in the average */ { /* j = inp[0]->sensor[i+2]-1; */ j = out_sensor[i+2]-1; printf(" j %d %f",j,xcal10[j]); B = B + xcal10[j]; Q1 = Q1 + xcal10[j+8]; Q2 = Q2 + xcal10[j+16]; } AF = xcal10[24]; B=B/4.F; /* average over the 4 vis sensors used */ Q1=Q1/4.F; Q2=Q2/4.F; sscanf(outisc->scale[0],"%f",&scale); sscanf(outisc->offset[0],"%f",&offset); printf(" B,Q, %f %f %f \n %f %f %f \n",B,Q1,Q2,AF,scale,offset); for (c8 = 0; c8 < 256 ; c8++) { c = offset + c8 / scale +1.5F; /* 2. for round off */ VR = Q2 * c * c + Q1 * c + B; if(VR > 0.0F) ALB = VR * AF; else { VR=0.F; ALB=0.F; } printf(" %d %d %f %f \n",c8,c,VR,ALB); } printf(" 8 bit count| mean 10 bit count| radiance| albedo [sic] \n"); for (in=1; in < 5; in++) { switch (in) { case 1: B = xcal10[27]; G = xcal10[35]; FK1=199943.56F; FK2=3684.01F; TC1=0.6514F; TC2=0.9990F; break; case 2: B = xcal10[28]; G = xcal10[36]; FK1=38782.06F; FK2=2132.53F; TC1=0.5891F; TC2=0.9986F; break; case 3: B = xcal10[25]; G = xcal10[33]; FK1=9740.34F; FK2=1345.48F; TC1=0.3919F; TC2=0.9987F; B4=B; G4=G; break; case 4: B = xcal10[26]; G = xcal10[34]; FK1=6945.75F; FK2=1202.05F; TC1=0.2372F; TC2=0.9991F; break; } printf(" channel %d \n",in+1); sscanf(outisc->scale[in],"%f",&scale); sscanf(outisc->offset[in],"%f",&offset); printf(" %d %f %f %f %f \n",in,B,G,scale,offset); for (c8 = 0; c8 < 256; c8++) { SR = c8 / scale + offset + 1.5F; /* SR = c8 / inp[in]->scle[0] + inp[in]->scle[1]+1.5F; */ /* first convert 8 bit back to 10 bit with proper round off */ R = (SR - B) / G; if(R > 0.0F) { expn = (FK1 / R) + 1.F; TT = FK2 / log(expn); TEMP = (TT - TC1) / TC2; } else { TEMP=0.F; R=0.F; } printf(" %d %f %f %f \n",c8,SR,R,TEMP); } printf(" 8 bit count| mean 10 bit count| radiance| temperature\n"); } /* now do something for the s.d. values */ sscanf(outisc->scale[5],"%f",&scale); sscanf(outisc->offset[5],"%f",&offset); printf(" vis s.d. scale offset %f %f %f \n",scale,offset,Q1); /* retrieve the s.d. */ if( strstr(outisc->news,"sqrt(sqrt") == NULL) return; for (c8 = 0; c8 < 256; c8++) { SR = c8 / scale + offset; R = (SR * SR) * Q1; printf(" %d %f \n",c8,R); } printf(" s.d. vis radiance \n"); sscanf(outisc->scale[6],"%f",&scale); sscanf(outisc->offset[6],"%f",&offset); printf(" ch4 s.d. scale offset %f %f %f \n",scale,offset,G4); for (c8 = 0; c8 < 256; c8++) { SR = offset + c8 / scale ; R = (SR * SR) / G4; printf(" %d %f \n",c8,R); } printf(" s.d. IR radiance \n"); } void prntlhd(ISC_LINE_PREFIX *hd) { printf(" logical record size %d\n",hd->linesize); printf(" line_number (full res) %d\n",hd->line_number); printf(" west (full res unit) %d\n",hd->west); printf(" width in pixels %d\n",hd->nwide); printf(" channel bit code %d\n",hd->chan_id); printf(" xave vis av interval %d\n",hd->xave); printf(" number of channels %d\n",hd->num_chan); printf(" sampling interval %d\n",hd->xstep); printf(" relative scan 8km unit %d\n",hd->imgr_2.scan); } void main () /* the following simple program was used to verify the sizes and byte positions listed above you are welcome to use it*/ { FILE *fp; short int *hd; char *da; ALL_MCHD m; int i,j,k,ln; printf(" sizeof mc %d \n ",sizeof(m.mc)); printf(" sizeof cal %d \n ",sizeof(m.cal)); printf(" sizeof nav %d \n ",sizeof(m.nav)); printf(" sizeof blk0 %d \n ",sizeof(m.blk0)); printf(" sizeof cira_hd %d \n ",sizeof(m.cira_hd)); printf(" sizeof isc %d \n ",sizeof(m.isc)); printf(" sizeof all header %d \n",sizeof(m)); i=&m.nav; j=&m.nav.solar_rate; k=&m.nav.instr; printf(" loc %d %d %d %d \n",i,j-i+1,k-i+1); /* for a test lets read one file */ if ( (fp = fopen ("C:\\CAMP\\TEMP\\9433808.b27", "rb")) == NULL ) { printf ("\nCannot find file "); exit(1); } fread (&m,sizeof(m.mc),1,fp); printf(" pri key calib %d \n",m.mc.pri_key_calib); printf(" pri key nav %d \n",m.mc.pri_key_nav); printf(" sec key nav %d \n",m.mc.sec_key_nav); printf(" len prefix doc %d \n",m.mc.len_prefix_doc); printf(" len prefix calib %d \n",m.mc.len_prefix_calib); printf(" len prefix lev %d \n",m.mc.len_prefix_lev); printf(" num byte ln prefix %d \n",m.mc.num_byte_ln_prefix); printf(" north edge %d \n",m.mc.north_bound); printf(" west edge %d \n",m.mc.west_vis_pixel); if(sizeof(m.mc) != m.mc.pri_key_nav) printf(" missing cira hd \n"); fread (&m.cal,m.mc.pri_key_nav-sizeof(m.mc),1,fp); printf(" text %s \n",m.isc.text); printf(" news %s \n",m.isc.news); /* now use the calibration table to print out the conversion between bytes and counts for this case */ /* caltab(&m.isc); */ /* now we can read some data for fun from a disk file using tape input requires one to keep track of the physical record headers as well */ i = m.mc.num_byte_ln_prefix/2; /* get the line header length */ hd = (short int *) malloc(i); j = m.mc.bytes_per_pixel*m.mc.num_chan*m.mc.num_elem; /* from the file header */ da = (char *) malloc(j); for (k = 0; k < 10; k++) { fread(hd,i,2,fp); /* read the line header */ prntlhd(hd); ln = *(hd) - m.mc.num_byte_ln_prefix; /* from the line header */ printf(" line length %d %d \n",ln,j); fread(da,ln,1,fp); /* now loop over the line header and data to get the image da is actually a array like da[m.mc.num_chan][m.mc.num_elem] with pixels interlaced */ } /* the following is a copy of the output for the above program sizeof mc 256 sizeof cal 512 sizeof nav 2560 sizeof blk0 8040 sizeof cira_hd 128 sizeof isc 2504 sizeof all header 14000 loc 1362936 241 1477 0 pri key calib 1 pri key nav 14000 sec key nav 256 len prefix doc 76 len prefix calib 0 len prefix lev 0 num byte ln prefix 80 north edge 2880 west edge 9913 missing cira hd text d:\camp\temp\94322201514i_g.B17 news s.d. = sqrt(sqrt(var)) iadd= 2 logical record size 2124 line_number (full res) 177 west (full res unit) 9913 width in pixels 292 channel bit code 107 xave vis av interval 7 number of channels 7 sampling interval 48 relative scan 8km unit 23 line length 2044 2044 logical record size 2124 line_number (full res) 209 west (full res unit) 9913 width in pixels 292 channel bit code 107 xave vis av interval 7 number of channels 7 sampling interval 48 relative scan 8km unit 27 line length 2044 2044 logical record size 2124 line_number (full res) 241 west (full res unit) 9913 width in pixels 292 channel bit code 107 xave vis av interval 7 number of channels 7 sampling interval 48 relative scan 8km unit 31 line length 2044 2044 logical record size 2124 line_number (full res) 273 west (full res unit) 9913 width in pixels 292 channel bit code 107 xave vis av interval 7 number of channels 7 sampling interval 48 relative scan 8km unit 35 */ } ============================================================================== ============================================================================== /* * +------------------+ * | STRUC.H | * +------------------+ * * Colorado State University * CIRA (Cooperative Institute for Research in the Atmosphere) * Foothills Campus * Fort Collins, Colorado 80523 * (303) 491-8448 * * * Written by: Duane Whitcomb, Russell Gartner * Date: December 29, 1993 * * Modified by: * Date: * Reason: * * * The following structures serve as templates for GVAR data. */ /******************************************************************************/ typedef struct { unsigned char type; unsigned char place_holder[3]; unsigned char frame_info; unsigned char frame_num; unsigned short actlen; } INGBUF_T; /******************************************************************************/ #define DWELL_LEN 5 #define DIR_LEN 64 #define EXT_LEN 30 #define NAME_LEN 255 #define BUF_SIZE (64 * 1024) /* Must be 64K */ #define CHAR_LINE_SIZE 80 #define LINE_PREFIX_SIZE 80 #define BYTES_PER_ELEMENT 2 /******************************************************************************/ #define SMALL_BUF_SIZE 255 #define STRUC_VALID 0xFACE typedef struct { long valid; /* struct FAB fab; struct RAB rab; */ char filename[NAME_LEN]; char prv_buf[SMALL_BUF_SIZE]; } FILE_STRUC_T; typedef struct { unsigned long ctx; short on; } LOG_INFO_T; typedef struct { LOG_INFO_T num[5]; } LOG_T; #define MIN_HEIGHT 1 #define MAX_HEIGHT 100000 #define MIN_WIDTH 1 #define MAX_WIDTH 100000 #define LOW_CHAN_IMGR 1 #define HIGH_CHAN_IMGR 5 #define MIN_LINE_IMGR 0 #define MAX_LINE_IMGR 30000 /* 15784 */ #define MIN_NUM_LINE_IMGR MIN_LINE_IMGR #define MAX_NUM_LINE_IMGR MAX_LINE_IMGR #define MIN_LINE_RES_IMGR MIN_HEIGHT #define MAX_LINE_RES_IMGR MAX_HEIGHT #define MIN_ELEM_IMGR 0 #define MAX_ELEM_IMGR 30680 #define MIN_NUM_ELEM_IMGR MIN_ELEM_IMGR #define MAX_NUM_ELEM_IMGR MAX_ELEM_IMGR #define MIN_ELEM_RES_IMGR MIN_WIDTH #define MAX_ELEM_RES_IMGR MAX_WIDTH #define LOW_CHAN_SNDR 0 #define HIGH_CHAN_SNDR 19 #define MIN_LINE_SNDR 0 #define MAX_LINE_SNDR 1580 #define MIN_NUM_LINE_SNDR MIN_LINE_SNDR #define MAX_NUM_LINE_SNDR MAX_LINE_SNDR #define MIN_LINE_RES_SNDR MIN_HEIGHT #define MAX_LINE_RES_SNDR MAX_HEIGHT #define MIN_ELEM_SNDR 0 #define MAX_ELEM_SNDR 1758 #define MIN_NUM_ELEM_SNDR MIN_ELEM_SNDR #define MAX_NUM_ELEM_SNDR MAX_ELEM_SNDR #define MIN_ELEM_RES_SNDR MIN_WIDTH #define MAX_ELEM_RES_SNDR MAX_WIDTH /******************************************************************************/ typedef struct { unsigned char year_100 : 4; unsigned char year_1000 : 4; unsigned char year_1 : 4; unsigned char year_10 : 4; unsigned char day_10 : 4; unsigned char day_100 : 3; unsigned char time_code : 1; unsigned char hour_10 : 4; unsigned char day_1 : 4; unsigned char min_10 : 4; unsigned char hour_1 : 4; unsigned char sec_10 : 4; unsigned char min_1 : 4; unsigned char msec_100 : 4; unsigned char sec_1 : 4; unsigned char msec_1 : 4; unsigned char msec_10 : 4; } BCD_TIME_T; typedef struct { unsigned char hour_10 : 4; /* bits 1 4 */ unsigned char day_1 : 4; /* bits 5 8 */ unsigned char day_10 : 4; /* bits 9 12 */ unsigned char day_100 : 3; /* bits 13 15 */ unsigned char flywheel : 1; /* bit 16 */ unsigned char year_1 : 4; /* bits 17 20 */ unsigned char year_10 : 4; /* one had best test this routine */ unsigned char year_100 : 4; /* and look for dates between 1994 and 2000 */ unsigned char year_1000 : 4; unsigned char msec_1 : 4; unsigned char msec_10 : 4; unsigned char msec_100 : 4; unsigned char sec_1 : 4; unsigned char sec_10 : 4; /* these have been flipped from the raw transmission */ unsigned char min_1 : 4; /* for use on PC's and VAX's */ unsigned char min_10 : 4; unsigned char hour_1 : 4; } MC_BCD_TIME_T; /* total of 8 bytes */ /******************************************************************************/ typedef struct { float mag_sinu; float phase_ang_sinu; } ONA_REPEAT_SINUSOID_T; typedef struct { long order_appl_sinu; long order_mono_sinu; float mag_mono_sinu; float phase_ang_sinu; float ang_from_epoch; } ONA_REPEAT_MONOMIAL_T; typedef struct { float exp_mag; float exp_time_const; float mean_att_ang_const; long num_sinu_per_angle; ONA_REPEAT_SINUSOID_T sinusoid[15]; long num_mono_sinu; ONA_REPEAT_MONOMIAL_T monomial[4]; } ONA_REPEAT_T; typedef struct { char IMC_id[4]; char spare1[12]; float ref_long; float ref_rad_dist; float ref_lat; float ref_orb_yaw; float ref_att_roll; float ref_att_pitch; float ref_att_yaw; MC_BCD_TIME_T epoch_time; float start_time; float IMC_corr_roll; float IMC_corr_pitch; float IMC_corr_yaw; float ref_long_change[13]; float ref_rad_dist_change[11]; float sine_lat[9]; float sine_orb_yaw[9]; float solar_rate; float exp_start_time; ONA_REPEAT_T roll_att; ONA_REPEAT_T pitch_att; ONA_REPEAT_T yaw_att; ONA_REPEAT_T roll_misalgn; ONA_REPEAT_T pitch_misalgn; } ONA_T; /******************************************************************************/ #define HDR_SIZE (sizeof (GVAR_HDR_T)) #define HDR_SIZE_3 (sizeof (GVAR_HDR_T) * 3) #define HDR_GVAR_BLOCK_0 240 #define HDR_GVAR_BLOCK_1 1 #define HDR_GVAR_BLOCK_2 2 #define HDR_GVAR_BLOCK_3 3 #define HDR_GVAR_BLOCK_4 4 #define HDR_GVAR_BLOCK_5 5 #define HDR_GVAR_BLOCK_6 6 #define HDR_GVAR_BLOCK_7 7 #define HDR_GVAR_BLOCK_8 8 #define HDR_GVAR_BLOCK_9 9 #define HDR_GVAR_BLOCK_10 10 #define HDR_GVAR_BLOCK_11 11 #define HDR_IDLE_BLOCK 15 #define HDR_6_BIT_WORD 6 #define HDR_8_BIT_WORD 8 #define HDR_10_BIT_WORD 10 #define HDR_NO_DATA 0 #define HDR_AAA_IR_DATA 1 #define HDR_AAA_VIS_DATA 2 #define HDR_GVAR_IMGR_DOC 3 #define HDR_GVAR_IMGR_IR_DATA 4 #define HDR_GVAR_IMGR_VIS_DATA 5 #define HDR_GVAR_SNDR_DOC 6 #define HDR_GVAR_SNDR_SCAN_DATA 7 #define HDR_GVAR_COMPEN_DATA 8 #define HDR_GVAR_TELEM_STAT 9 #define HDR_GVAR_AUX_TEXT 10 #define HDR_GIMTACS_TEXT 11 #define HDR_SPS_TEXT 12 #define HDR_AAA_SNDG_PROD 13 #define HDR_GVAR_ECAL_DATA 14 #define HDR_GVAR_SPCLOOK_DATA 15 #define HDR_GVAR_BLKBDY_DATA 16 #define HDR_GVAR_CALCOEF 17 #define HDR_GVAR_VIS_NLUTS 18 #define HDR_GVAR_STARSENSE_DATA 19 typedef struct { unsigned char block_id; unsigned char word_size; unsigned short word_count; unsigned short prod_id; unsigned char repeat_flag; unsigned char version; unsigned char data_valid; unsigned char asc_bin; unsigned char spare1; unsigned char range; unsigned short block_count; unsigned char spare2[14]; unsigned short crc; } GVAR_HDR_T; /******************************************************************************/ #define BLOCK_0_SIZE (sizeof (BLOCK_0_IMGR_DOC_T)) typedef struct { unsigned char south_north : 1; /* refer to the NESDIS*/ unsigned char east_west : 1; /* for an explanation */ unsigned char prio2_frame : 1; unsigned char prio1_frame : 1; unsigned char pixels_lost : 1; unsigned char frame_break : 1; unsigned char frame_end : 1; unsigned char frame_start : 1; unsigned char ir_calib_active : 1; unsigned char vis_norm_active : 1; unsigned char secondary_active : 1; unsigned char star_sense_break : 1; unsigned char lost_telemetry : 1; unsigned char lost_trailer : 1; unsigned char lost_header : 1; unsigned char IMC_active : 1; unsigned char ir_det7_not_valid : 1; unsigned char ir_det6_not_valid : 1; unsigned char ir_det5_not_valid : 1; unsigned char ir_det4_not_valid : 1; unsigned char ir_det3_not_valid : 1; unsigned char ir_det2_not_valid : 1; unsigned char ir_det1_not_valid : 1; unsigned char spare1 : 1; unsigned char vis_det8_not_valid : 1; unsigned char vis_det7_not_valid : 1; unsigned char vis_det6_not_valid : 1; unsigned char vis_det5_not_valid : 1; unsigned char vis_det4_not_valid : 1; unsigned char vis_det3_not_valid : 1; unsigned char vis_det2_not_valid : 1; unsigned char vis_det1_not_valid : 1; } IMGR_SCAN_STATUS_T; typedef struct { float pri_det[7]; float sec_det[7]; } IMGR_DOC_CAL_ARR_T; typedef struct { float base_plate[4]; } IMGR_DOC_BASE_PLATE_T; typedef struct { IMGR_DOC_BASE_PLATE_T pri_det[7]; IMGR_DOC_BASE_PLATE_T sec_det[7]; } IMGR_DOC_CAL_TAB_T; typedef struct { float det[8]; } IVIS_DET_T; typedef struct { float det[7]; } IIR_DET_T; typedef struct { IIR_DET_T pri; IIR_DET_T sec; } IALL_IR_DET_T; typedef struct { float bp[4]; } IBASE_PLATE_T; typedef struct { IBASE_PLATE_T pri_det[7]; IBASE_PLATE_T sec_det[7]; } IIR_BP_T; typedef struct { unsigned char sat_id; /* SPCID */ unsigned char sps_id; /* SPSID */ IMGR_SCAN_STATUS_T stat; /* ISCAN */ unsigned char det_sub_matrix[16]; /* IDSUB */ MC_BCD_TIME_T cur_sps_time; /* TCURR */ MC_BCD_TIME_T cur_hdr_time; /* TCHED */ MC_BCD_TIME_T cur_trlr_time; /* TCTRL */ MC_BCD_TIME_T lag_hdr_time; /* TLHED */ MC_BCD_TIME_T lag_trlr_time; /* TLTRL */ MC_BCD_TIME_T prio_start; /* TIPFS */ MC_BCD_TIME_T norm_start; /* TINFS */ MC_BCD_TIME_T last_spc_calib; /* TISPC */ MC_BCD_TIME_T last_elec_calib; /* TIECL */ MC_BCD_TIME_T last_blkbdy_calib; /* TIBBC */ MC_BCD_TIME_T last_star_sense; /* TISTR */ MC_BCD_TIME_T last_rang_meas; /* TLRAN */ MC_BCD_TIME_T cur_ir_calib_time; /* TIIRT */ MC_BCD_TIME_T cur_vis_nlut_time; /* TIVIT */ MC_BCD_TIME_T cur_limits_time; /* TCLMT */ MC_BCD_TIME_T cur_oa_time; /* TIONA */ unsigned short rel_scan; /* RISCT */ unsigned short abs_scan; /* AISCT */ unsigned short north_vis_line; /* INSLN */ unsigned short west_vis_pixel; /* IWFPX */ unsigned short east_vis_pixel; /* IEFPX */ unsigned short north_bound; /* INFLN */ unsigned short south_bound; /* ISFLN */ unsigned short pix_at_azimuth0; /* IMDPX */ unsigned short line_at_degree0; /* IMDLN */ unsigned short scan_at_degree0; /* IMDCT */ unsigned short satsub_line; /* IGVLN */ unsigned short satsub_elem; /* IGVPX */ float satsub_lat; /* SUBLA */ float satsub_lon; /* SUBLO */ unsigned char compen_zone; /* CZONE */ unsigned char blk3_det; unsigned short grid1_cnt; /* G1CNT */ unsigned short grid2_cnt /* G2CNT */ short elem_grid_bias; /* PBIAS */ short line_grid_bias; /* LBIAS */ short spare2; /* spare - not used */ float raw_ber; /* IDBER */ float range; /* RANGE */ float ground_delay; /* GPATH */ float xmit_delay; /* XMSNE */ MC_BCD_TIME_T gnd_delay_time; /* TGPAT */ MC_BCD_TIME_T xmit_delay_time; /* TXMSN */ unsigned short scan_time_msec; /* ISTIM */ unsigned char frame_cnt; /* IFRAM */ unsigned char img_mode; /* IMODE */ float nw_lat; /* IFNW1 */ float nw_lon; /* IFNW2 */ float se_lat; /* IFSE1 */ float se_lon; /* IFSE2 */ unsigned char gain2_int_idx; char spare3[30]; /* spare - not used */ unsigned char parity1; /* longitudinal parity 1-277 */ ONA_T ona; /* O&A parameters */ char spare4[3]; /* spare - not used */ unsigned char parity2; /* long. parity 279-1625 */ char tab_id[4]; unsigned char ew_cor_trm[48]; unsigned char idx_cor_trm; unsigned char z4[11]; unsigned short cur_scn_hdr_blk[46]; unsigned short cur_scn_trl_blk[46]; unsigned short lag_scn_hdr_blk[46]; unsigned short lag_scn_trl_blk[46]; char z5a[4246]; unsigned char ns_cyc; unsigned char ew_cyc; unsigned short ns_inc; unsigned short ew_inc; char z5b[88]; IVIS_DET_T vis_bias; IVIS_DET_T vis_gain1; IVIS_DET_T vis_gain2; float vis_albdo; IALL_IR_DET_T ir_rsp_bias; IALL_IR_DET_T ir_rsp_gain1; IALL_IR_DET_T ir_rsp_gain2; IALL_IR_DET_T ir_scl_bias; IALL_IR_DET_T ir_scl_gain1; IIR_BP_T ir_bp_int_gain2; IBASE_PLATE_T ir_bp_gain2; IIR_BP_T ir_blkbdy; char z6[798]; } BLOCK_0_IMGR_DOC_T; /******************************************************************************/ #define LINE_DOC_2_SIZE sizeof (BLOCKS_1TO10_LINE_DOC_2BYTE_T) typedef struct { short sat_id; /* SPCID */ short sps_source; /* SPSID */ short active_det_set; /* LSIDE */ short det_num; /* LIDET */ short channel; /* LICHA */ long scan; /* RISCT */ short imgr_stat1; /* L1SCAN */ short imgr_stat2; /* L2SCAN */ long num_pixels; /* LPIXELS */ long num_words; /* LWORDS */ short pixel_offset; /* LZCOR */ short spare[2]; /* spare - not used */ } BLOCKS_1TO10_LINE_DOC_2BYTE_T; /******************************************************************************/ /* Below are now in GVAR_DEFS.H #define BLOCK_11_SIZE (sizeof (BLOCK_11_SNDR_DOC_T)) #define SAD_SIZE 30 #define SAD_BEGIN_1_SIZE (sizeof (BLOCK_11_SAD_BEGIN_1BYTE_T)) #define SAD_BEGIN_2_SIZE (sizeof (BLOCK_11_SAD_BEGIN_2BYTE_T)) */ /* 3-59 SAD (Sounder/Auxiliary Data) block ID information. */ /* Below are now in GVAR_DEFS.H #define SAD_FILL_DATA 0x01 #define SAD_IMGR_COMPEN_TERM 0x07 #define SAD_SNDR_COMPEN_TERM 0x0E #define SAD_IMGR_TELEM_STAT 0x15 #define SAD_IMGR_SPCLOOK_DATA 0x16 #define SAD_IMGR_CALCOEF_LIM 0x19 #define SAD_IMGR_ECAL_DATA 0x1A #define SAD_IMGR_BLKBDY_DATA 0x1C #define SAD_IMGR_NLUTS_DATA 0x1F #define SAD_SNDR_DOC_DATA 0x20 #define SAD_SNDR_SCAN_DATA 0x23 #define SAD_SNDR_TELEM_STAT 0x25 #define SAD_SNDR_SPCLOOK_DATA 0x26 #define SAD_SNDR_CALCOEF_LIM 0x29 #define SAD_SNDR_ECAL_DATA 0x2A #define SAD_SNDR_BLKBDY_DATA 0x2C #define SAD_SNDR_NLUTS_DATA 0x2F #define SAD_AUX_DATA 0x31 #define SAD_GIMTACS_TEXT 0x32 #define SAD_SPS_TEXT 0x34 #define SAD_RESERVED 0x38 #define SAD_IMGR_STARSENSE_DATA 0x3B #define SAD_SNDR_STARSENSE_DATA 0x3D */ typedef struct { unsigned char sat_id; unsigned char sps_id; unsigned char data_id; unsigned char first_block; unsigned char last_block; unsigned char block_count1; unsigned char block_count2; unsigned char block_count3; unsigned char record_count; } BLOCK_11_SAD_BEGIN_1BYTE_T; typedef struct { unsigned short sat_id; unsigned short sps_id; unsigned short data_id; unsigned short first_block; unsigned short last_block; unsigned short block_count1; unsigned short block_count2; unsigned short block_count3; unsigned short record_count; } BLOCK_11_SAD_BEGIN_2BYTE_T; /* 3-128 An 8-bit word size is employed in block 11's when text messages are transmitted. */ typedef struct { unsigned char source_id; unsigned short num_words; MC_BCD_TIME_T time_queued; } BLOCK_11_SAD_TEXT_T; /* 3-132 The auxillary data may be of 6, 8, or 10 bit word size. */ typedef struct { unsigned char word_count1; unsigned char word_count2; unsigned char word_count3; unsigned char word_size; unsigned char data_type; unsigned char data_source1; unsigned char data_source2; unsigned char data_source3; unsigned char prod_id1; unsigned char prod_id2; unsigned char prod_id3; unsigned char ver_num; unsigned char start_end; } BLOCK_11_SAD_AUX_1BYTE_T; typedef struct { unsigned short word_count1; unsigned short word_count2; unsigned short word_count3; unsigned short word_size; unsigned short data_type; unsigned short data_source1; unsigned short data_source2; unsigned short data_source3; unsigned short prod_id1; unsigned short prod_id2; unsigned short prod_id3; unsigned short ver_num; unsigned short start_end; } BLOCK_11_SAD_AUX_2BYTE_T; /* The miscellaneous structure was added to keep track of multi-bit words that would not fit in the restraints of the SAD structure. Unions will not work due to internal spacing of the structure. */ typedef struct { unsigned int block_count : 18; unsigned int word_count : 18; unsigned int data_source : 18; unsigned int prod_id : 18; } BLOCK_11_SAD_MISC_T; /******************************************************************************/ /* 3.3.7.12 At the beginning of each message is a 16-byte time tag. */ typedef struct { unsigned char cr1; unsigned char lf1; unsigned char day[3]; unsigned char space; unsigned char hour[2]; unsigned char colon1; unsigned char min[2]; unsigned char colon2; unsigned char sec[2]; unsigned char cr2; unsigned char lf2; } TEXT_MSG_TIME_TAG_T; /* 16-bytes */ /******************************************************************************/ /* 3-131 SPS text messages may be up to 90 characters in length. A limit of 10 messages/block 11 is observed. */ typedef struct { TEXT_MSG_TIME_TAG_T time_tag; unsigned char msg[75]; } SPS_MSG_T; /* 90-bytes (+ 1 for '\0') */ /******************************************************************************/ /* 3-131 GIMTACS text messages may be up to 11866 characters in length. */ typedef struct { TEXT_MSG_TIME_TAG_T time_tag; unsigned char msg[11851]; } GIMTACS_MSG_T; /* 11866-bytes (+ 1 for '\0') */ /******************************************************************************/ typedef struct { unsigned char south_north : 1; unsigned char east_west : 1; unsigned char prio2_frame : 1; unsigned char prio1_frame : 1; unsigned char pixels_lost : 1; unsigned char frame_break : 1; unsigned char frame_end : 1; unsigned char frame_start : 1; unsigned char ir_calib_active : 1; unsigned char vis_norm_active : 1; unsigned char side2_active : 1; unsigned char step_mode_double : 1; unsigned char dwell_mode1 : 1; unsigned char dwell_mode2 : 1; unsigned char dwell_mode4 : 1; unsigned char IMC_active : 1; } SNDR_SCAN_STATUS_T; typedef struct { unsigned char det1_1 : 1; unsigned char det1_2 : 1; unsigned char det1_3 : 1; unsigned char det1_4 : 1; unsigned char det2_1 : 1; unsigned char det2_2 : 1; unsigned char det2_3 : 1; unsigned char det2_4 : 1; unsigned char det3_1 : 1; unsigned char det3_2 : 1; unsigned char det3_3 : 1; unsigned char det3_4 : 1; unsigned char det4_1 : 1; unsigned char det4_2 : 1; unsigned char det4_3 : 1; unsigned char det4_4 : 1; unsigned char det5_1 : 1; unsigned char det5_2 : 1; unsigned char det5_3 : 1; unsigned char det5_4 : 1; unsigned char det6_1 : 1; unsigned char det6_2 : 1; unsigned char det6_3 : 1; unsigned char det6_4 : 1; unsigned char det7_1 : 1; unsigned char det7_2 : 1; unsigned char det7_3 : 1; unsigned char det7_4 : 1; unsigned char det8_1 : 1; unsigned char det8_2 : 1; unsigned char det8_3 : 1; unsigned char det8_4 : 1; unsigned char det9_1 : 1; unsigned char det9_2 : 1; unsigned char det9_3 : 1; unsigned char det9_4 : 1; unsigned char det10_1 : 1; unsigned char det10_2 : 1; unsigned char det10_3 : 1; unsigned char det10_4 : 1; unsigned char det11_1 : 1; unsigned char det11_2 : 1; unsigned char det11_3 : 1; unsigned char det11_4 : 1; unsigned char det12_1 : 1; unsigned char det12_2 : 1; unsigned char det12_3 : 1; unsigned char det12_4 : 1; unsigned char det13_1 : 1; unsigned char det13_2 : 1; unsigned char det13_3 : 1; unsigned char det13_4 : 1; unsigned char det14_1 : 1; unsigned char det14_2 : 1; unsigned char det14_3 : 1; unsigned char det14_4 : 1; unsigned char det15_1 : 1; unsigned char det15_2 : 1; unsigned char det15_3 : 1; unsigned char det15_4 : 1; unsigned char det16_1 : 1; unsigned char det16_2 : 1; unsigned char det16_3 : 1; unsigned char det16_4 : 1; unsigned char det17_1 : 1; unsigned char det17_2 : 1; unsigned char det17_3 : 1; unsigned char det17_4 : 1; unsigned char det18_1 : 1; unsigned char det18_2 : 1; unsigned char det18_3 : 1; unsigned char det18_4 : 1; unsigned char det19_1 : 1; unsigned char det19_2 : 1; unsigned char det19_3 : 1; unsigned char det19_4 : 1; unsigned char last4 : 4; } SNDR_DET_STATUS_T; typedef struct { float det[4]; } SNDR_DOC_DET_T; typedef struct { SNDR_DOC_DET_T chan[18]; } SNDR_DOC_CAL_ARR_T; typedef struct { float base_plate[4]; } SNDR_DOC_BASE_PLATE_T; typedef struct { SNDR_DOC_BASE_PLATE_T det[4]; } SNDR_DOC_TAB_DET_T; typedef struct { SNDR_DOC_TAB_DET_T chan[18]; } SNDR_DOC_CAL_TAB_T; typedef struct { SNDR_SCAN_STATUS_T stat; /* SSCAN */ SNDR_DET_STATUS_T det_status; /* SDSTA */ unsigned short scan_data_blks; /* SRBCT */ unsigned short num_block_11; /* SGBCT */ unsigned short num_ln_brk; /* SLOCT */ unsigned short px_after_star_brk; /* SSBRK */ unsigned short px_after_calib_brk; /* SCBRK */ char spare1[6]; /* spare - not used */ MC_BCD_TIME_T cur_sps_time; /* TCURR */ MC_BCD_TIME_T ln_start_time; /* TSCLS */ MC_BCD_TIME_T ln_end_time; /* TSCLE */ MC_BCD_TIME_T calib_ln_start_time; /* TSSLS */ MC_BCD_TIME_T calib_ln_end_time; /* TSSLE */ MC_BCD_TIME_T prio_start; /* TSPFS */ MC_BCD_TIME_T norm_start; /* TSNFS */ MC_BCD_TIME_T last_spc_calib; /* TSSPC */ MC_BCD_TIME_T last_elec_calib; /* TSECL */ MC_BCD_TIME_T last_blkbdy_calib; /* TSBBC */ MC_BCD_TIME_T last_star_sense; /* TSSTR */ MC_BCD_TIME_T last_rang_meas; /* TLRAN */ MC_BCD_TIME_T cur_vis_nlut_time; /* TSVIT */ MC_BCD_TIME_T cur_limits_time; /* TCLMT */ MC_BCD_TIME_T cur_oa_time; /* TSONA */ char spare2[2]; /* spare - not used */ unsigned short rel_scan; /* RSSCT */ unsigned short abs_scan; /* ASSCT */ unsigned short north_vis_line; /* SNSLN */ unsigned short west_vis_pixel; /* SWFPX */ unsigned short east_vis_pixel; /* SEFPX */ unsigned short north_bound; /* SNFLN */ unsigned short south_bound; /* SSFLN */ unsigned short pix_at_azimuth0; /* SMDPX */ unsigned short line_at_degree0; /* SMDLN */ unsigned short scan_at_degree0; /* SMDCT */ unsigned short satsub_line; /* SGVLN */ unsigned short satsub_elem; /* SGVPX */ char spare3[2]; /* spare - not used */ float satsub_lat; /* SUBLA */ float satsub_lon; /* SUBLO */ char spare4[12]; /* spare - not used */ float raw_ber; /* SDBER */ float range; /* RANGE */ float ground_delay; /* GPATH */ float xmit_delay; /* XMSNE */ MC_BCD_TIME_T gnd_delay_time; /* TGPAT */ MC_BCD_TIME_T xmit_delay_time; /* TXMSN */ char spare5[2]; /* spare - not used */ unsigned char frame_cnt; /* SFRAM */ unsigned char snd_mode; /* SMODE */ float nw_lat; /* SFNW1 */ float nw_lon; /* SFNW2 */ float se_lat; /* SFSE1 */ float se_lon; /* SFSE2 */ char spare6[27]; /* spare - not used */ unsigned char parity1; /* long. parity 31-305 */ ONA_T ona; /* O&A parameters */ char spare7[67]; /* spare - not used */ unsigned char parity2; /* long. parity 307-1717 */ char extra1[1408]; /* spare - not used */ SNDR_DOC_CAL_ARR_T char_resp_bias; /* SICRB */ SNDR_DOC_CAL_ARR_T char_resp_gain1; /* SICR1 */ SNDR_DOC_CAL_ARR_T char_resp_gain2; /* SICR2 */ SNDR_DOC_CAL_ARR_T scale_fact_bias; /* SISFB */ SNDR_DOC_CAL_ARR_T scale_fact_gain1; /* SISF1 */ SNDR_DOC_CAL_TAB_T gain2_int_table; /* SG2IT */ float gain2_bp_temp[4]; /* SG2BP */ SNDR_DOC_CAL_TAB_T blkbdy_temp2rad; /* SBBTR */ char extra2[1154]; /* spare - not used */ } BLOCK_11_SNDR_DOC_T; /******************************************************************************/ typedef struct { unsigned short spare1 : 2; unsigned short neg_data : 1; unsigned short binary : 12; unsigned short parity : 1; } BLOCK_11_RECORD_WORD_AD_T; typedef struct { unsigned char spare1 : 5; unsigned char side2_electronics : 1; unsigned char scan_motor_off : 1; unsigned char filter_motor1_off : 1; unsigned char patch_stat_off : 1; unsigned char patch_temp_mid_low : 1; unsigned char filter_motor2_off : 1; unsigned char IMC_range_2mR : 1; unsigned char therm_cntl1_off : 1; unsigned char therm_cntl2_off : 1; unsigned char therm_power_low : 1; unsigned char parity : 1; } BLOCK_11_RECORD_WORD_6_T; typedef struct { unsigned char spare1 : 5; unsigned char hous_not_overtemp : 1; unsigned char rad_not_overtemp : 1; unsigned char patch_not_overtemp : 1; unsigned char spclook_west : 1; unsigned char fil_hous_heat_off : 1; unsigned char fil_outgas_heat_off : 1; unsigned char rad_outgas_heat_off : 1; unsigned char hous_temp_outgas_low : 1; unsigned char patch_temp_low : 1; unsigned char rad_outgas_low : 1; unsigned char parity : 1; } BLOCK_11_RECORD_WORD_7_T; typedef struct { unsigned char spare1 : 5; unsigned char instr_id : 5; unsigned char fil_in_sync : 1; unsigned char bias_power4_off : 1; unsigned char bias_power3_off : 1; unsigned char bias_power2_off : 1; unsigned char bias_power1_off : 1; unsigned char parity : 1; } BLOCK_11_RECORD_WORD_8_T; typedef struct { unsigned char spare1 : 8; unsigned char e_w_cyc : 3; unsigned char e_w_incr_msb : 4; unsigned char parity : 1; } BLOCK_11_RECORD_WORD_9_T; typedef struct { unsigned char spare1 : 7; unsigned char e_w_incr_lsb : 8; unsigned char parity : 1; } BLOCK_11_RECORD_WORD_10_T; typedef struct { unsigned char spare1 : 6; unsigned char n_s_cyc : 7; unsigned char n_s_incr_msb : 2; unsigned char parity : 1; } BLOCK_11_RECORD_WORD_11_T; typedef struct { unsigned short spare1 : 5; unsigned short n_s_incr_lsb : 10; unsigned short parity : 1; } BLOCK_11_RECORD_WORD_12_T; typedef struct { unsigned short spare1 : 3; unsigned short fil_rotation_cnt : 12; unsigned short parity : 1; } BLOCK_11_RECORD_WORD_13_T; typedef struct { unsigned short spare1 : 3; unsigned short rot_div10_since_bbcal : 12; unsigned short parity : 1; } BLOCK_11_RECORD_WORD_14_T; typedef struct { unsigned char x_start_lsb : 8; unsigned char spare1 : 1; unsigned char calib_disable_active : 1; unsigned char calib_enable_active : 1; unsigned char level_3_exe_req : 1; unsigned char level_2_exe_req : 1; unsigned char level_1_exe_req : 1; unsigned char level_0_exe_req : 1; unsigned char parity : 1; } BLOCK_11_RECORD_WORD_15_T; typedef struct { unsigned char spare1 : 1; unsigned char x_start_msb : 7; unsigned char spare2 : 3; unsigned char level_0_exe_ackn : 1; unsigned char level_1_exe_ackn : 1; unsigned char level_2_exe_ackn : 1; unsigned char level_3_exe_ackn : 1; unsigned char parity : 1; } BLOCK_11_RECORD_WORD_16_T; typedef struct { unsigned char x_stop_lsb : 8; unsigned char spare1 : 3; unsigned char level_0_cmd_loaded : 1; unsigned char level_1_cmd_loaded : 1; unsigned char level_2_cmd_loaded : 1; unsigned char level_3_cmd_loaded : 1; unsigned char parity : 1; } BLOCK_11_RECORD_WORD_17_T; typedef struct { unsigned char spare1 : 1; unsigned char x_stop_msb : 7; unsigned char spare2 : 1; unsigned char cmd_incomplete : 1; unsigned char cmd_valid : 1; unsigned char spare3 : 4; unsigned char parity : 1; } BLOCK_11_RECORD_WORD_18_T; typedef struct { unsigned char star_sequence : 1; unsigned char calib_inhibited : 1; unsigned char step_dwell_mode : 2; unsigned char frame_repeat : 4; unsigned char spare1 : 1; unsigned char dwell_cnt : 6; unsigned char parity : 1; } BLOCK_11_RECORD_WORD_19_T; typedef struct { unsigned char y_start_lsb : 8; unsigned char spare1 : 3; unsigned char repeat_cnt : 4; unsigned char parity : 1; } BLOCK_11_RECORD_WORD_20_T; typedef struct { unsigned char y_start_mid_sb : 8; unsigned char spare1 : 3; unsigned char ecal_level : 4; unsigned char parity : 1; } BLOCK_11_RECORD_WORD_21_T; typedef struct { unsigned char spare1 : 5; unsigned char y_start_msb : 3; unsigned char spare2 : 1; unsigned char motor_overload : 1; unsigned char scan_reset_active : 1; unsigned char stepping_north : 1; unsigned char stepping_south : 1; unsigned char stepping_east : 1; unsigned char stepping_west : 1; unsigned char parity : 1; } BLOCK_11_RECORD_WORD_22_T; typedef struct { unsigned char y_stop_lsb : 8; unsigned char spare1 : 1; unsigned char n_s_axis_step_active : 1; unsigned char n_s_axis_slew_active : 1; unsigned char e_w_axis_slew_active : 1; unsigned char prio_scan_active : 1; unsigned char reserved : 1; unsigned char scan_active : 1; unsigned char parity : 1; } BLOCK_11_RECORD_WORD_23_T; typedef struct { unsigned char y_stop_mid_sb : 8; unsigned char spare1 : 3; unsigned char level_3_active : 1; unsigned char level_2_active : 1; unsigned char level_1_active : 1; unsigned char level_0_active : 1; unsigned char parity : 1; } BLOCK_11_RECORD_WORD_24_T; typedef struct { unsigned char spare1 : 2; unsigned char cmd_level_id : 2; unsigned char spare2 : 1; unsigned char y_stop_msb : 3; unsigned char spare3 : 3; unsigned char vdb_active : 1; unsigned char bbcal_active : 1; unsigned char ecal_active : 1; unsigned char spclook_active : 1; unsigned char parity : 1; } BLOCK_11_RECORD_WORD_25_T; typedef struct { unsigned short spare1 : 1; unsigned short chan_fil1_veloc : 10; unsigned short fil_period_var : 4; unsigned short parity : 1; } BLOCK_11_RECORD_WORD_54_T; typedef struct { unsigned char spare1 : 2; unsigned char patch_heat_off : 1; unsigned char patch_mid_low_temp : 1; unsigned char outgas_rad_off : 1; unsigned char rad_cntl : 1; unsigned char spare2 : 2; unsigned char spare3 : 3; unsigned char patch_low_temp : 1; unsigned char outgas_low_rad_on : 1; unsigned char spare4 : 3; } BLOCK_11_RECORD_AOCE_T; typedef struct { unsigned char spare1 : 1; unsigned char sync_code : 7; unsigned char neg_bit_slip : 3; unsigned char input_chan : 2; unsigned char sync_fault_cnt : 2; unsigned char frm_after_sync_loss : 1; unsigned char pos_bit_slip : 8; unsigned char parity : 8; } BLOCK_11_RECORD_STATUS_T; /* 3-80 This data record is repeated up to 11 times in each sounder block 11. */ typedef struct { short sync_word1; short sync_word2; short sync_word3; short sync_word4; BLOCK_11_RECORD_WORD_AD_T e_w_servo_current1; BLOCK_11_RECORD_WORD_6_T com_stat_word6; BLOCK_11_RECORD_WORD_7_T com_stat_word7; BLOCK_11_RECORD_WORD_8_T instr_id_sync; BLOCK_11_RECORD_WORD_9_T e_w_pos_high_byte; BLOCK_11_RECORD_WORD_10_T e_w_pos_low_byte; BLOCK_11_RECORD_WORD_11_T n_s_pos_high_byte; BLOCK_11_RECORD_WORD_12_T n_s_pos_low_byte; BLOCK_11_RECORD_WORD_13_T time_since_spclook; BLOCK_11_RECORD_WORD_14_T time_since_bbcal; BLOCK_11_RECORD_WORD_15_T scan_cntl_word15; BLOCK_11_RECORD_WORD_16_T scan_cntl_word16; BLOCK_11_RECORD_WORD_17_T scan_cntl_word17; BLOCK_11_RECORD_WORD_18_T scan_cntl_word18; BLOCK_11_RECORD_WORD_19_T scan_cntl_word19; BLOCK_11_RECORD_WORD_20_T scan_cntl_word20; BLOCK_11_RECORD_WORD_21_T scan_cntl_word21; BLOCK_11_RECORD_WORD_22_T scan_cntl_word22; BLOCK_11_RECORD_WORD_23_T scan_cntl_word23; BLOCK_11_RECORD_WORD_24_T scan_cntl_word24; BLOCK_11_RECORD_WORD_25_T scan_cntl_word25; BLOCK_11_RECORD_WORD_AD_T e_w_servo_error1; BLOCK_11_RECORD_WORD_AD_T e_w_servo_error2; BLOCK_11_RECORD_WORD_AD_T e_w_servo_error3; BLOCK_11_RECORD_WORD_AD_T e_w_servo_error4; short spare1; BLOCK_11_RECORD_WORD_AD_T star_sense_chan1_1; BLOCK_11_RECORD_WORD_AD_T star_sense_chan1_2; BLOCK_11_RECORD_WORD_AD_T star_sense_chan1_3; BLOCK_11_RECORD_WORD_AD_T star_sense_chan1_4; BLOCK_11_RECORD_WORD_AD_T star_sense_chan1_5; BLOCK_11_RECORD_WORD_AD_T star_sense_chan1_6; BLOCK_11_RECORD_WORD_AD_T star_sense_chan1_7; BLOCK_11_RECORD_WORD_AD_T star_sense_chan1_8; BLOCK_11_RECORD_WORD_AD_T longwave_chan1_1; BLOCK_11_RECORD_WORD_AD_T longwave_chan1_2; BLOCK_11_RECORD_WORD_AD_T longwave_chan1_3; BLOCK_11_RECORD_WORD_AD_T longwave_chan1_4; BLOCK_11_RECORD_WORD_AD_T shortwave_chan16_1; BLOCK_11_RECORD_WORD_AD_T shortwave_chan16_2; BLOCK_11_RECORD_WORD_AD_T shortwave_chan16_3; BLOCK_11_RECORD_WORD_AD_T shortwave_chan16_4; BLOCK_11_RECORD_WORD_AD_T n_s_servo_current; BLOCK_11_RECORD_WORD_AD_T therm_current1; BLOCK_11_RECORD_WORD_AD_T therm_current2; BLOCK_11_RECORD_WORD_AD_T fil_motor_current1; BLOCK_11_RECORD_WORD_AD_T fil_motor_current2; BLOCK_11_RECORD_WORD_AD_T instr_current; BLOCK_11_RECORD_WORD_AD_T e_w_servo_error5; BLOCK_11_RECORD_WORD_54_T fil_period_mon; BLOCK_11_RECORD_WORD_AD_T elec_side_pos_17v1; BLOCK_11_RECORD_WORD_AD_T elec_side_pos_8v1; BLOCK_11_RECORD_WORD_AD_T elec_side_pos_8v2; BLOCK_11_RECORD_WORD_AD_T elec_side_neg_17v1; BLOCK_11_RECORD_WORD_AD_T elec_side_neg_8v; BLOCK_11_RECORD_WORD_AD_T elec_side_pos_12v; BLOCK_11_RECORD_WORD_AD_T elec_side_pos_8v3; BLOCK_11_RECORD_WORD_AD_T fw_pos_18v1; BLOCK_11_RECORD_WORD_AD_T fw_pos_18v2; BLOCK_11_RECORD_WORD_AD_T midwave_chan12_1; BLOCK_11_RECORD_WORD_AD_T midwave_chan12_2; BLOCK_11_RECORD_WORD_AD_T midwave_chan12_3; BLOCK_11_RECORD_WORD_AD_T midwave_chan12_4; BLOCK_11_RECORD_WORD_AD_T longwave_chan2_1; BLOCK_11_RECORD_WORD_AD_T longwave_chan2_2; BLOCK_11_RECORD_WORD_AD_T longwave_chan2_3; BLOCK_11_RECORD_WORD_AD_T longwave_chan2_4; BLOCK_11_RECORD_WORD_AD_T e_w_servo_error6; BLOCK_11_RECORD_WORD_AD_T servo_side_pos_25v; BLOCK_11_RECORD_WORD_AD_T servo_side_pos_7v1; BLOCK_11_RECORD_WORD_AD_T servo_side_pos_7v2; BLOCK_11_RECORD_WORD_AD_T servo_side_pos_9v; BLOCK_11_RECORD_WORD_AD_T servo_side_neg_25v; BLOCK_11_RECORD_WORD_AD_T servo_side_neg_9v; BLOCK_11_RECORD_WORD_AD_T tlm_side_pos_11v; short spare2; BLOCK_11_RECORD_WORD_AD_T shortwave_chan15_1; BLOCK_11_RECORD_WORD_AD_T shortwave_chan15_2; BLOCK_11_RECORD_WORD_AD_T shortwave_chan15_3; BLOCK_11_RECORD_WORD_AD_T shortwave_chan15_4; short spare3; BLOCK_11_RECORD_WORD_AD_T tlm_side_pos_17v; BLOCK_11_RECORD_WORD_AD_T tlm_side_pos_40v; BLOCK_11_RECORD_WORD_AD_T tlm_side_neg_8v; short spare4; BLOCK_11_RECORD_WORD_AD_T longwave_chan4_1; BLOCK_11_RECORD_WORD_AD_T longwave_chan4_2; BLOCK_11_RECORD_WORD_AD_T longwave_chan4_3; BLOCK_11_RECORD_WORD_AD_T longwave_chan4_4; BLOCK_11_RECORD_WORD_AD_T star_sense_chan2_1; BLOCK_11_RECORD_WORD_AD_T star_sense_chan2_2; BLOCK_11_RECORD_WORD_AD_T star_sense_chan2_3; BLOCK_11_RECORD_WORD_AD_T star_sense_chan2_4; BLOCK_11_RECORD_WORD_AD_T star_sense_chan2_5; BLOCK_11_RECORD_WORD_AD_T star_sense_chan2_6; BLOCK_11_RECORD_WORD_AD_T star_sense_chan2_7; BLOCK_11_RECORD_WORD_AD_T star_sense_chan2_8; BLOCK_11_RECORD_WORD_AD_T midwave_chan10_1; BLOCK_11_RECORD_WORD_AD_T midwave_chan10_2; BLOCK_11_RECORD_WORD_AD_T midwave_chan10_3; BLOCK_11_RECORD_WORD_AD_T midwave_chan10_4; short spare5; BLOCK_11_RECORD_WORD_AD_T signal_ground; BLOCK_11_RECORD_WORD_AD_T heater_bus_voltage; BLOCK_11_RECORD_WORD_AD_T vis_optics_temp; BLOCK_11_RECORD_WORD_AD_T blkbdy_target_temp1; BLOCK_11_RECORD_WORD_AD_T blkbdy_target_temp2; BLOCK_11_RECORD_WORD_AD_T blkbdy_target_temp3; BLOCK_11_RECORD_WORD_AD_T blkbdy_target_temp4; BLOCK_11_RECORD_WORD_AD_T blkbdy_target_temp5; BLOCK_11_RECORD_WORD_AD_T blkbdy_target_temp6; short spare6; BLOCK_11_RECORD_WORD_AD_T shortwave_chan14_1; BLOCK_11_RECORD_WORD_AD_T shortwave_chan14_2; BLOCK_11_RECORD_WORD_AD_T shortwave_chan14_3; BLOCK_11_RECORD_WORD_AD_T shortwave_chan14_4; BLOCK_11_RECORD_WORD_AD_T longwave_chan5_1; BLOCK_11_RECORD_WORD_AD_T longwave_chan5_2; BLOCK_11_RECORD_WORD_AD_T longwave_chan5_3; BLOCK_11_RECORD_WORD_AD_T longwave_chan5_4; BLOCK_11_RECORD_WORD_AD_T e_w_servo_error7; BLOCK_11_RECORD_WORD_AD_T blkbdy_target_temp7; BLOCK_11_RECORD_WORD_AD_T blkbdy_target_temp8; BLOCK_11_RECORD_WORD_AD_T cooler_hous_temp; BLOCK_11_RECORD_WORD_AD_T cooler_rad_temp; BLOCK_11_RECORD_WORD_AD_T elect_temp1; BLOCK_11_RECORD_WORD_AD_T elect_temp2; BLOCK_11_RECORD_WORD_AD_T fil_hous_temp; BLOCK_11_RECORD_WORD_AD_T fil_motor_temp; BLOCK_11_RECORD_WORD_AD_T e_w_motor_current2; BLOCK_11_RECORD_WORD_AD_T midwave_chan9_1; BLOCK_11_RECORD_WORD_AD_T midwave_chan9_2; BLOCK_11_RECORD_WORD_AD_T midwave_chan9_3; BLOCK_11_RECORD_WORD_AD_T midwave_chan9_4; short spare7; BLOCK_11_RECORD_WORD_AD_T fil_rad_temp; BLOCK_11_RECORD_WORD_AD_T louver_rad_temp; BLOCK_11_RECORD_WORD_AD_T narrow_ir_det_temp; BLOCK_11_RECORD_WORD_AD_T power_temp; BLOCK_11_RECORD_WORD_AD_T mirror_temp; BLOCK_11_RECORD_WORD_AD_T sensor_base_temp1; short spare8; BLOCK_11_RECORD_WORD_AD_T longwave_chan6_1; BLOCK_11_RECORD_WORD_AD_T longwave_chan6_2; BLOCK_11_RECORD_WORD_AD_T longwave_chan6_3; BLOCK_11_RECORD_WORD_AD_T longwave_chan6_4; BLOCK_11_RECORD_WORD_AD_T shortwave_chan13_1; BLOCK_11_RECORD_WORD_AD_T shortwave_chan13_2; BLOCK_11_RECORD_WORD_AD_T shortwave_chan13_3; BLOCK_11_RECORD_WORD_AD_T shortwave_chan13_4; short spare9; BLOCK_11_RECORD_WORD_AD_T star_sense_chan3_1; BLOCK_11_RECORD_WORD_AD_T star_sense_chan3_2; BLOCK_11_RECORD_WORD_AD_T star_sense_chan3_3; BLOCK_11_RECORD_WORD_AD_T star_sense_chan3_4; BLOCK_11_RECORD_WORD_AD_T star_sense_chan3_5; BLOCK_11_RECORD_WORD_AD_T star_sense_chan3_6; BLOCK_11_RECORD_WORD_AD_T star_sense_chan3_7; BLOCK_11_RECORD_WORD_AD_T star_sense_chan3_8; short spare10; BLOCK_11_RECORD_WORD_AD_T sensor_base_temp2; BLOCK_11_RECORD_WORD_AD_T sensor_base_temp3; BLOCK_11_RECORD_WORD_AD_T sensor_base_temp4; short spare11; BLOCK_11_RECORD_WORD_AD_T midwave_chan8_1; BLOCK_11_RECORD_WORD_AD_T midwave_chan8_2; BLOCK_11_RECORD_WORD_AD_T midwave_chan8_3; BLOCK_11_RECORD_WORD_AD_T midwave_chan8_4; BLOCK_11_RECORD_WORD_AD_T longwave_chan7_1; BLOCK_11_RECORD_WORD_AD_T longwave_chan7_2; BLOCK_11_RECORD_WORD_AD_T longwave_chan7_3; BLOCK_11_RECORD_WORD_AD_T longwave_chan7_4; BLOCK_11_RECORD_WORD_AD_T shortwave_chan17_1; BLOCK_11_RECORD_WORD_AD_T shortwave_chan17_2; BLOCK_11_RECORD_WORD_AD_T shortwave_chan17_3; BLOCK_11_RECORD_WORD_AD_T shortwave_chan17_4; BLOCK_11_RECORD_WORD_AD_T e_w_servo_error8; BLOCK_11_RECORD_WORD_AD_T sensor_base_temp5; BLOCK_11_RECORD_WORD_AD_T sensor_base_temp6; BLOCK_11_RECORD_WORD_AD_T tele_pri_temp; BLOCK_11_RECORD_WORD_AD_T tele_sec_temp1; BLOCK_11_RECORD_WORD_AD_T wide_ir_det_temp; BLOCK_11_RECORD_WORD_AD_T e_w_comp; short spare11_b; BLOCK_11_RECORD_WORD_AD_T elect_cal_voltage1; BLOCK_11_RECORD_WORD_AD_T fil_heater_voltage; BLOCK_11_RECORD_WORD_AD_T n_s_comp; BLOCK_11_RECORD_WORD_AD_T n_s_servo_error; BLOCK_11_RECORD_WORD_AD_T patch_voltage; BLOCK_11_RECORD_WORD_AD_T ref_voltage_pos_10v1; BLOCK_11_RECORD_WORD_AD_T therm_current3; BLOCK_11_RECORD_WORD_AD_T therm_current4; BLOCK_11_RECORD_WORD_AD_T therm_current5; BLOCK_11_RECORD_WORD_AD_T therm_current6; short spare12; short spare13; BLOCK_11_RECORD_WORD_AD_T longwave_chan3_1; BLOCK_11_RECORD_WORD_AD_T longwave_chan3_2; BLOCK_11_RECORD_WORD_AD_T longwave_chan3_3; BLOCK_11_RECORD_WORD_AD_T longwave_chan3_4; BLOCK_11_RECORD_WORD_AD_T tele_sec_temp2; BLOCK_11_RECORD_WORD_AD_T pri_baf_temp1; BLOCK_11_RECORD_WORD_AD_T pri_baf_temp2; short spare14; short spare15; short spare16; BLOCK_11_RECORD_WORD_AD_T shortwave_chan18_1; BLOCK_11_RECORD_WORD_AD_T shortwave_chan18_2; BLOCK_11_RECORD_WORD_AD_T shortwave_chan18_3; BLOCK_11_RECORD_WORD_AD_T shortwave_chan18_4; BLOCK_11_RECORD_WORD_AD_T midwave_chan11_1; BLOCK_11_RECORD_WORD_AD_T midwave_chan11_2; BLOCK_11_RECORD_WORD_AD_T midwave_chan11_3; BLOCK_11_RECORD_WORD_AD_T midwave_chan11_4; BLOCK_11_RECORD_WORD_AD_T star_sense_chan4_1; BLOCK_11_RECORD_WORD_AD_T star_sense_chan4_2; BLOCK_11_RECORD_WORD_AD_T star_sense_chan4_3; BLOCK_11_RECORD_WORD_AD_T star_sense_chan4_4; BLOCK_11_RECORD_WORD_AD_T star_sense_chan4_5; BLOCK_11_RECORD_WORD_AD_T star_sense_chan4_6; BLOCK_11_RECORD_WORD_AD_T star_sense_chan4_7; BLOCK_11_RECORD_WORD_AD_T star_sense_chan4_8; BLOCK_11_RECORD_WORD_AD_T vis_chan_1; BLOCK_11_RECORD_WORD_AD_T vis_chan_2; BLOCK_11_RECORD_WORD_AD_T vis_chan_3; BLOCK_11_RECORD_WORD_AD_T vis_chan_4; short spare17; BLOCK_11_RECORD_AOCE_T aoce_word1; BLOCK_11_RECORD_AOCE_T aoce_word2; BLOCK_11_RECORD_AOCE_T aoce_word3; BLOCK_11_RECORD_AOCE_T aoce_word4; BLOCK_11_RECORD_AOCE_T aoce_word5; BLOCK_11_RECORD_AOCE_T aoce_word6; BLOCK_11_RECORD_AOCE_T aoce_word7; BLOCK_11_RECORD_AOCE_T aoce_word8; BLOCK_11_RECORD_AOCE_T aoce_word9; BLOCK_11_RECORD_AOCE_T aoce_word10; BLOCK_11_RECORD_AOCE_T aoce_word11; short spare18; short spare19; short spare20; short spare21; short spare22; short spare23; short spare24; short spare24_b; BLOCK_11_RECORD_STATUS_T status; float aim_pt_lat; float aim_pt_lon; float chan_8_det_a_lat; float chan_8_det_a_lon; float chan_8_det_b_lat; float chan_8_det_b_lon; float chan_8_det_c_lat; float chan_8_det_c_lon; float chan_8_det_d_lat; float chan_8_det_d_lon; } BLOCK_11_RECORD_T; /******************************************************************************/ typedef struct { unsigned short line_num_det[4]; unsigned short pix_num[11]; unsigned char sync_loss; unsigned char sync_restore; unsigned char spare1[322]; } BLOCK_11_LOCATOR_T; /******************************************************************************/ typedef struct { unsigned short pixel[11]; } BLOCK_11_DATA_PIX_T; typedef struct { BLOCK_11_DATA_PIX_T det[4]; } BLOCK_11_DATA_DET_T; typedef struct { BLOCK_11_DATA_DET_T chan[19]; } BLOCK_11_DATA_T; /******************************************************************************/ typedef struct { BLOCK_11_RECORD_T rec[11]; BLOCK_11_LOCATOR_T loc; BLOCK_11_DATA_T data; } BLOCK_11_SNDR_DATA_T; /******************************************************************************/ typedef struct { short int ntop; /* transition between 1 and 2 slope < 127 */ unsigned short int i2zero; /* starting point */ unsigned short int i2last; /* ending point */ unsigned short int west_edge; /* west pixel (for space trim) */ unsigned short int number_px; /* number of pixels recorded */ unsigned short int spar2; } CMPRS_INFO; typedef struct { long val_code; short blk_hdr_crc; union { IMGR_SCAN_STATUS_T imgr; /* SNDR_SCAN_STATUS_T sndr; */ } scan_stat; MC_BCD_TIME_T time; GVAR_HDR_T blk_hdr; union { BLOCKS_1TO10_LINE_DOC_2BYTE_T imgr_2; /* BLOCK_11_SAD_BEGIN_1BYTE_T sndr_1; */ } line_doc; /* CMPRS_INFO cmp_info; */ } MC_LINE_PREFIX_T; typedef struct { MC_BCD_TIME_T cur_time; MC_BCD_TIME_T lag_time; long east_west; } MC_TIME_LINE_PREFIX_T; typedef struct { long val_code; short blk_hdr_crc; union { IMGR_SCAN_STATUS_T imgr; SNDR_SCAN_STATUS_T sndr; } scan_stat; MC_BCD_TIME_T time; GVAR_HDR_T blk_hdr; char doc[8040]; } MC_DOC_LINE_PREFIX_T; /******************************************************************************/ typedef struct { short ln_px[512][512]; /* short ln_px[1024][1024]; */ /* short ln_px[MAX_LINE_SNDR][MAX_ELEM_SNDR]; */ } SNDR_DATA_MATRIX_T; typedef struct { SNDR_DATA_MATRIX_T buf_chan[(HIGH_CHAN_SNDR + 1)]; MC_LINE_PREFIX_T mc_pre_ln[1024]; } SNDR_BUF_DATA_T; /******************************************************************************/ typedef struct { long beg_line; long end_line; long num_line; long beg_elem; long end_elem; long num_elem; long line_res; long elem_res; } SECTOR_T; typedef struct { long img_width; /* Variables IMX requires */ long img_height; long bits_per_pixel; long bytes_per_pixel; long pixels_per_byte; long lun; long status; } IMX_REQ_T; enum boolean { NO, YES }; struct PERFILE_T { long channel; SECTOR_T orig; SECTOR_T adj; char dwell[DWELL_LEN]; char directory[DIR_LEN]; char extension[EXT_LEN]; char filename[NAME_LEN]; long frl_written; long frl_wanted; IMX_REQ_T imx; long mc_uctx; long mc_rec_size; short id_num; short complete_image; short mc_headers_written; long line_drops; long segment_drops; struct PERFILE_T *next; }; /******************************************************************************/ ============================================================================== ============================================================================== /* atob1 transform GOES Mcidas full res (A) to ISCCP B1 data to get this to work use "compiler options / code generation/ 1 byte padding this code is most readable with a tab size of 4 characters g.g. campbell (9-11)/94 Reading the compressed format was added 7/95. It should not affect the output. 11/95 Detected an error in the processing of the compressed data This was fixed and replacement data was supplied. 1/96 Found that some of the channels saturate even in the 10 bit versions. This happens in steep solar angles so is of no consequence to ISCCP. CIRA CSU This runs on a PC with NT It can be run on a VAX with a few mods for the file name processing */ /* #define VAX 1 */ #define acamar 1 /* #define aquila 1 */ #define AMP 1 /* amplify the s.d. by sqrt(sqrt(var))*/ #define pcnum 1 /* 0 = acamar , 1 = aquila*/ #include #include #include #include #include #include #include #ifdef VAX #include #include #include #include #include #endif #ifdef aquila #include #include #include #include #include #include #endif #ifdef acamar #include #include #include #include #include #include #endif #define NSHIFTV 5 /* VIS shift to move to 10 bit data */ #define NSHIFTI 5 /* IR shift to move to 10 bit data */ #define B1B2X 16 #define B1B2Y 8 void gvarnams(argc,argv) /* construct the input files names */ int argc; char *argv[]; { char gn[100],gen[100],temp[7][100]; char *j,*pc; int k,in,nch; for (k = 0; k < argc; k++) strcpy(temp[k],argv[k]); strcpy(gn,argv[1]); sel_first(gn,gen); if(strcmp(gen,"empty") == 0) exit(33); pc=strrchr(gen,'\\'); strcpy(temp[1],gen); printf(" gen %s \n",gen); j = strstr(gen,"c0"); if(j == NULL) j = strstr(gen,"C0"); if(j == NULL) exit(17); nch=j-pc-1; strncpy(gn,pc+1,nch); gn[nch]=0; printf(" gn %s ",gn); sprintf(temp[1],"d:\\b1d\\%sB17",gn); printf(" |%s| \n",temp[1]); for (in = 1; in < 6; in++) { strcpy(temp[in+1],gen); j=strstr(temp[in+1],"C0"); if(j == NULL) j = strstr(temp[in+1],"c0"); sprintf(j,"C0%d",in); printf(" |%s| \n",temp[in+1]); } for (k = 1; k < argc; k++) { strcpy(argv[k],temp[k]); } } int irsampsd(inb,out,ch,nst,prisecond) /* sample ir accumulating the standard dev as well */ /* convert to byte for output */ /* assume inb contains two scan lines of data for construction of the S.D. */ unsigned short int *inb[]; CHANNEL *ch; int nst,prisecond; unsigned char *out; { int i; int iadd=1; register float sum,sum2; /* float sum2max; */ register long k,io,iosd,iosp; long *ip; long in0,in1,in2,in3; long nww; /* int icent; icent=ch->nwide/ch->xstep/2; /* printf(" scale offset smpsd %f %f %d \n",ch->scle[0],ch->scle[1],ch->isp); */ i=0; if(prisecond) ip = &in2; else ip = &in0; if( ch->goodbad[0] != 0 && ch->goodbad[1] != 0) { io = -nst; for (k=0 ; k < ch->nwide; k=k+ch->xstep) { io=io+nst; iosd=io+ch->isd; iosp=io+ch->isp; in0=*(inb[0]+k) >>NSHIFTI; in1=*(inb[0]+k+iadd) >>NSHIFTI; in2=*(inb[1]+k) >>NSHIFTI; in3=*(inb[1]+k+iadd) >>NSHIFTI; /* select the second channel rather than the first */ *(out+iosp)=(int)( ((float)(*ip)-ch->scle[1]) * ch->scle[0] ) & 0x00FF; sum = (float)( in0+in1+in2+in3 ) *.25F; sum2 =(float)( in0*in0+in1*in1+ in2*in2+in3*in3 ) *.25F; #if AMP sum2=sqrt(sqrt(sum2 - sum * sum)); /* accum the max if(sum2 > sum2max) sum2max=sum2; */ sum2=(sum2 >= ch->sclsd[1]) ? sum2 : ch->sclsd[1]; /* select a value so the following is positive */ sum2= (sum2-ch->sclsd[1]) * ch->sclsd[0]; #else sum2=sqrt(sum2-sum*sum); sum2= (sum2-ch->sclsd[1]) * ch->sclsd[0]; #endif *(out+iosd) = ((int) sum2 ) & 0x00FF; /* i=i+1; if(i == icent) { for (m = 0; m < nst; m++) printf(" %d",*(out+io+m)); printf(" %d %d %f %f %d %d %d \n",ch->isp,io,sum,sum2, *(out+iosp),*(out+iosd),in0 ); } */ } } else { if( ch->goodbad[0] == 0 || ch->goodbad[1] == 0) { nww = (ch->nwide-1)/ch->xstep+1; io = ch->isp-nst; iosd = ch->isd-nst; for (k=0 ; k < ch->nwide; k=k+ch->xstep) { in0=*(inb[0]+k); in2=*(inb[1]+k); io=io+nst; *(out+io)=(int)( ((float)( *ip >>NSHIFTI) - ch->scle[1] )/ ch->scle[0] ) & 0x00FF; iosd=iosd+nst; *(out+iosd)=255; /* missing s.d. */ } } else { nww=(ch->nwide-1)/ch->xstep+1; iosp=ch->isp-nst; iosd = ch->isd-nst; for (k=0; k < nww; k++) { iosp=iosp+nst; *(out+iosp)=255; /* missing data */ iosd=iosd+nst; *(out+iosd)=255; } } } i=0; /* printf(" sum2 ir max %d \n",sum2max); */ return i; } int irsamp(inb,out,ch,nst) /* sample one scan line of data */ /* convert to byte for output */ CHANNEL *ch; short int *inb[]; int nst; char *out; { register int k; /* int icent; */ register long iosp; long nww,intemp; /* printf(" scale offset samp %f %f %d %d %d \n", ch->scle[0],ch->scle[1],ch->isp,ch->goodbad[0],ch->nwide);*/ if( ch->goodbad[0] != 0) { iosp=-nst+ch->isp; for (k=0 ; k < ch->nwide; k=k+ch->xstep) { iosp=iosp+nst; intemp=*(inb[0]+k); *(out+iosp)=(int)( ( (float)(intemp >> NSHIFTI) - ch->scle[1] ) * ch->scle[0] ) & 0x00FF; } } else { nww=(ch->nwide-1)/ch->xstep+1; iosp=ch->isp-nst; for (k=0; k < nww; k++) { iosp=iosp+nst; *(out+iosp)=-1; /* missing data */ } printf(" no good data %d \n",ch->isp); } return iosp/nst; } int visave(inb,out,ch,nst,iadd) /* prepare means and variance and convert to byte from vis data */ /* assume inb contains 4 vis scan lines of data */ /* flaged by goodbad for use*/ short int *inb[]; CHANNEL *ch; int nst,iadd; unsigned char *out; { float sum,sum2,snn; /* float sum2max; */ float a,c; register long k; long nww,bad=0; long iosp,iosd; register int i,j,nnn,l; register long isum,isum2,ir; nww=(ch->nwide-ch->navx)/ch->xstep; /* sum2max=0.F; */ /* printf(" scale offset Vis %f %f %d \n",ch->scle[0],ch->scle[1],ch->isp); icent=nww/2; /* perhaps pass in the nww value */ /* printf(" nwide nww %d %d %d %d \n",ch->nwide,nww,ch->navx,ch->xstep); */ for (l=0 ; l < nww ; l++) { nnn=0; k=ch->xstep*l; isum=0; isum2=0; for (j = 0; j < ch->navy ; j++) { if( ch->goodbad[j] != 0) { for (i = k; i < k+ch->navx; i=i+iadd) { nnn=nnn+1; ir=*(inb[j]+i); ir=ir>>NSHIFTV; isum=isum+ir; isum2=isum2+ir*ir; /* if(l == icent) printf(" %d %d ",isum,ir); */ } } } iosp=l*nst+ch->isp; iosd=l*nst+ch->isd; snn = (float) nnn; if(snn > 0.) { sum=(float)isum; sum=sum/snn; sum2=(float)isum2; sum2=sum2/snn-sum*sum; #if AMP /* if(sum2 > sum2max) sum2max=sum2; */ sum2=(sum2 >= ch->sclsd[1]) ? sum2 : ch->sclsd[1]; sum2=sqrt(sqrt(sum2)); #else sum2=sqrt(sum2); #endif /* now conver to byte and put into out */ a=sum-ch->scle[1]; *(out+iosp)=(int)( a * ch->scle[0] ) & 0x00FF; c=sum2-ch->sclsd[1]; *(out+iosd)=(int) ( c * ch->sclsd[0] ) & 0x00FF; /* if(l == icent) printf(" %d %d %d %f %f %d %d \n", ch->isp,iosp,isum,sum,sum2, *(out+iosp),*(out+iosd) ); */ } else { *(out+iosp)=255; /* missing */ *(out+iosd)=255; bad=bad+1; } } /* printf(" sum2 vis %d ",sum2max); */ if(bad > 0 && bad < 20) printf(" bad vis sums %d \n",bad); return l; } int updathd(out,inp,nst,chan_map,ladd) /* update the file header */ CHANNEL *out,*inp; int nst,chan_map,ladd; { int i,j; i=sizeof(out->mc_area.comment); #if AMP strcpy(out->mc_area.calib_type,"ISCA"); #else strcpy(out->mc_area.calib_type,"ISC0"); #endif /* notice this overwrites the avg_or_sample, but that is filled later */ out->mc_area.avg_or_sample=2; out->mc_area.num_chan=nst; out->mc_area.sndr_filter_map=chan_map; strcpy( out->mc_area.comment, "ISCCP CIRA CSU V1.0 " ); for (j = 0; j < i; j++) printf ("%c", out->mc_area.comment[j]); printf(" = comment \n"); out->mc_area.img_id_num=nst+100; out->mc_area.line_res=out->ystep; out->mc_area.elem_res=out->xstep; out->mc_area.bytes_per_pixel=1; out->mc_area.num_line=out->nyout; out->mc_area.num_elem=out->nxout; out->mc_area.val_code=0; out->mc_area.pri_key_nav=out->mc_area.pri_key_nav+ladd; return nst; } int updatpre(out,in,mc_pre,chan_map,goodbad) /* move into from input headers to output headers */ CHANNEL *out,*in; MC_LINE_PREFIX_T *mc_pre; long chan_map; long goodbad; { /* printf(" merger prefix %d %d \n",chan_map,goodbad); */ out->isc_pre.imgr_2.num_pixels=out->mc_area.num_elem * out->mc_area.num_chan; out->isc_pre.imgr_2.channel = -1; out->isc_pre.imgr_2.det_num = -1; out->isc_pre.val_code = goodbad; out->isc_pre.chan_id=out->mc_area.num_chan+100; out->isc_pre.num_chan=out->mc_area.num_chan; out->isc_pre.west=out->mc_area.west_vis_pixel; out->isc_pre.nwide=out->nwide; out->isc_pre.linesize=sizeof(ISC_LINE_PREFIX)+ out->nwide*out->mc_area.num_chan; out->isc_pre.xstep=out->xstep; out->isc_pre.xave=out->navx; /* shuffle mc_pre into isc_pre */ memcpy(&out->isc_pre.time,&mc_pre->time, sizeof(MC_BCD_TIME_T)); memcpy(&out->isc_pre.imgr,&mc_pre->scan_stat.imgr, sizeof(IMGR_SCAN_STATUS_T)); out->isc_pre.blk_hdr.block_id=mc_pre->blk_hdr.block_id; out->isc_pre.blk_hdr.word_size=mc_pre->blk_hdr.word_size; out->isc_pre.blk_hdr.word_count=mc_pre->blk_hdr.word_count; out->isc_pre.blk_hdr.prod_id=mc_pre->blk_hdr.prod_id; out->isc_pre.blk_hdr.repeat_flag=mc_pre->blk_hdr.repeat_flag; out->isc_pre.blk_hdr.version=mc_pre->blk_hdr.version; out->isc_pre.blk_hdr.data_valid=mc_pre->blk_hdr.data_valid; out->isc_pre.blk_hdr.asc_bin=mc_pre->blk_hdr.asc_bin; out->isc_pre.blk_hdr.spare1=mc_pre->blk_hdr.spare1; out->isc_pre.blk_hdr.range=mc_pre->blk_hdr.range; out->isc_pre.blk_hdr.block_count=mc_pre->blk_hdr.block_count; out->isc_pre.blk_hdr.spare2=mc_pre->blk_hdr.spare2[0]; out->isc_pre.imgr_2.sat_id=mc_pre->line_doc.imgr_2.sat_id; out->isc_pre.imgr_2.sps_source=mc_pre->line_doc.imgr_2.sps_source; out->isc_pre.imgr_2.active_det_set=mc_pre->line_doc.imgr_2.active_det_set; out->isc_pre.imgr_2.det_num=mc_pre->line_doc.imgr_2.det_num; out->isc_pre.imgr_2.channel=out->mc_area.num_chan+100; out->isc_pre.imgr_2.imgr_stat1=mc_pre->line_doc.imgr_2.imgr_stat1; out->isc_pre.imgr_2.imgr_stat2=mc_pre->line_doc.imgr_2.imgr_stat2; out->isc_pre.imgr_2.pixel_offset=mc_pre->line_doc.imgr_2.pixel_offset; out->isc_pre.imgr_2.scan=mc_pre->line_doc.imgr_2.scan; out->isc_pre.imgr_2.num_pixels=mc_pre->line_doc.imgr_2.num_pixels; out->isc_pre.imgr_2.num_words=mc_pre->line_doc.imgr_2.num_words; out->isc_pre.line_number = (mc_pre->line_doc.imgr_2.scan-1) * 8 +1; /* this seems to be relative to the frame start, not an absolute unit */ /* if(out->isc_pre.line_number < 2000) printf(" out->isc_pre.line_number %d %d %d \n", out->isc_pre.line_number,mc_pre->line_doc.imgr_2.scan, in->mc_area.line_res ); */ /* convert scan number into full resolution line number if(goodbad != 0) printf(" goodbad %d \n",goodbad); printf(" merge done \n"); */ return 1; } void unpack_pre(rawhd,mc_pre) char *rawhd,*mc_pre; { int len; len=sizeof(MC_LINE_PREFIX_T); memcpy(mc_pre,rawhd,len); } void mc_pre_trans(inp,is) /* move raw header into structure, */ /* save up the sensor info for interlaced data */ CHANNEL *inp; int is;/* this is the scanline component of this channel */ { unpack_pre(inp->linehd[is],&inp->mc_pre.val_code); /* preprnt(&inp->mc_pre.val_code); */ inp->goodbad[is]=inp->mc_pre.line_doc.imgr_2.scan; if(inp->goodbad[is] == 0) printf(" bad line %d \n",is); inp->sensor[2+is]=inp->mc_pre.line_doc.imgr_2.det_num; inp->sensor[1]=inp->mc_pre.line_doc.imgr_2.active_det_set; inp->sensor[0]=inp->mc_pre.line_doc.imgr_2.channel; } void caltab(ISCHEAD *outisc) { printf(" insert cal printout \n"); } void makisch(inp,out,outisc,prisec,mc_cal,iadd) /* construct the ASCII isccp information for output to *out.fp */ CHANNEL *inp[5],*out; ISCHEAD *outisc; int prisec,iadd; MCIDAS_CAL_HDR *mc_cal; { float xcal10[50]; int in,n75,i; for (in =0; in < 5; in++) { sprintf(outisc->scale[in],"%f",inp[in]->scle[0]); sprintf(outisc->offset[in],"%f",inp[in]->scle[1]); sprintf(outisc->sampx[in],"%d",out->mc_area.elem_res); sprintf(outisc->sampy[in],"%d",out->mc_area.line_res); sprintf(outisc->averx[in],"%d",inp[in]->navx); sprintf(outisc->avery[in],"%d",inp[in]->navy); sprintf(outisc->sens[in],"%d %d %d %d %d %d channel sensor set num", inp[in]->sensor[0],inp[in]->sensor[1],inp[in]->sensor[2], inp[in]->sensor[3],inp[in]->sensor[4],inp[in]->sensor[5]); } in=5; sprintf(outisc->scale[in],"%f",inp[0]->sclsd[0]); sprintf(outisc->offset[in],"%f",inp[0]->sclsd[1]); sprintf(outisc->sampx[in],"%d",out->mc_area.elem_res); sprintf(outisc->sampy[in],"%d",out->mc_area.line_res); sprintf(outisc->averx[in],"%d",inp[0]->navx); sprintf(outisc->avery[in],"%d",inp[0]->navy); sprintf(outisc->sens[in],"%d %d %d %d %d %d channel sensor set num", inp[0]->sensor[0],inp[0]->sensor[1],inp[0]->sensor[2], inp[0]->sensor[3],inp[0]->sensor[4],inp[0]->sensor[5]); in=6; sprintf(outisc->scale[in],"%f",inp[3]->sclsd[0]); sprintf(outisc->offset[in],"%f",inp[3]->sclsd[1]); sprintf(outisc->sampx[in],"%d",out->mc_area.elem_res); sprintf(outisc->sampy[in],"%d",out->mc_area.line_res); sprintf(outisc->averx[in],"%d",inp[3]->navx); sprintf(outisc->avery[in],"%d",inp[3]->navy); sprintf(outisc->sens[in],"%d %d %d %d %d %d channel sensor set num", inp[3]->sensor[0],inp[3]->sensor[1],inp[3]->sensor[2], inp[3]->sensor[3],inp[3]->sensor[4],inp[3]->sensor[5]); sprintf(outisc->text,"ISCCP ASCII SCALE,OFFSET,SAMPX,AVERX,SAMPY,AVERY"); sprintf(outisc->primary_secondary," primary or secondary %d",prisec); #if AMP sprintf(outisc->news,"s.d. = sqrt(sqrt(var)) iadd= %d",iadd); #else sprintf(outisc->news,"s.d. = sqrt(var) iadd= %d",iadd); #endif strcpy(outisc->text,out->name); /* prntcal(mc_cal); */ n75=sizeof(outisc->cal10)/12; printf(" %d num cal parameters \n",n75); for (i=0; i < n75; i++) { xcal10[i]=seltopc(&(mc_cal->cal[i])); sprintf(outisc->cal10[i],"%f ",xcal10[i]); printf("%d %s \n",i,outisc->cal10[i]); } } void makenam(outn,inn) char *outn[]; char inn[]; { printf(" makenam \n"); } void maxacu(out,nx,nst,min,max) /* accumulate the extremes of the data for later print out */ unsigned char *out; unsigned char *max,*min; { register i,k; for (k = 0; k < nst; k++) for (i = 0; i < nx; i++) { if(*(out+i*nst+k) > *(max+k) && *(out+i*nst+k) != 255) *(max+k) = *(out+i*nst+k); if(*(out+i*nst+k) < *(min+k) ) *(min+k) = *(out+i*nst+k); } } void trimsect(MCIDAS_DATDIR_AREA_HDR_T *mc,long *eastshift,long *southshift, long west,long east,long north,long south) /* trim down the sector if it is too big */ { long nsub; if(mc->west_vis_pixel < west) { *eastshift=( (west - mc->west_vis_pixel)/4 ) * 4; mc->west_vis_pixel = mc->west_vis_pixel + *eastshift; mc->num_elem = mc->num_elem - *eastshift/mc->elem_res; } if(mc->west_vis_pixel + mc->elem_res * mc->num_elem > east) { nsub = mc->west_vis_pixel + mc->elem_res * mc->num_elem - east; nsub = (nsub/4) * 4; mc->num_elem = mc->num_elem - nsub/mc->elem_res; } if(mc->north_bound < north) { printf(" trim north edge %d %d %d \n",north, mc->north_bound,mc->num_line); *southshift=north - mc->north_bound; *southshift=(( *southshift-1) / 8 ) * 8; /* round to multiple of 8 because channel 3 is tranmitted as a multiple of 8 vis lines */ mc->north_bound=mc->north_bound + *southshift; mc->num_line=mc->num_line - *southshift/mc->line_res; printf(" trim north edge %d %d %d \n",north, mc->north_bound,mc->num_line); } if(mc->north_bound+mc->num_line * mc->line_res > south) { mc->num_line = (south-mc->north_bound-1)/mc->line_res+1; printf(" trim south edge %d %d %d \n",south, mc->north_bound,mc->num_line); } printf(" amount trimmed %d %d \n",*eastshift,*southshift); printf(" nelem,nline %d %d \n",mc->num_elem,mc->num_line); } /* Process sectorized GVAR data file [*.c01,.c02,.c03,.c04,.c05] into interlaced ISCCP B1 data files. This samples the IR pixels to B1X,B1Y sampling. It averages the visible data to the same size pixel as the IR and samples it to the same spacing. Hopefully the raw data is aligned. Headers are constructed so that MCIDAS software can process the data files. Some work needs to be done on the NAVIGATION and CALIBRATION to document that the information is transfered to the output file correctly. The companion program MCB2 will sample this output to the B2 resolution. G.G. Campbell 9/94 */ void main (nargc, nargv) int nargc; char *nargv[]; { ISCHEAD outisc; CHANNEL inp[5],out; CHANNEL *inpp[5]; int argc=5; #ifdef all int iadd=1; #else int iadd=2; #endif char dum[] = "d:\\Russ\\out\\9*.c04"; char labd[]="D",lbbb[]="B"; char notrim[]=" notrim"; char *nvcal_buf; char newname[80]; char *arg[7]; long chan_map,icm,flg,flgold; long iscan,eastshift=0,southshift=0; unsigned char max[10],min[10]; int ir,in,nvcalsiz,ladd,prisec=1; int k,lpro,i,ichanl[7],icp; long q,xstep,ystep; long westlimit=6001,eastlimit=24720; long northlimit=2481,southlimit=14640; long nrd; int ichgood[5]; int nst,n7=7,numfr; for (in=0 ; in < n7; in++) arg[in]=(char *) calloc(80,1); if(nargc > 1) strcpy(arg[1],nargv[1]); else strcpy(arg[1],dum); printf(" start %d \n",nargc); if(nargc > 1) { printf(" strcmp %d \n",strcmp(nargv[1],notrim)); if(strcmp(nargv[1],notrim) != 0) { strcpy(arg[1],dum); printf(" not triming \n"); northlimit=0; southlimit=20000; westlimit=0; eastlimit=28000; } } if(nargc > 2) { if(strcmp(nargv[2],notrim) != 0) { printf(" not triming \n"); northlimit=0; southlimit=20000; westlimit=0; eastlimit=28000; } } for (in = 0; in < nargc; in++) printf(" %s ",nargv[in]); printf(" input \n"); gvarnams(n7,arg); for (in = 1; in < 7; in++) printf(" %d %s|\n",in,arg[in]); printf(" files \n"); strcpy(out.name,arg[1]); printf(" out %s \n",out.name); for (in = 0; in < 5; in++) strcpy(inp[in].name,arg[in+2]); printf(" ready to begin \n"); for ( k=0; k < 5; k++) { /* 0 0 102 1 7 87 2 3 54 3 0 97 from .25 and 2. factors 4 0 103 5 0 192 6 0 148 */ inp[k].scle[0]=.25F; inp[k].scle[1]=0.F; inp[k].sclsd[0]=2.F; inp[k].sclsd[1]=0.F; inp[k].isd=-1; inp[k].isp=-1; for (i =0 ; i<4 ; i++) inp[k].goodbad[i]=0; } inp[0].scle[0]=.25F; inp[1].scle[0]=.25F; inp[2].scle[0]=.5F; inp[3].scle[0]=.25F; inp[4].scle[0]=.25F; #if AMP /* not used inp[0].sclsd[0]=256.F/(log10(200.F)+log10(10.F)); inp[0].sclsd[1]=-log10(10.); inp[3].sclsd[0]=256.F/(log10(170.F)+log10(10.F)); inp[3].sclsd[1]=-log10(10.); */ /* the following gives more weight to the lower values */ inp[0].sclsd[0]= 256.F / sqrt(sqrt(16000.F)); inp[0].sclsd[1]=0.; inp[3].sclsd[0]=256.F / sqrt(sqrt(10000.F)); inp[3].sclsd[1]=0.; #else inp[0].sclsd[0]=1.25F; inp[3].sclsd[0]=1.5F; #endif xstep=B1B2X; inp[0].nr=4; inp[1].nr=1; inp[2].nr=1; inp[3].nr=2; inp[4].nr=1; if(prisec) /* primary skips */ { printf(" primary channel"); inp[0].nskip=4; inp[1].nskip=1; inp[2].nskip=0; inp[3].nskip=0; inp[4].nskip=1; } else { inp[0].nskip=0; inp[1].nskip=0; inp[2].nskip=0; inp[3].nskip=0; inp[4].nskip=0; } ystep=B1B2Y; inp[0].navx=7; inp[1].navx=1; inp[2].navx=1; inp[3].navx=1; inp[4].navx=1; inp[0].navy=4; inp[1].navy=1; inp[2].navy=1; inp[3].navy=1; inp[4].navy=1; out.navx=inp[0].navx; nst=0; icp=-1; for (in = 0; in < 5; in++) { inpp[in]=&inp[in]; if( (inp[in].fp = fopen(inp[in].name,"rb")) == NULL ) { printf (" Cannot find file %s \n", inp[in].name); ichgood[in]=1; } /* read the mc header */ else { ichgood[in]=0; nst=nst+1; inp[in].isp=nst-1; ichanl[nst-1]=in+1; numfr=fread (&inp[in].mc_area,1,sizeof(MCIDAS_DATDIR_AREA_HDR_T), inp[in].fp); if(numfr != sizeof(MCIDAS_DATDIR_AREA_HDR_T)) { printf(" bad header read %d %d \n",numfr,in); exit(71); } if(icp < 0) icp=in; if(in == 3) icp=3; inp[in].nx=inp[in].mc_area.num_byte_ln_prefix+ inp[in].mc_area.num_elem* inp[in].mc_area.bytes_per_pixel; /* record the true length of the data lines before triming them */ mcprnt(&inp[in].mc_area); trimsect(&inp[in].mc_area,&eastshift,&southshift, westlimit,eastlimit,northlimit,southlimit); inp[in].nskip=inp[in].nskip+southshift/inp[in].mc_area.line_res; printf(" eastshift %d southshift %d skip %d \n", eastshift,southshift,inp[in].nskip); mcprnt(&inp[in].mc_area); inp[in].ystep=ystep/inp[in].mc_area.line_res; if(inp[in].ystep == 0) inp[in].ystep=1; inp[in].xstep=xstep/inp[in].mc_area.elem_res; if(inp[in].xstep == 0) inp[in].xstep=1; /* read the mc nav and cal info */ inp[in].byp=inp[in].mc_area.pri_key_nav; inp[in].nwide=inp[in].mc_area.num_elem; /* printf(" size hd %d %d %d \n",sizeof(MC_LINE_PREFIX_T), inp[in].mc_area.num_elem, inp[in].mc_area.bytes_per_pixel );*/ inp[in].nyout=inp[in].mc_area.num_line/inp[in].ystep; /* nbuf=inp[in].mc_area.num_elem*inp[in].mc_area.bytes_per_pixel* inp[in].navy; */ inp[in].linehd[0]=(char *)calloc(inp[in].nx,inp[in].nr); for(ir=0; ir< 6; ir++) inp[in].sensor[ir]=0; for(ir=0; ir< inp[in].nr; ir++) { inp[in].linehd[ir]=inp[in].linehd[0]+inp[in].nx*ir; /* printf(" line %p \n",inp[in].linehd[ir]); */ inp[in].in_buf[ir]=(short int *)(inp[in].linehd[ir]+ inp[in].mc_area.num_byte_ln_prefix + (eastshift * inp[in].mc_area.bytes_per_pixel) / inp[in].mc_area.elem_res); if(eastshift != 0) printf(" in_buf point %d %d %d %d \n",inp[in].in_buf[ir], inp[in].linehd[ir],inp[in].nwide, inp[in].nyout ); } } } for (in=0; in < 5; in++) { if(inp[0].fp != NULL) { if((inp[icp].mc_area.north_bound != inp[in].mc_area.north_bound) || (inp[icp].mc_area.west_vis_pixel != inp[in].mc_area.west_vis_pixel)) { printf(" in %d %d \n",icp,in); printf(" %d %d \n",inp[icp].mc_area.north_bound, inp[in].mc_area.north_bound ); printf(" %d %d %d \n",inp[icp].mc_area.west_vis_pixel, inp[in].mc_area.west_vis_pixel,inp[in].mc_area.line_res ); printf(" %s %s \n ",inp[icp].name,inp[in].name); printf(" corner of images do not match \n"); inp[in].nskip=inp[in].nskip+ (inp[icp].mc_area.north_bound-inp[in].mc_area.north_bound)/ inp[in].mc_area.line_res; printf(" new skip for %d %d \n",inp[in].nskip,in); /* for (in = 0; in < 5; in++) { if(inp[in].fp != NULL) fclose (inp[in].fp); strcpy(newname,inp[in].name); strcat(newname,"B"); rename(inp[in].name,newname); } exit(1); */ } printf(" skip %d %d \n",inp[in].nskip,in); } } if(nst <= 0) exit(15); if ( (out.fp = fopen (out.name, "wb+")) == NULL ) { printf ("\nCannot open out file '%s'; exiting...\n\n", out.name); exit(1); } if(inp[0].fp != NULL) { nst=nst+1; inp[0].isd=nst-1; ichanl[nst-1]=21; } if(inp[3].fp != NULL) { nst=nst+1; inp[3].isd=nst-1; ichanl[nst-1]=24; } chan_map=0; for ( k=0 ; k int compabc( const void *arg1, const void *arg2 ) { /* Compare all of both strings: */ return _stricmp( * ( char** ) arg1, * ( char** ) arg2 ); } void sort_fil( int argc, char **argv ) { /* int i; */ /* Sort remaining args using Quicksort algorithm: */ qsort( (void *)argv, (size_t)argc, sizeof( char * ), compabc ); /* Output sorted list: */ /* for( i = 0; i < argc; ++i ) printf( "%s ", argv[i] ); printf( "\n" ); */ } void sel_first(char *inn,char *outn) { char drive[_MAX_DRIVE]; char dir[_MAX_DIR]; char fname[_MAX_FNAME]; char ext[_MAX_EXT],ext2[_MAX_EXT]; struct _finddata_t c_file[400]; char *c_f[400]; /* one would need to bump this up if there are more than 400 files in the list */ int numfil; char *pc; int nch,nbr; long hFile; if( (hFile = _findfirst(inn,&(c_file[0]) )) == -1L) { printf(" no file like %s \n",inn); strcpy(outn,"empty"); return; } else { numfil=0; c_f[numfil]=(char *)&(c_file[numfil].name); numfil=1; while( _findnext( hFile, &(c_file[numfil]) ) == 0 ) { c_f[numfil]=(char *)&(c_file[numfil].name); numfil++; } _findclose(hFile); /* files come back in some kind of random order */ for (nch = 0; nch < numfil; nch++) printf(" RAW %s \n",c_f[nch]); sort_fil( numfil, &c_f[0] ) ; /* this puts them into alphabetical order or numberical order */ for (nch = 0; nch < numfil; nch++) printf(" sort %s \n",c_f[nch]); for (nch = 0; nch < numfil; nch++) { printf(" check %s \n",c_f[nch]); pc=strrchr(inn,'\\'); _splitpath( inn, drive, dir, fname, ext ); if(pc != NULL) { nbr=pc-inn+1; strncpy(outn,inn,nbr); printf(" pc nbr %d %d \n",pc,nbr); outn[nbr]=0; printf(" prefix %s \n",outn); } else { outn[0]=0; } strcat(outn,c_f[nch]); _splitpath( outn, drive, dir, fname, ext2 ); if(strcmp(ext,ext2) != 0) { printf(" suffixes %s %s \n",ext,ext2); strcpy(outn,"empty"); } else { nch=numfil; } } /* printf(" outn1 %s \n",outn); */ } printf(" found %s \n",outn); } /* seltopc2.c */ /*#include "sect2.h"*/ float seltopc (float *flt2_ptr) { /* Russel Gartner 9/94 convert Gould floating point to PC floating point */ float flt, *flt_ptr; long lng, *lng_ptr, tmp; short s, q; long expon, mantis; short left, found; flt_ptr = flt2_ptr; lng_ptr = (long *) flt_ptr; lng = *lng_ptr; /* printf ("%08X\n", lng); */ if (lng == 0) { return (0.0F); } s = ((lng & 0x80000000) >> 31) & 0x00000001; if (s == 1) { lng = ~lng; lng++; } expon = ((lng & 0xFF000000) >> 24) & 0x0000007F;; expon = expon - 0x40; expon = expon * 4; mantis = lng & 0x00FFFFFF; found = 0; left = 0; for (q = (sizeof (mantis) * 8); q > 0; q--) { tmp = 0; tmp = (mantis >> (q - 1) ); tmp = tmp & 0x00000001; if (q <= 24) { if ((tmp == 1) && (found == 0)) { found = 1; left = 24 - q; } } } mantis = mantis << left; mantis = mantis & 0x7FFFFF; expon = expon - left - 2; expon = expon + 0x80; lng = (s << 31) & 0x80000000; lng = lng | (expon << 23); lng = lng | mantis; lng_ptr = &lng; flt_ptr = (float *) lng_ptr; flt = *flt_ptr; /* printf(" %08X %f ",lng,flt); */ return (flt); } void mcprnt(MCIDAS_DATDIR_AREA_HDR_T *mc_area) /* print the MCIDAS header informaiton */ { char s[40]; long yy; long ddd; long hh; long mm; long ss; long q; long byp; byp=sizeof (MCIDAS_DATDIR_AREA_HDR_T); printf (" byp %d\n",byp); printf ("\n Area directory\n"); switch (mc_area->sat_id_num) { case 32: strcpy (s, "GOES-7 Visible"); break; case 33: strcpy (s, "GOES-7 Infrared"); break; case 70: strcpy (s, "GOES-8 (Imager)"); break; case 71: strcpy (s, "GOES-8 (Sounder)"); break; case 72: strcpy (s, "GOES-J (Imager)"); break; case 73: strcpy (s, "GOES-J (Sounder)"); break; case 74: strcpy (s, "GOES-K (Imager)"); break; case 75: strcpy (s, "GOES-K (Sounder)"); break; case 76: strcpy (s, "GOES-L (Imager)"); break; case 77: strcpy (s, "GOES-L (Sounder)"); break; case 78: strcpy (s, "GOES-M (Imager)"); break; case 79: strcpy (s, "GOES-M (Sounder)"); break; default: strcpy (s, "Unknown"); break; } printf ("%22u Satellite id: %s\n", mc_area->sat_id_num, s); printf (" '"); for (q = 0; q < 4; q++) { printf ("%c", mc_area->src_type[q]); } printf ("' Source type:\n"); printf (" '"); for (q = 0; q < 4; q++) { printf ("%c", mc_area->calib_type[q]); } printf ("' Calibration type:\n"); yy = mc_area->img_date / 1000; ddd = mc_area->img_date - (yy * 1000); printf ("%22u Image date: %02d/%03d\n", mc_area->img_date, yy, ddd); hh = mc_area->img_time / 10000; mm = (mc_area->img_time - (hh * 10000)) / 100; ss = mc_area->img_time - (hh * 10000) - (mm * 100); printf ("%22u Image time: %02d:%02d:%02d\n", mc_area->img_time, hh, mm, ss); for (q = 0; q < 16; q++) { /* if (mc_area->comment[q] == NULL) */ /* { printf (" "); */ /* } */ /* else */ /* { */ printf ("%c", mc_area->comment[q]); /* } */ } printf ("' Comment: (first half)\n"); for (q = 16; q < 32; q++) { /* if (mc_area->comment[q] == NULL) */ /* { printf (" "); */ /* } */ /* else */ /* { */ printf ("%c", mc_area->comment[q]); /* } */ } printf ("' (last half)\n"); printf ("%22u Number of channels:\n", mc_area->num_chan); printf ("%22u Channel filter map: %24X\n", mc_area->sndr_filter_map, mc_area->sndr_filter_map); printf (" Existing channel(s):\n"); for (q = 0; q < 32; q++) { if ( (((mc_area->sndr_filter_map >> q)) & 0x1) == 1) { printf (" Channel %d\n", (q + 1)); } } printf ("%22u Starting line:\n", mc_area->north_bound); printf ("%22u Starting element:\n", mc_area->west_vis_pixel); printf ("%22u Number of lines:\n", mc_area->num_line); printf ("%22u Number of elements:\n", mc_area->num_elem); printf ("%22u Line resolution:\n", mc_area->line_res); printf ("%22u Element resolution:\n", mc_area->elem_res); printf ("%22u Average or sample:\n",mc_area->avg_or_sample); printf ("%22u Offset to navigation: (bytes)\n", mc_area->sec_key_nav); printf ("%22u Offset to calibration: (bytes)\n", mc_area->cal_loc); printf ("%22u Offset to data: (bytes)\n", mc_area->pri_key_nav); printf ("%22u Bytes per element:\n", mc_area->bytes_per_pixel); printf ("%22u Line prefix length: (bytes)\n", mc_area->num_byte_ln_prefix); printf ("%22u Validity code: %08X\n", mc_area->val_code, mc_area->val_code); } #if VAX void sel_fil(char *outn,char *inn) { FILE *fp; char next[90]; int sp; char *p; p = strstr(inn , "*" ); if( p != NULL ) { printf(" search for file name %s \n",inn); sp=sprintf(next,"$dir %s/output=dir.lst/noheader/notrailing",inn); system(next); fp=fopen("dir.lst","r"); fgets(next,80,fp); fclose(fp); strcpy(outn,next); system("$del dir.lst;*"); } else { strcpy(outn,inn); } } #else void sel_fil(char *inn,char *outn) /* select a file in a list from a general file name input */ { char drive[_MAX_DRIVE]; char dir[_MAX_DIR]; char fname[_MAX_FNAME],fname2[_MAX_FNAME]; char ext[_MAX_EXT],ext2[_MAX_EXT]; struct _finddata_t c_file; char *pc; int nch; long hFile; if( (hFile = _findfirst(inn,&c_file)) == -1L) { printf(" no file like %s \n",inn); strcpy(outn,"empty"); } else { printf(" found %s \n",c_file.name); pc=strrchr(inn,'\\'); _splitpath( inn, drive, dir, fname, ext ); printf(" %p %p \n",inn,pc); if(pc != NULL) { nch=pc-inn+1; strncpy(outn,inn,nch); outn[nch]=0; printf(" outn %s \n",outn); } strcat(outn,c_file.name); printf(" outn1 %s \n",outn); _splitpath( outn, drive, dir, fname2, ext2 ); printf(" names %s %s \n",fname,fname2); printf(" exts %s %s \n",ext,ext2); if(strcmp(ext,ext2) == 0) { printf(" found %s \n",outn); return; } /* scan for the next name and check again */ while( _findnext( hFile, &c_file ) == 0 ) { printf(" found %s \n",c_file.name); pc=strrchr(inn,'\\'); _splitpath( inn, drive, dir, fname, ext ); printf(" %p %p \n",inn,pc); if(pc != NULL) { nch=pc-inn+1; strncpy(outn,inn,nch); printf(outn); } strcat(outn,c_file.name); _splitpath( outn, drive, dir, fname2, ext2 ); printf(" names %s %s \n",fname,fname2); printf(" exts %s %s \n",ext,ext2); if(strcmp(ext,ext2) == 0) { printf(" found %s \n",c_file.name); _findclose(hFile); return; } } strcpy(outn,"empty"); _findclose(hFile); } } #endif void prtbcd(MC_BCD_TIME_T *bcd) { printf (" %X%X%X%X,%X%X%X,%X%X:%X%X:%X%X.%X%X%X ", bcd->year_1000,bcd->year_100,bcd->year_10,bcd->year_1, bcd->day_100,bcd->day_10,bcd->day_1,bcd->hour_10,bcd->hour_1, bcd->min_10,bcd->min_1,bcd->sec_10,bcd->sec_1, bcd->msec_100,bcd->msec_10,bcd->msec_1); } void prtbcd_old(BCD_TIME_T *bcd) /* process un shuffled bcd times */ { printf (" %X%X%X%X,%X%X%X,%X%X:%X%X:%X%X.%X%X%X ", bcd->year_1000,bcd->year_100,bcd->year_10,bcd->year_1, bcd->day_100,bcd->day_10,bcd->day_1,bcd->hour_10,bcd->hour_1, bcd->min_10,bcd->min_1,bcd->sec_10,bcd->sec_1, bcd->msec_100,bcd->msec_10,bcd->msec_1); } void preiscprnt(ISC_LINE_PREFIX *isc_pre) /* print ISCCP scan line headers */ { printf(" linesize %d \n",isc_pre->linesize); printf(" line_number %d \n",isc_pre->line_number); printf(" west edge %d \n ",isc_pre->west); printf(" nwide %d \n",isc_pre->nwide); printf(" chan_id %d \n",isc_pre->chan_id); printf(" xave %d \n",isc_pre->xave); printf(" number of channels %d \n",isc_pre->num_chan); printf(" xstep %d \n",isc_pre->xstep); prtbcd(&isc_pre->time); printf (" EW:%d", isc_pre->imgr.east_west); printf (" sensor %d",isc_pre->imgr_2.det_num); printf (" channel %d \n",isc_pre->imgr_2.channel); printf(" gb %d",isc_pre->val_code); printf(" west %d \n",isc_pre->west); /* west edge */ printf(" width %d \n",isc_pre->nwide); /* pixels/channel in this line */ printf(" xstep %d \n",isc_pre->xstep); /* step in elem direction */ printf(" average %d \n",isc_pre->xave); /* average interval for vis */ printf(" sps_s %d ",isc_pre->imgr_2.sps_source); printf(" scan %d ",isc_pre->imgr_2.scan); printf(" stat1 %d ",isc_pre->imgr_2.imgr_stat1); printf(" stat2 %d \n",isc_pre->imgr_2.imgr_stat2); printf(" numpix %d ",isc_pre->imgr_2.num_pixels); printf(" numword %d ",isc_pre->imgr_2.num_words); printf(" pix off %d \n",isc_pre->imgr_2.pixel_offset); } void prntcal(MCIDAS_CAL_HDR *mc_cal) { int i,j; printf(" mc cal info \n"); for (j = 0; j < 8; j++) { for (i = j; i < 24; i=i+8) printf(" %f",seltopc(&(mc_cal->cal[i]))); printf("\n"); } printf(" alb %f \n",seltopc(&(mc_cal->cal[24]))); } void prntblk0(BLOCK_0_IMGR_DOC_T *blk0) { printf(" block 0 direct satellite transmission %d \n"); prtbcd(&(blk0->cur_sps_time)); /* TCURR */ printf(" cur sps time \n"); prtbcd(&(blk0->cur_hdr_time)); /* TCHED */ printf(" hdr time \n"); prtbcd(&(blk0->cur_trlr_time)); /* TCTRL */ printf(" trlr time \n"); prtbcd(&(blk0->lag_hdr_time)); /* TLHED */ printf(" lag hdr time \n"); prtbcd(&(blk0->lag_trlr_time)); /* TLTRL */ printf(" lag trlr time \n"); prtbcd(&(blk0->prio_start)); /* TIPFS */ printf(" priority start time \n"); prtbcd(&(blk0->norm_start)); /* TINFS */ printf(" normal start time \n"); prtbcd(&(blk0->last_spc_calib)); /* TISPC */ printf(" last spc calib \n"); prtbcd(&(blk0->last_elec_calib)); /* TIECL */ printf(" last elec calib \n"); prtbcd(&(blk0->last_blkbdy_calib)); /* TIBBC */ printf(" last black body calib \n"); prtbcd(&(blk0->last_star_sense)); /* TISTR */ printf(" last star sense \n"); prtbcd(&(blk0->last_rang_meas)); /* TLRAN */ printf(" last range measure \n"); prtbcd(&(blk0->cur_ir_calib_time)); /* TIIRT */ printf(" current ir cal time \n"); prtbcd(&(blk0->cur_vis_nlut_time)); /* TIVIT */ printf(" current vis nlut time \n"); prtbcd(&(blk0->cur_limits_time)); /* TCLMT */ printf(" current limits time \n"); prtbcd(&(blk0->cur_oa_time)); /* TIONA */ printf(" current orbit attitude time \n"); } void preprnt(MC_LINE_PREFIX_T *mc_pre) /* print raw scan line headers */ { prtbcd(&mc_pre->time); /* prtbcd_old(&mc_pre->time); */ printf (" EW:%d", mc_pre->scan_stat.imgr.east_west); printf (" sensor %d",mc_pre->line_doc.imgr_2.det_num); printf (" channel %d \n",mc_pre->line_doc.imgr_2.channel); printf(" gb %d",mc_pre->val_code); printf(" sps_s %d ",mc_pre->line_doc.imgr_2.sps_source); printf(" scan %d \n",mc_pre->line_doc.imgr_2.scan); printf(" stat1 %d ",mc_pre->line_doc.imgr_2.imgr_stat1); printf(" stat2 %d \n",mc_pre->line_doc.imgr_2.imgr_stat2); printf(" numpix %d ",mc_pre->line_doc.imgr_2.num_pixels); printf(" numword %d ",mc_pre->line_doc.imgr_2.num_words); printf(" pix off %d \n",mc_pre->line_doc.imgr_2.pixel_offset); } void prntnav(MCIDAS_NX_NAV_GVAR_HDR_T *mc_nav) { printf(" IMC status %s ",mc_nav->IMC_status); printf(" nav size %d \n",sizeof(MCIDAS_NX_NAV_GVAR_HDR_T)); printf(" long,dist,lat %d %d %d \n",mc_nav->ref_long,mc_nav->ref_rad_dist, mc_nav->ref_lat); printf(" yaw,rol,pitch %d %d %d \n",\ mc_nav->ref_att_yaw,mc_nav->ref_att_roll, mc_nav->ref_att_pitch); printf(" ref yaw,rol,pitch %d %d %d \n",mc_nav->ref_att_yaw); prtbcd(&(mc_nav->epoch_time)); printf(" epoch time \n"); printf(" start time %d \n",mc_nav->start_time); printf(" yaw,rol,pitch %d %d %d \n", mc_nav->IMC_corr_yaw,mc_nav->IMC_corr_roll,mc_nav->IMC_corr_pitch); printf(" ref_long_ch,ref_rad_dis_ch %d %d \n",mc_nav->ref_long_change[0], mc_nav->ref_rad_dist_change[0]); printf(" sine_lat %d sine orb yaw %d \n",mc_nav->sine_lat[0], mc_nav->sine_orb_yaw[0]); printf(" solar_rate %d \n",mc_nav->solar_rate); } ============================================================================== ============================================================================== /* mcread2.c */ /* #define VAX 1*/ /* #define acamar 1 */ #define aquila 1 #include #include #include #include #include #ifdef VAX #include #include #include #include #include #endif #ifdef acamar #include #include #include #include #include #include #endif #ifdef aquila #include #include #include #include #include #include #endif #define B1X 16 #define B1Y 8 #define B2X 48 #define B2Y 32 int updathd(out,inp,nst,chan_map,ladd) CHANNEL *out,*inp; int nst,chan_map,ladd; { out->mc_area.num_chan=nst; out->mc_area.sndr_filter_map=chan_map; /* (void) strcat( out->mc_area.comment, "ISCCP CIRA CSU V1.0" ); */ printf(" o.c %s ",out->mc_area.comment); out->mc_area.img_id_num=nst+100; out->mc_area.line_res=inp->ystep*inp->mc_area.line_res; out->mc_area.elem_res=inp->xstep*inp->mc_area.elem_res; out->mc_area.bytes_per_pixel=1; out->mc_area.num_line=out->nyout; out->mc_area.num_elem=out->nxout; out->mc_area.val_code=0; out->mc_area.pri_key_nav=out->mc_area.pri_key_nav+ladd; return nst; } void updatischd(out,outisc) CHANNEL *out; ISCHEAD *outisc; { int in; int nst; nst=out->mc_area.num_chan; for (in =0; in < nst; in++) { sprintf(outisc->sampx[in],"%d",out->mc_area.elem_res); sprintf(outisc->sampy[in],"%d",out->mc_area.line_res); } } void updatb2pre(out) CHANNEL *out; { out->isc_pre.nwide=out->mc_area.num_elem; out->isc_pre.linesize=sizeof(ISC_LINE_PREFIX)+ out->isc_pre.nwide*out->mc_area.num_chan; out->isc_pre.xstep=out->mc_area.elem_res; /* step size in vis pixel units */ } void sampb1b2(out,in,dxstep,nst,wide) char *out,*in; int nst,dxstep; long wide; { register int i,j,jj,j1,j2; i=0; for (j = 0 ; j < wide ; j++) { j1=j*dxstep*nst; j2=j1+nst; for (jj = j1 ; jj < j2 ; jj++) { *(out+i)=*(in+jj); i=i+1; } } } void makb2nam(inn,outn) char *inn,*outn; { char *j,*b; printf(" makb2nam %s \n",inn); strcpy(outn,inn); printf(" outn %s \n",outn); j=strstr(outn,".B1"); if(j == NULL) j=strstr(outn,".b1"); if(j == NULL) exit(10); else sprintf(j,".B27"); printf(" output %s \n",outn); } void main (argc, nargv) /* sample the B1 data into B2 data, all averaging and interleaving done in B1 program */ int argc; char *nargv[]; { CHANNEL inp,out; ISCHEAD outisc; char *nvcal_buf,*jch,*j; char newname[80]; long chan_map; int in,nvcalsiz,ladd; int i,icp; long q; unsigned char *ptbuf; int dystep; long nrd,nbuf; int nst,n7=7; #ifdef acamar char dum[]="d:\\camp\\temp\\*.B17"; #endif #ifdef vax char dum[]="tempdisk:*.B17"; #endif #ifdef aquila char dum[]="d:\\b1d\\*.B17"; #endif char *argv[5]; int iseek,nread; if(argc < 2) { argv[0]=&"MCB2"; argv[1]=&dum[0]; } else argv[1]=nargv[1]; printf(" argv1 %s \n",argv[1]); strcpy(inp.name,argv[1]); sel_first(argv[1],inp.name); printf(" %s|\n",inp.name); if(strcmp(inp.name,"empty") == 0) exit(0); jch=strchr(inp.name,';'); if(jch != NULL) *jch='\0'; makb2nam(inp.name,out.name); printf(" 5 %s \n",out.name); inp.nskip=dystep; nst=0; icp=-1; in=0; if( (inp.fp = fopen(inp.name,"rb"))== NULL ) { printf (" Cannot find file %s \n", inp.name); exit(9); } /* read the mc header */ else { if(icp < 0) icp=in; nbuf=fread (&inp.mc_area,sizeof(MCIDAS_DATDIR_AREA_HDR_T),1, inp.fp); if(nbuf != 1) { printf(" bad input file %s \n",inp.name); strcpy(newname,inp.name); strcat(newname,"B"); rename(inp.name,newname); exit(17); } mcprnt(&inp.mc_area); inp.ystep=B2Y/inp.mc_area.line_res; inp.xstep=B2X/inp.mc_area.elem_res; inp.nskip=inp.ystep; /* read the mc nav and cal info */ inp.byp=inp.mc_area.pri_key_nav; inp.nwide=inp.mc_area.num_elem; inp.nx=inp.mc_area.num_byte_ln_prefix+ inp.mc_area.num_elem* inp.mc_area.bytes_per_pixel* inp.mc_area.num_chan; inp.nyout=inp.mc_area.num_line/inp.ystep; nbuf=inp.mc_area.num_elem*inp.mc_area.bytes_per_pixel* inp.mc_area.num_chan; inp.out_buf=(unsigned char *)calloc(nbuf,1); } if ( (out.fp = fopen (out.name, "wb")) == NULL ) { printf ("\nCannot find file '%s'; exiting...\n\n", out.name); exit(1); } nst=inp.mc_area.num_chan; chan_map=inp.mc_area.sndr_filter_map; memcpy(&out.mc_area,&inp.mc_area,sizeof(MCIDAS_DATDIR_AREA_HDR_T) ); out.xstep=inp.xstep*inp.mc_area.elem_res; out.ystep=inp.nskip*inp.mc_area.line_res; printf(" ystep %d %d %d \n",out.ystep,inp.nskip,inp.mc_area.line_res); out.nyout=inp.nyout; out.nxout=((inp.nwide-1)/inp.xstep+1); inp.nxout=inp.nwide/inp.xstep; out.nxout=((out.nxout-1)/4+1) *4; nvcalsiz=inp.mc_area.pri_key_nav-sizeof(MCIDAS_DATDIR_AREA_HDR_T) -sizeof(ISCHEAD); nvcal_buf=(char *) calloc(nvcalsiz,1); fread(nvcal_buf,nvcalsiz,1,inp.fp); fread(&outisc,sizeof(ISCHEAD),1,inp.fp); printf(" outisc %s \n",outisc.text); out.out_buf=(unsigned char *) calloc(out.nxout*nst,sizeof(char)); for (i =0 ; i < out.nxout*nst ; i++) *(out.out_buf+i)=255; printf(" out point,size %d %d %d \n",out.out_buf,out.nxout,nst); nrd=inp.nyout; for (q = 0; q < nrd; q++) /* read the line prefix */ { in=0; /* maybe we should read every line, looking for good ones */ iseek=fseek (inp.fp,inp.byp,SEEK_SET); nread=fread (&out.isc_pre,inp.mc_area.num_byte_ln_prefix,1,inp.fp); if(nread != 1) goto eof; ptbuf=inp.out_buf; nread=fread(ptbuf,inp.mc_area.bytes_per_pixel, inp.mc_area.num_elem*inp.mc_area.num_chan,inp.fp); if(nread != inp.mc_area.num_elem*inp.mc_area.num_chan) goto eof; inp.byp=inp.byp+inp.nx*inp.nskip; ; if(q == 0 ) { ladd=0; updathd(&out,&inp,nst,chan_map,ladd); mcprnt(&out.mc_area); fwrite(&out.mc_area,sizeof(MCIDAS_DATDIR_AREA_HDR_T),1,out.fp); fwrite(nvcal_buf,nvcalsiz,1,out.fp); updatischd(&out,&outisc); fwrite(&outisc,sizeof(ISCHEAD),1,out.fp); } /* end q==0 */ /* construct the output line header */ updatb2pre(&out); fwrite (&out.isc_pre,out.mc_area.num_byte_ln_prefix,1,out.fp); if(q < 5) preiscprnt(&out.isc_pre); sampb1b2(out.out_buf,ptbuf,inp.xstep,nst,inp.nxout); fwrite (out.out_buf, out.nxout*nst,1, out.fp); if(out.isc_pre.linesize != out.nxout*nst+out.mc_area.num_byte_ln_prefix) { printf(" linesize? %d %d %d %d \n",out.isc_pre.linesize, out.nxout,nst,out.mc_area.num_byte_ln_prefix); preiscprnt(&out.isc_pre); } } /* end q loop */ eof: printf(" processed %d lines expected %d \n",q+1,nrd); in=0; if(inp.fp != NULL) { fclose (inp.fp); strcpy(newname,inp.name); j = strstr(newname,".B1"); if(j == NULL) j=strstr(newname,".b1"); if(j == NULL) exit(101); else sprintf(j,".B1D"); printf(" new name %s \n",newname); rename(inp.name,newname); } fclose(out.fp); } ============================================================================== ============================================================================== /* mcidas.h */ typedef struct { long int area_status; long int version_num; long int sat_id_num; long int img_date; long int img_time; long int north_bound; long int west_vis_pixel; long int z_coor; long int num_line; long int num_elem; long int bytes_per_pixel; long int line_res; long int elem_res; long int num_chan; long int num_byte_ln_prefix; long int proj_num; long int creation_date; long int creation_time; long int sndr_filter_map; long int img_id_num; long int id[4]; char comment[32]; long int pri_key_calib; long int pri_key_nav; long int sec_key_nav; long int val_code; long int pdl[8]; long int band8; long int act_img_date; long int act_img_time; long int act_start_scan; long int len_prefix_doc; long int len_prefix_calib; long int len_prefix_lev; char src_type[4]; char calib_type[4]; long int avg_or_sample; long int poes_signal; long int poes_up_down; char orig_src_type[4]; long int res1[5]; long int cal_loc; long int res2; } MCIDAS_DATDIR_AREA_HDR_T; typedef struct { long mag; long ang; } MC_NAV_ONA_ATT_SINU_T; typedef struct { long ord_apl; long ord_1st; long mag; long ang; long ang_frm_ep; } MC_NAV_ONA_ATT_MONO_T; typedef struct { long int mag_sinu; long int phase_ang_sinu; } MCIDAS_REPEAT_SINUSOID_T; typedef struct { long int cal[128]; /* fill this in when we figure it out */ } MCIDAS_CAL_HDR; typedef struct { long int order_appl_sinu; long int order_mono_sinu; long int mag_mono_sinu; long int phase_ang_sinu; long int ang_from_epoch; } MCIDAS_REPEAT_MONOMIAL_T; typedef struct { long int exp_mag; long int exp_time_const; long int mean_att_ang_const; long int num_sinu_per_angle; MCIDAS_REPEAT_SINUSOID_T sinusoid[15]; long int num_mono_sinu; MCIDAS_REPEAT_MONOMIAL_T monomial[4]; } MCIDAS_REPEAT_T; typedef struct { long exp_mag; long exp_time; long mean_att; long num_sinu; MC_NAV_ONA_ATT_SINU_T sinu[15]; long num_mono; MC_NAV_ONA_ATT_MONO_T mono[4]; } MC_NAV_ONA_ATT_T; typedef struct { char nav_type[4]; char IMC_status[4]; long int spare1[3]; long int ref_long; long int ref_rad_dist; long int ref_lat; long int ref_orb_yaw; long int ref_att_roll; long int ref_att_pitch; long int ref_att_yaw; MC_BCD_TIME_T epoch_time; long int start_time; long int IMC_corr_roll; long int IMC_corr_pitch; long int IMC_corr_yaw; long int ref_long_change[13]; long int ref_rad_dist_change[11]; long int sine_lat[9]; long int sine_orb_yaw[9]; long int solar_rate; long int exp_start_time; MC_NAV_ONA_ATT_T roll_att; long int spare2[10]; char more1[4]; char gvar1[4]; MC_NAV_ONA_ATT_T pitch_att; MC_NAV_ONA_ATT_T yaw_att; long int spare3[16]; char more2[4]; char gvar2[4]; MC_NAV_ONA_ATT_T roll_misalgn; MC_NAV_ONA_ATT_T pitch_misalgn; long int img_date; long int img_time; long int instr; long int spare4[9]; long int ns_cyc; /* added 1/15/1995 */ long int ew_cyc; long int ns_inc; long int ew_inc; char more3[4]; char gvar3[4]; long int spare5[126]; char more4[4]; char gvar4[4]; long int spare6[127]; } MCIDAS_NX_NAV_GVAR_HDR_T; ============================================================================== ============================================================================== typedef struct { unsigned char block_id; unsigned char word_size; unsigned short word_count; unsigned short prod_id; unsigned char repeat_flag; unsigned char version; unsigned char data_valid; unsigned char asc_bin; unsigned char spare1; unsigned char range; unsigned short block_count; unsigned short spare2; } GVAR_HDR_ISC; /* 16 bytes */ typedef struct { short sat_id; /* SPCID */ short sps_source; /* SPSID */ short active_det_set; /* LSIDE */ short det_num; /* LIDET */ short channel; /* LICHA */ short imgr_stat1; /* L1SCAN */ short imgr_stat2; /* L2SCAN */ short pixel_offset; /* LZCOR */ long scan; /* RISCT */ long num_pixels; /* LPIXELS */ long num_words; /* LWORDS */ short spare[2]; /* spare - not used */ } BLOCKS_1TO10_LINE_DOC_2BYTE_ISC; /* 32 bytes */ typedef struct { unsigned short linesize; /* 16+nwide*num_chan+64 */ unsigned short line_number; /* scan line number */ unsigned short west; /* west edge in vis pixel unit */ unsigned short nwide; /* number of pixels in one channel */ unsigned short chan_id; /* channel id (100+num_chan) */ unsigned short xave; /* visible average interval in x */ unsigned short num_chan; /* number of channels */ unsigned short xstep; /* step size in vis pixel units */ long val_code; /* good data code (0=good, other=some bad)*/ IMGR_SCAN_STATUS_T imgr; MC_BCD_TIME_T time; /* 4 bits/digit = time from satellite */ GVAR_HDR_ISC blk_hdr; BLOCKS_1TO10_LINE_DOC_2BYTE_ISC imgr_2; } ISC_LINE_PREFIX; typedef struct { char text[80]; char scale[7][12]; char offset[7][12]; char sampx[7][12]; char averx[7][12]; char sampy[7][12]; char avery[7][12]; char sens[7][80]; char primary_secondary[80]; char cal10[50][12]; char news[80]; char calextra[50][12]; } ISCHEAD; typedef struct { long compres; long adjust; long n_ln_adj; long w_el_adj; long sub; long sub_proj; long sub_date; long sub_time; long num_good; long num_bad; unsigned char future_use[(128 - 10 * sizeof (long))]; } MC_CIRA_T; typedef struct { char compres; short n_ln_adj; short w_el_adj; unsigned char future_use[(128 - 5 * sizeof (long))]; } MC_CIRA_OLD; typedef struct { FILE *fp; short int *in_buf[8]; unsigned char *out_buf; char name[80]; int nr,nwide,nskip; long goodbad[8]; char *linehd[8]; long byp,nx; int sensor[6]; int isp,isd; /* save position */ int navx,navy,xstep,ystep,nyout,nxout; float scle[2],sclsd[2]; MCIDAS_NX_NAV_GVAR_HDR_T *mc_nav; MCIDAS_CAL_HDR *mc_cal_hdr; BLOCK_0_IMGR_DOC_T *blk0_hdr; MC_LINE_PREFIX_T mc_pre; ISC_LINE_PREFIX isc_pre; MCIDAS_DATDIR_AREA_HDR_T mc_area; MC_CIRA_T *cira_hdr; MC_CIRA_OLD *cira_old; } CHANNEL; ============================================================================== ============================================================================== program mctotape C THIS IS ORIGINAL 9 TRACK TAPE PROGRAM. THIS IS NOT USED FOR THE C 3480 TAPE PROCESSING, WHICH BASICALLY BLOCKS THE DISK DATA FILE C AND DUMPS IT TO THE TAPE UNCHANGED. 2/99 GGC C c c quick program to move mc data to tape c in most cases all the files of a single tape will be on disk c before this starts so multiple tape mounts will not be needed. c This could be used for 6250 tapes or EXABYTE tapes. c c if the file came by FTP to the VAX do the following c $file *.b*/type=lfstream c this will allow random length reads c c G.G. Campbell 9/94 c parameter (nmx=500) CHARACTER *60 NAMES(nmx) CHARACTER *80 first character *2 lsat COMMON/SELF_COMMON/FIRST,NUMLAST,N,NWANT,nmax,names common/tpre/pref(4),buf(35000) integer *2 pref byte buf real *8 totalby character *60 lgen,lname,lout,lnew,numfile character *80 lab integer *2 lerr nmax=nmx in=1 iot=2 iotftp=0 maxbuf=32000 print *,' open output tape ' call tpvintc(iot) c examine the output tape c get the lgen general file name c put tape label and doc fiel onto the tape if needed c position the tape for output call oldnew(iot,lgen,iydddhh1,iydddhh2,isat,numfile,lab) nfile=0 call recfile(lab,nfile,0,0,0) 1 format(a,'? ',$) print *,' search for ',lgen 5 call sel_file(lgen,lname) if(lname.eq.'NONE') then 7 continue print *,' no data for ',lab k=lennoblnk(lab) lab(k+1:k+5)='empty' call updttp(numfile,lab) call exit endif if(lname.eq.'DONE') then if(nfile.eq.0) go to 7 go to 30 endif call tpvopnc(in,lname,'REDF',lerr) call tpvrln(in,buf,256,lerr,nread) call mccrack(buf,nheader,ndata,iydddhh,lsat) print *,' yydddhh ',iydddhh1,iydddhh,iydddhh2 if(iydddhh.lt.iydddhh1) then if(nfile.eq.0) then print *,' do you want to override the data limits (y/n)' read (5,1) yn if(yn.eq.'Y'.or.yn.eq.'y') goto 301 endif call tpvret(in) go to 5 else if(iydddhh.gt.iydddhh2) then if(nfile.eq.0) then print *,' do you want to override the data limits (y/n)' read (5,1) yn if(yn.eq.'Y'.or.yn.eq.'y') goto 301 endif call tpvret(in) if(nfile.eq.0) go to 7 go to 30 endif 301 continue nfile=nfile+1 call tpvrln(in,buf(257),nheader-256,lerr,nread) nread=nread+256 call tpvwrt(iot,buf,nread,lerr) if(lerr.ne.1) go to 2000 nwrt=8 pref(1)=nwrt pref(2)=0 pref(3)=nwrt pref(4)=0 nscan=0 10 call tpvrln(in,buf(nwrt+1),ndata,lerr,nread) if(lerr.ne.1) go to 20 if(nread.ne.ndata) print *,' read problem ',ndata,nread nscan=nscan+1 pref(2)=pref(2)+1 nwrt=nwrt+nread if(nwrt+nread.gt.maxbuf) then pref(3)=nwrt call chxsum(pref,nwrt/2,pref(4)) print *,' writing ',nwrt,pref totalby=totalby+nwrt call tpvwrt(iot,pref,nwrt,lerr) if(lerr.ne.1) go to 2000 nwrt=8 pref(1)=8 pref(2)=0 pref(3)=nwrt pref(4)=0 irec=irec+1 endif go to 10 20 continue if(nwrt.gt.8) then pref(3)=nwrt call chxsum(pref,nwrt/2,pref(4)) call tpvwrt(iot,pref,nwrt,lerr) totalby=totalby+nwrt irec=irec+1 endif call recfile(lab,nfile,irec,nscan,iydddhh) call tpveof(iot) call tpvret(in) ll=index(lname,';')-1 if(ll.le.0) ll=lennoblnk(lname) lnew=lname(1:ll-1)//'T' print *,' total bytes written ',totalby,irec,nfile print *,' rename ',lname,lnew call lib$rename_file(lname,lnew) call ftprename(iotftp,lname(1:ll),lnew,lsat) go to 5 30 call tpveof(iot) call tpveof(iot) call tpvrwd(iot) call ftprename(iotftp,'DONE','DONE',lsat) call updttp(numfile,lab) call exit 2000 continue call ftprename(iotftp,'DONE','DELETE',lsat) print *,' output error ',lerr,totalby print *,' redo this tape, no renaming' call tpvskp(iot,'FL',-1,lerr) call tpvskp(iot,'FL',1,lerr) call tpveof(iot) call exit end subroutine ftprename(iotftp,lname,lnew,lsat) character *32 lout character *8 lcd character *(*) lname,lnew,lsat if(iotftp.lt.0.or.lname.eq.'NONE') return if(iotftp.eq.0) then iotftp=17 if(index(lname,'B2').ne.0) then open(unit=iotftp,file='ftprenb2.com',status='new', , form='formatted') write(iotftp,1) '$set ver' 1 format(a) write(iotftp,1) '$ftp aquila' write(iotftp,1) 'login campbell' write(iotftp,1) 'cloud456' lcd='cd '//lsat(1:2)//'b27' write(iotftp,1) lcd else open(unit=iotftp,file='ftprenb1.com',status='new', , form='formatted') write(iotftp,1) '$set ver' write(iotftp,1) '$ftp aquila' write(iotftp,1) 'login campbell' write(iotftp,1) 'cloud456' lcd='cd '//lsat(1:2)//'b1d' write(iotftp,1) lcd endif endif if(lnew.eq.'DELETE') then print *,' deleting the renaming file' close(unit=iotftp,dispose='delete') else if(lname.eq.'DONE') then write(iotftp,1) 'exit' write(iotftp,1) 'quit' close(unit=iotftp) iotftp=0 else l1=index(lname,']')+1 m1=lennoblnk(lname) l2=index(lnew,']')+1 m2=lennoblnk(lnew) write(iotftp,'(a,1x,a,1x,a)') 'rename', , lname(l1:m1),lnew(l2:m2) endif return end subroutine mccrack(a,nheader,ndatat,iydddhh,lsat) c extract info form mcidas header structure /MCIDAS_DATDIR_AREA_HDR_T/ integer *4 area_status,version_num,sat_id_num,img_date,img_time, 1 north_bound,west_vis_pixel,z_coor,num_line,num_elem, 2 bytes_per_pixel,line_res,elem_res,num_chan, 3 num_byte_ln_prefix,proj_num,creation_date, 3 creation_time, 4 sndr_filter_map,img_id_num,id(4) character *32 comment integer *4 pri_key_calib,pri_key_nav,sec_key_nav,val_code, a pdl(8), 1 band8,act_img_date,act_img_time,act_start_scan, 2 len_prefix_doc,len_prefix_calib,len_prefix_lev character*4 src_type character*4 calib_type integer *4 avg_or_sample,poes_signal,poes_up_down character*4 orig_src_type integer *4 reserved(7) end structure structure / BCD_TIME_T / byte tm(8) end structure structure /IMGR_SCAN_STATUS_T/ byte bb(4) end structure structure /GVAR_HDR_ISC/ byte block_id,word_size integer *2 word_count,prod_id byte repeat_flag,version,data_valid,asc_bin,spare1,range integer *2 block_count,spare2 end structure structure / BLOCKS_1TO10_LINE_DOC_2BYTE_ISC/ integer *2 sat_id,sps_source,active_det_set,det_num,channel integer *2 imgr_stat1,imgr_stat2,pixel_offset integer *4 scan,num_pixels,num_words integer *2 spare(2) end structure structure /ISC_LINE_PREFIX/ integer *4 val_code,west,nwide integer *2 xstep,xave integer *4 chan_map record /IMGR_SCAN_STATUS_T/imgr record /BCD_TIME_T/time record /GVAR_HDR_ISC/blk_hdr record /BLOCKS_1TO10_LINE_DOC_2BYTE_ISC/imgr_2 end structure record /MCIDAS_DATDIR_AREA_HDR_T/a record /ISC_LINE_PREFIX/c character *(*) lsat C Simple test program to display some of the elements of the C ISCCP GVAR headers. This assumes that one can read random C length byte streams from the input file as in UNIX. Record C oriented systems like the VAX will not work. This simulates C the action of fread in C. C Byte swaping maybe needed for the I*2 and I*4 variables. print *,a.area_status,a.version_num,a.sat_id_num,a.img_date, 1 a.img_time,a.north_bound,a.west_vis_pixel,a.z_coor, 2 a.num_line,a.num_elem,a.bytes_per_pixel,a.line_res, 3 a.elem_res,a.num_chan,a.num_byte_ln_prefix,a.proj_num, 4 a.creation_date,a.creation_time,a.sndr_filter_map, 5 a.img_id_num print *,a.comment print *,a.pri_key_calib,a.pri_key_nav,a.sec_key_nav,a.val_code print *,a.band8,a.act_img_date,a.act_img_time,a.act_start_scan, 2 a.len_prefix_doc,a.len_prefix_calib,a.len_prefix_lev print *,a.src_type print *,a.calib_type print *,a.avg_or_sample,a.poes_signal,a.poes_up_down print *,a.orig_src_type C Read in the calibration and navigation components of the header. iydddhh=a.img_date*100+a.img_time/10000 nheader=a.pri_key_nav ndatat=a.num_elem*a.bytes_per_pixel*a.num_chan+ , a.num_byte_ln_prefix print *,iydddhh,ndatat,' yyddhh,ndatat' if(a.bytes_per_pixel.ne.1) then print *,' warning this is not 1 byte data ' endif C read each scan line in and print out part of the header C cracking the BCD time is rather a pain in Fortran but I am C sure it can be done. C One should look for potential breaks in the time sequence C because the satellite operations can call for high priority C scans in the middle of full disk images. if(a.sat_id_num.eq.70) then lsat='G8' else if(a.sat_id_num.eq.72) then lsat='G9' else print *,' wrong satellite type ',a.sat_id_num call exit endif return end subroutine oldnew(iot,lgen,iydddhh1,iydddhh2,isat, , numfile,lab) c examine the output tape c get the lgen general file name c put tape label and doc fiel onto the tape if needed c position the tape for output c G.G. Campbell 9/94 c integer iydddhh1,iydddhh2 character *(*) lgen,numfile character *80 lab character *2 ltype integer *2 lerr call tpvrln(iot,%ref(lab),80,lerr,nread) if(lerr.eq.1.or.lerr.eq.-13) then if(index(lab,'CSU.').gt.0) then print *,' current label',lab numfile='continue' read(lab,110) num,iydddhh1,iydddhh2,isat 110 format(7x,i4,3x,i7,1x,i7,2x,i2) if(index(lab,'*').ne.0) then c the lgen is in the title, need not read it else print 1,' enter wild card search (abort) or {g8b27:*.B27}' read (5,1) lgen 1 format(a,'? ',$) if(index(lgen,'*').eq.0) then call exit else go to 100 endif read(lgen,'(1x,i1)') isat endif call tpveov(iot) k=index(lab,'{') k2=index(lab,'}') lgen=lab(k+1:k2-1) else print 1,' enter wild card search ' read (5,1) lgen read(lgen(2:2),'(i1)') isat goto 100 endif else print 1,' enter wild card search g8b1d:*.B1M2,####' c set up directories iscg8, iscg9 and include in lgen read (5,1) lgen read(lgen(2:2),'(i1)') isat 100 continue if(index(lgen,'B1').ne.0.or.index(lgen,'b1').ne.0) then ltype='B1' else ltype='B2' endif if(index(lgen,',').ne.0) then ln=lennoblnk(lgen) l=index(lgen,',') read(lgen(l+1:ln),*) num lgen=lgen(1:l-1) print *,' read tape number from search string ',num else num=-1 endif call nexttp(ltype,lgen,num,iydddhh1,iydddhh2,isat,numfile) call tpvrwd(iot) c figure out the next tape number c time limits of interest m=lennoblnk(lgen) write(lab,25) ltype,num,iydddhh1,iydddhh2,isat,lgen(1:m) 25 format('CSU.',a2,'.',i4.4,'.0.',i7,'.',i7, , '.G',i2.2,'.','{',a,'}') print *,' new label ',lab call tpvwrt(iot,%ref(lab),80,lerr) call tpvwrt(iot,%ref(lab),80,lerr) call copmaydoc(iot,'iscph:G8.DOC') call tpveof(iot) endif return end subroutine copmaydoc(iot,lfile) c copy many doc files to output tape c G.G. Campbell 9/94 character *(*) lfile character *60 next in=89 open(unit=89,file=lfile,status='old',readonly,form='formatted') 1 read (89,'(a)',end=99) next if(next.eq.'DONE') return print *,' doc next ',next call copdoc(iot,next) 99 continue close(unit=in) return end subroutine recfile(lab,nfile,irec,nscan,iydddhh) character *(*) lab character *80 lfile l=min(lennoblnk(lab),index(lab,'{')-1) lfile='start' do i=1,l lfile(i:i)=lab(i:i) if(lfile(i:i).le.'.') lfile(i:i)='_' enddo lfile(l+1:l+4)='.tap' if(irec.le.0) then open(unit=87,file='tapdoc:'//lfile,status='old', , form='formatted',access='append',err=10) return 10 open(unit=87,file='tapdoc:'//lfile,status='new', , form='formatted') write(87,'(a)') lab return endif c nfile=number of files in this tape job c irec=number of tape records in this file c nscan=number of scan lines in this file c iydddhh=time of this file write(87,'(6i10)') nfile,irec,nscan,iydddhh return end subroutine nexttp(ltype,lgen,num,iydddhh1,iydddhh2, , isat,numfile) c read a file to figure out the next file name in the c sequence for this type data c G.G. Campbell 9/94 character *(*) ltype,lgen,numfile real *8 secnd4,t1,t2 if(num.lt.0) then k=index(lgen,':') write (numfile,20) lgen(1:k),ltype,isat 20 format(a,a2,i2.2,'tape.num') open(unit=45,file=numfile,status='old',form='formatted') read(45,10) numhr,ndhr print *,' number images to include and time step',numhr,ndhr 10 format(4i5) 100 read(45,110,end=88) num,iydddhh1,iydddhh2 110 format(7x,i4,3x,i7,1x,i7) go to 100 88 num=num+1 if(ltype.eq.'b1'.or.ltype.eq.'B1') then iyy=iydddhh2/100000 iddd=mod(iydddhh2/100,1000) ih=mod(iydddhh2,100) t1=secnd4(iyy,1,iddd,ih,0,1)+3600. t2=t1+ndhr*numhr*3600.-3600. call seciv4(t1,iy1,mon,id,ih1,im1,is1,jd1) iydddhh1=iy1*100000+jd1*100+ih1 call seciv4(t2,iy2,mon,id,ih2,im2,is2,jd2) iydddhh2=iy2*100000+jd2*100+ih2 else if(ltype.eq.'B2'.or.ltype.eq.'b2') then iyy=iydddhh2/100000 jddd=mod(iydddhh2/100,1000) ih=mod(iydddhh2,100) t1=secnd4(iyy,1,jddd,ih,0,1)+3600. call seciv4(t1,iy1,mon,id1,ih1,im1,is1,jd1) if(id1.lt.17) then t1=secnd4(iy1,mon,16,23,0,1) t2=secnd4(iy1,mon+1,1,-2,0,1) call seciv4(t1,iy1,jmon,jd,ih1,jimn,js1,jd1) iydddhh1=iy1*100000+jd1*100+ih1 call seciv4(t2,iy2,mon,id,ih2,im2,is2,jd2) iydddhh2=iy2*100000+jd2*100+ih2 else t2=t1+ndhr*numhr*3600.-3600. call seciv4(t1,iy1,mon,id,ih1,im1,is1,jd1) iydddhh1=iy1*100000+jd1*100+ih1 call seciv4(t2,iy2,mon,id,ih2,im2,is2,jd2) iydddhh2=iy2*100000+jd2*100+ih2 endif else print *,' enter first,last times (yydddhh)' read (5,*) iydddhh1,iydddh2 endif close(unit=45) else ndaym=num-7031 iy=95 if(ndaym.gt.365) then ndaym=ndaym-365 iy=iy+1 endif if(ndaym.gt.366) then ndaym=ndaym-366 iy=iy+1 endif if(ndaym.gt.365) then ndaym=ndaym-365 iy=iy+1 endif if(ndaym.gt.365) then ndaym=ndaym-365 iy=iy+1 endif nday=ndaym+1 iy2=iy if(nday.gt.365) then if(mod(iy,4).ne.0) then iy2=iy+1 nday=nday-365 else if(nday.gt.366) then iy2=iy+1 nday=nday-366 endif endif endif iydddhh1=(iy*1000+ndaym)*100+23 iydddhh2=(iy2*1000+nday)*100+22 numfile='redo' endif return end subroutine updttp(numfile,lab) c up data the tape name file with the label of this tape. c G.G. Campbell 9/94 character *(*) numfile,lab if(numfile.eq.'continue') return if(numfile.ne.'redo') then open(unit=45,file=numfile,status='old',access='append', , form='formatted') write(45,'(a)') lab close(unit=45) endif call taplbpr(lab) return end subroutine taplbpr(lab) character *(*) lab open(unit=45,file='tape.prt',status='new',form='formatted') nl=lennoblnk(lab) do k=1,2 write(45,76) write(45,75) write(45,77) lab(1:nl) 76 format(1x,'---------------------------------------------') 75 format(1X,'| |') 77 format(1x,'|'a) write(45,75) write(45,75) write(45,76) write(45,79) 79 format(/////) enddo close(unit=45) return end ============================================================================== ============================================================================== C THE FOLLOWING IS THE CODE OF INTEREST program g8navtest c c Program to prepare navigated sectors out of a G8 mcidas file c which includes the G8 navigation header. Either single channel c or multispectral files are acceptible. c c if the file came by FTP to the VAX do the following c $file *.b*/type=lfstream c this will allow random length reads c c G.G. Campbell+K.R. Dean 10/94 c Some revisions to 1/96 c common/tpre/pref(4),buf(14000) byte img[allocatable](:,:) integer *2 pref integer ichanl(7),iot(7) byte buf real *8 totalby character *60 lgen,lname,lout,lnew,numfile,lnav,lloc character *60 lcom(10) character *80 lab integer *2 lerr in=9 maxbuf=32000 c examine the output tape c get the lgen general file name call getcom(ncom,lcom) if(lennoblnk(lcom(1)).lt.2.or.ichar(lcom(1)(1:1)).eq.0) then print *,' enter general file name ' read (5,'(a)') lgen else print *,ncom,(lcom(m),m=1,ncom) lgen=lcom(1) endif if(ncom.le.1) lcom(2)='input' lloc=lcom(2) if(lloc.eq.'input') then linp=5 else linp=65 open(unit=linp,file=lloc,status='old',form='formatted') endif c print 1,' enter general file name' c read (5,'(a)') lgen 1 format(a,'? ',$) print *,' search for ',lgen 5 call sel_file(lgen,lname,1) if(lname.eq.'NONE') call exit if(lname.eq.'DONE') go to 2000 ln=lennoblnk(lname) lnew=lname(1:ln)//'D' call tpvopnc(in,lname,'FRED',lerr) call tpvrln(in,buf,256,lerr,nread) call mccrack(buf,nheader,ndata,iydddhh,navpos,locchd) call mcsatid(buf,isat) print *,' yydddhh ',iydddhh,ndata call tpvrln(in,buf(257),nheader-256,lerr,nread) nread=nread+256 call adjmc(buf,buf(navpos),buf(locchd),buf(locchd)) call sectsel(buf,buf(navpos),i1,i2,j1,j2,nchanl,nhead, , ndata,ichanl,i0,j0,imax,jmax,istep,jstep, , ifull,jfull,instru,icent,jcent, , wi,ei,yi,ysi,linp) c i1,i2,j1,j2 in what ever resolution of the input c which is specified by ifull,jfull ires=ifull/istep jres=jfull/jstep jnorth=(j1-1)*jfull+1 iwest=(i1-1)*ifull+1 c call earthedg(instru,iwest,ieast,inorth,isouth) nwid=(i2-i1)/istep+1 nwide=((nwid-1)/4+1)*4 if(nwide.gt.nwid) print *,' expand out ',nwid,nwide iom=10 iyear1=0 jsat=(isat-70)/2+8 do i=1,nchanl if(ichanl(i).lt.10) then write(lout,88) iydddhh,jsat,ichanl(i) c88 format(i7.7,'.g',i2.2) 88 format('d:\g',i1,'cal\',i7.7,'.ch',i1) iom=iom+1 iot(i)=iom nw=nwide call tpvopnc(iot(i),lout,'DNEW',nw) else iot(i)=0 endif enddo write(lnav,89) iydddhh 89 format('d:\g8cal\',i7.7,'.nav') ishdpos=nheader-2504+1 c dump out a calibration table call calgvar(isat,buf(ishdpos),lout) j0=j0-1 lr=0 if(j1.lt.j0) then print *,' padding north edge ',j1,j0 do i=1,nwide buf(i)=-1 enddo do j=j1,j0,jstep lr=lr+1 call wrzero(iot,buf,nwide,nchanl,lr) enddo endif iw=1 ie=1 c for a direct tape read one would need to include the 16 byte C physical record c header and the fact that many logical records are concatinated lprnt=0 10 call tpvrln(in,buf,ndata,lerr,nread) if(lprnt.lt.10) then call prntlhf(buf) lprnt=lprnt+1 endif j0=j0+1 if(lerr.ne.1) go to 20 if(j0.ge.j2) go to 20 if(j0.lt.j1) go to 10 c print *,j0,j1,j2,jstep,lr c skip over unwanted lines if(mod(j0,jstep).ne.0) go to 10 if(iyear1.eq.0) then jl1=j0 call timej(buf,iyear1,iday1,ihour1,imin1,isec1,msec1) endif jl2=j0 call timej(buf,iyear2,iday2,ihour2,imin2,isec2,msec2) lr=lr+1 c we should check the record header here c the logical record header is located in buf(1) to buf(80) call wriot(iot,i0,i1,i2,istep,buf(nhead+1),nchanl,lr,iw,ie) go to 10 20 continue call tpvret(in) call tpvrnm(lname,lnew) if(j0.lt.j2) then print *,' padding south edge ',j0,j2 do i=1,nwide buf(i)=-1 enddo do j=j0,j2,jstep lr=lr+1 call wrzero(iot,buf,nwide,nchanl,lr) enddo endif nx=nwide ny=lr print *,' select a file to superimpose a map (0=none)' read (linp,*) imap if(imap.gt.0) then allocate(img(nx,ny)) call drawmap(iot(imap),nx,ny,instru,img,ifull, , jfull,iwest,jnorth, , wi,ei,yi,ysi) deallocate(img) endif do i=1,nchanl if(iot(i).gt.0) then call ggcouth(iot(i),i1,j1,nx,ny,ifull,jfull) close(unit=iot(i)) iot(i)=0 endif c superimpose the ggc header on the first record enddo iotn=21 open(unit=iotn,file=lnav,status='unknown',form='formatted') call defsec8(i1,i2,j1,j2,ifull,jfull,iotn) fyddd=iyear1*1000.+iday1 fsec=ihour1*3600.+imin1*60+isec1+msec1/1000. c write (iotn,398) jl1,iyear1,iday1,ihour1,imin1,isec1,msec1 write (iotn,397) fyddd,fsec,fsec,jl1 397 format(' start: date',f10.1,' seconds',f8.1,' sec',f8.1, , ' full res line',i6) fyddd=iyear2*1000.+iday2 fsec=ihour2*3600.+imin2*60+isec2+msec2/1000. write (iotn,397) fyddd,fsec,fsec,jl2 c write (iotn,398) jl2,iyear2,iday2,ihour2,imin2,isec2,msec2 c398 format(' line ',i5,' time ',6i5) close (unit=iotn) 2000 call exit end subroutine mcsatid(buf,isat) include 'c:\camp\isccp\g8for\stru.inc' record /MCIDAS_DATDIR_AREA_HDR_T/buf isat=buf.sat_id_num print *,isat,' should be 72 or 70' return end subroutine calgvar(isat,buf,sav) c print out a table to convert count to radiance or temperature character *(*) sav character *1 null character *60 lout include 'c:\camp\isccp\g8for\stru.inc' record /ischead/buf real rtab(0:255,0:6),ttab(0:255,0:4) real scale(0:6),offset(0:6),xcal10(0:49) integer sens(0:5),c8 null=char(0) 124 format(f12.4) print *,buf.text print *,buf.news do j=0,6 k=index(buf.scale(j),null)-1 read(buf.scale(j)(1:k),124) scale(j) k=index(buf.offset(j),null)-1 read(buf.offset(j)(1:k),124) offset(j) enddo do j=0,49 k=index(buf.xcal10(j),null)-1 if(k.gt.0) read(buf.xcal10(j)(1:k),124) xcal10(j) enddo k=index(buf.sens(0),null) read (buf.sens(0)(1:k),'(i1,i2,i2,i2,i2,i2)') sens B=0 Q1=0 Q2=0 do i=2,5 j = sens(i) B = B + xcal10(j) Q1 = Q1 + xcal10(j+8) Q2 = Q2 + xcal10(j+16) enddo B=B/4. Q1=Q1/4. Q2=Q2/4. AF=xcal10(24) do c8=0,255 c=c8/scale(0)+offset(0)+1.5 VR=c**2*Q2+c*Q1+B if(VR.lt.0) VR=0. rtab(c8,0)=VR ALB=VR*AF ttab(c8,0)=ALB SR=c8/scale(5)+offset(5) rtab(c8,5)=SR**2*Q1 c the variance of the vis is in location 5 enddo do ichanl=1,4 if(ichanl.eq.1) then B=xcal10(27) G = xcal10(35) if(isat.eq.70) then FK1=199943.56 FK2=3684.01 TC1=0.6514 TC2=0.9990 c revised by Chad Johnson c see mail message 12/19/95 FK1=199986.19 FK2=3684.27 TC1=0.6357 TC2=0.9991 else if(isat.eq.72) then FK1=198807.83 FK2=3677.02 TC1=0.5864 TC2=0.9992 else if(isat.eq.74) then FK1=198406.98 FK2=3674.55 TC1=0.6222 TC2=0.9991 else print *,' unknown satellite, need new info',isat endif else if(ichanl.eq.2) then B = xcal10(28) G = xcal10(36) if(isat.eq.70) then FK1=38782.06 FK2=2132.53 TC1=0.5891 TC2=0.9986 FK1=38792.39 FK2=2132.72 TC1=0.6060 TC2=0.9986 else if(isat.eq.72) then FK1=38732.41 FK2=2131.62 TC1=0.4841 TC2=0.9989 else if(isat.eq.74) then FK1=39086.36 FK2=2138.09 TC1=0.6144 TC2=0.9986 else endif else if(ichanl.eq.3) then B = xcal10(25) G = xcal10(33) if(isat.eq.70) then FK1=9740.34 FK2=1345.48 TC1=0.3919 TC2=0.9987 FK1=9737.93 FK2=1345.37 TC1=0.3735 TC2=0.9987 else if(isat.eq.72) then FK1=9717.21 FK2=1344.41 TC1=0.3622 TC2=0.9988 else if(isat.eq.74) then FK1=9774.44 FK2=1347.05 TC1=0.2779 TC2=0.9991 else print *,' unknown satellite, need new info',isat endif else if(ichanl.eq.4) then B = xcal10(26) G = xcal10(34) c updated for GOES 10 2/99 ggc if(isat.eq.70) then FK1=6945.75 FK2=1202.05 TC1=0.2372 TC2=0.9991 FK1=6944.64 FK2=1201.99 TC1=0.2217 TC2=0.9992 else if(isat.eq.72) then FK1= 6899.47 FK2=1199.38 TC1=0.2014 TC2=0.9992 else if(isat.eq.74) then FK1=6828.63 FK2=1195.26 TC1=0.2114 TC2=0.9992 else print *,' unknown satellite, need new info',isat endif endif do c8=0,255 SR=c8/scale(ichanl)+offset(ichanl)+1.5 R = (SR - B) / G rtab(c8,ichanl)=R expn = (FK1/R+1.) if(expn.gt.0..and.R.gt.0.) then TT=FK2/alog(expn) c use plank function to convert radiance to temperature ttab(c8,ichanl)=(TT-TC1)/TC2 else ttab(c8,ichanl)=0. rtab(c8,ichanl)=0. endif enddo enddo c then channel 4 variance uses the radiance cal of channel 4 B = xcal10(25) G = xcal10(33) do c8=0,255 SR=C8/scale(6)+offset(6) R=SR**2/G rtab(c8,6)=R enddo c now print out the results print *,' rad ',(i+1,i=0,7) do c8=0,255 print 10,c8,(rtab(c8,i),i=0,6) 10 format(i5,7f10.4) enddo print *,' albedo temp',(i+1,i=1,4) do c8=0,255 print 10,c8,(ttab(c8,i),i=0,4) enddo if(index(sav,'cal\').gt.0) then k=index(sav,'cal\') do ichanl=0,4 write(lout,904) sav(1:k),ichanl+1 iot=81 open(unit=iot,file=lout,status='unknown',form='formatted') 904 format('cal\table.ch',i1) do c8=0,255 write (iot,905) c8,rtab(c8,ichanl),ttab(c8,ichanl) 905 format(i5,2f10.4) enddo close(unit=iot) enddo endif return end subroutine drawmap(imap,nx,ny,instru,b,ifull,jfull,iwest,inorth, , wi,ei,yi,ysi) c superimpose a map on the image to check the nav. byte b(nx,ny),bz real work(200) bz=-1 c first read the whole image do j=1,ny read (imap,rec=j) (b(i,j),i=1,nx) enddo c superimpose a map call SUPmg8(WI,EI,YI,YSI,WORK,b,NX,NY,bz, , instru,iwest,inorth,ifull,jfull) c write out the image again do j=1,ny write(imap,rec=j) (b(i,j),i=1,nx) enddo return end SUBROUTINE SUPmg8(WI,EI,YI,YSI,WORK,IMG,NXs,NYs,ICOL, , instru,iwest,inorth,ifull,jfull) C SUPER IMPOSE A MAP UPON THE IMAGE ARRAY IMG(NX,NY) C ICOL = OUTPUT COLOR C G.G. CAMPBELL 11/90 REAL *4 WORK(100,2) CHARACTER * 32 FNAME(2) character *18 l_prefix character *52 nname byte icol data l_prefix/'f:\camp\path\code\'/ DATA FNAME/'CONTQUIK.out','USQUICK.out'/ C LIMITED GEOGRAPHY DATA SET W=AMIN1(WI,EI) E=AMAX1(WI,EI) Y=AMAX1(YI,YSI) YS=AMIN1(YI,YSI) IF(W.GT.230.AND.E.LT.300..AND.Y.LT.55.AND.YS.GT.25.) THEN LNAM=2 ELSE LNAM=1 ENDIF IN=21 nname=l_prefix//fname(lnam) 18 OPEN (UNIT=IN,file=nname,status='OLD', , FORM='FORMATTED',err=17) DX=(E-W)/NXs DY=(Y-YS)/NYs print *,w,e,y,ys,dx,dy,' w,e,y,ys,dx,dy',fname(lnam) print *,' edges full ',iwest,inorth KSUM=0 c input longitudes range from -180 to +180 1 CONTINUE 12 FORMAT(I4,10F7.2/(4x,10F7.2)) READ (IN,12,ERR=2) KNT,(WORK(K,2),WORK(K,1),K=1,KNT) IF(W.LT.0) THEN DO K=1,KNT IF(WORK(K,1).GT.180.) WORK(K,1)=WORK(K,1)-360. enddo Else IF(E.GT.360.) THEN DO K=1,KNT IF(WORK(K,1).lt.180.) WORK(K,1)=WORK(K,1)+360. ENDDO else do k=1,knt if(work(k,1).lt.0) work(k,1)=work(k,1)+360. enddo ENDIF K1=1 3 DO 33 K=K1,KNT IF(WORK(K,1).GT.W.AND.WORK(K,1).LT.E.AND. , WORK(K,2).LT.Y.AND.WORK(K,2).GT.YS) THEN call lltopix(work(k,1),work(k,2),i,j) if(i.lt.iwest.or.j.lt.inorth) go to 33 IMGI=(i-iwest)/ifull+1 IMGJ=(j-inorth)/jfull+1 if(imgi.gt.nxs.or.imgj.gt.nys) go to 33 GO TO 4 ENDIF 33 CONTINUE GO TO 1 4 DO 44 KK=K+1,KNT IF(WORK(KK,1).GT.W.AND.WORK(KK,1).LT.E.AND. , WORK(KK,2).LT.Y.AND.WORK(KK,2).GT.YS.AND. , ABS(WORK(KK,1)-WORK(KK-1,1)).LT.180.) THEN call lltopix(work(kk,1),work(kk,2),i,j) if(i.lt.iwest.or.j.lt.inorth) go to 444 IMGL=(i-iwest)/ifull+1 IMGM=(j-inorth)/jfull+1 if(imgl.gt.nxs.or.imgm.gt.nys) go to 444 CALL LINIMG(IMG,NXs,NYs,IMGI,IMGJ,IMGL,IMGM,ICOL) IMGI=IMGL IMGJ=IMGM KSUM=KSUM+1 ELSE 444 K1=KK+1 GO TO 3 ENDIF 44 CONTINUE GO TO 1 2 CONTINUE print *,' SUPIMG DONE',KSUM,W,E,Y,YS CLOSE(UNIT=IN) RETURN 17 continue print *,' did not find ',nname print *,' enter file name for outline' linp=5 read (linp,'(a)') nname in=in+1 go to 18 END SUBROUTINE LINIMG(IMG,NX,NY,I1,J1,I2,J2,ICOL) C draw a short line on an image file from point (i1,j1) to (i2,j2) C color=icol byte IMG(NX,NY),ICOL DX=I2-I1 DY=J2-J1 IF(DX.EQ.0.AND.DY.EQ.0) THEN IMG(I1,J1)=ICOL RETURN ENDIF IF(ABS(DX).LT.ABS(DY)) GO TO 100 D TYPE *,DX,DY,I1,I2,J1,J2,' LINEG' IF(DX.GT.0) THEN ISTEP=1 ELSE ISTEP=-1 ENDIF DO 101 I=I1,I2,ISTEP IMG(I,IFIX(FLOAT(I-I1)*DY/DX+FLOAT(J1)))=ICOL 101 CONTINUE RETURN 100 CONTINUE D TYPE *,DX,DY,I1,I2,J1,J2,' LINEG' IF(DY.GE.0) THEN JSTEP=1 ELSE JSTEP=-1 ENDIF DO 201 J=J1,J2,JSTEP IMG(IFIX(FLOAT(J-J1)*DX/DY+FLOAT(I1)),J)=ICOL 201 CONTINUE RETURN END subroutine wrzero(iot,b,nwide,nchanl,lr) c pad zeros at the top of the image if sector edge is north of data byte b(nwide) integer iot(nchanl) do io=1,nchanl if(iot(io).gt.0) write(unit=iot(io),rec=lr) b enddo return end subroutine wriot(iot,i0,i1,i2,istep,buf,nchanl,lr,iw,ie) c write out each scan line to all output files. byte buf(nchanl,i0:i0+1),bz integer iot(nchanl) integer *2 lerr bz=-1 if(i1.lt.i0) then do io=1,nchanl if(iot(io).gt.0) then write(unit=iot(io),rec=lr) (bz,i=i1,i0-1,istep), , (buf(io,i),i=i0,i2,istep) endif enddo else do io=1,nchanl if(iot(io).gt.0) then write(unit=iot(io),rec=lr) (buf(io,i),i=i1,i2,istep) endif enddo endif return end ============================================================================== ============================================================================== subroutine mcsatid(buf,isat) c include 'c:\camp\isccp\g8for\stru.inc' record /MCIDAS_DATDIR_AREA_HDR_T/buf isat=buf.sat_id_num print *,isat,' should be 72 or 70' return end subroutine calgvar(isat,buf,sav,rtab,ttab) c print out a table to convert count to radiance or temperature c c some revisions to 1/96 c c G.G. Campbell 1/95 c character *(*) sav character *1 null character *60 lout include 'c:\camp\isccp\g8for\stru.inc' record /ischead/buf real rtab(0:255,0:6),ttab(0:255,0:4) real scale(0:6),offset(0:6),xcal10(0:49) integer sens(0:5),c8 null=char(0) 124 format(f12.4) print *,buf.text print *,buf.news do j=0,6 k=index(buf.scale(j),null)-1 read(buf.scale(j)(1:k),124) scale(j) k=index(buf.offset(j),null)-1 read(buf.offset(j)(1:k),124) offset(j) enddo do j=0,49 k=index(buf.xcal10(j),null)-1 if(k.gt.0) read(buf.xcal10(j)(1:k),124) xcal10(j) enddo k=index(buf.sens(0),null) read (buf.sens(0)(1:k),'(i1,i2,i2,i2,i2,i2)') sens B=0 Q1=0 Q2=0 do i=2,5 j = sens(i) B = B + xcal10(j) Q1 = Q1 + xcal10(j+8) Q2 = Q2 + xcal10(j+16) enddo B=B/4. Q1=Q1/4. Q2=Q2/4. AF=xcal10(24) do c8=0,255 c=c8/scale(0)+offset(0)+1.5 VR=c**2*Q2+c*Q1+B if(VR.lt.0) VR=0. rtab(c8,0)=VR ALB=VR*AF ttab(c8,0)=ALB SR=c8/scale(5)+offset(5) rtab(c8,5)=SR**2*Q1 c the variance of the vis is in location 5 enddo do ichanl=1,4 if(ichanl.eq.1) then B=xcal10(27) G = xcal10(35) if(isat.eq.70) then FK1=199943.56 FK2=3684.01 TC1=0.6514 TC2=0.9990 c revised by Chad Johnson c see mail message 12/19/95 FK1=199986.19 FK2=3684.27 TC1=0.6357 TC2=0.9991 else FK1=198807.83 FK2=3677.02 TC1=0.5864 TC2=0.9992 endif else if(ichanl.eq.2) then B = xcal10(28) G = xcal10(36) if(isat.eq.70) then FK1=38782.06 FK2=2132.53 TC1=0.5891 TC2=0.9986 FK1=38792.39 FK2=2132.72 TC1=0.6060 TC2=0.9986 else FK1=38732.41 FK2=2131.62 TC1=0.4841 TC2=0.9989 endif else if(ichanl.eq.3) then B = xcal10(25) G = xcal10(33) if(isat.eq.70) then FK1=9740.34 FK2=1345.48 TC1=0.3919 TC2=0.9987 FK1=9737.93 FK2=1345.37 TC1=0.3735 TC2=0.9987 else FK1=9717.21 FK2=1344.41 TC1=0.3622 TC2=0.9988 endif else if(ichanl.eq.4) then B = xcal10(26) G = xcal10(34) if(isat.eq.70) then FK1=6945.75 FK2=1202.05 TC1=0.2372 TC2=0.9991 FK1=6944.64 FK2=1201.99 TC1=0.2217 TC2=0.9992 else FK1= 6899.47 FK2=1199.38 TC1=0.2014 TC2=0.9992 endif endif do c8=0,255 SR=c8/scale(ichanl)+offset(ichanl)+1.5 R = (SR - B) / G rtab(c8,ichanl)=R expn = (FK1/R+1.) if(expn.gt.0..and.R.gt.0.) then TT=FK2/alog(expn) c use plank function to convert radiance to temperature ttab(c8,ichanl)=(TT-TC1)/TC2 else ttab(c8,ichanl)=0. rtab(c8,ichanl)=0. endif enddo enddo c then channel 4 variance uses the radiance cal of channel 4 B = xcal10(25) G = xcal10(33) do c8=0,255 SR=C8/scale(6)+offset(6) R=SR**2/G rtab(c8,6)=R enddo c now print out the results print *,' rad ',(i+1,i=0,7) do c8=0,255,9 print 10,c8,(rtab(c8,i),i=0,6) 10 format(i5,7f10.4) enddo print *,' albedo temp',(i+1,i=1,4) do c8=0,255,9 print 10,c8,(ttab(c8,i),i=0,4) enddo if(index(sav,'cal\').gt.0) then k=index(sav,'cal\') do ichanl=0,4 write(lout,904) sav(1:k),ichanl+1 iot=81 open(unit=iot,file=lout,status='unknown',form='formatted') 904 format('cal\table.ch',i1) do c8=0,255 write (iot,905) c8,rtab(c8,ichanl),ttab(c8,ichanl) 905 format(i5,2f10.4) enddo close(unit=iot) enddo endif return end subroutine adjmc(mc,navstr,cirahd1,cirahd2) c The initial navigation package did not include all the information. c We made an empirical adjustment to the north edge to make the old c navigation code to work. In January 1995 the new parameters and new c code was implemented. The routine adjusts the corner when needed. include 'c:\camp\isccp\g8for\stru.inc' record/cira_hd/cirahd1 ! old format (pre 1995) record/cira_hd2/cirahd2 ! new format record/GVAR_NAV/navstr record/MCIDAS_DATDIR_AREA_HDR_T/mc if(navstr.ns_cyl.eq.0) then print *,' use the adjusted corner: no extra nav info' c print *,' adj ',mc.north_bound,cirahd1.north_south_adj, c , cirahd2.north_south_adj,cirahd2.navflg return endif if( cirahd2.adjustment_flag.gt.0) then c unadjust the north corner print *,' adjusting the corner',cirahd2.north_south_adj mc.north_bound=mc.north_bound-cirahd2.north_south_adj c no unadjustment needed because not applied endif return end subroutine defsec8(i1,i2,j1,j2,ifull,jfull,iot) c print out a grid of lon,lats coresponding to the image di=20 dj=20 write(iot,*) ' elem num, line num, long , lat ', , ', x pixel , y pixel' do j=j1,j2,dj jp=(j-1)*jfull+1 do i=i1,i2,di ip=(i-1)*ifull+1 call pixtoll(xl,yl,ip,jp) write (iot,17) ip,jp,xl,yl,i-i1+1,j-j1+1 17 format(2i10,2f10.4,2i10) enddo enddo return end subroutine prntlhf(buf) include 'c:\camp\isccp\g8for\stru.inc' c include 'iscph:stru.inc' c print out some elements of the logical header ctypedef struct c{ c unsigned short linesize; /* 16+nwide*num_chan+64 */ c unsigned short line_number; /* scan line number full res units*/ c unsigned short west; /* west edge in vis pixel units */ c unsigned short nwide; /* number of pixels in one channel */ c unsigned short chan_id; /* channel id (100+num_chan) */ c unsigned short xave; /* visible average interval in x */ c unsigned short num_chan; /* number of channels */ c unsigned short xstep; /* step size in full vis pixel units */ c long val_code; /* good data code (0=good, other=some bad)*/ c IMGR_SCAN_STATUS_T imgr; c MC_BCD_TIME_T time; /* 4 bits/digit = time from satellite */ c GVAR_HDR_ISC blk_hdr; c BLOCKS_1TO10_LINE_DOC_2BYTE_ISC imgr_2; c} ISC_LINE_PREFIX; record /ISC_LINE_PREFIX/buf print *,buf.linesize,buf.line_number,buf.west,buf.nwide print *,buf.chan_id,buf.xave,buf.num_chan,buf.xstep print *,buf.val_code return end subroutine ggcouth(iot,i1,j1,nx,ny,ifull,jfull) c superimpose a GGC header for use in IDL display c this corrupts 24 bytes in the output file byte b(3600) character *24 bsize equivalence (b,bsize) print *,iot,i1,j1,nx,ny,ifull,jfull,' ggcouth' read (iot,rec=1) (b(i),i=1,nx) write (bsize,'(4i4,2i4)') i1,j1,nx,ny,ifull,jfull write (iot,rec=1) (b(i),i=1,nx) return end subroutine edgearth(j,ifw,ife,icent,jcent) i=icent/2 id=icent/2 10 continue id=id/2 call pixtoll(x,y,i,j) if(x.ne.999999.) then i=i-id else i=i+id endif if(id.gt.0) goto 10 ifw=i i=icent id=icent/2 i=3*icent/2 id=icent/2 20 continue id=id/2 call pixtoll(x,y,i,j) if(x.ne.999999.) then i=i+id else i=i-id endif if(id.gt.0) goto 20 ife=i return end subroutine timej(linehd,iyear,iday,ihour,imin,isec,msec) c convert bcd from isc header to time include 'c:\camp\isccp\g8for\stru.inc' record /ISC_LINE_PREFIX/linehd byte bt integer bcd(16) equivalence (bt,it) do m=2,16,2 bt=linehd.time.tm(m/2) bcd(m)=it/16 bcd(m-1)=mod(it,16) enddo bcd(4)=mod(bcd(4),8) iyear=bcd(8)*1000+bcd(7)*100+bcd(6)*10+bcd(5) iday=bcd(4)*100+bcd(3)*10+bcd(2) ihour=bcd(1)*10+bcd(16) imin=bcd(15)*10+bcd(14) isec=bcd(13)*10+bcd(12) msec=bcd(11)*100+bcd(10)*10+bcd(9) return end subroutine timerw(linehd,iyear,iday,ihour,imin,isec,msec) c convert bcd from isc header to time include 'c:\camp\isccp\g8for\stru.inc' record /ISC_LINE_PREFIX/linehd byte bt integer bcd(16) equivalence (bt,it) do m=2,16,2 bt=linehd.time.tm(m/2) bcd(m)=it/16 bcd(m-1)=mod(it,16) enddo bcd(4)=mod(bcd(4),8) iyear=bcd(8)*1000+bcd(7)*100+bcd(6)*10+bcd(5) iday=bcd(4)*100+bcd(3)*10+bcd(2) ihour=bcd(1)*10+bcd(16) imin=bcd(15)*10+bcd(14) isec=bcd(13)*10+bcd(12) msec=bcd(11)*100+bcd(10)*10+bcd(9) return end subroutine mccrack(a,nheader,ndatat,iydddhh,navpos,lcirahd) c extract info form mcidas header include 'c:\camp\isccp\g8for\stru.inc' c include 'iscph:stru.inc' record /MCIDAS_DATDIR_AREA_HDR_T/a record /ISC_LINE_PREFIX/c C Simple test program to display some of the elements of the C ISCCP GVAR headers. This assumes that one can read random C length byte streams from the input file as in UNIX. Record C oriented systems like the VAX will not work. This simulates C the action of fread in C. C Byte swaping maybe needed for the I*2 and I*4 variables. print *,a.area_status,a.version_num,a.sat_id_num,a.img_date, 1 a.img_time,a.north_bound,a.west_vis_pixel,a.z_coor, 2 a.num_line,a.num_elem,a.bytes_per_pixel,a.line_res, 3 a.elem_res,a.num_chan,a.num_byte_ln_prefix,a.proj_num, 4 a.creation_date,a.creation_time,a.sndr_filter_map, 5 a.img_id_num print *,a.comment print *,a.pri_key_calib,a.pri_key_nav,a.sec_key_nav,a.val_code print *,a.band8,a.act_img_date,a.act_img_time,a.act_start_scan, 2 a.len_prefix_doc,a.len_prefix_calib,a.len_prefix_lev print *,a.src_type print *,a.calib_type print *,a.avg_or_sample,a.poes_signal,a.poes_up_down print *,a.orig_src_type C Read in the calibration and navigation components of the header. iydddhh=a.img_date*100+a.img_time/10000 print *,iydddhh nheader=a.pri_key_nav navpos=a.sec_key_nav+1 ndatat=a.num_elem*a.bytes_per_pixel*a.num_chan+ , a.num_byte_ln_prefix if(a.bytes_per_pixel.ne.1) then print *,' warning this is not 1 byte data ' endif lcirahd=11369 C read each scan line in and print out part of the header C cracking the BCD time is rather a pain in Fortran but I am C sure it can be done. C One should look for potential breaks in the time sequence C because the satellite operations can call for high priority C scans in the middle of full disk images. return end subroutine earthedg(instru,iwest,ieast,inorth,isouth) c test program to check the navigation and give approximate c size of earth parameter (nx=260) byte b(nx),a(180:359,-90:90) iot=73 open(unit=iot,file='tempdisk:fulldisk.img',access='direct', , status='new',recl=nx) ny=160 do j=1,ny ioff=0 do i=1,nx call pixtoll(x,y,i*100,j*100) if(x.ne.999999.) then if(ioff.eq.0) print *,i*100,j*100,x,y ioff=1 xold=x yold=y b(i)=y lx=x if(lx.lt.0) lx=lx+360 ly=y a(lx,ly)=y else if(ioff.eq.1) print *,(i-1)*100,j*100,xold,yold ioff=0 b(i)=0 endif enddo write(iot,rec=j) b enddo call ggcouth(iot,i1,j1,nx,ny,ifull,jfull) close(unit=iot) open(unit=iot,file='tempdisk:remdisk.img',access='direct', , status='new',recl=180) l=0 do j=90,-90,-1 l=l+1 write(iot,rec=l) (a(i,j),i=180,359) enddo call ggcouth(iot,i1,j1,180,181,ifull,jfull) close(unit=iot) end C======================================================================= C L M O D E L C======================================================================= SUBROUTINE LMODEL( T, TU, NVS, RLAT, RLON ) C C AUTHOR: KELLY DEAN C C CREATED: October 1994 C C DEVELOPED FOR: CIRA/COLORADO STATE UNIVERSITY C C PURPOSE: C Procedure LModel accepts an input time and a set of O&A parameters C and computes position of the satellite, the attitude angles and C attitudes misalignment and the instrument to earth fixed coordinates C transformation matrix. C C This procedure computes the position of the satellite and the C attitude of the imager or sounder. The calculations are based C on the Oats orbit and attitude model represented by the O&A C parameter set in NVS. C C REVISION: 0.0 C C REFERENCES: C Part of this code was adapted from Igor Levine work C for Integal System, Inc. C C ARGUMENTS: C NAME: TYPE: PURPOSE: IN/OUT: C T REAL*8 Input time from Jan 1, 1950 (Minutes) IN C TU REAL*8 Epoch time from Jan 1, 1950 (Minutes) IN C RLAT REAL*8 Subsatellite Geodetic latitude (rad) OUT C RLON REAL*8 Subsatellite Geodetic Longitude (rad) OUT C C SUB: C NAME: PURPOSE: LIBRARY: C INST2E Computes instrument to earth coordinates GVARnav C C FUN: C NAME: TYPE: PURPOSE: LIBRARY: C DATAN REAL*8 Arc tangent (double precision) Intrinsic C DATAN2 REAL*8 Arc Tangent (double precision) Intrinsic C DCOS REAL*8 Cosine (double precision) Intrinsic C DSIN REAL*8 Sine (double precision) Intrinsic C DTAN REAL*8 tagent (double precision) Intrinsic C GATT REAL*8 Compute attitude and misalignment angle GVARnav C C VARIABLES: C NAME: PURPOSE: C **************** REAL*8 ***************** C XS NORMALIZED S/C POSITION IN ECEF COORDINATES C BT ECEF TO INSTRUMENT COORDINATES TRANSFORMATION C Q3 USED IN SUBR LPOINT C PITCH PITCH ANGLES OF INSTRUMENT (RAD) C ROLL ROLL ANGLES OF INSTRUMENT (RAD) C YAW YAW ANGLES OF INSTRUMENT (RAD) C PMA PITCH MISALIGNMENTS OF INSTRUMENT (RAD) C RMA ROLL MISALIGNMENTS OF INSTRUMENT (RAD) C R Normalized satellite distance (km) C TS Time from EPOCH (minutes) C B Spacecraft to earth fixed coordinates transmation matrix C TE Exponential time delay from EPOCH (minutes) C PHI Subsatellite geocentric latitude (rad) C DR Radial distance from the nominal (km) C PSI Orbital yaw (rad) C LAM IMC longitude (rad) C U Argument of latitude (rad) C SU DSIN(U) C CU DCOS(U) C SI Sine of the orbit inclination C CI Cosine of the orbit inclination C SLAT Sine of geocentric latitude C ASC Longitude of the ascending node (rad) C SA Sine of ASC C CA Cosine of ASC C SYAW Sine of the orbit yaw C WA Solar orbit angle (rad) C W Orbit angle (rad) C SW DSIN(W) C CW DCOS(W) C S2W DSIN(2*W) C C2W DCOS(2*W) C SW1 DSIN(0.927*W) C CW1 DCOS(0.927*W) C SW3 Sine of 1.9268*W C CW3 Cosine of 1.9268*W C DLAT Change in sine of geocentric latitude C DYAW Change in sine of orbit yaw C A1 Work area C A2 Work area C XS S/C position in ECEF coordinates C C COMMON BLOCKS: C NAME: CONTENTS: C ELCOMM Instrument position and attitude variables and C transformation matrix C C ------------------------------------------------------- C -------------- ACTUAL CODE STARTS HERE -------------- C ------------------------------------------------------- C C CONSTANT DECLARATION SECTION: C include 'c:\camp\isccp\g8for\stru.inc' c include 'iscph:stru.inc' C C VARIABLE DECLARATION SECTION: C INTEGER IMCstatus REAL*8 T, TU REAL*8 REC(336) REAL*8 RLAT, RLON, R, TS, TE, PHI, DR, PSI, LAM, U, SU, CU REAL*8 SI, CI, SLAT, ASC, SA, CA, SYAW, WA, W, SW, CW, S2W, C2W REAL*8 SW1, CW1, SW3, CW3, DLAT, DYAW, A1, A2 REAL*8 B(3,3), BT(3,3), XS(3) REAL*8 Q3, PITCH, ROLL, YAW, PMA, RMA RECORD /GVAR_NAV/ NVS C C FUNCTION DECLARATION SECTION: C REAL*8 DATAN,DATAN2,DCOS,DSIN,DTAN,GATT C C COMMON BLOCKS: C COMMON /ELCOMM/ xs, bt, q3, pitch, roll, yaw, pma, rma C C INITIALIZATIONS: (Description mathematical and earth-related constants) C PI = 3.141592653589793D0 DEG = 180D0 / PI RAD = PI / 180D0 ! Degrees to radians conversion (PI/180) NOMORB = 42164.365D0 ! Nominal radial distance of satellite (km) AE = 6378.137D0 ! Earth equatorial radius (km) FER = 1.0D0 - ( 6356.7533D0 / AE ) ! Earth flattening coefficient AEBE2 = 1.0D0 / (1.0D0 - FER )**2 AEBE3 = AEBE2 - 1. AEBE4 = ( 1.0D0 - FER )**4-1. C C ******--------------------------------------------****** C ******-------- MAIN BODY STARTS HERE -----------****** C ******--------------------------------------------****** C C Determine the IMC status C c IMCstatus = IBITS(NVS.stat,6,1) c print *,' NVS.imc_status',NVS.IMC_status IMCstatus=NVS.IMC_status c initialize the comp_es and comp_lp programs call comp_es1(NVS) C C Assign referenec values to the subsatellite longitude and C latitude, the radial distance and the orbit yaw. C LAM = NVS.ref_long * 1.0D-7 DR = NVS.ref_rad_dist PHI = NVS.ref_lat PSI = NVS.ref_orb_yaw C C Assign reference values to the attitudes and misalignments C ROLL = NVS.ref_att_roll PITCH = NVS.ref_att_pitch YAW = NVS.ref_att_yaw RMA = 0.0D0 PMA = 0.0D0 C C IF IMC_active is OFF, compute changes in the satellite orbit C IF ( IMCstatus .EQ. 0 ) THEN print *,' imc is off ' C C Compute time since EPOCH (minutes) C TS = T - TU C C Compute orbite angle and the related trigonometric functions. C earth rotational rate (.729115E-4 rad/sec). C W = 0.729115e-4 * 60.0D0 * TS SW = DSIN(W) CW = DCOS(W) SW1 = DSIN(0.927D0*W) CW1 = DCOS(0.927D0*W) S2W = DSIN(2.0D0*W) C2W = DCOS(2.0D0*W) SW3 = DSIN(1.9268D0*W) CW3 = DCOS(1.9268D0*W) C C Computes change in the IMC_active longitude from the reference. C LAM = LAM + ( NVS.ref_long_change(1) * 1.0D-7 ) + > ( ( NVS.ref_long_change(2) * 1.0D-7 ) + > ( NVS.ref_long_change(3) * 1.0D-7 ) * W ) * W + > ( NVS.ref_long_change(10) * 1.0D-7 ) * SW1 + > ( NVS.ref_long_change(11) * 1.0D-7 ) * CW1 + > ( ( NVS.ref_long_change(4) * 1.0D-7 ) * SW + > ( NVS.ref_long_change(5) * 1.0D-7 ) * CW + > ( NVS.ref_long_change(6) * 1.0D-7 ) * S2W + > ( NVS.ref_long_change(7) * 1.0D-7 ) * C2W + > ( NVS.ref_long_change(8) * 1.0D-7 ) * SW3 + > ( NVS.ref_long_change(9) * 1.0D-7 ) * CW3 + > W * ( ( NVS.ref_long_change(12) * 1.0D-7 ) * SW + > ( NVS.ref_long_change(13) * 1.0D-7 ) * CW ) ) * 2.0D0 C C Computes change in radial distance from the reference (km) C DR = DR + ( NVS.ref_rad_dist_change(1) * 1.0D-7 ) + > ( NVS.ref_rad_dist_change(2) * 1.0D-7 ) * CW + > ( NVS.ref_rad_dist_change(3) * 1.0D-7 ) * SW + > ( NVS.ref_rad_dist_change(4) * 1.0D-7 ) * C2W + > ( NVS.ref_rad_dist_change(5) * 1.0D-7 ) * S2W + > ( NVS.ref_rad_dist_change(6) * 1.0D-7 ) * CW3 + > ( NVS.ref_rad_dist_change(7) * 1.0D-7 ) * SW3 + > ( NVS.ref_rad_dist_change(8) * 1.0D-7 ) * CW1 + > ( NVS.ref_rad_dist_change(9) * 1.0D-7 ) * SW1 + > W * ( ( NVS.ref_rad_dist_change(10) * 1.0D-7 ) * CW + > ( NVS.ref_rad_dist_change(11) * 1.0D-7 ) * SW ) C C Computes the sine of the change in the geocentric latitude. C DLAT = ( NVS.sine_lat(1) * 1.0D-7 ) + > ( NVS.sine_lat(2) * 1.0D-7 ) * CW + > ( NVS.sine_lat(3) * 1.0D-7 ) * SW + > ( NVS.sine_lat(4) * 1.0D-7 ) * C2W + > ( NVS.sine_lat(5) * 1.0D-7 ) * S2W + > W * ( ( NVS.sine_lat(6) * 1.0D-7 ) * CW + > ( NVS.sine_lat(7) * 1.0D-7 ) * SW ) + > ( NVS.sine_lat(8) * 1.0D-7 ) * CW1 + > ( NVS.sine_lat(9) * 1.0D-7 ) * SW1 C C Computes geocentric latitude by using an expansion for arcsine. C PHI = PHI + DLAT * ( 1.0D0 + DLAT * DLAT / 6.0D0 ) C C Computes sine of the change in the orbit yaw. C DYAW = ( NVS.sine_orb_yaw(1) * 1.0D-7 ) + > ( NVS.sine_orb_yaw(2) * 1.0D-7 ) * SW + > ( NVS.sine_orb_yaw(3) * 1.0D-7 ) * CW + > ( NVS.sine_orb_yaw(4) * 1.0D-7 ) * S2W + > ( NVS.sine_orb_yaw(5) * 1.0D-7 ) * C2W + > W * ( ( NVS.sine_orb_yaw(6) * 1.0D-7 ) * SW + > ( NVS.sine_orb_yaw(7) * 1.0D-7 ) * CW ) + > ( NVS.sine_orb_yaw(8) * 1.0D-7 ) * SW1 + > ( NVS.sine_orb_yaw(9) * 1.0D-7 ) * CW1 C C Computes the orbit yaw by using an expansion for arcsine. C PSI = PSI + DYAW * ( 1.0D0 + DYAW * DYAW / 6.0D0 ) ELSE WRITE(6,*) ' IMC is turned on .......... >',IMCstatus ENDIF C C Conversion of the IMC_active longitude and orbit yaw to the subsatellite C longitude and the orbit inclination (REF: GOES-PCC-TM-2473). Inputs C required for earth location and gridding C SLAT = DSIN(PHI) SYAW = DSIN(PSI) SI = SLAT**2 + SYAW**2 CI = DSQRT(1.0D0 - SI ) SI = DSQRT(SI) C - old IF ( SYAW .NE. 0.0D0 ) THEN C - old U = DATAN2(SLAT,SYAW) C - old ELSE IF (SLAT .GT. 0.0D0 ) THEN C - old U = 1.570796D0 C - old ELSE IF (SLAT .LT. 0.0D0 ) THEN C - old U = 4.712389D0 C - old ELSE C - old U = LAM C - old ENDIF IF ( ( slat .EQ 0.0D ) AND ( syaw .EQ. 0.0D ) ) THEN u = 0.0D ELSE u = DATAN2 (slat, syaw); ENDIF C SU = DSIN(U) CU = DCOS(U) C C Computes longitude of the ascending node. C ASC = LAM - U SA = DSIN(ASC) CA = DCOS(ASC) C C Computes the subsatellite geographic latitude (rad) C RLAT = DATAN(AEBE2*DTAN(PHI)) C C Computes the subsatellite geographic longitude (rad) C RLON = ASC + DATAN2(CI*SU,CU) C C Computes the spacecraft to earth fixed coordinates transformation matrix. C C (VECTOR IN ECEF COORDINATES) = B * (VECTOR IN S/C COORDINATES) C B(1,2) = -SA * SI B(2,2) = CA * SI B(3,2) = -CI B(1,3) = -CA * CU + SA * SU * CI B(2,3) = -SA * CU - CA * SU * CI B(3,3) = -SLAT B(1,1) = -CA * SU - SA * CU * CI B(2,1) = -SA * SU + CA * CU * CI B(3,1) = CU * SI C C Computes the normalized spacecraft position vector in earth fixed C coordinates - XS. C R = (NOMORB + DR) / AE XS(1) = -B(1,3) * R XS(2) = -B(2,3) * R XS(3) = -B(3,3) * R C C Precomputes Q3 ( Used in LPoint ). C Q3 = XS(1)**2 + XS(2)**2 + AEBE2 * XS(3)**2 - 1.0D0 C C Computes the attitudes and misalignments IF IMC_active is OFF C IF ( IMCstatus .EQ. 0 ) THEN C C Computes the solar orbit angle C WA = ( NVS.solar_rate * 1.0D-7 ) * TS C C Computes the difference between current time, TS, and the C exponential time. Note that both times are since EPOCH. C TE = TS - ( NVS.exp_start_time * 1.0D-7 ) C C Computes ROLL + ROLL Misalignment C ROLL = ROLL + GATT(NVS.roll_att,WA,TE) C C Computes Pitch + Pitch Misalignment C PITCH = PITCH + GATT(NVS.pitch_att,WA,TE) C C Computes YAW C YAW = YAW + GATT(NVS.yaw_att,WA,TE) C C Computes roll misalignment C RMA = GATT(NVS.roll_misalgn,WA,TE) C C Computes pitch misalignment C PMA = GATT(NVS.pitch_misalgn,WA,TE) C C Apply the Earth Sensor compensation IF needed. C C - old IF ( TS .GE. ( NVS.start_time * 1.0D-2 ) ) THEN C - old ROLL = ROLL + NVS.IMC_corr_roll * 1.0D-7 C - old PITCH = PITCH + NVS.IMC_corr_pitch * 1.0D-7 C - old YAW = YAW + NVS.IMC_corr_yaw * 1.0D-7 C - old ENDIF ROLL = ( ROLL + NVS.IMC_corr_roll ) * 1.0D-7 PITCH = ( PITCH + NVS.IMC_corr_pitch ) * 1.0D-7 YAW = ( YAW + NVS.IMC_corr_yaw ) * 1.0D-7 ELSE WRITE(6,*) ' IMC is turned on .......... >',IMCstatus ENDIF C C Computes the instrument to earth fixed coordinates transformation C matrix - BT C CALL INST2E( ROLL, PITCH, YAW, B, BT) C C RETURN END subroutine COMP_LP( ELEV, SCAN, RL, RP ) c simplified version (must call comp_es1 once before this works. common/nvspar/inst,smax(2),spx(2),emax(2),elv(2) real*8 smax,spx,emax,elv real*8 ELEV,SCAN,RL,RP RL = ( EMAX(inst) - ELEV ) / ELV(inst) C Compute fractional pixel number. RP = ( SMAX(inst) + SCAN ) / SPX(inst) + 1.0D0 return end subroutine COMP_ES(line,pixel,elev,scan) c simplified version (must call comp_es1 once before this works common/nvspar/inst,smax(2),spx(2),emax(2),elv(2) real*8 smax,spx,emax,elv real*8 line,pixel,elev,scan elev=emax(inst)-line*elv(inst) scan=(pixel-1.)*spx(inst)-smax(inst) return end CC======================================================================= C C O M P _ E S C======================================================================= SUBROUTINE COMP_ES1( NVS ) C C AUTHOR: KELLY DEAN C C CREATED: January 1995 C C DEVELOPED FOR: CIRA/COLORADO STATE UNIVERSITY C C PURPOSE: C Compute the elevation and scan angles related to the C satellite line and pixel numbers. C C REVISION: 1.0 C C ARGUMENTS: C NAME: TYPE: PURPOSE: IN/OUT: C NVS Structure Navigation information IN C line REAL*8 Satellite line number IN C pixel REAL*8 Satellite pixel number IN C elev REAL*8 Elevation angle (rad) OUT C scan REAL*8 Scan angle (rad) OUT C C CONSTANTS: C NAME: PURPOSE: C **************** REAL*8 ***************** C elvln Elevation angle per detector line (rad) C elvmax Bounds in elevation C scnmax Bounds in scan angle C scnpx Scan angle per pixel (rad) C C ------------------------------------------------------- C -------------- ACTUAL CODE STARTS HERE -------------- C ------------------------------------------------------- C C INCLUDE DECLARATION SECTION: C include 'c:\camp\isccp\g8for\stru.inc' c include 'iscph:stru.inc' C C CONSTANT DECLARATION SECTION: C INTEGER incmax(2) /6136,2805/ REAL*8 elvmax(2) / 0.2208960D0, 0.22089375D0/ REAL*8 elvln(2) /28.0D-6, 280.0D-6/ REAL*8 elvinc(2) / 8.0D-6, 17.5D-6/ REAL*8 scnmax(2) / 0.245440D0, 0.2454375D0 / REAL*8 scnpx(2) /16.0D-6, 280.0D-6/ REAL*8 scninc(2) /16.0D-6, 35.0D-6/ C C VARIABLE DECLARATION SECTION: C RECORD /GVAR_NAV/ NVS REAL*8 line, pixel, elev, scan common/nvspar/inst,smax(2),spx(2),emax(2),elv(2) real*8 smax,spx,emax,elv C C ******--------------------------------------------****** C ******-------- MAIN BODY STARTS HERE -----------****** C ******--------------------------------------------****** C c print *,' inst comp_es',NVS.instr IF ( NVS.instr .EQ. 1 ) THEN C Recompute elevation and scan biases based on user inputs of C cycles and increments obtained from GVAR c print *,NVS.instr,NVS.ns_cyl,NVS.ns_inc,NVS.ew_inc, c , NVS.ew_inc,' ns terms',NVS.spare4 inst=nvs.instr print *,elvmax(1),scnmax(1),' data elv,scn ES' if(NVS.ns_cyl.ne.0) elvmax(NVS.instr) = ( NVS.ns_cyl * > incmax(NVS.instr) + > NVS.ns_inc ) * > elvinc(NVS.instr) if(NVS.ew_cyl.ne.0) scnmax(NVS.instr) = ( NVS.ew_cyl * > incmax(NVS.instr) + > NVS.ew_inc ) * > scninc(NVS.instr) C Compute elevation angle (rad) print *,elvmax(1),scnmax(1),' elv,scn ES' c elev = elvmax(NVS.instr) + (4.50 - line) * elvln(NVS.instr) C Compute scan angle (rad) c scan = (pixel - 1.0) * scnpx(NVS.instr) - scnmax(NVS.instr) smax(inst)=scnmax(NVS.instr) spx(inst)=scnpx(NVS.instr) elv(inst)=elvln(NVS.instr) emax(inst)=elvmax(NVS.instr)+4.50*elvln(NVS.instr) ELSE IF( NVS.instr .EQ. 2 ) THEN C Recompute elevation and scan biases based on user inputs of C cycles and increments obtained from GVAR. elvmax(NVS.instr) = ( (9 - NVS.ns_cyl) * > incmax(NVS.instr) - > NVS.ns_inc ) * > elvinc(NVS.instr) scnmax(NVS.instr) = ( NVS.ew_cyl * > incmax(NVS.instr) + > NVS.ew_inc ) * > scninc(NVS.instr) C Compute elevation angle (rad) c elev = elvmax(NVS.instr) + (2.50 - line) * elvln(NVS.instr) C Compute scan angle (rad) c scan = (pixel - 1.0)*scnpx(NVS.instr)-scnmax(NVS.instr) smax(inst)=scnmax(NVS.instr) spx(inst)=scnpx(NVS.instr) elv(inst)=elvln(NVS.instr) emax(inst)=elvmax(NVS.instr)+2.50*elvln(NVS.instr) ELSE C Unknown instrument..... print *,' unknown instrument ',NVS.instr stop c elev = 0.0D0 c scan = 0.0D0 ENDIF C C RETURN END C======================================================================= C======================================================================= C S E T U P N A V C======================================================================= SUBROUTINE SETUPNAV(NAVstr,instru,icent,jcent) c set up the navigation constant common blocks include 'c:\camp\isccp\g8for\stru.inc' c include 'iscph:stru.inc' INTEGER ierr REAL*8 rlat, rlon REAL*8 lat, lon REAL*8 LatR, LonR REAL*8 x, y, elev, scan, line, pixel REAL*8 TU, T, PI/3.141592653589793D0/ REAL*8 TIME50 RECORD /GVAR_NAV/ NAVstr c WRITE(6,*) ' Testing NAVstr ' c WRITE(6,1000) NAVstr.gvar1 c WRITE(6,1000) NAVstr.gvar2 c WRITE(6,1000) NAVstr.gvar3 c WRITE(6,1000) NAVstr.gvar4 c 1000 FORMAT(T2,' GVARn >',A4) TU = TIME50(NAVstr.epoch_time) T = TU + ( ( NAVstr.start_time ) * 1.0D-2 ) WRITE(6,*) ' Epoch Time >',TU, T CALL LMODEL( T, TU, NAVstr, rlat, rlon ) WRITE(6,*) ' Subsat latitiude >',rlat * ( 180.0D0 / PI ) WRITE(6,*) ' Subsat longitude >',rlon * ( 180.0D0 / PI ) x4=rlon*180./pi y4=rlat*180./pi call lltopix(x4,y4,icent,jcent) print *,' center elem,line',icent,jcent,' lat lon',x4,y4 y = 4100.0D0 x = 13389.0D0 CALL COMP_ES( y, x, elev, scan ) print *, 'intr >', NAVstr.instr,' elev,scan',elev,scan,ierr CALL LPoint( elev, scan, lat, lon, ierr ) WRITE(6,2000) x, y, lat*(180.0D0/PI), lon*(180.0D0/PI),ierr 2000 FORMAT(T4,'Computed latitude and longitude:',/ > T5,'Satellite line >',F10.3,/ > T5,'Satellite element >',F10.3,/ > T5,'Latitude >',F13.5,/ > T5,'Longitude >',F13.5,' error ',i3) C lat = 40.0D0 lon = -104.0D0 LatR = lat * ( PI / 180.0D0 ) LonR = lon * ( PI / 180.0D0 ) CALL GPoint( LatR, LonR, elev, scan, ierr ) print *, 'intr >', NAVstr.instr,' elev,scan',elev,scan,ierr IF ( ierr.eq.1) THEN WRITE(6,*) ' Point off earth!!!!' ELSE CALL COMP_LP( elev, scan, line, pixel) ENDIF C WRITE(6,3000) lat, lon, line, pixel 3000 FORMAT(T4,'Computed satellite line and scan:',/ > T5,'Latitude >',F10.5,/ > T5,'Longitude >',F10.5,/ > T5,'Satellite line >',F13.3,/ > T5,'Satellite scan >',F13.3) RETURN END subroutine sectsel(mc,mc_nav,i1,i2,j1,j2,nchanl,nhead, , ndata,ichanl,i0,j0,imax,jmax,istep,jstep, , ifull,jfull,instru,icent,jcent, , wi,ei,yi,ysi,linp) c select the sector of interest. c this can be bigger or smaller than the input c But the input should overlap the output c integer ichanl(7) include 'c:\camp\isccp\g8for\stru.inc' c include 'iscph:stru.inc' record /MCIDAS_DATDIR_AREA_HDR_T/mc record /GVAR_NAV/mc_nav c there is lots more interesting stuff in the header c not used hear integer ielem(9),jline(9) real west,east,south,north c call the navigation set up routine to initialize common blocks call setupnav(mc_nav,instru,icent,jcent) i0=(mc.west_vis_pixel-1)/mc.elem_res+1 j0=(mc.north_bound-1)/mc.line_res+1 istep=1 jstep=1 ifull=mc.elem_res*istep jfull=mc.line_res*jstep jmax=j0+mc.num_line-1 imax=i0+mc.num_elem-1 nchanl=mc.num_chan ic=0 l=mc.sndr_filter_map do m=1,30 if(mod(l,2).ne.0) then ic=ic+1 ichanl(ic)=m endif l=l/2 enddo nhead=mc.num_byte_ln_prefix print *,i0,imax,' i lims',j0,jmax,' jlims' print *,' full lims',mc.west_vis_pixel, , mc.west_vis_pixel-1+mc.num_elem*mc.elem_res, , mc.north_bound, , mc.north_bound-1+mc.num_line*mc.line_res, , mc.elem_res,mc.line_res print *,' num_elem,num_line ',mc.num_elem,mc.num_line print *,' enter coordinates in pixel/lines or long/lat' print 1,' enter(1=pix,2=latlon,3=center),west,east,north,south' 1 format(a,'? ',$) read (linp,*) ity,x1,x2,y1,y2 print *,' ity,x1,x2,y1,y2',ity,x1,x2,y1,y2 c figure this out from the nav. ?? if(ity.eq.1) then if(x1.eq.0) x1=i0 if(x2.eq.0) x2=i0+mc.num_elem-1 if(y1.eq.0) y1=j0 if(y2.eq.0) y2=j0-1+mc.num_line i1=min(x1,x2) i2=max(x1,x2) j1=min(y1,y2) j2=max(y1,y2) call pixtoll(xlon,ylat,icent,jcent) yi=ylat+60. ysi=ylat-60. if(xlon.lt.60.) xlon=xlon+360. wi=xlon-60. ei=xlon+60. else if(ity.eq.3) then call lltopix(x1,y1,iscent,jscent) nx=x2 ny=y2 i1=iscent/ifull-nx/2 i2=i1+nx-1 j1=jscent/jfull-ny/2 j2=j1+ny-1 else if(ity.eq.2) then c construct a navigated sector from long/lat input west=min(x1,x2) east=max(x1,x2) north=max(y1,y2) south=min(y1,y2) c lltopix = lat,lon to pixel, examine the 4 corners and sides call lltopix(west,north,ielem(1),jline(1)) call lltopix(west,south,ielem(2),jline(2)) call lltopix(west,(north+south)/2,ielem(3),jline(3)) call lltopix(east,north,ielem(4),jline(4)) call lltopix(east,south,ielem(5),jline(5)) call lltopix(east,(north+south)/2,ielem(6),jline(6)) call lltopix((west+east)/2,north,ielem(7),jline(7)) call lltopix((west+east)/2,south,ielem(8),jline(8)) call lltopix((west+east)/2,(north+south)/2,ielem(9), , jline(9)) i1=ielem(9) i2=ielem(9) j1=jline(9) j2=jline(9) do m=1,8 if(ielem(m).gt.0) i1=min(i1,ielem(m)) i2=max(i2,ielem(m)) if(jline(m).gt.0) j1=min(j1,jline(m)) j2=max(j2,jline(m)) enddo c now adjust for sector and resolution i1=i1/mc.elem_res+1 i2=(i2-1)/mc.elem_res+1 j1=j1/mc.line_res+1 j2=(j2-1)/mc.line_res+1 c print locs of the corners endif yi=-90. ysi=90. call pixtoll(xlon,ylat,icent,jcent) wi=360. ei=-360. do m=-1,1 iy=(j1*float(1-m)/2.+j2*float(m+1)/2.-1)*mc.line_res+1 do l=-1,1 ix=(i1*float(1-l)/2.+i2*float(l+1)/2.-1)*mc.elem_res+1 c pixel (full resolution visible coordinates) to lat,lon, call pixtoll(xlon,ylat,ix,iy) print *,ix,iy,xlon,ylat if(ylat.gt.-90..and.ylat.lt.90.) then if(m.eq.-1) yi=amax1(yi,ylat) if(m.eq.1) ysi=amin1(ysi,ylat) if(l.eq.-1) wi=amin1(wi,xlon) if(l.eq.1) ei=amax1(ei,xlon) endif enddo enddo if(yi.eq.-90.) yi=80. if(ysi.eq.90.) ysi=-80. if(wi.eq.360.) wi=xlon-80. if(ei.eq.-360.) ei=xlon+80. print *,' selected sector ',i1,i2,j1,j2,' in data resolut' print *,' degree edges ',yi,ysi,wi,ei return end C====================================================================== C T I M E 5 0 C====================================================================== REAL*8 FUNCTION TIME50(btim) C C AUTHOR: Garrett Campbell and Kelly Dean C C CREATED: October 1994 C C DEVELOPED FOR: CIRA/COLORADO STATE UNIVERSITY C C PURPOSE: C Function TIME50 will take the epoch time from the GVAR NAVstr and C convert it to minutes from January 1, 1950. NOTE - Epoch time in C the NAVstr is not in the same format as other BCD times.C C C REVISION: 0.0 C C ARGUMENTS: C NAME: TYPE: PURPOSE: IN/OUT: C btim BYTE Binary coded data (BCD) time IN C C FUNCTIONS: C NAME: TYPE: PURPOSE: LIBRARY: C MOD INTEGER Returns a remainder Intrinsic C C NAME: PURPOSE: C **************** INTEGER ***************** C day_100 Part of day extracted from BCD C day_10 Part of day extracted from BCD C day_1 Part of day extracted from BCD C hour_10 Part of hour extracted from BCD C hour_1 Part of hour extracted from BCD C min_10 Part of minute extracted from BCD C min_1 Part of minute extracted from BCD C NY YEAR C ND DAY OF YEAR C NH HOUR C NM MINUTE C ibt C J Loop control variable C year_1000 Part of year extracted from BCD C year_100 Part of year extracted from BCD C year_10 Part of year extracted from BCD C year_1 Part of year extracted from BCD C **************** REAL*8 ***************** C S SECONDS - Double precision C C ------------------------------------------------------- C -------------- ACTUAL CODE STARTS HERE -------------- C ------------------------------------------------------- C C VARIABLE DECLARATION SECTION: C byte btim(8),bt INTEGER NY,ND,NH,NM,J INTEGER year_1000, year_100, year_10, year_1 INTEGER day_100, day_10, day_1, hour_10, hour_1, min_10, min_1 INTEGER sec_10, sec_1, msec_10, msec_1 integer ibt REAL*8 S C C Equivalence DECLARATION SECTION: C equivalence (bt,ibt) C C ******--------------------------------------------****** C ******-------- MAIN BODY STARTS HERE -----------****** C ******--------------------------------------------****** C C Extract the Binary Coded Time into separate year, Julian day, hour C minutes, seconds. C bt = btim(1) day_1 = ibt/16 hour_10 = mod(ibt,16) bt = btim(2) day_100 = mod(ibt/16,8) day_10 = mod(ibt,16) flywheel = mod(ibt,2) bt = btim(3) year_10 = ibt/16 year_1 = mod(ibt,16) bt = btim(4) year_1000 = ibt/16 year_100 = mod(ibt,16) bt = btim(5) msec_10 = ibt/16 msec_1 = mod(ibt,16) bt = btim(6) sec_1 = ibt/16 msec_100 = mod(ibt,16) bt = btim(7) min_1 = ibt/16 sec_10 = mod(ibt,16) bt = btim(8) hour_1 = ibt/16 min_10 = mod(ibt,16) C C Make the year, Julian day, hour, minute, and seconds. C ny = year_1000 * 1000 + year_100 * 100 + year_10 * 10 + year_1 nd = day_100 * 100 + day_10 * 10 + day_1 nh = hour_10 * 10 + hour_1 nm = min_10 * 10 + min_1 s = sec_10 * 10.0D0 + sec_1 + > msec_100 * 0.1D0 + msec_10 * 0.01D0 + msec_1 * 0.001D0 C C HERE WE CONVERT INTEGER YEAR AND DAY OF YEAR TO NUMBER OF C DAYS FROM 0 HOUR UT, 1950 JAN. 1.0 C THIS CONVERTION IS BASED ON AN ALGORITHM BY FLIEGEL AND VAN C FLANDERN, COMM. OF ACM, VOL.11, NO. 10, OCT. 1968 (P.657) C j = nd + 1461 * (ny + 4799) / 4 - 3 * > ( ( ny + 4899 ) / 100 ) / 4 - 2465022 C C Compute time in minutes from January 1.0, 1950 as double precision. C TIME50 = j * 1440.0D0 + nh * 60.0D0 + nm + s / 60.0D0 C C RETURN END C======================================================================== C I N S T 2 E C======================================================================== SUBROUTINE INST2E( R, P, Y, A, AT ) C C AUTHOR: KELLY DEAN C C CREATED: October 1994 C C DEVELOPED FOR: CIRA/COLORADO STATE UNIVERSITY C C PURPOSE: C Procedure INST2E accepts the single precision roll, pitch and yaw C angles of an instrument and returns the double precision instrument C to earth coordinates transformation matrix. C C REVISION: 0.0 C C REFERENCES: C OTHER DOCUMENTS C C COMMENTS: C Adapted from Igor Levine program for Integral Systems, Inc. C C ARGUMENTS: C NAME: TYPE: PURPOSE: IN/OUT: C R REAL*8 Roll angle (rad) IN C P REAL*8 Pitch angle (rad) IN C Y REAL*8 Yaw angle (rad) IN C A REAL*8 Spacecraft to ECEF coordinates OUT C transformation matrix C AT REAL*8 Instrument to ECEF coordinates OUT C transformation matrix C C VARIABLES: C NAME: PURPOSE: C **************** INTEGER ***************** C I Indices C J Indices C **************** REAL*8 ***************** C RPY Instrument to body coordinates transformation matrix C C ------------------------------------------------------- C -------------- ACTUAL CODE STARTS HERE -------------- C ------------------------------------------------------- C C CONSTANT DECLARATION SECTION: C C VARIABLE DECLARATION SECTION: REAL*8 A(3,3),AT(3,3),R,RPY(3,3),P,Y INTEGER*4 I,J C C ******--------------------------------------------****** C ******-------- MAIN BODY STARTS HERE -----------****** C ******--------------------------------------------****** C C Compute instrument to body coordinates transformation matrix C by using a small angle approximation of trigonometric function C of the roll, pitch and yaw. C RPY(1,1) = 1.0D0 - 0.5D0 * ( P * P + Y * Y ) RPY(1,2) = -Y RPY(1,3) = P RPY(2,1) = Y + P * R RPY(2,2) = 1.0D0 - 0.5D0 * ( Y * Y + R * R ) RPY(2,3) = -R RPY(3,1) = -P + R * Y RPY(3,2) = R + P * Y RPY(3,3) = 1.0D0 - 0.5D0 * ( P * P + R * R ) C C Multiplication of matrices A and RPY C DO I = 1,3 DO J = 1,3 AT(I,J) = A(I,1)*RPY(1,J)+A(I,2)*RPY(2,J)+A(I,3)*RPY(3,J) ENDDO ENDDO C C RETURN END C======================================================================= C G A T T C======================================================================= REAL*8 FUNCTION GATT( IMGR_REP, WA, TE) C C AUTHOR: KELLY DEAN C C CREATED: October 1994 C C DEVELOPED FOR: CIRA/COLORADO STATE UNIVERSITY C C PURPOSE: C This function computes an attitude/misalignment angle from C a given subset of the O&A parameters. C C REVISION: 0.0 C C ARGUMENTS: C NAME: TYPE: PURPOSE: IN/OUT: C IMGR_REP STRUCTURE C TE REAL*8 Input exponential time IN C delay from epoch (minutes) C WA REAL*8 Input solar orbit angle (rad) IN C C FUNCTIONS: C NAME: TYPE: PURPOSE: LIBRARY: C DCOS REAL*8 Cosine ( Double precision ) INTRINSIC C C VARIABLES: C NAME: PURPOSE: C **************** INTEGER ***************** C m Temporary variable for order of monomial sinusoids C C ------------------------------------------------------- C -------------- ACTUAL CODE STARTS HERE -------------- C ------------------------------------------------------- C C INCLUDE DECLARATION SECTION: C include 'c:\camp\isccp\g8for\stru.inc' c include 'iscph:stru.inc' C C VARIABLE DECLARATION SECTION: C INTEGER m REAL*8 TE, WA record /IMGR_RP/ IMGR_REP C C ******--------------------------------------------****** C ******-------- MAIN BODY STARTS HERE -----------****** C ******--------------------------------------------****** C gatt = IMGR_REP.mean_att_ang_const * 1.0D-7 C C Computes the exponential term. C IF ( TE .GE. 0.0D0 ) THEN gatt = gatt + (IMGR_REP.exp_mag * 1.0D-7 ) * > EXP(-te / ( IMGR_REP.exp_time_const * 1.0D-2 )) ENDIF C C Calculation of sinusoids. C DO l = 1, IMGR_REP.num_sinu_per_angle gatt = gatt + ( IMGR_REP.sinusoid(l).mag_sinu * 1.0D-7 ) * > DCOS(wa * l + > ( IMGR_REP.sinusoid(l).phase_ang_sinu * 1.0D-7 ) ) ENDDO C C Computes monomial sinusoids. C DO l = 1, IMGR_REP.num_mono_sinu m = IMGR_REP.monomial(l).order_mono_sinu gatt = gatt + (IMGR_REP.monomial(l).mag_mono_sinu * 1.0D-7) * > (wa - ( IMGR_REP.monomial(l).ang_from_epoch * 1.0D-7) )**m * > DCOS( IMGR_REP.monomial(l).order_appl_sinu * wa + > ( IMGR_REP.monomial(l).phase_ang_sinu * 1.0D-7 ) ) ENDDO C C RETURN END *********************************************************************** C*********************************************************************** C** C** INTEGRAL SYSTEMS, INC. C** C*********************************************************************** C** C** PROJECT : OPERATIONS GROUND EQUIPMENT FOR GOES-NEXT C** SYSTEM : EARTH LOCATION USERS GUIDE C** ROUTINE : LPOINT C** SOURCE : F.LPOINT C** LOAD NAME : ANY C** PROGRAMMER: IGOR LEVINE C** C** VER. DATA BY COMMENT C** ---- -------- --- --------------------------------------------- C** A 01/09/89 IL INITIAL CREATION C** A 06/02/89 IL COORDINATE AXES CHANGED ACCORDING TO C** FORD'S DEFINITION IN SDAIP, DRL504-01 C** C*********************************************************************** C** C** THIS SUBR CONVERTS THE INSTRUMENT ELEVATION AND SCAN C** ANGLES TO THE RELATED GEOGRAPHIC LATITUDE AND LONGITUDE. C** C*********************************************************************** C** C** CALLED BY : ANY C** COMMONS MODIFIED: NONE C** INPUTS : NONE C** OUTPUTS : NONE C** ROUTINES CALLED : NONE C** C*********************************************************************** C*********************************************************************** SUBROUTINE LPOINT(ALPHA,ZETA,RLAT,RLON,IERR) C C CALLING PARAMETERS C REAL*8 ALPHA C ELEVATION ANGLE (RAD) REAL*8 ZETA C SCAN ANGLE (RAD) REAL*8 RLAT C LATITUDE IN RADIANS (OUTPUT) REAL*8 RLON C LONGITUDE IN RADIANS (OUTPUT) INTEGER IERR C OUTPUT STATUS; 0 - POINT ON THE EARTH C FOUND, 1 - INSTRUMENT POINTS OFF EARTH C C LOCAL VARIABLES C REAL*8 G1(3) C POINTING VECTOR IN EARTH CENTERED COORDINATES REAL*8 H C SLANT DISTANCE TO THE EARTH POINT (KM) REAL*8 Q1,Q2,D C WORK SPACE REAL*8 G(3) C POINTING VECTOR IN INSTRUMENT COORDINATES REAL*8 U(3) C COORDINATES OF THE EARTH POINT (KM) REAL*8 SA,CA,DA,DZ,D1,CZ C WORK SPACE C C INCLUDE FILES C REAL*8 PI PARAMETER (PI=3.141592653589793D0) REAL*8 DEG PARAMETER (DEG=180.D0/PI) REAL*8 RAD PARAMETER (RAD=PI/180.D0) C DEGREES TO RADIANS CONVERSION PI/180 REAL*8 NOMORB PARAMETER (NOMORB=42164.365D0) C NOMINAL RADIAL DISTANCE OF SATELLITE (km) REAL*8 AE PARAMETER (AE=6378.137D0) C EARTH EQUATORIAL RADIUS (km) REAL*8 FER PARAMETER (FER=1.D0-(6356.7533D0/AE)) C EARTH FLATTENING COEFFICIENT = 1-(BE/AE) REAL*4 AEBE2 PARAMETER (AEBE2=1.D0/(1.D0-FER)**2) REAL*4 AEBE3 PARAMETER (AEBE3=AEBE2-1.) REAL*4 AEBE4 PARAMETER (AEBE4=(1.D0-FER)**4-1.) REAL*8 XS(3) C NORMALIZED S/C POSITION IN ECEF COORDINATES REAL*8 BT(3,3) C ECEF TO INSTRUMENT COORDINATES TRANSFORMATION REAL*8 Q3 C USED IN SUBROUTINE LPOINT REAL*8 PITCH,ROLL,YAW C PITCH,ROLL,YAW ANGLES OF INSTRUMENT (RAD) REAL*8 PMA,RMA C PITCH,ROLL MISALIGNMENTS OF INSTRUMENT (RAD) COMMON /ELCOMM/ XS,BT,Q3,PITCH,ROLL,YAW,PMA,RMA C*********************************************************************** IERR=1 C C COMPUTES TRIGONOMETRIC FUNCTIONS OF THE SCAN AND ELEVATION C ANGLES CORRECTED FOR THE ROLL AND PITCH MISALIGNMENTS C CA=DCOS(ALPHA) SA=DSIN(ALPHA) DA=ALPHA-PMA*SA*(1.0D0+DTAN(ZETA))-RMA*(1.0D0-CA) DZ=ZETA+RMA*SA C CORRECTED SCAN ANGLE CZ=DCOS(DZ) C C COMPUTES POINTING VECTOR IN INSTRUMENT COORDINATES C G(1)=DSIN(DZ) G(2)=-CZ*DSIN(DA) G(3)=CZ*DCOS(DA) C C TRANSFORMS THE POINTING VECTOR TO EARTH FIXED COORDINATES C G1(1)=BT(1,1)*G(1)+BT(1,2)*G(2)+BT(1,3)*G(3) G1(2)=BT(2,1)*G(1)+BT(2,2)*G(2)+BT(2,3)*G(3) G1(3)=BT(3,1)*G(1)+BT(3,2)*G(2)+BT(3,3)*G(3) C C COMPUTES COEFFICIENTS AND SOLVES A QUADRATIC EQUATION TO C FIND THE INTERSECT OF THE POINTING VECTOR WITH THE EARTH C SURFACE C Q1=G1(1)**2+G1(2)**2+AEBE2*G1(3)**2 Q2=XS(1)*G1(1)+XS(2)*G1(2)+AEBE2*XS(3)*G1(3) D=Q2*Q2-Q1*Q3 IF (DABS(D).LT.1.D-9) D=0.0D0 C C IF THE DISCIMINANTE OF THE EQUATION, D, IS NEGATIVE, THE C INSTRUMENT POINTS OFF THE EARTH C IF (D.LT.0.0D0) THEN RLAT=999999.0D0 RLON=999999.0D0 RETURN END IF D=DSQRT(D) C C SLANT DISTANCE FROM THE SATELLITE TO THE EARTH POINT C H=-(Q2+D)/Q1 C C CARTESIAN COORDINATES OF THE EARTH POINT C U(1)=XS(1)+H*G1(1) U(2)=XS(2)+H*G1(2) U(3)=XS(3)+H*G1(3) C C SINUS OF GEOCENTRIC LATITUDE C D1=U(3)/DSQRT(U(1)**2+U(2)**2+U(3)**2) C C GEOGRAPHIC (GEODETIC) COORDINATES OF THE POINT C RLAT=DATAN(AEBE2*D1/DSQRT(1.0D0-D1*D1)) RLON=DATAN2(U(2),U(1)) IERR=0 RETURN END C*********************************************************************** C*********************************************************************** C** C** INTEGRAL SYSTEMS, INC. C** C*********************************************************************** C** C** PROJECT : OPERATIONS GROUND EQUIPMENT FOR GOES-NEXT C** SYSTEM : EARTH LOCATION USERS GUIDE C** ROUTINE : GPOINT C** SOURCE : F.GPOINT C** LOAD NAME : ANY C** PROGRAMMER: IGOR LEVINE C** C** VER. DATA BY COMMENT C** ---- -------- --- --------------------------------------------- C** A 12/10/87 IL INITIAL CREATION C** A 06/10/88 IL REPLACED ASIN WITH ATAN TO SAVE TIME C** A 06/02/89 IL COORDINATE AXES CHANGED ACCORDING TO C** FORD'S DEFINITION IN SDAIP, DRL 504-01 C** C*********************************************************************** C** C** THIS SUBROUTINE CONVERTS GEOGRAPHIC LATITUDE AND LONGITUDE C** TO THE RELATED ELEVATION AND SCAN ANGLES. C** C*********************************************************************** C** C** CALLED BY : ANY C** COMMONS MODIFIED: NONE C** INPUTS : NONE C** OUTPUTS : NONE C** ROUTINES CALLED : NONE C** C*********************************************************************** C*********************************************************************** SUBROUTINE GPOINT(RLAT,RLON,ALF,GAM,IERR) C C CALLING PARAMETERS C REAL*8 RLAT C GEOGRAPHIC LATITUDE IN RADIANS (INPUT) REAL*8 RLON C GEOGRAPHIC LONGITUDE IN RADIANS (INPUT) REAL*8 ALF C ELEVATION ANGLE IN RADIANS (OUTPUT) REAL*8 GAM C SCAN ANGLE IN RADIANS (OUTPUT) INTEGER IERR C OUTPUT STATUS; 0 - SUCCESSFUL COMPLETION, C 1 - POINT WITH GIVEN LAT/LON IS INVISIBLE C C LOCAL VARIABLES C REAL*8 F(3) C POINTING VECTOR IN EARTH CENTERED COORDINATES REAL*8 FT(3) C POINTING VECTOR IN INSTRUMENT COORDINATES REAL*8 U(3) C COORDINATES OF THE EARTH POINT (KM) REAL*8 SING,SLAT,W1,W2 C WORK SPACE C C INCLUDE FILES C REAL*8 PI PARAMETER (PI=3.141592653589793D0) REAL*8 DEG PARAMETER (DEG=180.D0/PI) REAL*8 RAD PARAMETER (RAD=PI/180.D0) C DEGREES TO RADIANS CONVERSION PI/180 REAL*8 NOMORB PARAMETER (NOMORB=42164.365D0) C NOMINAL RADIAL DISTANCE OF SATELLITE (km) REAL*8 AE PARAMETER (AE=6378.137D0) C EARTH EQUATORIAL RADIUS (km) REAL*8 FER PARAMETER (FER=1.D0-(6356.7533D0/AE)) C EARTH FLATTENING COEFFICIENT = 1-(BE/AE) REAL*4 AEBE2 PARAMETER (AEBE2=1.D0/(1.D0-FER)**2) REAL*4 AEBE3 PARAMETER (AEBE3=AEBE2-1.) REAL*4 AEBE4 PARAMETER (AEBE4=(1.D0-FER)**4-1.) REAL*8 XS(3) C NORMALIZED S/C POSITION IN ECEF COORDINATES REAL*8 BT(3,3) C ECEF TO INSTRUMENT COORDINATES TRANSFORMATION REAL*8 Q3 C USED IN SUBROUTINE LPOINT REAL*8 PITCH,ROLL,YAW C PITCH,ROLL,YAW ANGLES OF INSTRUMENT (RAD) REAL*8 PMA,RMA C PITCH,ROLL MISALIGNMENTS OF INSTRUMENT (RAD) COMMON /ELCOMM/ XS,BT,Q3,PITCH,ROLL,YAW,PMA,RMA C*********************************************************************** C C COMPUTES SINUS OF GEOGRAPHIC (GEODETIC) LATITUDE C SING=DSIN(RLAT) W1=AEBE4*SING*SING C C SINUS OF THE GEOCENTRIC LATITUDE C SLAT=((0.375D0*W1-0.5D0)*W1+1.0D0)*SING/AEBE2 C C COMPUTES LOCAL EARTH RADIUS AT SPECIFIED POINT C W2=SLAT*SLAT W1=AEBE3*W2 W1=(0.375D0*W1-0.5D0)*W1+1.D0 C C COMPUTES CARTESIAN COORDINATES OF THE POINT C U(3)=SLAT*W1 W2=W1*DSQRT(1.0D0-W2) U(1)=W2*DCOS(RLON) U(2)=W2*DSIN(RLON) C C POINTING VECTOR FROM SATELLITE TO THE EARTH POINT C F(1)=U(1)-XS(1) F(2)=U(2)-XS(2) F(3)=U(3)-XS(3) W2=U(1)*SNGL(F(1))+U(2)*SNGL(F(2))+ 1 U(3)*SNGL(F(3))*AEBE2 C C VERIFIES VISIBILITY OF THE POINT C IF (W2.GT.0.0D0) THEN C INVISIBLE POINT ON THE EARTH IERR=1 ALF=99999.0D0 GAM=99999.0D0 RETURN END IF C C CONVERTS POINTING VECTOR TO INSTRUMENT COORDINATES C FT(1)=BT(1,1)*F(1)+BT(2,1)*F(2)+BT(3,1)*F(3) FT(2)=BT(1,2)*F(1)+BT(2,2)*F(2)+BT(3,2)*F(3) FT(3)=BT(1,3)*F(1)+BT(2,3)*F(2)+BT(3,3)*F(3) C C CONVERTS POINTING VECTOR TO SCAN AND ELEVATION ANGLES AND C CORRECTS FOR THE ROLL AND PITCH MISALIGNMENTS C GAM=ATAN(FT(1)/SQRT(FT(2)**2+FT(3)**2)) ALF=-DATAN(FT(2)/FT(3)) W1=DSIN(ALF) W2=DCOS(ALF) ALF=ALF+RMA*(1.0D0-W2)+PMA*W1*(1.0D0+DTAN(GAM)) GAM=GAM-RMA*W1 IERR=0 RETURN END subroutine pixtoll(xlon,ylat,ix,iy) c (ix=elem,iy=line) to GVAR (xlon,ylat) input in full res coordinates c output in degrees real *8 x,y,elev,scan,lat,lon REAL*8 PI/3.141592653589793D0/ x=ix y=iy CALL COMP_ES( y, x, elev, scan ) CALL LPoint( elev, scan, lat, lon, ierr ) if(lat.ne.999999.) then xlon=(lon/pi)*180. ylat=(lat/pi)*180. else xlon=lon ylat=lat endif return end subroutine lltopix(west,north,ielem,jline) c (lat,lon) to GVAR (ielem,jline) output in full res coordinates real *8 latr,lonr,elev,scan,line,pixel real west,north REAL*8 PI/3.141592653589793D0/ LatR = north * ( PI / 180.0D0 ) LonR = west * ( PI / 180.0D0 ) CALL GPoint( LatR, LonR, elev, scan, ierr ) IF ( ierr.ne.0 ) THEN ielem=0 jline=0 ELSE CALL COMP_LP(elev,scan,line,pixel) ielem=pixel jline=line ENDIF return end subroutine filve(v,i1,i2,j1,j2,si,sj,nx,ny,di,dj,i0,j0) wide=(i2-i1+1)*si di=100 nx=wide/di+1 dj=100 tall=(j2-j1+1)*sj ny=tall/dj+1 i0=i1*si j0=j1*si call filloc(v,i0,j0,di,dj,nx,ny) return end subroutine filloc(v,i0,j0,di,dj,nx,ny) real v(3,nx,ny) data radang/.01745329/ do j=1,ny iy=j0+j*dj do i=1,nx iy=i0+i*di call pixtoll(xlon,ylat,ix,iy) xlon=xlon*radang ylat=ylat*radang v(1,i,j)=cos(xlon)*cos(ylat) v(2,i,j)=sin(xlon)*cos(ylat) v(3,i,j)=sin(ylat) enddo enddo return end subroutine uegnext(i,j,ue,xlon,ylat,nextgnav,uemis) integer nextgnav(4) c this dependent upon the sector selected in secsel c pass that info in a common block c real ue(3),uemis(3) data radang/.01745329/ ix=(nextgnav(1)+i)*nextgnav(3) iy=(nextgnav(2)+j)*nextgnav(4) call pixtoll(xlon,ylat,ix,iy) if(ylat.gt.90.) then ue(1)=uemis(1) ue(2)=uemis(2) ue(3)=uemis(3) else rlon=xlon*radang rlat=ylat*radang ue(1)=cos(rlon)*cos(rlat) ue(2)=sin(rlon)*cos(rlat) ue(3)=sin(rlat) endif return end subroutine uegint(i,j,si,sj,ue,nx,ny,di,dj,i0,j0,v) real v(3,nx,ny),ue(3) fi=(i*si-i0)/di k=fi kp=fi+1. fj=(j*sj-j0)/dj l=fj lp=fj+1 wi=kp-fi wj=lp-fj do m=1,3 ue(m)=wi*wj*v(m,k,l)+ (1.-wi)*wj*v(m,kp,l)+ , wi*(1.-wj)*v(m,k,lp)+(1.-wi)*(1.-wj)*v(m,kp,lp) enddo sue=sqrt(ue(1)*ue(1)+ue(2)*ue(2)+ue(3)*ue(3)) ue(1)=ue(1)/sue ue(2)=ue(2)/sue ue(3)=ue(3)/sue return end subroutine sunloc(usun,iydddhh,xmin) real usun(3) iyr=iydddhh/100000 iddd=iydddhh-iyr*100000 ihh=mod(iddd,100) iddd=iddd/100 if(iyr.lt.10) iyr=iyr+90 min=xmin isec=(xmin-min)*60. call sun4vec(iyr,iddd,ihh,min,isec,xlon,xlat,usun) print *,iyr,iddd,ihh,xlon,xlat,' sunp' return end ============================================================================== include 'c:\camp\isccp\g8for\stru.inc' ============================================================================== structure /MCIDAS_DATDIR_AREA_HDR_T/ !bytes 1-256 integer *4 area_status,version_num,sat_id_num,img_date,img_time, 1 north_bound,west_vis_pixel,z_coor,num_line,num_elem, 2 bytes_per_pixel,line_res,elem_res,num_chan, 3 num_byte_ln_prefix,proj_num,creation_date, 3 creation_time, 4 sndr_filter_map,img_id_num,id(4) character *32 comment integer *4 pri_key_calib,pri_key_nav,sec_key_nav,val_code, a pdl(8), 1 band8,act_img_date,act_img_time,act_start_scan, 2 len_prefix_doc,len_prefix_calib,len_prefix_lev character*4 src_type character*4 calib_type integer *4 avg_or_sample,poes_signal,poes_up_down character*4 orig_src_type integer *4 reserved(4) integer *4 ns_fudge integer *4 cal_loc integer *4 res2 c the fudge factor appears to be needed to fix up the c navigation. end structure structure / BCD_TIME_T / byte tm(8) end structure structure /IMGR_SCAN_STATUS_T/ byte bb(4) c each bit means something c look at the coresponding C structure definition end structure structure /GVAR_HDR_ISC/ byte block_id,word_size integer *2 word_count,prod_id byte epeat_flag,version,data_valid,asc_bin,spare1,range integer *2 block_count,spare2 end structure structure / BLOCKS_1TO10_LINE_DOC_2BYTE_ISC/ integer *2 sat_id,sps_source,active_det_set,det_num,channel integer *2 imgr_stat1,imgr_stat2,pixel_offset integer *4 scan,num_pixels,num_words integer *2 spare(2) end structure structure /ISC_LINE_PREFIX/ integer *2 linesize ! /* 16+nwide*num_chan+64 */ integer *2 line_number ! /* scan line number full res units*/ integer *2 west ! /* west edge in vis pixel units */ integer *2 nwide ! /* number of pixels in one channel */ integer *2 chan_id ! /* channel id (100+num_chan) */ integer *2 xave ! /* visible average interval in x */ integer *2 num_chan ! /* number of channels */ integer *2 xstep ! /* step size in full vis pixel units */ integer *4 val_code ! /* good data code (0=good, other=some bad)*/ record /IMGR_SCAN_STATUS_T/imgr record /BCD_TIME_T/time record /GVAR_HDR_ISC/blk_hdr record /BLOCKS_1TO10_LINE_DOC_2BYTE_ISC/imgr_2 end structure C C Imager ONA repeat sinusoid T. C STRUCTURE / IMGR_SIN / INTEGER mag_sinu INTEGER phase_ang_sinu END STRUCTURE C C Imager repeat monomial T. C STRUCTURE / IMGR_MON / INTEGER order_appl_sinu INTEGER order_mono_sinu INTEGER mag_mono_sinu INTEGER phase_ang_sinu INTEGER ang_from_epoch END STRUCTURE C C Imager repeat T. C STRUCTURE / IMGR_RP / INTEGER exp_mag INTEGER exp_time_const INTEGER mean_att_ang_const INTEGER num_sinu_per_angle RECORD / IMGR_SIN / sinusoid(15) INTEGER num_mono_sinu RECORD / IMGR_MON / monomial(4) END STRUCTURE C C Define GVAR Navigation block C STRUCTURE /GVAR_NAV/ character *4 nav_type integer *4 IMC_status INTEGER spare1(2) INTEGER stat INTEGER ref_long INTEGER ref_rad_dist INTEGER ref_lat INTEGER ref_orb_yaw INTEGER ref_att_roll INTEGER ref_att_pitch INTEGER ref_att_yaw BYTE epoch_time(8) ! BCD_TIME INTEGER start_time INTEGER IMC_corr_roll INTEGER IMC_corr_pitch INTEGER IMC_corr_yaw INTEGER ref_long_change(13) INTEGER ref_rad_dist_change(11) INTEGER sine_lat(9) INTEGER sine_orb_yaw(9) INTEGER solar_rate INTEGER exp_start_time RECORD / IMGR_RP / roll_att INTEGER spare2(10) CHARACTER*4 more1 CHARACTER*4 gvar1 RECORD / IMGR_RP / pitch_att RECORD / IMGR_RP / yaw_att INTEGER spare3(16) CHARACTER*4 more2 CHARACTER*4 gvar2 RECORD / IMGR_RP / roll_misalgn RECORD / IMGR_RP / pitch_misalgn INTEGER img_date INTEGER img_time INTEGER instr INTEGER spare4(9) integer ns_cyl integer ew_cyl integer ns_inc integer ew_inc CHARACTER*4 more3 CHARACTER*4 gvar3 INTEGER spare5(126) CHARACTER*4 more4 CHARACTER*4 gvar4 INTEGER spare6(127) END STRUCTURE structure /CIRA_HD/ ! extra cira info 128 bytes character *1 compress integer *2 north_south_adj integer *2 west_east_adj integer *1 spare(123) end structure structure /CIRA_HD2/ integer *4 compress integer *4 navflg integer *4 north_south_adj integer *4 west_east_adj integer *1 spare(112) end structure structure /ISCHEAD/ !2504 bytes ASCII information character *80 text !General info character *12 scale(0:6) !out=in*scale-offset character *12 offset(0:6) character *12 sampx(0:6) !sampling interval west to east character *12 averx(0:6) !averaging interval w-e character *12 sampy(0:6) !sampling interval north to south character *12 avery(0:6) !averaging interval n-s character *80 sens(0:6) !sensor numbers included character *80 primary_secondary !sensor set ID character *12 xcal10(0:49) !Vis and IR cal info. character *80 news !another info field character *12 alextra(50) !extra end structure ============================================================================== ============================================================================== c c routines used with microsoft fortran c These originated on the VAX and on those machines direct c tape I/O was possible. This is not so on the PC's c c G.G. Campbell c subroutine tpvwrt(iot,buf,nwrt,lerr) COMMON/TAPDIR/LENDIR(10) COMMON/TAPET/ITAP(10) COMMON/TAPCHN/ICHAN(10) INTEGER *2 LERR,ITAP,nr integer *4 nr4 equivalence(nr4,nr) byte buf(nwrt) goto(1200,1100,1,100,200,300,400,500) itap(iot)+3 1200 continue 1100 continue 1 continue lerr=-4 return 100 continue nr4=nwrt write (iot,err=3) nr,buf lerr=1 return 200 continue 300 continue if(lerr.le.1) lerr=ichan(iot)+1 write(iot,rec=lerr) buf ichan(iot)=lerr lerr=1 return 400 continue 500 continue write (iot,err=3) buf lerr=1 return 3 lerr=-3 return end subroutine tpvskp(in,num,ltype,lerr) character *(*) ltype integer *2 lerr byte b[allocatable](:) if(ltype.eq.'BY') then nb=min(16000,num) allocate(b(nb)) do n=1,num,nb krd=min(nb,num-n+1) read(in) (b(i),i=1,krd) enddo deallocate(b) lerr=1 c simulate fseek, maybe call it directly else if(ltype.eq.'FL') then print *,' INTERNAL Endoffile marks are not supported',in,num stop 78 else if(ltype.eq.'RC') then c assume the input is a sequential file do j=1,num read(in) enddo lerr=1 endif return end subroutine tpvrwd(in) COMMON/TAPDIR/LENDIR(10) COMMON/TAPET/ITAP(10) COMMON/TAPCHN/ICHAN(10) INTEGER *2 ITAP goto(1200,1100,1,100,200,300,400,500) itap(in)+3 1200 continue 1100 continue 1 continue print *,' file ',in,' not available' return 100 continue 200 continue 400 continue 500 continue rewind in return 300 continue ichan(in)=0 return end subroutine tpvrln(in,buf,nwant,lerr,nread) c simple read of nwant into the buffer buf with error codes. COMMON/TAPDIR/LENDIR(10) COMMON/TAPCHN/ICHAN(10) COMMON/TAPET/ITAP(10) INTEGER *2 LERR,NREAD,ITAP,nr integer *4 nr4 equivalence(nr4,nr) byte buf(*) goto(1200,1100,1,100,200,300,400,500) itap(in)+3 1200 continue 1100 continue 1 continue lerr=-4 return 100 continue read(in,err=3,end=10) nr,(buf(i),i=1,min(nr4,nwant)) if(nr4.gt.nwant) lerr=-13 nread=min(nr4,nwant) lerr=1 return 200 continue 300 continue if(lerr.le.1) lerr=ichan(in)+1 read(in,rec=lerr) (buf(i),i=1,min(nwant,lendir(in))) nread=min(nwant,lendir(in)) ichan(in)=lerr lerr=1 return 400 continue 500 continue read(in,err=3,end=10) (buf(i),i=1,nwant) lerr=1 nread=nwant return c error conditions 3 lerr=-3 return 10 lerr=-10 return end subroutine tpvret(ifile) COMMON/TAPDIR/LENDIR(10) COMMON/TAPET/ITAP(10) COMMON/TAPCHN/ICHAN(10) INTEGER *2 ITAP close(unit=ifile) itap(ifile)=0 lendir(ifile)=0 ichan(ifile)=0 return end subroutine tpvopnc(in,lfile,type,lerr) c simple file open, this particular version works for a PC c MICROSOFT Fortran with NT character *(*) lfile,type COMMON/TAPCHN/ICHAN(10) COMMON/TAPDIR/LENDIR(10) COMMON/TAPET/ITAP(10) INTEGER *2 LERR,ITAP integer *2 lrec equivalence (lrec,nrec) integer *4 nrec if(index(type,'F').ne.0.or.index(type,'f').ne.0) then itap(in)=5 if(index(type,'RED').ne.0.or.index(type,'red').ne.0) then open(unit=in,file=lfile,mode='read',form='binary',err=77, , status='old') else open(unit=in,file=lfile,form='binary',status='unknown') endif c the binary form allows fread action from C else if(type(1:1).eq.'D') then itap(in)=3 lrec=lerr lendir(in)=nrec if(index(type,'NEW').ne.0) then 13 open(unit=in,file=lfile,status='new',access='direct', , recl=nrec,err=11) go to 12 11 open(unit=in,file=lfile,status='old') c if this is a NEW file, blow away the old file close(unit=in,status='delete') open(unit=in,file=lfile,status='new',access='direct', , recl=nrec) else open(unit=in,file=lfile,status='old',access='direct', , recl=nrec,err=13) endif 12 continue ichan(in)=0 else itap(in)=1 if(index(type,'NEW').ne.0) then 23 open(unit=in,file=lfile,status='new',access='sequential', , form='unformatted',err=21) goto 22 21 open(unit=in,file=lfile,status='old') close(unit=in,status='delete') goto 23 22 continue else if(index(type,'OLD').ne.0) then open(unit=in,file=lfile,status='new',form='unformatted', , access='sequential',err=23) else if(index(type,'APP').ne.0) then open(unit=in,file=lfile,status='old',form='unformatted', , access='append',err=23) else if(index(type,'REA').ne.0.or.index(type,'RED').ne.0) then open(unit=in,file=lfile,status='old',form='unformatted', , access='sequential',err=23) endif endif lerr=1 return 77 continue print *,' open error ',type,lfile lerr=-10 return end SUBROUTINE TPVEOV(IU) C C MOVE TO THE END OF VOLUME OF A TAPE IU C THIS EQUIVALENT TO OPEN (TYPE='APPEND') C C JAN, 1984 GG CAMBELL C IMPLICIT INTEGER *2 (A-Z) COMMON/TAPET/ITAP(10) COMMON/TAPCHN/ICHAN(10) CHARACTER * 80 FLNAME INTEGER *4 ICHAN,JST,JL,ARR(2) GO TO (631,731,400,300,400,400) ITAP(IU)+3 631 CONTINUE NF=0 601 NF=NF+1 NR=0 602 CONTINUE CALL TPVRLN(IU,ARR,8,LERR,NREAD) NR=NR+1 IF(LERR.EQ.1.OR.LERR.EQ.-13) GO TO 602 IF(LERR.EQ.-10.AND.NR.GT.1) GO TO 601 PRINT *,' ERROR DETECTED AT RECORD ',NR,' FILE ',NF IF(LERR.NE.-11) GO TO 601 C CAME TO DOUBLE EOF CALL TPVSKP(IU,'FL',-1,LERR) RETURN 731 CALL MTFEOV(ICHAN(IU),JL,JST) PRINT 83,IU,JL,JST 83 FORMAT(' AT EOV ',I4,' FL SKIP ',I4,' IST ',I5) IF(JST.NE.-11.AND.JST.NE.1) CALL EXIT RETURN 300 CONTINUE INQUIRE (UNIT=IU,NAME=FLNAME) CLOSE (UNIT=IU) OPEN (UNIT=IU,file=FLNAME,FORM='UNFORMATTED', , ACCESS='APPEND',status='OLD') RETURN 400 PRINT *,' UNIT NOT AVAILABLE FOR EOV ',IU,ITAP(IU) RETURN END program testb2 c c simple test read and navigate GOES 9 B2 data. For more information vist: c http://www.cira.colostate.edu/climate/isccp/docum/G9B2format.htm c c G.G. Campbell 11/96 c byte buf[allocatable](:) byte arr[allocatable](:,:,:) byte bf[allocatable](:) real calib(-128:127,7) real rtab(0:255,7),ttab(0:255,5) integer ichanl(7),int byte bint equivalence(bint,int) c one could use fixed sizes for these arrays if one wished byte bmiss/-1/ c open the file or tape for binary input print *,' Test read of GOES 9 B2 data file' print *,' This will read a file and print out the locations' print *,' and radiances for some locations' print *,' the code is self contained except for IO routines' print *,' G.G. Campbell 11/96' print *,' ' call tpvintc(in) allocate (buf(15000)) c c tpvrln(unit,buffer,number_of_bytes_to_read,error_code,number_bytes_read) c this needs to do binary reads from disk or tape. c tpvret(unit) ! close the file c tpvintc(unit) ! open the file c read the first header information especially to get nheader call tpvrln(in,buf,256,lerr,nread) call mccrack(buf,nheader,ndata,iydddhh,navpos,lcirahd,mmss) print *,' yydddhh ',iydddhh,ndata,nheader,mmss c read the rest of the header call tpvrln(in,buf(257),nheader-256,lerr,nread) c nheader can be used as a pointer to the first scan information c c set up the navigation constants c The navigation usually works to 4 km accuracy. With the 32 km c sampling of the B2 data, everything should work OK. c set up navigation call sectsel(buf,buf(navpos),i1,i2,j1,j2,nchanl,nprefix, , ndata,ichanl,i0,j0,imax,jmax,instru,icent,jcent, , ires,jres) c c set up the calibration tables {calib} c notice that NESDIS adjust the counts to this scale and counts like c these were sent to lanion for calibration by comparison to AVHRR. ishdpos=nheader-2504+1 call calgvar(isat,buf(ishdpos),'none',rtab,ttab) c move rtab nominal radiance supplied to Lannion into calib for radiance print out c ttab = nominal temperatures supplied to Lannion c do n=1,7 do int=0,255 calib(bint,n)=rtab(int,n) enddo enddo c adjust the calib tables to reflect the Lanion results for this time c period and satellite c c Dennis Chesters has slightly different calibration coeficients c but since we are dealing with 8 bit values, there is no difference. c c now ready to read the scan lines. c We no longer have the inconvenience of physical headers scattered c in the data. c nchanl = number of channels (all ways 7) c nprefix = number of bytes in the line prefix allocate(bf(ndata)) allocate(arr(i1:i2,j1:j2,nchanl)) do j=j1,j2 c read each line call tpvrln(in,bf,ndata,lerr,nread) if(lerr.ne.1) then print *,' read problem ',j,lerr,nread stop endif call preftran(bf,igood) ! translate prefix, checking for good data lines if(igood.eq.1) then ip=nprefix do i=i1,i2 do n=1,nchanl ip=ip+1 arr(i,j,n)=bf(ip) enddo enddo else do i=i1,i2 do n=1,nchanl arr(i,j,n)=bmiss enddo enddo endif enddo call tpvret(in) ! return the file c c now one can make a picture of each of the 7 images c c apply the calibration and navigation call pixtoll(xcent,ycent,icent,jcent) print *,' calculated center lon,lat',xcent,ycent print *,' element, line of center',icent,jcent print *,' ' print *,' test print out locations and radiances ' print *,' i j lon lat vis ch2 ch3 ch', , '4 ch5 sd1 sd4' do j=j1,j2 jful=(j-1)*jres+1 c print *,j,ifwest,ifeast do i=i1,i2 c convert the indices from B2 position into full resolution c coordinates, a small offset is added to the up left corner c full pixel location to reflect the size of the pixel c thus ifull and jfull represent the center of the pixel c not the upper left corner. c calculate the lat,lon of the pixel center iful=(i-1)*ires+1 call pixtoll(xlon,ylat,iful,jful) if(mod(i,30).eq.1.and.mod(j,30).eq.1) then print 77,i,j,xlon,ylat,(calib(arr(i,j,n),n),n=1,nchanl) 77 format(1x,2i5,2f9.1,7f7.2) endif c notice that some of these locations are off the earth enddo enddo end subroutine calgvar(isat,buf,sav,rtab,ttab) c print out a table to convert count to radiance or temperature character *(*) sav character *1 null character *60 lout include 'stru.inc' record /ischead/buf real rtab(0:255,0:6),ttab(0:255,0:4) real scale(0:6),offset(0:6),xcal10(0:49) integer sens(0:5),c8 null=char(0) 124 format(f12.4) print *,'_______________________________________________________' print *,' calibration for count to radiance conversion' print *,' also count to temperature ' print *,' these are the nominal values supplied to Lannion' print * print *,buf.text print *,buf.news do j=0,6 k=index(buf.scale(j),null)-1 read(buf.scale(j)(1:k),124) scale(j) k=index(buf.offset(j),null)-1 read(buf.offset(j)(1:k),124) offset(j) enddo do j=0,49 k=index(buf.xcal10(j),null)-1 if(k.gt.0) read(buf.xcal10(j)(1:k),124) xcal10(j) enddo k=index(buf.sens(0),null) read (buf.sens(0)(1:k),'(i1,i2,i2,i2,i2,i2)') sens B=0 Q1=0 Q2=0 do i=2,5 j = sens(i) B = B + xcal10(j) Q1 = Q1 + xcal10(j+8) Q2 = Q2 + xcal10(j+16) enddo B=B/4. Q1=Q1/4. Q2=Q2/4. AF=xcal10(24) do c8=0,255 c=c8/scale(0)+offset(0)+1.5 VR=c**2*Q2+c*Q1+B if(VR.lt.0) VR=0. rtab(c8,0)=VR ALB=VR*AF ttab(c8,0)=ALB SR=c8/scale(5)+offset(5) rtab(c8,5)=SR**2*Q1 c the variance of the vis is in location 5 enddo do ichanl=1,4 if(ichanl.eq.1) then B=xcal10(27) G = xcal10(35) if(isat.eq.70) then FK1=199943.56 FK2=3684.01 TC1=0.6514 TC2=0.9990 c revised by Chad Johnson c see mail message 12/19/95 FK1=199986.19 FK2=3684.27 TC1=0.6357 TC2=0.9991 else FK1=198807.83 FK2=3677.02 TC1=0.5864 TC2=0.9992 endif else if(ichanl.eq.2) then B = xcal10(28) G = xcal10(36) if(isat.eq.70) then FK1=38782.06 FK2=2132.53 TC1=0.5891 TC2=0.9986 FK1=38792.39 FK2=2132.72 TC1=0.6060 TC2=0.9986 else FK1=38732.41 FK2=2131.62 TC1=0.4841 TC2=0.9989 endif else if(ichanl.eq.3) then B = xcal10(25) G = xcal10(33) if(isat.eq.70) then FK1=9740.34 FK2=1345.48 TC1=0.3919 TC2=0.9987 FK1=9737.93 FK2=1345.37 TC1=0.3735 TC2=0.9987 else FK1=9717.21 FK2=1344.41 TC1=0.3622 TC2=0.9988 endif else if(ichanl.eq.4) then B = xcal10(26) G = xcal10(34) if(isat.eq.70) then FK1=6945.75 FK2=1202.05 TC1=0.2372 TC2=0.9991 FK1=6944.64 FK2=1201.99 TC1=0.2217 TC2=0.9992 else FK1= 6899.47 FK2=1199.38 TC1=0.2014 TC2=0.9992 endif endif do c8=0,255 SR=c8/scale(ichanl)+offset(ichanl)+1.5 R = (SR - B) / G rtab(c8,ichanl)=R expn = (FK1/R+1.) if(expn.gt.0..and.R.gt.0.) then TT=FK2/alog(expn) c use plank function to convert radiance to temperature ttab(c8,ichanl)=(TT-TC1)/TC2 else ttab(c8,ichanl)=0. rtab(c8,ichanl)=0. endif enddo enddo c then channel 4 variance uses the radiance cal of channel 4 B = xcal10(25) G = xcal10(33) do c8=0,255 SR=C8/scale(6)+offset(6) R=SR**2/G rtab(c8,6)=R enddo c now print out the results print 44,' rad ',(i+1,i=0,6) 44 format(a,i7,6i10) do c8=0,255 print 10,c8,(rtab(c8,i),i=0,6) 10 format(i5,7f10.4) enddo print 144,' norm vs, temp:',(i+1,i=1,4) 144 format(a,i2,6i10) do c8=0,255 print 10,c8,(ttab(c8,i),i=0,4) enddo if(index(sav,'cal\').gt.0) then k=index(sav,'cal\') do ichanl=0,4 write(lout,904) sav(1:k),ichanl+1 iot=81 open(unit=iot,file=lout,status='unknown',form='formatted') 904 format('cal\table.ch',i1) do c8=0,255 write (iot,905) c8,rtab(c8,ichanl),ttab(c8,ichanl) 905 format(i5,2f10.4) enddo close(unit=iot) enddo endif print *,'_____________calibration done _________________________' return end subroutine tpvintc(in) integer *2 lerr character * 60 lfile,lgen print *,' enter file name ' read (5,'(a)') lgen call sel_file(lgen,lfile,0) call tpvopnc(in,lfile,'FRED',lerr) if(lerr.ne.1) then print *,' file not found ',lfile stop 1 endif return end subroutine mccrack(a,nheader,ndatat,iydddhh,navpos,lcirahd,mmss) c extract info form mcidas header include 'stru.inc' record /MCIDAS_DATDIR_AREA_HDR_T/a record /ISC_LINE_PREFIX/c C Simple test program to display some of the elements of the C ISCCP GVAR headers. This assumes that one can read random C length byte streams from the input file as in UNIX. Record C oriented systems like the VAX will not work. This simulates C the action of fread in C. C Byte swaping maybe needed for the I*2 and I*4 variables. print *,a.area_status,a.version_num,a.sat_id_num,a.img_date, 1 a.img_time,a.north_bound,a.west_vis_pixel,a.z_coor, 2 a.num_line,a.num_elem,a.bytes_per_pixel,a.line_res, 3 a.elem_res,a.num_chan,a.num_byte_ln_prefix,a.proj_num, 4 a.creation_date,a.creation_time,a.sndr_filter_map, 5 a.img_id_num print *,a.comment print *,a.pri_key_calib,a.pri_key_nav,a.sec_key_nav,a.val_code print *,a.band8,a.act_img_date,a.act_img_time,a.act_start_scan, 2 a.len_prefix_doc,a.len_prefix_calib,a.len_prefix_lev print *,a.src_type print *,a.calib_type print *,a.avg_or_sample,a.poes_signal,a.poes_up_down print *,a.orig_src_type C Read in the calibration and navigation components of the header. iydddhh=a.img_date*100+a.img_time/10000 mmss = mod(a.img_time,10000) print *,iydddhh nheader=a.pri_key_nav navpos=a.sec_key_nav+1 ndatat=a.num_elem*a.bytes_per_pixel*a.num_chan+ , a.num_byte_ln_prefix if(a.bytes_per_pixel.ne.1) then print *,' warning this is not 1 byte data ' endif lcirahd=11369 C read each scan line in and print out part of the header C cracking the BCD time is rather a pain in Fortran but I am C sure it can be done. C One should look for potential breaks in the time sequence C because the satellite operations can call for high priority C scans in the middle of full disk images. return end subroutine adjmc(mc,navstr,cirahd1,cirahd2) c The initial navigation package did not include all the information. c We made an empirical adjustment to the north edge to make the old c navigation code to work. In January 1995 the new parameters and new c code was implemented. The routine adjusts the corner when needed. c c This is not needed for GOES 9 but might be needed for GOES 8. include 'stru.inc' record/cira_hd/cirahd1 ! old format (pre 1995) record/cira_hd2/cirahd2 ! new format record/GVAR_NAV/navstr record/MCIDAS_DATDIR_AREA_HDR_T/mc if(navstr.ns_cyl.eq.0) then print *,' use the adjusted corner: no extra nav info' c print *,' adj ',mc.north_bound,cirahd1.north_south_adj, c , cirahd2.north_south_adj,cirahd2.navflg return endif if( cirahd2.adjustment_flag.gt.0) then c unadjust the north corner print *,' adjusting the corner',cirahd2.north_south_adj mc.north_bound=mc.north_bound-cirahd2.north_south_adj c no unadjustment needed because not applied endif return end subroutine sectsel(mc,mc_nav,i1,i2,j1,j2,nchanl,nhead, , ndata,ichanl,i0,j0,imax,jmax,instru,icent,jcent, , ires,jres) c select the sector of interest. c mc = 256 byte component of header specifying the sector c mc_nav = navigation info c i1,i2 = west, east pixel limits of selected sector c j1,j2 = north, south line limits of selected sector c nchanl = number of channels of data (7) c nhead = bytes in line prefix c ndata = input length of scan line c ichanl = spectral channel identifiers (1=vis, 2=3.7um, 3=6.7um, c 4=11um, 5 = 12um c 21 = s.d. of vis, 24 = s.d. of 11um c i0 = number of apparent elements to the left of the sector to the nominal edge c of the scan at this sampling rate c j0 = number of apparent lines above the sector to the nominal north edge c of the scan at this sampling rate c imax = last element at this sampling rate c jmax = last lien at this sampling rate c this array of data can be considered as da(i0:imax,j0:jmax) to simplify the c addressing of the data and the coresponding navigation c icent,jcent = returned for setupnav with the indices of the image center c integer ichanl(7) include 'stru.inc' record /MCIDAS_DATDIR_AREA_HDR_T/mc record /GVAR_NAV/mc_nav c there is lots more interesting stuff in the header c not used hear integer ielem(9),jline(9) real west,east,south,north c call the navigation set up routine to initialize common blocks call setupnav(mc_nav,instru,icent,jcent) i0=(mc.west_vis_pixel-1)/mc.elem_res+1 j0=(mc.north_bound-1)/mc.line_res+1 istep=1 jstep=1 ifull=mc.elem_res*istep jfull=mc.line_res*jstep ires=mc.elem_res jres=mc.line_res jmax=j0+mc.num_line-1 imax=i0+mc.num_elem-1 nchanl=mc.num_chan ic=0 l=mc.sndr_filter_map do m=1,30 if(mod(l,2).ne.0) then ic=ic+1 ichanl(ic)=m endif l=l/2 enddo nhead=mc.num_byte_ln_prefix print *,i0,imax,' i lims',j0,jmax,' jlims' print *,' full lims',mc.west_vis_pixel, , mc.west_vis_pixel-1+mc.num_elem*mc.elem_res, , mc.north_bound, , mc.north_bound-1+mc.num_line*mc.line_res, , mc.elem_res,mc.line_res print *,' num_elem,num_line ',mc.num_elem,mc.num_line i1=i0 i2=i0+mc.num_elem-1 j1=j0 j2=j0-1+mc.num_line call pixtoll(xlon,ylat,icent,jcent) return end subroutine preftran(pref,igood) include 'stru.inc' c structure /ISC_LINE_PREFIX/ c integer *2 linesize ! /* 16+nwide*num_chan+64 */ c integer *2 line_number ! /* scan line number full res units*/ c integer *2 west ! /* west edge in vis pixel units */ c integer *2 nwide ! /* number of pixels in one channel */ c integer *2 chan_id ! /* channel id (100+num_chan) */ c integer *2 xave ! /* visible average interval in x */ c integer *2 num_chan ! /* number of channels */ c integer *2 xstep ! /* step size in full vis pixel units */ c integer *4 val_code ! /* good data code (0=good, other=some bad)*/ record/ISC_LINE_PREFIX/pref if(pref.val_code.ne.0) then print *,' pref.val_code ',pref.val_code,pref.line_number igood=0 else igood=1 endif return end subroutine pixtoll(xlon,ylat,ix,iy) c (ix=elem,iy=line) to GVAR (xlon,ylat) input in full res coordinates c output in degrees real *8 x,y,elev,scan,lat,lon REAL*8 PI/3.141592653589793D0/ x=ix y=iy CALL COMP_ES( y, x, elev, scan ) CALL LPoint( elev, scan, lat, lon, ierr ) if(lat.ne.999999.) then xlon=(lon/pi)*180. ylat=(lat/pi)*180. else xlon=lon ylat=lat endif return end subroutine lltopix(west,north,ielem,jline) c (lat,lon) to GVAR (ielem,jline) output in full res coordinates real *8 latr,lonr,elev,scan,line,pixel real west,north REAL*8 PI/3.141592653589793D0/ LatR = north * ( PI / 180.0D0 ) LonR = west * ( PI / 180.0D0 ) CALL GPoint( LatR, LonR, elev, scan, ierr ) IF ( ierr.ne.0 ) THEN ielem=0 jline=0 ELSE CALL COMP_LP(elev,scan,line,pixel) ielem=pixel jline=line ENDIF return end SUBROUTINE SETUPNAV(NAVstr,instru,icent,jcent) c set up the navigation constant common blocks include 'stru.inc' INTEGER ierr REAL*8 rlat, rlon REAL*8 lat, lon REAL*8 LatR, LonR REAL*8 x, y, elev, scan, line, pixel REAL*8 TU, T, PI/3.141592653589793D0/ REAL*8 TIME50 RECORD /GVAR_NAV/ NAVstr c WRITE(6,*) ' Testing NAVstr ' c WRITE(6,1000) NAVstr.gvar1 c WRITE(6,1000) NAVstr.gvar2 c WRITE(6,1000) NAVstr.gvar3 c WRITE(6,1000) NAVstr.gvar4 c 1000 FORMAT(T2,' GVARn >',A4) TU = TIME50(NAVstr.epoch_time) T = TU + ( ( NAVstr.start_time ) * 1.0D-2 ) WRITE(6,*) ' Epoch Time >',TU, T CALL LMODEL( T, TU, NAVstr, rlat, rlon ) WRITE(6,*) ' Subsat latitiude >',rlat * ( 180.0D0 / PI ) WRITE(6,*) ' Subsat longitude >',rlon * ( 180.0D0 / PI ) x4=rlon*180./pi y4=rlat*180./pi call lltopix(x4,y4,icent,jcent) print *,' center elem,line',icent,jcent,' lat lon',x4,y4 y = 4100.0D0 x = 13389.0D0 CALL COMP_ES( y, x, elev, scan ) print *, 'intr >', NAVstr.instr,' elev,scan',elev,scan,ierr CALL LPoint( elev, scan, lat, lon, ierr ) WRITE(6,2000) x, y, lat*(180.0D0/PI), lon*(180.0D0/PI),ierr 2000 FORMAT(T4,'Computed latitude and longitude:',/ > T5,'Satellite line >',F10.3,/ > T5,'Satellite element >',F10.3,/ > T5,'Latitude >',F13.5,/ > T5,'Longitude >',F13.5,' error ',i3) C lat = 40.0D0 lon = -104.0D0 LatR = lat * ( PI / 180.0D0 ) LonR = lon * ( PI / 180.0D0 ) CALL GPoint( LatR, LonR, elev, scan, ierr ) print *, 'intr >', NAVstr.instr,' elev,scan',elev,scan,ierr IF ( ierr.eq.1) THEN WRITE(6,*) ' Point off earth!!!!' ELSE CALL COMP_LP( elev, scan, line, pixel) ENDIF C WRITE(6,3000) lat, lon, line, pixel 3000 FORMAT(T4,'Computed satellite line and scan:',/ > T5,'Latitude >',F10.5,/ > T5,'Longitude >',F10.5,/ > T5,'Satellite line >',F13.3,/ > T5,'Satellite scan >',F13.3) RETURN END C*********************************************************************** C*********************************************************************** C** C** INTEGRAL SYSTEMS, INC. C** C*********************************************************************** C** C** PROJECT : OPERATIONS GROUND EQUIPMENT FOR GOES-NEXT C** SYSTEM : EARTH LOCATION USERS GUIDE C** ROUTINE : GPOINT C** SOURCE : F.GPOINT C** LOAD NAME : ANY C** PROGRAMMER: IGOR LEVINE C** C** VER. DATA BY COMMENT C** ---- -------- --- --------------------------------------------- C** A 12/10/87 IL INITIAL CREATION C** A 06/10/88 IL REPLACED ASIN WITH ATAN TO SAVE TIME C** A 06/02/89 IL COORDINATE AXES CHANGED ACCORDING TO C** FORD'S DEFINITION IN SDAIP, DRL 504-01 C** C*********************************************************************** C** C** THIS SUBROUTINE CONVERTS GEOGRAPHIC LATITUDE AND LONGITUDE C** TO THE RELATED ELEVATION AND SCAN ANGLES. C** C*********************************************************************** C** C** CALLED BY : ANY C** COMMONS MODIFIED: NONE C** INPUTS : NONE C** OUTPUTS : NONE C** ROUTINES CALLED : NONE C** C*********************************************************************** C*********************************************************************** SUBROUTINE GPOINT(RLAT,RLON,ALF,GAM,IERR) C C CALLING PARAMETERS C REAL*8 RLAT C GEOGRAPHIC LATITUDE IN RADIANS (INPUT) REAL*8 RLON C GEOGRAPHIC LONGITUDE IN RADIANS (INPUT) REAL*8 ALF C ELEVATION ANGLE IN RADIANS (OUTPUT) REAL*8 GAM C SCAN ANGLE IN RADIANS (OUTPUT) INTEGER IERR C OUTPUT STATUS; 0 - SUCCESSFUL COMPLETION, C 1 - POINT WITH GIVEN LAT/LON IS INVISIBLE C C LOCAL VARIABLES C REAL*8 F(3) C POINTING VECTOR IN EARTH CENTERED COORDINATES REAL*8 FT(3) C POINTING VECTOR IN INSTRUMENT COORDINATES REAL*8 U(3) C COORDINATES OF THE EARTH POINT (KM) REAL*8 SING,SLAT,W1,W2 C WORK SPACE C C INCLUDE FILES C REAL*8 PI PARAMETER (PI=3.141592653589793D0) REAL*8 DEG PARAMETER (DEG=180.D0/PI) REAL*8 RAD PARAMETER (RAD=PI/180.D0) C DEGREES TO RADIANS CONVERSION PI/180 REAL*8 NOMORB PARAMETER (NOMORB=42164.365D0) C NOMINAL RADIAL DISTANCE OF SATELLITE (km) REAL*8 AE PARAMETER (AE=6378.137D0) C EARTH EQUATORIAL RADIUS (km) REAL*8 FER PARAMETER (FER=1.D0-(6356.7533D0/AE)) C EARTH FLATTENING COEFFICIENT = 1-(BE/AE) REAL*4 AEBE2 PARAMETER (AEBE2=1.D0/(1.D0-FER)**2) REAL*4 AEBE3 PARAMETER (AEBE3=AEBE2-1.) REAL*4 AEBE4 PARAMETER (AEBE4=(1.D0-FER)**4-1.) REAL*8 XS(3) C NORMALIZED S/C POSITION IN ECEF COORDINATES REAL*8 BT(3,3) C ECEF TO INSTRUMENT COORDINATES TRANSFORMATION REAL*8 Q3 C USED IN SUBROUTINE LPOINT REAL*8 PITCH,ROLL,YAW C PITCH,ROLL,YAW ANGLES OF INSTRUMENT (RAD) REAL*8 PMA,RMA C PITCH,ROLL MISALIGNMENTS OF INSTRUMENT (RAD) COMMON /ELCOMM/ XS,BT,Q3,PITCH,ROLL,YAW,PMA,RMA C*********************************************************************** C C COMPUTES SINUS OF GEOGRAPHIC (GEODETIC) LATITUDE C SING=DSIN(RLAT) W1=AEBE4*SING*SING C C SINUS OF THE GEOCENTRIC LATITUDE C SLAT=((0.375D0*W1-0.5D0)*W1+1.0D0)*SING/AEBE2 C C COMPUTES LOCAL EARTH RADIUS AT SPECIFIED POINT C W2=SLAT*SLAT W1=AEBE3*W2 W1=(0.375D0*W1-0.5D0)*W1+1.D0 C C COMPUTES CARTESIAN COORDINATES OF THE POINT C U(3)=SLAT*W1 W2=W1*DSQRT(1.0D0-W2) U(1)=W2*DCOS(RLON) U(2)=W2*DSIN(RLON) C C POINTING VECTOR FROM SATELLITE TO THE EARTH POINT C F(1)=U(1)-XS(1) F(2)=U(2)-XS(2) F(3)=U(3)-XS(3) W2=U(1)*SNGL(F(1))+U(2)*SNGL(F(2))+ 1 U(3)*SNGL(F(3))*AEBE2 C C VERIFIES VISIBILITY OF THE POINT C IF (W2.GT.0.0D0) THEN C INVISIBLE POINT ON THE EARTH IERR=1 ALF=99999.0D0 GAM=99999.0D0 RETURN END IF C C CONVERTS POINTING VECTOR TO INSTRUMENT COORDINATES C FT(1)=BT(1,1)*F(1)+BT(2,1)*F(2)+BT(3,1)*F(3) FT(2)=BT(1,2)*F(1)+BT(2,2)*F(2)+BT(3,2)*F(3) FT(3)=BT(1,3)*F(1)+BT(2,3)*F(2)+BT(3,3)*F(3) C C CONVERTS POINTING VECTOR TO SCAN AND ELEVATION ANGLES AND C CORRECTS FOR THE ROLL AND PITCH MISALIGNMENTS C GAM=ATAN(FT(1)/SQRT(FT(2)**2+FT(3)**2)) ALF=-DATAN(FT(2)/FT(3)) W1=DSIN(ALF) W2=DCOS(ALF) ALF=ALF+RMA*(1.0D0-W2)+PMA*W1*(1.0D0+DTAN(GAM)) GAM=GAM-RMA*W1 IERR=0 RETURN END *********************************************************************** C*********************************************************************** C** C** INTEGRAL SYSTEMS, INC. C** C*********************************************************************** C** C** PROJECT : OPERATIONS GROUND EQUIPMENT FOR GOES-NEXT C** SYSTEM : EARTH LOCATION USERS GUIDE C** ROUTINE : LPOINT C** SOURCE : F.LPOINT C** LOAD NAME : ANY C** PROGRAMMER: IGOR LEVINE C** C** VER. DATA BY COMMENT C** ---- -------- --- --------------------------------------------- C** A 01/09/89 IL INITIAL CREATION C** A 06/02/89 IL COORDINATE AXES CHANGED ACCORDING TO C** FORD'S DEFINITION IN SDAIP, DRL504-01 C** C*********************************************************************** C** C** THIS SUBR CONVERTS THE INSTRUMENT ELEVATION AND SCAN C** ANGLES TO THE RELATED GEOGRAPHIC LATITUDE AND LONGITUDE. C** C*********************************************************************** C** C** CALLED BY : ANY C** COMMONS MODIFIED: NONE C** INPUTS : NONE C** OUTPUTS : NONE C** ROUTINES CALLED : NONE C** C*********************************************************************** C*********************************************************************** SUBROUTINE LPOINT(ALPHA,ZETA,RLAT,RLON,IERR) C C CALLING PARAMETERS C REAL*8 ALPHA C ELEVATION ANGLE (RAD) REAL*8 ZETA C SCAN ANGLE (RAD) REAL*8 RLAT C LATITUDE IN RADIANS (OUTPUT) REAL*8 RLON C LONGITUDE IN RADIANS (OUTPUT) INTEGER IERR C OUTPUT STATUS; 0 - POINT ON THE EARTH C FOUND, 1 - INSTRUMENT POINTS OFF EARTH C C LOCAL VARIABLES C REAL*8 G1(3) C POINTING VECTOR IN EARTH CENTERED COORDINATES REAL*8 H C SLANT DISTANCE TO THE EARTH POINT (KM) REAL*8 Q1,Q2,D C WORK SPACE REAL*8 G(3) C POINTING VECTOR IN INSTRUMENT COORDINATES REAL*8 U(3) C COORDINATES OF THE EARTH POINT (KM) REAL*8 SA,CA,DA,DZ,D1,CZ C WORK SPACE C C INCLUDE FILES C REAL*8 PI PARAMETER (PI=3.141592653589793D0) REAL*8 DEG PARAMETER (DEG=180.D0/PI) REAL*8 RAD PARAMETER (RAD=PI/180.D0) C DEGREES TO RADIANS CONVERSION PI/180 REAL*8 NOMORB PARAMETER (NOMORB=42164.365D0) C NOMINAL RADIAL DISTANCE OF SATELLITE (km) REAL*8 AE PARAMETER (AE=6378.137D0) C EARTH EQUATORIAL RADIUS (km) REAL*8 FER PARAMETER (FER=1.D0-(6356.7533D0/AE)) C EARTH FLATTENING COEFFICIENT = 1-(BE/AE) REAL*4 AEBE2 PARAMETER (AEBE2=1.D0/(1.D0-FER)**2) REAL*4 AEBE3 PARAMETER (AEBE3=AEBE2-1.) REAL*4 AEBE4 PARAMETER (AEBE4=(1.D0-FER)**4-1.) REAL*8 XS(3) C NORMALIZED S/C POSITION IN ECEF COORDINATES REAL*8 BT(3,3) C ECEF TO INSTRUMENT COORDINATES TRANSFORMATION REAL*8 Q3 C USED IN SUBROUTINE LPOINT REAL*8 PITCH,ROLL,YAW C PITCH,ROLL,YAW ANGLES OF INSTRUMENT (RAD) REAL*8 PMA,RMA C PITCH,ROLL MISALIGNMENTS OF INSTRUMENT (RAD) COMMON /ELCOMM/ XS,BT,Q3,PITCH,ROLL,YAW,PMA,RMA C*********************************************************************** IERR=1 C C COMPUTES TRIGONOMETRIC FUNCTIONS OF THE SCAN AND ELEVATION C ANGLES CORRECTED FOR THE ROLL AND PITCH MISALIGNMENTS C CA=DCOS(ALPHA) SA=DSIN(ALPHA) DA=ALPHA-PMA*SA*(1.0D0+DTAN(ZETA))-RMA*(1.0D0-CA) DZ=ZETA+RMA*SA C CORRECTED SCAN ANGLE CZ=DCOS(DZ) C C COMPUTES POINTING VECTOR IN INSTRUMENT COORDINATES C G(1)=DSIN(DZ) G(2)=-CZ*DSIN(DA) G(3)=CZ*DCOS(DA) C C TRANSFORMS THE POINTING VECTOR TO EARTH FIXED COORDINATES C G1(1)=BT(1,1)*G(1)+BT(1,2)*G(2)+BT(1,3)*G(3) G1(2)=BT(2,1)*G(1)+BT(2,2)*G(2)+BT(2,3)*G(3) G1(3)=BT(3,1)*G(1)+BT(3,2)*G(2)+BT(3,3)*G(3) C C COMPUTES COEFFICIENTS AND SOLVES A QUADRATIC EQUATION TO C FIND THE INTERSECT OF THE POINTING VECTOR WITH THE EARTH C SURFACE C Q1=G1(1)**2+G1(2)**2+AEBE2*G1(3)**2 Q2=XS(1)*G1(1)+XS(2)*G1(2)+AEBE2*XS(3)*G1(3) D=Q2*Q2-Q1*Q3 IF (DABS(D).LT.1.D-9) D=0.0D0 C C IF THE DISCIMINANTE OF THE EQUATION, D, IS NEGATIVE, THE C INSTRUMENT POINTS OFF THE EARTH C IF (D.LT.0.0D0) THEN RLAT=999999.0D0 RLON=999999.0D0 RETURN END IF D=DSQRT(D) C C SLANT DISTANCE FROM THE SATELLITE TO THE EARTH POINT C H=-(Q2+D)/Q1 C C CARTESIAN COORDINATES OF THE EARTH POINT C U(1)=XS(1)+H*G1(1) U(2)=XS(2)+H*G1(2) U(3)=XS(3)+H*G1(3) C C SINUS OF GEOCENTRIC LATITUDE C D1=U(3)/DSQRT(U(1)**2+U(2)**2+U(3)**2) C C GEOGRAPHIC (GEODETIC) COORDINATES OF THE POINT C RLAT=DATAN(AEBE2*D1/DSQRT(1.0D0-D1*D1)) RLON=DATAN2(U(2),U(1)) IERR=0 RETURN END C======================================================================== C I N S T 2 E C======================================================================== SUBROUTINE INST2E( R, P, Y, A, AT ) C C AUTHOR: KELLY DEAN C C CREATED: October 1994 C C DEVELOPED FOR: CIRA/COLORADO STATE UNIVERSITY C C PURPOSE: C Procedure INST2E accepts the single precision roll, pitch and yaw C angles of an instrument and returns the double precision instrument C to earth coordinates transformation matrix. C C REVISION: 0.0 C C REFERENCES: C OTHER DOCUMENTS C C COMMENTS: C Adapted from Igor Levine program for Integral Systems, Inc. C C ARGUMENTS: C NAME: TYPE: PURPOSE: IN/OUT: C R REAL*8 Roll angle (rad) IN C P REAL*8 Pitch angle (rad) IN C Y REAL*8 Yaw angle (rad) IN C A REAL*8 Spacecraft to ECEF coordinates OUT C transformation matrix C AT REAL*8 Instrument to ECEF coordinates OUT C transformation matrix C C VARIABLES: C NAME: PURPOSE: C **************** INTEGER ***************** C I Indices C J Indices C **************** REAL*8 ***************** C RPY Instrument to body coordinates transformation matrix C C ------------------------------------------------------- C -------------- ACTUAL CODE STARTS HERE -------------- C ------------------------------------------------------- C C CONSTANT DECLARATION SECTION: C C VARIABLE DECLARATION SECTION: REAL*8 A(3,3),AT(3,3),R,RPY(3,3),P,Y INTEGER*4 I,J C C ******--------------------------------------------****** C ******-------- MAIN BODY STARTS HERE -----------****** C ******--------------------------------------------****** C C Compute instrument to body coordinates transformation matrix C by using a small angle approximation of trigonometric function C of the roll, pitch and yaw. C RPY(1,1) = 1.0D0 - 0.5D0 * ( P * P + Y * Y ) RPY(1,2) = -Y RPY(1,3) = P RPY(2,1) = Y + P * R RPY(2,2) = 1.0D0 - 0.5D0 * ( Y * Y + R * R ) RPY(2,3) = -R RPY(3,1) = -P + R * Y RPY(3,2) = R + P * Y RPY(3,3) = 1.0D0 - 0.5D0 * ( P * P + R * R ) C C Multiplication of matrices A and RPY C DO I = 1,3 DO J = 1,3 AT(I,J) = A(I,1)*RPY(1,J)+A(I,2)*RPY(2,J)+A(I,3)*RPY(3,J) ENDDO ENDDO C C RETURN END C====================================================================== C T I M E 5 0 C====================================================================== REAL*8 FUNCTION TIME50(btim) C C AUTHOR: Garrett Campbell and Kelly Dean C C CREATED: October 1994 C C DEVELOPED FOR: CIRA/COLORADO STATE UNIVERSITY C C PURPOSE: C Function TIME50 will take the epoch time from the GVAR NAVstr and C convert it to minutes from January 1, 1950. NOTE - Epoch time in C the NAVstr is not in the same format as other BCD times.C C C REVISION: 0.0 C C COMMENT: C Adapted from FORTRAN code written by INTEGRAL SYSTEMS, INC. C and supplied by NOAA/NESDIS. C C ARGUMENTS: C NAME: TYPE: PURPOSE: IN/OUT: C btim BYTE Binary coded data (BCD) time IN C C FUNCTIONS: C NAME: TYPE: PURPOSE: LIBRARY: C MOD INTEGER Returns a remainder Intrinsic C C NAME: PURPOSE: C **************** INTEGER ***************** C day_100 Part of day extracted from BCD C day_10 Part of day extracted from BCD C day_1 Part of day extracted from BCD C hour_10 Part of hour extracted from BCD C hour_1 Part of hour extracted from BCD C min_10 Part of minute extracted from BCD C min_1 Part of minute extracted from BCD C NY YEAR C ND DAY OF YEAR C NH HOUR C NM MINUTE C ibt C J Loop control variable C year_1000 Part of year extracted from BCD C year_100 Part of year extracted from BCD C year_10 Part of year extracted from BCD C year_1 Part of year extracted from BCD C **************** REAL*8 ***************** C S SECONDS - Double precision C C ------------------------------------------------------- C -------------- ACTUAL CODE STARTS HERE -------------- C ------------------------------------------------------- C C VARIABLE DECLARATION SECTION: C byte btim(8),bt INTEGER NY,ND,NH,NM,J INTEGER year_1000, year_100, year_10, year_1 INTEGER day_100, day_10, day_1, hour_10, hour_1, min_10, min_1 INTEGER sec_10, sec_1, msec_10, msec_1 integer ibt REAL*8 S C C Equivalence DECLARATION SECTION: C equivalence (bt,ibt) C C ******--------------------------------------------****** C ******-------- MAIN BODY STARTS HERE -----------****** C ******--------------------------------------------****** C C Extract the Binary Coded Time into separate year, Julian day, hour C minutes, seconds. C bt = btim(1) day_1 = ibt/16 hour_10 = mod(ibt,16) bt = btim(2) day_100 = mod(ibt/16,8) day_10 = mod(ibt,16) flywheel = mod(ibt,2) bt = btim(3) year_10 = ibt/16 year_1 = mod(ibt,16) bt = btim(4) year_1000 = ibt/16 year_100 = mod(ibt,16) bt = btim(5) msec_10 = ibt/16 msec_1 = mod(ibt,16) bt = btim(6) sec_1 = ibt/16 msec_100 = mod(ibt,16) bt = btim(7) min_1 = ibt/16 sec_10 = mod(ibt,16) bt = btim(8) hour_1 = ibt/16 min_10 = mod(ibt,16) C C Make the year, Julian day, hour, minute, and seconds. C ny = year_1000 * 1000 + year_100 * 100 + year_10 * 10 + year_1 nd = day_100 * 100 + day_10 * 10 + day_1 nh = hour_10 * 10 + hour_1 nm = min_10 * 10 + min_1 s = sec_10 * 10.0D0 + sec_1 + > msec_100 * 0.1D0 + msec_10 * 0.01D0 + msec_1 * 0.001D0 C C HERE WE CONVERT INTEGER YEAR AND DAY OF YEAR TO NUMBER OF C DAYS FROM 0 HOUR UT, 1950 JAN. 1.0 C THIS CONVERTION IS BASED ON AN ALGORITHM BY FLIEGEL AND VAN C FLANDERN, COMM. OF ACM, VOL.11, NO. 10, OCT. 1968 (P.657) C j = nd + 1461 * (ny + 4799) / 4 - 3 * > ( ( ny + 4899 ) / 100 ) / 4 - 2465022 C C Compute time in minutes from January 1.0, 1950 as double precision. C TIME50 = j * 1440.0D0 + nh * 60.0D0 + nm + s / 60.0D0 C C RETURN END C======================================================================= C G A T T C======================================================================= REAL*8 FUNCTION GATT( IMGR_REP, WA, TE) C C AUTHOR: KELLY DEAN C C CREATED: October 1994 C C DEVELOPED FOR: CIRA/COLORADO STATE UNIVERSITY C C PURPOSE: C This function computes an attitude/misalignment angle from C a given subset of the O&A parameters. C C REVISION: 0.0 C C COMMENT: C Adapted from FORTRAN code written by INTEGRAL SYSTEMS, INC. C and supplied by NOAA/NESDIS. C C ARGUMENTS: C NAME: TYPE: PURPOSE: IN/OUT: C IMGR_REP STRUCTURE C TE REAL*8 Input exponential time IN C delay from epoch (minutes) C WA REAL*8 Input solar orbit angle (rad) IN C C FUNCTIONS: C NAME: TYPE: PURPOSE: LIBRARY: C DCOS REAL*8 Cosine ( Double precision ) INTRINSIC C C VARIABLES: C NAME: PURPOSE: C **************** INTEGER ***************** C m Temporary variable for order of monomial sinusoids C C ------------------------------------------------------- C -------------- ACTUAL CODE STARTS HERE -------------- C ------------------------------------------------------- C C INCLUDE DECLARATION SECTION: C include 'stru.inc' C C VARIABLE DECLARATION SECTION: C INTEGER m REAL*8 TE, WA record /IMGR_RP/ IMGR_REP C C ******--------------------------------------------****** C ******-------- MAIN BODY STARTS HERE -----------****** C ******--------------------------------------------****** C gatt = IMGR_REP.mean_att_ang_const * 1.0D-7 C C Computes the exponential term. C IF ( TE .GE. 0.0D0 ) THEN gatt = gatt + (IMGR_REP.exp_mag * 1.0D-7 ) * > EXP(-te / ( IMGR_REP.exp_time_const * 1.0D-2 )) ENDIF C C Calculation of sinusoids. C DO l = 1, IMGR_REP.num_sinu_per_angle gatt = gatt + ( IMGR_REP.sinusoid(l).mag_sinu * 1.0D-7 ) * > DCOS(wa * l + > ( IMGR_REP.sinusoid(l).phase_ang_sinu * 1.0D-7 ) ) ENDDO C C Computes monomial sinusoids. C DO l = 1, IMGR_REP.num_mono_sinu m = IMGR_REP.monomial(l).order_mono_sinu gatt = gatt + (IMGR_REP.monomial(l).mag_mono_sinu * 1.0D-7) * > (wa - ( IMGR_REP.monomial(l).ang_from_epoch * 1.0D-7) )**m * > DCOS( IMGR_REP.monomial(l).order_appl_sinu * wa + > ( IMGR_REP.monomial(l).phase_ang_sinu * 1.0D-7 ) ) ENDDO C C RETURN END C======================================================================= C L M O D E L C======================================================================= SUBROUTINE LMODEL( T, TU, NVS, RLAT, RLON ) C C AUTHOR: KELLY DEAN C C CREATED: October 1994 C C DEVELOPED FOR: CIRA/COLORADO STATE UNIVERSITY C C PURPOSE: C Procedure LModel accepts an input time and a set of O&A parameters C and computes position of the satellite, the attitude angles and C attitudes misalignment and the instrument to earth fixed coordinates C transformation matrix. C C This procedure computes the position of the satellite and the C attitude of the imager or sounder. The calculations are based C on the Oats orbit and attitude model represented by the O&A C parameter set in NVS. C C REVISION: 0.0 C C REFERENCES: C Part of this code was adapted from Igor Levine work C for Integal System, Inc. C C ARGUMENTS: C NAME: TYPE: PURPOSE: IN/OUT: C T REAL*8 Input time from Jan 1, 1950 (Minutes) IN C TU REAL*8 Epoch time from Jan 1, 1950 (Minutes) IN C RLAT REAL*8 Subsatellite Geodetic latitude (rad) OUT C RLON REAL*8 Subsatellite Geodetic Longitude (rad) OUT C C SUB: C NAME: PURPOSE: LIBRARY: C INST2E Computes instrument to earth coordinates GVARnav C C FUN: C NAME: TYPE: PURPOSE: LIBRARY: C DATAN REAL*8 Arc tangent (double precision) Intrinsic C DATAN2 REAL*8 Arc Tangent (double precision) Intrinsic C DCOS REAL*8 Cosine (double precision) Intrinsic C DSIN REAL*8 Sine (double precision) Intrinsic C DTAN REAL*8 tagent (double precision) Intrinsic C GATT REAL*8 Compute attitude and misalignment angle GVARnav C C VARIABLES: C NAME: PURPOSE: C **************** REAL*8 ***************** C XS NORMALIZED S/C POSITION IN ECEF COORDINATES C BT ECEF TO INSTRUMENT COORDINATES TRANSFORMATION C Q3 USED IN SUBR LPOINT C PITCH PITCH ANGLES OF INSTRUMENT (RAD) C ROLL ROLL ANGLES OF INSTRUMENT (RAD) C YAW YAW ANGLES OF INSTRUMENT (RAD) C PMA PITCH MISALIGNMENTS OF INSTRUMENT (RAD) C RMA ROLL MISALIGNMENTS OF INSTRUMENT (RAD) C R Normalized satellite distance (km) C TS Time from EPOCH (minutes) C B Spacecraft to earth fixed coordinates transmation matrix C TE Exponential time delay from EPOCH (minutes) C PHI Subsatellite geocentric latitude (rad) C DR Radial distance from the nominal (km) C PSI Orbital yaw (rad) C LAM IMC longitude (rad) C U Argument of latitude (rad) C SU DSIN(U) C CU DCOS(U) C SI Sine of the orbit inclination C CI Cosine of the orbit inclination C SLAT Sine of geocentric latitude C ASC Longitude of the ascending node (rad) C SA Sine of ASC C CA Cosine of ASC C SYAW Sine of the orbit yaw C WA Solar orbit angle (rad) C W Orbit angle (rad) C SW DSIN(W) C CW DCOS(W) C S2W DSIN(2*W) C C2W DCOS(2*W) C SW1 DSIN(0.927*W) C CW1 DCOS(0.927*W) C SW3 Sine of 1.9268*W C CW3 Cosine of 1.9268*W C DLAT Change in sine of geocentric latitude C DYAW Change in sine of orbit yaw C A1 Work area C A2 Work area C XS S/C position in ECEF coordinates C C COMMON BLOCKS: C NAME: CONTENTS: C ELCOMM Instrument position and attitude variables and C transformation matrix C C ------------------------------------------------------- C -------------- ACTUAL CODE STARTS HERE -------------- C ------------------------------------------------------- C C CONSTANT DECLARATION SECTION: C include 'stru.inc' C C VARIABLE DECLARATION SECTION: C INTEGER IMCstatus REAL*8 T, TU REAL*8 REC(336) REAL*8 RLAT, RLON, R, TS, TE, PHI, DR, PSI, LAM, U, SU, CU REAL*8 SI, CI, SLAT, ASC, SA, CA, SYAW, WA, W, SW, CW, S2W, C2W REAL*8 SW1, CW1, SW3, CW3, DLAT, DYAW, A1, A2 REAL*8 B(3,3), BT(3,3), XS(3) REAL*8 Q3, PITCH, ROLL, YAW, PMA, RMA RECORD /GVAR_NAV/ NVS C C FUNCTION DECLARATION SECTION: C REAL*8 DATAN,DATAN2,DCOS,DSIN,DTAN,GATT C C COMMON BLOCKS: C COMMON /ELCOMM/ xs, bt, q3, pitch, roll, yaw, pma, rma C C INITIALIZATIONS: (Description mathematical and earth-related constants) C PI = 3.141592653589793D0 DEG = 180D0 / PI RAD = PI / 180D0 ! Degrees to radians conversion (PI/180) NOMORB = 42164.365D0 ! Nominal radial distance of satellite (km) AE = 6378.137D0 ! Earth equatorial radius (km) FER = 1.0D0 - ( 6356.7533D0 / AE ) ! Earth flattening coefficient AEBE2 = 1.0D0 / (1.0D0 - FER )**2 AEBE3 = AEBE2 - 1. AEBE4 = ( 1.0D0 - FER )**4-1. C C ******--------------------------------------------****** C ******-------- MAIN BODY STARTS HERE -----------****** C ******--------------------------------------------****** C C Determine the IMC status C IMCstatus=NVS.IMC_status c initialize the comp_es and comp_lp programs call comp_es1(NVS) C C Assign referenec values to the subsatellite longitude and C latitude, the radial distance and the orbit yaw. C LAM = NVS.ref_long * 1.0D-7 DR = NVS.ref_rad_dist PHI = NVS.ref_lat PSI = NVS.ref_orb_yaw C C Assign reference values to the attitudes and misalignments C ROLL = NVS.ref_att_roll PITCH = NVS.ref_att_pitch YAW = NVS.ref_att_yaw RMA = 0.0D0 PMA = 0.0D0 C C IF IMC_active is OFF, compute changes in the satellite orbit C IF ( IMCstatus .EQ. 0 ) THEN print *,' imc is off ' C C Compute time since EPOCH (minutes) C TS = T - TU C C Compute orbite angle and the related trigonometric functions. C earth rotational rate (.729115E-4 rad/sec). C W = 0.729115e-4 * 60.0D0 * TS SW = DSIN(W) CW = DCOS(W) SW1 = DSIN(0.927D0*W) CW1 = DCOS(0.927D0*W) S2W = DSIN(2.0D0*W) C2W = DCOS(2.0D0*W) SW3 = DSIN(1.9268D0*W) CW3 = DCOS(1.9268D0*W) C C Computes change in the IMC_active longitude from the reference. C LAM = LAM + ( NVS.ref_long_change(1) * 1.0D-7 ) + > ( ( NVS.ref_long_change(2) * 1.0D-7 ) + > ( NVS.ref_long_change(3) * 1.0D-7 ) * W ) * W + > ( NVS.ref_long_change(10) * 1.0D-7 ) * SW1 + > ( NVS.ref_long_change(11) * 1.0D-7 ) * CW1 + > ( ( NVS.ref_long_change(4) * 1.0D-7 ) * SW + > ( NVS.ref_long_change(5) * 1.0D-7 ) * CW + > ( NVS.ref_long_change(6) * 1.0D-7 ) * S2W + > ( NVS.ref_long_change(7) * 1.0D-7 ) * C2W + > ( NVS.ref_long_change(8) * 1.0D-7 ) * SW3 + > ( NVS.ref_long_change(9) * 1.0D-7 ) * CW3 + > W * ( ( NVS.ref_long_change(12) * 1.0D-7 ) * SW + > ( NVS.ref_long_change(13) * 1.0D-7 ) * CW ) ) * 2.0D0 C C Computes change in radial distance from the reference (km) C DR = DR + ( NVS.ref_rad_dist_change(1) * 1.0D-7 ) + > ( NVS.ref_rad_dist_change(2) * 1.0D-7 ) * CW + > ( NVS.ref_rad_dist_change(3) * 1.0D-7 ) * SW + > ( NVS.ref_rad_dist_change(4) * 1.0D-7 ) * C2W + > ( NVS.ref_rad_dist_change(5) * 1.0D-7 ) * S2W + > ( NVS.ref_rad_dist_change(6) * 1.0D-7 ) * CW3 + > ( NVS.ref_rad_dist_change(7) * 1.0D-7 ) * SW3 + > ( NVS.ref_rad_dist_change(8) * 1.0D-7 ) * CW1 + > ( NVS.ref_rad_dist_change(9) * 1.0D-7 ) * SW1 + > W * ( ( NVS.ref_rad_dist_change(10) * 1.0D-7 ) * CW + > ( NVS.ref_rad_dist_change(11) * 1.0D-7 ) * SW ) C C Computes the sine of the change in the geocentric latitude. C DLAT = ( NVS.sine_lat(1) * 1.0D-7 ) + > ( NVS.sine_lat(2) * 1.0D-7 ) * CW + > ( NVS.sine_lat(3) * 1.0D-7 ) * SW + > ( NVS.sine_lat(4) * 1.0D-7 ) * C2W + > ( NVS.sine_lat(5) * 1.0D-7 ) * S2W + > W * ( ( NVS.sine_lat(6) * 1.0D-7 ) * CW + > ( NVS.sine_lat(7) * 1.0D-7 ) * SW ) + > ( NVS.sine_lat(8) * 1.0D-7 ) * CW1 + > ( NVS.sine_lat(9) * 1.0D-7 ) * SW1 C C Computes geocentric latitude by using an expansion for arcsine. C PHI = PHI + DLAT * ( 1.0D0 + DLAT * DLAT / 6.0D0 ) C C Computes sine of the change in the orbit yaw. C DYAW = ( NVS.sine_orb_yaw(1) * 1.0D-7 ) + > ( NVS.sine_orb_yaw(2) * 1.0D-7 ) * SW + > ( NVS.sine_orb_yaw(3) * 1.0D-7 ) * CW + > ( NVS.sine_orb_yaw(4) * 1.0D-7 ) * S2W + > ( NVS.sine_orb_yaw(5) * 1.0D-7 ) * C2W + > W * ( ( NVS.sine_orb_yaw(6) * 1.0D-7 ) * SW + > ( NVS.sine_orb_yaw(7) * 1.0D-7 ) * CW ) + > ( NVS.sine_orb_yaw(8) * 1.0D-7 ) * SW1 + > ( NVS.sine_orb_yaw(9) * 1.0D-7 ) * CW1 C C Computes the orbit yaw by using an expansion for arcsine. C PSI = PSI + DYAW * ( 1.0D0 + DYAW * DYAW / 6.0D0 ) ELSE WRITE(6,*) ' IMC is turned on .......... >',IMCstatus ENDIF C C Conversion of the IMC_active longitude and orbit yaw to the subsatellite C longitude and the orbit inclination (REF: GOES-PCC-TM-2473). Inputs C required for earth location and gridding C SLAT = DSIN(PHI) SYAW = DSIN(PSI) SI = SLAT**2 + SYAW**2 CI = DSQRT(1.0D0 - SI ) SI = DSQRT(SI) IF ( SYAW .NE. 0.0D0 ) THEN U = DATAN2(SLAT,SYAW) ELSE IF (SLAT .GT. 0.0D0 ) THEN U = 1.570796D0 ELSE IF (SLAT .LT. 0.0D0 ) THEN U = 4.712389D0 ELSE U = LAM ENDIF C SU = DSIN(U) CU = DCOS(U) C C Computes longitude of the ascending node. C ASC = LAM - U SA = DSIN(ASC) CA = DCOS(ASC) C C Computes the subsatellite geographic latitude (rad) C RLAT = DATAN(AEBE2*DTAN(PHI)) C C Computes the subsatellite geographic longitude (rad) C RLON = ASC + DATAN2(CI*SU,CU) C C Computes the spacecraft to earth fixed coordinates transformation matrix. C C (VECTOR IN ECEF COORDINATES) = B * (VECTOR IN S/C COORDINATES) C B(1,2) = -SA * SI B(2,2) = CA * SI B(3,2) = -CI B(1,3) = -CA * CU + SA * SU * CI B(2,3) = -SA * CU - CA * SU * CI B(3,3) = -SLAT B(1,1) = -CA * SU - SA * CU * CI B(2,1) = -SA * SU + CA * CU * CI B(3,1) = CU * SI C C Computes the normalized spacecraft position vector in earth fixed C coordinates - XS. C R = (NOMORB + DR) / AE XS(1) = -B(1,3) * R XS(2) = -B(2,3) * R XS(3) = -B(3,3) * R C C Precomputes Q3 ( Used in LPoint ). C Q3 = XS(1)**2 + XS(2)**2 + AEBE2 * XS(3)**2 - 1.0D0 C C Computes the attitudes and misalignments IF IMC_active is OFF C IF ( IMCstatus .EQ. 0 ) THEN C C Computes the solar orbit angle C WA = ( NVS.solar_rate * 1.0D-7 ) * TS C C Computes the difference between current time, TS, and the C exponential time. Note that both times are since EPOCH. C TE = TS - ( NVS.exp_start_time * 1.0D-7 ) C C Computes ROLL + ROLL Misalignment C ROLL = ROLL + GATT(NVS.roll_att,WA,TE) C C Computes Pitch + Pitch Misalignment C PITCH = PITCH + GATT(NVS.pitch_att,WA,TE) C C Computes YAW C YAW = YAW + GATT(NVS.yaw_att,WA,TE) C C Computes roll misalignment C RMA = GATT(NVS.roll_misalgn,WA,TE) C C Computes pitch misalignment C PMA = GATT(NVS.pitch_misalgn,WA,TE) C C Apply the Earth Sensor compensation IF needed. C IF ( TS .GE. ( NVS.start_time * 1.0D-2 ) ) THEN ROLL = ROLL + NVS.IMC_corr_roll * 1.0D-7 PITCH = PITCH + NVS.IMC_corr_pitch * 1.0D-7 YAW = YAW + NVS.IMC_corr_yaw * 1.0D-7 ENDIF ELSE WRITE(6,*) ' IMC is turned on .......... >',IMCstatus ENDIF C C Computes the instrument to earth fixed coordinates transformation C matrix - BT C CALL INST2E( ROLL, PITCH, YAW, B, BT) C C RETURN END subroutine COMP_LP( ELEV, SCAN, RL, RP ) c simplified version (must call comp_es1 once before this works. common/nvspar/inst,smax(2),spx(2),emax(2),elv(2) real*8 smax,spx,emax,elv real*8 ELEV,SCAN,RL,RP RL = ( EMAX(inst) - ELEV ) / ELV(inst) C Compute fractional pixel number. RP = ( SMAX(inst) + SCAN ) / SPX(inst) + 1.0D0 return end subroutine COMP_ES(line,pixel,elev,scan) c simplified version (must call comp_es1 once before this works common/nvspar/inst,smax(2),spx(2),emax(2),elv(2) real*8 smax,spx,emax,elv real*8 line,pixel,elev,scan elev=emax(inst)-line*elv(inst) scan=(pixel-1.)*spx(inst)-smax(inst) return end C======================================================================= C C O M P _ E S C======================================================================= SUBROUTINE COMP_ES1( NVS ) C C AUTHOR: KELLY DEAN C C CREATED: January 1995 C C DEVELOPED FOR: CIRA/COLORADO STATE UNIVERSITY C C PURPOSE: C Compute the elevation and scan angles related to the C satellite line and pixel numbers. C C REVISION: 1.0 C C COMMENT: C Adapted from FORTRAN code written by INTEGRAL SYSTEMS, INC. C and supplied by NOAA/NESDIS. C C ARGUMENTS: C NAME: TYPE: PURPOSE: IN/OUT: C NVS Structure Navigation information IN C line REAL*8 Satellite line number IN C pixel REAL*8 Satellite pixel number IN C elev REAL*8 Elevation angle (rad) OUT C scan REAL*8 Scan angle (rad) OUT C C CONSTANTS: C NAME: PURPOSE: C **************** REAL*8 ***************** C elvln Elevation angle per detector line (rad) C elvmax Bounds in elevation C scnmax Bounds in scan angle C scnpx Scan angle per pixel (rad) C C ------------------------------------------------------- C -------------- ACTUAL CODE STARTS HERE -------------- C ------------------------------------------------------- C C INCLUDE DECLARATION SECTION: C include 'stru.inc' C C CONSTANT DECLARATION SECTION: C INTEGER incmax(2) /6136,2805/ REAL*8 elvmax(2) / 0.2208960D0, 0.22089375D0/ REAL*8 elvln(2) /28.0D-6, 280.0D-6/ REAL*8 elvinc(2) / 8.0D-6, 17.5D-6/ REAL*8 scnmax(2) / 0.245440D0, 0.2454375D0 / REAL*8 scnpx(2) /16.0D-6, 280.0D-6/ REAL*8 scninc(2) /16.0D-6, 35.0D-6/ C C VARIABLE DECLARATION SECTION: C RECORD /GVAR_NAV/ NVS REAL*8 line, pixel, elev, scan common/nvspar/inst,smax(2),spx(2),emax(2),elv(2) real*8 smax,spx,emax,elv C C ******--------------------------------------------****** C ******-------- MAIN BODY STARTS HERE -----------****** C ******--------------------------------------------****** C IF ( NVS.instr .EQ. 1 ) THEN C Recompute elevation and scan biases based on user inputs of C cycles and increments obtained from GVAR c print *,NVS.instr,NVS.ns_cyl,NVS.ns_inc,NVS.ew_inc, c , NVS.ew_inc,' ns terms',NVS.spare4 inst=nvs.instr print *,elvmax(1),scnmax(1),' data elv,scn ES' if(NVS.ns_cyl.ne.0) elvmax(NVS.instr) = ( NVS.ns_cyl * > incmax(NVS.instr) + > NVS.ns_inc ) * > elvinc(NVS.instr) if(NVS.ew_cyl.ne.0) scnmax(NVS.instr) = ( NVS.ew_cyl * > incmax(NVS.instr) + > NVS.ew_inc ) * > scninc(NVS.instr) C Compute elevation angle (rad) print *,elvmax(1),scnmax(1),' elv,scn ES' c elev = elvmax(NVS.instr) + (4.50 - line) * elvln(NVS.instr) C Compute scan angle (rad) c scan = (pixel - 1.0) * scnpx(NVS.instr) - scnmax(NVS.instr) smax(inst)=scnmax(NVS.instr) spx(inst)=scnpx(NVS.instr) elv(inst)=elvln(NVS.instr) emax(inst)=elvmax(NVS.instr)+4.50*elvln(NVS.instr) ELSE IF( NVS.instr .EQ. 2 ) THEN C Recompute elevation and scan biases based on user inputs of C cycles and increments obtained from GVAR. elvmax(NVS.instr) = ( (9 - NVS.ns_cyl) * > incmax(NVS.instr) - > NVS.ns_inc ) * > elvinc(NVS.instr) scnmax(NVS.instr) = ( NVS.ew_cyl * > incmax(NVS.instr) + > NVS.ew_inc ) * > scninc(NVS.instr) C Compute elevation angle (rad) c elev = elvmax(NVS.instr) + (2.50 - line) * elvln(NVS.instr) C Compute scan angle (rad) c scan = (pixel - 1.0)*scnpx(NVS.instr)-scnmax(NVS.instr) smax(inst)=scnmax(NVS.instr) spx(inst)=scnpx(NVS.instr) elv(inst)=elvln(NVS.instr) emax(inst)=elvmax(NVS.instr)+2.50*elvln(NVS.instr) ELSE C Unknown instrument..... print *,' unknown instrument ',NVS.instr stop c elev = 0.0D0 c scan = 0.0D0 ENDIF C C RETURN END c c stru.inc c SUBROUTINE TPVRLN(IN,BY,NWANT,LFLAGE,NREAD) C SUBSTITUTE YOU OWN CODE TO PROCESS DISK FILES OR TAPE FILES. BYTE BY(NWANT) C READ Bytes C make your own disk IO routines. return end