[Dart-dev] [3322]
DART/branches/nancy_work/preprocess/preprocess.f90:
My test branch only; initial parsing of new format
nancy at subversion.ucar.edu
nancy at subversion.ucar.edu
Mon Apr 28 16:36:02 MDT 2008
An HTML attachment was scrubbed...
URL: http://mailman.ucar.edu/pipermail/dart-dev/attachments/20080428/0089973d/attachment.html
-------------- next part --------------
Modified: DART/branches/nancy_work/preprocess/preprocess.f90
===================================================================
--- DART/branches/nancy_work/preprocess/preprocess.f90 2008-04-23 15:10:29 UTC (rev 3321)
+++ DART/branches/nancy_work/preprocess/preprocess.f90 2008-04-28 22:36:01 UTC (rev 3322)
@@ -14,19 +14,20 @@
! Takes a list of observation type module path names. These modules contain
! multiple fragments of standard F90 that may be required to implement forward
! observation operators for DART. The sections are retrieved from the files
-! by this program and inserted into the appropriate blank in the
-! DEFAULT_obs_def_mod.F90. The final obs_def_mod.f90 that is created contains
+! by this program and inserted into the appropriate blanks in the
+! DEFAULT_obs_def_mod.F90 and DEFAULT_obs_kind_mod.F90 templates.
+! The final obs_def_mod.f90 and obs_kind_mod.f90 that are created contain
! the default code plus all the code required from the selected observation
! type modules. Preprocess also inserts the required identifier and string
-! for the corresponding observation kinds into the DEFAULT_obs_kind_mod.f90
-! which is written out to obs_kind_mod.f90.
+! for the corresponding observation kinds (and only those kinds).
! NEED TO ADD IN ALL THE ERROR STUFF
-use types_mod, only : r8
-use utilities_mod, only : register_module, error_handler, E_ERR, E_MSG, file_exist, &
- open_file, logfileunit, initialize_utilities, timestamp, &
- find_namelist_in_file, check_namelist_read
+use types_mod, only : r8
+use utilities_mod, only : register_module, error_handler, E_ERR, E_MSG, &
+ file_exist, open_file, logfileunit, timestamp, &
+ initialize_utilities, &
+ find_namelist_in_file, check_namelist_read
implicit none
@@ -37,14 +38,29 @@
revdate = "$Date$"
! Pick something ridiculously large and forget about it (lazy)
-integer, parameter :: max_types = 10000
-character(len = 256) :: line, test, type_string(max_types), &
- raw_kind_item(max_types), t_string
-integer :: iunit, ierr, io, i, j, k, l, l_type_string
-integer :: num_types_found
-logical :: duplicate
+integer, parameter :: max_types = 5000, max_kinds = 5000
+character(len = 256) :: line, test, test2, type_string(max_types), &
+ kind_string(max_kinds), t_string, temp_type, temp_kind
+integer :: iunit, ierr, io, i, j, k, l
+integer :: l_string, l2_string, total_len
+integer :: num_types_found, num_kinds_found
+logical :: duplicate, usercode(max_types)
character(len = 169) :: err_string
+! specific marker strings
+character(len = 33) :: kind_start_string = '! BEGIN DART PREPROCESS KIND LIST'
+character(len = 31) :: kind_end_string = '! END DART PREPROCESS KIND LIST'
+
+! output format decorations
+character(len = 78) :: separator_line = &
+'!---------------------------------------------------------------------------'
+character(len = 78) :: blank_comment_line = &
+'! '
+character(len = 78) :: blank_line = &
+' '
+character(len = 12) :: start_line = '! Start of '
+character(len = 12) :: end_line = '! End of '
+
! List of the DART PREPROCESS strings for obs_def type files.
character(len = 29) :: preprocess_string(8) = (/ &
'MODULE CODE ', &
@@ -64,15 +80,26 @@
! and these files are used to fill in observation kind details in
! DEFAULT_obs_def_mod.f90 and DEFAULT_obs_kind_mod.f90.
integer, parameter :: max_input_files = 1000
-character(len = 129) :: input_obs_def_mod_file = '../../../obs_def/DEFAULT_obs_def_mod.F90'
-character(len = 129) :: output_obs_def_mod_file = '../../../obs_def/obs_def_mod.f90'
-character(len = 129) :: input_obs_kind_mod_file = '../../../obs_kind/DEFAULT_obs_kind_mod.F90'
-character(len = 129) :: output_obs_kind_mod_file = '../../../obs_kind/obs_kind_mod.f90'
+character(len = 129) :: input_obs_def_mod_file = &
+ '../../../obs_def/DEFAULT_obs_def_mod.F90'
+character(len = 129) :: output_obs_def_mod_file = &
+ '../../../obs_def/obs_def_mod.f90'
+character(len = 129) :: input_obs_kind_mod_file = &
+ '../../../obs_kind/DEFAULT_obs_kind_mod.F90'
+character(len = 129) :: output_obs_kind_mod_file = &
+ '../../../obs_kind/obs_kind_mod.f90'
character(len = 129) :: input_files(max_input_files) = 'null'
namelist /preprocess_nml/ input_obs_def_mod_file, input_obs_kind_mod_file, &
output_obs_def_mod_file, output_obs_kind_mod_file, input_files
+!---------------------------------------------------------------------------
+! start of program code
+
+do i = 1, 10000
+ j = i + 1
+enddo
+
!Begin by reading the namelist
call initialize_utilities('preprocess')
call register_module(source, revision, revdate)
@@ -84,33 +111,37 @@
! Output the namelist file information
write(logfileunit, *) 'Path names of default obs_def and obs_kind modules'
-write(*, *) 'Path names of default obs_def and obs_kind modules'
write(logfileunit, *) trim(input_obs_def_mod_file)
write(logfileunit, *) trim(input_obs_kind_mod_file)
+write(*, *) 'Path names of default obs_def and obs_kind modules'
write(*, *) trim(input_obs_def_mod_file)
write(*, *) trim(input_obs_kind_mod_file)
write(logfileunit, *) 'Path names of output obs_def and obs_kind modules'
-write(*, *) 'Path names of output obs_def and obs_kind modules'
write(logfileunit, *) trim(output_obs_def_mod_file)
write(logfileunit, *) trim(output_obs_kind_mod_file)
+write(*, *) 'Path names of output obs_def and obs_kind modules'
write(*, *) trim(output_obs_def_mod_file)
write(*, *) trim(output_obs_kind_mod_file)
! A path for the default files is required. Have an error if these are null.
if(input_obs_def_mod_file == 'null') &
- call error_handler(E_ERR, 'preprocess', 'Namelist must provide input_obs_def_mod_file', &
+ call error_handler(E_ERR, 'preprocess', &
+ 'Namelist must provide input_obs_def_mod_file', &
source, revision, revdate)
if(input_obs_kind_mod_file == 'null') &
- call error_handler(E_ERR, 'preprocess', 'Namelist must provide input_obs_kind_mod_file', &
+ call error_handler(E_ERR, 'preprocess', &
+ 'Namelist must provide input_obs_kind_mod_file', &
source, revision, revdate)
! A path for the output files is required. Have an error if these are null.
if(output_obs_def_mod_file == 'null') &
- call error_handler(E_ERR, 'preprocess', 'Namelist must provide output_obs_def_mod_file', &
+ call error_handler(E_ERR, 'preprocess', &
+ 'Namelist must provide output_obs_def_mod_file', &
source, revision, revdate)
if(output_obs_kind_mod_file == 'null') &
- call error_handler(E_ERR, 'preprocess', 'Namelist must provide output_obs_kind_mod_file', &
+ call error_handler(E_ERR, 'preprocess', &
+ 'Namelist must provide output_obs_kind_mod_file', &
source, revision, revdate)
write(logfileunit, *) 'INPUT obs_def files follow:'
@@ -130,8 +161,10 @@
obs_def_in_unit = open_file(input_obs_def_mod_file)
else
! If file does not exist it is an error
- write(err_string, *) 'file ', trim(input_obs_def_mod_file), ' does not exist'
- call error_handler(E_ERR, 'preprocess', err_string, source, revision, revdate)
+ write(err_string, *) 'file ', trim(input_obs_def_mod_file), &
+ ' must exist (and does not)'
+ call error_handler(E_ERR, 'preprocess', err_string, &
+ source, revision, revdate)
endif
if(file_exist(trim(input_obs_kind_mod_file))) then
@@ -139,8 +172,10 @@
obs_kind_in_unit = open_file(input_obs_kind_mod_file)
else
! If file does not exist it is an error
- write(err_string, *) 'file ', trim(input_obs_kind_mod_file), ' does not exist'
- call error_handler(E_ERR, 'preprocess', err_string, source, revision, revdate)
+ write(err_string, *) 'file ', trim(input_obs_kind_mod_file), &
+ ' must exist (and does not)'
+ call error_handler(E_ERR, 'preprocess', err_string, &
+ source, revision, revdate)
endif
! Output files must NOT EXIST or else an error
@@ -149,8 +184,10 @@
obs_def_out_unit = open_file(output_obs_def_mod_file)
else
! If file *does* exist it is an error
- write(err_string, *) 'file ', trim(output_obs_def_mod_file), ' exists: Please Rename'
- call error_handler(E_ERR, 'preprocess', err_string, source, revision, revdate)
+ write(err_string, *) 'file ', trim(output_obs_def_mod_file), &
+ ' exists and will not be overwritten: Please remove or rename'
+ call error_handler(E_ERR, 'preprocess', err_string, &
+ source, revision, revdate)
endif
if(.not. file_exist(trim(output_obs_kind_mod_file))) then
@@ -158,82 +195,138 @@
obs_kind_out_unit = open_file(output_obs_kind_mod_file)
else
! If file *does* exist it is an error
- write(err_string, *) 'file ', trim(output_obs_kind_mod_file), ' exists: Please Rename'
- call error_handler(E_ERR, 'preprocess', err_string, source, revision, revdate)
+ write(err_string, *) 'file ', trim(output_obs_kind_mod_file), &
+ ' exists and will not be overwritten: Please remove or rename'
+ call error_handler(E_ERR, 'preprocess', err_string, &
+ source, revision, revdate)
endif
-!_______________________________________________________________________________________
-! Now do preprocessing for the obs_kind module
-! Easiest to get the three strings required from all of the obs_kind files up front and
-! then insert stuff
+!______________________________________________________________________________
+! Preprocessing for the obs_kind module
+! Get all the type/kind strings from all of the obs_def files
+! up front and then insert stuff. Easier to error check and combine
+! duplicate kinds.
-! Initial number of types is 0
+! Initial number of types and kinds is 0
num_types_found = 0
+num_kinds_found = 0
SEARCH_INPUT_FILES: do j = 1, num_input_files
if(file_exist(trim(input_files(j)))) then
! Open the file for reading
in_unit = open_file(input_files(j))
- else
+ else
! If file does not exist it is an error
- write(err_string, *) 'input_files ', trim(input_files(j)), ' does NOT exist.'
- call error_handler(E_ERR, 'preprocess', err_string, source, revision, revdate)
+ write(err_string, *) 'input_files ', trim(input_files(j)), &
+ ' does NOT exist (and must).'
+ call error_handler(E_ERR, 'preprocess', err_string, &
+ source, revision, revdate)
endif
! Read until the ! BEGIN KIND LIST is found
FIND_KIND_LIST: do
read(in_unit, 222, IOSTAT = ierr) line
- ! If end of file, then the input file is incomplete or weird stuff has happened
- if(ierr /=0) then
+ ! If end of file, input file is incomplete or weird stuff happened
+ if(ierr /= 0) then
write(err_string, *) 'file ', trim(input_files(j)), &
- ' does NOT contain ! BEGIN DART PREPROCESS KIND LIST'
- call error_handler(E_ERR, 'preprocess', err_string, source, revision, revdate)
+ ' does NOT contain ', kind_start_string
+ call error_handler(E_ERR, 'preprocess', err_string, &
+ source, revision, revdate)
endif
- ! Look for the ! BEGIN KIND LIST
+ ! Look for the ! BEGIN KIND LIST in the current line
test = adjustl(line)
- if(test(1:33) == '! BEGIN DART PREPROCESS KIND LIST') exit FIND_KIND_LIST
+ if(test(1:33) == kind_start_string) exit FIND_KIND_LIST
end do FIND_KIND_LIST
! Subsequent lines contain the type_identifier (same as type_string), and
- ! raw_kind_ident separated by commas
+ ! kind_string separated by commas, and optional usercode flag
EXTRACT_KINDS: do
read(in_unit, 222, IOSTAT = ierr) line
- ! If end of file, then the input file is incomplete or weird stuff has happened
- if(ierr /=0) then
+ ! If end of file, input file is incomplete or weird stuff happened
+ if(ierr /= 0) then
write(err_string, *) 'file ', trim(input_files(j)), &
- ' does NOT contain ! END DART PREPROCESS KIND LIST'
- call error_handler(E_ERR, 'preprocess', err_string, source, revision, revdate)
+ ' does NOT contain ', kind_end_string
+ call error_handler(E_ERR, 'preprocess', err_string, &
+ source, revision, revdate)
endif
- ! Look for the ! END KIND LIST
+ ! Look for the ! END KIND LIST in the current line
test = adjustl(line)
- if(test(1:31) == '! END DART PREPROCESS KIND LIST') exit EXTRACT_KINDS
+ if(test(1:31) == kind_end_string) exit EXTRACT_KINDS
- ! Found a type; increment the count
- num_types_found = num_types_found + 1
- ! Otherwise this line should contain type_identifier (same as type_string),
- ! raw_kind_item with leading comment
- ! Get rid of the leading comment and subsequent space
+ ! All lines between start/end must be type/kind lines.
+ ! Format: ! type_string, kind_string [, USERCODE]
+
+ ! Get rid of the leading comment and any subsequent whitespace
+ if (line(1:1) /= '!') call typekind_error(line, input_files(j))
+
test = adjustl(line(2:))
+ total_len = len(test)
+
! Compute the length of the type_string by seeking comma
- do k = 1, 256
- l_type_string = k - 1
+ do k = 1, total_len
+ l_string = k - 1
if(test(k:k) == ',') exit
end do
- type_string(num_types_found) = adjustl(test(1:l_type_string))
- ! Finally get the raw_kind_item
- raw_kind_item(num_types_found) = adjustl(test(l_type_string + 2:))
+ ! comma not found? (first one is required)
+ if (l_string == total_len - 1) call typekind_error(line, input_files(j))
+ ! save results in temp vars for now, so we can check for
+ ! duplicates (not allowed in types) or duplicates (which are
+ ! expected in kinds)
+ temp_type = adjustl(test(1:l_string))
+
+ ! FIXME: old code; remove when new code working
+ !type_string(num_types_found) = adjustl(test(1:l_string))
+
+ ! check for another comma before end of line (not mandatory)
+ do k = l_string+2, total_len
+ l2_string = k - 1
+ if(test(k:k) == ',') exit
+ end do
+
+ ! not found? ok, then kind is remaining part of string
+ if (l2_string == total_len - 1) then
+ temp_kind = adjustl(test(l_string + 2:))
+ else
+ ! another comma found, need to have USERCODE on rest of line
+ test2 = adjustl(test(l2_string+2:))
+ if (test2(1:8) /= 'USERCODE') call typekind_error(line, input_files(j))
+
+ temp_kind = adjustl(test(l_string + 2:l2_string))
+
+ endif
+
+print *, 'temp_type = ', trim(temp_type)
+print *, 'temp_kind = ', trim(temp_kind)
+
+ ! Another type/kind line; increment the type count. Check the kinds
+ ! list for repeated occurances first before deciding this is a new kind.
+ num_types_found = num_types_found + 1
+ type_string(num_types_found) = temp_type
+ kind_string(num_types_found) = temp_kind
+
+ ! FIXME: old code, remove when new code working
+ !kind_string(num_types_found) = adjustl(test(l_string + 2:))
+
end do EXTRACT_KINDS
! Close this obs_kind file
close(in_unit)
end do SEARCH_INPUT_FILES
-! A list of num_types_found kinds has been found, now need to put code into the obs_kind_mod
+do i = 1, num_types_found
+ print *, i
+ print *, 'type = ', trim(type_string(i))
+ print *, 'kind = ', trim(kind_string(i))
+enddo
+stop
+
+! A list of num_types_found kinds has been found, now need to put code
+! into the obs_kind_mod
! Begin by copying over lines until first insertion point is found
do
read(obs_kind_in_unit, 222, IOSTAT = ierr) line
@@ -262,13 +355,13 @@
do i = 1, num_types_found
duplicate = .false.
do j = 1, i-1
- if (trim(raw_kind_item(j)) == trim(raw_kind_item(i))) then
+ if (trim(kind_string(j)) == trim(kind_string(i))) then
duplicate = .true.
exit
endif
end do
if (.not. duplicate) then
- write(line, *) 'public :: ', trim(raw_kind_item(i))
+ write(line, *) 'public :: ', trim(kind_string(i))
write(obs_kind_out_unit, 51) trim(adjustl(line))
endif
end do
@@ -301,13 +394,13 @@
do i = 1, num_types_found
duplicate = .false.
do j = 1, i-1
- if (trim(raw_kind_item(j)) == trim(raw_kind_item(i))) then
+ if (trim(kind_string(j)) == trim(kind_string(i))) then
duplicate = .true.
exit
endif
end do
if (.not. duplicate) then
- write(line, *) 'integer, parameter :: ', trim(adjustl(raw_kind_item(i))), ' = ', i
+ write(line, *) 'integer, parameter :: ', trim(adjustl(kind_string(i))), ' = ', i
write(obs_kind_out_unit, 51) trim(adjustl(line))
endif
end do
@@ -337,7 +430,7 @@
do i = 1, num_types_found
write(line, *) 'obs_kind_info(', i, ') = obs_kind_type(', trim(type_string(i)), ", '", trim(type_string(i)), "', &"
write(obs_kind_out_unit, 21) trim(line)
- write(line, *) ' ', trim(raw_kind_item(i)), ', .false., .false.)'
+ write(line, *) ' ', trim(kind_string(i)), ', .false., .false.)'
write(obs_kind_out_unit, 21) trim(line)
end do
@@ -353,9 +446,9 @@
end do
close(obs_kind_out_unit)
-!_______________________________________________________________________________________
+!______________________________________________________________________________
-!_______________________________________________________________________________________
+!______________________________________________________________________________
! Now do the obs_def files
! Read DEFAULT file line by line and copy into output file until
! Each insertion point is found. At the insertion points, copy the
@@ -402,13 +495,13 @@
do k = 1, num_types_found
duplicate = .false.
do l = 1, k-1
- if (trim(raw_kind_item(k)) == trim(raw_kind_item(l))) then
+ if (trim(kind_string(k)) == trim(kind_string(l))) then
duplicate = .true.
exit
endif
end do
if (.not. duplicate) &
- write(obs_def_out_unit, 21) 'use obs_kind_mod, only : ' // trim(raw_kind_item(k))
+ write(obs_def_out_unit, 21) 'use obs_kind_mod, only : ' // trim(kind_string(k))
end do
else
! Insert the code for this ITEM from each of the requested obs_kind 'modules'
@@ -475,9 +568,26 @@
end do ITEMS
close(obs_def_out_unit)
-!_______________________________________________________________________________________
+!______________________________________________________________________________
call timestamp(source,revision,revdate,'end') ! closes the log file.
+contains
+
+subroutine typekind_error(line, file)
+ character(len=*), intent(in) :: line, file
+
+write(err_string, *) 'obs_def file has misformatted Type/Kind line'
+call error_handler(E_MSG, 'preprocess error', err_string, &
+ source, revision, revdate)
+write(err_string, *) 'line needs ! Type, Kind or ! Type, Kind, USERCODE'
+call error_handler(E_MSG, 'preprocess', err_string, source, revision, revdate)
+call error_handler(E_MSG, 'bad file:', trim(file), source, revision, revdate)
+call error_handler(E_MSG, 'bad line:', line, source, revision, revdate)
+write(err_string, *) 'See msg lines above for error details'
+call error_handler(E_ERR, 'preprocess', err_string, source, revision, revdate)
+
+end subroutine typekind_error
+
end program preprocess
More information about the Dart-dev
mailing list