Using modern Fortran practices by using error_unit when writing output that is a warning or error. The python scripts capture this as stderr output

Author: scrasmussen

scm/src/scm.F90

@@ -6,6 +6,7 @@ module scm_main
 
 subroutine scm_main_sub()
 
+  use iso_fortran_env, only: error_unit
   use scm_kinds, only: sp, dp, qp
   use scm_input
   use scm_utils
@@ -44,7 +45,7 @@ subroutine scm_main_sub()
 
   call MPI_INIT(ierr)
   if (ierr/=0) then
-      write(*,*) 'An error occurred in MPI_INIT: ', ierr
+      write(error_unit,*) 'An error occurred in MPI_INIT: ', ierr
       error stop
   end if
   fcst_mpi_comm = MPI_COMM_WORLD
@@ -59,7 +60,7 @@ subroutine scm_main_sub()
     case(1)
       call get_case_init_DEPHY(scm_state, scm_input_instance)
     case default
-      write(*,*) 'An unrecognized specification of the input_type namelist variable is being used. Exiting...'
+      write(error_unit,*) 'An unrecognized specification of the input_type namelist variable is being used. Exiting...'
       error stop
   end select
 
@@ -153,10 +154,10 @@ subroutine scm_main_sub()
 
   !check for problematic diagnostic and radiation periods
   if (mod(physics%Model%nszero,scm_state%n_itt_out) /= 0) then
-    write(*,*) "***ERROR***: The diagnostic output period must be a multiple of the output period."
-    write(*,*) "From ", adjustl(trim(scm_state%physics_nml)), ", fhzero = ",physics%Model%fhzero
-    write(*,*) "implying a diagnostic output period of ", physics%Model%nszero*scm_state%dt, "seconds."
-    write(*,*) "The given output period in the case configuration namelist is ", scm_state%output_period,"seconds."
+    write(error_unit,*) "***ERROR***: The diagnostic output period must be a multiple of the output period."
+    write(error_unit,*) "From ", adjustl(trim(scm_state%physics_nml)), ", fhzero = ",physics%Model%fhzero
+    write(error_unit,*) "implying a diagnostic output period of ", physics%Model%nszero*scm_state%dt, "seconds."
+    write(error_unit,*) "The given output period in the case configuration namelist is ", scm_state%output_period,"seconds."
     error stop
   end if
 
@@ -195,11 +196,11 @@ subroutine scm_main_sub()
 
   !initialize the column's physics
 
-  write(0,'(a,i0,a)') "Calling ccpp_physics_init with suite '" // trim(trim(adjustl(scm_state%physics_suite_name))) // "'"
+  write(*,'(a,i0,a)') "Calling ccpp_physics_init with suite '" // trim(trim(adjustl(scm_state%physics_suite_name))) // "'"
   call ccpp_physics_init(cdata, suite_name=trim(trim(adjustl(scm_state%physics_suite_name))), ierr=ierr)
-  write(0,'(a,i0,a,i0)') "Called ccpp_physics_init with suite '" // trim(trim(adjustl(scm_state%physics_suite_name))) // "', ierr=", ierr
+  write(*,'(a,i0,a,i0)') "Called ccpp_physics_init with suite '" // trim(trim(adjustl(scm_state%physics_suite_name))) // "', ierr=", ierr
   if (ierr/=0) then
-      write(*,'(a,i0,a)') 'An error occurred in ccpp_physics_init: ' // trim(cdata%errmsg) // '. Exiting...'
+      write(error_unit,'(a,i0,a)') 'An error occurred in ccpp_physics_init: ' // trim(cdata%errmsg) // '. Exiting...'
       error stop
   end if
 
@@ -289,7 +290,7 @@ subroutine scm_main_sub()
 
     call ccpp_physics_timestep_init(cdata, suite_name=trim(adjustl(scm_state%physics_suite_name)), ierr=ierr)
     if (ierr/=0) then
-        write(*,'(a,i0,a)') 'An error occurred in ccpp_physics_timestep_init: ' // trim(cdata%errmsg) // '. Exiting...'
+        write(error_unit,'(a,i0,a)') 'An error occurred in ccpp_physics_timestep_init: ' // trim(cdata%errmsg) // '. Exiting...'
         error stop
     end if
 
@@ -309,33 +310,33 @@ subroutine scm_main_sub()
     if (mod(physics%Model%kdt,physics%Model%nszero) == 1 .or. physics%Model%nszero == 1) then
       call physics%Diag%phys_zero (physics%Model)
     endif
