Skip to content

Commit

Permalink
- Update namelist implementation to allow namelist groups to be read …
Browse files Browse the repository at this point in the history 
…in any order. (#382)

- Had to remove recent implementation to write bad namelist lines.  That implementation conflicts with flexibility to read groups in any order.  This really only affects NAG because other compilers automatically read thru the namelist file to find the group while NAG does not.
  • Loading branch information
@apcraig
apcraig authored Dec 24, 2021
1 parent 5281c3e commit 19d9745
Show file tree
Hide file tree
Showing 2 changed files with 85 additions and 101 deletions.
165 changes: 77 additions & 88 deletions configuration/driver/icedrv_init.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -119,8 +119,7 @@ subroutine input_data

real (kind=real_kind) :: rpcesm, rplvl, rptopo
real (kind=dbl_kind) :: Cf, puny
character(len=char_len_long) :: tmpstr2 ! for namelist error


character(len=*), parameter :: subname='(input_data)'

!-----------------------------------------------------------------
Expand Down Expand Up @@ -294,143 +293,133 @@ subroutine input_data
! read from input file
!-----------------------------------------------------------------

open (nu_nml, file=nml_filename, status='old',iostat=nml_error)
open (nu_nml, file=trim(nml_filename), status='old',iostat=nml_error)
if (nml_error /= 0) then
write(ice_stdout,*) 'error opening namelist file '//trim(nml_filename)
call icedrv_system_abort(file=__FILE__,line=__LINE__)
call icedrv_system_abort(string=subname//'ERROR: open file '// &
trim(nml_filename), &
file=__FILE__, line=__LINE__)
endif
close(nu_nml)

print*,'Reading namelist file ',nml_filename

open (nu_nml, file=nml_filename, status='old',iostat=nml_error)
write(nu_diag,*) subname,' Reading setup_nml'
rewind(unit=nu_nml, iostat=nml_error)
if (nml_error /= 0) then
call icedrv_system_abort(string=subname//'ERROR: setup_nml rewind ', &
file=__FILE__, line=__LINE__)
endif
nml_error = 1
print*,'Reading setup_nml'
do while (nml_error > 0)
read(nu_nml, nml=setup_nml,iostat=nml_error)
if (nml_error /= 0) exit
end do
if (nml_error /= 0) then
! backspace, re-read erroneous line, then print
backspace(nu_nml)
read(nu_nml,fmt='(A)') tmpstr2
write(ice_stdout,*) 'ERROR: reading namelist ' // trim(tmpstr2)
call icedrv_system_abort(file=__FILE__,line=__LINE__)
call icedrv_system_abort(string=subname//'ERROR: setup_nml reading ', &
file=__FILE__, line=__LINE__)
endif
close(nu_nml)

open (nu_nml, file=nml_filename, status='old',iostat=nml_error)
write(nu_diag,*) subname,' Reading grid_nml'
rewind(unit=nu_nml, iostat=nml_error)
if (nml_error /= 0) then
call icedrv_system_abort(string=subname//'ERROR: grid_nml rewind ', &
file=__FILE__, line=__LINE__)
endif
nml_error = 1
print*,'Reading grid_nml'
do while (nml_error > 0)
read(nu_nml, nml=grid_nml,iostat=nml_error)
if (nml_error /= 0) exit
end do
if (nml_error /= 0) then
! backspace, re-read erroneous line, then print
backspace(nu_nml)
read(nu_nml,fmt='(A)') tmpstr2
write(ice_stdout,*) 'ERROR: reading namelist ' // trim(tmpstr2)
call icedrv_system_abort(file=__FILE__,line=__LINE__)
call icedrv_system_abort(string=subname//'ERROR: grid_nml reading ', &
file=__FILE__, line=__LINE__)
endif
close(nu_nml)

open (nu_nml, file=nml_filename, status='old',iostat=nml_error)
write(nu_diag,*) subname,' Reading thermo_nml'
rewind(unit=nu_nml, iostat=nml_error)
if (nml_error /= 0) then
call icedrv_system_abort(string=subname//'ERROR: thermo_nml rewind ', &
file=__FILE__, line=__LINE__)
endif
nml_error = 1
print*,'Reading tracer_nml'
do while (nml_error > 0)
read(nu_nml, nml=tracer_nml,iostat=nml_error)
if (nml_error /= 0) exit
read(nu_nml, nml=thermo_nml,iostat=nml_error)
end do
if (nml_error /= 0) then
! backspace, re-read erroneous line, then print
backspace(nu_nml)
read(nu_nml,fmt='(A)') tmpstr2
write(ice_stdout,*) 'ERROR: reading namelist ' // trim(tmpstr2)
call icedrv_system_abort(file=__FILE__,line=__LINE__)
call icedrv_system_abort(string=subname//'ERROR: thermo_nml reading ', &
file=__FILE__, line=__LINE__)
endif
close(nu_nml)

open (nu_nml, file=nml_filename, status='old',iostat=nml_error)
write(nu_diag,*) subname,' Reading tracer_nml'
rewind(unit=nu_nml, iostat=nml_error)
if (nml_error /= 0) then
call icedrv_system_abort(string=subname//'ERROR: tracer_nml rewind ', &
file=__FILE__, line=__LINE__)
endif
nml_error = 1
print*,'Reading thermo_nml'
do while (nml_error > 0)
read(nu_nml, nml=thermo_nml,iostat=nml_error)
if (nml_error /= 0) exit
read(nu_nml, nml=tracer_nml,iostat=nml_error)
end do
if (nml_error /= 0) then
! backspace, re-read erroneous line, then print
backspace(nu_nml)
read(nu_nml,fmt='(A)') tmpstr2
write(ice_stdout,*) 'ERROR: reading namelist ' // trim(tmpstr2)
call icedrv_system_abort(file=__FILE__,line=__LINE__)
call icedrv_system_abort(string=subname//'ERROR: tracer_nml reading ', &
file=__FILE__, line=__LINE__)
endif
close(nu_nml)

open (nu_nml, file=nml_filename, status='old',iostat=nml_error)
write(nu_diag,*) subname,' Reading shortwave_nml'
rewind(unit=nu_nml, iostat=nml_error)
if (nml_error /= 0) then
call icedrv_system_abort(string=subname//'ERROR: shortwave_nml rewind ', &
file=__FILE__, line=__LINE__)
endif
nml_error = 1
print*,'Reading shortwave_nml'
do while (nml_error > 0)
read(nu_nml, nml=shortwave_nml,iostat=nml_error)
if (nml_error /= 0) exit
end do
if (nml_error /= 0) then
! backspace, re-read erroneous line, then print
backspace(nu_nml)
read(nu_nml,fmt='(A)') tmpstr2
write(ice_stdout,*) 'ERROR: reading namelist ' // trim(tmpstr2)
call icedrv_system_abort(file=__FILE__,line=__LINE__)
call icedrv_system_abort(string=subname//'ERROR: shortwave_nml reading ', &
file=__FILE__, line=__LINE__)
endif
close(nu_nml)

open (nu_nml, file=nml_filename, status='old',iostat=nml_error)
write(nu_diag,*) subname,' Reading ponds_nml'
rewind(unit=nu_nml, iostat=nml_error)
if (nml_error /= 0) then
call icedrv_system_abort(string=subname//'ERROR: ponds_nml rewind ', &
file=__FILE__, line=__LINE__)
endif
nml_error = 1
print*,'Reading ponds_nml'
do while (nml_error > 0)
read(nu_nml, nml=ponds_nml,iostat=nml_error)
if (nml_error /= 0) exit
end do
if (nml_error /= 0) then
! backspace, re-read erroneous line, then print
backspace(nu_nml)
read(nu_nml,fmt='(A)') tmpstr2
write(ice_stdout,*) 'ERROR: reading namelist ' // trim(tmpstr2)
call icedrv_system_abort(file=__FILE__,line=__LINE__)
call icedrv_system_abort(string=subname//'ERROR: ponds_nml reading ', &
file=__FILE__, line=__LINE__)
endif
close(nu_nml)

if (tr_snow) then
open (nu_nml, file=nml_filename, status='old',iostat=nml_error)
nml_error = 1
print*,'Reading snow_nml'
do while (nml_error > 0)
read(nu_nml, nml=snow_nml,iostat=nml_error)
if (nml_error /= 0) exit
end do
if (nml_error /= 0) then
! backspace, re-read erroneous line, then print
backspace(nu_nml)
read(nu_nml,fmt='(A)') tmpstr2
write(ice_stdout,*) 'ERROR: reading namelist ' // trim(tmpstr2)
call icedrv_system_abort(file=__FILE__,line=__LINE__)
endif
close(nu_nml)
write(nu_diag,*) subname,' Reading snow_nml'
rewind(unit=nu_nml, iostat=nml_error)
if (nml_error /= 0) then
call icedrv_system_abort(string=subname//'ERROR: snow_nml rewind ', &
file=__FILE__, line=__LINE__)
endif
nml_error = 1
do while (nml_error > 0)
read(nu_nml, nml=snow_nml,iostat=nml_error)
end do
if (nml_error /= 0) then
call icedrv_system_abort(string=subname//'ERROR: snow_nml reading ', &
file=__FILE__, line=__LINE__)
endif

open (nu_nml, file=nml_filename, status='old',iostat=nml_error)
write(nu_diag,*) subname,' Reading forcing_nml'
rewind(unit=nu_nml, iostat=nml_error)
if (nml_error /= 0) then
call icedrv_system_abort(string=subname//'ERROR: forcing_nml rewind ', &
file=__FILE__, line=__LINE__)
endif
nml_error = 1
print*,'Reading forcing_nml'
do while (nml_error > 0)
read(nu_nml, nml=forcing_nml,iostat=nml_error)
if (nml_error /= 0) exit
end do
if (nml_error /= 0) then
! backspace, re-read erroneous line, then print
backspace(nu_nml)
read(nu_nml,fmt='(A)') tmpstr2
write(ice_stdout,*) 'ERROR: reading namelist ' // trim(tmpstr2)
call icedrv_system_abort(file=__FILE__,line=__LINE__)
call icedrv_system_abort(string=subname//'ERROR: forcing_nml reading ', &
file=__FILE__, line=__LINE__)
endif

close(nu_nml)

!-----------------------------------------------------------------
Expand Down
21 changes: 8 additions & 13 deletions configuration/driver/icedrv_init_column.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -796,8 +796,6 @@ subroutine init_zbgc
ntd , & ! for tracer dependency calculation
nk , & !
nt_depend

character(len=char_len_long) :: tmpstr2 ! for namelist errors

character(len=*), parameter :: subname='(init_zbgc)'

Expand Down Expand Up @@ -1008,25 +1006,22 @@ subroutine init_zbgc
! read from input file
!-----------------------------------------------------------------

write(nu_diag,*) subname,' Reading zbgc_nml'

open (nu_nml, file=trim(nml_filename), status='old',iostat=nml_error)
if (nml_error /= 0) then
print*,'error opening zbgc namelist file '//trim(nml_filename)
call icedrv_system_abort(file=__FILE__,line=__LINE__)
endif
call icedrv_system_abort(string=subname//'ERROR: zbgc_nml open file '// &
trim(nml_filename), &
file=__FILE__, line=__LINE__)
endif

nml_error = 1
print*,'Reading zbgc_nml'
do while (nml_error > 0)
read(nu_nml, nml=zbgc_nml,iostat=nml_error)
if (nml_error /= 0) exit
end do
if (nml_error /= 0) then
! backspace, re-read erroneous line, then print
backspace(nu_nml)
read(nu_nml,fmt='(A)') tmpstr2

print*,'ERROR: reading zbgc namelist ' // trim(tmpstr2)
call icedrv_system_abort(file=__FILE__,line=__LINE__)
call icedrv_system_abort(string=subname//'ERROR: zbgc_nml reading ', &
file=__FILE__, line=__LINE__)
endif
close(nu_nml)

Expand Down

0 comments on commit 19d9745

Please sign in to comment.