From eebb35054a77b6062eaa12c2de39626ccdbeb8c1 Mon Sep 17 00:00:00 2001 From: daveh150 Date: Fri, 16 Dec 2022 16:48:36 -0600 Subject: [PATCH] Adding method to check namelist in any order, tested with NAG Fortran. (#801) * Adding method to check namelist in any order. Use subroutine in ice_namelist_mod.F90 to search for namelist in ice_in. * Moved goto_nml subroutine to ice_fileunits.F90. Removed ice_namelist_mod.F90 * Cleanup indentations with tmpstr2 use * Cleanup spacing and intentation * For namelist check, remove extra continuation after making ice_abort string. Co-authored-by: Tony Craig --- cicecore/cicedyn/analysis/ice_history.F90 | 32 ++- cicecore/cicedyn/analysis/ice_history_bgc.F90 | 31 ++- .../cicedyn/analysis/ice_history_drag.F90 | 30 ++- cicecore/cicedyn/analysis/ice_history_fsd.F90 | 30 ++- .../cicedyn/analysis/ice_history_mechred.F90 | 30 ++- .../cicedyn/analysis/ice_history_pond.F90 | 36 ++- .../cicedyn/analysis/ice_history_snow.F90 | 34 ++- cicecore/cicedyn/general/ice_init.F90 | 222 +++++++++++++----- .../cicedyn/infrastructure/ice_domain.F90 | 34 ++- cicecore/shared/ice_fileunits.F90 | 53 ++++- 10 files changed, 410 insertions(+), 122 deletions(-) diff --git a/cicecore/cicedyn/analysis/ice_history.F90 b/cicecore/cicedyn/analysis/ice_history.F90 index 9ba5cf4d4..f19158f6a 100644 --- a/cicecore/cicedyn/analysis/ice_history.F90 +++ b/cicecore/cicedyn/analysis/ice_history.F90 @@ -81,6 +81,7 @@ subroutine init_hist (dt) use ice_history_fsd, only: init_hist_fsd_2D, init_hist_fsd_3Df, & init_hist_fsd_4Df, f_afsd, f_afsdn use ice_restart_shared, only: restart + use ice_fileunits, only: goto_nml real (kind=dbl_kind), intent(in) :: & dt ! time step @@ -104,7 +105,9 @@ subroutine init_hist (dt) cstr_got, cstr_gou, cstr_gov ! mask area name for t, u, v ocn grid (go) character (len=25) :: & gridstr2D, gridstr ! temporary string names - character(len=char_len) :: description + character(len=char_len) :: description + character(len=char_len_long) :: tmpstr2 ! for namelist check + character(len=char_len) :: nml_name ! text namelist name character(len=*), parameter :: subname = '(init_hist)' @@ -228,24 +231,39 @@ subroutine init_hist (dt) file=__FILE__, line=__LINE__) if (my_task == master_task) then - write(nu_diag,*) subname,' Reading icefields_nml' + nml_name = 'icefields_nml' + write(nu_diag,*) subname,' Reading ', trim(nml_name) + ! open file call get_fileunit(nu_nml) open (nu_nml, file=trim(nml_filename), status='old',iostat=nml_error) if (nml_error /= 0) then - call abort_ice(subname//'ERROR: icefields_nml open file '// & + call abort_ice(subname//'ERROR: '//trim(nml_name)//' open file '// & trim(nml_filename), & file=__FILE__, line=__LINE__) endif + ! seek to this namelist + call goto_nml(nu_nml,trim(nml_name),nml_error) + if (nml_error /= 0) then + call abort_ice(subname//'ERROR: searching for '// trim(nml_name), & + file=__FILE__, line=__LINE__) + endif + + ! read namelist nml_error = 1 do while (nml_error > 0) read(nu_nml, nml=icefields_nml,iostat=nml_error) + ! check if error + if (nml_error /= 0) then + ! backspace and re-read erroneous line + backspace(nu_nml) + read(nu_nml,fmt='(A)') tmpstr2 + call abort_ice(subname//'ERROR: ' // trim(nml_name) // ' reading ' // & + trim(tmpstr2), file=__FILE__, line=__LINE__) + endif end do - if (nml_error /= 0) then - call abort_ice(subname//'ERROR: icefields_nml reading ', & - file=__FILE__, line=__LINE__) - endif + close(nu_nml) call release_fileunit(nu_nml) endif diff --git a/cicecore/cicedyn/analysis/ice_history_bgc.F90 b/cicecore/cicedyn/analysis/ice_history_bgc.F90 index 003e76120..6974a087b 100644 --- a/cicecore/cicedyn/analysis/ice_history_bgc.F90 +++ b/cicecore/cicedyn/analysis/ice_history_bgc.F90 @@ -271,6 +271,7 @@ subroutine init_hist_bgc_2D use ice_communicate, only: my_task, master_task use ice_history_shared, only: tstr2D, tcstr, define_hist_field, & f_fsalt, f_fsalt_ai, f_sice + use ice_fileunits, only: goto_nml integer (kind=int_kind) :: n, ns integer (kind=int_kind) :: nml_error ! namelist i/o error flag @@ -283,6 +284,9 @@ subroutine init_hist_bgc_2D tr_bgc_DON, tr_bgc_Fe, tr_bgc_hum, & skl_bgc, solve_zsal, z_tracers + character(len=char_len) :: nml_name ! for namelist check + character(len=char_len_long) :: tmpstr2 ! for namelist check + character(len=*), parameter :: subname = '(init_hist_bgc_2D)' call icepack_query_parameters(skl_bgc_out=skl_bgc, & @@ -305,24 +309,39 @@ subroutine init_hist_bgc_2D !----------------------------------------------------------------- if (my_task == master_task) then - write(nu_diag,*) subname,' Reading icefields_bgc_nml' + nml_name = 'icefields_bgc_nml' + write(nu_diag,*) subname,' Reading ', trim(nml_name) + ! check if can open file call get_fileunit(nu_nml) open (nu_nml, file=trim(nml_filename), status='old',iostat=nml_error) if (nml_error /= 0) then - call abort_ice(subname//'ERROR: icefields_bgc_nml open file '// & + call abort_ice(subname//'ERROR: '//trim(nml_name)//' open file '// & trim(nml_filename), & file=__FILE__, line=__LINE__) endif + ! seek to namelist in file + call goto_nml(nu_nml,trim(nml_name),nml_error) + if (nml_error /= 0) then + call abort_ice(subname//'ERROR: searching for '// trim(nml_name), & + file=__FILE__, line=__LINE__) + endif + + ! read namelist nml_error = 1 do while (nml_error > 0) read(nu_nml, nml=icefields_bgc_nml,iostat=nml_error) + ! check if error + if (nml_error /= 0) then + ! backspace and re-read erroneous line + backspace(nu_nml) + read(nu_nml,fmt='(A)') tmpstr2 + call abort_ice(subname//'ERROR: ' // trim(nml_name) // ' reading ' // & + trim(tmpstr2), file=__FILE__, line=__LINE__) + endif end do - if (nml_error /= 0) then - call abort_ice(subname//'ERROR: icefields_bgc_nml reading ', & - file=__FILE__, line=__LINE__) - endif + close(nu_nml) call release_fileunit(nu_nml) endif diff --git a/cicecore/cicedyn/analysis/ice_history_drag.F90 b/cicecore/cicedyn/analysis/ice_history_drag.F90 index fba19b364..dd9e3cb59 100644 --- a/cicecore/cicedyn/analysis/ice_history_drag.F90 +++ b/cicecore/cicedyn/analysis/ice_history_drag.F90 @@ -64,10 +64,13 @@ subroutine init_hist_drag_2D use ice_calendar, only: nstreams use ice_communicate, only: my_task, master_task use ice_history_shared, only: tstr2D, tcstr, define_hist_field + use ice_fileunits, only: goto_nml integer (kind=int_kind) :: ns integer (kind=int_kind) :: nml_error ! namelist i/o error flag logical (kind=log_kind) :: formdrag + character(len=char_len_long) :: tmpstr2 ! for namelist check + character(len=char_len) :: nml_name ! for namelist check character(len=*), parameter :: subname = '(init_hist_drag_2D)' @@ -81,24 +84,39 @@ subroutine init_hist_drag_2D !----------------------------------------------------------------- if (my_task == master_task) then - write(nu_diag,*) subname,' Reading icefields_drag_nml' + nml_name = 'icefields_drag_nml' + write(nu_diag,*) subname,' Reading ', trim(nml_name) + ! open namelist file call get_fileunit(nu_nml) open (nu_nml, file=trim(nml_filename), status='old',iostat=nml_error) if (nml_error /= 0) then - call abort_ice(subname//'ERROR: icefields_drag_nml open file '// & + call abort_ice(subname//'ERROR: '//trim(nml_name)//' open file '// & trim(nml_filename), & file=__FILE__, line=__LINE__) endif + ! go to this namelist + call goto_nml(nu_nml,trim(nml_name),nml_error) + if (nml_error /= 0) then + call abort_ice(subname//'ERROR: searching for '// trim(nml_name), & + file=__FILE__, line=__LINE__) + endif + + ! read namelist nml_error = 1 do while (nml_error > 0) read(nu_nml, nml=icefields_drag_nml,iostat=nml_error) + ! check if error + if (nml_error /= 0) then + ! backspace and re-read erroneous line + backspace(nu_nml) + read(nu_nml,fmt='(A)') tmpstr2 + call abort_ice(subname//'ERROR: ' // trim(nml_name) // ' reading ' // & + trim(tmpstr2), file=__FILE__, line=__LINE__) + endif end do - if (nml_error /= 0) then - call abort_ice(subname//'ERROR: icefields_drag_nml reading ', & - file=__FILE__, line=__LINE__) - endif + close(nu_nml) call release_fileunit(nu_nml) endif diff --git a/cicecore/cicedyn/analysis/ice_history_fsd.F90 b/cicecore/cicedyn/analysis/ice_history_fsd.F90 index b52db4e05..610f56608 100644 --- a/cicecore/cicedyn/analysis/ice_history_fsd.F90 +++ b/cicecore/cicedyn/analysis/ice_history_fsd.F90 @@ -76,10 +76,13 @@ subroutine init_hist_fsd_2D use ice_calendar, only: nstreams use ice_communicate, only: my_task, master_task use ice_history_shared, only: tstr2D, tcstr, define_hist_field + use ice_fileunits, only: goto_nml integer (kind=int_kind) :: ns integer (kind=int_kind) :: nml_error ! namelist i/o error flag logical (kind=log_kind) :: tr_fsd, wave_spec + character (len=char_len_long) :: tmpstr2 ! test namelist + character(len=char_len) :: nml_name ! text namelist name character(len=*), parameter :: subname = '(init_hist_fsd_2D)' @@ -96,24 +99,39 @@ subroutine init_hist_fsd_2D !----------------------------------------------------------------- if (my_task == master_task) then - write(nu_diag,*) subname,' Reading icefields_fsd_nml' + nml_name = 'icefields_fsd_nml' + write(nu_diag,*) subname,' Reading ', trim(nml_name) + ! open namelist file call get_fileunit(nu_nml) open (nu_nml, file=trim(nml_filename), status='old',iostat=nml_error) if (nml_error /= 0) then - call abort_ice(subname//'ERROR: icefields_fsd_nml open file '// & + call abort_ice(subname//'ERROR: '//trim(nml_name)//' open file '// & trim(nml_filename), & file=__FILE__, line=__LINE__) endif + ! goto this namelist + call goto_nml(nu_nml,trim(nml_name),nml_error) + if (nml_error /= 0) then + call abort_ice(subname//'ERROR: searching for '// trim(nml_name), & + file=__FILE__, line=__LINE__) + endif + + ! read namelist nml_error = 1 do while (nml_error > 0) read(nu_nml, nml=icefields_fsd_nml,iostat=nml_error) + ! check if error + if (nml_error /= 0) then + ! backspace and re-read erroneous line + backspace(nu_nml) + read(nu_nml,fmt='(A)') tmpstr2 + call abort_ice(subname//'ERROR: ' // trim(nml_name) // ' reading ' // & + trim(tmpstr2), file=__FILE__, line=__LINE__) + endif end do - if (nml_error /= 0) then - call abort_ice(subname//'ERROR: icefields_fsd_nml reading ', & - file=__FILE__, line=__LINE__) - endif + close(nu_nml) call release_fileunit(nu_nml) endif diff --git a/cicecore/cicedyn/analysis/ice_history_mechred.F90 b/cicecore/cicedyn/analysis/ice_history_mechred.F90 index 98c58bc39..e0d15fcf2 100644 --- a/cicecore/cicedyn/analysis/ice_history_mechred.F90 +++ b/cicecore/cicedyn/analysis/ice_history_mechred.F90 @@ -84,11 +84,14 @@ subroutine init_hist_mechred_2D use ice_calendar, only: nstreams, histfreq use ice_communicate, only: my_task, master_task use ice_history_shared, only: tstr2D, tcstr, define_hist_field + use ice_fileunits, only: goto_nml integer (kind=int_kind) :: ns integer (kind=int_kind) :: nml_error ! namelist i/o error flag real (kind=dbl_kind) :: secday logical (kind=log_kind) :: tr_lvl + character(len=char_len_long) :: tmpstr2 ! for namelist check + character(len=char_len) :: nml_name ! for namelist check character(len=*), parameter :: subname = '(init_hist_mechred_2D)' @@ -103,24 +106,39 @@ subroutine init_hist_mechred_2D !----------------------------------------------------------------- if (my_task == master_task) then - write(nu_diag,*) subname,' Reading icefields_mechred_nml' + nml_name = 'icefields_mechred_nml' + write(nu_diag,*) subname,' Reading ', trim(nml_name) + ! open namelist file call get_fileunit(nu_nml) open (nu_nml, file=trim(nml_filename), status='old',iostat=nml_error) if (nml_error /= 0) then - call abort_ice(subname//'ERROR: icefields_mechred_nml open file '// & + call abort_ice(subname//'ERROR: '//trim(nml_name)//' open file '// & trim(nml_filename), & file=__FILE__, line=__LINE__) endif + ! goto this namelist in file + call goto_nml(nu_nml,trim(nml_name),nml_error) + if (nml_error /= 0) then + call abort_ice(subname//'ERROR: searching for '// trim(nml_name), & + file=__FILE__, line=__LINE__) + endif + + ! read namelist nml_error = 1 do while (nml_error > 0) read(nu_nml, nml=icefields_mechred_nml,iostat=nml_error) + ! check if error + if (nml_error /= 0) then + ! backspace and re-read erroneous line + backspace(nu_nml) + read(nu_nml,fmt='(A)') tmpstr2 + call abort_ice(subname//'ERROR: ' // trim(nml_name) // ' reading ' // & + trim(tmpstr2), file=__FILE__, line=__LINE__) + endif end do - if (nml_error /= 0) then - call abort_ice(subname//'ERROR: icefields_mechred_nml reading ', & - file=__FILE__, line=__LINE__) - endif + close(nu_nml) call release_fileunit(nu_nml) endif diff --git a/cicecore/cicedyn/analysis/ice_history_pond.F90 b/cicecore/cicedyn/analysis/ice_history_pond.F90 index 8818ff94e..d209e6db6 100644 --- a/cicecore/cicedyn/analysis/ice_history_pond.F90 +++ b/cicecore/cicedyn/analysis/ice_history_pond.F90 @@ -69,10 +69,13 @@ subroutine init_hist_pond_2D use ice_calendar, only: nstreams, histfreq use ice_communicate, only: my_task, master_task use ice_history_shared, only: tstr2D, tcstr, define_hist_field + use ice_fileunits, only: goto_nml integer (kind=int_kind) :: ns integer (kind=int_kind) :: nml_error ! namelist i/o error flag logical (kind=log_kind) :: tr_pond + character(len=char_len_long) :: tmpstr2 ! for namelist check + character(len=char_len) :: nml_name ! text namelist name character(len=*), parameter :: subname = '(init_hist_pond_2D)' @@ -86,24 +89,39 @@ subroutine init_hist_pond_2D !----------------------------------------------------------------- if (my_task == master_task) then - write(nu_diag,*) subname,' Reading icefields_pond_nml' + nml_name = 'icefields_pond_nml' + write(nu_diag,*) subname,' Reading ', trim(nml_name) + ! open namelist file call get_fileunit(nu_nml) open (nu_nml, file=trim(nml_filename), status='old',iostat=nml_error) if (nml_error /= 0) then - call abort_ice(subname//'ERROR: icefields_pond_nml open file '// & - trim(nml_filename), & - file=__FILE__, line=__LINE__) + call abort_ice(subname//'ERROR: '//trim(nml_name)//' open file '// & + trim(nml_filename), & + file=__FILE__, line=__LINE__) endif - + + ! goto this namelist in file + call goto_nml(nu_nml,trim(nml_name),nml_error) + if (nml_error /= 0) then + call abort_ice(subname//'ERROR: searching for '// trim(nml_name), & + file=__FILE__, line=__LINE__) + endif + + ! read namelist nml_error = 1 do while (nml_error > 0) read(nu_nml, nml=icefields_pond_nml,iostat=nml_error) + ! check if error + if (nml_error /= 0) then + ! backspace and re-read erroneous line + backspace(nu_nml) + read(nu_nml,fmt='(A)') tmpstr2 + call abort_ice(subname//'ERROR: ' // trim(nml_name) // ' reading ' // & + trim(tmpstr2), file=__FILE__, line=__LINE__) + endif end do - if (nml_error /= 0) then - call abort_ice(subname//'ERROR: icefields_pond_nml reading ', & - file=__FILE__, line=__LINE__) - endif + close(nu_nml) call release_fileunit(nu_nml) endif diff --git a/cicecore/cicedyn/analysis/ice_history_snow.F90 b/cicecore/cicedyn/analysis/ice_history_snow.F90 index 0ec4144bf..62e65b5a3 100644 --- a/cicecore/cicedyn/analysis/ice_history_snow.F90 +++ b/cicecore/cicedyn/analysis/ice_history_snow.F90 @@ -69,6 +69,7 @@ subroutine init_hist_snow_2D (dt) use ice_history_shared, only: tstr2D, tcstr, define_hist_field use ice_fileunits, only: nu_nml, nml_filename, & get_fileunit, release_fileunit + use ice_fileunits, only: goto_nml real (kind=dbl_kind), intent(in) :: & dt ! time step @@ -76,7 +77,10 @@ subroutine init_hist_snow_2D (dt) integer (kind=int_kind) :: ns integer (kind=int_kind) :: nml_error ! namelist i/o error flag real (kind=dbl_kind) :: rhofresh, secday - logical (kind=log_kind) :: tr_snow + logical (kind=log_kind) :: tr_snow + character(len=char_len_long) :: tmpstr2 ! for namelist check + character(len=char_len) :: nml_name ! for namelist check + character(len=*), parameter :: subname = '(init_hist_snow_2D)' call icepack_query_tracer_flags(tr_snow_out=tr_snow) @@ -92,26 +96,42 @@ subroutine init_hist_snow_2D (dt) !----------------------------------------------------------------- if (my_task == master_task) then - write(nu_diag,*) subname,' Reading icefields_snow_nml' + nml_name = 'icefields_snow_nml' + write(nu_diag,*) subname,' Reading ', trim(nml_name) + ! open namelist file call get_fileunit(nu_nml) open (nu_nml, file=trim(nml_filename), status='old',iostat=nml_error) if (nml_error /= 0) then - call abort_ice(subname//'ERROR: icefields_snow_nml open file '// & + call abort_ice(subname//'ERROR: '//trim(nml_name)//' open file '// & trim(nml_filename), & file=__FILE__, line=__LINE__) endif + ! goto namelist in file + call goto_nml(nu_nml,trim(nml_name),nml_error) + if (nml_error /= 0) then + call abort_ice(subname//'ERROR: searching for '// trim(nml_name), & + file=__FILE__, line=__LINE__) + endif + + ! read namelist nml_error = 1 do while (nml_error > 0) read(nu_nml, nml=icefields_snow_nml,iostat=nml_error) + ! check if error + if (nml_error /= 0) then + ! backspace and re-read erroneous line + backspace(nu_nml) + read(nu_nml,fmt='(A)') tmpstr2 + call abort_ice(subname//'ERROR: ' // trim(nml_name) // ' reading ' // & + trim(tmpstr2), file=__FILE__, line=__LINE__) + endif end do - if (nml_error /= 0) then - call abort_ice(subname//'ERROR: icefields_snow_nml reading ', & - file=__FILE__, line=__LINE__) - endif + close(nu_nml) call release_fileunit(nu_nml) + endif else ! .not. tr_snow diff --git a/cicecore/cicedyn/general/ice_init.F90 b/cicecore/cicedyn/general/ice_init.F90 index 03ebc0174..1d16d1ac2 100644 --- a/cicecore/cicedyn/general/ice_init.F90 +++ b/cicecore/cicedyn/general/ice_init.F90 @@ -124,6 +124,8 @@ subroutine input_data use ice_restoring, only: restore_ice use ice_timers, only: timer_stats use ice_memusage, only: memory_stats + use ice_fileunits, only: goto_nml + #ifdef CESMCOUPLED use shr_file_mod, only: shr_file_setIO #endif @@ -163,9 +165,11 @@ subroutine input_data integer (kind=int_kind) :: numin, numax ! unit number limits integer (kind=int_kind) :: rplvl, rptopo - real (kind=dbl_kind) :: Cf, ksno, puny, ice_ref_salinity + real (kind=dbl_kind) :: Cf, ksno, puny, ice_ref_salinity + character (len=char_len) :: abort_list - character (len=128) :: tmpstr2 + character (len=char_len) :: nml_name ! namelist name + character (len=char_len_long) :: tmpstr2 character(len=*), parameter :: subname='(input_data)' @@ -587,6 +591,7 @@ subroutine input_data if (my_task == master_task) then + ! open namelist file call get_fileunit(nu_nml) open (nu_nml, file=trim(nml_filename), status='old',iostat=nml_error) if (nml_error /= 0) then @@ -595,141 +600,228 @@ subroutine input_data file=__FILE__, line=__LINE__) endif - write(nu_diag,*) subname,' Reading setup_nml' - rewind(unit=nu_nml, iostat=nml_error) + ! read setup_nml + nml_name = 'setup_nml' + write(nu_diag,*) subname,' Reading ', trim(nml_name) + ! goto namelist in file + call goto_nml(nu_nml,trim(nml_name),nml_error) if (nml_error /= 0) then - call abort_ice(subname//'ERROR: setup_nml rewind ', & + call abort_ice(subname//'ERROR: searching for '// trim(nml_name), & file=__FILE__, line=__LINE__) endif + + ! read namelist nml_error = 1 do while (nml_error > 0) read(nu_nml, nml=setup_nml,iostat=nml_error) + ! check if error + if (nml_error /= 0) then + ! backspace and re-read erroneous line + backspace(nu_nml) + read(nu_nml,fmt='(A)') tmpstr2 + call abort_ice(subname//'ERROR: '//trim(nml_name)//' reading '// & + trim(tmpstr2), file=__FILE__, line=__LINE__) + endif end do - if (nml_error /= 0) then - call abort_ice(subname//'ERROR: setup_nml reading ', & - file=__FILE__, line=__LINE__) - endif - write(nu_diag,*) subname,' Reading grid_nml' - rewind(unit=nu_nml, iostat=nml_error) + ! read grid_nml + nml_name = 'grid_nml' + write(nu_diag,*) subname,' Reading ', trim(nml_name) + ! goto namelist in file + call goto_nml(nu_nml,trim(nml_name),nml_error) if (nml_error /= 0) then - call abort_ice(subname//'ERROR: grid_nml rewind ', & + call abort_ice(subname//'ERROR: searching for '// trim(nml_name), & file=__FILE__, line=__LINE__) endif + + ! read namelist nml_error = 1 do while (nml_error > 0) read(nu_nml, nml=grid_nml,iostat=nml_error) + ! check if error + if (nml_error /= 0) then + ! backspace and re-read erroneous line + backspace(nu_nml) + read(nu_nml,fmt='(A)') tmpstr2 + call abort_ice(subname//'ERROR: ' //trim(nml_name)//' reading '// & + trim(tmpstr2), file=__FILE__, line=__LINE__) + endif end do - if (nml_error /= 0) then - call abort_ice(subname//'ERROR: grid_nml reading ', & - file=__FILE__, line=__LINE__) - endif - write(nu_diag,*) subname,' Reading tracer_nml' - rewind(unit=nu_nml, iostat=nml_error) + ! read tracer_nml + nml_name = 'tracer_nml' + write(nu_diag,*) subname,' Reading ', trim(nml_name) + ! goto namelist in file + call goto_nml(nu_nml,trim(nml_name),nml_error) if (nml_error /= 0) then - call abort_ice(subname//'ERROR: tracer_nml rewind ', & + call abort_ice(subname//'ERROR: searching for '// trim(nml_name), & file=__FILE__, line=__LINE__) endif + + ! read namelist nml_error = 1 do while (nml_error > 0) read(nu_nml, nml=tracer_nml,iostat=nml_error) + ! check if error + if (nml_error /= 0) then + ! backspace and re-read erroneous line + backspace(nu_nml) + read(nu_nml,fmt='(A)') tmpstr2 + call abort_ice(subname//'ERROR: ' //trim(nml_name)//' reading '// & + trim(tmpstr2), file=__FILE__, line=__LINE__) + endif end do - if (nml_error /= 0) then - call abort_ice(subname//'ERROR: tracer_nml reading ', & - file=__FILE__, line=__LINE__) - endif - write(nu_diag,*) subname,' Reading thermo_nml' - rewind(unit=nu_nml, iostat=nml_error) + ! read thermo_nml + nml_name = 'thermo_nml' + write(nu_diag,*) subname,' Reading ', trim(nml_name) + ! goto namelist in file + call goto_nml(nu_nml,trim(nml_name),nml_error) if (nml_error /= 0) then - call abort_ice(subname//'ERROR: thermo_nml rewind ', & + call abort_ice(subname//'ERROR: searching for '// trim(nml_name), & file=__FILE__, line=__LINE__) endif + + ! read namelist nml_error = 1 do while (nml_error > 0) read(nu_nml, nml=thermo_nml,iostat=nml_error) + ! check if error + if (nml_error /= 0) then + ! backspace and re-read erroneous line + backspace(nu_nml) + read(nu_nml,fmt='(A)') tmpstr2 + call abort_ice(subname//'ERROR: '//trim(nml_name)//' reading '// & + trim(tmpstr2), file=__FILE__, line=__LINE__) + endif end do - if (nml_error /= 0) then - call abort_ice(subname//'ERROR: thermo_nml reading ', & - file=__FILE__, line=__LINE__) - endif - write(nu_diag,*) subname,' Reading dynamics_nml' - rewind(unit=nu_nml, iostat=nml_error) + ! read dynamics_nml + nml_name = 'dynamics_nml' + write(nu_diag,*) subname,' Reading ', trim(nml_name) + + ! goto namelist in file + call goto_nml(nu_nml,trim(nml_name),nml_error) if (nml_error /= 0) then - call abort_ice(subname//'ERROR: dynamics_nml rewind ', & + call abort_ice(subname//'ERROR: searching for '// trim(nml_name), & file=__FILE__, line=__LINE__) endif + + ! read namelist nml_error = 1 do while (nml_error > 0) read(nu_nml, nml=dynamics_nml,iostat=nml_error) + ! check if error + if (nml_error /= 0) then + ! backspace and re-read erroneous line + backspace(nu_nml) + read(nu_nml,fmt='(A)') tmpstr2 + call abort_ice(subname//'ERROR: '//trim(nml_name)//' reading '// & + trim(tmpstr2), file=__FILE__, line=__LINE__) + endif end do - if (nml_error /= 0) then - call abort_ice(subname//'ERROR: dynamics_nml reading ', & - file=__FILE__, line=__LINE__) - endif - write(nu_diag,*) subname,' Reading shortwave_nml' - rewind(unit=nu_nml, iostat=nml_error) + ! read shortwave_nml + nml_name = 'shortwave_nml' + write(nu_diag,*) subname,' Reading ', trim(nml_name) + + ! goto namelist in file + call goto_nml(nu_nml,trim(nml_name),nml_error) if (nml_error /= 0) then - call abort_ice(subname//'ERROR: shortwave_nml rewind ', & + call abort_ice(subname//'ERROR: searching for '// trim(nml_name), & file=__FILE__, line=__LINE__) endif + + ! read namelist nml_error = 1 do while (nml_error > 0) read(nu_nml, nml=shortwave_nml,iostat=nml_error) + ! check if error + if (nml_error /= 0) then + ! backspace and re-read erroneous line + backspace(nu_nml) + read(nu_nml,fmt='(A)') tmpstr2 + call abort_ice(subname//'ERROR: '//trim(nml_name)//' reading '//& + trim(tmpstr2), file=__FILE__, line=__LINE__) + endif end do - if (nml_error /= 0) then - call abort_ice(subname//'ERROR: shortwave_nml reading ', & - file=__FILE__, line=__LINE__) - endif - write(nu_diag,*) subname,' Reading ponds_nml' - rewind(unit=nu_nml, iostat=nml_error) + ! read ponds_nml + nml_name = 'ponds_nml' + write(nu_diag,*) subname,' Reading ', trim(nml_name) + + ! goto namelist in file + call goto_nml(nu_nml,trim(nml_name),nml_error) if (nml_error /= 0) then - call abort_ice(subname//'ERROR: ponds_nml rewind ', & + call abort_ice(subname//'ERROR: searching for '// trim(nml_name), & file=__FILE__, line=__LINE__) endif + + ! read namelist nml_error = 1 do while (nml_error > 0) read(nu_nml, nml=ponds_nml,iostat=nml_error) + ! check if error + if (nml_error /= 0) then + ! backspace and re-read erroneous line + backspace(nu_nml) + read(nu_nml,fmt='(A)') tmpstr2 + call abort_ice(subname//'ERROR: '//trim(nml_name)//' reading '// & + trim(tmpstr2), file=__FILE__, line=__LINE__) + endif end do - if (nml_error /= 0) then - call abort_ice(subname//'ERROR: ponds_nml reading ', & - file=__FILE__, line=__LINE__) - endif - write(nu_diag,*) subname,' Reading snow_nml' - rewind(unit=nu_nml, iostat=nml_error) + ! read snow_nml + nml_name = 'snow_nml' + write(nu_diag,*) subname,' Reading ', trim(nml_name) + + ! goto namelist in file + call goto_nml(nu_nml,trim(nml_name),nml_error) if (nml_error /= 0) then - call abort_ice(subname//'ERROR: snow_nml rewind ', & + call abort_ice(subname//'ERROR: searching for '// trim(nml_name), & file=__FILE__, line=__LINE__) endif + + ! read namelist nml_error = 1 do while (nml_error > 0) read(nu_nml, nml=snow_nml,iostat=nml_error) + ! check if error + if (nml_error /= 0) then + ! backspace and re-read erroneous line + backspace(nu_nml) + read(nu_nml,fmt='(A)') tmpstr2 + call abort_ice(subname//'ERROR: '//trim(nml_name)//' reading '// & + trim(tmpstr2), file=__FILE__, line=__LINE__) + endif end do - if (nml_error /= 0) then - call abort_ice(subname//'ERROR: snow_nml reading ', & - file=__FILE__, line=__LINE__) - endif - write(nu_diag,*) subname,' Reading forcing_nml' - rewind(unit=nu_nml, iostat=nml_error) + ! read forcing_nml + nml_name = 'forcing_nml' + write(nu_diag,*) subname,' Reading ', trim(nml_name) + + ! goto namelist in file + call goto_nml(nu_nml,trim(nml_name),nml_error) if (nml_error /= 0) then - call abort_ice(subname//'ERROR: forcing_nml rewind ', & + call abort_ice(subname//'ERROR: searching for '// trim(nml_name), & file=__FILE__, line=__LINE__) endif + + ! read namelist nml_error = 1 do while (nml_error > 0) read(nu_nml, nml=forcing_nml,iostat=nml_error) + ! check if error + if (nml_error /= 0) then + ! backspace and re-read erroneous line + backspace(nu_nml) + read(nu_nml,fmt='(A)') tmpstr2 + call abort_ice(subname//'ERROR: '// trim(nml_name)//' reading '// & + trim(tmpstr2), file=__FILE__, line=__LINE__) + endif end do - if (nml_error /= 0) then - call abort_ice(subname//'ERROR: forcing_nml reading ', & - file=__FILE__, line=__LINE__) - endif + ! done reading namelist. close(nu_nml) call release_fileunit(nu_nml) endif diff --git a/cicecore/cicedyn/infrastructure/ice_domain.F90 b/cicecore/cicedyn/infrastructure/ice_domain.F90 index 10254aa93..ff1fac723 100644 --- a/cicecore/cicedyn/infrastructure/ice_domain.F90 +++ b/cicecore/cicedyn/infrastructure/ice_domain.F90 @@ -104,7 +104,7 @@ subroutine init_domain_blocks use ice_distribution, only: processor_shape use ice_domain_size, only: ncat, nilyr, nslyr, max_blocks, & nx_global, ny_global, block_size_x, block_size_y - + use ice_fileunits, only: goto_nml !---------------------------------------------------------------------- ! ! local variables @@ -114,6 +114,9 @@ subroutine init_domain_blocks integer (int_kind) :: & nml_error ! namelist read error flag + character(len=char_len) :: nml_name ! text namelist name + character(len=char_len_long) :: tmpstr2 ! for namelist check + character(len=*), parameter :: subname = '(init_domain_blocks)' !---------------------------------------------------------------------- @@ -167,26 +170,39 @@ subroutine init_domain_blocks landblockelim = .true. ! on by default if (my_task == master_task) then - write(nu_diag,*) subname,' Reading domain_nml' - + nml_name = 'domain_nml' + write(nu_diag,*) subname,' Reading ', trim(nml_name) + call get_fileunit(nu_nml) open (nu_nml, file=trim(nml_filename), status='old',iostat=nml_error) if (nml_error /= 0) then call abort_ice(subname//'ERROR: domain_nml open file '// & - trim(nml_filename), & - file=__FILE__, line=__LINE__) + trim(nml_filename), & + file=__FILE__, line=__LINE__) endif + call goto_nml(nu_nml,trim(nml_name),nml_error) + if (nml_error /= 0) then + call abort_ice(subname//'ERROR: searching for '// trim(nml_name), & + file=__FILE__, line=__LINE__) + endif + nml_error = 1 do while (nml_error > 0) read(nu_nml, nml=domain_nml,iostat=nml_error) + ! check if error + if (nml_error /= 0) then + ! backspace and re-read erroneous line + backspace(nu_nml) + read(nu_nml,fmt='(A)') tmpstr2 + call abort_ice(subname//'ERROR: ' // trim(nml_name) // ' reading ' // & + trim(tmpstr2), file=__FILE__, line=__LINE__) + endif end do - if (nml_error /= 0) then - call abort_ice(subname//'ERROR: domain_nml reading ', & - file=__FILE__, line=__LINE__) - endif + close(nu_nml) call release_fileunit(nu_nml) + endif call broadcast_scalar(nprocs, master_task) diff --git a/cicecore/shared/ice_fileunits.F90 b/cicecore/shared/ice_fileunits.F90 index c8ca3a937..7e425e5e7 100644 --- a/cicecore/shared/ice_fileunits.F90 +++ b/cicecore/shared/ice_fileunits.F90 @@ -28,7 +28,8 @@ module ice_fileunits implicit none private public :: init_fileunits, get_fileunit, flush_fileunit, & - release_fileunit, release_all_fileunits + release_fileunit, release_all_fileunits, & + goto_nml character (len=char_len), public :: & diag_type ! 'stdout' or 'file' @@ -322,6 +323,56 @@ subroutine flush_fileunit(iunit) end subroutine flush_fileunit +!======================================================================= + +!======================================================= + + subroutine goto_nml(iunit, nml, status) + ! Search to namelist group within ice_in file. + ! for compilers that do not allow optional namelists + + ! passed variables + integer(kind=int_kind), intent(in) :: & + iunit ! namelist file unit + + character(len=*), intent(in) :: & + nml ! namelist to search for + + integer(kind=int_kind), intent(out) :: & + status ! status of subrouine + + ! local variables + character(len=char_len) :: & + file_str, & ! string in file + nml_str ! namelist string to test + + integer(kind=int_kind) :: & + i, n ! dummy integers + + + ! rewind file + rewind(iunit) + + ! define test string with ampersand + nml_str = '&' // trim(adjustl(nml)) + + ! search for the record containing the namelist group we're looking for + do + read(iunit, '(a)', iostat=status) file_str + if (status /= 0) then + exit ! e.g. end of file + else + if (index(adjustl(file_str), nml_str) == 1) then + exit ! i.e. found record we're looking for + end if + end if + end do + + ! backspace to namelist name in file + backspace(iunit) + + end subroutine goto_nml + !======================================================================= end module ice_fileunits