-    
+
     !CCPP run phase
     ! time_vary group doesn't have any run phase (omitted)
     ! radiation group
     call physics%Interstitial(1)%rad_reset(physics%Model)
     call ccpp_physics_run(cdata, suite_name=trim(adjustl(scm_state%physics_suite_name)), group_name="radiation", ierr=ierr)
     if (ierr/=0) then
-        write(*,'(a,i0,a)') 'An error occurred in ccpp_physics_run for group radiation: ' // trim(cdata%errmsg) // '. Exiting...'
+        write(error_unit,'(a,i0,a)') 'An error occurred in ccpp_physics_run for group radiation: ' // trim(cdata%errmsg) // '. Exiting...'
         error stop
     end if
     ! process-split physics
     call physics%Interstitial(1)%phys_reset(physics%Model)
     call ccpp_physics_run(cdata, suite_name=trim(adjustl(scm_state%physics_suite_name)), group_name="phys_ps", ierr=ierr)
     if (ierr/=0) then
-        write(*,'(a,i0,a)') 'An error occurred in ccpp_physics_run for group phys_ps: ' // trim(cdata%errmsg) // '. Exiting...'
+        write(error_unit,'(a,i0,a)') 'An error occurred in ccpp_physics_run for group phys_ps: ' // trim(cdata%errmsg) // '. Exiting...'
         error stop
     end if
     ! time-split physics
     call ccpp_physics_run(cdata, suite_name=trim(adjustl(scm_state%physics_suite_name)), group_name="phys_ts", ierr=ierr)
     if (ierr/=0) then
-        write(*,'(a,i0,a)') 'An error occurred in ccpp_physics_run for group phys_ts: ' // trim(cdata%errmsg) // '. Exiting...'
+        write(error_unit,'(a,i0,a)') 'An error occurred in ccpp_physics_run for group phys_ts: ' // trim(cdata%errmsg) // '. Exiting...'
         error stop
     end if
 
     call ccpp_physics_timestep_finalize(cdata, suite_name=trim(adjustl(scm_state%physics_suite_name)), ierr=ierr)
     if (ierr/=0) then
-        write(*,'(a,i0,a)') 'An error occurred in ccpp_physics_timestep_finalize: ' // trim(cdata%errmsg) // '. Exiting...'
+        write(error_unit,'(a,i0,a)') 'An error occurred in ccpp_physics_timestep_finalize: ' // trim(cdata%errmsg) // '. Exiting...'
         error stop
     end if
 
@@ -447,13 +448,13 @@ subroutine scm_main_sub()
   call ccpp_physics_finalize(cdata, suite_name=trim(trim(adjustl(scm_state%physics_suite_name))), ierr=ierr)
 
   if (ierr/=0) then
-      write(*,'(a,i0,a)') 'An error occurred in ccpp_physics_finalize: ' // trim(cdata%errmsg) // '. Exiting...'
+      write(error_unit,'(a,i0,a)') 'An error occurred in ccpp_physics_finalize: ' // trim(cdata%errmsg) // '. Exiting...'
       error stop
   end if
 
   call MPI_FINALIZE(ierr)
   if (ierr/=0) then
-      write(*,*) 'An error occurred in MPI_FINALIZE: ', ierr
+      write(error_unit,*) 'An error occurred in MPI_FINALIZE: ', ierr
       error stop
   end if
 

scm/src/scm_forcing.F90

@@ -3,6 +3,7 @@
 
 module scm_forcing
 
+use iso_fortran_env, only: error_unit
 use scm_kinds, only: sp, dp, qp
 use scm_utils, only: interpolate_to_grid_centers, find_vertical_index_pressure
 
@@ -795,7 +796,7 @@ subroutine apply_forcing_leapfrog(scm_state)
 
   select case(scm_state%mom_forcing_type)
     case (1)
-      write(*,*) 'momentum forcing type = 1 is not implemented. Pick 2 or 3. Stopping...'
+      write(error_unit,*) 'momentum forcing type = 1 is not implemented. Pick 2 or 3. Stopping...'
       error stop
     case (2)
       !> - Calculate change in state momentum variables due to vertical advection (subsidence).
@@ -994,7 +995,7 @@ subroutine apply_forcing_forward_Euler(scm_state, in_spinup)
   else
     select case(scm_state%mom_forcing_type)
       case (1)
