Viewing contents of file '../idllib/contrib/esrg_ucsb/fordatin.pro'
function fordatin,file,varname,pu=pu, help=help
;+
; ROUTINE: fordatin
;
; PURPOSE: read fortran data statements
;
; USEAGE: result=fordatin(file,varname)
;
; INPUT:
; file name of fortran source file containing target
; data statement (string)
;
; varname name of fortran variable initialized in data statement
; (string)
;
; KEYWORD INPUT:
; pu the name of the program unit which contains the data
; initialization. Specify enough of the leading
; characters of the program unit name to make it
; unique. White space and case are ignored. For example
;
; pu='subroutine foo'
; pu=' subroutine foobar'
; pu='SUBROUTINE FOOBAR(x1,'
;
; all match
;
; subroutine foobar(x1,x2,x3) ! a comment
;
; help print this documentation header
;
; OUTPUT:
; result array of initial values of variable VARNAME.
;
; PROCEDURE: FORDATIN first searches through the fortran source file
; for a program unit matching PU (if this optional
; parameter is provided). Next it looks for a line
; containing the keywords DATA and the variable name
; VARNAME. It reads all the following characters until it
; finds two matching forward slashes (/). All characters
; between the matching slashes are scanned and turned into
; either an integer or float array as appropriate.
;
;
; RESTRICTIONS:
; this routine is designed to extract the part of the data
; block following a typical array initialization such as
;
; data varname/ 1,2,3,4,5,5
; & 7,8,9/
;
; if the data statement looks like
;
; data (varname(i),i=1,3) /1,2,3/
; data (varname(i),i=4,6) /3,2,4/
;
; you can read the data as
;
; v1=fordatin('file.f','(varname(i),i=1,3)')
; v2=fordatin('file.f','(varname(i),i=4,6)')
; v=[v1,v2]
;
; but beware, FORDATIN will read all the numbers between
; slashes in a multi-variable data statement such as
;
; data v1,v2,v3/12,24,25/
;
; EXAMPLE:
;
;; plot temperature profile of TROPICAL standard atmosphere
;
; z1=fordatin('/home/paul/rtmodel/atms.f','z1')
; t1=fordatin('/home/paul/rtmodel/atms.f','t1')
; plot,z1,t1
;
;; plot coalbedo of ice particles as a function of wavelength
;
; wl=.29*(333.33/.29)^(findgen(400)/399)
; w=fordatin('/home/paul/rtmodel/cloudpar.f','(ww(i,14),i=1,mxwv)')
; plot,wl,1.-w,xrange=[0,4]
;
; REVISIONS:
;
; author: Paul Ricchiazzi jan94
; Institute for Computational Earth System Science
; University of California, Santa Barbara
;-
;
if n_params() eq 0 or keyword_set(help) then begin
xhelp,'fordatin'
return,0
endif
line=''
get_lun,lun
openr,lun,file
blank=" "
; first look for the program unit which contains the variable initialization
if keyword_set(pu) then begin
match=strcompress(strlowcase(pu),/remove_all)
repeat begin
readf,lun,line
line=strcompress(strlowcase(line),/remove_all)
endrep until strpos(line,match) eq 0
endif
; look for the variable initialization
found=0
nslsh=0
body=''
while nslsh lt 2 do begin
readf,lun,line
line=strlowcase(line)
if strpos(line,' ') ne 0 then line=' ' ; delete comment lines
if not found then begin
ncvar=strpos(line,varname)
if ncvar gt 0 then begin
ncdat=strpos(line,"data")
predat=""
if ncdat ge 0 then predat=strmid(line,0,ncdat-1)
blnk=strmid(blank,0,ncdat-1)
if ncdat ge 6 and ncvar ge ncdat and predat eq blnk then found=1
endif
endif
if found then begin
nend=strpos(line,"!")
if nend lt 0 then nend=72
line=strmid(line,0,nend-1)
if strpos(line,"c") eq 0 then line=blank
n1=6
if nslsh eq 0 then begin
n1=strpos(line,"/")
if n1 ge 0 then begin
nslsh=nslsh+1
n1=n1+1
endif
endif
if n1 eq 6 then n2=strpos(line,"/") $
else n2=strpos(strmid(line,n1,71),"/")+n1
if n2 ge n1 then begin
nslsh=nslsh+1
n2=n2-1
endif else begin
n2=71
endelse
body=body+strmid(line,n1,n2-n1+1)
endif
endwhile
free_lun,lun
body=strcompress(body,/remove_all)
a_float=strpos(body,'.') ge 0 or strpos(body,'e') ge 0
body1=str_sep(body,',')
if a_float then body2=float(body1) else body2=fix(body1)
return,body2
end