实质上是调用globk实现解算"/>
glred实质上是调用globk实现解算
glred的运行,最后是调用的globk。
call execute( globk_run, iprm, 1, 100, off_com)
glred源代码如下:
program glredimplicit none * Program which will schedule GLOBK for a series of single global
* files which as given to it. This program may be used to
* generate global files with the source positions fixed from ones
* which have all sources free.
*
* The runstring is very similar to GLOBK's runstring:
*
* CI> GLRED,crt,prt,log,input list,markov file,common,sort,list_mask
*
* Where crt is user's LU
* prt is print device (LU)
* log is log unit number
* input list is the name of the file containing the list of
* global files to be processed
* markov file is the name of the markov control file to be
* passed to GLOBK.
* common [file] is the name of the common file to be used
* (Can also be specified in the markov file)
* sort [file] is the name of the sort file (can also be given
* in the markov file)
* list mask is the mask to be used when the list file for GLOBK
* is generated. Each list file contains the name of the
* global file to be processed by GLOBK. The file name
* will be generated from the name of the current global
* file being processed.
*include '../includes/kalman_param.h'* crt - User's LU number
* DecimalToInt - Converts string to integer
* i,j - Loop counters
* ierr - IOSTAT error flag
* indx - Pointer to position in string for Read_Line
* iprm(5) - Parameters returned from FmpRunProgram
* len_run - Length of runstring parameter
* loglu - Return users LU number
* rcpar - HP function to read runstring
* trimlen - String length function
* num_in_gdl - Number of files listed to the lsit file.
* indx_save - Saved value of index to see if + at end of line.integer*4 crt, DecimalToInt, i, ierr, indx, iprm(5), len_run,. loglu, rcpar, trimlen, off_com, jerr, kerr, dumm, . num_in_gdl, indx_save* expts_var_read - Variance to be given to the experiment.real*8 expts_var_read* Still_adding - Logical to indicate that we are still
* adding global files to the list. (Lines ending
* in + are added)logical still_adding* MOD TAH 980519: Added explicit specification of diagonal
* scaling of matrices* glb_diag -- Diagonal scaling factor in ppm
* glb_var -- Complete matrix scalingreal*8 glb_diag, glb_var* crt_string - String containing CRT LU
* log_string - String containing LOG LU
* prt_string - String containing PRINT LUcharacter*128 crt_string, log_string, prt_string* comopt - Optional command line beginning stringcharacter*256 comopt* global_file - Name of the global file being processed
* input_file - Name of the file with the list of global files
* - to be processed.
* list_file - Name of the list file for current global
* list_mask - Mask to be used to generate list file name
* markov_file - Name of the markov file (Must be given)
* common_file - Name of the global common file to used
* sort_file - Name of the sort file to be passed to GLOBKcharacter*128 global_file, input_file, list_file, list_mask,. markov_file, common_file, sort_file* line - Line read from input filecharacter*128 line* globk_run - GLOBK run command linecharacter*256 globk_runcharacter*4 cdum***** Start decoding the runstringcrt_string = ' 'prt_string = ' 'log_string = ' 'list_file = ' 'markov_file = ' 'common_file = ' 'sort_file = ' '* ! Get CRT string for GLOBKlen_run = rcpar(1, crt_string )if( len_run.gt.0 ) thencrt = DecimalToInt( crt_string, ierr)end ifif( len_run.eq.0 .or. ierr.ne.0 ) thencrt = loglu(i)end if* ! Printer stringlen_run = rcpar(2, prt_string)
* ! Log LU stringlen_run = rcpar(3, log_string)
* ! Name of input filelen_run = rcpar(4, input_file)if( len_run.eq.0 ) thencall proper_runstring('glred.hlp','glred',1)
* ! Report runstring and stopend if* ! Name of markov filelen_run = rcpar(5, markov_file)if( len_run.eq.0 ) thencall proper_runstring('glred.hlp','glred',1)
* ! Report runstring and stopend if*len_run = rcpar(6, comopt) ! optional command line beginningif( len_run.eq.0 ) comopt = ' ' ! Name of common file (optional)len_run = rcpar(7, common_file)
* ! Name of sort file (optional)len_run = rcpar(8, sort_file)* ! List file mask (optional)len_run = rcpar(9, list_mask)
* ! Use defaultif( len_run.eq.0 ) thenlist_mask = list_mask_defaultend if***** Now loop over the input file, scheduling GLOBK to run on each of the
* filesopen(100, file=input_file, iostat=ierr, status='old')call report_error('IOSTAT',ierr,'open',input_file,0,'GLRED')if( ierr.ne.0 ) thencall proper_runstring('glred.hlp','glred',1)
* ! Report runstring and stopend if***** Now loop over of the input filedo while ( ierr.eq.0 )still_adding = .true.num_in_gdl = 0do while ( still_adding )read(100,'(a)',iostat=ierr) linejerr = ierrif( ierr.ne.0 ) still_adding = .false.
* ! Get file name from
* MOD TAH 950106: Check file name to see if non-blank and does not
* start with # or *if ( ierr.eq.0 .and. trimlen(line).gt.0 .and.. line(1:1).ne.'#' .and. line(1:1).ne.'*' ) then
* ! lineindx = 1call read_line( line, indx, 'CH', jerr, dumm,. global_file)* Try to read the variance:indx_save = indxglb_var = 1.d0glb_diag = 0.d0call GetWord(line, cdum, indx)if ( cdum(1:4).ne.'+ ' ) thenindx = indx_savecall read_line( line, indx, 'R8', kerr, . glb_var, cdum )if( kerr.ne.0 ) thenglb_var = 1.d0if( index(line,'+').lt.indx_save ) . still_adding = .false.else* MOD TAH 980519: see if diagonal passedindx_save = indxcall GetWord(line, cdum, indx)if ( cdum(1:4).ne.'+ ' ) thenindx = indx_savecall read_line( line, indx, 'R8', kerr, . glb_diag, cdum )if( kerr.ne.0 ) thenglb_diag = 0.d0if( index(line,'+').lt.indx_save ) . still_adding = .false.else
* MOD TAH 980519: In this case test against last thing
* read in line. if( index(line,'+').lt.indx ) . still_adding = .false.endifend ifend ifendif* Compute the value of the variance scale to be written.if( glb_diag.ne.0.d0 ) thenexpts_var_read = -(glb_var + . (1.d0+glb_diag/1.d6)/1000.d3)elseexpts_var_read = glb_varend ifelse jerr = -1end if * ! Schedule Globkif( jerr.eq.0 ) then* Generate list file nameif( num_in_gdl.eq.0 ) thenlist_file = list_maskcall wild_card( list_file, global_file )* Create the list fileopen(200,file=list_file, iostat=jerr, . status='unknown')call report_error('IOSTAT',jerr,'open',list_file,. 0,'GLRED')end ifend if* ! Only continue is no errorsif( jerr.eq.0 ) then* Write the global file name into the list filenum_in_gdl = num_in_gdl + 1write(200,'(a,1x,f25.16)', iostat=ierr) . global_file(1:trimlen(global_file)), . expts_var_readend ifend doclose(200)* Now schedule GLOBK, build up runstringif( num_in_gdl.gt. 0 ) thenglobk_run = 'globk ' //. crt_string (1:max(1,trimlen(crt_string ))) // ' ' //. prt_string (1:max(1,trimlen(prt_string ))) // ' ' //. log_string (1:max(1,trimlen(log_string ))) // ' ' //. list_file (1:max(1,trimlen(list_file ))) // ' ' //. markov_file(1:max(1,trimlen(markov_file ))) // ' ' //. comopt (1:max(1,trimlen(comopt ))) // ' ' //. common_file(1:max(1,trimlen(common_file ))) // ' ' //. sort_file (1:max(1,trimlen(sort_file )))write(*,'(a)') globk_run(1:trimlen(globk_run))call execute( globk_run, iprm, 1, 100, off_com)* Now purge the list file since we do not need itopen(200,file=list_file, iostat=ierr, status='old')close(200, status='delete', iostat= ierr)call report_error('IOSTAT',ierr,'clos',list_file,0,. 'GLRED')end ifend do***** Thats allclose(100)end
更多推荐
glred实质上是调用globk实现解算
发布评论