-        write(*,*) 'momentum forcing type = 1 is not implemented. Pick 2 or 3. Stopping...'
+        write(error_unit,*) 'momentum forcing type = 1 is not implemented. Pick 2 or 3. Stopping...'
         error stop
       case (2)
         !> - Calculate change in state momentum variables due to vertical advection (subsidence).

scm/src/scm_input.F90

@@ -4,6 +4,7 @@
 
 module scm_input
 
+use iso_fortran_env, only: error_unit
 use scm_kinds, only : sp, dp, qp
 use netcdf
 use scm_type_defs, only: character_length
@@ -128,15 +129,15 @@ subroutine get_config_nml(scm_state)
 
   open(unit=10, file=experiment_namelist, status='old', action='read', iostat=ioerror)
   if(ioerror /= 0) then
-    write(*,'(a,i0)') 'There was an error opening the file ' // experiment_namelist // &
+    write(error_unit,'(a,i0)') 'There was an error opening the file ' // experiment_namelist // &
                       '; error code = ', ioerror
     error stop "error opening namelist"
   else
     read(10, NML=case_config, iostat=ioerror)
   end if
 
   if(ioerror /= 0) then
-    write(*,'(a,i0)') 'There was an error reading the namelist case_config in the file '&
+    write(error_unit,'(a,i0)') 'There was an error reading the namelist case_config in the file '&
                       // experiment_namelist // '; error code = ',ioerror
     error stop "error opening namelist"
   end if
@@ -502,7 +503,7 @@ subroutine get_case_init(scm_state, scm_input)
   call NetCDF_read_var(grp_ncid, "thetail", .False., input_thetail)
   call NetCDF_read_var(grp_ncid, "temp", .False., input_temp)
   if (maxval(input_thetail) < 0 .and. maxval(input_temp) < 0) then
-    write(*,*) "One of thetail or temp variables must be present in ",trim(adjustl(scm_state%case_name))//'.nc',". Stopping..."
+    write(error_unit,*) "One of thetail or temp variables must be present in ",trim(adjustl(scm_state%case_name))//'.nc',". Stopping..."
     error stop "One of thetail or temp variables"
   end if
   call NetCDF_read_var(grp_ncid, "qt",    .True., input_qt   )
@@ -1215,8 +1216,8 @@ subroutine get_case_init_DEPHY(scm_state, scm_input)
   else if (adjustl(trim(tmpUnits)) == 'm') then
     lev_in_altitude = .true.
   else
-    write(0,'(a,i0,a)') "The variable 'lev' in the case data file had units different than 'm', 'pa', or 'Pa', but it is expected to be altitude in m or pressure in Pa. Stopping..."
-    STOP
+    write(error_unit,'(a,i0,a)') "The variable 'lev' in the case data file had units different than 'm', 'pa', or 'Pa', but it is expected to be altitude in m or pressure in Pa. Stopping..."
+    error stop
   end if
 
   !### TO BE USED IF DEPHY-SCM can be extended to include model ICs ###
@@ -2035,7 +2036,7 @@ subroutine get_case_init_DEPHY(scm_state, scm_input)
     end if !ql test
   else
     !no qv or qt
-    write(*,*) 'When reading '//trim(adjustl(scm_state%case_name))//'.nc, all of the supported moisture variables (qv, qt, rv, rt) were missing. Stopping...'
+    write(error_unit,*) 'When reading '//trim(adjustl(scm_state%case_name))//'.nc, all of the supported moisture variables (qv, qt, rv, rt) were missing. Stopping...'
     error stop "Aall of the supported moisture variables (qv, qt, rv, rt) were missing"
   end if
 
@@ -2065,7 +2066,7 @@ subroutine get_case_init_DEPHY(scm_state, scm_input)
     !since thetail is present, choose to use it, and set the alternative temperature to missing, even if it is also present in the file
     scm_input%input_temp = missing_value
   else
-    write(*,*) 'When reading '//trim(adjustl(scm_state%case_name))//'.nc, all of the supported temperature variables (temp, theta, thetal) were missing. Stopping...'
+    write(error_unit,*) 'When reading '//trim(adjustl(scm_state%case_name))//'.nc, all of the supported temperature variables (temp, theta, thetal) were missing. Stopping...'
     error stop "All of the supported temperature variables (temp, theta, thetal) were missing"
   end if
 
