[Dart-dev] [4309] DART/trunk/obs_def: Make the last argument to read/ write be fform instead of fileformat
nancy at ucar.edu
nancy at ucar.edu
Wed Mar 10 13:25:42 MST 2010
Revision: 4309
Author: nancy
Date: 2010-03-10 13:25:42 -0700 (Wed, 10 Mar 2010)
Log Message:
-----------
Make the last argument to read/write be fform instead of fileformat
to match updated DEFAULT_obs_def_mod.F90, and use ascii_file_format()
routine from the utilities_mod to have a consistent treatment of
formatted vs unformatted i/o.
Modified Paths:
--------------
DART/trunk/obs_def/obs_def_TES_nadir_mod.f90
DART/trunk/obs_def/obs_def_gps_mod.f90
DART/trunk/obs_def/obs_def_ocean_mod.f90
-------------- next part --------------
Modified: DART/trunk/obs_def/obs_def_TES_nadir_mod.f90
===================================================================
--- DART/trunk/obs_def/obs_def_TES_nadir_mod.f90 2010-03-10 20:22:22 UTC (rev 4308)
+++ DART/trunk/obs_def/obs_def_TES_nadir_mod.f90 2010-03-10 20:25:42 UTC (rev 4309)
@@ -24,13 +24,13 @@
! BEGIN DART PREPROCESS READ_OBS_DEF
! case(TES_NADIR_OBS)
-! call read_TES_nadir_obs(obs_def%key, ifile, fileformat)
+! call read_TES_nadir_obs(obs_def%key, ifile, fform)
! END DART PREPROCESS READ_OBS_DEF
! BEGIN DART PREPROCESS WRITE_OBS_DEF
! case(TES_NADIR_OBS)
-! call write_TES_nadir_obs(obs_def%key, ifile, fileformat)
+! call write_TES_nadir_obs(obs_def%key, ifile, fform)
! END DART PREPROCESS WRITE_OBS_DEF
@@ -53,7 +53,8 @@
use utilities_mod, only : register_module, error_handler, E_ERR, E_WARN, E_MSG, &
check_namelist_read, find_namelist_in_file, &
logfileunit, nmlfileunit, do_output, file_exist, &
- open_file, close_file, get_unit, do_nml_file, do_nml_term
+ open_file, close_file, get_unit, do_nml_file, do_nml_term, &
+ ascii_file_format
use location_mod, only : location_type, set_location, get_location, &
vert_is_undef, vert_is_surface, &
vert_is_level, vert_is_pressure, vert_is_height, &
@@ -479,32 +480,25 @@
integer, intent(in) :: teskey, ifile
character(len=*), intent(in), optional :: fform
-character(len=32) :: fileformat
integer :: i
if ( .not. module_initialized ) call initialize_module
-fileformat = "ascii" ! supply default
-if(present(fform)) fileformat = trim(adjustl(fform))
-
! write out obs_seq info
-SELECT CASE ( fileformat )
-
- CASE( "unf", "UNF", "unformatted", "UNFORMATTED" ) ! binary stuff
- write(ifile) teskey
- write(ifile) TES_data(teskey)%scan_length, &
+if (ascii_file_format(fform)) then
+ write(ifile,98) teskey
+ write(ifile, *) TES_data(teskey)%scan_length, &
TES_data(teskey)%wavenumber, &
TES_data(teskey)%emission_angle, &
TES_data(teskey)%l_sub_s
- continue
+else
+ write(ifile) teskey
+ write(ifile) TES_data(teskey)%scan_length, &
+ TES_data(teskey)%wavenumber, &
+ TES_data(teskey)%emission_angle, &
+ TES_data(teskey)%l_sub_s
+endif
- CASE default
- write(ifile,98) teskey
- write(ifile, *) TES_data(teskey)%scan_length, &
- TES_data(teskey)%wavenumber, &
- TES_data(teskey)%emission_angle, &
- TES_data(teskey)%l_sub_s
-END SELECT
98 format('TES_nadir_obs', i8)
end subroutine write_TES_nadir_obs
@@ -525,30 +519,22 @@
integer :: scan_length
real(r8) :: wavenumber, emission_angle, l_sub_s
character(len=13) :: header
-character(len=32) :: fileformat
if ( .not. module_initialized ) call initialize_module
-fileformat = "ascii" ! supply default
-if(present(fform)) fileformat = trim(adjustl(fform))
+if (ascii_file_format(fform)) then
+ read(ifile, fmt='(a13, i8)') header, keyin ! throw away keyin
+ if(header /= 'TES_nadir_obs') then
+ write(errstring,*)'Expected header "TES_nadir_obs" in input file'
+ call error_handler(E_ERR,'read_TES_nadir_obs',errstring, &
+ source, revision, revdate)
+ end if
+ read(ifile,*) scan_length, wavenumber, emission_angle, l_sub_s
+else
+ read(ifile) keyin ! read and throw away
+ read(ifile) scan_length, wavenumber, emission_angle, l_sub_s
+endif
-SELECT CASE ( fileformat )
-
- CASE( "unf", "UNF", "unformatted", "UNFORMATTED" ) ! binary stuff
- read(ifile) keyin ! read and throw away
- read(ifile) scan_length, wavenumber, emission_angle, l_sub_s
-
- CASE default
- read(ifile, fmt='(a13, i8)') header, keyin ! throw away keyin
- if(header /= 'TES_nadir_obs') then
- write(errstring,*)'Expected header "TES_nadir_obs" in input file'
- call error_handler(E_ERR,'read_TES_nadir_obs',errstring, &
- source, revision, revdate)
- end if
- read(ifile,*) scan_length, wavenumber, emission_angle, l_sub_s
-
-END SELECT
-
! increment key and set all private data for this observation
call set_TES_nadir(teskey, scan_length, wavenumber, emission_angle, l_sub_s)
Modified: DART/trunk/obs_def/obs_def_gps_mod.f90
===================================================================
--- DART/trunk/obs_def/obs_def_gps_mod.f90 2010-03-10 20:22:22 UTC (rev 4308)
+++ DART/trunk/obs_def/obs_def_gps_mod.f90 2010-03-10 20:25:42 UTC (rev 4309)
@@ -31,13 +31,13 @@
! BEGIN DART PREPROCESS READ_OBS_DEF
! case(GPSRO_REFRACTIVITY)
-! call read_gpsro_ref(obs_def%key, ifile, fileformat)
+! call read_gpsro_ref(obs_def%key, ifile, fform)
! END DART PREPROCESS READ_OBS_DEF
! BEGIN DART PREPROCESS WRITE_OBS_DEF
! case(GPSRO_REFRACTIVITY)
-! call write_gpsro_ref(obs_def%key, ifile, fileformat)
+! call write_gpsro_ref(obs_def%key, ifile, fform)
! END DART PREPROCESS WRITE_OBS_DEF
@@ -60,7 +60,8 @@
use utilities_mod, only : register_module, error_handler, E_ERR, E_MSG, &
file_exist, open_file, close_file, nmlfileunit, &
check_namelist_read, find_namelist_in_file, &
- do_output, do_nml_file, do_nml_term
+ do_output, do_nml_file, do_nml_term, &
+ ascii_file_format
use location_mod, only : location_type, set_location, get_location, &
write_location, read_location, vert_is_height, &
VERTISHEIGHT
@@ -231,34 +232,25 @@
integer, intent(in) :: gpskey, ifile
character(len=*), intent(in), optional :: fform
-character(len=32) :: fileformat
if ( .not. module_initialized ) call initialize_module
-fileformat = "ascii" ! supply default
-if(present(fform)) fileformat = trim(adjustl(fform))
-
! Write the 5 character identifier for verbose formatted output
! Write out the obs_def key for this observation
-SELECT CASE (fileformat)
-
- CASE ("unf", "UNF", "unformatted", "UNFORMATTED")
- write(ifile) gpskey
- write(ifile) gps_data(gpskey)%rfict, gps_data(gpskey)%step_size, &
- gps_data(gpskey)%ray_top, &
- (gps_data(gpskey)%ray_direction(ii), ii=1, 3), &
- gps_data(gpskey)%gpsro_ref_form
- continue
-
-
- CASE DEFAULT
- write(ifile,11) gpskey
- write(ifile, *) gps_data(gpskey)%rfict, gps_data(gpskey)%step_size, &
- gps_data(gpskey)%ray_top, &
- (gps_data(gpskey)%ray_direction(ii), ii=1, 3), &
- gps_data(gpskey)%gpsro_ref_form
-END SELECT
+if (ascii_file_format(fform)) then
+ write(ifile,11) gpskey
+ write(ifile, *) gps_data(gpskey)%rfict, gps_data(gpskey)%step_size, &
+ gps_data(gpskey)%ray_top, &
+ (gps_data(gpskey)%ray_direction(ii), ii=1, 3), &
+ gps_data(gpskey)%gpsro_ref_form
11 format('gpsroref', i8)
+else
+ write(ifile) gpskey
+ write(ifile) gps_data(gpskey)%rfict, gps_data(gpskey)%step_size, &
+ gps_data(gpskey)%ray_top, &
+ (gps_data(gpskey)%ray_direction(ii), ii=1, 3), &
+ gps_data(gpskey)%gpsro_ref_form
+endif
end subroutine write_gpsro_ref
@@ -282,31 +274,22 @@
real(r8) :: nx, ny, nz, rfict0, ds, htop
character(len=6) :: subset0
character(len=8) :: header
-character(len=32) :: fileformat
if ( .not. module_initialized ) call initialize_module
-fileformat = "ascii" ! supply default
-if(present(fform)) fileformat = trim(adjustl(fform))
+if (ascii_file_format(fform)) then
+ read(ifile, FMT='(a8, i8)') header, keyin ! throw away keyin
+ if(header /= 'gpsroref') then
+ call error_handler(E_ERR,'read_gpsro_ref', &
+ 'Expected header "gpsroref" in input file', source, revision, revdate)
+ endif
+ read(ifile, *) rfict0, ds, htop, nx, ny, nz, subset0
+else
+ read(ifile) keyin ! read and throw away
+ read(ifile) rfict0, ds, htop, nx, ny, nz, subset0
+endif
-! Read the character identifier for verbose formatted output
-SELECT CASE (fileformat)
- CASE ("unf", "UNF", "unformatted", "UNFORMATTED")
- read(ifile) keyin ! read and throw away
- read(ifile) rfict0, ds, htop, nx, ny, nz, subset0
-
- CASE DEFAULT
- read(ifile, FMT='(a8, i8)') header, keyin ! throw away keyin
- if(header /= 'gpsroref') then
- call error_handler(E_ERR,'read_gpsro_ref', &
- 'Expected header "gpsroref" in input file', source, revision, revdate)
- endif
- read(ifile, *) rfict0, ds, htop, nx, ny, nz, subset0
-
-END SELECT
-
-
! increment key and set all private data for this observation
call set_gpsro_ref(gpskey, nx, ny, nz, rfict0, ds, htop, subset0)
Modified: DART/trunk/obs_def/obs_def_ocean_mod.f90
===================================================================
--- DART/trunk/obs_def/obs_def_ocean_mod.f90 2010-03-10 20:22:22 UTC (rev 4308)
+++ DART/trunk/obs_def/obs_def_ocean_mod.f90 2010-03-10 20:25:42 UTC (rev 4309)
@@ -97,14 +97,14 @@
!-----------------------------------------------------------------------------
! BEGIN DART PREPROCESS READ_OBS_DEF
! case(CODAR_RADIAL_VELOCITY)
-! call read_radial_vel(obs_def%key, ifile, fileformat)
+! call read_radial_vel(obs_def%key, ifile, fform)
! END DART PREPROCESS READ_OBS_DEF
!-----------------------------------------------------------------------------
!-----------------------------------------------------------------------------
! BEGIN DART PREPROCESS WRITE_OBS_DEF
! case(CODAR_RADIAL_VELOCITY)
-! call write_radial_vel(obs_def%key, ifile, fileformat)
+! call write_radial_vel(obs_def%key, ifile, fform)
! END DART PREPROCESS WRITE_OBS_DEF
!-----------------------------------------------------------------------------
@@ -128,7 +128,8 @@
use types_mod, only : r8, missing_r8, PI, deg2rad
use utilities_mod, only : register_module, error_handler, E_ERR, E_MSG, &
check_namelist_read, find_namelist_in_file, &
- nmlfileunit, do_output, do_nml_file, do_nml_term
+ nmlfileunit, do_output, do_nml_file, do_nml_term, &
+ ascii_file_format
use location_mod, only : location_type, write_location, read_location, &
interactive_location, get_location
use assim_model_mod, only : interpolate
@@ -252,13 +253,13 @@
is_asciifile = ascii_file_format(fform)
if (is_asciifile) then
- ! Read the character identifier for verbose formatted output
- read(ifile, FMT="(a5)") header
- if(header /= 'CODAR') then
- call error_handler(E_ERR,'read_radial_vel', &
- "Expected header 'CODAR' in input file", &
- source, revision, revdate)
- endif
+ ! Read the character identifier for verbose formatted output
+ read(ifile, FMT="(a5)") header
+ if(header /= 'CODAR') then
+ call error_handler(E_ERR,'read_radial_vel', &
+ "Expected header 'CODAR' in input file", &
+ source, revision, revdate)
+ endif
endif
! read_location is a DART library routine that expects an optional string
@@ -670,36 +671,6 @@
!----------------------------------------------------------------------
-function ascii_file_format(fform)
-
-! Common routine for determining input file format.
-
-character(len=*), intent(in), optional :: fform
-logical :: ascii_file_format
-
-! Returns .true. if file is formatted/ascii, .false. if unformatted/binary
-! Defaults (if fform not specified) to formatted/ascii.
-
-if ( .not. module_initialized ) call initialize_module
-
-! Default to formatted/ascii.
-if ( .not. present(fform)) then
- ascii_file_format = .true.
- return
-endif
-
-SELECT CASE (trim(adjustl(fform)))
- CASE("unf", "UNF", "unformatted", "UNFORMATTED")
- ascii_file_format = .false.
- CASE DEFAULT
- ascii_file_format = .true.
-END SELECT
-
-
-end function ascii_file_format
-
-!----------------------------------------------------------------------
-
subroutine velkey_out_of_range(velkey)
! Range check velkey and trigger a fatal error if larger than allocated array.
More information about the Dart-dev
mailing list