diff --git a/src/ALE/MOM_remapping.F90 b/src/ALE/MOM_remapping.F90 index 6255a6fce8..65cf5b9d55 100644 --- a/src/ALE/MOM_remapping.F90 +++ b/src/ALE/MOM_remapping.F90 @@ -14,6 +14,8 @@ module MOM_remapping use PPM_functions, only : PPM_reconstruction, PPM_boundary_extrapolation use PQM_functions, only : PQM_reconstruction, PQM_boundary_extrapolation_v1 +use iso_fortran_env, only : stdout=>output_unit, stderr=>error_unit + implicit none ; private #include @@ -1899,12 +1901,13 @@ logical function test_answer(verbose, n, u, u_true, label, tol) if (abs(u(k) - u_true(k)) > tolerance) test_answer = .true. enddo if (test_answer .or. verbose) then - write(*,'(a4,2a24,x,a)') 'k','Calculated value','Correct value',label + write(stdout,'(a4,2a24,x,a)') 'k','Calculated value','Correct value',label do k = 1, n if (abs(u(k) - u_true(k)) > tolerance) then - write(*,'(i4,1p2e24.16,a,1pe24.16,a)') k,u(k),u_true(k),' err=',u(k)-u_true(k),' < wrong' + write(stdout,'(i4,1p2e24.16,a,1pe24.16,a)') k,u(k),u_true(k),' err=',u(k)-u_true(k),' < wrong' + write(stderr,'(i4,1p2e24.16,a,1pe24.16,a)') k,u(k),u_true(k),' err=',u(k)-u_true(k),' < wrong' else - write(*,'(i4,1p2e24.16)') k,u(k),u_true(k) + write(stdout,'(i4,1p2e24.16)') k,u(k),u_true(k) endif enddo endif @@ -1918,11 +1921,11 @@ subroutine dumpGrid(n,h,x,u) real, dimension(:), intent(in) :: x !< Interface delta real, dimension(:), intent(in) :: u !< Cell average values integer :: i - write(*,'("i=",20i10)') (i,i=1,n+1) - write(*,'("x=",20es10.2)') (x(i),i=1,n+1) - write(*,'("i=",5x,20i10)') (i,i=1,n) - write(*,'("h=",5x,20es10.2)') (h(i),i=1,n) - write(*,'("u=",5x,20es10.2)') (u(i),i=1,n) + write(stdout,'("i=",20i10)') (i,i=1,n+1) + write(stdout,'("x=",20es10.2)') (x(i),i=1,n+1) + write(stdout,'("i=",5x,20i10)') (i,i=1,n) + write(stdout,'("h=",5x,20es10.2)') (h(i),i=1,n) + write(stdout,'("u=",5x,20es10.2)') (u(i),i=1,n) end subroutine dumpGrid end module MOM_remapping diff --git a/src/framework/MOM_diag_vkernels.F90 b/src/framework/MOM_diag_vkernels.F90 index 1b8fb58b6d..b7c1130521 100644 --- a/src/framework/MOM_diag_vkernels.F90 +++ b/src/framework/MOM_diag_vkernels.F90 @@ -4,6 +4,8 @@ module MOM_diag_vkernels ! This file is part of MOM6. See LICENSE.md for the license. +use iso_fortran_env, only : stdout=>output_unit, stderr=>error_unit + implicit none ; private public diag_vkernels_unit_tests @@ -173,8 +175,8 @@ logical function diag_vkernels_unit_tests(verbose) v = verbose - write(0,*) '==== MOM_diag_kernels: diag_vkernels_unit_tests ==========' - if (v) write(0,*) '- - - - - - - - - - interpolation tests - - - - - - - - -' + write(stdout,*) '==== MOM_diag_kernels: diag_vkernels_unit_tests ==========' + if (v) write(stdout,*) '- - - - - - - - - - interpolation tests - - - - - - - - -' fail = test_interp(v,mv,'Identity: 3 layer', & 3, (/1.,2.,3./), (/1.,2.,3.,4./), & @@ -221,7 +223,7 @@ logical function diag_vkernels_unit_tests(verbose) 4, (/0.,2.,6.,0./), (/mv,1.,3.,8.,mv/) ) diag_vkernels_unit_tests = diag_vkernels_unit_tests .or. fail - if (v) write(0,*) '- - - - - - - - - - reintegration tests - - - - - - - - -' + if (v) write(stdout,*) '- - - - - - - - - - reintegration tests - - - - - - - - -' fail = test_reintegrate(v,mv,'Identity: 3 layer', & 3, (/1.,2.,3./), (/-5.,2.,1./), & @@ -273,7 +275,7 @@ logical function diag_vkernels_unit_tests(verbose) 3, (/0.,0.,0./), (/mv, mv, mv/) ) diag_vkernels_unit_tests = diag_vkernels_unit_tests .or. fail - if (.not. fail) write(*,*) 'Pass' + if (.not. fail) write(stdout,*) 'Pass' end function diag_vkernels_unit_tests @@ -302,14 +304,15 @@ logical function test_interp(verbose, missing_value, msg, nsrc, h_src, u_src, nd if (u_dest(k)/=u_true(k)) test_interp = .true. enddo if (verbose .or. test_interp) then - write(0,'(2a)') ' Test: ',msg - write(0,'(a3,3(a24))') 'k','u_result','u_true','error' + write(stdout,'(2a)') ' Test: ',msg + write(stdout,'(a3,3(a24))') 'k','u_result','u_true','error' do k=1,ndest+1 error = u_dest(k)-u_true(k) if (error==0.) then - write(0,'(i3,3(1pe24.16))') k,u_dest(k),u_true(k),u_dest(k)-u_true(k) + write(stdout,'(i3,3(1pe24.16))') k,u_dest(k),u_true(k),u_dest(k)-u_true(k) else - write(0,'(i3,3(1pe24.16),x,a)') k,u_dest(k),u_true(k),u_dest(k)-u_true(k),'<--- WRONG!' + write(stdout,'(i3,3(1pe24.16),x,a)') k,u_dest(k),u_true(k),u_dest(k)-u_true(k),'<--- WRONG!' + write(stderr,'(i3,3(1pe24.16),x,a)') k,u_dest(k),u_true(k),u_dest(k)-u_true(k),'<--- WRONG!' endif enddo endif @@ -340,14 +343,15 @@ logical function test_reintegrate(verbose, missing_value, msg, nsrc, h_src, uh_s if (uh_dest(k)/=uh_true(k)) test_reintegrate = .true. enddo if (verbose .or. test_reintegrate) then - write(0,'(2a)') ' Test: ',msg - write(0,'(a3,3(a24))') 'k','uh_result','uh_true','error' + write(stdout,'(2a)') ' Test: ',msg + write(stdout,'(a3,3(a24))') 'k','uh_result','uh_true','error' do k=1,ndest error = uh_dest(k)-uh_true(k) if (error==0.) then - write(0,'(i3,3(1pe24.16))') k,uh_dest(k),uh_true(k),uh_dest(k)-uh_true(k) + write(stdout,'(i3,3(1pe24.16))') k,uh_dest(k),uh_true(k),uh_dest(k)-uh_true(k) else - write(0,'(i3,3(1pe24.16),x,a)') k,uh_dest(k),uh_true(k),uh_dest(k)-uh_true(k),'<--- WRONG!' + write(stdout,'(i3,3(1pe24.16),x,a)') k,uh_dest(k),uh_true(k),uh_dest(k)-uh_true(k),'<--- WRONG!' + write(stderr,'(i3,3(1pe24.16),x,a)') k,uh_dest(k),uh_true(k),uh_dest(k)-uh_true(k),'<--- WRONG!' endif enddo endif diff --git a/src/framework/MOM_random.F90 b/src/framework/MOM_random.F90 index 6e254abed2..c37893012e 100644 --- a/src/framework/MOM_random.F90 +++ b/src/framework/MOM_random.F90 @@ -11,6 +11,8 @@ module MOM_random use MersenneTwister_mod, only : getRandomReal ! Generates a random number use MersenneTwister_mod, only : getRandomPositiveInt ! Generates a random positive integer +use iso_fortran_env, only : stdout=>output_unit, stderr=>error_unit + implicit none ; private public :: random_0d_constructor @@ -205,7 +207,7 @@ logical function random_unit_tests(verbose) HI%jdg_offset = 0 random_unit_tests = .false. - stdunit = 6 + stdunit = stdout write(stdunit,'(1x,a)') '==== MOM_random: random_unit_tests =======================' if (verbose) write(stdunit,'(1x,"random: ",a)') '-- Time-based seeds ---------------------' @@ -417,15 +419,17 @@ logical function test_fn(verbose, good, label, rvalue, ivalue) if (present(ivalue)) then if (.not. good) then - write(0,'(1x,a,i10,1x,a,a)') 'random: result =',ivalue,label,' <------- FAIL!' + write(stdout,'(1x,a,i10,1x,a,a)') 'random: result =',ivalue,label,' <------- FAIL!' + write(stderr,'(1x,a,i10,1x,a,a)') 'random: result =',ivalue,label,' <------- FAIL!' elseif (verbose) then - write(6,'(1x,a,i10,1x,a)') 'random: result =',ivalue,label + write(stdout,'(1x,a,i10,1x,a)') 'random: result =',ivalue,label endif else if (.not. good) then - write(0,'(1x,a,1pe15.8,1x,a,a)') 'random: result =',rvalue,label,' <------- FAIL!' + write(stdout,'(1x,a,1pe15.8,1x,a,a)') 'random: result =',rvalue,label,' <------- FAIL!' + write(stderr,'(1x,a,1pe15.8,1x,a,a)') 'random: result =',rvalue,label,' <------- FAIL!' elseif (verbose) then - write(6,'(1x,a,1pe15.8,1x,a)') 'random: result =',rvalue,label + write(stdout,'(1x,a,1pe15.8,1x,a)') 'random: result =',rvalue,label endif endif test_fn = .not. good diff --git a/src/framework/MOM_string_functions.F90 b/src/framework/MOM_string_functions.F90 index 0a4058995a..1293499930 100644 --- a/src/framework/MOM_string_functions.F90 +++ b/src/framework/MOM_string_functions.F90 @@ -3,6 +3,8 @@ module MOM_string_functions ! This file is part of MOM6. See LICENSE.md for the license. +use iso_fortran_env, only : stdout=>output_unit, stderr=>error_unit + implicit none ; private public lowercase, uppercase @@ -319,7 +321,7 @@ logical function string_functions_unit_tests(verbose) logical :: fail, v fail = .false. v = verbose - write(*,*) '==== MOM_string_functions: string_functions_unit_tests ===' + write(stdout,*) '==== MOM_string_functions: string_functions_unit_tests ===' fail = fail .or. localTestS(v,left_int(-1),'-1') fail = fail .or. localTestS(v,left_ints(i(:)),'-1, 1, 3, 3, 0') fail = fail .or. localTestS(v,left_real(0.),'0.0') @@ -349,7 +351,7 @@ logical function string_functions_unit_tests(verbose) fail = fail .or. localTestR(v,extract_real("1.,2.",",",2),2.) fail = fail .or. localTestR(v,extract_real("1.,2.",",",3),0.) fail = fail .or. localTestR(v,extract_real("1.,2.",",",4,4.),4.) - if (.not. fail) write(*,*) 'Pass' + if (.not. fail) write(stdout,*) 'Pass' string_functions_unit_tests = fail end function string_functions_unit_tests @@ -361,8 +363,11 @@ logical function localTestS(verbose,str1,str2) localTestS=.false. if (trim(str1)/=trim(str2)) localTestS=.true. if (localTestS .or. verbose) then - write(*,*) '>'//trim(str1)//'<' - if (localTestS) write(*,*) trim(str1),':',trim(str2), '<-- FAIL' + write(stdout,*) '>'//trim(str1)//'<' + if (localTestS) then + write(stdout,*) trim(str1),':',trim(str2), '<-- FAIL' + write(stderr,*) trim(str1),':',trim(str2), '<-- FAIL' + endif endif end function localTestS @@ -374,8 +379,11 @@ logical function localTestI(verbose,i1,i2) localTestI=.false. if (i1/=i2) localTestI=.true. if (localTestI .or. verbose) then - write(*,*) i1,i2 - if (localTestI) write(*,*) i1,'!=',i2, '<-- FAIL' + write(stdout,*) i1,i2 + if (localTestI) then + write(stdout,*) i1,'!=',i2, '<-- FAIL' + write(stderr,*) i1,'!=',i2, '<-- FAIL' + endif endif end function localTestI @@ -387,8 +395,11 @@ logical function localTestR(verbose,r1,r2) localTestR=.false. if (r1/=r2) localTestR=.true. if (localTestR .or. verbose) then - write(*,*) r1,r2 - if (localTestR) write(*,*) r1,'!=',r2, '<-- FAIL' + write(stdout,*) r1,r2 + if (localTestR) then + write(stdout,*) r1,'!=',r2, '<-- FAIL' + write(stderr,*) r1,'!=',r2, '<-- FAIL' + endif endif end function localTestR diff --git a/src/tracer/MOM_lateral_boundary_diffusion.F90 b/src/tracer/MOM_lateral_boundary_diffusion.F90 index 82e0d6a559..443b9108d2 100644 --- a/src/tracer/MOM_lateral_boundary_diffusion.F90 +++ b/src/tracer/MOM_lateral_boundary_diffusion.F90 @@ -24,6 +24,8 @@ module MOM_lateral_boundary_diffusion use MOM_energetic_PBL, only : energetic_PBL_get_MLD, energetic_PBL_CS use MOM_diabatic_driver, only : diabatic_CS, extract_diabatic_member +use iso_fortran_env, only : stdout=>output_unit, stderr=>error_unit + implicit none ; private public near_boundary_unit_tests, lateral_boundary_diffusion, lateral_boundary_diffusion_init @@ -987,14 +989,18 @@ logical function test_layer_fluxes(verbose, nk, test_name, F_calc, F_ans) real, dimension(nk), intent(in) :: F_ans !< Fluxes of the unitless tracer calculated by hand [s^-1] ! Local variables integer :: k - integer, parameter :: stdunit = 6 + integer, parameter :: stdunit = stdout test_layer_fluxes = .false. do k=1,nk if ( F_calc(k) /= F_ans(k) ) then test_layer_fluxes = .true. - write(stdunit,*) "UNIT TEST FAILED: ", test_name + write(stdunit,*) "MOM_lateral_boundary_diffusion, UNIT TEST FAILED: ", test_name write(stdunit,10) k, F_calc(k), F_ans(k) + ! ### Once these unit tests are passing, and failures are caught properly, + ! we will post failure notifications to both stdout and stderr. + !write(stderr,*) "MOM_lateral_boundary_diffusion, UNIT TEST FAILED: ", test_name + !write(stderr,10) k, F_calc(k), F_ans(k) elseif (verbose) then write(stdunit,10) k, F_calc(k), F_ans(k) endif @@ -1017,7 +1023,7 @@ logical function test_boundary_k_range(k_top, zeta_top, k_bot, zeta_bot, k_top_a character(len=80) :: test_name !< Name of the unit test logical :: verbose !< If true always print output - integer, parameter :: stdunit = 6 + integer, parameter :: stdunit = stdout test_boundary_k_range = k_top .ne. k_top_ans test_boundary_k_range = test_boundary_k_range .or. (zeta_top .ne. zeta_top_ans) diff --git a/src/tracer/MOM_neutral_diffusion.F90 b/src/tracer/MOM_neutral_diffusion.F90 index 64d5e134d7..6a109b7cba 100644 --- a/src/tracer/MOM_neutral_diffusion.F90 +++ b/src/tracer/MOM_neutral_diffusion.F90 @@ -28,6 +28,9 @@ module MOM_neutral_diffusion use MOM_energetic_PBL, only : energetic_PBL_get_MLD, energetic_PBL_CS use MOM_diabatic_driver, only : diabatic_CS, extract_diabatic_member use MOM_lateral_boundary_diffusion, only : boundary_k_range, SURFACE, BOTTOM + +use iso_fortran_env, only : stdout=>output_unit, stderr=>error_unit + implicit none ; private #include @@ -1125,9 +1128,10 @@ real function interpolate_for_nondim_position(dRhoNeg, Pneg, dRhoPos, Ppos) if (Ppos < Pneg) then call MOM_error(FATAL, 'interpolate_for_nondim_position: Houston, we have a problem! PposdRhoPos) then + write(stderr,*) 'dRhoNeg, Pneg, dRhoPos, Ppos=',dRhoNeg, Pneg, dRhoPos, Ppos write(mesg,*) 'dRhoNeg, Pneg, dRhoPos, Ppos=', dRhoNeg, Pneg, dRhoPos, Ppos call MOM_error(WARNING, 'interpolate_for_nondim_position: '//trim(mesg)) - elseif (dRhoNeg>dRhoPos) then !### Does this test belong here? + elseif (dRhoNeg>dRhoPos) then !### Does this duplicated test belong here? call MOM_error(FATAL, 'interpolate_for_nondim_position: Houston, we have a problem! dRhoNeg>dRhoPos') endif if (Ppos<=Pneg) then ! Handle vanished or inverted layers @@ -1282,8 +1286,9 @@ subroutine find_neutral_surface_positions_discontinuous(CS, US, nk, & Tr(kl_right, ki_right), Sr(kl_right, ki_right), Pres_r(kl_right,ki_right), & Tl(kl_left, ki_left), Sl(kl_left, ki_left) , Pres_l(kl_left,ki_left), & dRho) - if (CS%debug) write(*,'(A,I2,A,E12.4,A,I2,A,I2,A,I2,A,I2)') "k_surface=",k_surface," dRho=",US%R_to_kg_m3*dRho, & - "kl_left=",kl_left, " ki_left=",ki_left," kl_right=",kl_right, " ki_right=",ki_right + if (CS%debug) write(stdout,'(A,I2,A,E12.4,A,I2,A,I2,A,I2,A,I2)') & + "k_surface=",k_surface, " dRho=",US%R_to_kg_m3*dRho, & + "kl_left=",kl_left, " ki_left=",ki_left, " kl_right=",kl_right, " ki_right=",ki_right ! Which column has the lighter surface for the current indexes, kr and kl if (.not. reached_bottom) then if (dRho < 0.) then @@ -1314,11 +1319,11 @@ subroutine find_neutral_surface_positions_discontinuous(CS, US, nk, & KoL(k_surface) = kl_left if (CS%debug) then - write(*,'(A,I2)') "Searching left layer ", kl_left - write(*,'(A,I2,X,I2)') "Searching from right: ", kl_right, ki_right - write(*,*) "Temp/Salt Reference: ", Tr(kl_right,ki_right), Sr(kl_right,ki_right) - write(*,*) "Temp/Salt Top L: ", Tl(kl_left,1), Sl(kl_left,1) - write(*,*) "Temp/Salt Bot L: ", Tl(kl_left,2), Sl(kl_left,2) + write(stdout,'(A,I2)') "Searching left layer ", kl_left + write(stdout,'(A,I2,X,I2)') "Searching from right: ", kl_right, ki_right + write(stdout,*) "Temp/Salt Reference: ", Tr(kl_right,ki_right), Sr(kl_right,ki_right) + write(stdout,*) "Temp/Salt Top L: ", Tl(kl_left,1), Sl(kl_left,1) + write(stdout,*) "Temp/Salt Bot L: ", Tl(kl_left,2), Sl(kl_left,2) endif call increment_interface(nk, kl_right, ki_right, reached_bottom, searching_right_column, searching_left_column) lastP_left = PoL(k_surface) @@ -1337,11 +1342,11 @@ subroutine find_neutral_surface_positions_discontinuous(CS, US, nk, & KoR(k_surface) = kl_right if (CS%debug) then - write(*,'(A,I2)') "Searching right layer ", kl_right - write(*,'(A,I2,X,I2)') "Searching from left: ", kl_left, ki_left - write(*,*) "Temp/Salt Reference: ", Tl(kl_left,ki_left), Sl(kl_left,ki_left) - write(*,*) "Temp/Salt Top L: ", Tr(kl_right,1), Sr(kl_right,1) - write(*,*) "Temp/Salt Bot L: ", Tr(kl_right,2), Sr(kl_right,2) + write(stdout,'(A,I2)') "Searching right layer ", kl_right + write(stdout,'(A,I2,X,I2)') "Searching from left: ", kl_left, ki_left + write(stdout,*) "Temp/Salt Reference: ", Tl(kl_left,ki_left), Sl(kl_left,ki_left) + write(stdout,*) "Temp/Salt Top L: ", Tr(kl_right,1), Sr(kl_right,1) + write(stdout,*) "Temp/Salt Bot L: ", Tr(kl_right,2), Sr(kl_right,2) endif call increment_interface(nk, kl_left, ki_left, reached_bottom, searching_left_column, searching_right_column) lastP_right = PoR(k_surface) @@ -1350,7 +1355,7 @@ subroutine find_neutral_surface_positions_discontinuous(CS, US, nk, & else stop 'Else what?' endif - if (CS%debug) write(*,'(A,I3,A,ES16.6,A,I2,A,ES16.6)') "KoL:", KoL(k_surface), " PoL:", PoL(k_surface), & + if (CS%debug) write(stdout,'(A,I3,A,ES16.6,A,I2,A,ES16.6)') "KoL:", KoL(k_surface), " PoL:", PoL(k_surface), & " KoR:", KoR(k_surface), " PoR:", PoR(k_surface) endif ! Effective thickness @@ -2060,7 +2065,6 @@ logical function neutral_diffusion_unit_tests(verbose) neutral_diffusion_unit_tests = .false. .or. & ndiff_unit_tests_continuous(verbose) .or. ndiff_unit_tests_discontinuous(verbose) - end function neutral_diffusion_unit_tests !> Returns true if unit tests of neutral_diffusion functions fail. Otherwise returns false. @@ -2085,7 +2089,7 @@ logical function ndiff_unit_tests_continuous(verbose) v = verbose ndiff_unit_tests_continuous = .false. ! Normally return false - write(*,*) '==== MOM_neutral_diffusion: ndiff_unit_tests_continuous =' + write(stdout,*) '==== MOM_neutral_diffusion: ndiff_unit_tests_continuous =' ndiff_unit_tests_continuous = ndiff_unit_tests_continuous .or. & test_fv_diff(v,1.,1.,1., 0.,1.,2., 1., 'FV: Straight line on uniform grid') @@ -2325,7 +2329,7 @@ logical function ndiff_unit_tests_continuous(verbose) (/0.,0.,0.,0.,0.,6.,0./), & ! hEff 'Two unstable mixed layers') - if (.not. ndiff_unit_tests_continuous) write(*,*) 'Pass' + if (.not. ndiff_unit_tests_continuous) write(stdout,*) 'Pass' end function ndiff_unit_tests_continuous @@ -2359,7 +2363,7 @@ logical function ndiff_unit_tests_discontinuous(verbose) v = verbose ndiff_unit_tests_discontinuous = .false. ! Normally return false - write(*,*) '==== MOM_neutral_diffusion: ndiff_unit_tests_discontinuous =' + write(stdout,*) '==== MOM_neutral_diffusion: ndiff_unit_tests_discontinuous =' ! Unit tests for find_neutral_surface_positions_discontinuous ! Salinity is 0 for all these tests @@ -2582,7 +2586,7 @@ logical function ndiff_unit_tests_discontinuous(verbose) find_neutral_pos_linear(CS, 0., 10., 35., 0., 0.8, & 0., 1.0, 0., 0.5, & (/12.,0./), (/34.,2./)), "Salt stratified Linearized Alpha/Beta")) - if (.not. ndiff_unit_tests_discontinuous) write(*,*) 'Pass' + if (.not. ndiff_unit_tests_discontinuous) write(stdout,*) 'Pass' deallocate(US) @@ -2608,8 +2612,8 @@ logical function test_fv_diff(verbose, hkm1, hk, hkp1, Skm1, Sk, Skp1, Ptrue, ti test_fv_diff = (Pret /= Ptrue) if (test_fv_diff .or. verbose) then - stdunit = 6 - if (test_fv_diff) stdunit = 0 ! In case of wrong results, write to error stream + stdunit = stdout + if (test_fv_diff) stdunit = stderr ! In case of wrong results, write to error stream write(stdunit,'(a)') title if (test_fv_diff) then write(stdunit,'(2(x,a,f20.16),x,a)') 'pRet=',Pret,'pTrue=',Ptrue,'WRONG!' @@ -2640,8 +2644,8 @@ logical function test_fvlsq_slope(verbose, hkm1, hk, hkp1, Skm1, Sk, Skp1, Ptrue test_fvlsq_slope = (Pret /= Ptrue) if (test_fvlsq_slope .or. verbose) then - stdunit = 6 - if (test_fvlsq_slope) stdunit = 0 ! In case of wrong results, write to error stream + stdunit = stdout + if (test_fvlsq_slope) stdunit = stderr ! In case of wrong results, write to error stream write(stdunit,'(a)') title if (test_fvlsq_slope) then write(stdunit,'(2(x,a,f20.16),x,a)') 'pRet=',Pret,'pTrue=',Ptrue,'WRONG!' @@ -2670,8 +2674,8 @@ logical function test_ifndp(verbose, rhoNeg, Pneg, rhoPos, Ppos, Ptrue, title) test_ifndp = (Pret /= Ptrue) if (test_ifndp .or. verbose) then - stdunit = 6 - if (test_ifndp) stdunit = 0 ! In case of wrong results, write to error stream + stdunit = stdout + if (test_ifndp) stdunit = stderr ! In case of wrong results, write to error stream write(stdunit,'(a)') title if (test_ifndp) then write(stdunit,'(4(x,a,f20.16),2(x,a,1pe22.15),x,a)') & @@ -2701,8 +2705,8 @@ logical function test_data1d(verbose, nk, Po, Ptrue, title) enddo if (test_data1d .or. verbose) then - stdunit = 6 - if (test_data1d) stdunit = 0 ! In case of wrong results, write to error stream + stdunit = stdout + if (test_data1d) stdunit = stderr ! In case of wrong results, write to error stream write(stdunit,'(a)') title do k = 1,nk if (Po(k) /= Ptrue(k)) then @@ -2736,8 +2740,8 @@ logical function test_data1di(verbose, nk, Po, Ptrue, title) enddo if (test_data1di .or. verbose) then - stdunit = 6 - if (test_data1di) stdunit = 0 ! In case of wrong results, write to error stream + stdunit = stdout + if (test_data1di) stdunit = stderr ! In case of wrong results, write to error stream write(stdunit,'(a)') title do k = 1,nk if (Po(k) /= Ptrue(k)) then @@ -2782,8 +2786,8 @@ logical function test_nsp(verbose, ns, KoL, KoR, pL, pR, hEff, KoL0, KoR0, pL0, enddo if (test_nsp .or. verbose) then - stdunit = 6 - if (test_nsp) stdunit = 0 ! In case of wrong results, write to error stream + stdunit = stdout + if (test_nsp) stdunit = stderr ! In case of wrong results, write to error stream write(stdunit,'(a)') title do k = 1,ns this_row_failed = compare_nsp_row(KoL(k), KoR(k), pL(k), pR(k), KoL0(k), KoR0(k), pL0(k), pR0(k)) @@ -2831,7 +2835,9 @@ logical function test_rnp(expected_pos, test_pos, title) real, intent(in) :: test_pos !< The position returned by the code character(len=*), intent(in) :: title !< A label for this test ! Local variables - integer :: stdunit = 6 ! Output to standard error + integer :: stdunit + + stdunit = stdout ! Output to standard error test_rnp = ABS(expected_pos - test_pos) > 2*EPSILON(test_pos) if (test_rnp) then write(stdunit,'(A, f20.16, " .neq. ", f20.16, " <-- WRONG")') title, expected_pos, test_pos