@@ -2134,7 +2135,7 @@ subroutine get_case_init_DEPHY(scm_state, scm_input)
 
   if (input_surfaceForcingTemp == 'ts') then
     if (maxval(input_force_ts) < 0) then
-      write(*,*) 'The global attribute surfaceForcing in '//trim(adjustl(scm_state%case_name))//'.nc indicates that the variable ts should be present, but it is missing. Stopping ...'
+      write(error_unit,*) 'The global attribute surfaceForcing in '//trim(adjustl(scm_state%case_name))//'.nc indicates that the variable ts should be present, but it is missing. Stopping ...'
       error stop "The global attribute surfaceForcing indicates that the variable ts should be present, but it is missing"
     else
       !overwrite sfc_flux_spec
@@ -2166,7 +2167,7 @@ subroutine get_case_init_DEPHY(scm_state, scm_input)
 
     !kinematic surface fluxes are specified (but may need to be converted)
     if (maxval(input_force_wpthetap(:)) < missing_value_eps) then
-      write(*,*) 'The global attribute surfaceForcing in '//trim(adjustl(scm_state%case_name))//'.nc indicates that the variable wpthetap should be present, but it is missing. Stopping ...'
+      write(error_unit,*) 'The global attribute surfaceForcing in '//trim(adjustl(scm_state%case_name))//'.nc indicates that the variable wpthetap should be present, but it is missing. Stopping ...'
       error stop "The global attribute surfaceForcing indicates that the variable wpthetap should be present, but it is missing."
     else
       !convert from theta to T
@@ -2196,7 +2197,7 @@ subroutine get_case_init_DEPHY(scm_state, scm_input)
     end if
 
     if (maxval(input_force_wpqvp(:)) < missing_value_eps .and. maxval(input_force_wpqtp(:)) < missing_value_eps) then
-      write(*,*) 'The global attribute surfaceForcing in '//trim(adjustl(scm_state%case_name))//'.nc indicates that the variable wpqvp, wpqtp, wprvp, or wprtp should be present, but all are missing. Stopping ...'
+      write(error_unit,*) 'The global attribute surfaceForcing in '//trim(adjustl(scm_state%case_name))//'.nc indicates that the variable wpqvp, wpqtp, wprvp, or wprtp should be present, but all are missing. Stopping ...'
       error stop "The global attribute surfaceForcing indicates that the variable wpqvp, wpqtp, wprvp, or wprtp should be present, but all are missing."
     else
       if (maxval(input_force_wpqvp(:)) > missing_value_eps) then !use wpqvp if available
@@ -2230,14 +2231,14 @@ subroutine get_case_init_DEPHY(scm_state, scm_input)
 
 
     if (maxval(input_force_sfc_sens_flx(:)) < missing_value_eps) then
-      write(*,*) 'The global attribute surfaceForcing in '//trim(adjustl(scm_state%case_name))//'.nc indicates that the variable sfc_sens_flx should be present, but it is missing. Stopping ...'
+      write(error_unit,*) 'The global attribute surfaceForcing in '//trim(adjustl(scm_state%case_name))//'.nc indicates that the variable sfc_sens_flx should be present, but it is missing. Stopping ...'
       error stop "The global attribute surfaceForcing in indicates that the variable sfc_sens_flx should be present, but it is missing."
     else
       scm_input%input_sh_flux_sfc = input_force_sfc_sens_flx(:)
     end if
 
     if (maxval(input_force_sfc_lat_flx(:)) < missing_value_eps) then
-      write(*,*) 'The global attribute surfaceForcing in '//trim(adjustl(scm_state%case_name))//'.nc indicates that the variable sfc_lat_flx should be present, but it is missing. Stopping ...'
+      write(error_unit,*) 'The global attribute surfaceForcing in '//trim(adjustl(scm_state%case_name))//'.nc indicates that the variable sfc_lat_flx should be present, but it is missing. Stopping ...'
       error stop "The global attribute surfaceForcing indicates that the variable sfc_lat_flx should be present, but it is missing."
     else
       scm_input%input_lh_flux_sfc = input_force_sfc_lat_flx(:)
@@ -2352,7 +2353,7 @@ subroutine get_case_init_DEPHY(scm_state, scm_input)
   else if (input_surfaceForcingWind == 'ustar') then
     !not supported
     scm_state%surface_momentum_control = 1
