C Copyright(c) 1999, Space Science and Engineering Center, UW-Madison C Refer to "McIDAS Software Acquisition and Distribution Policies" C in the file mcidas/data/license.txt C *** $Id: smpaddeimg.f,v 1.0 1999/09/28 14:38:32 russd Tst $ *** C ? SMPADDEIMG - sample ADDE image application C ? SMPADDEIMG DIR C ? SMPADDEIMG GET sdataset ddataset C ? Parameters: C ? DIR | read image directories ADDE dataset C ? GET | read and print image data from ADDE dataset; C ? | if ddataset is provided, the data is copied to ddataset C ? sdataset | source dataset C ? ddataset | destination dataset C ? Keywords: C ? DAY=bday eday | beginning and ending day of images C ? TIMe=btime etime | beginning and ending time of image C ? RTIme=btime etime | beginning and ending minutes of image C ? LATlon=lat lon | lat/lon to center image C ? STA= | station to center image C ? Remarks: C ? McIDAS programing sample C ? C ? This program demonstrates reading ADDE image directories and C ? ADDE image data. C ? C ? The DIR option takes a hard coded set of sort conditions and C ? calls MCADIR to open a connection to the image directory server. C ? If directories are returned, then print some of the directory C ? entries. C ? C ? The GET option uses MCASORT to generate sort clauses based C ? on keywords. A connection to the image get server is made with C ? a call to MCAGET. The nav, cal, data, and comment card blocks C ? then read. The first four data values returned by the server C ? are printed. C ? C ? With the GET option, if the destination ddataset is supplied, C ? then the image PUT interface is demonstrated by copying the C ? image from sdataset to ddataset. C ? ---------- subroutine main0 implicit none c --- external functions integer mccmdstr ! character string parameter c --- internal functions integer adde_image_dir integer adde_image_get c --- internal variables character*12 option ! program option string integer status ! function status c **************** Program Body ************** c --- set initial program status to FAILED call MCCODESET( -1 ) c --- fetch the command option status = MCCMDSTR( ' ', 1, ' ', option ) if( status.lt.0 ) return c --- Force the contents of the option string to upper case call MCUPCASE( option ) c --- getting ADDE image directory if (option .eq. 'DIR') then status = adde_image_dir( ) if (status .lt. 0) return endif c --- getting and putting ADDE image if (option .eq. 'GET' .or. option .eq. 'PUT') then status = adde_image_get( ) if (status .lt. 0) return endif c --- set the program status to SUCCESS call mccodeset( 0 ) call sdest ('Done...', 0) return end integer function adde_image_dir( ) implicit none c --- internal constants integer MAXDIRSORTS parameter (MAXDIRSORTS = 5) ! maximum sort clause strings integer MAXCARDS parameter (MAXCARDS = 500) ! maximum num of comment cards integer DIRSIZE parameter (DIRSIZE = 65) ! size of returned dir block ! the directory server always prepends one word ! (the absolute number of the AREA if it is ! an AREA) to the directory. The second ! word is the position of this image in the ! dataset. Words 3-65 are the same as words ! 2-64 of the AREA directory format. c --- external functions character*12 cfg ! real to character integer mcadir ! connect to directory server integer mcadrd ! read directories from server integer mccmdstr ! character string parameter integer mcpcal ! return the valid cal keys integer mcpnav ! return center lat/lon and res c --- internal functions c --- internal variables character*36 dataset ! name of source dataset character*12 cval ! character form of value character*36 selects(MAXDIRSORTS) ! selects clause strings character*12 calkeys(200) ! valid calibration keys character*80 expkeys(200) ! exanded calibration key names integer comment_cards(1000) ! comment cards (should be ! integer array) integer i ! loop counter integer band ! image band integer directory(DIRSIZE) ! image directory block integer error_flag ! error reporting flag integer ncards ! number of comment cards integer nkeys ! number of calibration keys integer nselects ! number of select strings integer status ! return status real lat ! center latitude real lon ! center longitude real latres ! latitude resolution real lonres ! longitude resolution real cplatres ! center latitude resolution real cplonres ! center longitude resolution adde_image_dir = -1 c --- set select conditions selects(1) = 'SS 70 70' ! sensor source for GOES-8 selects(2) = 'DAY 1999217 1999217' ! julian day range selects(3) = 'TIME 14:00:00 18:00:00' ! time range selects(4) = 'AUX YES' ! return center lat/lon, res cal selects(5) = 'SUBSET ALL' ! search all position in dataset nselects = MAXDIRSORTS c --- retrieve the dataset name from the command line 2nd argument status = mccmdstr (' ', 2, ' ', dataset) if (status .le. 0) then call edest ('No dataset given in second parameter', 0) return endif c --- open a connection for the specified dataset error_flag = 1 status = MCADIR (dataset, nselects, selects, error_flag) if (status .lt. 0) then call edest ('Failed to open image directory connection to', 0) call edest ('dataset '//dataset, 0) return endif c --- loop to read all the directories returned by the server 100 continue c --- read an image directory block status = MCADRD (directory, comment_cards) c --- check for directory read error if (status .lt. 0) then call edest ('Failed reading directory block', 0) return endif c --- no more directories to be read if (status .eq. 1) goto 999 c --- print a bit of information from the directory block ncards = directory(65) call sdest (' ', 0) call sdest ('Absolute Number of image ', directory(1)) call sdest ('Image Position in dataset ', directory(2)) call sdest (' Nominal Image Date: ', directory(5)) call sdest (' Nominal Image Time: ', directory(6)) call sdest (' Number of comment cards: ', ncards) c --- get and print the list of cal type keys for band 4 band = 4 status = MCPCAL (comment_cards, ncards, band, & calkeys, expkeys, nkeys) if (status .lt. 0) then call edest ('Failed retrieving cal block', 0) goto 100 endif call sdest (' Valid calibration keys for band 4 are', 0) do 110 i=1, nkeys call sdest (' '//calkeys(i)//' - '//expkeys(i), 0) 110 continue c --- get and print the navigation information at the c --- center of the image status = MCPNAV (comment_cards, ncards, lat, lon, & latres, lonres, cplatres, cplonres) c --- failed parsing nav keys, get the next directory if (status .lt. 0) goto 100 cval = cfg (lat) call sdest (' Center latitude '//cval, 0) cval = cfg (lon) call sdest (' Center lontitude '//cval, 0) c --- read the next directory returned by the server goto 100 999 continue c --- return success adde_image_dir = 0 return end integer function adde_image_get ( ) implicit none c --- internal constants integer MAXSORTS parameter (MAXSORTS = 24) ! maximum sort clause strings integer DIRSIZE parameter (DIRSIZE = 64) ! size of image directory block integer NAVSIZE parameter (NAVSIZE = 1024) ! max size of navigation block integer CALSIZE parameter (CALSIZE = 10000) ! max size of calibration block integer PFXSIZE parameter (PFXSIZE = 1000) ! max size of a line prefix integer MAXBYTES parameter (MAXBYTES = 4000) ! max number of bytes return by server integer MAXLINES parameter (MAXlINES = 480) ! max number of lines return by server c --- external functions character*4 clit ! integer type converted to character character*12 cfi ! integer to character integer m0dsnnam ! get position from dataset name integer mcasort ! retrieve select conditions integer mcaget ! open connection to get image integer mcacal ! get calibration block integer mcanav ! get navigation block integer mcalin ! get line of data integer mcapfx ! get line prefix block integer mcacrd ! read the comment cards integer mccmdstr ! retrieve string from command line integer mcaout ! write a line of data integer mcaput ! write a image integer mcacou ! write the comment block integer mcafree ! free the image c --- internal functions c --- internal variables character*80 cline ! a line of text output character*36 dataset ! dataset name character*36 ddataset ! destination dataset name character*36 dname ! destination dataset name without pos character*80 selects(MAXSORTS) ! select conditions character*12 calunit ! calibration unit requested character*12 form ! number of bytes to return data character*4 units ! calibration unit returned character*4 type ! calibration type returned character*12 cpos ! character position value character*12 cval1 ! temporary char val character*12 cval2 ! temporary char val integer i ! loop counter integer bandpos ! position in the BAND= to ! select the band number from ! (used in call to mcasort) integer cal_block(CALSIZE) ! calibration block integer comment_cards(1000) ! comment cards (should be ! integer array) integer directory(DIRSIZE) ! image directory ! returned integer nav_block(NAVSIZE) ! navigation block integer data_line(MAXBYTES) ! a line of data block integer output_datablock(MAXLINES,MAXBYTES) ! output data block integer output_buffer(MAXBYTES) integer prefix_block(PFXSIZE) ! a line prefix block integer errorflag ! errorflag to mcaget() integer handle ! handle to image integer line ! current line of data integer ele ! current ele of a line integer nselects ! number of select conditions integer num_line ! number of lines to retrieve integer num_ele ! number of elements to retrieve real data_point(MAXBYTES) ! a data point as a real real scale ! scaling of data value integer status ! return status c --- return error adde_image_get = -1 c --- get the dataset name status = mccmdstr (' ', 2, ' ', dataset) if (status .le. 0) return cpos = ' ' status = m0dsnnam (dataset, dname, cpos, cval1, 0) if (status .lt. 0) then call edest ('Failed parsing datasetname', 0) return endif adde_image_get = -2 c --- get select conditions from the command line c --- c --- the mcasort function builds select strings from the following c --- keywords c --- BAND = band image bands c --- DAY = bday image day c --- LATLON = lat lon lat/lon location c --- LINELE = line ele sys image lin/ele location c --- MAG = lmag emag line and element magnification c --- PLACE = loc sets whether the location c --- is to be centered, upperleft, c --- etc c --- RTIME = bmin emin set the bmin and emin of the c --- current hour in the TIME select c --- STATION= stn set the location to the lat/lon c --- of the station stn c --- TIME = btime etime image time range c --- select only the first band specified in BAND= keyword c --- if you wanted the ability to select all bands, then you would c --- do the following c --- c --- call movcw ('ALL ', bandpos) bandpos = 1 status = MCASORT (nselects, selects, bandpos) if (status .lt. 0) return adde_image_get = -3 c --- For the purpose of this excercise, only get 100 lines and c --- 100 elements. The number of elements must be divisible by 4. c --- Build the 'SIZE = line ele' select clause num_line = 100 num_ele = 100 nselects = nselects + 1 cval1 = cfi (num_line) cval2 = cfi (num_ele) selects(nselects) = 'SIZE '//cval1//' '//cval2 if (cpos .ne. ' ') then nselects = nselects + 1 selects(nselects) = 'POS '//cpos endif c --- request temperature data calunit = 'RAW ' c --- because temperature data is 4 bytes, request 4-byte data c --- options are c --- I1 1-byte elements c --- I2 2-byte elements c --- I4 4-byte elements form = 'I4' c --- open a connection to the server status = MCAGET (dataset, nselects, selects, calunit, form, & maxbytes, errorflag, directory, HANDLE) if (status .lt. 0) then call edest ('Call to MCAGET failed; returned ', status) return endif c --- now we have made a connection to the server and there is data c --- waiting for us to fetch. adde_image_get = -4 c --- fetch the navigation block - can be read at any time after a c --- successful call to MCAGET status = MCANAV (HANDLE, nav_block) if (status .lt. 0) then call edest ('Failed to retrieve navigation block', 0) return endif adde_image_get = -5 c --- fetch the calibration block - can be read at any time after a c --- successful call to MCAGET status = MCACAL (HANDLE, cal_block) if (status .lt. 0) then call edest ('Failed to retrieve calibration block', 0) return endif adde_image_get = -6 c --- From the directory block, get the calibration unit of the data we c --- retrieved units = clit (directory (58)) c --- From the directory block, get the calibration type of the data we c --- retrieved type = clit (directory (53)) c --- From the directory block, get the scaling factor of the data we c --- retrieved. For example, if the data is a real value (radiance, c --- temperature), the data will be scaled to an integer. To get the c --- real value back, it must be divided by this scaling factor scale = real (directory (59)) c --- read the data block by fetching each line of data and it's prefix call sdest ('First 4 values in each line '//type//' '//units, 0) line = 1 100 continue c --- read the data status = MCALIN (HANDLE, data_line) if (status .lt. 0) then call edest ('Data read error', 0) return c --- got a line of data else if (status .eq. 0) then c --- get the prefix block status = MCAPFX (HANDLE, prefix_block) if (status .lt. 0) then call edest ('Prefix read error', 0) return endif c --- print the first 4 element values for this line do 120 i=1, num_ele data_point(i) = real (data_line(i)) / scale output_datablock(line,i) = data_line(i) 120 continue write (cline, 130) data_point(1), data_point(2), & data_point(3), data_point(4) 130 format (F7.1," ",F7.1," ",F7.1," ",F7.1) call sdest (cline, 0) call sdest (' ', 0) line = line + 1 goto 100 endif adde_image_get = -7 c --- Read the comment cards status = MCACRD (HANDLE, comment_cards) if (status .ne. 0) then call edest ('Failed to read comment cards', 0) return endif c --- Done reading data, we can free the handle to this request status = MCAFREE (HANDLE) c --- write the image to the destination dataset if the dataset name was given c --- Get the destination dataset status = mccmdstr (' ', 3, ' ', ddataset) if (status .le. 0) then adde_image_get = 0 return endif adde_image_get = -8 c --- Parse the destination dataset and get the position number. The c --- position number is requires as a sort clause to write the image status = m0dsnnam (ddataset, dname, cpos, cval1, 1) if (status .lt. 0) then call edest ('Error parsing destination dataset name', 0) return endif nselects = 1 selects(nselects) = 'POS '//cpos c --- Change the data to 2 byte data directory (11) = 2 adde_image_get = -9 c --- Open connection to put the data call sdest ('opening put connetion with dataset '//dname, 0) status = MCAPUT (dname, nselects, selects, directory, & nav_block, cal_block) if (status .ne. 0) then call edest ('Error opening image put connection', 0) return endif adde_image_get = -10 c --- Write out each line, but first pack the 4 byte data into 2 byte do line=1, num_line do ele=1, num_ele output_buffer(ele) = output_datablock(line, ele) end do c --- make the output buffer two byte data call MPIXEL (num_ele, 4, 2, output_buffer) c --- write the line status = MCAOUT (output_buffer) if (status .ne. 0) then call edest ('Error writing image line ', line) return endif end do adde_image_get = -11 c --- write the comment cards status = MCACOU (comment_cards) if (status .ne. 0) then call edest ('Error writing comment cards', 0) return endif adde_image_get = 0 return end