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: smpaddegrd.f,v 1.0 1999/09/28 14:38:32 russd Tst $ *** C ? SMPADDEGRD - McIDAS ADDE grid interface sample program C ? SMPADDEGRD sdataset ddataset C ? Parameters: C ? sdataset | source grid dataset name entered as C ? group/descripter (def=RTGRIDS/ETA) C ? ddataset | destination grid dataset name entered as C ? group/descripter (def=G/G) C ? Keywords: C ? PARam=p1..pn | copy grids with the specified parameters, e.g., T, Z, RH C ? LEV=l1[u1]..ln[un] | copy grids with the specified levels and units, C ? e.g., SFC, 1000[MB], 5000[M]; units are optional C ? but must be in square brackets if specified C ? DAY=d1..d2 | copy grids with the specified days C ? DRAnge=bday eday inc | copy grids in the range of days bday through C ? eday incrementing by inc days (no def for bday; C ? eday def=bday; inc def=1) C ? TIMe=t1..tn | copy grids with the specified times C ? TRAnge=btim etim inc | copy grids in the range of times btim through C ? etim with time increment inc (no def for btim; C ? etim def=btim; inc def=1, meaning 1-hour) C ? SRC=s1..sn | copy grids with the specified sources, e.g., MDX, MRF, ETA C ? FHOur=h1..hn | copy grids with the specified forecast hours; you C ? cannot use FHOUR with FRANGE, FDAY or FTIME keywords C ? FRANGe=bhr ehr inc | copy grids in the range of forecast hours bhr C ? through ehr incrementing by inc hours (no def for C ? bhr; ehr def=bhr; inc def=1); you cannot use C ? FRANGE with FHOUR, FDAY or FTIME keywords C ? FDAy= | copy grids with the specified forecast day; calculated by C ? adding the grid's fhour to its day and time, e.g., a grid with C ? day=95300, time=12 and fhour=72 has fday=95303; you cannot use C ? FDAY with FHOUR or FRANGE keywords C ? FTIme= | copy grids with the specified forecast time; calculated by C ? adding the grid's fhour to its time, e.g., a grid with time=12 C ? and fhour=18 has ftime=6; you cannot use FTIME with FHOUR or C ? FRANGE keywords C ? GPRo=g1..gn | copy grids with the specified projections, e.g., MERC, C ? PS, LAMB, EQUI C ? GRId=bgrid egrid | copy grids bgrid through egrid; enter a grid number C ? or LAST (last grid) for bgrid and egrid; see the C ? Remarks (no def for bgrid; egrid def=bgrid) C ? Remarks: C ? McIDAS programing sample. C ? C ? Based on the serach conditions specified (using the keywords) this C ? sample application will copy the grids from the source dataset C ? to the destination dataset. C ? ---------- subroutine main0 implicit none c --- external functions c --- internal functions integer grid_utils ! test ADDE grid utils c --- internal variables integer status ! function status c **************** Program Body ************** c --- set initial program status to FAILED call MCCODESET( -1 ) c --- GRId ADDE package utility status = GRID_UTILS( ) if( status.lt.0 ) return c --- set the program status to SUCCESS call MCCODESET( 0 ) c --- signal finished call EDEST('Done ...',0) return end ** Name: ** grid_utils - code tests ADDE grid package utilities ** ** Interface: ** integer function ** grid_utils( ) ** ** Input: ** none ** ** Input and Output: ** none ** ** Output: ** none ** ** Return values: ** 0 - Success ** -1 - Failed ** ** Remarks: ** Used to illustrate basic graphic functions ** ** Categories: ** adde ** grid integer function grid_utils( ) implicit none c --- parameters c --- internal constants integer MAX_NSORT parameter (MAX_NSORT = 20) integer MAX_GSIZE parameter (MAX_GSIZE = 100000) character*4 FORM parameter (FORM = 'I4 ') character*4 UNIT parameter (UNIT = ' ') c --- external functions character*12 cfu integer len_trim integer m0gsort integer mccmdnum integer mccmdstr integer mcgdir integer mcgdrd integer mcgfdrd integer mcgget integer mcgridf integer mcgput integer mcgoutf c --- internal variables character*12 cgrid character*12 cday character*12 ctime character*12 csrc character*12 cpar character*12 clev character*12 cfhour character*12 cnum character*32 file_label character*256 sdataset_name character*256 ddataset_name character*256 rsorts(MAX_NSORT) character*256 wsorts(MAX_NSORT) integer nrsort integer nwsort integer sort_len integer ok integer i integer beg integer end integer ngrid integer err_flag integer rep_flag integer num_grid integer totbyte integer file_header(64) integer grid_header(64) integer grid(MAX_GSIZE) c ************ Function Body ************* c --- initialize the function status grid_utils = -1 c --- get the name of the source dataset ok= mccmdstr(' ', 2, 'RTGRIDS/ETA', sdataset_name ) call sdest('Source Dataset Name: '//sdataset_name,0) c --- get the name of the destination dataset ok= mccmdstr(' ', 3, 'G/G', ddataset_name ) call sdest('Destination Dataset Name: '//ddataset_name,0) c --- get multiple keyword values in M)PSORT rep_flag = 1 c --- build the sort clause set from the command line ok= M0GSORT( nrsort, rsorts, rep_flag ) if( ok.lt.0 ) return c --- check for NUM= keyword, not added by MCGSORT if( MCCMDNUM( 'NUM' ).ne.0 ) then c ------ get the entered value for NUM= ok= MCCMDSTR('NUM', 1, ' ', cnum ) if( ok.lt.0 ) return c ------ add NUM= clause to sort list nrsort = nrsort+1 if( nrsort.gt.MAX_NSORT ) then call EDEST('Too many sort clauses specified',0) return else call MCUPCASE( cnum ) rsorts(nrsort) = 'NUM '//cnum endif endif c --- print a list of the select clauses call sdest('Grid Directory Sort Clause List: Num=',nrsort) if( nrsort.gt.0 ) then do i = 1, nrsort sort_len = LEN_TRIM( rsorts(i) ) cnum = CFU( i ) call sdest(' sort('//cnum(1:2)//'): '// & rsorts(i)(1:sort_len),0) end do endif c --- send transaction request to the directory server err_flag = 1 ! error messaging flag set to on ok= MCGDIR( sdataset_name, nrsort, rsorts, err_flag ) if( ok.lt.0 ) then call EDEST('MCGDIR: failed -- status=', ok) return endif c --- read the grid file header 100 ok= MCGFDRD( file_header ) if( ok.lt.0 ) then call EDEST('MCGFDRD: failed -- status=', ok) return endif if( ok.lt.0 ) return c --- check if the pipe has a grid file header record if( ok.eq.0 ) then c ------ print the grid file label call MOVWC( file_header(1), file_label ) call SDEST(' ',0) call SDEST('Grid File Label: '//file_label,0) c ------ read all the grid header records from the pipe 200 ok= MCGDRD( grid_header ) if( ok.lt.0 ) then call EDEST('MCGDRD: failed -- status=', ok) return endif c ------ recieved a grid header if( ok.eq.0 ) then c --------- convert grid directory values to character type cday = CFU( grid_header(4) ) ctime = CFU( grid_header(5) ) beg = index( sdataset_name, '/' ) + 1 end = LEN_TRIM( sdataset_name ) csrc = sdataset_name(beg:end) cpar = CFU( grid_header(7) ) clev = CFU( grid_header(10) ) cfhour = CFU( grid_header(6) ) c --------- print the grid parameters call SDEST( & ' Grid : Parameter= '// & clev(1:4)//'mb '// & cpar(1:4)//' '// & csrc(1:4)//' on '// & cday(1:7)//' at '// & ctime(1:6)//'GMT valid= '// & cfhour(1:3)//'hr',0) c --------- go back and read the pipe for another grid header goto 200 endif c ------ go back and read the pipe for another file header goto 100 endif call sdest(' ',0) call sdest('Transfer grids from server to client',0) c --- set up the grid write sort clauses wsorts(1) = 'DEL=YES' wsorts(2) = 'NUM=1' wsorts(3) = 'GRID=1' nwsort = 4 c --- Request the same grids from the server ok= MCGGET( sdataset_name, nrsort, rsorts, UNIT, FORM, & MAX_GSIZE*4, err_flag, num_grid, totbyte ) if( ok.lt.0 ) then call EDEST('MCGGET: failed -- status=', ok) return endif c --- initialize the grid counter ngrid = 0 c --- read the grid(s) from the pipe 300 ok= MCGRIDF( grid, grid_header ) c --- got a grid from the server if( ok.eq.0 ) then call sdest(' Received the grid from '//sdataset_name,0) c ------ increment the grid counter ngrid = ngrid+1 c ------ add the grid position to the sort clause list cgrid = CFU( ngrid ) wsorts(4) = 'POS='//cgrid c ------ request write the grid file to the destination dataset ok= MCGPUT(ddataset_name, nwsort, wsorts, err_flag, totbyte) if( ok.lt.0 ) then call EDEST('MCGGET: failed -- status=', ok) return else c --------- write the grid to the destination dataset ok= MCGOUTF( grid, grid_header ) if( ok.lt.0 ) then call EDEST('MCGOUTF: failed -- status=', ok) return endif call sdest(' Stored the grid to '//ddataset_name,0) endif goto 300 else call sdest('Transfer completed',0) endif c --- set return status grid_utils = 0 return end