-    write(*,*) 'The global attribute surfaceForcingWind in '//trim(adjustl(scm_state%case_name))//'.nc indicates that surface wind is controlled by a specified time-series of ustar. This is currently not supported. Stopping ...'
+    write(error_unit,*) 'The global attribute surfaceForcingWind in '//trim(adjustl(scm_state%case_name))//'.nc indicates that surface wind is controlled by a specified time-series of ustar. This is currently not supported. Stopping ...'
     error stop "The global attribute surfaceForcingWind indicates that surface wind is controlled by a specified time-series of ustar. This is currently not supported."
   end if
 
@@ -2454,7 +2455,7 @@ subroutine get_case_init_DEPHY(scm_state, scm_input)
   if (char_rad_temp == 'adv' .or. char_rad_theta == 'adv' .or. char_rad_thetal == 'adv') then
     scm_state%force_rad_T = 4
     if (scm_state%force_adv_T == 0) then
-      write(*,*) 'The global attribute rad_temp, rad_theta, or rad_thetal in '//trim(adjustl(scm_state%case_name))//'.nc indicates that radiative forcing is included in the advection term, but there is no advection term. Stopping ...'
+      write(error_unit,*) 'The global attribute rad_temp, rad_theta, or rad_thetal in '//trim(adjustl(scm_state%case_name))//'.nc indicates that radiative forcing is included in the advection term, but there is no advection term. Stopping ...'
       error stop "The global attribute rad_temp, rad_theta, or rad_thetal indicates that radiative forcing is included in the advection term, but there is no advection term."
     end if
   else if (rad_temp > 0) then
@@ -2750,7 +2751,7 @@ subroutine get_reference_profile(scm_state, scm_reference)
     case (1)
       open(unit=1, file='McCProfiles.dat', status='old', action='read', iostat=ioerror)
       if(ioerror /= 0) then
-        write(*,*) 'There was an error opening the file McCprofiles.dat in the processed_case_input directory. &
+        write(error_unit,*) 'There was an error opening the file McCprofiles.dat in the processed_case_input directory. &
           &Error code = ',ioerror
         error stop "There was an error opening the file McCprofiles.dat in the processed_case_input directory."
       endif
@@ -2860,7 +2861,7 @@ subroutine get_tracers(tracer_names, tracer_types)
             tracer_types(i) = 0 ! temporary until SCM is configured to work with GOCART
         end do
     else
-        write(*,'(a,i0)') 'There was an error opening the file ' // FILE_NAME // &
+        write(error_unit,'(a,i0)') 'There was an error opening the file ' // FILE_NAME // &
                           '; error code = ', rc
         error stop "Error opening tracers file"
     end if

scm/src/scm_setup.F90

@@ -4,6 +4,7 @@
 
 module scm_setup
 
+use iso_fortran_env, only: error_unit
 use scm_kinds, only: sp, dp, qp
 use scm_physical_constants, only: con_hvap, con_hfus, con_cp, con_rocp, con_pi
 use scm_utils, only: interpolate_to_grid_centers
@@ -354,7 +355,7 @@ subroutine GFS_suite_setup (Model, Statein, Stateout, Sfcprop,
     if (nthreads == 1) then
       call Interstitial(1)%create(n_cols, Model)
     else
-      print *,' CCPP SCM is only set up to use one thread - shutting down'
+      write(error_unit,*) ' CCPP SCM is only set up to use one thread - shutting down'
       error stop
     end if
 
@@ -384,15 +385,15 @@ subroutine GFS_suite_setup (Model, Statein, Stateout, Sfcprop,
 
   !--- lsidea initialization
   if (Model%lsidea) then
-    print *,' LSIDEA is active but needs to be reworked for FV3 - shutting down'
+    write(error_unit,*) ' LSIDEA is active but needs to be reworked for FV3 - shutting down'
     error stop
     !--- NEED TO get the logic from the old phys/gloopb.f initialization area
   endif
 
   if(Model%do_ca)then
-    print *,'Cellular automata cannot be used when CCPP is turned on until'
-    print *,'the stochastic physics pattern generation code has been pulled'
-    print *,'out of the FV3 repository and updated with the CCPP version.'
+    write(error_unit,*) 'Cellular automata cannot be used when CCPP is turned on until'
+    write(error_unit,*) 'the stochastic physics pattern generation code has been pulled'
+    write(error_unit,*) 'out of the FV3 repository and updated with the CCPP version.'
     error stop
   endif