diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index 5a05694fef..1622ae9886 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -60,7 +60,7 @@ gnu:ocean-only-nolibs: - time tar zxf $CACHE_DIR/tests_$CI_PIPELINE_ID.tgz && cd tests - make -f MRS/Makefile.build build/gnu/env && cd build/gnu # mkdir -p build/gnu/repro/symmetric_dynamic/ocean_only && cd build/gnu/repro/symmetric_dynamic/ocean_only - - ../../MOM6-examples/src/mkmf/bin/list_paths -l ../../../config_src/{solo_driver,dynamic_symmetric} ../../../src ../../MOM6-examples/src/FMS + - ../../MOM6-examples/src/mkmf/bin/list_paths -l ../../../config_src/{solo_driver,dynamic_symmetric,ext*} ../../../src ../../MOM6-examples/src/FMS - sed -i '/FMS\/.*\/test_/d' path_names - ../../MOM6-examples/src/mkmf/bin/mkmf -t ../../MOM6-examples/src/mkmf/templates/ncrc-gnu.mk -p MOM6 -c"-Duse_libMPI -Duse_netCDF" path_names - time (source ./env ; make NETCDF=3 REPRO=1 MOM6 -s -j) @@ -73,7 +73,7 @@ gnu:ice-ocean-nolibs: - time tar zxf $CACHE_DIR/tests_$CI_PIPELINE_ID.tgz && cd tests - make -f MRS/Makefile.build build/gnu/env && cd build/gnu # mkdir -p build/gnu/repro/symmetric_dynamic/ocean_only && cd build/gnu/repro/symmetric_dynamic/ocean_only - - ../../MOM6-examples/src/mkmf/bin/list_paths -l ../../../config_src/{coupled_driver,dynamic} ../../../src ../../MOM6-examples/src/{FMS,coupler,SIS2,icebergs,ice_param,land_null,atmos_null} + - ../../MOM6-examples/src/mkmf/bin/list_paths -l ../../../config_src/{coupled_driver,dynamic,ext*} ../../../src ../../MOM6-examples/src/{FMS,coupler,SIS2,icebergs,ice_param,land_null,atmos_null} - sed -i '/FMS\/.*\/test_/d' path_names - ../../MOM6-examples/src/mkmf/bin/mkmf -t ../../MOM6-examples/src/mkmf/templates/ncrc-gnu.mk -p MOM6 -c"-Duse_libMPI -Duse_netCDF -D_USE_LEGACY_LAND_ -Duse_AM3_physics" path_names - time (source ./env ; make NETCDF=3 REPRO=1 MOM6 -s -j) @@ -116,7 +116,7 @@ run: - time tar zxf $CACHE_DIR/build-intel-repro-$CI_PIPELINE_ID.tgz - time tar zxf $CACHE_DIR/build-pgi-repro-$CI_PIPELINE_ID.tgz # time tar zxf $CACHE_DIR/build-gnu-debug-$CI_PIPELINE_ID.tgz - - (echo '#!/bin/tcsh';echo 'make -f MRS/Makefile.tests all -B') > job.sh + - (echo '#!/bin/tcsh';echo 'make -f MRS/Makefile.tests all') > job.sh - sbatch --clusters=c3,c4 --nodes=29 --time=0:34:00 --account=gfdl_o --qos=debug --job-name=mom6_regressions --output=log.$CI_PIPELINE_ID --wait job.sh - cat log.$CI_PIPELINE_ID - test -f restart_results_gnu.tar.gz diff --git a/.gitmodules b/.gitmodules index b499e43096..637f1188ed 100644 --- a/.gitmodules +++ b/.gitmodules @@ -4,9 +4,3 @@ [submodule "pkg/GSW-Fortran"] path = pkg/GSW-Fortran url = https://github.com/TEOS-10/GSW-Fortran.git -[submodule "pkg/MOM6_DA_hooks"] - path = pkg/MOM6_DA_hooks - url = https://github.com/MJHarrison-GFDL/MOM6_DA_hooks.git -[submodule "pkg/geoKdTree"] - path = pkg/geoKdTree - url = https://github.com/travissluka/geoKdTree.git diff --git a/.testing/Makefile b/.testing/Makefile index d38189667b..bc03358649 100644 --- a/.testing/Makefile +++ b/.testing/Makefile @@ -20,7 +20,7 @@ MKMF := $(abspath $(DEPS)/mkmf/bin/mkmf) # FMS framework FMS_URL ?= https://github.com/NOAA-GFDL/FMS.git -FMS_COMMIT ?= 2019.01.01 +FMS_COMMIT ?= 2019.01.02 FMS := $(DEPS)/fms #--- @@ -85,9 +85,11 @@ endif SOURCE = \ $(foreach ext,F90 inc c h,$(wildcard $(1)/*/*.$(ext) $(1)/*/*/*.$(ext))) -MOM_SOURCE = $(call SOURCE,../src) $(wildcard ../config_src/solo_driver/*.F90) +MOM_SOURCE = $(call SOURCE,../src) $(wildcard ../config_src/solo_driver/*.F90) \ + $(wildcard ../config_src/ext*/*/*.F90) TARGET_SOURCE = $(call SOURCE,build/target_codebase/src) \ - $(wildcard build/target_codebase/config_src/solo_driver/*.F90) + $(wildcard build/target_codebase/config_src/solo_driver/*.F90) \ + $(wildcard build/target_codebase/config_src/ext*/*.F90) FMS_SOURCE = $(call SOURCE,$(DEPS)/fms/src) #--- @@ -114,7 +116,7 @@ build/asymmetric/path_names: GRID_SRC=config_src/dynamic build/%/path_names: GRID_SRC=config_src/dynamic_symmetric build/%/MOM6: build/%/Makefile $(FMS)/lib/libfms.a - make -C $(@D) $(MOMFLAGS) $(@F) + $(MAKE) -C $(@D) $(MOMFLAGS) $(@F) build/%/Makefile: build/%/path_names cp $(MKMF_TEMPLATE) $(@D) @@ -133,6 +135,7 @@ build/target/path_names: $(LIST_PATHS) $(TARGET_CODEBASE) $(TARGET_SOURCE) cd $(@D) && $(LIST_PATHS) -l \ ../../$(TARGET_CODEBASE)/src \ ../../$(TARGET_CODEBASE)/config_src/solo_driver \ + ../../$(TARGET_CODEBASE)/config_src/ext* \ ../../$(TARGET_CODEBASE)/$(GRID_SRC) build/%/path_names: $(LIST_PATHS) $(MOM_SOURCE) @@ -140,6 +143,7 @@ build/%/path_names: $(LIST_PATHS) $(MOM_SOURCE) cd $(@D) && $(LIST_PATHS) -l \ ../../../src \ ../../../config_src/solo_driver \ + ../../../config_src/ext* \ ../../../$(GRID_SRC) # Target repository for regression tests @@ -153,7 +157,7 @@ $(TARGET_CODEBASE): $(FMS)/lib/libfms.a: $(FMS)/build/Makefile mkdir -p $(FMS)/lib - cd $(FMS)/build && make NETCDF=3 DEBUG=1 ../lib/libfms.a + cd $(FMS)/build && $(MAKE) NETCDF=3 DEBUG=1 ../lib/libfms.a $(FMS)/build/Makefile: $(FMS)/build/path_names cp $(MKMF_TEMPLATE) $(@D) @@ -250,8 +254,6 @@ $(eval $(call CMP_RULE,regression,symmetric target)) # Restart tests only compare the final stat record .PRECIOUS: $(foreach b,symmetric restart target,work/%/$(b)/ocean.stats) %.restart: $(foreach b,symmetric restart,work/%/$(b)/ocean.stats) - #cmp $(foreach f,$^,<(tr -s ' ' < $(f) | cut -d ' ' -f3- | tail -n 1)) \ - # || diff $^ @cmp $(foreach f,$^,<(tr -s ' ' < $(f) | cut -d ' ' -f3- | tail -n 1)) \ || !( \ mkdir -p results/$*; \ @@ -266,18 +268,6 @@ $(eval $(call CMP_RULE,regression,symmetric target)) #--- # Test run output files -# Generalized MPI environment variable support -# XXX: Using `-env` in the MPICH test can erroneously producing an `nv` file. -# $(1): Environment variables -ifeq ($(shell $(MPIRUN) -x tmp=1 true 2> /dev/null ; echo $$?), 0) - MPIRUN_CMD=$(MPIRUN) $(if $(1),-x $(1),) -else ifeq ($(shell $(MPIRUN) -env tmp=1 true 2> /dev/null ; echo $$?), 0) - MPIRUN_CMD=$(MPIRUN) $(if $(1),-env $(1),) -else - MPIRUN_CMD=$(1) $(MPIRUN) -endif - - # Rule to build work//{ocean.stats,chksum_diag}. # $(1): Test configuration name # $(2): Executable type @@ -291,24 +281,24 @@ work/%/$(1)/ocean.stats work/%/$(1)/chksum_diag: build/$(2)/MOM6 if [ $(3) ]; then find build/$(2) -name *.gcda -exec rm -f '{}' \; ; fi mkdir -p $$(@D) cp -rL $$*/* $$(@D) - cd $$(@D) && if [ -f Makefile ]; then make; fi + cd $$(@D) && if [ -f Makefile ]; then $(MAKE); fi mkdir -p $$(@D)/RESTART echo -e "$(4)" > $$(@D)/MOM_override cd $$(@D) \ - && $$(call MPIRUN_CMD,$(5)) -n $(6) ../../../$$< 2> std.err > std.out \ + && $(5) $(MPIRUN) -n $(6) ../../../$$< 2> std.err > std.out \ || !( \ mkdir -p ../../../results/$$*/ ; \ - cat std.out | tee ../../../results/$$*/std.$(1).out | tail ; \ - cat std.err | tee ../../../results/$$*/std.$(1).err | tail ; \ - rm ocean.stats chksum_diag ; \ - echo -e "${FAIL}: $$*.$(1) failed at runtime." \ + cat std.out | tee ../../../results/$$*/std.$(1).out | tail -20 ; \ + cat std.err | tee ../../../results/$$*/std.$(1).err | tail -20 ; \ + rm ocean.stats chksum_diag ; \ + echo -e "${FAIL}: $$*.$(1) failed at runtime." \ ) @echo -e "${DONE}: $$*.$(1); no runtime errors." if [ $(3) ]; then \ mkdir -p results/$$* ; \ bash <(curl -s https://codecov.io/bash) -n $$@ \ > work/$$*/codecov.$(1).out \ - 2> work/$$*/codecov.$(1).err ; \ + 2> work/$$*/codecov.$(1).err ; \ fi endef @@ -320,7 +310,7 @@ $(eval $(call STAT_RULE,symmetric,symmetric,$(REPORT_COVERAGE),,,1)) $(eval $(call STAT_RULE,asymmetric,asymmetric,,,,1)) $(eval $(call STAT_RULE,target,target,,,,1)) $(eval $(call STAT_RULE,repro,repro,,,,1)) -$(eval $(call STAT_RULE,openmp,openmp,,,,1)) +$(eval $(call STAT_RULE,openmp,openmp,,,GOMP_CPU_AFFINITY=0,1)) $(eval $(call STAT_RULE,layout,symmetric,,LAYOUT=2$(,)1,,2)) $(eval $(call STAT_RULE,rotate,symmetric,,ROTATE_INDEX=True\nINDEX_TURNS=1,,1)) $(eval $(call STAT_RULE,nan,symmetric,,,MALLOC_PERTURB_=256,1)) @@ -337,7 +327,7 @@ work/%/restart/ocean.stats: build/symmetric/MOM6 rm -rf $(@D) mkdir -p $(@D) cp -rL $*/* $(@D) - cd work/$*/restart && if [ -f Makefile ]; then make; fi + cd work/$*/restart && if [ -f Makefile ]; then $(MAKE); fi mkdir -p $(@D)/RESTART # Generate the half-period input namelist # TODO: Assumes that runtime set by DAYMAX, will fail if set by input.nml @@ -352,8 +342,8 @@ work/%/restart/ocean.stats: build/symmetric/MOM6 cd $(@D) && $(MPIRUN) -n 1 ../../../$< 2> std1.err > std1.out \ || !( \ cat std1.out | tee ../../../results/$*/std.restart1.out | tail ; \ - cat std1.err | tee ../../../results/$*/std.restart1.err | tail ; \ - echo -e "${FAIL}: $*.restart failed at runtime." \ + cat std1.err | tee ../../../results/$*/std.restart1.err | tail ; \ + echo -e "${FAIL}: $*.restart failed at runtime." \ ) # Setup the next inputs cd $(@D) && rm -rf INPUT && mv RESTART INPUT @@ -363,8 +353,8 @@ work/%/restart/ocean.stats: build/symmetric/MOM6 cd $(@D) && $(MPIRUN) -n 1 ../../../$< 2> std2.err > std2.out \ || !( \ cat std2.out | tee ../../../results/$*/std.restart2.out | tail ; \ - cat std2.err | tee ../../../results/$*/std.restart2.err | tail ; \ - echo -e "${FAIL}: $*.restart failed at runtime." \ + cat std2.err | tee ../../../results/$*/std.restart2.err | tail ; \ + echo -e "${FAIL}: $*.restart failed at runtime." \ ) # TODO: Restart checksum diagnostics diff --git a/.testing/README.md b/.testing/README.md index 5cd190ef25..abad08ada8 100644 --- a/.testing/README.md +++ b/.testing/README.md @@ -217,3 +217,10 @@ use `srun` (such as on GFDL's gaea HPC): ``` make MPIRUN=srun test ``` + +For convenience you can provide some macro in the file `config.mk`. For example, on +gaea, to be able to run `make test -s -j` you will find putting the line +``` +MPIRUN = srun -mblock --exclusive +``` +in `config.mk` very useful. diff --git a/.testing/tc4/Makefile b/.testing/tc4/Makefile index cea78bf3bd..c332bbd7e6 100644 --- a/.testing/tc4/Makefile +++ b/.testing/tc4/Makefile @@ -1,3 +1,3 @@ -all: +ocean_hgrid.nc topog.nc temp_salt_ic.nc sponge.nc: python build_grid.py python build_data.py diff --git a/config_src/coupled_driver/MOM_surface_forcing_gfdl.F90 b/config_src/coupled_driver/MOM_surface_forcing_gfdl.F90 index 7d2814da93..a04ee426e6 100644 --- a/config_src/coupled_driver/MOM_surface_forcing_gfdl.F90 +++ b/config_src/coupled_driver/MOM_surface_forcing_gfdl.F90 @@ -16,7 +16,7 @@ module MOM_surface_forcing_gfdl use MOM_domains, only : AGRID, BGRID_NE, CGRID_NE, To_All use MOM_domains, only : To_North, To_East, Omit_Corners use MOM_error_handler, only : MOM_error, WARNING, FATAL, is_root_pe, MOM_mesg -use MOM_file_parser, only : get_param, log_version, param_file_type +use MOM_file_parser, only : get_param, log_param, log_version, param_file_type use MOM_forcing_type, only : forcing, mech_forcing use MOM_forcing_type, only : forcing_diags, mech_forcing_diags, register_forcing_type_diags use MOM_forcing_type, only : allocate_forcing_type, deallocate_forcing_type @@ -1231,7 +1231,7 @@ subroutine forcing_save_restart(CS, G, Time, directory, time_stamped, & end subroutine forcing_save_restart !> Initialize the surface forcing, including setting parameters and allocating permanent memory. -subroutine surface_forcing_init(Time, G, US, param_file, diag, CS) +subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, wind_stagger) type(time_type), intent(in) :: Time !< The current model time type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type @@ -1240,6 +1240,8 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS) !! diagnostic output type(surface_forcing_CS), pointer :: CS !< A pointer that is set to point to the control !! structure for this module + integer, optional, intent(in) :: wind_stagger !< If present, the staggering of the winds that are + !! being provided in calls to update_ocean_model ! Local variables real :: utide ! The RMS tidal velocity [Z T-1 ~> m s-1]. @@ -1272,7 +1274,7 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS) call write_version_number(version) ! Read all relevant parameters and write them to the model log. - call log_version(param_file, mdl, version, "") + call log_version(param_file, mdl, version, "", log_to_all=.true., debugging=.true.) call get_param(param_file, mdl, "INPUTDIR", CS%inputdir, & "The directory in which all input files are found.", & @@ -1347,15 +1349,28 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS) "the ocean dynamics. The actual net mass source may differ "//& "due to internal corrections.", default=.false.) - call get_param(param_file, mdl, "WIND_STAGGER", stagger, & - "A case-insensitive character string to indicate the "//& - "staggering of the input wind stress field. Valid "//& - "values are 'A', 'B', or 'C'.", default="C") - if (uppercase(stagger(1:1)) == 'A') then ; CS%wind_stagger = AGRID - elseif (uppercase(stagger(1:1)) == 'B') then ; CS%wind_stagger = BGRID_NE - elseif (uppercase(stagger(1:1)) == 'C') then ; CS%wind_stagger = CGRID_NE - else ; call MOM_error(FATAL,"surface_forcing_init: WIND_STAGGER = "// & - trim(stagger)//" is invalid.") ; endif + if (present(wind_stagger)) then + if (wind_stagger == AGRID) then ; stagger = 'AGRID' + elseif (wind_stagger == BGRID_NE) then ; stagger = 'BGRID_NE' + elseif (wind_stagger == CGRID_NE) then ; stagger = 'CGRID_NE' + else ; stagger = 'UNKNOWN' ; call MOM_error(FATAL,"surface_forcing_init: WIND_STAGGER = "// & + trim(stagger)// "is invalid."); endif + call log_param(param_file, mdl, "WIND_STAGGER", stagger, & + "The staggering of the input wind stress field "//& + "from the coupler that is actually used.") + CS%wind_stagger = wind_stagger + else + call get_param(param_file, mdl, "WIND_STAGGER", stagger, & + "A case-insensitive character string to indicate the "//& + "staggering of the input wind stress field. Valid "//& + "values are 'A', 'B', or 'C'.", default="C") + if (uppercase(stagger(1:1)) == 'A') then ; CS%wind_stagger = AGRID + elseif (uppercase(stagger(1:1)) == 'B') then ; CS%wind_stagger = BGRID_NE + elseif (uppercase(stagger(1:1)) == 'C') then ; CS%wind_stagger = CGRID_NE + else ; call MOM_error(FATAL,"surface_forcing_init: WIND_STAGGER = "// & + trim(stagger)//" is invalid.") ; endif + endif + call get_param(param_file, mdl, "WIND_STRESS_MULTIPLIER", CS%wind_stress_multiplier, & "A factor multiplying the wind-stress given to the ocean by the "//& "coupler. This is used for testing and should be =1.0 for any "//& diff --git a/config_src/coupled_driver/ocean_model_MOM.F90 b/config_src/coupled_driver/ocean_model_MOM.F90 index 05759cb7b8..082099158c 100644 --- a/config_src/coupled_driver/ocean_model_MOM.F90 +++ b/config_src/coupled_driver/ocean_model_MOM.F90 @@ -77,6 +77,8 @@ module ocean_model_mod public ice_ocn_bnd_type_chksum public ocean_public_type_chksum public ocean_model_data_get +public get_ocean_grid +public ocean_model_get_UV_surf !> This interface extracts a named scalar field or array from the ocean surface or public type interface ocean_model_data_get @@ -222,7 +224,7 @@ module ocean_model_mod !! This subroutine initializes both the ocean state and the ocean surface type. !! Because of the way that indicies and domains are handled, Ocean_sfc must have !! been used in a previous call to initialize_ocean_type. -subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn) +subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, wind_stagger, gas_fields_ocn) type(ocean_public_type), target, & intent(inout) :: Ocean_sfc !< A structure containing various publicly !! visible ocean surface properties after initialization, @@ -232,6 +234,8 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn) !! contain all information about the ocean's interior state. type(time_type), intent(in) :: Time_init !< The start time for the coupled model's calendar type(time_type), intent(in) :: Time_in !< The time at which to initialize the ocean model. + integer, optional, intent(in) :: wind_stagger !< If present, the staggering of the winds that are + !! being provided in calls to update_ocean_model type(coupler_1d_bc_type), & optional, intent(in) :: gas_fields_ocn !< If present, this type describes the !! ocean and surface-ice fields that will participate @@ -354,8 +358,13 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn) call allocate_surface_state(OS%sfc_state, OS%grid, use_temperature, do_integrals=.true., & gas_fields_ocn=gas_fields_ocn, use_meltpot=use_melt_pot) - call surface_forcing_init(Time_in, OS%grid, OS%US, param_file, OS%diag, & - OS%forcing_CSp) + if (present(wind_stagger)) then + call surface_forcing_init(Time_in, OS%grid, OS%US, param_file, OS%diag, & + OS%forcing_CSp, wind_stagger) + else + call surface_forcing_init(Time_in, OS%grid, OS%US, param_file, OS%diag, & + OS%forcing_CSp) + endif if (OS%use_ice_shelf) then call initialize_ice_shelf(param_file, OS%grid, OS%Time, OS%ice_shelf_CSp, & @@ -1045,6 +1054,16 @@ subroutine ocean_model_data2D_get(OS, Ocean, name, array2D, isc, jsc) array2D(isc:,jsc:) = Ocean%t_surf(isc:,jsc:)-CELSIUS_KELVIN_OFFSET case('btfHeat') array2D(isc:,jsc:) = 0 + case('cos_rot') + array2D(isc:,jsc:) = OS%grid%cos_rot(g_isc:g_iec,g_jsc:g_jec) ! =1 + case('sin_rot') + array2D(isc:,jsc:) = OS%grid%sin_rot(g_isc:g_iec,g_jsc:g_jec) ! =0 + case('s_surf') + array2D(isc:,jsc:) = Ocean%s_surf(isc:,jsc:) + case('sea_lev') + array2D(isc:,jsc:) = Ocean%sea_lev(isc:,jsc:) + case('frazil') + array2D(isc:,jsc:) = Ocean%frazil(isc:,jsc:) case default call MOM_error(FATAL,'get_ocean_grid_data2D: unknown argument name='//name) end select @@ -1096,4 +1115,76 @@ subroutine ocean_public_type_chksum(id, timestep, ocn) end subroutine ocean_public_type_chksum +!> This subroutine gives a handle to the grid from ocean state +subroutine get_ocean_grid(OS, Gridp) + ! Obtain the ocean grid. + type(ocean_state_type) :: OS !< A structure containing the + !! internal ocean state + type(ocean_grid_type) , pointer :: Gridp !< The ocean's grid structure + + Gridp => OS%grid + return +end subroutine get_ocean_grid + +!> This subroutine extracts a named (u- or v-) 2-D surface current from ocean internal state +subroutine ocean_model_get_UV_surf(OS, Ocean, name, array2D, isc, jsc) + + type(ocean_state_type), pointer :: OS !< A pointer to the structure containing the + !! internal ocean state (intent in). + type(ocean_public_type), intent(in) :: Ocean !< A structure containing various publicly + !! visible ocean surface fields. + character(len=*) , intent(in) :: name !< The name of the current (ua or va) to extract + real, dimension(isc:,jsc:), intent(out):: array2D !< The values of the named field, it must + !! cover only the computational domain + integer , intent(in) :: isc !< The starting i-index of array2D + integer , intent(in) :: jsc !< The starting j-index of array2D + + type(ocean_grid_type) , pointer :: G !< The ocean's grid structure + type(surface), pointer :: sfc_state !< A structure containing fields that + !! describe the surface state of the ocean. + + integer :: isc_bnd, iec_bnd, jsc_bnd, jec_bnd + integer :: i, j, i0, j0 + integer :: is, ie, js, je + + if (.not.associated(OS)) return + if (.not.OS%is_ocean_pe) return + + G => OS%grid + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec + + call mpp_get_compute_domain(Ocean%Domain, isc_bnd, iec_bnd, & + jsc_bnd, jec_bnd) + + i0 = is - isc_bnd ; j0 = js - jsc_bnd + + sfc_state => OS%sfc_state + + select case(name) + case('ua') + do j=jsc_bnd,jec_bnd ; do i=isc_bnd,iec_bnd + array2D(i,j) = G%mask2dT(i+i0,j+j0) * & + 0.5*(sfc_state%u(I+i0,j+j0)+sfc_state%u(I-1+i0,j+j0)) + enddo ; enddo + case('va') + do j=jsc_bnd,jec_bnd ; do i=isc_bnd,iec_bnd + array2D(i,j) = G%mask2dT(i+i0,j+j0) * & + 0.5*(sfc_state%v(i+i0,J+j0)+sfc_state%v(i+i0,J-1+j0)) + enddo ; enddo + case('ub') + do j=jsc_bnd,jec_bnd ; do i=isc_bnd,iec_bnd + array2D(i,j) = G%mask2dBu(I+i0,J+j0) * & + 0.5*(sfc_state%u(I+i0,j+j0)+sfc_state%u(I+i0,j+j0+1)) + enddo ; enddo + case('vb') + do j=jsc_bnd,jec_bnd ; do i=isc_bnd,iec_bnd + array2D(i,j) = G%mask2dBu(I+i0,J+j0) * & + 0.5*(sfc_state%v(i+i0,J+j0)+sfc_state%v(i+i0+1,J+j0)) + enddo ; enddo + case default + call MOM_error(FATAL,'ocean_model_get_UV_surf: unknown argument name='//name) + end select + +end subroutine ocean_model_get_UV_surf + end module ocean_model_mod diff --git a/config_src/external/GFDL_ocean_BGC/FMS_coupler_util.F90 b/config_src/external/GFDL_ocean_BGC/FMS_coupler_util.F90 new file mode 100644 index 0000000000..f3d63dd061 --- /dev/null +++ b/config_src/external/GFDL_ocean_BGC/FMS_coupler_util.F90 @@ -0,0 +1,35 @@ +module FMS_coupler_util + +use coupler_types_mod, only : coupler_2d_bc_type + +implicit none ; private + +public :: extract_coupler_values, set_coupler_values + +contains + +!> Get element and index of a boundary condition +subroutine extract_coupler_values(BC_struc, BC_index, BC_element, array_out, ilb, jlb, & + is, ie, js, je, conversion) + real, dimension(ilb:,jlb:),intent(out) :: array_out !< The array being filled with the input values + integer, intent(in) :: ilb, jlb !< Lower bounds + type(coupler_2d_bc_type), intent(in) :: BC_struc !< The type from which the data is being extracted + integer, intent(in) :: BC_index !< The boundary condition number being extracted + integer, intent(in) :: BC_element !< The element of the boundary condition being extracted + integer, optional, intent(in) :: is, ie, js, je !< The i- and j- limits of array_out to be filled + real, optional, intent(in) :: conversion !< A number that every element is multiplied by +end subroutine extract_coupler_values + +!> Set element and index of a boundary condition +subroutine set_coupler_values(array_in, BC_struc, BC_index, BC_element, ilb, jlb,& + is, ie, js, je, conversion) + real, dimension(ilb:,jlb:), intent(in) :: array_in !< The array containing the values to load into the BC + integer, intent(in) :: ilb, jlb !< Lower bounds + type(coupler_2d_bc_type), intent(inout) :: BC_struc !< The type into which the data is being loaded + integer, intent(in) :: BC_index !< The boundary condition number being set + integer, intent(in) :: BC_element !< The element of the boundary condition being set + integer, optional, intent(in) :: is, ie, js, je !< The i- and j- limits of array_out to be filled + real, optional, intent(in) :: conversion !< A number that every element is multiplied by +end subroutine set_coupler_values + +end module FMS_coupler_util diff --git a/config_src/external/GFDL_ocean_BGC/README.md b/config_src/external/GFDL_ocean_BGC/README.md new file mode 100644 index 0000000000..198575c8a7 --- /dev/null +++ b/config_src/external/GFDL_ocean_BGC/README.md @@ -0,0 +1,6 @@ +GFDL_ocean_BGC +============== + +These APIs reflect those for the GFDL ocean_BGC available at https://github.com/NOAA-GFDL/ocean_BGC. + +The modules in this directory do not do any computations. They simply reflect the APIs of the above package. diff --git a/config_src/external/GFDL_ocean_BGC/generic_tracer.F90 b/config_src/external/GFDL_ocean_BGC/generic_tracer.F90 new file mode 100644 index 0000000000..bfbc846af9 --- /dev/null +++ b/config_src/external/GFDL_ocean_BGC/generic_tracer.F90 @@ -0,0 +1,130 @@ +!> A non-functioning template of the GFDL ocean BGC +module generic_tracer + + use time_manager_mod, only : time_type + use coupler_types_mod, only : coupler_2d_bc_type + + use g_tracer_utils, only : g_tracer_type, g_diag_type + + implicit none ; private + + public generic_tracer_register + public generic_tracer_init + public generic_tracer_register_diag + public generic_tracer_source + public generic_tracer_update_from_bottom + public generic_tracer_coupler_get + public generic_tracer_coupler_set + public generic_tracer_end + public generic_tracer_get_list + public do_generic_tracer + public generic_tracer_vertdiff_G + public generic_tracer_get_diag_list + public generic_tracer_coupler_accumulate + + !> Turn on generic tracers (note dangerous use of module data) + logical :: do_generic_tracer = .true. + +contains + + !> Unknown + subroutine generic_tracer_register + end subroutine generic_tracer_register + + !> Initialize generic tracers + subroutine generic_tracer_init(isc,iec,jsc,jec,isd,ied,jsd,jed,nk,ntau,axes,grid_tmask,grid_kmt,init_time) + integer, intent(in) :: isc,iec,jsc,jec,isd,ied,jsd,jed,nk,ntau,axes(3) !< Domain boundaries and axes + type(time_type), intent(in) :: init_time !< Time + real, dimension(:,:,:),target, intent(in) :: grid_tmask !< Mask + integer, dimension(:,:) , intent(in) :: grid_kmt !< Number of wet cells in column + end subroutine generic_tracer_init + + !> Unknown + subroutine generic_tracer_register_diag + end subroutine generic_tracer_register_diag + + !> Get coupler values + subroutine generic_tracer_coupler_get(IOB_struc) + type(coupler_2d_bc_type), intent(in) :: IOB_struc !< Ice Ocean Boundary flux structure + end subroutine generic_tracer_coupler_get + + !> Unknown + subroutine generic_tracer_coupler_accumulate(IOB_struc, weight, model_time) + type(coupler_2d_bc_type), intent(in) :: IOB_struc !< Ice Ocean Boundary flux structure + real, intent(in) :: weight !< Unknown + type(time_type), optional,intent(in) :: model_time !< Time + end subroutine generic_tracer_coupler_accumulate + + !> Calls the corresponding generic_X_update_from_source routine for each package X + subroutine generic_tracer_source(Temp,Salt,rho_dzt,dzt,hblt_depth,ilb,jlb,tau,dtts,& + grid_dat,model_time,nbands,max_wavelength_band,sw_pen_band,opacity_band,internal_heat,& + frunoff,grid_ht, current_wave_stress, sosga) + real, dimension(ilb:,jlb:,:), intent(in) :: Temp !< Potential temperature [deg C] + real, dimension(ilb:,jlb:,:), intent(in) :: Salt !< Salinity [psu] + real, dimension(ilb:,jlb:,:), intent(in) :: rho_dzt + real, dimension(ilb:,jlb:,:), intent(in) :: dzt !< Ocean layer thickness [m] + real, dimension(ilb:,jlb:), intent(in) :: hblt_depth !< Boundary layer depth + integer, intent(in) :: ilb !< Lower bounds of x extent of input arrays on data domain + integer, intent(in) :: jlb !< Lower bounds of y extent of input arrays on data domain + integer, intent(in) :: tau !< Time step index of %field + real, intent(in) :: dtts !< Unknown + real, dimension(ilb:,jlb:), intent(in) :: grid_dat !< Unknown + type(time_type), intent(in) :: model_time !< Time + integer, intent(in) :: nbands !< Unknown + real, dimension(:), intent(in) :: max_wavelength_band + real, dimension(:,ilb:,jlb:), intent(in) :: sw_pen_band !< Shortwave penetration + real, dimension(:,ilb:,jlb:,:), intent(in) :: opacity_band !< Unknown + real, dimension(ilb:,jlb:),optional, intent(in) :: internal_heat !< Unknown + real, dimension(ilb:,jlb:),optional, intent(in) :: frunoff !< Unknown + real, dimension(ilb:,jlb:),optional, intent(in) :: grid_ht !< Unknown + real, dimension(ilb:,jlb:),optional , intent(in) :: current_wave_stress !< Unknown + real, optional , intent(in) :: sosga ! global avg. sea surface salinity + end subroutine generic_tracer_source + + !> Update the tracers from bottom fluxes + subroutine generic_tracer_update_from_bottom(dt, tau, model_time) + real, intent(in) :: dt !< Time step increment + integer, intent(in) :: tau !< Time step index used for the concentration field + type(time_type), intent(in) :: model_time !< Time + end subroutine generic_tracer_update_from_bottom + + !> Vertically diffuse all generic tracers for GOLD ocean + subroutine generic_tracer_vertdiff_G(h_old, ea, eb, dt, kg_m2_to_H, m_to_H, tau) + real, dimension(:,:,:), intent(in) :: h_old !< Unknown + real, dimension(:,:,:), intent(in) :: ea !< Unknown + real, dimension(:,:,:), intent(in) :: eb !< Unknown + real, intent(in) :: dt !< Unknown + real, intent(in) :: kg_m2_to_H !< Unknown + real, intent(in) :: m_to_H !< Unknown + integer, intent(in) :: tau !< Unknown + end subroutine generic_tracer_vertdiff_G + + !> Set the coupler values for each generic tracer + subroutine generic_tracer_coupler_set(IOB_struc, ST,SS,rho,ilb,jlb,tau, dzt, sosga,model_time) + type(coupler_2d_bc_type), intent(inout) :: IOB_struc !< Ice Ocean Boundary flux structure + integer, intent(in) :: ilb !< Lower bounds of x extent of input arrays on data domain + integer, intent(in) :: jlb !< Lower bounds of y extent of input arrays on data domain + integer, intent(in) :: tau !< Time step index of %field + real, dimension(ilb:,jlb:), intent(in) :: ST !< Sea surface temperature [deg C] + real, dimension(ilb:,jlb:), intent(in) :: SS !< Sea surface salinity [psu] + real, dimension(ilb:,jlb:,:,:), intent(in) :: rho !< Ocean density [kg m-3] + real, dimension(ilb:,jlb:,:), optional, intent(in) :: dzt !< Layer thickness [m] + real, optional, intent(in) :: sosga !< Unknown + type(time_type),optional, intent(in) :: model_time !< Time + end subroutine generic_tracer_coupler_set + + !> End this module by calling the corresponding generic_X_end for each package X + subroutine generic_tracer_end + end subroutine generic_tracer_end + + !> Get a pointer to the head of the generic tracers list + subroutine generic_tracer_get_list(list) + type(g_tracer_type), pointer :: list !< Pointer to head of the linked list + end subroutine generic_tracer_get_list + + !> Unknown + subroutine generic_tracer_get_diag_list(list) + type(g_diag_type), pointer :: list !< Pointer to head of the linked list + end subroutine generic_tracer_get_diag_list + +end module generic_tracer diff --git a/config_src/external/GFDL_ocean_BGC/generic_tracer_utils.F90 b/config_src/external/GFDL_ocean_BGC/generic_tracer_utils.F90 new file mode 100644 index 0000000000..6937ef4710 --- /dev/null +++ b/config_src/external/GFDL_ocean_BGC/generic_tracer_utils.F90 @@ -0,0 +1,284 @@ +!> g_tracer_utils module consists of core utility subroutines to be used by +!! all generic tracer modules. These include the lowest level functions +!! for adding, allocating memory, and record keeping of individual generic +!! tracers irrespective of their physical/chemical nature. +module g_tracer_utils + + use coupler_types_mod, only: coupler_2d_bc_type + use time_manager_mod, only : time_type + use field_manager_mod, only: fm_string_len + use MOM_diag_mediator, only : g_diag_ctrl=>diag_ctrl + +implicit none ; private + + !> Each generic tracer node is an instant of a FORTRAN type with the following member variables. + !! These member fields are supposed to uniquely define an individual tracer. + !! One such type shall be instantiated for EACH individual tracer. + type g_tracer_type + !> Tracer concentration field in space (and time) + !! MOM keeps the prognostic tracer fields at 3 time levels, hence 4D. + real, pointer, dimension(:,:,:,:) :: field => NULL() + !> Tracer concentration in river runoff + real, allocatable, dimension(:,:) :: trunoff + logical :: requires_restart = .true. !< Unknown + !> Tracer source: filename, type, var name, units, record, gridfile + character(len=fm_string_len) :: src_file, src_var_name, src_var_unit, src_var_gridspec + integer :: src_var_record !< Unknown + logical :: requires_src_info = .false. !< Unknown + real :: src_var_unit_conversion = 1.0 !< This factor depends on the tracer. Ask Jasmin + real :: src_var_valid_min = 0.0 !< Unknown + end type g_tracer_type + + !> Unknown + type g_diag_type + integer :: dummy !< A dummy member, not part of the API + end type g_diag_type + + !> The following type fields are common to ALL generic tracers and hence has to be instantiated only once + type g_tracer_common +! type(g_diag_ctrl) :: diag_CS !< Unknown + !> Domain extents + integer :: isd,jsd + end type g_tracer_common + + !> Unknown dangerous module data! + type(g_tracer_common), target, save :: g_tracer_com + + public :: g_tracer_type + public :: g_tracer_flux_init + public :: g_tracer_set_values + public :: g_tracer_get_values + public :: g_tracer_get_pointer + public :: g_tracer_get_common + public :: g_tracer_set_common + public :: g_tracer_set_csdiag + public :: g_tracer_send_diag + public :: g_tracer_get_name + public :: g_tracer_get_alias + public :: g_tracer_get_next + public :: g_tracer_is_prog + public :: g_diag_type + + !> Set the values of various (array) members of the tracer node g_tracer_type + !! + !! This function is overloaded to set the values of the following member variables + interface g_tracer_set_values + module procedure g_tracer_set_real + module procedure g_tracer_set_2D + module procedure g_tracer_set_3D + module procedure g_tracer_set_4D + end interface + + !> Reverse of interface g_tracer_set_values for getting the tracer member arrays in the argument value + !! + !! This means "get the values of array %field_name for tracer tracer_name and put them in argument array_out" + interface g_tracer_get_values + module procedure g_tracer_get_4D_val + module procedure g_tracer_get_3D_val + module procedure g_tracer_get_2D_val + module procedure g_tracer_get_real + module procedure g_tracer_get_string + end interface + + !> Return the pointer to the requested field of a particular tracer + !! + !! This means "get the pointer of array %field_name for tracer tracer_name in argument array_ptr" + interface g_tracer_get_pointer + module procedure g_tracer_get_4D + module procedure g_tracer_get_3D + module procedure g_tracer_get_2D + end interface + +contains + + !> Unknown + subroutine g_tracer_flux_init(g_tracer) + type(g_tracer_type), pointer :: g_tracer !< Pointer to this tracer node + end subroutine g_tracer_flux_init + + !> Unknown + subroutine g_tracer_set_csdiag(diag_CS) + type(g_diag_ctrl), target,intent(in) :: diag_CS !< Unknown + end subroutine g_tracer_set_csdiag + + subroutine g_tracer_set_common(isc,iec,jsc,jec,isd,ied,jsd,jed,nk,ntau,axes,grid_tmask,grid_kmt,init_time) + integer, intent(in) :: isc,iec,jsc,jec,isd,ied,jsd,jed,nk,ntau,axes(3) !< Unknown + real, dimension(isd:,jsd:,:),intent(in) :: grid_tmask !< Unknown + integer,dimension(isd:,jsd:),intent(in) :: grid_kmt !< Unknown + type(time_type), intent(in) :: init_time !< Unknown + end subroutine g_tracer_set_common + + subroutine g_tracer_get_common(isc,iec,jsc,jec,isd,ied,jsd,jed,nk,ntau,& + axes,grid_tmask,grid_mask_coast,grid_kmt,init_time,diag_CS) + integer, intent(out) :: isc,iec,jsc,jec,isd,ied,jsd,jed,nk,ntau !< Unknown + integer,optional, intent(out) :: axes(3) !< Unknown + type(time_type), optional, intent(out) :: init_time !< Unknown + real, optional, dimension(:,:,:),pointer :: grid_tmask !< Unknown + integer, optional, dimension(:,:), pointer :: grid_mask_coast !< Unknown + integer, optional, dimension(:,:), pointer :: grid_kmt !< Unknown + type(g_diag_ctrl), optional, pointer :: diag_CS !< Unknown + end subroutine g_tracer_get_common + + !> Unknown + subroutine g_tracer_get_4D(g_tracer_list,name,member,array_ptr) + character(len=*), intent(in) :: name !< Unknown + character(len=*), intent(in) :: member !< Unknown + type(g_tracer_type), pointer :: g_tracer_list, g_tracer !< Unknown + real, dimension(:,:,:,:), pointer :: array_ptr + end subroutine g_tracer_get_4D + + !> Unknown + subroutine g_tracer_get_3D(g_tracer_list,name,member,array_ptr) + character(len=*), intent(in) :: name !< Unknown + character(len=*), intent(in) :: member !< Unknown + type(g_tracer_type), pointer :: g_tracer_list, g_tracer !< Unknown + real, dimension(:,:,:), pointer :: array_ptr !< Unknown + end subroutine g_tracer_get_3D + + !> Unknown + subroutine g_tracer_get_2D(g_tracer_list,name,member,array_ptr) + character(len=*), intent(in) :: name !< Unknown + character(len=*), intent(in) :: member !< Unknown + type(g_tracer_type), pointer :: g_tracer_list, g_tracer !< Unknown + real, dimension(:,:), pointer :: array_ptr !< Unknown + end subroutine g_tracer_get_2D + + !> Unknown + subroutine g_tracer_get_4D_val(g_tracer_list,name,member,array,isd,jsd) + character(len=*), intent(in) :: name !< Unknown + character(len=*), intent(in) :: member !< Unknown + type(g_tracer_type), pointer :: g_tracer_list, g_tracer !< Unknown + integer, intent(in) :: isd,jsd !< Unknown + real, dimension(isd:,jsd:,:,:), intent(out):: array !< Unknown + end subroutine g_tracer_get_4D_val + + !> Unknown + subroutine g_tracer_get_3D_val(g_tracer_list,name,member,array,isd,jsd,ntau,positive) + character(len=*), intent(in) :: name !< Unknown + character(len=*), intent(in) :: member !< Unknown + type(g_tracer_type), pointer :: g_tracer_list, g_tracer !< Unknown + integer, intent(in) :: isd,jsd !< Unknown + integer, optional, intent(in) :: ntau !< Unknown + logical, optional, intent(in) :: positive !< Unknown + real, dimension(isd:,jsd:,:), intent(out):: array !< Unknown + integer :: tau + character(len=fm_string_len), parameter :: sub_name = 'g_tracer_get_3D_val' + end subroutine g_tracer_get_3D_val + + !> Unknown + subroutine g_tracer_get_2D_val(g_tracer_list,name,member,array,isd,jsd) + character(len=*), intent(in) :: name !< Unknown + character(len=*), intent(in) :: member !< Unknown + type(g_tracer_type), pointer :: g_tracer_list, g_tracer !< Unknown + integer, intent(in) :: isd,jsd !< Unknown + real, dimension(isd:,jsd:), intent(out):: array !< Unknown + end subroutine g_tracer_get_2D_val + + !> Unknown + subroutine g_tracer_get_real(g_tracer_list,name,member,value) + character(len=*), intent(in) :: name !< Unknown + character(len=*), intent(in) :: member !< Unknown + type(g_tracer_type), pointer :: g_tracer_list, g_tracer !< Unknown + real, intent(out):: value + end subroutine g_tracer_get_real + + !> Unknown + subroutine g_tracer_get_string(g_tracer_list,name,member,string) + character(len=*), intent(in) :: name !< Unknown + character(len=*), intent(in) :: member !< Unknown + type(g_tracer_type), pointer :: g_tracer_list, g_tracer !< Unknown + character(len=fm_string_len), intent(out) :: string !< Unknown + end subroutine g_tracer_get_string + + !> Unknown + subroutine g_tracer_set_2D(g_tracer_list,name,member,array,isd,jsd,weight) + character(len=*), intent(in) :: name !< Unknown + character(len=*), intent(in) :: member !< Unknown + type(g_tracer_type), pointer :: g_tracer_list, g_tracer !< Unknown + integer, intent(in) :: isd,jsd !< Unknown + real, dimension(isd:,jsd:),intent(in) :: array !< Unknown + real, optional ,intent(in) :: weight !< Unknown + end subroutine g_tracer_set_2D + + !> Unknown + subroutine g_tracer_set_3D(g_tracer_list,name,member,array,isd,jsd,ntau) + character(len=*), intent(in) :: name !< Unknown + character(len=*), intent(in) :: member !< Unknown + type(g_tracer_type), pointer :: g_tracer_list, g_tracer !< Unknown + integer, intent(in) :: isd,jsd !< Unknown + integer, optional, intent(in) :: ntau !< Unknown + real, dimension(isd:,jsd:,:), intent(in) :: array !< Unknown + end subroutine g_tracer_set_3D + + !> Unknown + subroutine g_tracer_set_4D(g_tracer_list,name,member,array,isd,jsd) + character(len=*), intent(in) :: name !< Unknown + character(len=*), intent(in) :: member !< Unknown + type(g_tracer_type), pointer :: g_tracer_list, g_tracer !< Unknown + integer, intent(in) :: isd,jsd !< Unknown + real, dimension(isd:,jsd:,:,:), intent(in) :: array !< Unknown + end subroutine g_tracer_set_4D + + !> Unknown + subroutine g_tracer_set_real(g_tracer_list,name,member,value) + character(len=*), intent(in) :: name !< Unknown + character(len=*), intent(in) :: member !< Unknown + type(g_tracer_type), pointer :: g_tracer_list, g_tracer !< Unknown + real, intent(in) :: value !< Unknown + end subroutine g_tracer_set_real + + subroutine g_tracer_send_diag(g_tracer_list,model_time,tau) + type(g_tracer_type), pointer :: g_tracer_list !< pointer to the head of the generic tracer list + type(g_tracer_type), pointer :: g_tracer !< Pointer to tracer node + type(time_type), intent(in) :: model_time !< Time + integer, intent(in) :: tau !< The time step for the %field 4D field to be reported + end subroutine g_tracer_send_diag + + !> Unknown + subroutine g_tracer_get_name(g_tracer,string) + type(g_tracer_type), pointer :: g_tracer !< Unknown + character(len=*), intent(out) :: string !< Unknown + end subroutine g_tracer_get_name + + !> Unknown + subroutine g_tracer_get_alias(g_tracer,string) + type(g_tracer_type), pointer :: g_tracer !< Unknown + character(len=*), intent(out) :: string !< Unknown + end subroutine g_tracer_get_alias + + !> Is the tracer prognostic? + function g_tracer_is_prog(g_tracer) + logical :: g_tracer_is_prog + type(g_tracer_type), pointer :: g_tracer !< Pointer to tracer node + end function g_tracer_is_prog + + !> get the next tracer in the list + subroutine g_tracer_get_next(g_tracer,g_tracer_next) + type(g_tracer_type), pointer :: g_tracer !< Pointer to tracer node + type(g_tracer_type), pointer :: g_tracer_next !< Pointer to the next tracer node in the list + end subroutine g_tracer_get_next + + !>Vertical Diffusion of a tracer node + !! + !! This subroutine solves a tridiagonal equation to find and set values of vertically diffused field + !! for a tracer node.This is ported from GOLD (vertdiff) and simplified + !! Since the surface flux from the atmosphere (%stf) has the units of mol/m^2/sec the resulting + !! tracer concentration has units of mol/Kg + subroutine g_tracer_vertdiff_G(g_tracer, h_old, ea, eb, dt, kg_m2_to_H, m_to_H, tau, mom) + type(g_tracer_type), pointer :: g_tracer + !> Layer thickness before entrainment, in m or kg m-2. + real, dimension(g_tracer_com%isd:,g_tracer_com%jsd:,:), intent(in) :: h_old + !> The amount of fluid entrained from the layer above, in H. + real, dimension(g_tracer_com%isd:,g_tracer_com%jsd:,:), intent(in) :: ea + !> The amount of fluid entrained from the layer below, in H. + real, dimension(g_tracer_com%isd:,g_tracer_com%jsd:,:), intent(in) :: eb + real, intent(in) :: dt !< The amount of time covered by this call, in s. + real, intent(in) :: kg_m2_to_H !< A conversion factor that translates kg m-2 into + !! the units of h_old (H) + real, intent(in) :: m_to_H !< A conversion factor that translates m into the units + !! of h_old (H). + integer, intent(in) :: tau !< Unknown + logical, intent(in), optional :: mom + end subroutine g_tracer_vertdiff_G + +end module g_tracer_utils diff --git a/config_src/external/ODA_hooks/README.md b/config_src/external/ODA_hooks/README.md new file mode 100644 index 0000000000..b26731a463 --- /dev/null +++ b/config_src/external/ODA_hooks/README.md @@ -0,0 +1,9 @@ +ODA_hooks +========= + +These APIs reflect those for the ocean data assimilation hooks similar to https://github.com/MJHarrison-GFDL/MOM6_DA_hooks + +The modules in this directory do not do any computations. They simply reflect the APIs of the above package. + +- kdtree.f90 - would come from https://github.com/travissluka/geoKdTree +- ocean_da_core.F90, ocean_da_types.F90, write_ocean_obs.F90 were copied from https://github.com/MJHarrison-GFDL/MOM6_DA_hooks diff --git a/config_src/external/ODA_hooks/kdtree.f90 b/config_src/external/ODA_hooks/kdtree.f90 new file mode 100644 index 0000000000..a27716dde1 --- /dev/null +++ b/config_src/external/ODA_hooks/kdtree.f90 @@ -0,0 +1,12 @@ +!> A null version of K-d tree from geoKdTree +module kdtree + implicit none + private + + public :: kd_root + + !> A K-d tree tpe + type kd_root + integer :: dummy !< To stop a compiler from doing nothing + end type kd_root +end module kdtree diff --git a/config_src/external/ODA_hooks/ocean_da_core.F90 b/config_src/external/ODA_hooks/ocean_da_core.F90 new file mode 100644 index 0000000000..769e44b2aa --- /dev/null +++ b/config_src/external/ODA_hooks/ocean_da_core.F90 @@ -0,0 +1,47 @@ +!> A set of dummy interfaces for compiling the MOM6 DA driver code. +module ocean_da_core_mod + ! MOM modules + use MOM_domains, only : MOM_domain_type, domain2D + use MOM_time_manager, only : time_type, set_time, get_date + ! ODA_tools modules + use ocean_da_types_mod, only : ocean_profile_type, grid_type + use kdtree, only : kd_root + + implicit none + private + public :: ocean_da_core_init + public :: get_profiles + +contains + + !> Initializes the MOM6 DA driver code. + subroutine ocean_da_core_init(Domain, global_grid, Profiles, model_time) + type(domain2D), pointer, intent(in) :: Domain !< A MOM domain type + type(grid_type), pointer, intent(in) :: global_grid !< The global ODA horizontal grid type + type(ocean_profile_type), pointer :: Profiles !< This is an unstructured recursive list of profiles + !! which are either within the localized domain corresponding + !! to the Domain argument, or the global profile list (type). + type(time_type), intent(in) :: model_time !< The current model time type. + + + + Profiles=>NULL() + return + end subroutine ocean_da_core_init + + + !> Get profiles obs within the current analysis interval + subroutine get_profiles(model_time, Profiles, Current_profiles) + type(time_type), intent(in) :: model_time !< The current analysis time. + type(ocean_profile_type), pointer :: Profiles !< The full recursive list of profiles. + type(ocean_profile_type), pointer :: Current_profiles !< A returned list of profiles for the + !! current analysis step. + + Profiles=>NULL() + Current_Profiles=>NULL() + + return + end subroutine get_profiles + + +end module ocean_da_core_mod diff --git a/config_src/external/ODA_hooks/ocean_da_types.F90 b/config_src/external/ODA_hooks/ocean_da_types.F90 new file mode 100644 index 0000000000..bc5af1d782 --- /dev/null +++ b/config_src/external/ODA_hooks/ocean_da_types.F90 @@ -0,0 +1,85 @@ +!> Dummy aata structures and methods for ocean data assimilation. +module ocean_da_types_mod + + use MOM_time_manager, only : time_type + + implicit none + + private + + + !> Example type for ocean ensemble DA state + type, public :: OCEAN_CONTROL_STRUCT + integer :: ensemble_size + real, pointer, dimension(:,:,:) :: SSH=>NULL() !NULL() !NULL() !NULL() !NULL() !NULL() ! Example of a profile type + type, public :: ocean_profile_type + integer :: inst_type !< A numeric code indicating the type of instrument (e.g. ARGO drifter, CTD, ...) + logical :: initialized !< a True value indicates that this profile has been allocated for use + logical :: colocated !< a True value indicated that the measurements of (num_variables) data are + !! co-located in space-time + integer :: ensemble_size !< size of the ensemble of model states used in association with this profile + integer :: num_variables !< number of measurement types associated with this profile. + integer, pointer, dimension(:) :: var_id !< variable ids are defined by the ocean_types module + integer :: platform !< platform types are defined by platform class (e.g. MOORING, DROP, etc.) + !! and instrument type (XBT, CDT, etc.) + integer :: levels !< number of levels in the current profile + integer :: basin_mask !< 1:Southern Ocean, 2:Atlantic Ocean, 3:Pacific Ocean, + !! 4:Arctic Ocean, 5:Indian Ocean, 6:Mediterranean Sea, 7:Black Sea, + !! 8:Hudson Bay, 9:Baltic Sea, 10:Red Sea, 11:Persian Gulf + integer :: profile_flag !< an overall flag for the profile + real :: lat, lon !< latitude and longitude (degrees E and N) + logical :: accepted !< logical flag to disable a profile + type(time_type) :: time_window !< The time window associated with this profile [s] + real, pointer, dimension(:) :: obs_error !< The observation error by variable + real :: loc_dist !< The impact radius of this observation (m) + type(ocean_profile_type), pointer :: next=>NULL() !< all profiles are stored as linked list. + type(ocean_profile_type), pointer :: prev=>NULL() + type(ocean_profile_type), pointer :: cnext=>NULL() ! current profiles are stored as linked list. + type(ocean_profile_type), pointer :: cprev=>NULL() + integer :: nbr_xi, nbr_yi ! nearest neighbor model gridpoint for the profile + real :: nbr_dist ! distance to nearest neighbor model gridpoint + logical :: compute !< profile is within current compute domain + real, dimension(:,:), pointer :: depth => NULL() !< depth of measurement [m] + real, dimension(:,:), pointer :: data => NULL() !< data by variable type + integer, dimension(:,:), pointer :: flag => NULL() !< flag by depth and variable type + real, dimension(:,:,:), pointer :: forecast => NULL() !< ensemble member first guess + real, dimension(:,:,:), pointer :: analysis => NULL() !< ensemble member analysis + type(forward_operator_type), pointer :: obs_def => NULL() !< observation forward operator + type(time_type) :: time !< profile time type + real :: i_index, j_index !< model longitude and latitude indices respectively + real, dimension(:,:), pointer :: k_index !< model depth indices + type(time_type) :: tdiff !< difference between model time and observation time + character(len=128) :: filename + end type ocean_profile_type + + !> Example forward operator type. + type, public :: forward_operator_type + integer :: num + integer, dimension(2) :: state_size !< for + integer, dimension(:), pointer :: state_var_index !< for flattened data + integer, dimension(:), pointer :: i_index !< i-dimension index + integer, dimension(:), pointer :: j_index !< j-dimension index + real, dimension(:), pointer :: coef + end type forward_operator_type + + !> Grid type for DA + type, public :: grid_type + real, pointer, dimension(:,:) :: x=>NULL(), y=>NULL() + real, pointer, dimension(:,:,:) :: z=>NULL() + real, pointer, dimension(:,:,:) :: h=>NULL() + real, pointer, dimension(:,:) :: basin_mask => NULL() + real, pointer, dimension(:,:,:) :: mask => NULL() + real, pointer, dimension(:,:) :: bathyT => NULL() + logical :: tripolar_N + integer :: ni, nj, nk + end type grid_type + +end module ocean_da_types_mod diff --git a/config_src/external/ODA_hooks/write_ocean_obs.F90 b/config_src/external/ODA_hooks/write_ocean_obs.F90 new file mode 100644 index 0000000000..a2c41b58d6 --- /dev/null +++ b/config_src/external/ODA_hooks/write_ocean_obs.F90 @@ -0,0 +1,50 @@ +!> Dummy interfaces for writing ODA data +module write_ocean_obs_mod + + + use ocean_da_types_mod, only : ocean_profile_type + use MOM_time_manager, only : time_type, get_time, set_date + + implicit none + + private + + public :: open_profile_file, write_profile, close_profile_file, & + write_ocean_obs_init + +contains + +!> Open a profile file +integer function open_profile_file(name, nvar, grid_lon, grid_lat,thread,fset) + character(len=*), intent(in) :: name !< File name + integer, intent(in), optional :: nvar !< Number of variables + real, dimension(:), optional, intent(in) :: grid_lon !< Longitude [degreeE] + real, dimension(:), optional, intent(in) :: grid_lat !< Latitude [degreeN] + integer, intent(in), optional :: thread !< Thread + integer, intent(in), optional :: fset !< File set + + open_profile_file=-1 +end function open_profile_file + +!> Write a profile +subroutine write_profile(unit,profile) + integer, intent(in) :: unit !< File unit + type(ocean_profile_type), intent(in) :: profile !< Profile + + return +end subroutine write_profile + +!> Close a profile file +subroutine close_profile_file(unit) + integer, intent(in) :: unit !< File unit + + return +end subroutine close_profile_file + +!> Initialize write_ocean_obs module +subroutine write_ocean_obs_init() + + return +end subroutine write_ocean_obs_init + +end module write_ocean_obs_mod diff --git a/config_src/external/README.md b/config_src/external/README.md new file mode 100644 index 0000000000..ff70f35915 --- /dev/null +++ b/config_src/external/README.md @@ -0,0 +1,10 @@ +config_src/external +=================== + +Subdirectories in here provide null versions of external packages that +can be called by, or used with, MOM6 but that are not needed in all +configurations/executables. + +The APIs in these modules should be consistent with the actual external +package. To build with the actual external package include it in the +search path for your build system and remove the associated null version. diff --git a/config_src/solo_driver/MOM_driver.F90 b/config_src/solo_driver/MOM_driver.F90 index dfdfeff8ef..f180cd9717 100644 --- a/config_src/solo_driver/MOM_driver.F90 +++ b/config_src/solo_driver/MOM_driver.F90 @@ -66,6 +66,7 @@ program MOM_main use ensemble_manager_mod, only : ensemble_pelist_setup use mpp_mod, only : set_current_pelist => mpp_set_current_pelist use time_interp_external_mod, only : time_interp_external_init + use fms_affinity_mod, only : fms_affinity_init, fms_affinity_set,fms_affinity_get use MOM_ice_shelf, only : initialize_ice_shelf, ice_shelf_end, ice_shelf_CS use MOM_ice_shelf, only : shelf_calc_flux, add_shelf_forces, ice_shelf_save_restart @@ -207,11 +208,10 @@ program MOM_main character(len=40) :: mod_name = "MOM_main (MOM_driver)" ! This module's name. integer :: ocean_nthreads = 1 - integer :: ncores_per_node = 36 logical :: use_hyper_thread = .false. - integer :: omp_get_num_threads,omp_get_thread_num,get_cpu_affinity,adder,base_cpu + integer :: omp_get_num_threads,omp_get_thread_num namelist /ocean_solo_nml/ date_init, calendar, months, days, hours, minutes, seconds,& - ocean_nthreads, ncores_per_node, use_hyper_thread + ocean_nthreads, use_hyper_thread !===================================================================== @@ -252,20 +252,11 @@ program MOM_main endif endif +!$ call fms_affinity_init +!$ call fms_affinity_set('OCEAN', use_hyper_thread, ocean_nthreads) !$ call omp_set_num_threads(ocean_nthreads) -!$ base_cpu = get_cpu_affinity() -!$OMP PARALLEL private(adder) -!$ if (use_hyper_thread) then -!$ if (mod(omp_get_thread_num(),2) == 0) then -!$ adder = omp_get_thread_num()/2 -!$ else -!$ adder = ncores_per_node + omp_get_thread_num()/2 -!$ endif -!$ else -!$ adder = omp_get_thread_num() -!$ endif -!$ call set_cpu_affinity (base_cpu + adder) -!$ write(6,*) " ocean ", base_cpu, get_cpu_affinity(), adder, omp_get_thread_num(), omp_get_num_threads() +!$OMP PARALLEL +!$ write(6,*) "ocean_solo OMPthreading ", fms_affinity_get(), omp_get_thread_num(), omp_get_num_threads() !$ call flush(6) !$OMP END PARALLEL diff --git a/docs/Doxyfile_nortd b/docs/Doxyfile_nortd index e07ce4f0b6..76b66b9dd3 100644 --- a/docs/Doxyfile_nortd +++ b/docs/Doxyfile_nortd @@ -794,7 +794,9 @@ INPUT = ../src \ front_page.md \ ../config_src/solo_driver \ ../config_src/dynamic_symmetric - ../config_src/coupled_driver/ocean_model_MOM.F90 + ../config_src/external + ../config_src/coupled_driver + # This tag can be used to specify the character encoding of the source files # that doxygen parses. Internally doxygen uses the UTF-8 encoding. Doxygen uses diff --git a/docs/Doxyfile_rtd b/docs/Doxyfile_rtd index 652f46f076..7a74004d19 100644 --- a/docs/Doxyfile_rtd +++ b/docs/Doxyfile_rtd @@ -783,8 +783,8 @@ WARN_LOGFILE = doxygen.log INPUT = ../src \ ../config_src/solo_driver \ ../config_src/dynamic_symmetric \ - ../config_src/coupled_driver/coupler_util.F90 \ - ../config_src/coupled_driver/ocean_model_MOM.F90 + ../config_src/external \ + ../config_src/coupled_driver # This tag can be used to specify the character encoding of the source files # that doxygen parses. Internally doxygen uses the UTF-8 encoding. Doxygen uses diff --git a/pkg/MOM6_DA_hooks b/pkg/MOM6_DA_hooks deleted file mode 160000 index 6d8834ca8c..0000000000 --- a/pkg/MOM6_DA_hooks +++ /dev/null @@ -1 +0,0 @@ -Subproject commit 6d8834ca8cf399f1a0d202239d72919907f6cd74 diff --git a/pkg/geoKdTree b/pkg/geoKdTree deleted file mode 160000 index a4670b9743..0000000000 --- a/pkg/geoKdTree +++ /dev/null @@ -1 +0,0 @@ -Subproject commit a4670b9743c883d310d821eeac5b1f77f587b9d5 diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 2ff06b85f0..4a98dbea6f 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -994,7 +994,7 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, & call enable_averages(dt_thermo, Time_local+real_to_time(US%T_to_s*(dt_thermo-dt)), CS%diag) call cpu_clock_begin(id_clock_thick_diff) if (associated(CS%VarMix)) & - call calc_slope_functions(h, CS%tv, dt, G, GV, US, CS%VarMix) + call calc_slope_functions(h, CS%tv, dt, G, GV, US, CS%VarMix, OBC=CS%OBC) call thickness_diffuse(h, CS%uhtr, CS%vhtr, CS%tv, dt_thermo, G, GV, US, & CS%MEKE, CS%VarMix, CS%CDp, CS%thickness_diffuse_CSp) call cpu_clock_end(id_clock_thick_diff) @@ -1067,7 +1067,7 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, & if (CS%debug) call hchksum(h,"Pre-thickness_diffuse h", G%HI, haloshift=0, scale=GV%H_to_m) if (associated(CS%VarMix)) & - call calc_slope_functions(h, CS%tv, dt, G, GV, US, CS%VarMix) + call calc_slope_functions(h, CS%tv, dt, G, GV, US, CS%VarMix, OBC=CS%OBC) call thickness_diffuse(h, CS%uhtr, CS%vhtr, CS%tv, dt, G, GV, US, & CS%MEKE, CS%VarMix, CS%CDp, CS%thickness_diffuse_CSp) @@ -1265,8 +1265,8 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & call cpu_clock_begin(id_clock_diabatic) - call diabatic(u, v, h, tv, CS%Hml, fluxes, CS%visc, CS%ADp, CS%CDp, & - dtdia, Time_end_thermo, G, GV, US, CS%diabatic_CSp, Waves=Waves) + call diabatic(u, v, h, tv, CS%Hml, fluxes, CS%visc, CS%ADp, CS%CDp, dtdia, & + Time_end_thermo, G, GV, US, CS%diabatic_CSp, OBC=CS%OBC, Waves=Waves) fluxes%fluxes_used = .true. if (showCallTree) call callTree_waypoint("finished diabatic (step_MOM_thermo)") @@ -1479,7 +1479,7 @@ subroutine step_offline(forces, fluxes, sfc_state, Time_start, time_interval, CS call pass_var(CS%h, G%Domain) call calc_resoln_function(CS%h, CS%tv, G, GV, US, CS%VarMix) call calc_depth_function(G, CS%VarMix) - call calc_slope_functions(CS%h, CS%tv, dt_offline, G, GV, US, CS%VarMix) + call calc_slope_functions(CS%h, CS%tv, dt_offline, G, GV, US, CS%VarMix, OBC=CS%OBC) endif call tracer_hordiff(CS%h, dt_offline, CS%MEKE, CS%VarMix, G, GV, US, & CS%tracer_diff_CSp, CS%tracer_Reg, CS%tv) @@ -1505,7 +1505,7 @@ subroutine step_offline(forces, fluxes, sfc_state, Time_start, time_interval, CS call pass_var(CS%h, G%Domain) call calc_resoln_function(CS%h, CS%tv, G, GV, US, CS%VarMix) call calc_depth_function(G, CS%VarMix) - call calc_slope_functions(CS%h, CS%tv, dt_offline, G, GV, US, CS%VarMix) + call calc_slope_functions(CS%h, CS%tv, dt_offline, G, GV, US, CS%VarMix, OBC=CS%OBC) endif call tracer_hordiff(CS%h, dt_offline, CS%MEKE, CS%VarMix, G, GV, US, & CS%tracer_diff_CSp, CS%tracer_Reg, CS%tv) @@ -1705,8 +1705,12 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & call find_obsolete_params(param_file) + ! Determining the internal unit scaling factors for this run. + call unit_scaling_init(param_file, CS%US) + US => CS%US + ! Read relevant parameters and write them to the model log. - call log_version(param_file, "MOM", version, "") + call log_version(param_file, "MOM", version, "", log_to_all=.true., layout=.true., debugging=.true.) call get_param(param_file, "MOM", "VERBOSITY", verbosity, & "Integer controlling level of messaging\n" // & "\t0 = Only FATAL messages\n" // & @@ -1719,11 +1723,6 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & call unit_tests(verbosity) endif - ! Determining the internal unit scaling factors for this run. - call unit_scaling_init(param_file, CS%US) - - US => CS%US - call get_param(param_file, "MOM", "SPLIT", CS%split, & "Use the split time stepping if true.", default=.true.) if (CS%split) then @@ -2665,7 +2664,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & call register_obsolete_diagnostics(param_file, CS%diag) if (use_frazil) then - if (.not.query_initialized(CS%tv%frazil,"frazil",restart_CSp)) then + if (query_initialized(CS%tv%frazil, "frazil", restart_CSp)) then ! Test whether the dimensional rescaling has changed for heat content. if ((US%kg_m3_to_R_restart*US%m_to_Z_restart*US%J_kg_to_Q_restart /= 0.0) .and. & ((US%J_kg_to_Q*US%kg_m3_to_R*US%m_to_Z) /= & diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index 9b5a2c1a57..50ad121b77 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -3966,7 +3966,9 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, endif ! Read all relevant parameters and write them to the model log. - call log_version(param_file, mdl, version, "") + call get_param(param_file, mdl, "SPLIT", CS%split, default=.true., do_not_log=.true.) + call log_version(param_file, mdl, version, "", log_to_all=.true., layout=CS%split, & + debugging=CS%split, all_default=.not.CS%split) call get_param(param_file, mdl, "SPLIT", CS%split, & "Use the split time stepping if true.", default=.true.) if (.not.CS%split) return diff --git a/src/core/MOM_grid.F90 b/src/core/MOM_grid.F90 index f2c4a7d93b..8844c65f40 100644 --- a/src/core/MOM_grid.F90 +++ b/src/core/MOM_grid.F90 @@ -210,9 +210,10 @@ subroutine MOM_grid_init(G, param_file, US, HI, global_indexing, bathymetry_at_v ! Read all relevant parameters and write them to the model log. + call get_param(param_file, mod_nm, "REFERENCE_HEIGHT", G%Z_ref, default=0.0, do_not_log=.true.) call log_version(param_file, mod_nm, version, & - "Parameters providing information about the lateral grid.") - + "Parameters providing information about the lateral grid.", & + log_to_all=.true., layout=.true., all_default=(G%Z_ref==0.0)) call get_param(param_file, mod_nm, "NIBLOCK", niblock, "The number of blocks "// & "in the x-direction on each processor (for openmp).", default=1, & diff --git a/src/core/MOM_isopycnal_slopes.F90 b/src/core/MOM_isopycnal_slopes.F90 index fa60fb821d..58bc196744 100644 --- a/src/core/MOM_isopycnal_slopes.F90 +++ b/src/core/MOM_isopycnal_slopes.F90 @@ -8,6 +8,8 @@ module MOM_isopycnal_slopes use MOM_variables, only : thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type use MOM_EOS, only : int_specific_vol_dp, calculate_density_derivs +use MOM_open_boundary, only : ocean_OBC_type +use MOM_open_boundary, only : OBC_DIRECTION_E, OBC_DIRECTION_W, OBC_DIRECTION_N, OBC_DIRECTION_S implicit none ; private @@ -24,7 +26,7 @@ module MOM_isopycnal_slopes !> Calculate isopycnal slopes, and optionally return N2 used in calculation. subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, & - slope_x, slope_y, N2_u, N2_v, halo) !, eta_to_m) + slope_x, slope_y, N2_u, N2_v, halo, OBC) !, eta_to_m) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type @@ -44,6 +46,7 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, & optional, intent(inout) :: N2_v !< Brunt-Vaisala frequency squared at !! interfaces between u-points [T-2 ~> s-2] integer, optional, intent(in) :: halo !< Halo width over which to compute + type(ocean_OBC_type), optional, pointer :: OBC !< Open boundaries control structure. ! real, optional, intent(in) :: eta_to_m !< The conversion factor from the units ! (This argument has been tested but for now serves no purpose.) !! of eta to m; US%Z_to_m by default. @@ -102,6 +105,7 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, & integer, dimension(2) :: EOSdom_u, EOSdom_v ! Domains for the equation of state calculations at u and v points integer :: is, ie, js, je, nz, IsdB integer :: i, j, k + logical :: local_open_u_BC, local_open_v_BC if (present(halo)) then is = G%isc-halo ; ie = G%iec+halo ; js = G%jsc-halo ; je = G%jec+halo @@ -118,6 +122,13 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, & L_to_Z = 1.0 / Z_to_L dz_neglect = GV%H_subroundoff * H_to_Z + local_open_u_BC = .false. + local_open_v_BC = .false. + if (present(OBC)) then ; if (associated(OBC)) then + local_open_u_BC = OBC%open_u_BCs_exist_globally + local_open_v_BC = OBC%open_v_BCs_exist_globally + endif ; endif + use_EOS = associated(tv%eqn_of_state) present_N2_u = PRESENT(N2_u) @@ -167,7 +178,8 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, & !$OMP parallel do default(none) shared(nz,is,ie,js,je,IsdB,use_EOS,G,GV,US,pres,T,S,tv,h,e, & !$OMP h_neglect,dz_neglect,Z_to_L,L_to_Z,H_to_Z,h_neglect2, & - !$OMP present_N2_u,G_Rho0,N2_u,slope_x,EOSdom_u) & + !$OMP present_N2_u,G_Rho0,N2_u,slope_x,EOSdom_u,local_open_u_BC, & + !$OMP OBC) & !$OMP private(drdiA,drdiB,drdkL,drdkR,pres_u,T_u,S_u, & !$OMP drho_dT_u,drho_dS_u,hg2A,hg2B,hg2L,hg2R,haA, & !$OMP haB,haL,haR,dzaL,dzaR,wtA,wtB,wtL,wtR,drdz, & @@ -247,6 +259,19 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, & else ! With .not.use_EOS, the layers are constant density. slope_x(I,j,K) = (Z_to_L*(e(i,j,K)-e(i+1,j,K))) * G%IdxCu(I,j) endif + if (local_open_u_BC) then + if (OBC%segment(OBC%segnum_u(I,j))%open) then + slope_x(I,j,K) = 0. + ! This and/or the masking code below is to make slopes match inside + ! land mask. Might not be necessary except for DEBUG output. +! if (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_E) then +! slope_x(I+1,j,K) = 0. +! else +! slope_x(I-1,j,K) = 0. +! endif + endif + slope_x(I,j,K) = slope_x(I,j,k) * max(g%mask2dT(i,j),g%mask2dT(i+1,j)) + endif enddo ! I enddo ; enddo ! end of j-loop @@ -256,7 +281,8 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, & ! Calculate the meridional isopycnal slope. !$OMP parallel do default(none) shared(nz,is,ie,js,je,IsdB,use_EOS,G,GV,US,pres,T,S,tv, & !$OMP h,h_neglect,e,dz_neglect,Z_to_L,L_to_Z,H_to_Z, & - !$OMP h_neglect2,present_N2_v,G_Rho0,N2_v,slope_y,EOSdom_v) & + !$OMP h_neglect2,present_N2_v,G_Rho0,N2_v,slope_y,EOSdom_v, & + !$OMP local_open_v_BC,OBC) & !$OMP private(drdjA,drdjB,drdkL,drdkR,pres_v,T_v,S_v, & !$OMP drho_dT_v,drho_dS_v,hg2A,hg2B,hg2L,hg2R,haA, & !$OMP haB,haL,haR,dzaL,dzaR,wtA,wtB,wtL,wtR,drdz, & @@ -333,6 +359,19 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, & else ! With .not.use_EOS, the layers are constant density. slope_y(i,J,K) = (Z_to_L*(e(i,j,K)-e(i,j+1,K))) * G%IdyCv(i,J) endif + if (local_open_v_BC) then + if (OBC%segment(OBC%segnum_v(i,J))%open) then + slope_y(i,J,K) = 0. + ! This and/or the masking code below is to make slopes match inside + ! land mask. Might not be necessary except for DEBUG output. +! if (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_N) then +! slope_y(i,J+1,K) = 0. +! else +! slope_y(i,J-1,K) = 0. +! endif + endif + slope_y(i,J,K) = slope_y(i,J,k) * max(g%mask2dT(i,j),g%mask2dT(i,j+1)) + endif enddo ! i enddo ; enddo ! end of j-loop diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index 1f973f39ca..c0e64db491 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -9,7 +9,7 @@ module MOM_open_boundary use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end, CLOCK_ROUTINE use MOM_diag_mediator, only : diag_ctrl, time_type use MOM_domains, only : pass_var, pass_vector -use MOM_domains, only : To_All, SCALAR_PAIR, CGRID_NE +use MOM_domains, only : To_All, SCALAR_PAIR, CGRID_NE, CORNER use MOM_error_handler, only : MOM_mesg, MOM_error, FATAL, WARNING, is_root_pe use MOM_error_handler, only : NOTE use MOM_file_parser, only : get_param, log_version, param_file_type, log_param @@ -343,9 +343,12 @@ subroutine open_boundary_config(G, US, param_file, OBC) real :: Lscale_in, Lscale_out ! parameters controlling tracer values at the boundaries [L ~> m] allocate(OBC) + call get_param(param_file, mdl, "OBC_NUMBER_OF_SEGMENTS", OBC%number_of_segments, & + default=0, do_not_log=.true.) call log_version(param_file, mdl, version, & "Controls where open boundaries are located, what kind of boundary condition "//& - "to impose, and what data to apply, if any.") + "to impose, and what data to apply, if any.", & + all_default=(OBC%number_of_segments<=0)) call get_param(param_file, mdl, "OBC_NUMBER_OF_SEGMENTS", OBC%number_of_segments, & "The number of open boundary segments.", & default=0) @@ -1595,6 +1598,11 @@ subroutine open_boundary_init(G, GV, US, param_file, OBC, restart_CSp) if (.not.associated(OBC)) return id_clock_pass = cpu_clock_id('(Ocean OBC halo updates)', grain=CLOCK_ROUTINE) + if (OBC%radiation_BCs_exist_globally) call pass_vector(OBC%rx_normal, OBC%ry_normal, G%Domain, & + To_All+Scalar_Pair) + if (OBC%oblique_BCs_exist_globally) call pass_vector(OBC%rx_oblique, OBC%ry_oblique, G%Domain, & + To_All+Scalar_Pair) + if (associated(OBC%cff_normal)) call pass_var(OBC%cff_normal, G%Domain, position=CORNER) ! The rx_normal and ry_normal arrays used with radiation OBCs are currently in units of grid ! points per timestep, but if this were to be corrected to [L T-1 ~> m s-1] or [T-1 ~> s-1] to diff --git a/src/core/MOM_verticalGrid.F90 b/src/core/MOM_verticalGrid.F90 index 2823175b23..6e65d38c8a 100644 --- a/src/core/MOM_verticalGrid.F90 +++ b/src/core/MOM_verticalGrid.F90 @@ -92,7 +92,8 @@ subroutine verticalGridInit( param_file, GV, US ) ! Read all relevant parameters and write them to the model log. call log_version(param_file, mdl, version, & - "Parameters providing information about the vertical grid.") + "Parameters providing information about the vertical grid.", & + log_to_all=.true., debugging=.true.) call get_param(param_file, mdl, "G_EARTH", GV%g_Earth, & "The gravitational acceleration of the Earth.", & units="m s-2", default = 9.80, scale=US%Z_to_m*US%m_s_to_L_T**2) diff --git a/src/diagnostics/MOM_PointAccel.F90 b/src/diagnostics/MOM_PointAccel.F90 index 4ad1b67314..f6326b06fa 100644 --- a/src/diagnostics/MOM_PointAccel.F90 +++ b/src/diagnostics/MOM_PointAccel.F90 @@ -759,7 +759,7 @@ subroutine PointAccel_init(MIS, Time, G, param_file, diag, dirs, CS) CS%v_av => MIS%v_av; if (.not.associated(MIS%v_av)) CS%v_av => MIS%v(:,:,:) ! Read all relevant parameters and write them to the model log. - call log_version(param_file, mdl, version, "") + call log_version(param_file, mdl, version, "", debugging=.true.) call get_param(param_file, mdl, "U_TRUNC_FILE", CS%u_trunc_file, & "The absolute path to the file where the accelerations "//& "leading to zonal velocity truncations are written. \n"//& @@ -771,7 +771,7 @@ subroutine PointAccel_init(MIS, Time, G, param_file, diag, dirs, CS) "Leave this empty for efficiency if this diagnostic is "//& "not needed.", default="", debuggingParam=.true.) call get_param(param_file, mdl, "MAX_TRUNC_FILE_SIZE_PER_PE", CS%max_writes, & - "The maximum number of colums of truncations that any PE "//& + "The maximum number of columns of truncations that any PE "//& "will write out during a run.", default=50, debuggingParam=.true.) if (len_trim(dirs%output_directory) > 0) then @@ -779,8 +779,8 @@ subroutine PointAccel_init(MIS, Time, G, param_file, diag, dirs, CS) CS%u_trunc_file = trim(dirs%output_directory)//trim(CS%u_trunc_file) if (len_trim(CS%v_trunc_file) > 0) & CS%v_trunc_file = trim(dirs%output_directory)//trim(CS%v_trunc_file) - call log_param(param_file, mdl, "output_dir/U_TRUNC_FILE", CS%u_trunc_file) - call log_param(param_file, mdl, "output_dir/V_TRUNC_FILE", CS%v_trunc_file) + call log_param(param_file, mdl, "output_dir/U_TRUNC_FILE", CS%u_trunc_file, debuggingParam=.true.) + call log_param(param_file, mdl, "output_dir/V_TRUNC_FILE", CS%v_trunc_file, debuggingParam=.true.) endif CS%u_file = -1 ; CS%v_file = -1 ; CS%cols_written = 0 diff --git a/src/diagnostics/MOM_debugging.F90 b/src/diagnostics/MOM_debugging.F90 index 29f7f0f123..43c9c8c406 100644 --- a/src/diagnostics/MOM_debugging.F90 +++ b/src/diagnostics/MOM_debugging.F90 @@ -83,7 +83,7 @@ subroutine MOM_debugging_init(param_file) #include "version_variable.h" character(len=40) :: mdl = "MOM_debugging" ! This module's name. - call log_version(param_file, mdl, version) + call log_version(param_file, mdl, version, debugging=.true.) call get_param(param_file, mdl, "DEBUG", debug, & "If true, write out verbose debugging data.", & default=.false., debuggingParam=.true.) diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index 81f1e3cf15..f26e7fc815 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -15,7 +15,7 @@ module MOM_diagnostics use MOM_diag_mediator, only : diag_save_grids, diag_restore_grids, diag_copy_storage_to_diag use MOM_domains, only : create_group_pass, do_group_pass, group_pass_type use MOM_domains, only : To_North, To_East -use MOM_EOS, only : calculate_density, int_density_dz, EOS_domain +use MOM_EOS, only : calculate_density, calculate_density_derivs, int_density_dz, EOS_domain use MOM_EOS, only : gsw_sp_from_sr, gsw_pt_from_ct use MOM_error_handler, only : MOM_error, FATAL, WARNING use MOM_file_parser, only : get_param, log_version, param_file_type @@ -134,6 +134,7 @@ module MOM_diagnostics integer :: id_pbo = -1 integer :: id_thkcello = -1, id_rhoinsitu = -1 integer :: id_rhopot0 = -1, id_rhopot2 = -1 + integer :: id_drho_dT = -1, id_drho_dS = -1 integer :: id_h_pre_sync = -1 !>@} !> The control structure for calculating wave speed. @@ -619,6 +620,22 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & enddo if (CS%id_rhoinsitu > 0) call post_data(CS%id_rhoinsitu, Rcv, CS%diag) endif + + if (CS%id_drho_dT > 0 .or. CS%id_drho_dS > 0) then + !$OMP parallel do default(shared) private(pressure_1d) + do j=js,je + pressure_1d(:) = 0. ! Start at p=0 Pa at surface + do k=1,nz + pressure_1d(:) = pressure_1d(:) + 0.5 * h(:,j,k) * GV%H_to_Pa ! Pressure in middle of layer k + ! To avoid storing more arrays, put drho_dT into Rcv, and drho_dS into work3d + call calculate_density_derivs(tv%T(:,j,k),tv%S(:,j,k),pressure_1d, & + Rcv(:,j,k),work_3d(:,j,k),is,ie-is+1, tv%eqn_of_state) + pressure_1d(:) = pressure_1d(:) + 0.5 * h(:,j,k) * GV%H_to_Pa ! Pressure at bottom of layer k + enddo + enddo + if (CS%id_drho_dT > 0) call post_data(CS%id_drho_dT, Rcv, CS%diag) + if (CS%id_drho_dS > 0) call post_data(CS%id_drho_dS, work_3d, CS%diag) + endif endif if ((CS%id_cg1>0) .or. (CS%id_Rd1>0) .or. (CS%id_cfl_cg1>0) .or. & @@ -1478,7 +1495,7 @@ subroutine MOM_diagnostics_init(MIS, ADp, CDp, Time, G, GV, US, param_file, diag do_not_log=.true.) ! Read all relevant parameters and write them to the model log. - call log_version(param_file, mdl, version) + call log_version(param_file, mdl, version, "") call get_param(param_file, mdl, "DIAG_EBT_MONO_N2_COLUMN_FRACTION", CS%mono_N2_column_fraction, & "The lower fraction of water column over which N2 is limited as monotonic "// & "for the purposes of calculating the equivalent barotropic wave speed.", & @@ -1600,6 +1617,10 @@ subroutine MOM_diagnostics_init(MIS, ADp, CDp, Time, G, GV, US, param_file, diag 'Potential density referenced to 2000 dbar', 'kg m-3', conversion=US%R_to_kg_m3) CS%id_rhoinsitu = register_diag_field('ocean_model', 'rhoinsitu', diag%axesTL, Time, & 'In situ density', 'kg m-3', conversion=US%R_to_kg_m3) + CS%id_drho_dT = register_diag_field('ocean_model', 'drho_dT', diag%axesTL, Time, & + 'Partial derivative of rhoinsitu with respect to temperature (alpha)', 'kg m-3 degC-1') + CS%id_drho_dS = register_diag_field('ocean_model', 'drho_dS', diag%axesTL, Time, & + 'Partial derivative of rhoinsitu with respect to salinity (beta)', 'kg^2 g-1 m-3') CS%id_du_dt = register_diag_field('ocean_model', 'dudt', diag%axesCuL, Time, & 'Zonal Acceleration', 'm s-2', conversion=US%L_T2_to_m_s2) diff --git a/src/equation_of_state/TEOS10/gsw_chem_potential_water_t_exact.f90 b/src/equation_of_state/TEOS10/gsw_chem_potential_water_t_exact.f90 deleted file mode 100644 index ca1ac55956..0000000000 --- a/src/equation_of_state/TEOS10/gsw_chem_potential_water_t_exact.f90 +++ /dev/null @@ -1,82 +0,0 @@ -!========================================================================== -elemental function gsw_chem_potential_water_t_exact (sa, t, p) -!========================================================================== -! -! Calculates the chemical potential of water in seawater. -! -! SA = Absolute Salinity [ g/kg ] -! t = in-situ temperature (ITS-90) [ deg C ] -! p = sea pressure [ dbar ] -! ( i.e. absolute pressure - 10.1325 dbar ) -! -! chem_potential_water_t_exact = chemical potential of water in seawater -! [ J/g ] -!-------------------------------------------------------------------------- - -use gsw_mod_teos10_constants, only : gsw_sfac - -use gsw_mod_kinds - -implicit none - -real (r8), intent(in) :: sa, t, p - -real (r8) :: gsw_chem_potential_water_t_exact - -real (r8) :: g03_g, g08_g, g_sa_part, x, x2, y, z - -real (r8), parameter :: kg2g = 1e-3_r8 - -x2 = gsw_sfac*sa -x = sqrt(x2) -y = t*0.025_r8 -z = p*1e-4_r8 - -g03_g = 101.342743139674_r8 + z*(100015.695367145_r8 + & - z*(-2544.5765420363_r8 + z*(284.517778446287_r8 + & - z*(-33.3146754253611_r8 + (4.20263108803084_r8 - 0.546428511471039_r8*z)*z)))) + & - y*(5.90578347909402_r8 + z*(-270.983805184062_r8 + & - z*(776.153611613101_r8 + z*(-196.51255088122_r8 + (28.9796526294175_r8 - 2.13290083518327_r8*z)*z))) + & - y*(-12357.785933039_r8 + z*(1455.0364540468_r8 + & - z*(-756.558385769359_r8 + z*(273.479662323528_r8 + z*(-55.5604063817218_r8 + 4.34420671917197_r8*z)))) + & - y*(736.741204151612_r8 + z*(-672.50778314507_r8 + & - z*(499.360390819152_r8 + z*(-239.545330654412_r8 + (48.8012518593872_r8 - 1.66307106208905_r8*z)*z))) + & - y*(-148.185936433658_r8 + z*(397.968445406972_r8 + & - z*(-301.815380621876_r8 + (152.196371733841_r8 - 26.3748377232802_r8*z)*z)) + & - y*(58.0259125842571_r8 + z*(-194.618310617595_r8 + & - z*(120.520654902025_r8 + z*(-55.2723052340152_r8 + 6.48190668077221_r8*z))) + & - y*(-18.9843846514172_r8 + y*(3.05081646487967_r8 - 9.63108119393062_r8*z) + & - z*(63.5113936641785_r8 + z*(-22.2897317140459_r8 + 8.17060541818112_r8*z)))))))) - -g08_g = x2*(1416.27648484197_r8 + & - x*(-2432.14662381794_r8 + x*(2025.80115603697_r8 + & - y*(543.835333000098_r8 + y*(-68.5572509204491_r8 + & - y*(49.3667694856254_r8 + y*(-17.1397577419788_r8 + 2.49697009569508_r8*y))) - 22.6683558512829_r8*z) + & - x*(-1091.66841042967_r8 - 196.028306689776_r8*y + & - x*(374.60123787784_r8 - 48.5891069025409_r8*x + 36.7571622995805_r8*y) + 36.0284195611086_r8*z) + & - z*(-54.7919133532887_r8 + (-4.08193978912261_r8 - 30.1755111971161_r8*z)*z)) + & - z*(199.459603073901_r8 + z*(-52.2940909281335_r8 + (68.0444942726459_r8 - 3.41251932441282_r8*z)*z)) + & - y*(-493.407510141682_r8 + z*(-175.292041186547_r8 + (83.1923927801819_r8 - 29.483064349429_r8*z)*z) + & - y*(-43.0664675978042_r8 + z*(383.058066002476_r8 + z*(-54.1917262517112_r8 + 25.6398487389914_r8*z)) + & - y*(-10.0227370861875_r8 - 460.319931801257_r8*z + y*(0.875600661808945_r8 + 234.565187611355_r8*z))))) + & - y*(168.072408311545_r8)) - -g_sa_part = 8645.36753595126_r8 + & - x*(-7296.43987145382_r8 + x*(8103.20462414788_r8 + & - y*(2175.341332000392_r8 + y*(-274.2290036817964_r8 + & - y*(197.4670779425016_r8 + y*(-68.5590309679152_r8 + 9.98788038278032_r8*y))) - 90.6734234051316_r8*z) + & - x*(-5458.34205214835_r8 - 980.14153344888_r8*y + & - x*(2247.60742726704_r8 - 340.1237483177863_r8*x + 220.542973797483_r8*y) + 180.142097805543_r8*z) + & - z*(-219.1676534131548_r8 + (-16.32775915649044_r8 - 120.7020447884644_r8*z)*z)) + & - z*(598.378809221703_r8 + z*(-156.8822727844005_r8 + (204.1334828179377_r8 - 10.23755797323846_r8*z)*z)) + & - y*(-1480.222530425046_r8 + z*(-525.876123559641_r8 + (249.57717834054571_r8 - 88.449193048287_r8*z)*z) + & - y*(-129.1994027934126_r8 + z*(1149.174198007428_r8 + z*(-162.5751787551336_r8 + 76.9195462169742_r8*z)) + & - y*(-30.0682112585625_r8 - 1380.9597954037708_r8*z + y*(2.626801985426835_r8 + 703.695562834065_r8*z))))) + & - y*(1187.3715515697959_r8) - -gsw_chem_potential_water_t_exact = kg2g*(g03_g + g08_g - 0.5_r8*x2*g_sa_part) - -return -end function - -!-------------------------------------------------------------------------- diff --git a/src/equation_of_state/TEOS10/gsw_chem_potential_water_t_exact.f90 b/src/equation_of_state/TEOS10/gsw_chem_potential_water_t_exact.f90 new file mode 120000 index 0000000000..7ce7ff9e1e --- /dev/null +++ b/src/equation_of_state/TEOS10/gsw_chem_potential_water_t_exact.f90 @@ -0,0 +1 @@ +../../../pkg/GSW-Fortran/toolbox/gsw_chem_potential_water_t_exact.f90 \ No newline at end of file diff --git a/src/equation_of_state/TEOS10/gsw_ct_freezing_exact.f90 b/src/equation_of_state/TEOS10/gsw_ct_freezing_exact.f90 deleted file mode 100644 index 1627322dcd..0000000000 --- a/src/equation_of_state/TEOS10/gsw_ct_freezing_exact.f90 +++ /dev/null @@ -1,43 +0,0 @@ -!========================================================================== -elemental function gsw_ct_freezing_exact (sa, p, saturation_fraction) -!========================================================================== -! -! Calculates the Conservative Temperature at which seawater freezes. The -! Conservative Temperature freezing point is calculated from the exact -! in-situ freezing temperature which is found by a modified Newton-Raphson -! iteration (McDougall and Wotherspoon, 2013) of the equality of the -! chemical potentials of water in seawater and in ice. -! -! An alternative GSW function, gsw_CT_freezing_poly, it is based on a -! computationally-efficient polynomial, and is accurate to within -5e-4 K -! and 6e-4 K, when compared with this function. -! -! SA = Absolute Salinity [ g/kg ] -! p = sea pressure [ dbar ] -! ( i.e. absolute pressure - 10.1325 dbar ) -! saturation_fraction = the saturation fraction of dissolved air in -! seawater -! -! CT_freezing = Conservative Temperature at freezing of seawater [ deg C ] -!-------------------------------------------------------------------------- - -use gsw_mod_toolbox, only : gsw_t_freezing_exact -use gsw_mod_toolbox, only : gsw_ct_from_t - -use gsw_mod_kinds - -implicit none - -real (r8), intent(in) :: sa, p, saturation_fraction - -real (r8) :: gsw_ct_freezing_exact - -real (r8) :: t_freezing - -t_freezing = gsw_t_freezing_exact(sa,p,saturation_fraction) -gsw_ct_freezing_exact = gsw_ct_from_t(sa,t_freezing,p) - -return -end function - -!-------------------------------------------------------------------------- diff --git a/src/equation_of_state/TEOS10/gsw_ct_freezing_exact.f90 b/src/equation_of_state/TEOS10/gsw_ct_freezing_exact.f90 new file mode 120000 index 0000000000..696fe5c425 --- /dev/null +++ b/src/equation_of_state/TEOS10/gsw_ct_freezing_exact.f90 @@ -0,0 +1 @@ +../../../pkg/GSW-Fortran/toolbox/gsw_ct_freezing_exact.f90 \ No newline at end of file diff --git a/src/equation_of_state/TEOS10/gsw_ct_freezing_poly.f90 b/src/equation_of_state/TEOS10/gsw_ct_freezing_poly.f90 deleted file mode 100644 index a6b8f08091..0000000000 --- a/src/equation_of_state/TEOS10/gsw_ct_freezing_poly.f90 +++ /dev/null @@ -1,53 +0,0 @@ -!========================================================================== -elemental function gsw_ct_freezing_poly (sa, p, saturation_fraction) -!========================================================================== -! -! Calculates the Conservative Temperature at which seawater freezes. -! The error of this fit ranges between -5e-4 K and 6e-4 K when compared -! with the Conservative Temperature calculated from the exact in-situ -! freezing temperature which is found by a Newton-Raphson iteration of the -! equality of the chemical potentials of water in seawater and in ice. -! Note that the Conservative temperature freezing temperature can be found -! by this exact method using the function gsw_CT_freezing. -! -! SA = Absolute Salinity [ g/kg ] -! p = sea pressure [ dbar ] -! ( i.e. absolute pressure - 10.1325 dbar ) -! saturation_fraction = the saturation fraction of dissolved air in -! seawater -! -! CT_freezing = Conservative Temperature at freezing of seawater [ deg C ] -! That is, the freezing temperature expressed in -! terms of Conservative Temperature (ITS-90). -!-------------------------------------------------------------------------- - -use gsw_mod_teos10_constants, only : gsw_sso - -use gsw_mod_freezing_poly_coefficients - -use gsw_mod_kinds - -implicit none - -real (r8), intent(in) :: sa, p, saturation_fraction - -real (r8) :: gsw_ct_freezing_poly - -real (r8) :: p_r, sa_r, x - -sa_r = sa*1e-2_r8 -x = sqrt(sa_r) -p_r = p*1e-4_r8 - -gsw_ct_freezing_poly = c0 & - + sa_r*(c1 + x*(c2 + x*(c3 + x*(c4 + x*(c5 + c6*x))))) & - + p_r*(c7 + p_r*(c8 + c9*p_r)) + sa_r*p_r*(c10 + p_r*(c12 & - + p_r*(c15 + c21*sa_r)) + sa_r*(c13 + c17*p_r + c19*sa_r) & - + x*(c11 + p_r*(c14 + c18*p_r) + sa_r*(c16 + c20*p_r + c22*sa_r))) - -! Adjust for the effects of dissolved air -gsw_ct_freezing_poly = gsw_ct_freezing_poly - saturation_fraction* & - (1e-3_r8)*(2.4_r8 - a*sa)*(1.0_r8 + b*(1.0_r8 - sa/gsw_sso)) - -return -end function diff --git a/src/equation_of_state/TEOS10/gsw_ct_freezing_poly.f90 b/src/equation_of_state/TEOS10/gsw_ct_freezing_poly.f90 new file mode 120000 index 0000000000..84e6e12572 --- /dev/null +++ b/src/equation_of_state/TEOS10/gsw_ct_freezing_poly.f90 @@ -0,0 +1 @@ +../../../pkg/GSW-Fortran/toolbox/gsw_ct_freezing_poly.f90 \ No newline at end of file diff --git a/src/equation_of_state/TEOS10/gsw_ct_from_pt.f90 b/src/equation_of_state/TEOS10/gsw_ct_from_pt.f90 deleted file mode 100644 index c4a624ed37..0000000000 --- a/src/equation_of_state/TEOS10/gsw_ct_from_pt.f90 +++ /dev/null @@ -1,52 +0,0 @@ -!========================================================================== -elemental function gsw_ct_from_pt (sa, pt) -!========================================================================== -! -! Calculates Conservative Temperature from potential temperature of seawater -! -! sa : Absolute Salinity [g/kg] -! pt : potential temperature with [deg C] -! reference pressure of 0 dbar -! -! gsw_ct_from_pt : Conservative Temperature [deg C] -!-------------------------------------------------------------------------- - -use gsw_mod_teos10_constants, only : gsw_cp0, gsw_sfac - -use gsw_mod_kinds - -implicit none - -real (r8), intent(in) :: sa, pt - -real (r8) :: gsw_ct_from_pt - -real (r8) :: pot_enthalpy, x2, x, y - -x2 = gsw_sfac*sa -x = sqrt(x2) -y = pt*0.025_r8 ! normalize for F03 and F08 - -pot_enthalpy = 61.01362420681071_r8 + y*(168776.46138048015_r8 + & - y*(-2735.2785605119625_r8 + y*(2574.2164453821433_r8 + & - y*(-1536.6644434977543_r8 + y*(545.7340497931629_r8 + & - (-50.91091728474331_r8 - 18.30489878927802_r8*y)*y))))) + & - x2*(268.5520265845071_r8 + y*(-12019.028203559312_r8 + & - y*(3734.858026725145_r8 + y*(-2046.7671145057618_r8 + & - y*(465.28655623826234_r8 + (-0.6370820302376359_r8 - & - 10.650848542359153_r8*y)*y)))) + & - x*(937.2099110620707_r8 + y*(588.1802812170108_r8 + & - y*(248.39476522971285_r8 + (-3.871557904936333_r8 - & - 2.6268019854268356_r8*y)*y)) + & - x*(-1687.914374187449_r8 + x*(246.9598888781377_r8 + & - x*(123.59576582457964_r8 - 48.5891069025409_r8*x)) + & - y*(936.3206544460336_r8 + & - y*(-942.7827304544439_r8 + y*(369.4389437509002_r8 + & - (-33.83664947895248_r8 - 9.987880382780322_r8*y)*y)))))) - -gsw_ct_from_pt = pot_enthalpy/gsw_cp0 - -return -end function - -!-------------------------------------------------------------------------- diff --git a/src/equation_of_state/TEOS10/gsw_ct_from_pt.f90 b/src/equation_of_state/TEOS10/gsw_ct_from_pt.f90 new file mode 120000 index 0000000000..d67d2df3e2 --- /dev/null +++ b/src/equation_of_state/TEOS10/gsw_ct_from_pt.f90 @@ -0,0 +1 @@ +../../../pkg/GSW-Fortran/toolbox/gsw_ct_from_pt.f90 \ No newline at end of file diff --git a/src/equation_of_state/TEOS10/gsw_ct_from_t.f90 b/src/equation_of_state/TEOS10/gsw_ct_from_t.f90 deleted file mode 100644 index b2a0c9e354..0000000000 --- a/src/equation_of_state/TEOS10/gsw_ct_from_t.f90 +++ /dev/null @@ -1,32 +0,0 @@ -!========================================================================== -elemental function gsw_ct_from_t (sa, t, p) -!========================================================================== -! -! Calculates Conservative Temperature from in-situ temperature -! -! sa : Absolute Salinity [g/kg] -! t : in-situ temperature [deg C] -! p : sea pressure [dbar] -! -! gsw_ct_from_t : Conservative Temperature [deg C] -!-------------------------------------------------------------------------- - -use gsw_mod_toolbox, only : gsw_ct_from_pt, gsw_pt0_from_t - -use gsw_mod_kinds - -implicit none - -real (r8), intent(in) :: sa, t, p - -real (r8) :: gsw_ct_from_t - -real (r8) :: pt0 - -pt0 = gsw_pt0_from_t(sa,t,p) -gsw_ct_from_t = gsw_ct_from_pt(sa,pt0) - -return -end function - -!-------------------------------------------------------------------------- diff --git a/src/equation_of_state/TEOS10/gsw_ct_from_t.f90 b/src/equation_of_state/TEOS10/gsw_ct_from_t.f90 new file mode 120000 index 0000000000..6f917027b3 --- /dev/null +++ b/src/equation_of_state/TEOS10/gsw_ct_from_t.f90 @@ -0,0 +1 @@ +../../../pkg/GSW-Fortran/toolbox/gsw_ct_from_t.f90 \ No newline at end of file diff --git a/src/equation_of_state/TEOS10/gsw_entropy_part.f90 b/src/equation_of_state/TEOS10/gsw_entropy_part.f90 deleted file mode 100644 index 70fcd11255..0000000000 --- a/src/equation_of_state/TEOS10/gsw_entropy_part.f90 +++ /dev/null @@ -1,62 +0,0 @@ -!========================================================================== -elemental function gsw_entropy_part (sa, t, p) -!========================================================================== -! -! entropy minus the terms that are a function of only SA -! -! sa : Absolute Salinity [g/kg] -! t : in-situ temperature [deg C] -! p : sea pressure [dbar] -! -! gsw_entropy_part : entropy part -!-------------------------------------------------------------------------- - -use gsw_mod_teos10_constants, only : gsw_sfac - -use gsw_mod_kinds - -implicit none - -real (r8), intent(in) :: sa, t, p - -real (r8) :: gsw_entropy_part - -real (r8) :: x2, x, y, z, g03, g08 - -x2 = gsw_sfac*sa -x = sqrt(x2) -y = t*0.025_r8 -z = p*1e-4_r8 - -g03 = z*(-270.983805184062_r8 + & - z*(776.153611613101_r8 + z*(-196.51255088122_r8 + (28.9796526294175_r8 - 2.13290083518327_r8*z)*z))) + & - y*(-24715.571866078_r8 + z*(2910.0729080936_r8 + & - z*(-1513.116771538718_r8 + z*(546.959324647056_r8 + z*(-111.1208127634436_r8 + 8.68841343834394_r8*z)))) + & - y*(2210.2236124548363_r8 + z*(-2017.52334943521_r8 + & - z*(1498.081172457456_r8 + z*(-718.6359919632359_r8 + (146.4037555781616_r8 - 4.9892131862671505_r8*z)*z))) + & - y*(-592.743745734632_r8 + z*(1591.873781627888_r8 + & - z*(-1207.261522487504_r8 + (608.785486935364_r8 - 105.4993508931208_r8*z)*z)) + & - y*(290.12956292128547_r8 + z*(-973.091553087975_r8 + & - z*(602.603274510125_r8 + z*(-276.361526170076_r8 + 32.40953340386105_r8*z))) + & - y*(-113.90630790850321_r8 + y*(21.35571525415769_r8 - 67.41756835751434_r8*z) + & - z*(381.06836198507096_r8 + z*(-133.7383902842754_r8 + 49.023632509086724_r8*z))))))) - -g08 = x2*(z*(729.116529735046_r8 + & - z*(-343.956902961561_r8 + z*(124.687671116248_r8 + z*(-31.656964386073_r8 + 7.04658803315449_r8*z)))) + & - x*( x*(y*(-137.1145018408982_r8 + y*(148.10030845687618_r8 + y*(-68.5590309679152_r8 + 12.4848504784754_r8*y))) - & - 22.6683558512829_r8*z) + z*(-175.292041186547_r8 + (83.1923927801819_r8 - 29.483064349429_r8*z)*z) + & - y*(-86.1329351956084_r8 + z*(766.116132004952_r8 + z*(-108.3834525034224_r8 + 51.2796974779828_r8*z)) + & - y*(-30.0682112585625_r8 - 1380.9597954037708_r8*z + y*(3.50240264723578_r8 + 938.26075044542_r8*z)))) + & - y*(1760.062705994408_r8 + y*(-675.802947790203_r8 + & - y*(365.7041791005036_r8 + y*(-108.30162043765552_r8 + 12.78101825083098_r8*y) + & - z*(-1190.914967948748_r8 + (298.904564555024_r8 - 145.9491676006352_r8*z)*z)) + & - z*(2082.7344423998043_r8 + z*(-614.668925894709_r8 + (340.685093521782_r8 - 33.3848202979239_r8*z)*z))) + & - z*(-1721.528607567954_r8 + z*(674.819060538734_r8 + & - z*(-356.629112415276_r8 + (88.4080716616_r8 - 15.84003094423364_r8*z)*z))))) - -gsw_entropy_part = -(g03 + g08)*0.025_r8 - -return -end function - -!-------------------------------------------------------------------------- diff --git a/src/equation_of_state/TEOS10/gsw_entropy_part.f90 b/src/equation_of_state/TEOS10/gsw_entropy_part.f90 new file mode 120000 index 0000000000..0160db551f --- /dev/null +++ b/src/equation_of_state/TEOS10/gsw_entropy_part.f90 @@ -0,0 +1 @@ +../../../pkg/GSW-Fortran/toolbox/gsw_entropy_part.f90 \ No newline at end of file diff --git a/src/equation_of_state/TEOS10/gsw_entropy_part_zerop.f90 b/src/equation_of_state/TEOS10/gsw_entropy_part_zerop.f90 deleted file mode 100644 index 2156b71c4e..0000000000 --- a/src/equation_of_state/TEOS10/gsw_entropy_part_zerop.f90 +++ /dev/null @@ -1,44 +0,0 @@ -!========================================================================== -elemental function gsw_entropy_part_zerop (sa, pt0) -!========================================================================== -! -! entropy part evaluated at the sea surface -! -! sa : Absolute Salinity [g/kg] -! pt0 : insitu temperature [deg C] -! -! gsw_entropy_part_zerop : entropy part at the sea surface -!-------------------------------------------------------------------------- - -use gsw_mod_teos10_constants, only : gsw_sfac - -use gsw_mod_kinds - -implicit none - -real (r8), intent(in) :: sa, pt0 - -real (r8) :: gsw_entropy_part_zerop - -real (r8) :: x2, x, y, g03, g08 - -x2 = gsw_sfac*sa -x = sqrt(x2) -y = pt0*0.025_r8 - -g03 = y*(-24715.571866078_r8 + y*(2210.2236124548363_r8 + & - y*(-592.743745734632_r8 + y*(290.12956292128547_r8 + & - y*(-113.90630790850321_r8 + y*21.35571525415769_r8))))) - -g08 = x2*(x*(x*(y*(-137.1145018408982_r8 + y*(148.10030845687618_r8 + & - y*(-68.5590309679152_r8 + 12.4848504784754_r8*y)))) + & - y*(-86.1329351956084_r8 + y*(-30.0682112585625_r8 + y*3.50240264723578_r8))) + & - y*(1760.062705994408_r8 + y*(-675.802947790203_r8 + & - y*(365.7041791005036_r8 + y*(-108.30162043765552_r8 + 12.78101825083098_r8*y))))) - -gsw_entropy_part_zerop = -(g03 + g08)*0.025_r8 - -return -end function - -!-------------------------------------------------------------------------- diff --git a/src/equation_of_state/TEOS10/gsw_entropy_part_zerop.f90 b/src/equation_of_state/TEOS10/gsw_entropy_part_zerop.f90 new file mode 120000 index 0000000000..678bce8822 --- /dev/null +++ b/src/equation_of_state/TEOS10/gsw_entropy_part_zerop.f90 @@ -0,0 +1 @@ +../../../pkg/GSW-Fortran/toolbox/gsw_entropy_part_zerop.f90 \ No newline at end of file diff --git a/src/equation_of_state/TEOS10/gsw_gibbs.f90 b/src/equation_of_state/TEOS10/gsw_gibbs.f90 deleted file mode 100644 index 59f7d221ac..0000000000 --- a/src/equation_of_state/TEOS10/gsw_gibbs.f90 +++ /dev/null @@ -1,317 +0,0 @@ -!========================================================================== -elemental function gsw_gibbs (ns, nt, np, sa, t, p) -!========================================================================== -! -! seawater specific Gibbs free energy and derivatives up to order 2 -! -! ns : order of s derivative -! nt : order of t derivative -! np : order of p derivative -! sa : Absolute Salinity [g/kg] -! t : temperature [deg C] -! p : sea pressure [dbar] -! -! gsw_gibbs : specific Gibbs energy or its derivative -!-------------------------------------------------------------------------- - -use gsw_mod_teos10_constants, only : gsw_sfac - -use gsw_mod_kinds - -implicit none - -integer, intent(in) :: ns, nt, np -real (r8), intent(in) :: sa, t, p - -real (r8) :: gsw_gibbs - -real (r8) :: x2, x, y, z, g03, g08 - -x2 = gsw_sfac*sa -x = sqrt(x2) -y = t*0.025_r8 -z = p*1e-4_r8 - -if(ns.eq.0 .and. nt.eq.0 .and. np.eq.0) then - - g03 = 101.342743139674_r8 + z*(100015.695367145_r8 + & - z*(-2544.5765420363_r8 + z*(284.517778446287_r8 + & - z*(-33.3146754253611_r8 + (4.20263108803084_r8 - 0.546428511471039_r8*z)*z)))) + & - y*(5.90578347909402_r8 + z*(-270.983805184062_r8 + & - z*(776.153611613101_r8 + z*(-196.51255088122_r8 + (28.9796526294175_r8 - 2.13290083518327_r8*z)*z))) + & - y*(-12357.785933039_r8 + z*(1455.0364540468_r8 + & - z*(-756.558385769359_r8 + z*(273.479662323528_r8 + z*(-55.5604063817218_r8 + 4.34420671917197_r8*z)))) + & - y*(736.741204151612_r8 + z*(-672.50778314507_r8 + & - z*(499.360390819152_r8 + z*(-239.545330654412_r8 + (48.8012518593872_r8 - 1.66307106208905_r8*z)*z))) + & - y*(-148.185936433658_r8 + z*(397.968445406972_r8 + & - z*(-301.815380621876_r8 + (152.196371733841_r8 - 26.3748377232802_r8*z)*z)) + & - y*(58.0259125842571_r8 + z*(-194.618310617595_r8 + & - z*(120.520654902025_r8 + z*(-55.2723052340152_r8 + 6.48190668077221_r8*z))) + & - y*(-18.9843846514172_r8 + y*(3.05081646487967_r8 - 9.63108119393062_r8*z) + & - z*(63.5113936641785_r8 + z*(-22.2897317140459_r8 + 8.17060541818112_r8*z)))))))) - - g08 = x2*(1416.27648484197_r8 + z*(-3310.49154044839_r8 + & - z*(384.794152978599_r8 + z*(-96.5324320107458_r8 + (15.8408172766824_r8 - 2.62480156590992_r8*z)*z))) + & - x*(-2432.14662381794_r8 + x*(2025.80115603697_r8 + & - y*(543.835333000098_r8 + y*(-68.5572509204491_r8 + & - y*(49.3667694856254_r8 + y*(-17.1397577419788_r8 + 2.49697009569508_r8*y))) - 22.6683558512829_r8*z) + & - x*(-1091.66841042967_r8 - 196.028306689776_r8*y + & - x*(374.60123787784_r8 - 48.5891069025409_r8*x + 36.7571622995805_r8*y) + 36.0284195611086_r8*z) + & - z*(-54.7919133532887_r8 + (-4.08193978912261_r8 - 30.1755111971161_r8*z)*z)) + & - z*(199.459603073901_r8 + z*(-52.2940909281335_r8 + (68.0444942726459_r8 - 3.41251932441282_r8*z)*z)) + & - y*(-493.407510141682_r8 + z*(-175.292041186547_r8 + (83.1923927801819_r8 - 29.483064349429_r8*z)*z) + & - y*(-43.0664675978042_r8 + z*(383.058066002476_r8 + z*(-54.1917262517112_r8 + 25.6398487389914_r8*z)) + & - y*(-10.0227370861875_r8 - 460.319931801257_r8*z + y*(0.875600661808945_r8 + 234.565187611355_r8*z))))) + & - y*(168.072408311545_r8 + z*(729.116529735046_r8 + & - z*(-343.956902961561_r8 + z*(124.687671116248_r8 + z*(-31.656964386073_r8 + 7.04658803315449_r8*z)))) + & - y*(880.031352997204_r8 + y*(-225.267649263401_r8 + & - y*(91.4260447751259_r8 + y*(-21.6603240875311_r8 + 2.13016970847183_r8*y) + & - z*(-297.728741987187_r8 + (74.726141138756_r8 - 36.4872919001588_r8*z)*z)) + & - z*(694.244814133268_r8 + z*(-204.889641964903_r8 + (113.561697840594_r8 - 11.1282734326413_r8*z)*z))) + & - z*(-860.764303783977_r8 + z*(337.409530269367_r8 + & - z*(-178.314556207638_r8 + (44.2040358308_r8 - 7.92001547211682_r8*z)*z)))))) - - if(sa.gt.0.0_r8) & - g08 = g08 + x2*(5812.81456626732_r8 + 851.226734946706_r8*y)*log(x) - - gsw_gibbs = g03 + g08 - -elseif(ns.eq.1 .and. nt.eq.0 .and. np.eq.0) then - - g08 = 8645.36753595126_r8 + z*(-6620.98308089678_r8 + & - z*(769.588305957198_r8 + z*(-193.0648640214916_r8 + (31.6816345533648_r8 - 5.24960313181984_r8*z)*z))) + & - x*(-7296.43987145382_r8 + x*(8103.20462414788_r8 + & - y*(2175.341332000392_r8 + y*(-274.2290036817964_r8 + & - y*(197.4670779425016_r8 + y*(-68.5590309679152_r8 + 9.98788038278032_r8*y))) - 90.6734234051316_r8*z) + & - x*(-5458.34205214835_r8 - 980.14153344888_r8*y + & - x*(2247.60742726704_r8 - 340.1237483177863_r8*x + 220.542973797483_r8*y) + 180.142097805543_r8*z) + & - z*(-219.1676534131548_r8 + (-16.32775915649044_r8 - 120.7020447884644_r8*z)*z)) + & - z*(598.378809221703_r8 + z*(-156.8822727844005_r8 + (204.1334828179377_r8 - 10.23755797323846_r8*z)*z)) + & - y*(-1480.222530425046_r8 + z*(-525.876123559641_r8 + (249.57717834054571_r8 - 88.449193048287_r8*z)*z) + & - y*(-129.1994027934126_r8 + z*(1149.174198007428_r8 + z*(-162.5751787551336_r8 + 76.9195462169742_r8*z)) + & - y*(-30.0682112585625_r8 - 1380.9597954037708_r8*z + y*(2.626801985426835_r8 + 703.695562834065_r8*z))))) + & - y*(1187.3715515697959_r8 + z*(1458.233059470092_r8 + & - z*(-687.913805923122_r8 + z*(249.375342232496_r8 + z*(-63.313928772146_r8 + 14.09317606630898_r8*z)))) + & - y*(1760.062705994408_r8 + y*(-450.535298526802_r8 + & - y*(182.8520895502518_r8 + y*(-43.3206481750622_r8 + 4.26033941694366_r8*y) + & - z*(-595.457483974374_r8 + (149.452282277512_r8 - 72.9745838003176_r8*z)*z)) + & - z*(1388.489628266536_r8 + z*(-409.779283929806_r8 + (227.123395681188_r8 - 22.2565468652826_r8*z)*z))) + & - z*(-1721.528607567954_r8 + z*(674.819060538734_r8 + & - z*(-356.629112415276_r8 + (88.4080716616_r8 - 15.84003094423364_r8*z)*z))))) - - if(sa.gt.0_r8) then - g08 = g08 + (11625.62913253464_r8 + 1702.453469893412_r8*y)*log(x) - else - g08 = 0.0_r8 - endif - - gsw_gibbs = 0.5*gsw_sfac*g08 - -elseif(ns.eq.0 .and. nt.eq.1 .and. np.eq.0) then - - g03 = 5.90578347909402_r8 + z*(-270.983805184062_r8 + & - z*(776.153611613101_r8 + z*(-196.51255088122_r8 + (28.9796526294175_r8 - 2.13290083518327_r8*z)*z))) + & - y*(-24715.571866078_r8 + z*(2910.0729080936_r8 + & - z*(-1513.116771538718_r8 + z*(546.959324647056_r8 + z*(-111.1208127634436_r8 + 8.68841343834394_r8*z)))) + & - y*(2210.2236124548363_r8 + z*(-2017.52334943521_r8 + & - z*(1498.081172457456_r8 + z*(-718.6359919632359_r8 + (146.4037555781616_r8 - 4.9892131862671505_r8*z)*z))) + & - y*(-592.743745734632_r8 + z*(1591.873781627888_r8 + & - z*(-1207.261522487504_r8 + (608.785486935364_r8 - 105.4993508931208_r8*z)*z)) + & - y*(290.12956292128547_r8 + z*(-973.091553087975_r8 + & - z*(602.603274510125_r8 + z*(-276.361526170076_r8 + 32.40953340386105_r8*z))) + & - y*(-113.90630790850321_r8 + y*(21.35571525415769_r8 - 67.41756835751434_r8*z) + & - z*(381.06836198507096_r8 + z*(-133.7383902842754_r8 + 49.023632509086724_r8*z))))))) - - g08 = x2*(168.072408311545_r8 + z*(729.116529735046_r8 + & - z*(-343.956902961561_r8 + z*(124.687671116248_r8 + z*(-31.656964386073_r8 + 7.04658803315449_r8*z)))) + & - x*(-493.407510141682_r8 + x*(543.835333000098_r8 + x*(-196.028306689776_r8 + 36.7571622995805_r8*x) + & - y*(-137.1145018408982_r8 + y*(148.10030845687618_r8 + y*(-68.5590309679152_r8 + 12.4848504784754_r8*y))) - & - 22.6683558512829_r8*z) + z*(-175.292041186547_r8 + (83.1923927801819_r8 - 29.483064349429_r8*z)*z) + & - y*(-86.1329351956084_r8 + z*(766.116132004952_r8 + z*(-108.3834525034224_r8 + 51.2796974779828_r8*z)) + & - y*(-30.0682112585625_r8 - 1380.9597954037708_r8*z + y*(3.50240264723578_r8 + 938.26075044542_r8*z)))) + & - y*(1760.062705994408_r8 + y*(-675.802947790203_r8 + & - y*(365.7041791005036_r8 + y*(-108.30162043765552_r8 + 12.78101825083098_r8*y) + & - z*(-1190.914967948748_r8 + (298.904564555024_r8 - 145.9491676006352_r8*z)*z)) + & - z*(2082.7344423998043_r8 + z*(-614.668925894709_r8 + (340.685093521782_r8 - 33.3848202979239_r8*z)*z))) + & - z*(-1721.528607567954_r8 + z*(674.819060538734_r8 + & - z*(-356.629112415276_r8 + (88.4080716616_r8 - 15.84003094423364_r8*z)*z))))) - - if(sa.gt.0_r8) g08 = g08 + 851.226734946706_r8*x2*log(x) - - gsw_gibbs = (g03 + g08)*0.025_r8 - -elseif(ns.eq.0 .and. nt.eq.0 .and. np.eq.1) then - - g03 = 100015.695367145_r8 + z*(-5089.1530840726_r8 + & - z*(853.5533353388611_r8 + z*(-133.2587017014444_r8 + (21.0131554401542_r8 - 3.278571068826234_r8*z)*z))) + & - y*(-270.983805184062_r8 + z*(1552.307223226202_r8 + & - z*(-589.53765264366_r8 + (115.91861051767_r8 - 10.664504175916349_r8*z)*z)) + & - y*(1455.0364540468_r8 + z*(-1513.116771538718_r8 + & - z*(820.438986970584_r8 + z*(-222.2416255268872_r8 + 21.72103359585985_r8*z))) + & - y*(-672.50778314507_r8 + z*(998.720781638304_r8 + & - z*(-718.6359919632359_r8 + (195.2050074375488_r8 - 8.31535531044525_r8*z)*z)) + & - y*(397.968445406972_r8 + z*(-603.630761243752_r8 + (456.589115201523_r8 - 105.4993508931208_r8*z)*z) + & - y*(-194.618310617595_r8 + y*(63.5113936641785_r8 - 9.63108119393062_r8*y + & - z*(-44.5794634280918_r8 + 24.511816254543362_r8*z)) + & - z*(241.04130980405_r8 + z*(-165.8169157020456_r8 + & - 25.92762672308884_r8*z))))))) - - g08 = x2*(-3310.49154044839_r8 + z*(769.588305957198_r8 + & - z*(-289.5972960322374_r8 + (63.3632691067296_r8 - 13.1240078295496_r8*z)*z)) + & - x*(199.459603073901_r8 + x*(-54.7919133532887_r8 + 36.0284195611086_r8*x - 22.6683558512829_r8*y + & - (-8.16387957824522_r8 - 90.52653359134831_r8*z)*z) + & - z*(-104.588181856267_r8 + (204.1334828179377_r8 - 13.65007729765128_r8*z)*z) + & - y*(-175.292041186547_r8 + (166.3847855603638_r8 - 88.449193048287_r8*z)*z + & - y*(383.058066002476_r8 + y*(-460.319931801257_r8 + 234.565187611355_r8*y) + & - z*(-108.3834525034224_r8 + 76.9195462169742_r8*z)))) + & - y*(729.116529735046_r8 + z*(-687.913805923122_r8 + & - z*(374.063013348744_r8 + z*(-126.627857544292_r8 + 35.23294016577245_r8*z))) + & - y*(-860.764303783977_r8 + y*(694.244814133268_r8 + & - y*(-297.728741987187_r8 + (149.452282277512_r8 - 109.46187570047641_r8*z)*z) + & - z*(-409.779283929806_r8 + (340.685093521782_r8 - 44.5130937305652_r8*z)*z)) + & - z*(674.819060538734_r8 + z*(-534.943668622914_r8 + (176.8161433232_r8 - 39.600077360584095_r8*z)*z))))) - - gsw_gibbs = (g03 + g08)*1e-8_r8 - -elseif(ns.eq.0 .and. nt.eq.2 .and. np.eq.0) then - - g03 = -24715.571866078_r8 + z*(2910.0729080936_r8 + z* & - (-1513.116771538718_r8 + z*(546.959324647056_r8 + z*(-111.1208127634436_r8 + 8.68841343834394_r8*z)))) + & - y*(4420.4472249096725_r8 + z*(-4035.04669887042_r8 + & - z*(2996.162344914912_r8 + z*(-1437.2719839264719_r8 + (292.8075111563232_r8 - 9.978426372534301_r8*z)*z))) + & - y*(-1778.231237203896_r8 + z*(4775.621344883664_r8 + & - z*(-3621.784567462512_r8 + (1826.356460806092_r8 - 316.49805267936244_r8*z)*z)) + & - y*(1160.5182516851419_r8 + z*(-3892.3662123519_r8 + & - z*(2410.4130980405_r8 + z*(-1105.446104680304_r8 + 129.6381336154442_r8*z))) + & - y*(-569.531539542516_r8 + y*(128.13429152494615_r8 - 404.50541014508605_r8*z) + & - z*(1905.341809925355_r8 + z*(-668.691951421377_r8 + 245.11816254543362_r8*z)))))) - - g08 = x2*(1760.062705994408_r8 + x*(-86.1329351956084_r8 + & - x*(-137.1145018408982_r8 + y*(296.20061691375236_r8 + y*(-205.67709290374563_r8 + 49.9394019139016_r8*y))) + & - z*(766.116132004952_r8 + z*(-108.3834525034224_r8 + 51.2796974779828_r8*z)) + & - y*(-60.136422517125_r8 - 2761.9195908075417_r8*z + y*(10.50720794170734_r8 + 2814.78225133626_r8*z))) + & - y*(-1351.605895580406_r8 + y*(1097.1125373015109_r8 + y*(-433.20648175062206_r8 + 63.905091254154904_r8*y) + & - z*(-3572.7449038462437_r8 + (896.713693665072_r8 - 437.84750280190565_r8*z)*z)) + & - z*(4165.4688847996085_r8 + z*(-1229.337851789418_r8 + (681.370187043564_r8 - 66.7696405958478_r8*z)*z))) + & - z*(-1721.528607567954_r8 + z*(674.819060538734_r8 + & - z*(-356.629112415276_r8 + (88.4080716616_r8 - 15.84003094423364_r8*z)*z)))) - - gsw_gibbs = (g03 + g08)*0.000625_r8 - -elseif(ns.eq.1 .and. nt.eq.0 .and. np.eq.1) then - - g08 = -6620.98308089678_r8 + z*(1539.176611914396_r8 + & - z*(-579.1945920644748_r8 + (126.7265382134592_r8 - 26.2480156590992_r8*z)*z)) + & - x*(598.378809221703_r8 + x*(-219.1676534131548_r8 + 180.142097805543_r8*x - 90.6734234051316_r8*y + & - (-32.65551831298088_r8 - 362.10613436539325_r8*z)*z) + & - z*(-313.764545568801_r8 + (612.4004484538132_r8 - 40.95023189295384_r8*z)*z) + & - y*(-525.876123559641_r8 + (499.15435668109143_r8 - 265.347579144861_r8*z)*z + & - y*(1149.174198007428_r8 + y*(-1380.9597954037708_r8 + 703.695562834065_r8*y) + & - z*(-325.1503575102672_r8 + 230.7586386509226_r8*z)))) + & - y*(1458.233059470092_r8 + z*(-1375.827611846244_r8 + & - z*(748.126026697488_r8 + z*(-253.255715088584_r8 + 70.4658803315449_r8*z))) + & - y*(-1721.528607567954_r8 + y*(1388.489628266536_r8 + & - y*(-595.457483974374_r8 + (298.904564555024_r8 - 218.92375140095282_r8*z)*z) + & - z*(-819.558567859612_r8 + (681.370187043564_r8 - 89.0261874611304_r8*z)*z)) + & - z*(1349.638121077468_r8 + z*(-1069.887337245828_r8 + (353.6322866464_r8 - 79.20015472116819_r8*z)*z)))) - - gsw_gibbs = g08*gsw_sfac*0.5e-8_r8 - -elseif(ns.eq.0 .and. nt.eq.1 .and. np.eq.1) then - - g03 = -270.983805184062_r8 + z*(1552.307223226202_r8 + z*(-589.53765264366_r8 + & - (115.91861051767_r8 - 10.664504175916349_r8*z)*z)) + & - y*(2910.0729080936_r8 + z*(-3026.233543077436_r8 + & - z*(1640.877973941168_r8 + z*(-444.4832510537744_r8 + 43.4420671917197_r8*z))) + & - y*(-2017.52334943521_r8 + z*(2996.162344914912_r8 + & - z*(-2155.907975889708_r8 + (585.6150223126464_r8 - 24.946065931335752_r8*z)*z)) + & - y*(1591.873781627888_r8 + z*(-2414.523044975008_r8 + (1826.356460806092_r8 - 421.9974035724832_r8*z)*z) + & - y*(-973.091553087975_r8 + z*(1205.20654902025_r8 + z*(-829.084578510228_r8 + 129.6381336154442_r8*z)) + & - y*(381.06836198507096_r8 - 67.41756835751434_r8*y + z*(-267.4767805685508_r8 + 147.07089752726017_r8*z)))))) - - g08 = x2*(729.116529735046_r8 + z*(-687.913805923122_r8 + & - z*(374.063013348744_r8 + z*(-126.627857544292_r8 + 35.23294016577245_r8*z))) + & - x*(-175.292041186547_r8 - 22.6683558512829_r8*x + (166.3847855603638_r8 - 88.449193048287_r8*z)*z + & - y*(766.116132004952_r8 + y*(-1380.9597954037708_r8 + 938.26075044542_r8*y) + & - z*(-216.7669050068448_r8 + 153.8390924339484_r8*z))) + & - y*(-1721.528607567954_r8 + y*(2082.7344423998043_r8 + & - y*(-1190.914967948748_r8 + (597.809129110048_r8 - 437.84750280190565_r8*z)*z) + & - z*(-1229.337851789418_r8 + (1022.055280565346_r8 - 133.5392811916956_r8*z)*z)) + & - z*(1349.638121077468_r8 + z*(-1069.887337245828_r8 + (353.6322866464_r8 - 79.20015472116819_r8*z)*z)))) - - gsw_gibbs = (g03 + g08)*2.5e-10_r8 - -elseif(ns.eq.1 .and. nt.eq.1 .and. np.eq.0) then - - g08 = 1187.3715515697959_r8 + z*(1458.233059470092_r8 + & - z*(-687.913805923122_r8 + z*(249.375342232496_r8 + z*(-63.313928772146_r8 + 14.09317606630898_r8*z)))) + & - x*(-1480.222530425046_r8 + x*(2175.341332000392_r8 + x*(-980.14153344888_r8 + 220.542973797483_r8*x) + & - y*(-548.4580073635929_r8 + y*(592.4012338275047_r8 + y*(-274.2361238716608_r8 + 49.9394019139016_r8*y))) - & - 90.6734234051316_r8*z) + z*(-525.876123559641_r8 + (249.57717834054571_r8 - 88.449193048287_r8*z)*z) + & - y*(-258.3988055868252_r8 + z*(2298.348396014856_r8 + z*(-325.1503575102672_r8 + 153.8390924339484_r8*z)) + & - y*(-90.2046337756875_r8 - 4142.8793862113125_r8*z + y*(10.50720794170734_r8 + 2814.78225133626_r8*z)))) + & - y*(3520.125411988816_r8 + y*(-1351.605895580406_r8 + & - y*(731.4083582010072_r8 + y*(-216.60324087531103_r8 + 25.56203650166196_r8*y) + & - z*(-2381.829935897496_r8 + (597.809129110048_r8 - 291.8983352012704_r8*z)*z)) + & - z*(4165.4688847996085_r8 + z*(-1229.337851789418_r8 + (681.370187043564_r8 - 66.7696405958478_r8*z)*z))) + & - z*(-3443.057215135908_r8 + z*(1349.638121077468_r8 + & - z*(-713.258224830552_r8 + (176.8161433232_r8 - 31.68006188846728_r8*z)*z)))) - - if(sa.gt.0_r8) g08 = g08 + 1702.453469893412_r8*log(x) - - gsw_gibbs = 0.5_r8*gsw_sfac*0.025_r8*g08 - -elseif(ns.eq.2 .and. nt.eq.0 .and. np.eq.0) then - - g08 = 2.0_r8*(8103.20462414788_r8 + & - y*(2175.341332000392_r8 + y*(-274.2290036817964_r8 + & - y*(197.4670779425016_r8 + y*(-68.5590309679152_r8 + 9.98788038278032_r8*y))) - 90.6734234051316_r8*z) + & - 1.5_r8*x*(-5458.34205214835_r8 - 980.14153344888_r8*y + & - (4.0_r8/3.0_r8)*x*(2247.60742726704_r8 - 340.1237483177863_r8*1.25_r8*x + 220.542973797483_r8*y) + & - 180.142097805543_r8*z) + & - z*(-219.1676534131548_r8 + (-16.32775915649044_r8 - 120.7020447884644_r8*z)*z)) - - if (x.gt.0_r8) then - g08 = g08 + (-7296.43987145382_r8 + z*(598.378809221703_r8 + & - z*(-156.8822727844005_r8 + (204.1334828179377_r8 - 10.23755797323846_r8*z)*z)) + & - y*(-1480.222530425046_r8 + z*(-525.876123559641_r8 + & - (249.57717834054571_r8 - 88.449193048287_r8*z)*z) + & - y*(-129.1994027934126_r8 + z*(1149.174198007428_r8 + & - z*(-162.5751787551336_r8 + 76.9195462169742_r8*z)) + & - y*(-30.0682112585625_r8 - 1380.9597954037708_r8*z + & - y*(2.626801985426835_r8 + 703.695562834065_r8*z)))))/x + & - (11625.62913253464_r8 + 1702.453469893412_r8*y)/x2 - else - g08 = 0.0_r8 - end if - - gsw_gibbs = 0.25_r8*gsw_sfac*gsw_sfac*g08 - -elseif(ns.eq.0 .and. nt.eq.0 .and. np.eq.2) then - - g03 = -5089.1530840726_r8 + z*(1707.1066706777221_r8 + & - z*(-399.7761051043332_r8 + (84.0526217606168_r8 - 16.39285534413117_r8*z)*z)) + & - y*(1552.307223226202_r8 + z*(-1179.07530528732_r8 + (347.75583155301_r8 - 42.658016703665396_r8*z)*z) + & - y*(-1513.116771538718_r8 + z*(1640.877973941168_r8 + z*(-666.7248765806615_r8 + 86.8841343834394_r8*z)) + & - y*(998.720781638304_r8 + z*(-1437.2719839264719_r8 + (585.6150223126464_r8 - 33.261421241781_r8*z)*z) + & - y*(-603.630761243752_r8 + (913.178230403046_r8 - 316.49805267936244_r8*z)*z + & - y*(241.04130980405_r8 + y*(-44.5794634280918_r8 + 49.023632509086724_r8*z) + & - z*(-331.6338314040912_r8 + 77.78288016926652_r8*z)))))) - - g08 = x2*(769.588305957198_r8 + z*(-579.1945920644748_r8 + (190.08980732018878_r8 - 52.4960313181984_r8*z)*z) + & - x*(-104.588181856267_r8 + x*(-8.16387957824522_r8 - 181.05306718269662_r8*z) + & - (408.2669656358754_r8 - 40.95023189295384_r8*z)*z + & - y*(166.3847855603638_r8 - 176.898386096574_r8*z + y*(-108.3834525034224_r8 + 153.8390924339484_r8*z))) + & - y*(-687.913805923122_r8 + z*(748.126026697488_r8 + z*(-379.883572632876_r8 + 140.9317606630898_r8*z)) + & - y*(674.819060538734_r8 + z*(-1069.887337245828_r8 + (530.4484299696_r8 - 158.40030944233638_r8*z)*z) + & - y*(-409.779283929806_r8 + y*(149.452282277512_r8 - 218.92375140095282_r8*z) + & - (681.370187043564_r8 - 133.5392811916956_r8*z)*z)))) - - gsw_gibbs = (g03 + g08)*1e-16_r8 - -end if - -return -end function - -!-------------------------------------------------------------------------- diff --git a/src/equation_of_state/TEOS10/gsw_gibbs.f90 b/src/equation_of_state/TEOS10/gsw_gibbs.f90 new file mode 120000 index 0000000000..6bb64d98a7 --- /dev/null +++ b/src/equation_of_state/TEOS10/gsw_gibbs.f90 @@ -0,0 +1 @@ +../../../pkg/GSW-Fortran/toolbox/gsw_gibbs.f90 \ No newline at end of file diff --git a/src/equation_of_state/TEOS10/gsw_gibbs_ice.f90 b/src/equation_of_state/TEOS10/gsw_gibbs_ice.f90 deleted file mode 100644 index 0416a1eeaf..0000000000 --- a/src/equation_of_state/TEOS10/gsw_gibbs_ice.f90 +++ /dev/null @@ -1,130 +0,0 @@ -! ========================================================================= -elemental function gsw_gibbs_ice (nt, np, t, p) -! ========================================================================= -! -! Ice specific Gibbs energy and derivatives up to order 2. -! -! nt = order of t derivative [ integers 0, 1 or 2 ] -! np = order of p derivative [ integers 0, 1 or 2 ] -! t = in-situ temperature (ITS-90) [ deg C ] -! p = sea pressure [ dbar ] -! -! gibbs_ice = Specific Gibbs energy of ice or its derivatives. -! The Gibbs energy (when nt = np = 0) has units of: [ J/kg ] -! The temperature derivatives are output in units of: -! [ (J/kg) (K)^(-nt) ] -! The pressure derivatives are output in units of: -! [ (J/kg) (Pa)^(-np) ] -! The mixed derivatives are output in units of: -! [ (J/kg) (K)^(-nt) (Pa)^(-np) ] -! Note. The derivatives are taken with respect to pressure in Pa, not -! withstanding that the pressure input into this routine is in dbar. -!-------------------------------------------------------------------------- - -use gsw_mod_teos10_constants, only : gsw_t0, db2pa - -use gsw_mod_gibbs_ice_coefficients - -use gsw_mod_kinds - -implicit none - -integer, intent(in) :: nt, np -real (r8), intent(in) :: t, p - -real (r8) :: gsw_gibbs_ice - -real (r8) :: dzi, g0, g0p, g0pp, sqrec_pt -complex (r8) :: r2, r2p, r2pp, g, sqtau_t1, sqtau_t2, tau, tau_t1, tau_t2 - -real (r8), parameter :: s0 = -3.32733756492168e3_r8 - -tau = (t + gsw_t0)*rec_tt - -dzi = db2pa*p*rec_pt - -if (nt.eq.0 .and. np.eq.0) then - - tau_t1 = tau/t1 - sqtau_t1 = tau_t1*tau_t1 - tau_t2 = tau/t2 - sqtau_t2 = tau_t2*tau_t2 - - g0 = g00 + dzi*(g01 + dzi*(g02 + dzi*(g03 + g04*dzi))) - - r2 = r20 + dzi*(r21 + r22*dzi) - - g = r1*(tau*log((1.0_r8 + tau_t1)/(1.0_r8 - tau_t1)) & - + t1*(log(1.0_r8 - sqtau_t1) - sqtau_t1)) & - + r2*(tau*log((1.0_r8 + tau_t2)/(1.0_r8 - tau_t2)) & - + t2*(log(1.0_r8 - sqtau_t2) - sqtau_t2)) - - gsw_gibbs_ice = g0 - tt*(s0*tau - real(g)) - -elseif (nt.eq.1 .and. np.eq.0) then - - tau_t1 = tau/t1 - tau_t2 = tau/t2 - - r2 = r20 + dzi*(r21 + r22*dzi) - - g = r1*(log((1.0_r8 + tau_t1)/(1.0_r8 - tau_t1)) - 2.0_r8*tau_t1) & - + r2*(log((1.0_r8 + tau_t2)/(1.0_r8 - tau_t2)) - 2.0_r8*tau_t2) - - gsw_gibbs_ice = -s0 + real(g) - -elseif (nt.eq.0 .and. np.eq.1) then - - tau_t2 = tau/t2 - sqtau_t2 = tau_t2*tau_t2 - - g0p = rec_pt*(g01 + dzi*(2.0_r8*g02 + dzi*(3.0_r8*g03 + 4.0_r8*g04*dzi))) - - r2p = rec_pt*(r21 + 2.0_r8*r22*dzi) - - g = r2p*(tau*log((1.0_r8 + tau_t2)/(1.0_r8 - tau_t2)) & - + t2*(log(1.0_r8 - sqtau_t2) - sqtau_t2)) - - gsw_gibbs_ice = g0p + tt*real(g) - -elseif (nt.eq.1 .and. np.eq.1) then - - tau_t2 = tau/t2 - - r2p = rec_pt*(r21 + 2.0_r8*r22*dzi) - - g = r2p*(log((1.0_r8 + tau_t2)/(1.0_r8 - tau_t2)) - 2.0_r8*tau_t2) - - gsw_gibbs_ice = real(g) - -elseif (nt.eq.2 .and. np.eq.0) then - - r2 = r20 + dzi*(r21 + r22*dzi) - - g = r1*(1.0_r8/(t1 - tau) + 1.0_r8/(t1 + tau) - 2.0_r8/t1) & - + r2*(1.0_r8/(t2 - tau) + 1.0_r8/(t2 + tau) - 2.0_r8/t2) - - gsw_gibbs_ice = rec_tt*real(g) - -elseif (nt.eq.0 .and. np.eq.2) then - - sqrec_pt = rec_pt*rec_pt - - tau_t2 = tau/t2 - sqtau_t2 = tau_t2*tau_t2 - - g0pp = sqrec_pt*(2.0_r8*g02 + dzi*(6.0_r8*g03 + 12.0_r8*g04*dzi)) - - r2pp = 2.0_r8*r22*sqrec_pt - - g = r2pp*(tau*log((1.0_r8 + tau_t2)/(1.0_r8 - tau_t2)) & - + t2*(log(1.0_r8 - sqtau_t2) - sqtau_t2)) - - gsw_gibbs_ice = g0pp + tt*real(g) - -end if - -return -end function - -!-------------------------------------------------------------------------- diff --git a/src/equation_of_state/TEOS10/gsw_gibbs_ice.f90 b/src/equation_of_state/TEOS10/gsw_gibbs_ice.f90 new file mode 120000 index 0000000000..9d1d06c481 --- /dev/null +++ b/src/equation_of_state/TEOS10/gsw_gibbs_ice.f90 @@ -0,0 +1 @@ +../../../pkg/GSW-Fortran/toolbox/gsw_gibbs_ice.f90 \ No newline at end of file diff --git a/src/equation_of_state/TEOS10/gsw_gibbs_pt0_pt0.f90 b/src/equation_of_state/TEOS10/gsw_gibbs_pt0_pt0.f90 deleted file mode 100644 index 6e8bcfc779..0000000000 --- a/src/equation_of_state/TEOS10/gsw_gibbs_pt0_pt0.f90 +++ /dev/null @@ -1,47 +0,0 @@ -!========================================================================== -elemental function gsw_gibbs_pt0_pt0 (sa, pt0) -!========================================================================== -! -! gibbs_tt at (sa,pt,0) -! -! sa : Absolute Salinity [g/kg] -! pt0 : potential temperature [deg C] -! -! gsw_gibbs_pt0_pt0 : gibbs_tt at (sa,pt,0) -!-------------------------------------------------------------------------- - -use gsw_mod_teos10_constants, only : gsw_sfac - -use gsw_mod_kinds - -implicit none - -real (r8), intent(in) :: sa, pt0 - -real (r8) :: gsw_gibbs_pt0_pt0 - -real (r8) :: x2, x, y, g03, g08 - -x2 = gsw_sfac*sa -x = sqrt(x2) -y = pt0*0.025_r8 - -g03 = -24715.571866078_r8 + & - y*(4420.4472249096725_r8 + & - y*(-1778.231237203896_r8 + & - y*(1160.5182516851419_r8 + & - y*(-569.531539542516_r8 + y*128.13429152494615_r8)))) - -g08 = x2*(1760.062705994408_r8 + x*(-86.1329351956084_r8 + & - x*(-137.1145018408982_r8 + y*(296.20061691375236_r8 + & - y*(-205.67709290374563_r8 + 49.9394019139016_r8*y))) + & - y*(-60.136422517125_r8 + y*10.50720794170734_r8)) + & - y*(-1351.605895580406_r8 + y*(1097.1125373015109_r8 + & - y*(-433.20648175062206_r8 + 63.905091254154904_r8*y)))) - -gsw_gibbs_pt0_pt0 = (g03 + g08)*0.000625_r8 - -return -end function - -!-------------------------------------------------------------------------- diff --git a/src/equation_of_state/TEOS10/gsw_gibbs_pt0_pt0.f90 b/src/equation_of_state/TEOS10/gsw_gibbs_pt0_pt0.f90 new file mode 120000 index 0000000000..e345379f5d --- /dev/null +++ b/src/equation_of_state/TEOS10/gsw_gibbs_pt0_pt0.f90 @@ -0,0 +1 @@ +../../../pkg/GSW-Fortran/toolbox/gsw_gibbs_pt0_pt0.f90 \ No newline at end of file diff --git a/src/equation_of_state/TEOS10/gsw_mod_freezing_poly_coefficients.f90 b/src/equation_of_state/TEOS10/gsw_mod_freezing_poly_coefficients.f90 deleted file mode 100644 index d4b5052f99..0000000000 --- a/src/equation_of_state/TEOS10/gsw_mod_freezing_poly_coefficients.f90 +++ /dev/null @@ -1,63 +0,0 @@ -!========================================================================== -module gsw_mod_freezing_poly_coefficients -!========================================================================== - -use gsw_mod_kinds - -implicit none - -real (r8), parameter :: c0 = 0.017947064327968736_r8 -real (r8), parameter :: c1 = -6.076099099929818_r8 -real (r8), parameter :: c2 = 4.883198653547851_r8 -real (r8), parameter :: c3 = -11.88081601230542_r8 -real (r8), parameter :: c4 = 13.34658511480257_r8 -real (r8), parameter :: c5 = -8.722761043208607_r8 -real (r8), parameter :: c6 = 2.082038908808201_r8 -real (r8), parameter :: c7 = -7.389420998107497_r8 -real (r8), parameter :: c8 = -2.110913185058476_r8 -real (r8), parameter :: c9 = 0.2295491578006229_r8 -real (r8), parameter :: c10 = -0.9891538123307282_r8 -real (r8), parameter :: c11 = -0.08987150128406496_r8 -real (r8), parameter :: c12 = 0.3831132432071728_r8 -real (r8), parameter :: c13 = 1.054318231187074_r8 -real (r8), parameter :: c14 = 1.065556599652796_r8 -real (r8), parameter :: c15 = -0.7997496801694032_r8 -real (r8), parameter :: c16 = 0.3850133554097069_r8 -real (r8), parameter :: c17 = -2.078616693017569_r8 -real (r8), parameter :: c18 = 0.8756340772729538_r8 -real (r8), parameter :: c19 = -2.079022768390933_r8 -real (r8), parameter :: c20 = 1.596435439942262_r8 -real (r8), parameter :: c21 = 0.1338002171109174_r8 -real (r8), parameter :: c22 = 1.242891021876471_r8 - -! Note that a = 0.502500117621_r8/gsw_sso -real (r8), parameter :: a = 0.014289763856964_r8 -real (r8), parameter :: b = 0.057000649899720_r8 - -real (r8), parameter :: t0 = 0.002519_r8 -real (r8), parameter :: t1 = -5.946302841607319_r8 -real (r8), parameter :: t2 = 4.136051661346983_r8 -real (r8), parameter :: t3 = -1.115150523403847e1_r8 -real (r8), parameter :: t4 = 1.476878746184548e1_r8 -real (r8), parameter :: t5 = -1.088873263630961e1_r8 -real (r8), parameter :: t6 = 2.961018839640730_r8 -real (r8), parameter :: t7 = -7.433320943962606_r8 -real (r8), parameter :: t8 = -1.561578562479883_r8 -real (r8), parameter :: t9 = 4.073774363480365e-2_r8 -real (r8), parameter :: t10 = 1.158414435887717e-2_r8 -real (r8), parameter :: t11 = -4.122639292422863e-1_r8 -real (r8), parameter :: t12 = -1.123186915628260e-1_r8 -real (r8), parameter :: t13 = 5.715012685553502e-1_r8 -real (r8), parameter :: t14 = 2.021682115652684e-1_r8 -real (r8), parameter :: t15 = 4.140574258089767e-2_r8 -real (r8), parameter :: t16 = -6.034228641903586e-1_r8 -real (r8), parameter :: t17 = -1.205825928146808e-2_r8 -real (r8), parameter :: t18 = -2.812172968619369e-1_r8 -real (r8), parameter :: t19 = 1.877244474023750e-2_r8 -real (r8), parameter :: t20 = -1.204395563789007e-1_r8 -real (r8), parameter :: t21 = 2.349147739749606e-1_r8 -real (r8), parameter :: t22 = 2.748444541144219e-3_r8 - -end module - -!-------------------------------------------------------------------------- diff --git a/src/equation_of_state/TEOS10/gsw_mod_freezing_poly_coefficients.f90 b/src/equation_of_state/TEOS10/gsw_mod_freezing_poly_coefficients.f90 new file mode 120000 index 0000000000..93ea8e1d2a --- /dev/null +++ b/src/equation_of_state/TEOS10/gsw_mod_freezing_poly_coefficients.f90 @@ -0,0 +1 @@ +../../../pkg/GSW-Fortran/modules/gsw_mod_freezing_poly_coefficients.f90 \ No newline at end of file diff --git a/src/equation_of_state/TEOS10/gsw_mod_gibbs_ice_coefficients.f90 b/src/equation_of_state/TEOS10/gsw_mod_gibbs_ice_coefficients.f90 deleted file mode 100644 index e9da3baf48..0000000000 --- a/src/equation_of_state/TEOS10/gsw_mod_gibbs_ice_coefficients.f90 +++ /dev/null @@ -1,30 +0,0 @@ -!========================================================================== -module gsw_mod_gibbs_ice_coefficients -!========================================================================== - -use gsw_mod_kinds - -implicit none - -complex(r8), parameter :: t1 =( 3.68017112855051e-2_r8, 5.10878114959572e-2_r8) -complex(r8), parameter :: t2 =( 3.37315741065416e-1_r8, 3.35449415919309e-1_r8) - -complex(r8), parameter :: r1 =( 4.47050716285388e1_r8, 6.56876847463481e1_r8) -complex(r8), parameter :: r20=(-7.25974574329220e1_r8, -7.81008427112870e1_r8) -complex(r8), parameter :: r21=(-5.57107698030123e-5_r8, 4.64578634580806e-5_r8) -complex(r8), parameter :: r22=(2.34801409215913e-11_r8,-2.85651142904972e-11_r8) - -! 1./Pt, where Pt = 611.657; Experimental triple-point pressure in Pa. -real (r8), parameter :: rec_pt = 1.634903221903779e-3_r8 -real (r8), parameter :: tt = 273.16_r8 ! Triple-point temperature, kelvin (K). -real (r8), parameter :: rec_tt = 3.660858105139845e-3_r8 ! = 1/tt - -real (r8), parameter :: g00 = -6.32020233335886e5_r8 -real (r8), parameter :: g01 = 6.55022213658955e-1_r8 -real (r8), parameter :: g02 = -1.89369929326131e-8_r8 -real (r8), parameter :: g03 = 3.3974612327105304e-15_r8 -real (r8), parameter :: g04 = -5.564648690589909e-22_r8 - -end module - -!-------------------------------------------------------------------------- diff --git a/src/equation_of_state/TEOS10/gsw_mod_gibbs_ice_coefficients.f90 b/src/equation_of_state/TEOS10/gsw_mod_gibbs_ice_coefficients.f90 new file mode 120000 index 0000000000..4c72d9079b --- /dev/null +++ b/src/equation_of_state/TEOS10/gsw_mod_gibbs_ice_coefficients.f90 @@ -0,0 +1 @@ +../../../pkg/GSW-Fortran/modules/gsw_mod_gibbs_ice_coefficients.f90 \ No newline at end of file diff --git a/src/equation_of_state/TEOS10/gsw_mod_kinds.f90 b/src/equation_of_state/TEOS10/gsw_mod_kinds.f90 deleted file mode 100644 index 7a2a80891f..0000000000 --- a/src/equation_of_state/TEOS10/gsw_mod_kinds.f90 +++ /dev/null @@ -1,16 +0,0 @@ -!========================================================================== -module gsw_mod_kinds -!========================================================================== - -implicit none - -integer, parameter :: r4 = selected_real_kind(6,30) - -integer, parameter :: r8 = selected_real_kind(14,30) - -end module - -!-------------------------------------------------------------------------- - - - diff --git a/src/equation_of_state/TEOS10/gsw_mod_kinds.f90 b/src/equation_of_state/TEOS10/gsw_mod_kinds.f90 new file mode 120000 index 0000000000..fa0926e540 --- /dev/null +++ b/src/equation_of_state/TEOS10/gsw_mod_kinds.f90 @@ -0,0 +1 @@ +../../../pkg/GSW-Fortran/modules/gsw_mod_kinds.f90 \ No newline at end of file diff --git a/src/equation_of_state/TEOS10/gsw_mod_specvol_coefficients.f90 b/src/equation_of_state/TEOS10/gsw_mod_specvol_coefficients.f90 deleted file mode 100644 index 7bc89c7b5e..0000000000 --- a/src/equation_of_state/TEOS10/gsw_mod_specvol_coefficients.f90 +++ /dev/null @@ -1,313 +0,0 @@ -!========================================================================== -module gsw_mod_specvol_coefficients -!========================================================================== - -use gsw_mod_kinds - -implicit none - -real (r8), parameter :: a000 = -1.56497346750e-5_r8 -real (r8), parameter :: a001 = 1.85057654290e-5_r8 -real (r8), parameter :: a002 = -1.17363867310e-6_r8 -real (r8), parameter :: a003 = -3.65270065530e-7_r8 -real (r8), parameter :: a004 = 3.14540999020e-7_r8 -real (r8), parameter :: a010 = 5.55242129680e-5_r8 -real (r8), parameter :: a011 = -2.34332137060e-5_r8 -real (r8), parameter :: a012 = 4.26100574800e-6_r8 -real (r8), parameter :: a013 = 5.73918103180e-7_r8 -real (r8), parameter :: a020 = -4.95634777770e-5_r8 -real (r8), parameter :: a021 = 2.37838968519e-5_r8 -real (r8), parameter :: a022 = -1.38397620111e-6_r8 -real (r8), parameter :: a030 = 2.76445290808e-5_r8 -real (r8), parameter :: a031 = -1.36408749928e-5_r8 -real (r8), parameter :: a032 = -2.53411666056e-7_r8 -real (r8), parameter :: a040 = -4.02698077700e-6_r8 -real (r8), parameter :: a041 = 2.53683834070e-6_r8 -real (r8), parameter :: a050 = 1.23258565608e-6_r8 -real (r8), parameter :: a100 = 3.50095997640e-5_r8 -real (r8), parameter :: a101 = -9.56770881560e-6_r8 -real (r8), parameter :: a102 = -5.56991545570e-6_r8 -real (r8), parameter :: a103 = -2.72956962370e-7_r8 -real (r8), parameter :: a110 = -7.48716846880e-5_r8 -real (r8), parameter :: a111 = -4.73566167220e-7_r8 -real (r8), parameter :: a112 = 7.82747741600e-7_r8 -real (r8), parameter :: a120 = 7.24244384490e-5_r8 -real (r8), parameter :: a121 = -1.03676320965e-5_r8 -real (r8), parameter :: a122 = 2.32856664276e-8_r8 -real (r8), parameter :: a130 = -3.50383492616e-5_r8 -real (r8), parameter :: a131 = 5.18268711320e-6_r8 -real (r8), parameter :: a140 = -1.65263794500e-6_r8 -real (r8), parameter :: a200 = -4.35926785610e-5_r8 -real (r8), parameter :: a201 = 1.11008347650e-5_r8 -real (r8), parameter :: a202 = 5.46207488340e-6_r8 -real (r8), parameter :: a210 = 7.18156455200e-5_r8 -real (r8), parameter :: a211 = 5.85666925900e-6_r8 -real (r8), parameter :: a212 = -1.31462208134e-6_r8 -real (r8), parameter :: a220 = -4.30608991440e-5_r8 -real (r8), parameter :: a221 = 9.49659182340e-7_r8 -real (r8), parameter :: a230 = 1.74814722392e-5_r8 -real (r8), parameter :: a300 = 3.45324618280e-5_r8 -real (r8), parameter :: a301 = -9.84471178440e-6_r8 -real (r8), parameter :: a302 = -1.35441856270e-6_r8 -real (r8), parameter :: a310 = -3.73971683740e-5_r8 -real (r8), parameter :: a311 = -9.76522784000e-7_r8 -real (r8), parameter :: a320 = 6.85899736680e-6_r8 -real (r8), parameter :: a400 = -1.19594097880e-5_r8 -real (r8), parameter :: a401 = 2.59092252600e-6_r8 -real (r8), parameter :: a410 = 7.71906784880e-6_r8 -real (r8), parameter :: a500 = 1.38645945810e-6_r8 - -real (r8), parameter :: b000 = -3.10389819760e-4_r8 -real (r8), parameter :: b003 = 3.63101885150e-7_r8 -real (r8), parameter :: b004 = -1.11471254230e-7_r8 -real (r8), parameter :: b010 = 3.50095997640e-5_r8 -real (r8), parameter :: b013 = -2.72956962370e-7_r8 -real (r8), parameter :: b020 = -3.74358423440e-5_r8 -real (r8), parameter :: b030 = 2.41414794830e-5_r8 -real (r8), parameter :: b040 = -8.75958731540e-6_r8 -real (r8), parameter :: b050 = -3.30527589000e-7_r8 -real (r8), parameter :: b100 = 1.33856134076e-3_r8 -real (r8), parameter :: b103 = 3.34926075600e-8_r8 -real (r8), parameter :: b110 = -8.71853571220e-5_r8 -real (r8), parameter :: b120 = 7.18156455200e-5_r8 -real (r8), parameter :: b130 = -2.87072660960e-5_r8 -real (r8), parameter :: b140 = 8.74073611960e-6_r8 -real (r8), parameter :: b200 = -2.55143801811e-3_r8 -real (r8), parameter :: b210 = 1.03597385484e-4_r8 -real (r8), parameter :: b220 = -5.60957525610e-5_r8 -real (r8), parameter :: b230 = 6.85899736680e-6_r8 -real (r8), parameter :: b300 = 2.32344279772e-3_r8 -real (r8), parameter :: b310 = -4.78376391520e-5_r8 -real (r8), parameter :: b320 = 1.54381356976e-5_r8 -real (r8), parameter :: b400 = -1.05461852535e-3_r8 -real (r8), parameter :: b410 = 6.93229729050e-6_r8 -real (r8), parameter :: b500 = 1.91594743830e-4_r8 -real (r8), parameter :: b001 = 2.42624687470e-5_r8 -real (r8), parameter :: b011 = -9.56770881560e-6_r8 -real (r8), parameter :: b021 = -2.36783083610e-7_r8 -real (r8), parameter :: b031 = -3.45587736550e-6_r8 -real (r8), parameter :: b041 = 1.29567177830e-6_r8 -real (r8), parameter :: b101 = -6.95849219480e-5_r8 -real (r8), parameter :: b111 = 2.22016695300e-5_r8 -real (r8), parameter :: b121 = 5.85666925900e-6_r8 -real (r8), parameter :: b131 = 6.33106121560e-7_r8 -real (r8), parameter :: b201 = 1.12412331915e-4_r8 -real (r8), parameter :: b211 = -2.95341353532e-5_r8 -real (r8), parameter :: b221 = -1.46478417600e-6_r8 -real (r8), parameter :: b301 = -6.92888744480e-5_r8 -real (r8), parameter :: b311 = 1.03636901040e-5_r8 -real (r8), parameter :: b401 = 1.54637136265e-5_r8 -real (r8), parameter :: b002 = -5.84844329840e-7_r8 -real (r8), parameter :: b012 = -5.56991545570e-6_r8 -real (r8), parameter :: b022 = 3.91373870800e-7_r8 -real (r8), parameter :: b032 = 7.76188880920e-9_r8 -real (r8), parameter :: b102 = -9.62445031940e-6_r8 -real (r8), parameter :: b112 = 1.09241497668e-5_r8 -real (r8), parameter :: b122 = -1.31462208134e-6_r8 -real (r8), parameter :: b202 = 1.47789320994e-5_r8 -real (r8), parameter :: b212 = -4.06325568810e-6_r8 -real (r8), parameter :: b302 = -7.12478989080e-6_r8 - -real (r8), parameter :: c000 = -6.07991438090e-5_r8 -real (r8), parameter :: c001 = 1.99712338438e-5_r8 -real (r8), parameter :: c002 = -3.39280843110e-6_r8 -real (r8), parameter :: c003 = 4.21246123200e-7_r8 -real (r8), parameter :: c004 = -6.32363064300e-8_r8 -real (r8), parameter :: c005 = 1.17681023580e-8_r8 -real (r8), parameter :: c010 = 1.85057654290e-5_r8 -real (r8), parameter :: c011 = -2.34727734620e-6_r8 -real (r8), parameter :: c012 = -1.09581019659e-6_r8 -real (r8), parameter :: c013 = 1.25816399608e-6_r8 -real (r8), parameter :: c020 = -1.17166068530e-5_r8 -real (r8), parameter :: c021 = 4.26100574800e-6_r8 -real (r8), parameter :: c022 = 8.60877154770e-7_r8 -real (r8), parameter :: c030 = 7.92796561730e-6_r8 -real (r8), parameter :: c031 = -9.22650800740e-7_r8 -real (r8), parameter :: c040 = -3.41021874820e-6_r8 -real (r8), parameter :: c041 = -1.26705833028e-7_r8 -real (r8), parameter :: c050 = 5.07367668140e-7_r8 -real (r8), parameter :: c100 = 2.42624687470e-5_r8 -real (r8), parameter :: c101 = -1.16968865968e-6_r8 -real (r8), parameter :: c102 = 1.08930565545e-6_r8 -real (r8), parameter :: c103 = -4.45885016920e-7_r8 -real (r8), parameter :: c110 = -9.56770881560e-6_r8 -real (r8), parameter :: c111 = -1.11398309114e-5_r8 -real (r8), parameter :: c112 = -8.18870887110e-7_r8 -real (r8), parameter :: c120 = -2.36783083610e-7_r8 -real (r8), parameter :: c121 = 7.82747741600e-7_r8 -real (r8), parameter :: c130 = -3.45587736550e-6_r8 -real (r8), parameter :: c131 = 1.55237776184e-8_r8 -real (r8), parameter :: c140 = 1.29567177830e-6_r8 -real (r8), parameter :: c200 = -3.47924609740e-5_r8 -real (r8), parameter :: c201 = -9.62445031940e-6_r8 -real (r8), parameter :: c202 = 5.02389113400e-8_r8 -real (r8), parameter :: c210 = 1.11008347650e-5_r8 -real (r8), parameter :: c211 = 1.09241497668e-5_r8 -real (r8), parameter :: c220 = 2.92833462950e-6_r8 -real (r8), parameter :: c221 = -1.31462208134e-6_r8 -real (r8), parameter :: c230 = 3.16553060780e-7_r8 -real (r8), parameter :: c300 = 3.74707773050e-5_r8 -real (r8), parameter :: c301 = 9.85262139960e-6_r8 -real (r8), parameter :: c310 = -9.84471178440e-6_r8 -real (r8), parameter :: c311 = -2.70883712540e-6_r8 -real (r8), parameter :: c320 = -4.88261392000e-7_r8 -real (r8), parameter :: c400 = -1.73222186120e-5_r8 -real (r8), parameter :: c401 = -3.56239494540e-6_r8 -real (r8), parameter :: c410 = 2.59092252600e-6_r8 -real (r8), parameter :: c500 = 3.09274272530e-6_r8 - -real (r8), parameter :: h001 = 1.07699958620e-3_r8 -real (r8), parameter :: h002 = -3.03995719050e-5_r8 -real (r8), parameter :: h003 = 3.32853897400e-6_r8 -real (r8), parameter :: h004 = -2.82734035930e-7_r8 -real (r8), parameter :: h005 = 2.10623061600e-8_r8 -real (r8), parameter :: h006 = -2.10787688100e-9_r8 -real (r8), parameter :: h007 = 2.80192913290e-10_r8 -real (r8), parameter :: h011 = -1.56497346750e-5_r8 -real (r8), parameter :: h012 = 9.25288271450e-6_r8 -real (r8), parameter :: h013 = -3.91212891030e-7_r8 -real (r8), parameter :: h014 = -9.13175163830e-8_r8 -real (r8), parameter :: h015 = 6.29081998040e-8_r8 -real (r8), parameter :: h021 = 2.77621064840e-5_r8 -real (r8), parameter :: h022 = -5.85830342650e-6_r8 -real (r8), parameter :: h023 = 7.10167624670e-7_r8 -real (r8), parameter :: h024 = 7.17397628980e-8_r8 -real (r8), parameter :: h031 = -1.65211592590e-5_r8 -real (r8), parameter :: h032 = 3.96398280870e-6_r8 -real (r8), parameter :: h033 = -1.53775133460e-7_r8 -real (r8), parameter :: h042 = -1.70510937410e-6_r8 -real (r8), parameter :: h043 = -2.11176388380e-8_r8 -real (r8), parameter :: h041 = 6.91113227020e-6_r8 -real (r8), parameter :: h051 = -8.05396155400e-7_r8 -real (r8), parameter :: h052 = 2.53683834070e-7_r8 -real (r8), parameter :: h061 = 2.05430942680e-7_r8 -real (r8), parameter :: h101 = -3.10389819760e-4_r8 -real (r8), parameter :: h102 = 1.21312343735e-5_r8 -real (r8), parameter :: h103 = -1.94948109950e-7_r8 -real (r8), parameter :: h104 = 9.07754712880e-8_r8 -real (r8), parameter :: h105 = -2.22942508460e-8_r8 -real (r8), parameter :: h111 = 3.50095997640e-5_r8 -real (r8), parameter :: h112 = -4.78385440780e-6_r8 -real (r8), parameter :: h113 = -1.85663848520e-6_r8 -real (r8), parameter :: h114 = -6.82392405930e-8_r8 -real (r8), parameter :: h121 = -3.74358423440e-5_r8 -real (r8), parameter :: h122 = -1.18391541805e-7_r8 -real (r8), parameter :: h123 = 1.30457956930e-7_r8 -real (r8), parameter :: h131 = 2.41414794830e-5_r8 -real (r8), parameter :: h132 = -1.72793868275e-6_r8 -real (r8), parameter :: h133 = 2.58729626970e-9_r8 -real (r8), parameter :: h141 = -8.75958731540e-6_r8 -real (r8), parameter :: h142 = 6.47835889150e-7_r8 -real (r8), parameter :: h151 = -3.30527589000e-7_r8 -real (r8), parameter :: h201 = 6.69280670380e-4_r8 -real (r8), parameter :: h202 = -1.73962304870e-5_r8 -real (r8), parameter :: h203 = -1.60407505320e-6_r8 -real (r8), parameter :: h204 = 4.18657594500e-9_r8 -real (r8), parameter :: h211 = -4.35926785610e-5_r8 -real (r8), parameter :: h212 = 5.55041738250e-6_r8 -real (r8), parameter :: h213 = 1.82069162780e-6_r8 -real (r8), parameter :: h221 = 3.59078227600e-5_r8 -real (r8), parameter :: h222 = 1.46416731475e-6_r8 -real (r8), parameter :: h223 = -2.19103680220e-7_r8 -real (r8), parameter :: h231 = -1.43536330480e-5_r8 -real (r8), parameter :: h232 = 1.58276530390e-7_r8 -real (r8), parameter :: h241 = 4.37036805980e-6_r8 -real (r8), parameter :: h301 = -8.50479339370e-4_r8 -real (r8), parameter :: h302 = 1.87353886525e-5_r8 -real (r8), parameter :: h303 = 1.64210356660e-6_r8 -real (r8), parameter :: h311 = 3.45324618280e-5_r8 -real (r8), parameter :: h312 = -4.92235589220e-6_r8 -real (r8), parameter :: h313 = -4.51472854230e-7_r8 -real (r8), parameter :: h321 = -1.86985841870e-5_r8 -real (r8), parameter :: h322 = -2.44130696000e-7_r8 -real (r8), parameter :: h331 = 2.28633245560e-6_r8 -real (r8), parameter :: h401 = 5.80860699430e-4_r8 -real (r8), parameter :: h402 = -8.66110930600e-6_r8 -real (r8), parameter :: h403 = -5.93732490900e-7_r8 -real (r8), parameter :: h411 = -1.19594097880e-5_r8 -real (r8), parameter :: h421 = 3.85953392440e-6_r8 -real (r8), parameter :: h412 = 1.29546126300e-6_r8 -real (r8), parameter :: h501 = -2.10923705070e-4_r8 -real (r8), parameter :: h502 = 1.54637136265e-6_r8 -real (r8), parameter :: h511 = 1.38645945810e-6_r8 -real (r8), parameter :: h601 = 3.19324573050e-5_r8 - -real (r8), parameter :: v000 = 1.0769995862e-3_r8 -real (r8), parameter :: v001 = -6.0799143809e-5_r8 -real (r8), parameter :: v002 = 9.9856169219e-6_r8 -real (r8), parameter :: v003 = -1.1309361437e-6_r8 -real (r8), parameter :: v004 = 1.0531153080e-7_r8 -real (r8), parameter :: v005 = -1.2647261286e-8_r8 -real (r8), parameter :: v006 = 1.9613503930e-9_r8 -real (r8), parameter :: v010 = -3.1038981976e-4_r8 -real (r8), parameter :: v011 = 2.4262468747e-5_r8 -real (r8), parameter :: v012 = -5.8484432984e-7_r8 -real (r8), parameter :: v013 = 3.6310188515e-7_r8 -real (r8), parameter :: v014 = -1.1147125423e-7_r8 -real (r8), parameter :: v020 = 6.6928067038e-4_r8 -real (r8), parameter :: v021 = -3.4792460974e-5_r8 -real (r8), parameter :: v022 = -4.8122251597e-6_r8 -real (r8), parameter :: v023 = 1.6746303780e-8_r8 -real (r8), parameter :: v030 = -8.5047933937e-4_r8 -real (r8), parameter :: v031 = 3.7470777305e-5_r8 -real (r8), parameter :: v032 = 4.9263106998e-6_r8 -real (r8), parameter :: v040 = 5.8086069943e-4_r8 -real (r8), parameter :: v041 = -1.7322218612e-5_r8 -real (r8), parameter :: v042 = -1.7811974727e-6_r8 -real (r8), parameter :: v050 = -2.1092370507e-4_r8 -real (r8), parameter :: v051 = 3.0927427253e-6_r8 -real (r8), parameter :: v060 = 3.1932457305e-5_r8 -real (r8), parameter :: v100 = -1.5649734675e-5_r8 -real (r8), parameter :: v101 = 1.8505765429e-5_r8 -real (r8), parameter :: v102 = -1.1736386731e-6_r8 -real (r8), parameter :: v103 = -3.6527006553e-7_r8 -real (r8), parameter :: v104 = 3.1454099902e-7_r8 -real (r8), parameter :: v110 = 3.5009599764e-5_r8 -real (r8), parameter :: v111 = -9.5677088156e-6_r8 -real (r8), parameter :: v112 = -5.5699154557e-6_r8 -real (r8), parameter :: v113 = -2.7295696237e-7_r8 -real (r8), parameter :: v120 = -4.3592678561e-5_r8 -real (r8), parameter :: v121 = 1.1100834765e-5_r8 -real (r8), parameter :: v122 = 5.4620748834e-6_r8 -real (r8), parameter :: v130 = 3.4532461828e-5_r8 -real (r8), parameter :: v131 = -9.8447117844e-6_r8 -real (r8), parameter :: v132 = -1.3544185627e-6_r8 -real (r8), parameter :: v140 = -1.1959409788e-5_r8 -real (r8), parameter :: v141 = 2.5909225260e-6_r8 -real (r8), parameter :: v150 = 1.3864594581e-6_r8 -real (r8), parameter :: v200 = 2.7762106484e-5_r8 -real (r8), parameter :: v201 = -1.1716606853e-5_r8 -real (r8), parameter :: v202 = 2.1305028740e-6_r8 -real (r8), parameter :: v203 = 2.8695905159e-7_r8 -real (r8), parameter :: v210 = -3.7435842344e-5_r8 -real (r8), parameter :: v211 = -2.3678308361e-7_r8 -real (r8), parameter :: v212 = 3.9137387080e-7_r8 -real (r8), parameter :: v220 = 3.5907822760e-5_r8 -real (r8), parameter :: v221 = 2.9283346295e-6_r8 -real (r8), parameter :: v222 = -6.5731104067e-7_r8 -real (r8), parameter :: v230 = -1.8698584187e-5_r8 -real (r8), parameter :: v231 = -4.8826139200e-7_r8 -real (r8), parameter :: v240 = 3.8595339244e-6_r8 -real (r8), parameter :: v300 = -1.6521159259e-5_r8 -real (r8), parameter :: v301 = 7.9279656173e-6_r8 -real (r8), parameter :: v302 = -4.6132540037e-7_r8 -real (r8), parameter :: v310 = 2.4141479483e-5_r8 -real (r8), parameter :: v311 = -3.4558773655e-6_r8 -real (r8), parameter :: v312 = 7.7618888092e-9_r8 -real (r8), parameter :: v320 = -1.4353633048e-5_r8 -real (r8), parameter :: v321 = 3.1655306078e-7_r8 -real (r8), parameter :: v330 = 2.2863324556e-6_r8 -real (r8), parameter :: v400 = 6.9111322702e-6_r8 -real (r8), parameter :: v401 = -3.4102187482e-6_r8 -real (r8), parameter :: v402 = -6.3352916514e-8_r8 -real (r8), parameter :: v410 = -8.7595873154e-6_r8 -real (r8), parameter :: v411 = 1.2956717783e-6_r8 -real (r8), parameter :: v420 = 4.3703680598e-6_r8 -real (r8), parameter :: v500 = -8.0539615540e-7_r8 -real (r8), parameter :: v501 = 5.0736766814e-7_r8 -real (r8), parameter :: v510 = -3.3052758900e-7_r8 -real (r8), parameter :: v600 = 2.0543094268e-7_r8 - -end module - -!-------------------------------------------------------------------------- diff --git a/src/equation_of_state/TEOS10/gsw_mod_specvol_coefficients.f90 b/src/equation_of_state/TEOS10/gsw_mod_specvol_coefficients.f90 new file mode 120000 index 0000000000..934f689c20 --- /dev/null +++ b/src/equation_of_state/TEOS10/gsw_mod_specvol_coefficients.f90 @@ -0,0 +1 @@ +../../../pkg/GSW-Fortran/modules/gsw_mod_specvol_coefficients.f90 \ No newline at end of file diff --git a/src/equation_of_state/TEOS10/gsw_mod_teos10_constants.f90 b/src/equation_of_state/TEOS10/gsw_mod_teos10_constants.f90 deleted file mode 100644 index e3c6afbce0..0000000000 --- a/src/equation_of_state/TEOS10/gsw_mod_teos10_constants.f90 +++ /dev/null @@ -1,71 +0,0 @@ -!========================================================================== -module gsw_mod_teos10_constants -!========================================================================== - -use gsw_mod_kinds - -implicit none - -real (r8), parameter :: db2pa = 1.0e4_r8 -real (r8), parameter :: rec_db2pa = 1.0e-4_r8 - -real (r8), parameter :: pa2db = 1.0e-4_r8 -real (r8), parameter :: rec_pa2db = 1.0e4_r8 - -real (r8), parameter :: pi = 3.141592653589793_r8 -real (r8), parameter :: deg2rad = pi/180.0_r8 -real (r8), parameter :: rad2deg = 180.0_r8/pi - -real (r8), parameter :: gamma = 2.26e-7_r8 - -! cp0 = The "specific heat" for use [ J/(kg K) ] -! with Conservative Temperature - -real (r8), parameter :: gsw_cp0 = 3991.86795711963_r8 - -! T0 = the Celcius zero point. [ K ] - -real (r8), parameter :: gsw_t0 = 273.15_r8 - -! P0 = Absolute Pressure of one standard atmosphere. [ Pa ] - -real (r8), parameter :: gsw_p0 = 101325.0_r8 - -! SSO = Standard Ocean Reference Salinity. [ g/kg ] - -real (r8), parameter :: gsw_sso = 35.16504_r8 -real (r8), parameter :: gsw_sqrtsso = 5.930011804372737_r8 - -! uPS = unit conversion factor for salinities [ g/kg ] - -real (r8), parameter :: gsw_ups = gsw_sso/35.0_r8 - -! sfac = 1/(40*gsw_ups) - -real (r8), parameter :: gsw_sfac = 0.0248826675584615_r8 - -! deltaS = 24, offset = deltaS*gsw_sfac - -real (r8), parameter :: offset = 5.971840214030754e-1_r8 - -! C3515 = Conductivity at (SP=35, t_68=15, p=0) [ mS/cm ] - -real (r8), parameter :: gsw_c3515 = 42.9140_r8 - -! SonCl = SP to Chlorinity ratio [ (g/kg)^-1 ] - -real (r8), parameter :: gsw_soncl = 1.80655_r8 - -! valence_factor = valence factor of sea salt of Reference Composition -! [ unitless ] - -real (r8), parameter :: gsw_valence_factor = 1.2452898_r8 - -! atomic_weight = mole-weighted atomic weight of sea salt of Reference -! Composition [ g/mol ] - -real (r8), parameter :: gsw_atomic_weight = 31.4038218_r8 - -end module - -!-------------------------------------------------------------------------- diff --git a/src/equation_of_state/TEOS10/gsw_mod_teos10_constants.f90 b/src/equation_of_state/TEOS10/gsw_mod_teos10_constants.f90 new file mode 120000 index 0000000000..17dec5add5 --- /dev/null +++ b/src/equation_of_state/TEOS10/gsw_mod_teos10_constants.f90 @@ -0,0 +1 @@ +../../../pkg/GSW-Fortran/modules/gsw_mod_teos10_constants.f90 \ No newline at end of file diff --git a/src/equation_of_state/TEOS10/gsw_mod_toolbox.f90 b/src/equation_of_state/TEOS10/gsw_mod_toolbox.f90 deleted file mode 100644 index a8012e1274..0000000000 --- a/src/equation_of_state/TEOS10/gsw_mod_toolbox.f90 +++ /dev/null @@ -1,1493 +0,0 @@ -module gsw_mod_toolbox - -use gsw_mod_kinds - -implicit none - -public :: gsw_add_barrier -public :: gsw_add_mean -public :: gsw_adiabatic_lapse_rate_from_ct -public :: gsw_adiabatic_lapse_rate_ice -public :: gsw_alpha -public :: gsw_alpha_on_beta -public :: gsw_alpha_wrt_t_exact -public :: gsw_alpha_wrt_t_ice -public :: gsw_beta_const_t_exact -public :: gsw_beta -public :: gsw_cabbeling -public :: gsw_c_from_sp -public :: gsw_chem_potential_water_ice -public :: gsw_chem_potential_water_t_exact -public :: gsw_cp_ice -public :: gsw_ct_first_derivatives -public :: gsw_ct_first_derivatives_wrt_t_exact -public :: gsw_ct_freezing_exact -public :: gsw_ct_freezing -public :: gsw_ct_freezing_first_derivatives -public :: gsw_ct_freezing_first_derivatives_poly -public :: gsw_ct_freezing_poly -public :: gsw_ct_from_enthalpy_exact -public :: gsw_ct_from_enthalpy -public :: gsw_ct_from_entropy -public :: gsw_ct_from_pt -public :: gsw_ct_from_rho -public :: gsw_ct_from_t -public :: gsw_ct_maxdensity -public :: gsw_ct_second_derivatives -public :: gsw_deltasa_atlas -public :: gsw_deltasa_from_sp -public :: gsw_dilution_coefficient_t_exact -public :: gsw_dynamic_enthalpy -public :: gsw_enthalpy_ct_exact -public :: gsw_enthalpy_diff -public :: gsw_enthalpy -public :: gsw_enthalpy_first_derivatives_ct_exact -public :: gsw_enthalpy_first_derivatives -public :: gsw_enthalpy_ice -public :: gsw_enthalpy_second_derivatives_ct_exact -public :: gsw_enthalpy_second_derivatives -public :: gsw_enthalpy_sso_0 -public :: gsw_enthalpy_t_exact -public :: gsw_entropy_first_derivatives -public :: gsw_entropy_from_pt -public :: gsw_entropy_from_t -public :: gsw_entropy_ice -public :: gsw_entropy_part -public :: gsw_entropy_part_zerop -public :: gsw_entropy_second_derivatives -public :: gsw_fdelta -public :: gsw_frazil_properties -public :: gsw_frazil_properties_potential -public :: gsw_frazil_properties_potential_poly -public :: gsw_frazil_ratios_adiabatic -public :: gsw_frazil_ratios_adiabatic_poly -public :: gsw_geo_strf_dyn_height -public :: gsw_geo_strf_dyn_height_pc -public :: gsw_gibbs -public :: gsw_gibbs_ice -public :: gsw_gibbs_ice_part_t -public :: gsw_gibbs_ice_pt0 -public :: gsw_gibbs_ice_pt0_pt0 -public :: gsw_gibbs_pt0_pt0 -public :: gsw_grav -public :: gsw_helmholtz_energy_ice -public :: gsw_hill_ratio_at_sp2 -public :: gsw_ice_fraction_to_freeze_seawater -public :: gsw_internal_energy -public :: gsw_internal_energy_ice -public :: gsw_ipv_vs_fnsquared_ratio -public :: gsw_kappa_const_t_ice -public :: gsw_kappa -public :: gsw_kappa_ice -public :: gsw_kappa_t_exact -public :: gsw_latentheat_evap_ct -public :: gsw_latentheat_evap_t -public :: gsw_latentheat_melting -public :: gsw_linear_interp_sa_ct -public :: gsw_melting_ice_equilibrium_sa_ct_ratio -public :: gsw_melting_ice_equilibrium_sa_ct_ratio_poly -public :: gsw_melting_ice_into_seawater -public :: gsw_melting_ice_sa_ct_ratio -public :: gsw_melting_ice_sa_ct_ratio_poly -public :: gsw_melting_seaice_equilibrium_sa_ct_ratio -public :: gsw_melting_seaice_equilibrium_sa_ct_ratio_poly -public :: gsw_melting_seaice_into_seawater -public :: gsw_melting_seaice_sa_ct_ratio -public :: gsw_melting_seaice_sa_ct_ratio_poly -public :: gsw_nsquared -public :: gsw_pot_enthalpy_from_pt_ice -public :: gsw_pot_enthalpy_from_pt_ice_poly -public :: gsw_pot_enthalpy_ice_freezing -public :: gsw_pot_enthalpy_ice_freezing_first_derivatives -public :: gsw_pot_enthalpy_ice_freezing_first_derivatives_poly -public :: gsw_pot_enthalpy_ice_freezing_poly -public :: gsw_pot_rho_t_exact -public :: gsw_pressure_coefficient_ice -public :: gsw_pressure_freezing_ct -public :: gsw_pt0_cold_ice_poly -public :: gsw_pt0_from_t -public :: gsw_pt0_from_t_ice -public :: gsw_pt_first_derivatives -public :: gsw_pt_from_ct -public :: gsw_pt_from_entropy -public :: gsw_pt_from_pot_enthalpy_ice -public :: gsw_pt_from_pot_enthalpy_ice_poly_dh -public :: gsw_pt_from_pot_enthalpy_ice_poly -public :: gsw_pt_from_t -public :: gsw_pt_from_t_ice -public :: gsw_pt_second_derivatives -public :: gsw_rho_alpha_beta -public :: gsw_rho -public :: gsw_rho_first_derivatives -public :: gsw_rho_first_derivatives_wrt_enthalpy -public :: gsw_rho_ice -public :: gsw_rho_second_derivatives -public :: gsw_rho_second_derivatives_wrt_enthalpy -public :: gsw_rho_t_exact -public :: gsw_rr68_interp_sa_ct -public :: gsw_saar -public :: gsw_sa_freezing_estimate -public :: gsw_sa_freezing_from_ct -public :: gsw_sa_freezing_from_ct_poly -public :: gsw_sa_freezing_from_t -public :: gsw_sa_freezing_from_t_poly -public :: gsw_sa_from_rho -public :: gsw_sa_from_sp_baltic -public :: gsw_sa_from_sp -public :: gsw_sa_from_sstar -public :: gsw_sa_p_inrange -public :: gsw_seaice_fraction_to_freeze_seawater -public :: gsw_sigma0 -public :: gsw_sigma1 -public :: gsw_sigma2 -public :: gsw_sigma3 -public :: gsw_sigma4 -public :: gsw_sound_speed -public :: gsw_sound_speed_ice -public :: gsw_sound_speed_t_exact -public :: gsw_specvol_alpha_beta -public :: gsw_specvol_anom_standard -public :: gsw_specvol -public :: gsw_specvol_first_derivatives -public :: gsw_specvol_first_derivatives_wrt_enthalpy -public :: gsw_specvol_ice -public :: gsw_specvol_second_derivatives -public :: gsw_specvol_second_derivatives_wrt_enthalpy -public :: gsw_specvol_sso_0 -public :: gsw_specvol_t_exact -public :: gsw_sp_from_c -public :: gsw_sp_from_sa_baltic -public :: gsw_sp_from_sa -public :: gsw_sp_from_sk -public :: gsw_sp_from_sr -public :: gsw_sp_from_sstar -public :: gsw_spiciness0 -public :: gsw_spiciness1 -public :: gsw_spiciness2 -public :: gsw_sr_from_sp -public :: gsw_sstar_from_sa -public :: gsw_sstar_from_sp -public :: gsw_t_deriv_chem_potential_water_t_exact -public :: gsw_t_freezing_exact -public :: gsw_t_freezing -public :: gsw_t_freezing_first_derivatives -public :: gsw_t_freezing_first_derivatives_poly -public :: gsw_t_freezing_poly -public :: gsw_t_from_ct -public :: gsw_t_from_pt0_ice -public :: gsw_thermobaric -public :: gsw_turner_rsubrho -public :: gsw_util_indx -public :: gsw_util_interp1q_int -public :: gsw_util_sort_real -public :: gsw_util_xinterp1 -public :: gsw_z_from_p - -interface - - pure subroutine gsw_add_barrier (input_data, long, lat, long_grid, & - lat_grid, dlong_grid, dlat_grid, output_data) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: long, lat, long_grid, lat_grid, dlong_grid - real (r8), intent(in) :: dlat_grid - real (r8), intent(in), dimension(4) :: input_data - real (r8), intent(out), dimension(4) :: output_data - end subroutine gsw_add_barrier - - pure subroutine gsw_add_mean (data_in, data_out) - use gsw_mod_kinds - implicit none - real (r8), intent(in), dimension(4) :: data_in - real (r8), intent(out), dimension(4) :: data_out - end subroutine gsw_add_mean - - elemental function gsw_adiabatic_lapse_rate_from_ct (sa, ct, p) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: sa, ct, p - real (r8) :: gsw_adiabatic_lapse_rate_from_ct - end function gsw_adiabatic_lapse_rate_from_ct - - elemental function gsw_adiabatic_lapse_rate_ice (t, p) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: t, p - real (r8) :: gsw_adiabatic_lapse_rate_ice - end function gsw_adiabatic_lapse_rate_ice - - elemental function gsw_alpha (sa, ct, p) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: sa, ct, p - real (r8) :: gsw_alpha - end function gsw_alpha - - elemental function gsw_alpha_on_beta (sa, ct, p) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: sa, ct, p - real (r8) :: gsw_alpha_on_beta - end function gsw_alpha_on_beta - - elemental function gsw_alpha_wrt_t_exact (sa, t, p) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: sa, t, p - real (r8) :: gsw_alpha_wrt_t_exact - end function gsw_alpha_wrt_t_exact - - elemental function gsw_alpha_wrt_t_ice (t, p) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: t, p - real (r8) :: gsw_alpha_wrt_t_ice - end function gsw_alpha_wrt_t_ice - - elemental function gsw_beta_const_t_exact (sa, t, p) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: sa, t, p - real (r8) :: gsw_beta_const_t_exact - end function gsw_beta_const_t_exact - - elemental function gsw_beta (sa, ct, p) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: sa, ct, p - real (r8) :: gsw_beta - end function gsw_beta - - elemental function gsw_cabbeling (sa, ct, p) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: sa, ct, p - real (r8) :: gsw_cabbeling - end function gsw_cabbeling - - elemental function gsw_c_from_sp (sp, t, p) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: sp, t, p - real (r8) :: gsw_c_from_sp - end function gsw_c_from_sp - - elemental function gsw_chem_potential_water_ice (t, p) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: t, p - real (r8) :: gsw_chem_potential_water_ice - end function gsw_chem_potential_water_ice - - elemental function gsw_chem_potential_water_t_exact (sa, t, p) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: sa, t, p - real (r8) :: gsw_chem_potential_water_t_exact - end function gsw_chem_potential_water_t_exact - - elemental function gsw_cp_ice (t, p) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: t, p - real (r8) :: gsw_cp_ice - end function gsw_cp_ice - - elemental subroutine gsw_ct_first_derivatives (sa, pt, ct_sa, ct_pt) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: sa, pt - real (r8), intent(out), optional :: ct_sa, ct_pt - end subroutine gsw_ct_first_derivatives - - elemental subroutine gsw_ct_first_derivatives_wrt_t_exact (sa, t, p, & - ct_sa_wrt_t, ct_t_wrt_t, ct_p_wrt_t) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: sa, t, p - real (r8), intent(out), optional :: ct_p_wrt_t, ct_sa_wrt_t, ct_t_wrt_t - end subroutine gsw_ct_first_derivatives_wrt_t_exact - - elemental function gsw_ct_freezing_exact (sa, p, saturation_fraction) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: sa, p, saturation_fraction - real (r8) :: gsw_ct_freezing_exact - end function gsw_ct_freezing_exact - - elemental function gsw_ct_freezing (sa, p, saturation_fraction, poly) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: sa, p, saturation_fraction - logical, intent(in), optional :: poly - real (r8) :: gsw_ct_freezing - end function gsw_ct_freezing - - elemental subroutine gsw_ct_freezing_first_derivatives (sa, p, & - saturation_fraction, ctfreezing_sa, ctfreezing_p) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: sa, p, saturation_fraction - real (r8), intent(out), optional :: ctfreezing_sa, ctfreezing_p - end subroutine gsw_ct_freezing_first_derivatives - - elemental subroutine gsw_ct_freezing_first_derivatives_poly (sa, p, & - saturation_fraction, ctfreezing_sa, ctfreezing_p) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: sa, p, saturation_fraction - real (r8), intent(out), optional :: ctfreezing_sa, ctfreezing_p - end subroutine gsw_ct_freezing_first_derivatives_poly - - elemental function gsw_ct_freezing_poly (sa, p, saturation_fraction) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: sa, p, saturation_fraction - real (r8) :: gsw_ct_freezing_poly - end function gsw_ct_freezing_poly - - elemental function gsw_ct_from_enthalpy_exact (sa, h, p) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: sa, h, p - real (r8) :: gsw_ct_from_enthalpy_exact - end function gsw_ct_from_enthalpy_exact - - elemental function gsw_ct_from_enthalpy (sa, h, p) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: sa, h, p - real (r8) :: gsw_ct_from_enthalpy - end function gsw_ct_from_enthalpy - - elemental function gsw_ct_from_entropy (sa, entropy) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: sa, entropy - real (r8) :: gsw_ct_from_entropy - end function gsw_ct_from_entropy - - elemental function gsw_ct_from_pt (sa, pt) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: sa, pt - real (r8) :: gsw_ct_from_pt - end function gsw_ct_from_pt - - elemental subroutine gsw_ct_from_rho (rho, sa, p, ct, ct_multiple) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: rho, sa, p - real (r8), intent(out) :: ct - real (r8), intent(out), optional :: ct_multiple - end subroutine gsw_ct_from_rho - - elemental function gsw_ct_from_t (sa, t, p) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: sa, t, p - real (r8) :: gsw_ct_from_t - end function gsw_ct_from_t - - elemental function gsw_ct_maxdensity (sa, p) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: sa, p - real (r8) :: gsw_ct_maxdensity - end function gsw_ct_maxdensity - - elemental subroutine gsw_ct_second_derivatives (sa, pt, ct_sa_sa, ct_sa_pt, & - ct_pt_pt) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: sa, pt - real (r8), intent(out), optional :: ct_sa_sa, ct_sa_pt, ct_pt_pt - end subroutine gsw_ct_second_derivatives - - elemental function gsw_deltasa_atlas (p, long, lat) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: p, long, lat - real (r8) :: gsw_deltasa_atlas - end function gsw_deltasa_atlas - - elemental function gsw_deltasa_from_sp (sp, p, long, lat) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: sp, p, long, lat - real (r8) :: gsw_deltasa_from_sp - end function gsw_deltasa_from_sp - - elemental function gsw_dilution_coefficient_t_exact (sa, t, p) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: sa, t, p - real (r8) :: gsw_dilution_coefficient_t_exact - end function gsw_dilution_coefficient_t_exact - - elemental function gsw_dynamic_enthalpy (sa, ct, p) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: sa, ct, p - real (r8) :: gsw_dynamic_enthalpy - end function gsw_dynamic_enthalpy - - elemental function gsw_enthalpy_ct_exact (sa, ct, p) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: sa, ct, p - real (r8) :: gsw_enthalpy_ct_exact - end function gsw_enthalpy_ct_exact - - elemental function gsw_enthalpy_diff (sa, ct, p_shallow, p_deep) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: sa, ct, p_shallow, p_deep - real (r8) :: gsw_enthalpy_diff - end function gsw_enthalpy_diff - - elemental function gsw_enthalpy (sa, ct, p) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: sa, ct, p - real (r8) :: gsw_enthalpy - end function gsw_enthalpy - - elemental subroutine gsw_enthalpy_first_derivatives_ct_exact (sa, ct, p, & - h_sa, h_ct) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: sa, ct, p - real (r8), intent(out), optional :: h_sa, h_ct - end subroutine gsw_enthalpy_first_derivatives_ct_exact - - elemental subroutine gsw_enthalpy_first_derivatives (sa, ct, p, h_sa, h_ct) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: sa, ct, p - real (r8), intent(out), optional :: h_sa, h_ct - end subroutine gsw_enthalpy_first_derivatives - - elemental function gsw_enthalpy_ice (t, p) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: t, p - real (r8) :: gsw_enthalpy_ice - end function gsw_enthalpy_ice - - elemental subroutine gsw_enthalpy_second_derivatives_ct_exact (sa, ct, p, & - h_sa_sa, h_sa_ct, h_ct_ct) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: sa, ct, p - real (r8), intent(out), optional :: h_sa_sa, h_sa_ct, h_ct_ct - end subroutine gsw_enthalpy_second_derivatives_ct_exact - - elemental subroutine gsw_enthalpy_second_derivatives (sa, ct, p, h_sa_sa, & - h_sa_ct, h_ct_ct) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: sa, ct, p - real (r8), intent(out), optional :: h_sa_sa, h_sa_ct, h_ct_ct - end subroutine gsw_enthalpy_second_derivatives - - elemental function gsw_enthalpy_sso_0 (p) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: p - real (r8) :: gsw_enthalpy_sso_0 - end function gsw_enthalpy_sso_0 - - elemental function gsw_enthalpy_t_exact (sa, t, p) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: sa, t, p - real (r8) :: gsw_enthalpy_t_exact - end function gsw_enthalpy_t_exact - - elemental subroutine gsw_entropy_first_derivatives (sa, ct, eta_sa, eta_ct) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: sa, ct - real (r8), intent(out), optional :: eta_sa, eta_ct - end subroutine gsw_entropy_first_derivatives - - elemental function gsw_entropy_from_pt (sa, pt) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: sa, pt - real (r8) :: gsw_entropy_from_pt - end function gsw_entropy_from_pt - - elemental function gsw_entropy_from_t (sa, t, p) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: sa, t, p - real (r8) :: gsw_entropy_from_t - end function gsw_entropy_from_t - - elemental function gsw_entropy_ice (t, p) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: t, p - real (r8) :: gsw_entropy_ice - end function gsw_entropy_ice - - elemental function gsw_entropy_part (sa, t, p) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: sa, t, p - real (r8) :: gsw_entropy_part - end function gsw_entropy_part - - elemental function gsw_entropy_part_zerop (sa, pt0) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: sa, pt0 - real (r8) :: gsw_entropy_part_zerop - end function gsw_entropy_part_zerop - - elemental subroutine gsw_entropy_second_derivatives (sa, ct, eta_sa_sa, & - eta_sa_ct, eta_ct_ct) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: sa, ct - real (r8), intent(out), optional :: eta_sa_sa, eta_sa_ct, eta_ct_ct - end subroutine gsw_entropy_second_derivatives - - elemental function gsw_fdelta (p, long, lat) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: p, long, lat - real (r8) :: gsw_fdelta - end function gsw_fdelta - - elemental subroutine gsw_frazil_properties (sa_bulk, h_bulk, p, & - sa_final, ct_final, w_ih_final) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: sa_bulk, h_bulk, p - real (r8), intent(out) :: sa_final, ct_final, w_ih_final - end subroutine gsw_frazil_properties - - elemental subroutine gsw_frazil_properties_potential (sa_bulk, h_pot_bulk,& - p, sa_final, ct_final, w_ih_final) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: sa_bulk, h_pot_bulk, p - real (r8), intent(out) :: sa_final, ct_final, w_ih_final - end subroutine gsw_frazil_properties_potential - - elemental subroutine gsw_frazil_properties_potential_poly (sa_bulk, & - h_pot_bulk, p, sa_final, ct_final, w_ih_final) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: sa_bulk, h_pot_bulk, p - real (r8), intent(out) :: sa_final, ct_final, w_ih_final - end subroutine gsw_frazil_properties_potential_poly - - elemental subroutine gsw_frazil_ratios_adiabatic (sa, p, w_ih, & - dsa_dct_frazil, dsa_dp_frazil, dct_dp_frazil) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: sa, p, w_ih - real (r8), intent(out) :: dsa_dct_frazil, dsa_dp_frazil, dct_dp_frazil - end subroutine gsw_frazil_ratios_adiabatic - - elemental subroutine gsw_frazil_ratios_adiabatic_poly (sa, p, w_ih, & - dsa_dct_frazil, dsa_dp_frazil, dct_dp_frazil) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: sa, p, w_ih - real (r8), intent(out) :: dsa_dct_frazil, dsa_dp_frazil, dct_dp_frazil - end subroutine gsw_frazil_ratios_adiabatic_poly - - pure function gsw_geo_strf_dyn_height (sa, ct, p, p_ref) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: sa(:), ct(:), p(:), p_ref - real (r8) :: gsw_geo_strf_dyn_height(size(sa)) - end function gsw_geo_strf_dyn_height - - pure subroutine gsw_geo_strf_dyn_height_pc (sa, ct, delta_p, & - geo_strf_dyn_height_pc, p_mid) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: sa(:), ct(:), delta_p(:) - real (r8), intent(out) :: geo_strf_dyn_height_pc(:), p_mid(:) - end subroutine gsw_geo_strf_dyn_height_pc - - elemental function gsw_gibbs (ns, nt, np, sa, t, p) - use gsw_mod_kinds - implicit none - integer, intent(in) :: ns, nt, np - real (r8), intent(in) :: sa, t, p - real (r8) :: gsw_gibbs - end function gsw_gibbs - - elemental function gsw_gibbs_ice (nt, np, t, p) - use gsw_mod_kinds - implicit none - integer, intent(in) :: nt, np - real (r8), intent(in) :: t, p - real (r8) :: gsw_gibbs_ice - end function gsw_gibbs_ice - - elemental function gsw_gibbs_ice_part_t (t, p) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: t, p - real (r8) :: gsw_gibbs_ice_part_t - end function gsw_gibbs_ice_part_t - - elemental function gsw_gibbs_ice_pt0 (pt0) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: pt0 - real (r8) :: gsw_gibbs_ice_pt0 - end function gsw_gibbs_ice_pt0 - - elemental function gsw_gibbs_ice_pt0_pt0 (pt0) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: pt0 - real (r8) :: gsw_gibbs_ice_pt0_pt0 - end function gsw_gibbs_ice_pt0_pt0 - - elemental function gsw_gibbs_pt0_pt0 (sa, pt0) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: sa, pt0 - real (r8) :: gsw_gibbs_pt0_pt0 - end function gsw_gibbs_pt0_pt0 - - elemental function gsw_grav (lat, p) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: lat, p - real (r8) :: gsw_grav - end function gsw_grav - - elemental function gsw_helmholtz_energy_ice (t, p) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: t, p - real (r8) :: gsw_helmholtz_energy_ice - end function gsw_helmholtz_energy_ice - - elemental function gsw_hill_ratio_at_sp2 (t) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: t - real (r8) :: gsw_hill_ratio_at_sp2 - end function gsw_hill_ratio_at_sp2 - - elemental subroutine gsw_ice_fraction_to_freeze_seawater (sa, ct, p, & - t_ih, sa_freeze, ct_freeze, w_ih) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: sa, ct, p, t_ih - real (r8), intent(out) :: sa_freeze, ct_freeze, w_ih - end subroutine gsw_ice_fraction_to_freeze_seawater - - elemental function gsw_internal_energy (sa, ct, p) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: sa, ct, p - real (r8) :: gsw_internal_energy - end function gsw_internal_energy - - elemental function gsw_internal_energy_ice (t, p) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: t, p - real (r8) :: gsw_internal_energy_ice - end function gsw_internal_energy_ice - - pure subroutine gsw_ipv_vs_fnsquared_ratio (sa, ct, p, p_ref, & - ipv_vs_fnsquared_ratio, p_mid) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: sa(:), ct(:), p(:), p_ref - real (r8), intent(out) :: ipv_vs_fnsquared_ratio(:), p_mid(:) - end subroutine gsw_ipv_vs_fnsquared_ratio - - elemental function gsw_kappa_const_t_ice (t, p) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: t, p - real (r8) :: gsw_kappa_const_t_ice - end function gsw_kappa_const_t_ice - - elemental function gsw_kappa (sa, ct, p) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: sa, ct, p - real (r8) :: gsw_kappa - end function gsw_kappa - - elemental function gsw_kappa_ice (t, p) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: t, p - real (r8) :: gsw_kappa_ice - end function gsw_kappa_ice - - elemental function gsw_kappa_t_exact (sa, t, p) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: sa, t, p - real (r8) :: gsw_kappa_t_exact - end function gsw_kappa_t_exact - - elemental function gsw_latentheat_evap_ct (sa, ct) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: sa, ct - real (r8) :: gsw_latentheat_evap_ct - end function gsw_latentheat_evap_ct - - elemental function gsw_latentheat_evap_t (sa, t) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: sa, t - real (r8) :: gsw_latentheat_evap_t - end function gsw_latentheat_evap_t - - elemental function gsw_latentheat_melting (sa, p) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: sa, p - real (r8) :: gsw_latentheat_melting - end function gsw_latentheat_melting - - pure subroutine gsw_linear_interp_sa_ct (sa, ct, p, p_i, sa_i, ct_i) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: sa(:), ct(:), p(:), p_i(:) - real (r8), intent(out) :: sa_i(:), ct_i(:) - end subroutine gsw_linear_interp_sa_ct - - elemental function gsw_melting_ice_equilibrium_sa_ct_ratio (sa, p) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: sa, p - real (r8) :: gsw_melting_ice_equilibrium_sa_ct_ratio - end function gsw_melting_ice_equilibrium_sa_ct_ratio - - elemental function gsw_melting_ice_equilibrium_sa_ct_ratio_poly (sa, p) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: sa, p - real (r8) :: gsw_melting_ice_equilibrium_sa_ct_ratio_poly - end function gsw_melting_ice_equilibrium_sa_ct_ratio_poly - - elemental subroutine gsw_melting_ice_into_seawater (sa, ct, p, w_ih, t_ih,& - sa_final, ct_final, w_ih_final) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: sa, ct, p, w_ih, t_ih - real (r8), intent(out) :: sa_final, ct_final, w_ih_final - end subroutine gsw_melting_ice_into_seawater - - elemental function gsw_melting_ice_sa_ct_ratio (sa, ct, p, t_ih) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: sa, ct, p, t_ih - real (r8) :: gsw_melting_ice_sa_ct_ratio - end function gsw_melting_ice_sa_ct_ratio - - elemental function gsw_melting_ice_sa_ct_ratio_poly (sa, ct, p, t_ih) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: sa, ct, p, t_ih - real (r8) :: gsw_melting_ice_sa_ct_ratio_poly - end function gsw_melting_ice_sa_ct_ratio_poly - - elemental function gsw_melting_seaice_equilibrium_sa_ct_ratio (sa, p) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: sa, p - real (r8) :: gsw_melting_seaice_equilibrium_sa_ct_ratio - end function gsw_melting_seaice_equilibrium_sa_ct_ratio - - elemental function gsw_melting_seaice_equilibrium_sa_ct_ratio_poly (sa, p) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: sa, p - real (r8) :: gsw_melting_seaice_equilibrium_sa_ct_ratio_poly - end function gsw_melting_seaice_equilibrium_sa_ct_ratio_poly - - elemental subroutine gsw_melting_seaice_into_seawater (sa, ct, p, & - w_seaice, sa_seaice, t_seaice, sa_final, ct_final) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: sa, ct, p, w_seaice, sa_seaice, t_seaice - real (r8), intent(out) :: sa_final, ct_final - end subroutine gsw_melting_seaice_into_seawater - - elemental function gsw_melting_seaice_sa_ct_ratio (sa, ct, p, sa_seaice, & - t_seaice) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: sa, ct, p, sa_seaice, t_seaice - real (r8) :: gsw_melting_seaice_sa_ct_ratio - end function gsw_melting_seaice_sa_ct_ratio - - elemental function gsw_melting_seaice_sa_ct_ratio_poly (sa, ct, p, & - sa_seaice, t_seaice) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: sa, ct, p, sa_seaice, t_seaice - real (r8) :: gsw_melting_seaice_sa_ct_ratio_poly - end function gsw_melting_seaice_sa_ct_ratio_poly - - pure subroutine gsw_nsquared (sa, ct, p, lat, n2, p_mid) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: sa(:), ct(:), p(:), lat(:) - real (r8), intent(out) :: n2(:), p_mid(:) - end subroutine gsw_nsquared - - elemental function gsw_pot_enthalpy_from_pt_ice (pt0_ice) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: pt0_ice - real (r8) :: gsw_pot_enthalpy_from_pt_ice - end function gsw_pot_enthalpy_from_pt_ice - - elemental function gsw_pot_enthalpy_from_pt_ice_poly (pt0_ice) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: pt0_ice - real (r8) :: gsw_pot_enthalpy_from_pt_ice_poly - end function gsw_pot_enthalpy_from_pt_ice_poly - - elemental function gsw_pot_enthalpy_ice_freezing (sa, p) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: sa, p - real (r8) :: gsw_pot_enthalpy_ice_freezing - end function gsw_pot_enthalpy_ice_freezing - - elemental subroutine gsw_pot_enthalpy_ice_freezing_first_derivatives (sa, & - p, pot_enthalpy_ice_freezing_sa, pot_enthalpy_ice_freezing_p) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: sa, p - real (r8), intent(out), optional :: pot_enthalpy_ice_freezing_sa - real (r8), intent(out), optional :: pot_enthalpy_ice_freezing_p - end subroutine gsw_pot_enthalpy_ice_freezing_first_derivatives - - elemental subroutine gsw_pot_enthalpy_ice_freezing_first_derivatives_poly(& - sa, p, pot_enthalpy_ice_freezing_sa, pot_enthalpy_ice_freezing_p) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: sa, p - real (r8), intent(out), optional :: pot_enthalpy_ice_freezing_sa - real (r8), intent(out), optional :: pot_enthalpy_ice_freezing_p - end subroutine gsw_pot_enthalpy_ice_freezing_first_derivatives_poly - - elemental function gsw_pot_enthalpy_ice_freezing_poly (sa, p) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: sa, p - real (r8) :: gsw_pot_enthalpy_ice_freezing_poly - end function gsw_pot_enthalpy_ice_freezing_poly - - elemental function gsw_pot_rho_t_exact (sa, t, p, p_ref) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: sa, t, p, p_ref - real (r8) :: gsw_pot_rho_t_exact - end function gsw_pot_rho_t_exact - - elemental function gsw_pressure_coefficient_ice (t, p) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: t, p - real (r8) :: gsw_pressure_coefficient_ice - end function gsw_pressure_coefficient_ice - - elemental function gsw_pressure_freezing_ct (sa, ct, saturation_fraction) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: sa, ct, saturation_fraction - real (r8) :: gsw_pressure_freezing_ct - end function gsw_pressure_freezing_ct - - elemental function gsw_pt0_cold_ice_poly (pot_enthalpy_ice) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: pot_enthalpy_ice - real (r8) :: gsw_pt0_cold_ice_poly - end function gsw_pt0_cold_ice_poly - - elemental function gsw_pt0_from_t (sa, t, p) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: sa, t, p - real (r8) :: gsw_pt0_from_t - end function gsw_pt0_from_t - - elemental function gsw_pt0_from_t_ice (t, p) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: t, p - real (r8) :: gsw_pt0_from_t_ice - end function gsw_pt0_from_t_ice - - elemental subroutine gsw_pt_first_derivatives (sa, ct, pt_sa, pt_ct) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: sa, ct - real (r8), intent(out), optional :: pt_sa, pt_ct - end subroutine gsw_pt_first_derivatives - - elemental function gsw_pt_from_ct (sa, ct) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: sa, ct - real (r8) :: gsw_pt_from_ct - end function gsw_pt_from_ct - - elemental function gsw_pt_from_entropy (sa, entropy) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: sa, entropy - real (r8) :: gsw_pt_from_entropy - end function gsw_pt_from_entropy - - elemental function gsw_pt_from_pot_enthalpy_ice (pot_enthalpy_ice) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: pot_enthalpy_ice - real (r8) :: gsw_pt_from_pot_enthalpy_ice - end function gsw_pt_from_pot_enthalpy_ice - - elemental function gsw_pt_from_pot_enthalpy_ice_poly_dh (pot_enthalpy_ice) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: pot_enthalpy_ice - real (r8) :: gsw_pt_from_pot_enthalpy_ice_poly_dh - end function gsw_pt_from_pot_enthalpy_ice_poly_dh - - elemental function gsw_pt_from_pot_enthalpy_ice_poly (pot_enthalpy_ice) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: pot_enthalpy_ice - real (r8) :: gsw_pt_from_pot_enthalpy_ice_poly - end function gsw_pt_from_pot_enthalpy_ice_poly - - elemental function gsw_pt_from_t (sa, t, p, p_ref) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: sa, t, p, p_ref - real (r8) :: gsw_pt_from_t - end function gsw_pt_from_t - - elemental function gsw_pt_from_t_ice (t, p, p_ref) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: t, p, p_ref - real (r8) :: gsw_pt_from_t_ice - end function gsw_pt_from_t_ice - - elemental subroutine gsw_pt_second_derivatives (sa, ct, pt_sa_sa, & - pt_sa_ct, pt_ct_ct) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: sa, ct - real (r8), intent(out), optional :: pt_sa_sa, pt_sa_ct, pt_ct_ct - end subroutine gsw_pt_second_derivatives - - elemental subroutine gsw_rho_alpha_beta (sa, ct, p, rho, alpha, beta) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: sa, ct, p - real (r8), intent(out), optional :: rho, alpha, beta - end subroutine gsw_rho_alpha_beta - - elemental function gsw_rho (sa, ct, p) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: sa, ct, p - real (r8) :: gsw_rho - end function gsw_rho - - elemental subroutine gsw_rho_first_derivatives (sa, ct, p, drho_dsa, & - drho_dct, drho_dp) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: sa, ct, p - real (r8), intent(out), optional :: drho_dsa, drho_dct, drho_dp - end subroutine gsw_rho_first_derivatives - - elemental subroutine gsw_rho_first_derivatives_wrt_enthalpy (sa, ct, p, & - rho_sa, rho_h) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: sa, ct, p - real (r8), intent(out), optional :: rho_sa, rho_h - end subroutine gsw_rho_first_derivatives_wrt_enthalpy - - elemental function gsw_rho_ice (t, p) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: t, p - real (r8) :: gsw_rho_ice - end function gsw_rho_ice - - elemental subroutine gsw_rho_second_derivatives (sa, ct, p, rho_sa_sa, & - rho_sa_ct, rho_ct_ct, rho_sa_p, rho_ct_p) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: sa, ct, p - real (r8), intent(out), optional :: rho_sa_sa, rho_sa_ct, rho_ct_ct - real (r8), intent(out), optional :: rho_sa_p, rho_ct_p - end subroutine gsw_rho_second_derivatives - - elemental subroutine gsw_rho_second_derivatives_wrt_enthalpy (sa, ct, p, & - rho_sa_sa, rho_sa_h, rho_h_h) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: sa, ct, p - real (r8), intent(out), optional :: rho_sa_sa, rho_sa_h, rho_h_h - end subroutine gsw_rho_second_derivatives_wrt_enthalpy - - elemental function gsw_rho_t_exact (sa, t, p) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: sa, t, p - real (r8) :: gsw_rho_t_exact - end function gsw_rho_t_exact - - pure subroutine gsw_rr68_interp_sa_ct (sa, ct, p, p_i, sa_i, ct_i) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: sa(:), ct(:), p(:), p_i(:) - real (r8), intent(out) :: sa_i(:), ct_i(:) - end subroutine gsw_rr68_interp_sa_ct - - elemental function gsw_saar (p, long, lat) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: p, long, lat - real (r8) :: gsw_saar - end function gsw_saar - - elemental function gsw_sa_freezing_estimate (p, saturation_fraction, ct, t) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: p, saturation_fraction - real (r8), intent(in), optional :: ct, t - real (r8) :: gsw_sa_freezing_estimate - end function gsw_sa_freezing_estimate - - elemental function gsw_sa_freezing_from_ct (ct, p, saturation_fraction) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: ct, p, saturation_fraction - real (r8) :: gsw_sa_freezing_from_ct - end function gsw_sa_freezing_from_ct - - elemental function gsw_sa_freezing_from_ct_poly (ct, p, saturation_fraction) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: ct, p, saturation_fraction - real (r8) :: gsw_sa_freezing_from_ct_poly - end function gsw_sa_freezing_from_ct_poly - - elemental function gsw_sa_freezing_from_t (t, p, saturation_fraction) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: t, p, saturation_fraction - real (r8) :: gsw_sa_freezing_from_t - end function gsw_sa_freezing_from_t - - elemental function gsw_sa_freezing_from_t_poly (t, p, saturation_fraction) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: t, p, saturation_fraction - real (r8) :: gsw_sa_freezing_from_t_poly - end function gsw_sa_freezing_from_t_poly - - elemental function gsw_sa_from_rho (rho, ct, p) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: rho, ct, p - real (r8) :: gsw_sa_from_rho - end function gsw_sa_from_rho - - elemental function gsw_sa_from_sp_baltic (sp, long, lat) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: sp, long, lat - real (r8) :: gsw_sa_from_sp_baltic - end function gsw_sa_from_sp_baltic - - elemental function gsw_sa_from_sp (sp, p, long, lat) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: sp, p, long, lat - real (r8) :: gsw_sa_from_sp - end function gsw_sa_from_sp - - elemental function gsw_sa_from_sstar (sstar, p, long, lat) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: sstar, p, long, lat - real (r8) :: gsw_sa_from_sstar - end function gsw_sa_from_sstar - - elemental function gsw_sa_p_inrange (sa, p) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: sa, p - logical :: gsw_sa_p_inrange - end function gsw_sa_p_inrange - - elemental subroutine gsw_seaice_fraction_to_freeze_seawater (sa, ct, p, & - sa_seaice, t_seaice, sa_freeze, ct_freeze, w_seaice) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: sa, ct, p, sa_seaice, t_seaice - real (r8), intent(out) :: sa_freeze, ct_freeze, w_seaice - end subroutine gsw_seaice_fraction_to_freeze_seawater - - elemental function gsw_sigma0 (sa, ct) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: sa, ct - real (r8) :: gsw_sigma0 - end function gsw_sigma0 - - elemental function gsw_sigma1 (sa, ct) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: sa, ct - real (r8) :: gsw_sigma1 - end function gsw_sigma1 - - elemental function gsw_sigma2 (sa, ct) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: sa, ct - real (r8) :: gsw_sigma2 - end function gsw_sigma2 - - elemental function gsw_sigma3 (sa, ct) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: sa, ct - real (r8) :: gsw_sigma3 - end function gsw_sigma3 - - elemental function gsw_sigma4 (sa, ct) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: sa, ct - real (r8) :: gsw_sigma4 - end function gsw_sigma4 - - elemental function gsw_sound_speed (sa, ct, p) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: sa, ct, p - real (r8) :: gsw_sound_speed - end function gsw_sound_speed - - elemental function gsw_sound_speed_ice (t, p) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: t, p - real (r8) :: gsw_sound_speed_ice - end function gsw_sound_speed_ice - - elemental function gsw_sound_speed_t_exact (sa, t, p) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: sa, t, p - real (r8) :: gsw_sound_speed_t_exact - end function gsw_sound_speed_t_exact - - elemental subroutine gsw_specvol_alpha_beta (sa, ct, p, specvol, alpha, & - beta) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: sa, ct, p - real (r8), intent(out), optional :: specvol, alpha, beta - end subroutine gsw_specvol_alpha_beta - - elemental function gsw_specvol_anom_standard (sa, ct, p) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: sa, ct, p - real (r8) :: gsw_specvol_anom_standard - end function gsw_specvol_anom_standard - - elemental function gsw_specvol (sa, ct, p) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: sa, ct, p - real (r8) :: gsw_specvol - end function gsw_specvol - - elemental subroutine gsw_specvol_first_derivatives (sa, ct, p, v_sa, v_ct, & - v_p, iflag) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: sa, ct, p - integer, intent(in), optional :: iflag - real (r8), intent(out), optional :: v_sa, v_ct, v_p - end subroutine gsw_specvol_first_derivatives - - elemental subroutine gsw_specvol_first_derivatives_wrt_enthalpy (sa, ct, & - p, v_sa, v_h, iflag) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: sa, ct, p - integer, intent(in), optional :: iflag - real (r8), intent(out), optional :: v_sa, v_h - end subroutine gsw_specvol_first_derivatives_wrt_enthalpy - - elemental function gsw_specvol_ice (t, p) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: t, p - real (r8) :: gsw_specvol_ice - end function gsw_specvol_ice - - elemental subroutine gsw_specvol_second_derivatives (sa, ct, p, v_sa_sa, & - v_sa_ct, v_ct_ct, v_sa_p, v_ct_p, iflag) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: sa, ct, p - integer, intent(in), optional :: iflag - real (r8), intent(out), optional :: v_sa_sa, v_sa_ct, v_ct_ct, v_sa_p, v_ct_p - end subroutine gsw_specvol_second_derivatives - - elemental subroutine gsw_specvol_second_derivatives_wrt_enthalpy (sa, ct, & - p, v_sa_sa, v_sa_h, v_h_h, iflag) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: sa, ct, p - integer, intent(in), optional :: iflag - real (r8), intent(out), optional :: v_sa_sa, v_sa_h, v_h_h - end subroutine gsw_specvol_second_derivatives_wrt_enthalpy - - elemental function gsw_specvol_sso_0 (p) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: p - real (r8) :: gsw_specvol_sso_0 - end function gsw_specvol_sso_0 - - elemental function gsw_specvol_t_exact (sa, t, p) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: sa, t, p - real (r8) :: gsw_specvol_t_exact - end function gsw_specvol_t_exact - - elemental function gsw_sp_from_c (c, t, p) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: c, t, p - real (r8) :: gsw_sp_from_c - end function gsw_sp_from_c - - elemental function gsw_sp_from_sa_baltic (sa, long, lat) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: sa, long, lat - real (r8) :: gsw_sp_from_sa_baltic - end function gsw_sp_from_sa_baltic - - elemental function gsw_sp_from_sa (sa, p, long, lat) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: sa, p, long, lat - real (r8) :: gsw_sp_from_sa - end function gsw_sp_from_sa - - elemental function gsw_sp_from_sk (sk) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: sk - real (r8) :: gsw_sp_from_sk - end function gsw_sp_from_sk - - elemental function gsw_sp_from_sr (sr) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: sr - real (r8) :: gsw_sp_from_sr - end function gsw_sp_from_sr - - elemental function gsw_sp_from_sstar (sstar, p, long, lat) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: sstar, p, long, lat - real (r8) :: gsw_sp_from_sstar - end function gsw_sp_from_sstar - - elemental function gsw_spiciness0 (sa, ct) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: sa, ct - real (r8) :: gsw_spiciness0 - end function gsw_spiciness0 - - elemental function gsw_spiciness1 (sa, ct) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: sa, ct - real (r8) :: gsw_spiciness1 - end function gsw_spiciness1 - - elemental function gsw_spiciness2 (sa, ct) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: sa, ct - real (r8) :: gsw_spiciness2 - end function gsw_spiciness2 - - elemental function gsw_sr_from_sp (sp) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: sp - real (r8) :: gsw_sr_from_sp - end function gsw_sr_from_sp - - elemental function gsw_sstar_from_sa (sa, p, long, lat) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: sa, p, long, lat - real (r8) :: gsw_sstar_from_sa - end function gsw_sstar_from_sa - - elemental function gsw_sstar_from_sp (sp, p, long, lat) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: sp, p, long, lat - real (r8) :: gsw_sstar_from_sp - end function gsw_sstar_from_sp - - elemental function gsw_t_deriv_chem_potential_water_t_exact (sa, t, p) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: sa, t, p - real (r8) :: gsw_t_deriv_chem_potential_water_t_exact - end function gsw_t_deriv_chem_potential_water_t_exact - - elemental function gsw_t_freezing_exact (sa, p, saturation_fraction) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: sa, p, saturation_fraction - real (r8) :: gsw_t_freezing_exact - end function gsw_t_freezing_exact - - elemental function gsw_t_freezing (sa, p, saturation_fraction, poly) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: sa, p, saturation_fraction - logical, intent(in), optional :: poly - real (r8) :: gsw_t_freezing - end function gsw_t_freezing - - elemental subroutine gsw_t_freezing_first_derivatives (sa, p, & - saturation_fraction, tfreezing_sa, tfreezing_p) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: sa, p, saturation_fraction - real (r8), intent(out), optional :: tfreezing_sa, tfreezing_p - end subroutine gsw_t_freezing_first_derivatives - - elemental subroutine gsw_t_freezing_first_derivatives_poly (sa, p, & - saturation_fraction, tfreezing_sa, tfreezing_p) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: sa, p, saturation_fraction - real (r8), intent(out), optional :: tfreezing_sa, tfreezing_p - end subroutine gsw_t_freezing_first_derivatives_poly - - elemental function gsw_t_freezing_poly (sa, p, saturation_fraction, polynomial) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: sa, p - real (r8), intent(in), optional :: saturation_fraction - logical, intent(in), optional :: polynomial - real (r8) :: gsw_t_freezing_poly - end function gsw_t_freezing_poly - - elemental function gsw_t_from_ct (sa, ct, p) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: sa, ct, p - real (r8) :: gsw_t_from_ct - end function gsw_t_from_ct - - elemental function gsw_t_from_pt0_ice (pt0_ice, p) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: pt0_ice, p - real (r8) :: gsw_t_from_pt0_ice - end function gsw_t_from_pt0_ice - - elemental function gsw_thermobaric (sa, ct, p) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: sa, ct, p - real (r8) :: gsw_thermobaric - end function gsw_thermobaric - - pure subroutine gsw_turner_rsubrho (sa, ct, p, tu, rsubrho, p_mid) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: sa(:), ct(:), p(:) - real (r8), intent(out) :: tu(:), rsubrho(:), p_mid(:) - end subroutine gsw_turner_rsubrho - - pure subroutine gsw_util_indx (x, n, z, k) - use gsw_mod_kinds - integer, intent(in) :: n - integer, intent(out) :: k - real (r8), intent(in), dimension(n) :: x - real (r8), intent(in) :: z - end subroutine gsw_util_indx - - pure function gsw_util_interp1q_int (x, iy, x_i) result(y_i) - use gsw_mod_kinds - implicit none - integer, intent(in) :: iy(:) - real (r8), intent(in) :: x(:), x_i(:) - real (r8) :: y_i(size(x_i)) - end function gsw_util_interp1q_int - - pure function gsw_util_sort_real (rarray) result(iarray) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: rarray(:) ! Values to be sorted - integer :: iarray(size(rarray)) ! Sorted ids - end function gsw_util_sort_real - - pure function gsw_util_xinterp1 (x, y, n, x0) - use gsw_mod_kinds - implicit none - integer, intent(in) :: n - real (r8), intent(in) :: x0 - real (r8), dimension(n), intent(in) :: x, y - real (r8) :: gsw_util_xinterp1 - end function gsw_util_xinterp1 - - elemental function gsw_z_from_p (p, lat) - use gsw_mod_kinds - implicit none - real (r8), intent(in) :: p, lat - real (r8) :: gsw_z_from_p - end function gsw_z_from_p - -end interface - -end module gsw_mod_toolbox diff --git a/src/equation_of_state/TEOS10/gsw_mod_toolbox.f90 b/src/equation_of_state/TEOS10/gsw_mod_toolbox.f90 new file mode 120000 index 0000000000..f2f4761ec4 --- /dev/null +++ b/src/equation_of_state/TEOS10/gsw_mod_toolbox.f90 @@ -0,0 +1 @@ +../../../pkg/GSW-Fortran/modules/gsw_mod_toolbox.f90 \ No newline at end of file diff --git a/src/equation_of_state/TEOS10/gsw_pt0_from_t.f90 b/src/equation_of_state/TEOS10/gsw_pt0_from_t.f90 deleted file mode 100644 index 63c2c83292..0000000000 --- a/src/equation_of_state/TEOS10/gsw_pt0_from_t.f90 +++ /dev/null @@ -1,59 +0,0 @@ -!========================================================================== -elemental function gsw_pt0_from_t (sa, t, p) -!========================================================================== -! -! Calculates potential temperature with reference pressure, p_ref = 0 dbar. -! -! sa : Absolute Salinity [g/kg] -! t : in-situ temperature [deg C] -! p : sea pressure [dbar] -! -! gsw_pt0_from_t : potential temperature, p_ref = 0 [deg C] -!-------------------------------------------------------------------------- - -use gsw_mod_toolbox, only : gsw_entropy_part, gsw_entropy_part_zerop -use gsw_mod_toolbox, only : gsw_gibbs_pt0_pt0 - -use gsw_mod_teos10_constants, only : gsw_cp0, gsw_sso, gsw_t0, gsw_ups - -use gsw_mod_kinds - -implicit none - -real (r8), intent(in) :: sa, t, p - -real (r8) :: gsw_pt0_from_t - -integer n, no_iter -real (r8) :: s1, true_entropy_part, pt0m -real (r8) :: pt0, pt0_old, de_dt, dentropy, dentropy_dt - -s1 = sa/gsw_ups - -pt0 = t + p*( 8.65483913395442e-6_r8 - & - s1 * 1.41636299744881e-6_r8 - & - p * 7.38286467135737e-9_r8 + & - t *(-8.38241357039698e-6_r8 + & - s1 * 2.83933368585534e-8_r8 + & - t * 1.77803965218656e-8_r8 + & - p * 1.71155619208233e-10_r8)) - -dentropy_dt = gsw_cp0/((gsw_t0 + pt0)*(1.0_r8 - 0.05_r8*(1.0_r8 - sa/gsw_sso))) - -true_entropy_part = gsw_entropy_part(sa,t,p) - -do no_iter = 1, 2 - pt0_old = pt0 - dentropy = gsw_entropy_part_zerop(sa,pt0_old) - true_entropy_part - pt0 = pt0_old - dentropy/dentropy_dt - pt0m = 0.5_r8*(pt0 + pt0_old) - dentropy_dt = -gsw_gibbs_pt0_pt0(sa,pt0m) - pt0 = pt0_old - dentropy/dentropy_dt -end do - -gsw_pt0_from_t = pt0 - -return -end function - -!-------------------------------------------------------------------------- diff --git a/src/equation_of_state/TEOS10/gsw_pt0_from_t.f90 b/src/equation_of_state/TEOS10/gsw_pt0_from_t.f90 new file mode 120000 index 0000000000..79cf5b0d65 --- /dev/null +++ b/src/equation_of_state/TEOS10/gsw_pt0_from_t.f90 @@ -0,0 +1 @@ +../../../pkg/GSW-Fortran/toolbox/gsw_pt0_from_t.f90 \ No newline at end of file diff --git a/src/equation_of_state/TEOS10/gsw_pt_from_ct.f90 b/src/equation_of_state/TEOS10/gsw_pt_from_ct.f90 deleted file mode 100644 index b856b923c8..0000000000 --- a/src/equation_of_state/TEOS10/gsw_pt_from_ct.f90 +++ /dev/null @@ -1,72 +0,0 @@ -!========================================================================== -elemental function gsw_pt_from_ct (sa, ct) -!========================================================================== -! -! potential temperature of seawater from conservative temperature -! -! sa : Absolute Salinity [g/kg] -! ct : Conservative Temperature [deg C] -! p : sea pressure [dbar] -! -! gsw_pt_from_ct : potential temperature with [deg C] -! reference pressure of 0 dbar -!-------------------------------------------------------------------------- - -use gsw_mod_toolbox, only : gsw_ct_from_pt, gsw_gibbs_pt0_pt0 - -use gsw_mod_teos10_constants, only : gsw_cp0, gsw_ups, gsw_t0 - -use gsw_mod_kinds - -implicit none - -real (r8), intent(in) :: sa, ct - -real (r8) :: gsw_pt_from_ct - -real (r8) :: a5ct, b3ct, ct_factor, pt_num, pt_recden, ct_diff -real (r8) :: ct0, pt, pt_old, ptm, dct, dpt_dct, s1 - -real (r8), parameter :: a0 = -1.446013646344788e-2_r8 -real (r8), parameter :: a1 = -3.305308995852924e-3_r8 -real (r8), parameter :: a2 = 1.062415929128982e-4_r8 -real (r8), parameter :: a3 = 9.477566673794488e-1_r8 -real (r8), parameter :: a4 = 2.166591947736613e-3_r8 -real (r8), parameter :: a5 = 3.828842955039902e-3_r8 - -real (r8), parameter :: b0 = 1.0_r8 -real (r8), parameter :: b1 = 6.506097115635800e-4_r8 -real (r8), parameter :: b2 = 3.830289486850898e-3_r8 -real (r8), parameter :: b3 = 1.247811760368034e-6_r8 - -s1 = sa/gsw_ups - -a5ct = a5*ct -b3ct = b3*ct - -ct_factor = (a3 + a4*s1 + a5ct) -pt_num = a0 + s1*(a1 + a2*s1) + ct*ct_factor -pt_recden = 1.0_r8/(b0 + b1*s1 + ct*(b2 + b3ct)) -pt = pt_num*pt_recden - -dpt_dct = (ct_factor + a5ct - (b2 + b3ct + b3ct)*pt)*pt_recden - -! Start the 1.5 iterations through the modified Newton-Rapshon iterative, -! method, which is also known as the Newton-McDougall method. - -ct_diff = gsw_ct_from_pt(sa,pt) - ct -pt_old = pt -pt = pt_old - ct_diff*dpt_dct -ptm = 0.5_r8*(pt + pt_old) - -dpt_dct = -gsw_cp0/((ptm + gsw_t0)*gsw_gibbs_pt0_pt0(sa,ptm)) - -pt = pt_old - ct_diff*dpt_dct -ct_diff = gsw_ct_from_pt(sa,pt) - ct -pt_old = pt -gsw_pt_from_ct = pt_old - ct_diff*dpt_dct - -return -end function - -!-------------------------------------------------------------------------- diff --git a/src/equation_of_state/TEOS10/gsw_pt_from_ct.f90 b/src/equation_of_state/TEOS10/gsw_pt_from_ct.f90 new file mode 120000 index 0000000000..cd794a1316 --- /dev/null +++ b/src/equation_of_state/TEOS10/gsw_pt_from_ct.f90 @@ -0,0 +1 @@ +../../../pkg/GSW-Fortran/toolbox/gsw_pt_from_ct.f90 \ No newline at end of file diff --git a/src/equation_of_state/TEOS10/gsw_pt_from_t.f90 b/src/equation_of_state/TEOS10/gsw_pt_from_t.f90 deleted file mode 100644 index 46dc766fb6..0000000000 --- a/src/equation_of_state/TEOS10/gsw_pt_from_t.f90 +++ /dev/null @@ -1,61 +0,0 @@ -!========================================================================== -elemental function gsw_pt_from_t (sa, t, p, p_ref) -!========================================================================== -! -! Calculates potential temperature of seawater from in-situ temperature -! -! sa : Absolute Salinity [g/kg] -! t : in-situ temperature [deg C] -! p : sea pressure [dbar] -! p_ref : reference sea pressure [dbar] -! -! gsw_pt_from_t : potential temperature [deg C] -!-------------------------------------------------------------------------- - -use gsw_mod_toolbox, only : gsw_entropy_part, gsw_gibbs - -use gsw_mod_teos10_constants, only : gsw_cp0, gsw_sso, gsw_t0, gsw_ups - -use gsw_mod_kinds - -implicit none - -real (r8), intent(in) :: sa, t, p, p_ref - -real (r8) :: gsw_pt_from_t - -integer n, no_iter -real (r8) :: s1, pt, pt_old, de_dt, dentropy, dentropy_dt -real (r8) :: true_entropy_part, ptm - -integer, parameter :: n0=0, n2=2 - -s1 = sa/gsw_ups - -pt = t + (p-p_ref)*( 8.65483913395442e-6_r8 - & - s1 * 1.41636299744881e-6_r8 - & - (p+p_ref)* 7.38286467135737e-9_r8 + & - t *(-8.38241357039698e-6_r8 + & - s1 * 2.83933368585534e-8_r8 + & - t * 1.77803965218656e-8_r8 + & - (p+p_ref)* 1.71155619208233e-10_r8)) - -dentropy_dt = gsw_cp0/((gsw_t0 + pt)*(1.0_r8 - 0.05_r8*(1.0_r8 - sa/gsw_sso))) - -true_entropy_part = gsw_entropy_part(sa,t,p) - -do no_iter = 1, 2 - pt_old = pt - dentropy = gsw_entropy_part(sa,pt_old,p_ref) - true_entropy_part - pt = pt_old - dentropy/dentropy_dt - ptm = 0.5_r8*(pt + pt_old) - dentropy_dt = -gsw_gibbs(n0,n2,n0,sa,ptm,p_ref) - pt = pt_old - dentropy/dentropy_dt -end do - -gsw_pt_from_t = pt - -return -end function - -!-------------------------------------------------------------------------- diff --git a/src/equation_of_state/TEOS10/gsw_pt_from_t.f90 b/src/equation_of_state/TEOS10/gsw_pt_from_t.f90 new file mode 120000 index 0000000000..37fa5f104f --- /dev/null +++ b/src/equation_of_state/TEOS10/gsw_pt_from_t.f90 @@ -0,0 +1 @@ +../../../pkg/GSW-Fortran/toolbox/gsw_pt_from_t.f90 \ No newline at end of file diff --git a/src/equation_of_state/TEOS10/gsw_rho.f90 b/src/equation_of_state/TEOS10/gsw_rho.f90 deleted file mode 100644 index 3daa65746e..0000000000 --- a/src/equation_of_state/TEOS10/gsw_rho.f90 +++ /dev/null @@ -1,36 +0,0 @@ -!========================================================================== -elemental function gsw_rho (sa, ct, p) -!========================================================================== -! -! Calculates in-situ density from Absolute Salinity and Conservative -! Temperature, using the computationally-efficient expression for -! specific volume in terms of SA, CT and p (Roquet et al., 2014). -! -! Note that potential density with respect to reference pressure, pr, is -! obtained by calling this function with the pressure argument being pr -! (i.e. "gsw_rho(SA,CT,pr)"). -! -! SA = Absolute Salinity [ g/kg ] -! CT = Conservative Temperature (ITS-90) [ deg C ] -! p = sea pressure [ dbar ] -! ( i.e. absolute pressure - 10.1325 dbar ) -! -! rho = in-situ density [ kg/m ] -!-------------------------------------------------------------------------- - -use gsw_mod_toolbox, only : gsw_specvol - -use gsw_mod_kinds - -implicit none - -real (r8), intent(in) :: sa, ct, p - -real (r8) :: gsw_rho - -gsw_rho = 1.0_r8/gsw_specvol(sa,ct,p) - -return -end function - -!-------------------------------------------------------------------------- diff --git a/src/equation_of_state/TEOS10/gsw_rho.f90 b/src/equation_of_state/TEOS10/gsw_rho.f90 new file mode 120000 index 0000000000..22eea6219a --- /dev/null +++ b/src/equation_of_state/TEOS10/gsw_rho.f90 @@ -0,0 +1 @@ +../../../pkg/GSW-Fortran/toolbox/gsw_rho.f90 \ No newline at end of file diff --git a/src/equation_of_state/TEOS10/gsw_rho_first_derivatives.f90 b/src/equation_of_state/TEOS10/gsw_rho_first_derivatives.f90 deleted file mode 100644 index b4ee696a1d..0000000000 --- a/src/equation_of_state/TEOS10/gsw_rho_first_derivatives.f90 +++ /dev/null @@ -1,110 +0,0 @@ -!========================================================================== -elemental subroutine gsw_rho_first_derivatives (sa, ct, p, drho_dsa, & - drho_dct, drho_dp) -!========================================================================== -! -! Calculates the three (3) partial derivatives of in-situ density with -! respect to Absolute Salinity, Conservative Temperature and pressure. -! Note that the pressure derivative is done with respect to pressure in -! Pa, not dbar. This function uses the computationally-efficient expression -! for specific volume in terms of SA, CT and p (Roquet et al., 2014). -! -! SA = Absolute Salinity [ g/kg ] -! CT = Conservative Temperature (ITS-90) [ deg C ] -! p = sea pressure [ dbar ] -! ( i.e. absolute pressure - 10.1325 dbar ) -! -! drho_dSA = partial derivatives of density [ kg^2/(g m^3) ] -! with respect to Absolute Salinity -! drho_dCT = partial derivatives of density [ kg/(K m^3) ] -! with respect to Conservative Temperature -! drho_dP = partial derivatives of density [ kg/(Pa m^3) ] -! with respect to pressure in Pa -!-------------------------------------------------------------------------- - -use gsw_mod_teos10_constants, only : pa2db, gsw_sfac, offset - -use gsw_mod_specvol_coefficients - -use gsw_mod_kinds - -implicit none - -real (r8), intent(in) :: sa, ct, p -real (r8), intent(out), optional :: drho_dsa, drho_dct, drho_dp - -real (r8) :: rho2, v_ct, v_p, v_sa, xs, ys, z, v - -xs = sqrt(gsw_sfac*sa + offset) -ys = ct*0.025_r8 -z = p*1e-4_r8 - -v = v000 + xs*(v010 + xs*(v020 + xs*(v030 + xs*(v040 + xs*(v050 & - + v060*xs))))) + ys*(v100 + xs*(v110 + xs*(v120 + xs*(v130 + xs*(v140 & - + v150*xs)))) + ys*(v200 + xs*(v210 + xs*(v220 + xs*(v230 + v240*xs))) & - + ys*(v300 + xs*(v310 + xs*(v320 + v330*xs)) + ys*(v400 + xs*(v410 & - + v420*xs) + ys*(v500 + v510*xs + v600*ys))))) + z*(v001 + xs*(v011 & - + xs*(v021 + xs*(v031 + xs*(v041 + v051*xs)))) + ys*(v101 + xs*(v111 & - + xs*(v121 + xs*(v131 + v141*xs))) + ys*(v201 + xs*(v211 + xs*(v221 & - + v231*xs)) + ys*(v301 + xs*(v311 + v321*xs) + ys*(v401 + v411*xs & - + v501*ys)))) + z*(v002 + xs*(v012 + xs*(v022 + xs*(v032 + v042*xs))) & - + ys*(v102 + xs*(v112 + xs*(v122 + v132*xs)) + ys*(v202 + xs*(v212 & - + v222*xs) + ys*(v302 + v312*xs + v402*ys))) + z*(v003 + xs*(v013 & - + v023*xs) + ys*(v103 + v113*xs + v203*ys) + z*(v004 + v014*xs + v104*ys & - + z*(v005 + v006*z))))) - -rho2 = (1.0_r8/v)**2 - -if (present(drho_dsa)) then - - v_sa = b000 + xs*(b100 + xs*(b200 + xs*(b300 + xs*(b400 + b500*xs)))) & - + ys*(b010 + xs*(b110 + xs*(b210 + xs*(b310 + b410*xs))) & - + ys*(b020 + xs*(b120 + xs*(b220 + b320*xs)) + ys*(b030 & - + xs*(b130 + b230*xs) + ys*(b040 + b140*xs + b050*ys)))) & - + z*(b001 + xs*(b101 + xs*(b201 + xs*(b301 + b401*xs))) & - + ys*(b011 + xs*(b111 + xs*(b211 + b311*xs)) + ys*(b021 & - + xs*(b121 + b221*xs) + ys*(b031 + b131*xs + b041*ys))) & - + z*(b002 + xs*(b102 + xs*(b202 + b302*xs))+ ys*(b012 & - + xs*(b112 + b212*xs) + ys*(b022 + b122*xs + b032*ys)) & - + z*(b003 + b103*xs + b013*ys + b004*z))) - - drho_dsa = -rho2*0.5_r8*gsw_sfac*v_sa/xs - -end if - -if (present(drho_dct)) then - - v_ct = a000 + xs*(a100 + xs*(a200 + xs*(a300 + xs*(a400 + a500*xs)))) & - + ys*(a010 + xs*(a110 + xs*(a210 + xs*(a310 + a410*xs))) & - + ys*(a020 + xs*(a120 + xs*(a220 + a320*xs)) + ys*(a030 & - + xs*(a130 + a230*xs) + ys*(a040 + a140*xs + a050*ys )))) & - + z*(a001 + xs*(a101 + xs*(a201 + xs*(a301 + a401*xs))) & - + ys*(a011 + xs*(a111 + xs*(a211 + a311*xs)) + ys*(a021 & - + xs*(a121 + a221*xs) + ys*(a031 + a131*xs + a041*ys))) & - + z*(a002 + xs*(a102 + xs*(a202 + a302*xs)) + ys*(a012 & - + xs*(a112 + a212*xs) + ys*(a022 + a122*xs + a032*ys)) & - + z*(a003 + a103*xs + a013*ys + a004*z))) - - drho_dct = -rho2*0.025_r8*v_ct - -end if - -if (present(drho_dp)) then - - v_p = c000 + xs*(c100 + xs*(c200 + xs*(c300 + xs*(c400 + c500*xs)))) & - + ys*(c010 + xs*(c110 + xs*(c210 + xs*(c310 + c410*xs))) + ys*(c020 & - + xs*(c120 + xs*(c220 + c320*xs)) + ys*(c030 + xs*(c130 + c230*xs) & - + ys*(c040 + c140*xs + c050*ys)))) + z*(c001 + xs*(c101 + xs*(c201 & - + xs*(c301 + c401*xs))) + ys*(c011 + xs*(c111 + xs*(c211 + c311*xs)) & - + ys*(c021 + xs*(c121 + c221*xs) + ys*(c031 + c131*xs + c041*ys))) & - + z*(c002 + xs*(c102 + c202*xs) + ys*(c012 + c112*xs + c022*ys) & - + z*(c003 + c103*xs + c013*ys + z*(c004 + c005*z)))) - - drho_dp = -rho2*1e-4_r8*pa2db*v_p - -end if - -return -end subroutine - -!-------------------------------------------------------------------------- diff --git a/src/equation_of_state/TEOS10/gsw_rho_first_derivatives.f90 b/src/equation_of_state/TEOS10/gsw_rho_first_derivatives.f90 new file mode 120000 index 0000000000..3a8ba38824 --- /dev/null +++ b/src/equation_of_state/TEOS10/gsw_rho_first_derivatives.f90 @@ -0,0 +1 @@ +../../../pkg/GSW-Fortran/toolbox/gsw_rho_first_derivatives.f90 \ No newline at end of file diff --git a/src/equation_of_state/TEOS10/gsw_rho_second_derivatives.f90 b/src/equation_of_state/TEOS10/gsw_rho_second_derivatives.f90 deleted file mode 100644 index fdf75e7a0a..0000000000 --- a/src/equation_of_state/TEOS10/gsw_rho_second_derivatives.f90 +++ /dev/null @@ -1,78 +0,0 @@ -!========================================================================== -elemental subroutine gsw_rho_second_derivatives (sa, ct, p, rho_sa_sa, & - rho_sa_ct, rho_ct_ct, rho_sa_p, rho_ct_p) -!========================================================================== -! -! Calculates five second-order derivatives of rho. Note that this function -! uses the using the computationally-efficient expression for specific -! volume (Roquet et al., 2014). -! -! SA = Absolute Salinity [ g/kg ] -! CT = Conservative Temperature (ITS-90) [ deg C ] -! p = sea pressure [ dbar ] -! ( i.e. absolute pressure - 10.1325 dbar ) -! -! rho_SA_SA = The second-order derivative of rho with respect to -! Absolute Salinity at constant CT & p. [ J/(kg (g/kg)^2) ] -! rho_SA_CT = The second-order derivative of rho with respect to -! SA and CT at constant p. [ J/(kg K(g/kg)) ] -! rho_CT_CT = The second-order derivative of rho with respect to CT at -! constant SA & p -! rho_SA_P = The second-order derivative with respect to SA & P at -! constant CT. -! rho_CT_P = The second-order derivative with respect to CT & P at -! constant SA. -!-------------------------------------------------------------------------- - -use gsw_mod_toolbox, only : gsw_specvol, gsw_specvol_first_derivatives -use gsw_mod_toolbox, only : gsw_specvol_second_derivatives - -use gsw_mod_kinds - -implicit none - -real (r8), intent(in) :: sa, ct, p -real (r8), intent(out), optional :: rho_sa_sa, rho_sa_ct, rho_ct_ct -real (r8), intent(out), optional :: rho_sa_p, rho_ct_p - -integer :: iflag1, iflag2 -real (r8) :: rec_v, rec_v2, rec_v3, v_ct, v_ct_ct, v_ct_p, v_p, v_sa, v_sa_ct -real (r8) :: v_sa_p, v_sa_sa - -iflag1 = 0 -if (present(rho_sa_sa) .or. present(rho_sa_ct) & - .or. present(rho_sa_p)) iflag1 = ibset(iflag1,1) -if (present(rho_sa_ct) .or. present(rho_ct_ct) & - .or. present(rho_ct_p)) iflag1 = ibset(iflag1,2) -if (present(rho_sa_p) .or. present(rho_ct_p)) iflag1 = ibset(iflag1,3) - -call gsw_specvol_first_derivatives(sa,ct,p,v_sa,v_ct,v_p,iflag=iflag1) - -iflag2 = 0 -if (present(rho_sa_sa)) iflag2 = ibset(iflag2,1) -if (present(rho_sa_ct)) iflag2 = ibset(iflag2,2) -if (present(rho_ct_ct)) iflag2 = ibset(iflag2,3) -if (present(rho_sa_p)) iflag2 = ibset(iflag2,4) -if (present(rho_ct_p)) iflag2 = ibset(iflag2,5) - -call gsw_specvol_second_derivatives(sa,ct,p,v_sa_sa,v_sa_ct,v_ct_ct, & - v_sa_p,v_ct_p,iflag=iflag2) - -rec_v = 1.0_r8/gsw_specvol(sa,ct,p) -rec_v2 = rec_v**2 -rec_v3 = rec_v2*rec_v - -if (present(rho_sa_sa)) rho_sa_sa = -v_sa_sa*rec_v2 + 2.0_r8*v_sa*v_sa*rec_v3 - -if (present(rho_sa_ct)) rho_sa_ct = -v_sa_ct*rec_v2 + 2.0_r8*v_sa*v_ct*rec_v3 - -if (present(rho_ct_ct)) rho_ct_ct = -v_ct_ct*rec_v2 + 2.0_r8*v_ct*v_ct*rec_v3 - -if (present(rho_sa_p)) rho_sa_p = -v_sa_p*rec_v2 + 2.0_r8*v_sa*v_p*rec_v3 - -if (present(rho_ct_p)) rho_ct_p = -v_ct_p*rec_v2 + 2.0_r8*v_ct*v_p*rec_v3 - -return -end subroutine - -!-------------------------------------------------------------------------- diff --git a/src/equation_of_state/TEOS10/gsw_rho_second_derivatives.f90 b/src/equation_of_state/TEOS10/gsw_rho_second_derivatives.f90 new file mode 120000 index 0000000000..8b38e0f56f --- /dev/null +++ b/src/equation_of_state/TEOS10/gsw_rho_second_derivatives.f90 @@ -0,0 +1 @@ +../../../pkg/GSW-Fortran/toolbox/gsw_rho_second_derivatives.f90 \ No newline at end of file diff --git a/src/equation_of_state/TEOS10/gsw_sp_from_sr.f90 b/src/equation_of_state/TEOS10/gsw_sp_from_sr.f90 deleted file mode 100644 index c01377546c..0000000000 --- a/src/equation_of_state/TEOS10/gsw_sp_from_sr.f90 +++ /dev/null @@ -1,30 +0,0 @@ -!========================================================================== -elemental function gsw_sp_from_sr (sr) -!========================================================================== -! -! Calculates Practical Salinity, sp, from Reference Salinity, sr. -! -! sr : Reference Salinity [g/kg] -! -! gsw_sp_from_sr : Practical Salinity [unitless] -!-------------------------------------------------------------------------- - -use gsw_mod_teos10_constants, only : gsw_ups - -use gsw_mod_kinds - -implicit none - -real (r8), intent(in) :: sr - -real (r8) :: gsw_sp_from_sr - -gsw_sp_from_sr = sr/gsw_ups - -return -end function - -!-------------------------------------------------------------------------- - - - diff --git a/src/equation_of_state/TEOS10/gsw_sp_from_sr.f90 b/src/equation_of_state/TEOS10/gsw_sp_from_sr.f90 new file mode 120000 index 0000000000..d8cd41f4bf --- /dev/null +++ b/src/equation_of_state/TEOS10/gsw_sp_from_sr.f90 @@ -0,0 +1 @@ +../../../pkg/GSW-Fortran/toolbox/gsw_sp_from_sr.f90 \ No newline at end of file diff --git a/src/equation_of_state/TEOS10/gsw_specvol.f90 b/src/equation_of_state/TEOS10/gsw_specvol.f90 deleted file mode 100644 index 00cfaab125..0000000000 --- a/src/equation_of_state/TEOS10/gsw_specvol.f90 +++ /dev/null @@ -1,52 +0,0 @@ -!========================================================================== -elemental function gsw_specvol (sa, ct, p) -!========================================================================== -! -! Calculates specific volume from Absolute Salinity, Conservative -! Temperature and pressure, using the computationally-efficient -! polynomial expression for specific volume (Roquet et al., 2014). -! -! SA = Absolute Salinity [ g/kg ] -! CT = Conservative Temperature (ITS-90) [ deg C ] -! p = sea pressure [ dbar ] -! ( i.e. absolute pressure - 10.1325 dbar ) -! -! specvol = specific volume [ m^3/kg ] -!-------------------------------------------------------------------------- - -use gsw_mod_teos10_constants, only : gsw_sfac, offset - -use gsw_mod_specvol_coefficients - -use gsw_mod_kinds - -implicit none - -real (r8), intent(in) :: sa, ct, p - -real (r8) :: gsw_specvol - -real (r8) :: xs, ys, z - -xs = sqrt(gsw_sfac*sa + offset) -ys = ct*0.025_r8 -z = p*1e-4_r8 - -gsw_specvol = v000 + xs*(v010 + xs*(v020 + xs*(v030 + xs*(v040 + xs*(v050 & - + v060*xs))))) + ys*(v100 + xs*(v110 + xs*(v120 + xs*(v130 + xs*(v140 & - + v150*xs)))) + ys*(v200 + xs*(v210 + xs*(v220 + xs*(v230 + v240*xs))) & - + ys*(v300 + xs*(v310 + xs*(v320 + v330*xs)) + ys*(v400 + xs*(v410 & - + v420*xs) + ys*(v500 + v510*xs + v600*ys))))) + z*(v001 + xs*(v011 & - + xs*(v021 + xs*(v031 + xs*(v041 + v051*xs)))) + ys*(v101 + xs*(v111 & - + xs*(v121 + xs*(v131 + v141*xs))) + ys*(v201 + xs*(v211 + xs*(v221 & - + v231*xs)) + ys*(v301 + xs*(v311 + v321*xs) + ys*(v401 + v411*xs & - + v501*ys)))) + z*(v002 + xs*(v012 + xs*(v022 + xs*(v032 + v042*xs))) & - + ys*(v102 + xs*(v112 + xs*(v122 + v132*xs)) + ys*(v202 + xs*(v212 & - + v222*xs) + ys*(v302 + v312*xs + v402*ys))) + z*(v003 + xs*(v013 & - + v023*xs) + ys*(v103 + v113*xs + v203*ys) + z*(v004 + v014*xs + v104*ys & - + z*(v005 + v006*z))))) - -return -end function - -!-------------------------------------------------------------------------- diff --git a/src/equation_of_state/TEOS10/gsw_specvol.f90 b/src/equation_of_state/TEOS10/gsw_specvol.f90 new file mode 120000 index 0000000000..7a41a5cea0 --- /dev/null +++ b/src/equation_of_state/TEOS10/gsw_specvol.f90 @@ -0,0 +1 @@ +../../../pkg/GSW-Fortran/toolbox/gsw_specvol.f90 \ No newline at end of file diff --git a/src/equation_of_state/TEOS10/gsw_specvol_first_derivatives.f90 b/src/equation_of_state/TEOS10/gsw_specvol_first_derivatives.f90 deleted file mode 100644 index 2f2a006b17..0000000000 --- a/src/equation_of_state/TEOS10/gsw_specvol_first_derivatives.f90 +++ /dev/null @@ -1,104 +0,0 @@ -!========================================================================== -elemental subroutine gsw_specvol_first_derivatives (sa, ct, p, v_sa, v_ct, & - v_p, iflag) -! ========================================================================= -! -! Calculates three first-order derivatives of specific volume (v). -! Note that this function uses the computationally-efficient -! expression for specific volume (Roquet et al., 2014). -! -! SA = Absolute Salinity [ g/kg ] -! CT = Conservative Temperature (ITS-90) [ deg C ] -! p = sea pressure [ dbar ] -! ( i.e. absolute pressure - 10.1325 dbar ) -! -! v_SA = The first derivative of specific volume with respect to -! Absolute Salinity at constant CT & p. [ J/(kg (g/kg)^2) ] -! v_CT = The first derivative of specific volume with respect to -! CT at constant SA and p. [ J/(kg K(g/kg)) ] -! v_P = The first derivative of specific volume with respect to -! P at constant SA and CT. [ J/(kg K^2) ] -!-------------------------------------------------------------------------- - -use gsw_mod_teos10_constants, only : gsw_sfac, offset - -use gsw_mod_specvol_coefficients - -use gsw_mod_kinds - -implicit none - -real (r8), intent(in) :: sa, ct, p -integer, intent(in), optional :: iflag -real (r8), intent(out), optional :: v_sa, v_ct, v_p - -integer :: i -logical :: flags(3) -real (r8) :: v_ct_part, v_p_part, v_sa_part, xs, ys, z - -xs = sqrt(gsw_sfac*sa + offset) -ys = ct*0.025_r8 -z = p*1e-4_r8 - -if (present(iflag)) then - do i = 1, 3 - flags(i) = btest(iflag,i) - end do -else - flags = .true. -end if - -if (present(v_sa) .and. flags(1)) then - - v_sa_part = b000 + xs*(b100 + xs*(b200 + xs*(b300 + xs*(b400 + b500*xs)))) & - + ys*(b010 + xs*(b110 + xs*(b210 + xs*(b310 + b410*xs))) & - + ys*(b020 + xs*(b120 + xs*(b220 + b320*xs)) + ys*(b030 & - + xs*(b130 + b230*xs) + ys*(b040 + b140*xs + b050*ys)))) & - + z*(b001 + xs*(b101 + xs*(b201 + xs*(b301 + b401*xs))) & - + ys*(b011 + xs*(b111 + xs*(b211 + b311*xs)) + ys*(b021 & - + xs*(b121 + b221*xs) + ys*(b031 + b131*xs + b041*ys))) & - + z*(b002 + xs*(b102 + xs*(b202 + b302*xs))+ ys*(b012 & - + xs*(b112 + b212*xs) + ys*(b022 + b122*xs + b032*ys)) & - + z*(b003 + b103*xs + b013*ys + b004*z))) - - v_sa = 0.5_r8*gsw_sfac*v_sa_part/xs - -end if - - -if (present(v_ct) .and. flags(2)) then - - v_ct_part = a000 + xs*(a100 + xs*(a200 + xs*(a300 + xs*(a400 + a500*xs)))) & - + ys*(a010 + xs*(a110 + xs*(a210 + xs*(a310 + a410*xs))) & - + ys*(a020 + xs*(a120 + xs*(a220 + a320*xs)) + ys*(a030 & - + xs*(a130 + a230*xs) + ys*(a040 + a140*xs + a050*ys )))) & - + z*(a001 + xs*(a101 + xs*(a201 + xs*(a301 + a401*xs))) & - + ys*(a011 + xs*(a111 + xs*(a211 + a311*xs)) + ys*(a021 & - + xs*(a121 + a221*xs) + ys*(a031 + a131*xs + a041*ys))) & - + z*(a002 + xs*(a102 + xs*(a202 + a302*xs)) + ys*(a012 & - + xs*(a112 + a212*xs) + ys*(a022 + a122*xs + a032*ys)) & - + z*(a003 + a103*xs + a013*ys + a004*z))) - - v_ct = 0.025_r8*v_ct_part - -end if - -if (present(v_p) .and. flags(3)) then - - v_p_part = c000 + xs*(c100 + xs*(c200 + xs*(c300 + xs*(c400 + c500*xs)))) & - + ys*(c010 + xs*(c110 + xs*(c210 + xs*(c310 + c410*xs))) + ys*(c020 & - + xs*(c120 + xs*(c220 + c320*xs)) + ys*(c030 + xs*(c130 + c230*xs) & - + ys*(c040 + c140*xs + c050*ys)))) + z*(c001 + xs*(c101 + xs*(c201 & - + xs*(c301 + c401*xs))) + ys*(c011 + xs*(c111 + xs*(c211 + c311*xs)) & - + ys*(c021 + xs*(c121 + c221*xs) + ys*(c031 + c131*xs + c041*ys))) & - + z*( c002 + xs*(c102 + c202*xs) + ys*(c012 + c112*xs + c022*ys) & - + z*(c003 + c103*xs + c013*ys + z*(c004 + c005*z)))) - - v_p = 1e-8_r8*v_p_part - -end if - -return -end subroutine - -!-------------------------------------------------------------------------- diff --git a/src/equation_of_state/TEOS10/gsw_specvol_first_derivatives.f90 b/src/equation_of_state/TEOS10/gsw_specvol_first_derivatives.f90 new file mode 120000 index 0000000000..ee6ee1f906 --- /dev/null +++ b/src/equation_of_state/TEOS10/gsw_specvol_first_derivatives.f90 @@ -0,0 +1 @@ +../../../pkg/GSW-Fortran/toolbox/gsw_specvol_first_derivatives.f90 \ No newline at end of file diff --git a/src/equation_of_state/TEOS10/gsw_specvol_second_derivatives.f90 b/src/equation_of_state/TEOS10/gsw_specvol_second_derivatives.f90 deleted file mode 100644 index 39096109e9..0000000000 --- a/src/equation_of_state/TEOS10/gsw_specvol_second_derivatives.f90 +++ /dev/null @@ -1,131 +0,0 @@ -!========================================================================== -elemental subroutine gsw_specvol_second_derivatives (sa, ct, p, v_sa_sa, & - v_sa_ct, v_ct_ct, v_sa_p, v_ct_p, iflag) -! ========================================================================= -! -! Calculates five second-order derivatives of specific volume (v). -! Note that this function uses the computationally-efficient -! expression for specific volume (Roquet et al., 2014). -! -! SA = Absolute Salinity [ g/kg ] -! CT = Conservative Temperature (ITS-90) [ deg C ] -! p = sea pressure [ dbar ] -! ( i.e. absolute pressure - 10.1325 dbar ) -! -! v_SA_SA = The second derivative of specific volume with respect to -! Absolute Salinity at constant CT & p. [ J/(kg (g/kg)^2) ] -! v_SA_CT = The second derivative of specific volume with respect to -! SA and CT at constant p. [ J/(kg K(g/kg)) ] -! v_CT_CT = The second derivative of specific volume with respect to -! CT at constant SA and p. [ J/(kg K^2) ] -! v_SA_P = The second derivative of specific volume with respect to -! SA and P at constant CT. [ J/(kg K(g/kg)) ] -! v_CT_P = The second derivative of specific volume with respect to -! CT and P at constant SA. [ J/(kg K(g/kg)) ] -!-------------------------------------------------------------------------- - -use gsw_mod_teos10_constants, only : gsw_sfac, offset - -use gsw_mod_specvol_coefficients - -use gsw_mod_kinds - -implicit none - -real (r8), intent(in) :: sa, ct, p -integer, intent(in), optional :: iflag -real (r8), intent(out), optional :: v_sa_sa, v_sa_ct, v_ct_ct, v_sa_p, v_ct_p - -integer :: i -logical :: flags(5) -real (r8) :: v_ct_ct_part, v_ct_p_part, v_sa_ct_part, v_sa_p_part -real (r8) :: v_sa_sa_part, xs, xs2, ys, z - -xs2 = gsw_sfac*sa + offset -xs = sqrt(xs2) -ys = ct*0.025_r8 -z = p*1e-4_r8 - -if (present(iflag)) then - do i = 1, 5 - flags(i) = btest(iflag,i) - end do -else - flags = .true. -end if - -if (present(v_sa_sa) .and. flags(1)) then - - v_sa_sa_part = (-b000 + xs2*(b200 + xs*(2.0_r8*b300 + xs*(3.0_r8*b400 & - + 4.0_r8*b500*xs))) + ys*(-b010 + xs2*(b210 + xs*(2.0_r8*b310 & - + 3.0_r8*b410*xs)) + ys*(-b020 + xs2*(b220 + 2.0_r8*b320*xs) & - + ys*(-b030 + b230*xs2 + ys*(-b040 - b050*ys)))) + z*(-b001 & - + xs2*(b201 + xs*(2.0_r8*b301 + 3.0_r8*b401*xs)) + ys*(-b011 & - + xs2*(b211 + 2.0_r8*b311*xs) + ys*(-b021 + b221*xs2 & - + ys*(-b031 - b041*ys))) + z*(-b002 + xs2*(b202 + 2.0_r8*b302*xs) & - + ys*(-b012 + b212*xs2 + ys*(-b022 - b032*ys)) + z*(-b003 & - - b013*ys - b004*z))))/xs2 - - v_sa_sa = 0.25_r8*gsw_sfac*gsw_sfac*v_sa_sa_part/xs - -end if - -if (present(v_sa_ct) .and. flags(2)) then - - v_sa_ct_part = (b010 + xs*(b110 + xs*(b210 + xs*(b310 + b410*xs))) & - + ys*(2.0_r8*(b020 + xs*(b120 + xs*(b220 + b320*xs))) & - + ys*(3.0_r8*(b030 + xs*(b130 + b230*xs)) + ys*(4.0_r8*(b040 + b140*xs) & - + 5.0_r8*b050*ys))) + z*(b011 + xs*(b111 + xs*(b211 + b311*xs)) & - + ys*(2.0_r8*(b021 + xs*(b121 + b221*xs)) + ys*(3.0_r8*(b031 + b131*xs) & - + 4.0_r8*b041*ys)) + z*(b012 + xs*(b112 + b212*xs) + ys*(2.0_r8*(b022 & - + b122*xs) + 3.0_r8*b032*ys) + b013*z)))/xs - - v_sa_ct = 0.025_r8*0.5_r8*gsw_sfac*v_sa_ct_part - -end if - -if (present(v_ct_ct) .and. flags(3)) then - - v_ct_ct_part = a010 + xs*(a110 + xs*(a210 + xs*(a310 + a410*xs))) & - + ys*(2.0_r8*(a020 + xs*(a120 + xs*(a220 + a320*xs))) & - + ys*(3.0_r8*(a030 + xs*(a130 + a230*xs)) + ys*(4.0_r8*(a040 & - + a140*xs) + 5.0_r8*a050*ys))) + z*( a011 + xs*(a111 + xs*(a211 & - + a311*xs)) + ys*(2.0_r8*(a021 + xs*(a121 + a221*xs)) & - + ys*(3.0_r8*(a031 + a131*xs) + 4.0_r8*a041*ys)) + z*(a012 & - + xs*(a112 + a212*xs) + ys*(2.0_r8*(a022 + a122*xs) & - + 3.0_r8*a032*ys) + a013*z)) - - v_ct_ct = 0.025_r8*0.025_r8*v_ct_ct_part - -end if - -if (present(v_sa_p) .and. flags(4)) then - - v_sa_p_part = b001 + xs*(b101 + xs*(b201 + xs*(b301 + b401*xs))) + ys*(b011 & - + xs*(b111 + xs*(b211 + b311*xs)) + ys*(b021 + xs*(b121 + b221*xs) & - + ys*(b031 + b131*xs + b041*ys))) + z*(2.0_r8*(b002 + xs*(b102 & - + xs*(b202 + b302*xs)) + ys*(b012 + xs*(b112 + b212*xs) + ys*(b022 & - + b122*xs + b032*ys))) + z*(3.0_r8*(b003 + b103*xs + b013*ys) & - + 4.0_r8*b004*z)) - - v_sa_p = 1e-8_r8*0.5_r8*gsw_sfac*v_sa_p_part - -end if - -if (present(v_ct_p) .and. flags(5)) then - - v_ct_p_part = a001 + xs*(a101 + xs*(a201 + xs*(a301 + a401*xs))) + ys*(a011 & - + xs*(a111 + xs*(a211 + a311*xs)) + ys*(a021 + xs*(a121 + a221*xs) & - + ys*(a031 + a131*xs + a041*ys))) + z*(2.0_r8*(a002 + xs*(a102 & - + xs*(a202 + a302*xs)) + ys*(a012 + xs*(a112 + a212*xs) + ys*(a022 & - + a122*xs + a032*ys))) + z*(3.0_r8*(a003 + a103*xs + a013*ys) & - + 4.0_r8*a004*z)) - - v_ct_p = 1e-8_r8*0.025_r8*v_ct_p_part - -end if - -return -end subroutine - -!-------------------------------------------------------------------------- diff --git a/src/equation_of_state/TEOS10/gsw_specvol_second_derivatives.f90 b/src/equation_of_state/TEOS10/gsw_specvol_second_derivatives.f90 new file mode 120000 index 0000000000..cdd1c1b87a --- /dev/null +++ b/src/equation_of_state/TEOS10/gsw_specvol_second_derivatives.f90 @@ -0,0 +1 @@ +../../../pkg/GSW-Fortran/toolbox/gsw_specvol_second_derivatives.f90 \ No newline at end of file diff --git a/src/equation_of_state/TEOS10/gsw_sr_from_sp.f90 b/src/equation_of_state/TEOS10/gsw_sr_from_sp.f90 deleted file mode 100644 index cbcc4fea0b..0000000000 --- a/src/equation_of_state/TEOS10/gsw_sr_from_sp.f90 +++ /dev/null @@ -1,30 +0,0 @@ -!========================================================================== -elemental function gsw_sr_from_sp (sp) -!========================================================================== -! -! Calculates Reference Salinity, SR, from Practical Salinity, SP. -! -! sp : Practical Salinity [unitless] -! -! gsw_sr_from_sp : Reference Salinity [g/kg] -!-------------------------------------------------------------------------- - -use gsw_mod_teos10_constants, only : gsw_ups - -use gsw_mod_kinds - -implicit none - -real (r8), intent(in) :: sp - -real (r8) :: gsw_sr_from_sp - -gsw_sr_from_sp = sp*gsw_ups - -return -end function - -!-------------------------------------------------------------------------- - - - diff --git a/src/equation_of_state/TEOS10/gsw_sr_from_sp.f90 b/src/equation_of_state/TEOS10/gsw_sr_from_sp.f90 new file mode 120000 index 0000000000..eda229ff66 --- /dev/null +++ b/src/equation_of_state/TEOS10/gsw_sr_from_sp.f90 @@ -0,0 +1 @@ +../../../pkg/GSW-Fortran/toolbox/gsw_sr_from_sp.f90 \ No newline at end of file diff --git a/src/equation_of_state/TEOS10/gsw_t_deriv_chem_potential_water_t_exact.f90 b/src/equation_of_state/TEOS10/gsw_t_deriv_chem_potential_water_t_exact.f90 deleted file mode 100644 index 668184491f..0000000000 --- a/src/equation_of_state/TEOS10/gsw_t_deriv_chem_potential_water_t_exact.f90 +++ /dev/null @@ -1,88 +0,0 @@ -!========================================================================== -elemental function gsw_t_deriv_chem_potential_water_t_exact (sa, t, p) -!========================================================================== -! -! Calculates the temperature derivative of the chemical potential of water -! in seawater so that it is valid at exactly SA = 0. -! -! SA = Absolute Salinity [ g/kg ] -! t = in-situ temperature (ITS-90) [ deg C ] -! p = sea pressure [ dbar ] -! ( i.e. absolute pressure - 10.1325 dbar ) -! -! chem_potential_water_dt = temperature derivative of the chemical -! potential of water in seawater [ J g^-1 K^-1 ] -!-------------------------------------------------------------------------- - -use gsw_mod_teos10_constants, only : gsw_sfac, rec_db2pa - -use gsw_mod_kinds - -implicit none - -real (r8), intent(in) :: sa, t, p - -real (r8) :: gsw_t_deriv_chem_potential_water_t_exact - -real (r8) :: g03_t, g08_sa_t, x, x2, y, z, g08_t - -real (r8), parameter :: kg2g = 1e-3_r8 - -! Note. The kg2g, a factor of 1e-3, is needed to convert the output of this -! function into units of J/g. See section (2.9) of the TEOS-10 Manual. - -x2 = gsw_sfac*sa -x = sqrt(x2) -y = t*0.025_r8 -z = p*rec_db2pa ! the input pressure (p) is sea pressure in units of dbar. - -g03_t = 5.90578347909402_r8 + z*(-270.983805184062_r8 + & - z*(776.153611613101_r8 + z*(-196.51255088122_r8 + (28.9796526294175_r8 - & - 2.13290083518327_r8*z)*z))) + & - y*(-24715.571866078_r8 + z*(2910.0729080936_r8 + & - z*(-1513.116771538718_r8 + z*(546.959324647056_r8 + & - z*(-111.1208127634436_r8 + 8.68841343834394_r8*z)))) + & - y*(2210.2236124548363_r8 + z*(-2017.52334943521_r8 + & - z*(1498.081172457456_r8 + z*(-718.6359919632359_r8 + & - (146.4037555781616_r8 - 4.9892131862671505_r8*z)*z))) + & - y*(-592.743745734632_r8 + z*(1591.873781627888_r8 + & - z*(-1207.261522487504_r8 + (608.785486935364_r8 - & - 105.4993508931208_r8*z)*z)) + & - y*(290.12956292128547_r8 + z*(-973.091553087975_r8 + & - z*(602.603274510125_r8 + z*(-276.361526170076_r8 + & - 32.40953340386105_r8*z))) + & - y*(-113.90630790850321_r8 + y*(21.35571525415769_r8 - & - 67.41756835751434_r8*z) + & - z*(381.06836198507096_r8 + z*(-133.7383902842754_r8 + & - 49.023632509086724_r8*z))))))) - -g08_t = x2*(168.072408311545_r8 + & - x*(-493.407510141682_r8 + x*(543.835333000098_r8 + & - x*(-196.028306689776_r8 + 36.7571622995805_r8*x) + & - y*(-137.1145018408982_r8 + y*(148.10030845687618_r8 + & - y*(-68.5590309679152_r8 + 12.4848504784754_r8*y))) - & - 22.6683558512829_r8*z) + z*(-175.292041186547_r8 + & - (83.1923927801819_r8 - 29.483064349429_r8*z)*z) + & - y*(-86.1329351956084_r8 + z*(766.116132004952_r8 + & - z*(-108.3834525034224_r8 + 51.2796974779828_r8*z)) + & - y*(-30.0682112585625_r8 - 1380.9597954037708_r8*z + & - y*(3.50240264723578_r8 + 938.26075044542_r8*z))))) - -g08_sa_t = 1187.3715515697959_r8 + & - x*(-1480.222530425046_r8 + x*(2175.341332000392_r8 + & - x*(-980.14153344888_r8 + 220.542973797483_r8*x) + & - y*(-548.4580073635929_r8 + y*(592.4012338275047_r8 + & - y*(-274.2361238716608_r8 + 49.9394019139016_r8*y))) - & - 90.6734234051316_r8*z) + z*(-525.876123559641_r8 + & - (249.57717834054571_r8 - 88.449193048287_r8*z)*z) + & - y*(-258.3988055868252_r8 + z*(2298.348396014856_r8 + & - z*(-325.1503575102672_r8 + 153.8390924339484_r8*z)) + & - y*(-90.2046337756875_r8 - 4142.8793862113125_r8*z + & - y*(10.50720794170734_r8 + 2814.78225133626_r8*z)))) - -gsw_t_deriv_chem_potential_water_t_exact = kg2g*((g03_t + g08_t)*0.025_r8 - & - 0.5_r8*gsw_sfac*0.025_r8*sa*g08_sa_t) -return -end function - -!-------------------------------------------------------------------------- diff --git a/src/equation_of_state/TEOS10/gsw_t_deriv_chem_potential_water_t_exact.f90 b/src/equation_of_state/TEOS10/gsw_t_deriv_chem_potential_water_t_exact.f90 new file mode 120000 index 0000000000..3194f69a64 --- /dev/null +++ b/src/equation_of_state/TEOS10/gsw_t_deriv_chem_potential_water_t_exact.f90 @@ -0,0 +1 @@ +../../../pkg/GSW-Fortran/toolbox/gsw_t_deriv_chem_potential_water_t_exact.f90 \ No newline at end of file diff --git a/src/equation_of_state/TEOS10/gsw_t_freezing_exact.f90 b/src/equation_of_state/TEOS10/gsw_t_freezing_exact.f90 deleted file mode 100644 index 63c27db986..0000000000 --- a/src/equation_of_state/TEOS10/gsw_t_freezing_exact.f90 +++ /dev/null @@ -1,71 +0,0 @@ -!========================================================================== -elemental function gsw_t_freezing_exact (sa, p, saturation_fraction) -!========================================================================== -! -! Calculates the in-situ temperature at which seawater freezes. The -! in-situ temperature freezing point is calculated from the exact -! in-situ freezing temperature which is found by a modified Newton-Raphson -! iteration (McDougall and Wotherspoon, 2013) of the equality of the -! chemical potentials of water in seawater and in ice. -! -! An alternative GSW function, gsw_t_freezing_poly, it is based on a -! computationally-efficient polynomial, and is accurate to within -5e-4 K -! and 6e-4 K, when compared with this function. -! -! SA = Absolute Salinity [ g/kg ] -! p = sea pressure [ dbar ] -! ( i.e. absolute pressure - 10.1325 dbar ) -! saturation_fraction = the saturation fraction of dissolved air in -! seawater -! (i.e., saturation_fraction must be between 0 and 1, and the default -! is 1, completely saturated) -! -! t_freezing = in-situ temperature at which seawater freezes. [ deg C ] -!-------------------------------------------------------------------------- - -use gsw_mod_teos10_constants, only : gsw_sso - -use gsw_mod_toolbox, only : gsw_gibbs_ice, gsw_chem_potential_water_t_exact -use gsw_mod_toolbox, only : gsw_t_deriv_chem_potential_water_t_exact -use gsw_mod_toolbox, only : gsw_t_freezing_poly - -use gsw_mod_kinds - -implicit none - -real (r8), intent(in) :: sa, p, saturation_fraction - -real (r8) :: gsw_t_freezing_exact - -real (r8) :: df_dt, p_r, sa_r, tf, tfm, tf_old, x, f - -! The initial value of t_freezing_exact (for air-free seawater) -tf = gsw_t_freezing_poly(sa,p,polynomial=.true.) - -df_dt = 1e3_r8*gsw_t_deriv_chem_potential_water_t_exact(sa,tf,p) - & - gsw_gibbs_ice(1,0,tf,p) -! df_dt here is the initial value of the derivative of the function f whose -! zero (f = 0) we are finding (see Eqn. (3.33.2) of IOC et al (2010)). - -tf_old = tf -f = 1e3_r8*gsw_chem_potential_water_t_exact(sa,tf_old,p) - & - gsw_gibbs_ice(0,0,tf_old,p) -tf = tf_old - f/df_dt -tfm = 0.5_r8*(tf + tf_old) -df_dt = 1e3_r8*gsw_t_deriv_chem_potential_water_t_exact(sa,tfm,p) - & - gsw_gibbs_ice(1,0,tfm,p) -tf = tf_old - f/df_dt - -tf_old = tf -f = 1e3_r8*gsw_chem_potential_water_t_exact(sa,tf_old,p) - & - gsw_gibbs_ice(0,0,tf_old,p) -tf = tf_old - f/df_dt - -! Adjust for the effects of dissolved air -gsw_t_freezing_exact = tf - & - saturation_fraction*(1e-3_r8)*(2.4_r8 - sa/(2.0_r8*gsw_sso)) - -return -end function - -!-------------------------------------------------------------------------- diff --git a/src/equation_of_state/TEOS10/gsw_t_freezing_exact.f90 b/src/equation_of_state/TEOS10/gsw_t_freezing_exact.f90 new file mode 120000 index 0000000000..ca5434983f --- /dev/null +++ b/src/equation_of_state/TEOS10/gsw_t_freezing_exact.f90 @@ -0,0 +1 @@ +../../../pkg/GSW-Fortran/toolbox/gsw_t_freezing_exact.f90 \ No newline at end of file diff --git a/src/equation_of_state/TEOS10/gsw_t_freezing_poly.f90 b/src/equation_of_state/TEOS10/gsw_t_freezing_poly.f90 deleted file mode 100644 index 479a323d2c..0000000000 --- a/src/equation_of_state/TEOS10/gsw_t_freezing_poly.f90 +++ /dev/null @@ -1,78 +0,0 @@ -!========================================================================== -elemental function gsw_t_freezing_poly (sa, p, saturation_fraction, polynomial) -!========================================================================== -! -! Calculates the in-situ temperature at which seawater freezes from a -! computationally efficient polynomial. -! -! SA = Absolute Salinity [ g/kg ] -! p = sea pressure [ dbar ] -! ( i.e. absolute pressure - 10.1325 dbar ) -! saturation_fraction = the saturation fraction of dissolved air in -! seawater -! -! t_freezing = in-situ temperature at which seawater freezes. [ deg C ] -! (ITS-90) -!-------------------------------------------------------------------------- - -use gsw_mod_teos10_constants, only : gsw_sso - -use gsw_mod_freezing_poly_coefficients - -use gsw_mod_toolbox, only : gsw_ct_freezing_poly, gsw_t_from_ct - -use gsw_mod_kinds - -implicit none - -real (r8), intent(in) :: sa, p -real (r8), intent(in), optional :: saturation_fraction -logical, intent(in), optional :: polynomial - -real (r8) :: gsw_t_freezing_poly - -real (r8) :: p_r, sa_r, x, ctf, sfrac -logical :: direct_poly - -if (present(polynomial)) then - direct_poly = polynomial -else - direct_poly = .false. -end if - -if (.not. direct_poly) then - - if (present(saturation_fraction)) then - sfrac = saturation_fraction - else - sfrac = 1.0_r8 - end if - - ctf = gsw_ct_freezing_poly(sa,p,sfrac) - gsw_t_freezing_poly = gsw_t_from_ct(sa,ctf,p) - -else - - ! Alternative calculation ... - sa_r = sa*1e-2_r8 - x = sqrt(sa_r) - p_r = p*1e-4_r8 - - gsw_t_freezing_poly = t0 & - + sa_r*(t1 + x*(t2 + x*(t3 + x*(t4 + x*(t5 + t6*x))))) & - + p_r*(t7 + p_r*(t8 + t9*p_r)) & - + sa_r*p_r*(t10 + p_r*(t12 + p_r*(t15 + t21*sa_r)) & - + sa_r*(t13 + t17*p_r + t19*sa_r) & - + x*(t11 + p_r*(t14 + t18*p_r) + sa_r*(t16 + t20*p_r + t22*sa_r))) - - if (.not. present(saturation_fraction)) return - - ! Adjust for the effects of dissolved air - gsw_t_freezing_poly = gsw_t_freezing_poly - & - saturation_fraction*(1e-3_r8)*(2.4_r8 - sa/(2.0_r8*gsw_sso)) -end if - -return -end function - -!-------------------------------------------------------------------------- diff --git a/src/equation_of_state/TEOS10/gsw_t_freezing_poly.f90 b/src/equation_of_state/TEOS10/gsw_t_freezing_poly.f90 new file mode 120000 index 0000000000..fcc75a7d80 --- /dev/null +++ b/src/equation_of_state/TEOS10/gsw_t_freezing_poly.f90 @@ -0,0 +1 @@ +../../../pkg/GSW-Fortran/toolbox/gsw_t_freezing_poly.f90 \ No newline at end of file diff --git a/src/equation_of_state/TEOS10/gsw_t_from_ct.f90 b/src/equation_of_state/TEOS10/gsw_t_from_ct.f90 deleted file mode 100644 index 9f85a4530c..0000000000 --- a/src/equation_of_state/TEOS10/gsw_t_from_ct.f90 +++ /dev/null @@ -1,33 +0,0 @@ -!========================================================================== -elemental function gsw_t_from_ct (sa, ct, p) -!========================================================================== -! -! Calculates in-situ temperature from Conservative Temperature of seawater -! -! sa : Absolute Salinity [g/kg] -! ct : Conservative Temperature [deg C] -! -! gsw_t_from_ct : in-situ temperature [deg C] -!-------------------------------------------------------------------------- - -use gsw_mod_toolbox, only : gsw_pt_from_ct, gsw_pt_from_t - -use gsw_mod_kinds - -implicit none - -real (r8), intent(in) :: sa, ct, p - -real (r8) :: gsw_t_from_ct - -real (r8) :: pt0 - -real (r8), parameter :: p0 = 0.0_r8 - -pt0 = gsw_pt_from_ct(sa,ct) -gsw_t_from_ct = gsw_pt_from_t(sa,pt0,p0,p) - -return -end function - -!-------------------------------------------------------------------------- diff --git a/src/equation_of_state/TEOS10/gsw_t_from_ct.f90 b/src/equation_of_state/TEOS10/gsw_t_from_ct.f90 new file mode 120000 index 0000000000..41a33a07b5 --- /dev/null +++ b/src/equation_of_state/TEOS10/gsw_t_from_ct.f90 @@ -0,0 +1 @@ +../../../pkg/GSW-Fortran/toolbox/gsw_t_from_ct.f90 \ No newline at end of file diff --git a/src/framework/MOM_diag_mediator.F90 b/src/framework/MOM_diag_mediator.F90 index 368a6b773b..2a71e7cda5 100644 --- a/src/framework/MOM_diag_mediator.F90 +++ b/src/framework/MOM_diag_mediator.F90 @@ -33,7 +33,7 @@ module MOM_diag_mediator use diag_axis_mod, only : get_diag_axis_name use diag_data_mod, only : null_axis_id use diag_manager_mod, only : diag_manager_init, diag_manager_end -use diag_manager_mod, only : send_data, diag_axis_init, diag_field_add_attribute +use diag_manager_mod, only : send_data, diag_axis_init, EAST, NORTH, diag_field_add_attribute ! The following module is needed for PGI since the following line does not compile with PGI 6.5.0 ! was: use diag_manager_mod, only : register_diag_field_fms=>register_diag_field use MOM_diag_manager_wrapper, only : register_diag_field_fms @@ -365,14 +365,14 @@ subroutine set_axes_info(G, GV, US, param_file, diag_cs, set_vertical) ! Horizontal axes for the native grids if (G%symmetric) then id_xq = diag_axis_init('xq', G%gridLonB(G%isgB:G%iegB), G%x_axis_units, 'x', & - 'q point nominal longitude', Domain2=G%Domain%mpp_domain) + 'q point nominal longitude', Domain2=G%Domain%mpp_domain, domain_position=EAST) id_yq = diag_axis_init('yq', G%gridLatB(G%jsgB:G%jegB), G%y_axis_units, 'y', & - 'q point nominal latitude', Domain2=G%Domain%mpp_domain) + 'q point nominal latitude', Domain2=G%Domain%mpp_domain, domain_position=NORTH) else id_xq = diag_axis_init('xq', G%gridLonB(G%isg:G%ieg), G%x_axis_units, 'x', & - 'q point nominal longitude', Domain2=G%Domain%mpp_domain) + 'q point nominal longitude', Domain2=G%Domain%mpp_domain, domain_position=EAST) id_yq = diag_axis_init('yq', G%gridLatB(G%jsg:G%jeg), G%y_axis_units, 'y', & - 'q point nominal latitude', Domain2=G%Domain%mpp_domain) + 'q point nominal latitude', Domain2=G%Domain%mpp_domain, domain_position=NORTH) endif id_xh = diag_axis_init('xh', G%gridLonT(G%isg:G%ieg), G%x_axis_units, 'x', & 'h point nominal longitude', Domain2=G%Domain%mpp_domain) diff --git a/src/framework/MOM_document.F90 b/src/framework/MOM_document.F90 index b122a5b6f0..15d0839ee9 100644 --- a/src/framework/MOM_document.F90 +++ b/src/framework/MOM_document.F90 @@ -85,7 +85,7 @@ end subroutine doc_param_none !> This subroutine handles parameter documentation for logicals. subroutine doc_param_logical(doc, varname, desc, units, val, default, & - layoutParam, debuggingParam) + layoutParam, debuggingParam, like_default) type(doc_type), pointer :: doc !< A pointer to a structure that controls where the !! documentation occurs and its formatting character(len=*), intent(in) :: varname !< The name of the parameter being documented @@ -95,6 +95,8 @@ subroutine doc_param_logical(doc, varname, desc, units, val, default, & logical, optional, intent(in) :: default !< The default value of this parameter logical, optional, intent(in) :: layoutParam !< If present and true, this is a layout parameter. logical, optional, intent(in) :: debuggingParam !< If present and true, this is a debugging parameter. + logical, optional, intent(in) :: like_default !< If present and true, log this parameter as though + !! it has the default value, even if there is no default. ! This subroutine handles parameter documentation for logicals. character(len=mLen) :: mesg logical :: equalsDefault @@ -110,6 +112,7 @@ subroutine doc_param_logical(doc, varname, desc, units, val, default, & endif equalsDefault = .false. + if (present(like_default)) equalsDefault = like_default if (present(default)) then if (val .eqv. default) equalsDefault = .true. if (default) then @@ -127,7 +130,7 @@ end subroutine doc_param_logical !> This subroutine handles parameter documentation for arrays of logicals. subroutine doc_param_logical_array(doc, varname, desc, units, vals, default, & - layoutParam, debuggingParam) + layoutParam, debuggingParam, like_default) type(doc_type), pointer :: doc !< A pointer to a structure that controls where the !! documentation occurs and its formatting character(len=*), intent(in) :: varname !< The name of the parameter being documented @@ -137,6 +140,8 @@ subroutine doc_param_logical_array(doc, varname, desc, units, vals, default, & logical, optional, intent(in) :: default !< The default value of this parameter logical, optional, intent(in) :: layoutParam !< If present and true, this is a layout parameter. logical, optional, intent(in) :: debuggingParam !< If present and true, this is a debugging parameter. + logical, optional, intent(in) :: like_default !< If present and true, log this parameter as though + !! it has the default value, even if there is no default. ! This subroutine handles parameter documentation for arrays of logicals. integer :: i character(len=mLen) :: mesg @@ -158,7 +163,7 @@ subroutine doc_param_logical_array(doc, varname, desc, units, vals, default, & mesg = define_string(doc, varname, valstring, units) - equalsDefault = .false. + equalsDefault = .false. if (present(default)) then equalsDefault = .true. do i=1,size(vals) ; if (vals(i) .neqv. default) equalsDefault = .false. ; enddo @@ -168,6 +173,7 @@ subroutine doc_param_logical_array(doc, varname, desc, units, vals, default, & mesg = trim(mesg)//" default = "//STRING_FALSE endif endif + if (present(like_default)) then ; if (like_default) equalsDefault = .true. ; endif if (mesgHasBeenDocumented(doc, varName, mesg)) return ! Avoid duplicates call writeMessageAndDesc(doc, mesg, desc, equalsDefault, & @@ -177,7 +183,7 @@ end subroutine doc_param_logical_array !> This subroutine handles parameter documentation for integers. subroutine doc_param_int(doc, varname, desc, units, val, default, & - layoutParam, debuggingParam) + layoutParam, debuggingParam, like_default) type(doc_type), pointer :: doc !< A pointer to a structure that controls where the !! documentation occurs and its formatting character(len=*), intent(in) :: varname !< The name of the parameter being documented @@ -187,6 +193,8 @@ subroutine doc_param_int(doc, varname, desc, units, val, default, & integer, optional, intent(in) :: default !< The default value of this parameter logical, optional, intent(in) :: layoutParam !< If present and true, this is a layout parameter. logical, optional, intent(in) :: debuggingParam !< If present and true, this is a debugging parameter. + logical, optional, intent(in) :: like_default !< If present and true, log this parameter as though + !! it has the default value, even if there is no default. ! This subroutine handles parameter documentation for integers. character(len=mLen) :: mesg character(len=doc%commentColumn) :: valstring @@ -200,6 +208,7 @@ subroutine doc_param_int(doc, varname, desc, units, val, default, & mesg = define_string(doc, varname, valstring, units) equalsDefault = .false. + if (present(like_default)) equalsDefault = like_default if (present(default)) then if (val == default) equalsDefault = .true. mesg = trim(mesg)//" default = "//(trim(int_string(default))) @@ -213,7 +222,7 @@ end subroutine doc_param_int !> This subroutine handles parameter documentation for arrays of integers. subroutine doc_param_int_array(doc, varname, desc, units, vals, default, & - layoutParam, debuggingParam) + layoutParam, debuggingParam, like_default) type(doc_type), pointer :: doc !< A pointer to a structure that controls where the !! documentation occurs and its formatting character(len=*), intent(in) :: varname !< The name of the parameter being documented @@ -223,6 +232,8 @@ subroutine doc_param_int_array(doc, varname, desc, units, vals, default, & integer, optional, intent(in) :: default !< The default value of this parameter logical, optional, intent(in) :: layoutParam !< If present and true, this is a layout parameter. logical, optional, intent(in) :: debuggingParam !< If present and true, this is a debugging parameter. + logical, optional, intent(in) :: like_default !< If present and true, log this parameter as though + !! it has the default value, even if there is no default. ! This subroutine handles parameter documentation for arrays of integers. integer :: i character(len=mLen) :: mesg @@ -246,6 +257,7 @@ subroutine doc_param_int_array(doc, varname, desc, units, vals, default, & do i=1,size(vals) ; if (vals(i) /= default) equalsDefault = .false. ; enddo mesg = trim(mesg)//" default = "//(trim(int_string(default))) endif + if (present(like_default)) then ; if (like_default) equalsDefault = .true. ; endif if (mesgHasBeenDocumented(doc, varName, mesg)) return ! Avoid duplicates call writeMessageAndDesc(doc, mesg, desc, equalsDefault, & @@ -255,7 +267,7 @@ subroutine doc_param_int_array(doc, varname, desc, units, vals, default, & end subroutine doc_param_int_array !> This subroutine handles parameter documentation for reals. -subroutine doc_param_real(doc, varname, desc, units, val, default, debuggingParam) +subroutine doc_param_real(doc, varname, desc, units, val, default, debuggingParam, like_default) type(doc_type), pointer :: doc !< A pointer to a structure that controls where the !! documentation occurs and its formatting character(len=*), intent(in) :: varname !< The name of the parameter being documented @@ -264,6 +276,8 @@ subroutine doc_param_real(doc, varname, desc, units, val, default, debuggingPara real, intent(in) :: val !< The value of this parameter real, optional, intent(in) :: default !< The default value of this parameter logical, optional, intent(in) :: debuggingParam !< If present and true, this is a debugging parameter. + logical, optional, intent(in) :: like_default !< If present and true, log this parameter as though + !! it has the default value, even if there is no default. ! This subroutine handles parameter documentation for reals. character(len=mLen) :: mesg character(len=doc%commentColumn) :: valstring @@ -277,6 +291,7 @@ subroutine doc_param_real(doc, varname, desc, units, val, default, debuggingPara mesg = define_string(doc, varname, valstring, units) equalsDefault = .false. + if (present(like_default)) equalsDefault = like_default if (present(default)) then if (val == default) equalsDefault = .true. mesg = trim(mesg)//" default = "//trim(real_string(default)) @@ -288,7 +303,7 @@ subroutine doc_param_real(doc, varname, desc, units, val, default, debuggingPara end subroutine doc_param_real !> This subroutine handles parameter documentation for arrays of reals. -subroutine doc_param_real_array(doc, varname, desc, units, vals, default, debuggingParam) +subroutine doc_param_real_array(doc, varname, desc, units, vals, default, debuggingParam, like_default) type(doc_type), pointer :: doc !< A pointer to a structure that controls where the !! documentation occurs and its formatting character(len=*), intent(in) :: varname !< The name of the parameter being documented @@ -297,6 +312,8 @@ subroutine doc_param_real_array(doc, varname, desc, units, vals, default, debugg real, intent(in) :: vals(:) !< The array of values to record real, optional, intent(in) :: default !< The default value of this parameter logical, optional, intent(in) :: debuggingParam !< If present and true, this is a debugging parameter. + logical, optional, intent(in) :: like_default !< If present and true, log this parameter as though + !! it has the default value, even if there is no default. ! This subroutine handles parameter documentation for arrays of reals. integer :: i character(len=mLen) :: mesg @@ -317,6 +334,7 @@ subroutine doc_param_real_array(doc, varname, desc, units, vals, default, debugg do i=1,size(vals) ; if (vals(i) /= default) equalsDefault = .false. ; enddo mesg = trim(mesg)//" default = "//trim(real_string(default)) endif + if (present(like_default)) then ; if (like_default) equalsDefault = .true. ; endif if (mesgHasBeenDocumented(doc, varName, mesg)) return ! Avoid duplicates call writeMessageAndDesc(doc, mesg, desc, equalsDefault, debuggingParam=debuggingParam) @@ -326,7 +344,7 @@ end subroutine doc_param_real_array !> This subroutine handles parameter documentation for character strings. subroutine doc_param_char(doc, varname, desc, units, val, default, & - layoutParam, debuggingParam) + layoutParam, debuggingParam, like_default) type(doc_type), pointer :: doc !< A pointer to a structure that controls where the !! documentation occurs and its formatting character(len=*), intent(in) :: varname !< The name of the parameter being documented @@ -337,6 +355,8 @@ subroutine doc_param_char(doc, varname, desc, units, val, default, & optional, intent(in) :: default !< The default value of this parameter logical, optional, intent(in) :: layoutParam !< If present and true, this is a layout parameter. logical, optional, intent(in) :: debuggingParam !< If present and true, this is a debugging parameter. + logical, optional, intent(in) :: like_default !< If present and true, log this parameter as though + !! it has the default value, even if there is no default. ! This subroutine handles parameter documentation for character strings. character(len=mLen) :: mesg logical :: equalsDefault @@ -348,6 +368,7 @@ subroutine doc_param_char(doc, varname, desc, units, val, default, & mesg = define_string(doc, varname, '"'//trim(val)//'"', units) equalsDefault = .false. + if (present(like_default)) equalsDefault = like_default if (present(default)) then if (trim(val) == trim(default)) equalsDefault = .true. mesg = trim(mesg)//' default = "'//trim(adjustl(default))//'"' @@ -412,7 +433,7 @@ subroutine doc_closeBlock(doc, blockName) end subroutine doc_closeBlock !> This subroutine handles parameter documentation for time-type variables. -subroutine doc_param_time(doc, varname, desc, val, default, units, debuggingParam) +subroutine doc_param_time(doc, varname, desc, val, default, units, debuggingParam, like_default) type(doc_type), pointer :: doc !< A pointer to a structure that controls where the !! documentation occurs and its formatting character(len=*), intent(in) :: varname !< The name of the parameter being documented @@ -421,6 +442,8 @@ subroutine doc_param_time(doc, varname, desc, val, default, units, debuggingPara type(time_type), optional, intent(in) :: default !< The default value of this parameter character(len=*), optional, intent(in) :: units !< The units of the parameter being documented logical, optional, intent(in) :: debuggingParam !< If present and true, this is a debugging parameter. + logical, optional, intent(in) :: like_default !< If present and true, log this parameter as though + !! it has the default value, even if there is no default. ! Local varables character(len=mLen) :: mesg ! The output message @@ -439,6 +462,7 @@ subroutine doc_param_time(doc, varname, desc, val, default, units, debuggingPara endif equalsDefault = .false. + if (present(like_default)) equalsDefault = like_default if (present(default)) then if (val == default) equalsDefault = .true. mesg = trim(mesg)//" default = "//trim(time_string(default)) @@ -756,21 +780,43 @@ end function undef_string ! ---------------------------------------------------------------------- !> This subroutine handles the module documentation -subroutine doc_module(doc, modname, desc) +subroutine doc_module(doc, modname, desc, log_to_all, all_default, layoutMod, debuggingMod) type(doc_type), pointer :: doc !< A pointer to a structure that controls where the !! documentation occurs and its formatting character(len=*), intent(in) :: modname !< The name of the module being documented character(len=*), intent(in) :: desc !< A description of the module being documented -! This subroutine handles the module documentation + logical, optional, intent(in) :: log_to_all !< If present and true, log this parameter to the + !! ..._doc.all files, even if this module also has layout + !! or debugging parameters. + logical, optional, intent(in) :: all_default !< If true, all parameters take their default values. + logical, optional, intent(in) :: layoutMod !< If present and true, this module has layout parameters. + logical, optional, intent(in) :: debuggingMod !< If present and true, this module has debugging parameters. + + ! This subroutine handles the module documentation character(len=mLen) :: mesg + logical :: repeat_doc if (.not. (is_root_pe() .and. associated(doc))) return call open_doc_file(doc) if (doc%filesAreOpen) then - call writeMessageAndDesc(doc, '', '') ! Blank line for delineation + ! Add a blank line for delineation + call writeMessageAndDesc(doc, '', '', valueWasDefault=all_default, & + layoutParam=layoutMod, debuggingParam=debuggingMod) mesg = "! === module "//trim(modname)//" ===" - call writeMessageAndDesc(doc, mesg, desc, indent=0) + call writeMessageAndDesc(doc, mesg, desc, valueWasDefault=all_default, indent=0, & + layoutParam=layoutMod, debuggingParam=debuggingMod) + if (present(log_to_all)) then ; if (log_to_all) then + ! Log the module version again if the previous call was intercepted for use to document + ! a layout or debugging module. + repeat_doc = .false. + if (present(layoutMod)) then ; if (layoutMod) repeat_doc = .true. ; endif + if (present(debuggingMod)) then ; if (debuggingMod) repeat_doc = .true. ; endif + if (repeat_doc) then + call writeMessageAndDesc(doc, '', '', valueWasDefault=all_default) + call writeMessageAndDesc(doc, mesg, desc, valueWasDefault=all_default, indent=0) + endif + endif ; endif endif end subroutine doc_module diff --git a/src/framework/MOM_domains.F90 b/src/framework/MOM_domains.F90 index 477ebd70df..7cf9df39f1 100644 --- a/src/framework/MOM_domains.F90 +++ b/src/framework/MOM_domains.F90 @@ -30,6 +30,7 @@ module MOM_domains use mpp_parameter_mod, only : To_East => WUPDATE, To_West => EUPDATE, Omit_Corners => EDGEUPDATE use mpp_parameter_mod, only : To_North => SUPDATE, To_South => NUPDATE, CENTER use fms_io_mod, only : file_exist, parse_mask_table +use fms_affinity_mod, only : fms_affinity_init, fms_affinity_set,fms_affinity_get implicit none ; private @@ -45,6 +46,7 @@ module MOM_domains public :: start_group_pass, complete_group_pass public :: compute_block_extent, get_global_shape public :: get_simple_array_i_ind, get_simple_array_j_ind +public :: domain2D !> Do a halo update on an array interface pass_var @@ -1191,7 +1193,6 @@ subroutine MOM_domains_init(MOM_dom, param_file, symmetric, static_memory, & integer, dimension(4) :: global_indices !$ integer :: ocean_nthreads ! Number of Openmp threads !$ integer :: get_cpu_affinity, omp_get_thread_num, omp_get_num_threads -!$ integer :: omp_cores_per_node, adder, base_cpu !$ logical :: ocean_omp_hyper_thread integer :: nihalo_dflt, njhalo_dflt integer :: pe, proc_used @@ -1261,7 +1262,7 @@ subroutine MOM_domains_init(MOM_dom, param_file, symmetric, static_memory, & endif ! Read all relevant parameters and write them to the model log. - call log_version(param_file, mdl, version, "") + call log_version(param_file, mdl, version, "", log_to_all=.true., layout=.true.) call get_param(param_file, mdl, "REENTRANT_X", reentrant_x, & "If true, the domain is zonally reentrant.", default=.true.) call get_param(param_file, mdl, "REENTRANT_Y", reentrant_y, & @@ -1273,6 +1274,7 @@ subroutine MOM_domains_init(MOM_dom, param_file, symmetric, static_memory, & default=.false.) #ifndef NOT_SET_AFFINITY +!$ call fms_affinity_init !$OMP PARALLEL !$OMP master !$ ocean_nthreads = omp_get_num_threads() @@ -1284,27 +1286,10 @@ subroutine MOM_domains_init(MOM_dom, param_file, symmetric, static_memory, & !$ default = 1, layoutParam=.true.) !$ call get_param(param_file, mdl, "OCEAN_OMP_HYPER_THREAD", ocean_omp_hyper_thread, & !$ "If True, use hyper-threading.", default = .false., layoutParam=.true.) -!$ if (ocean_omp_hyper_thread) then -!$ call get_param(param_file, mdl, "OMP_CORES_PER_NODE", omp_cores_per_node, & -!$ "Number of cores per node needed for hyper-threading.", & -!$ fail_if_missing=.true., layoutParam=.true.) -!$ endif +!$ call fms_affinity_set('OCEAN', ocean_omp_hyper_thread, ocean_nthreads) !$ call omp_set_num_threads(ocean_nthreads) -!$ base_cpu = get_cpu_affinity() -!$OMP PARALLEL private(adder) -!$ if (ocean_omp_hyper_thread) then -!$ if (mod(omp_get_thread_num(),2) == 0) then -!$ adder = omp_get_thread_num()/2 -!$ else -!$ adder = omp_cores_per_node + omp_get_thread_num()/2 -!$ endif -!$ else -!$ adder = omp_get_thread_num() -!$ endif -!$ call set_cpu_affinity(base_cpu + adder) -!!$ write(6,*) " ocean ", base_cpu, get_cpu_affinity(), adder, omp_get_thread_num(), omp_get_num_threads() -!!$ call flush(6) -!$OMP END PARALLEL +!$ write(6,*) "MOM_domains_mod OMPthreading ", fms_affinity_get(), omp_get_thread_num(), omp_get_num_threads() +!$ call flush(6) !$ endif #endif call log_param(param_file, mdl, "!SYMMETRIC_MEMORY_", MOM_dom%symmetric, & @@ -1336,26 +1321,6 @@ subroutine MOM_domains_init(MOM_dom, param_file, symmetric, static_memory, & "at run time. This can only be set at compile time.",& layoutParam=.true.) - call get_param(param_file, mdl, trim(nihalo_nm), MOM_dom%nihalo, & - "The number of halo points on each side in the "//& - "x-direction. With STATIC_MEMORY_ this is set as NIHALO_ "//& - "in "//trim(inc_nm)//" at compile time; without STATIC_MEMORY_ "//& - "the default is NIHALO_ in "//trim(inc_nm)//" (if defined) or 2.", & - default=4, static_value=nihalo_dflt, layoutParam=.true.) - call get_param(param_file, mdl, trim(njhalo_nm), MOM_dom%njhalo, & - "The number of halo points on each side in the "//& - "y-direction. With STATIC_MEMORY_ this is set as NJHALO_ "//& - "in "//trim(inc_nm)//" at compile time; without STATIC_MEMORY_ "//& - "the default is NJHALO_ in "//trim(inc_nm)//" (if defined) or 2.", & - default=4, static_value=njhalo_dflt, layoutParam=.true.) - if (present(min_halo)) then - MOM_dom%nihalo = max(MOM_dom%nihalo, min_halo(1)) - min_halo(1) = MOM_dom%nihalo - MOM_dom%njhalo = max(MOM_dom%njhalo, min_halo(2)) - min_halo(2) = MOM_dom%njhalo - call log_param(param_file, mdl, "!NIHALO min_halo", MOM_dom%nihalo, layoutParam=.true.) - call log_param(param_file, mdl, "!NJHALO min_halo", MOM_dom%nihalo, layoutParam=.true.) - endif if (is_static) then call get_param(param_file, mdl, "NIGLOBAL", MOM_dom%niglobal, & "The total number of thickness grid points in the "//& @@ -1372,12 +1337,6 @@ subroutine MOM_domains_init(MOM_dom, param_file, symmetric, static_memory, & if (MOM_dom%njglobal /= NJGLOBAL) call MOM_error(FATAL,"MOM_domains_init: " // & "static mismatch for NJGLOBAL_ domain size. Header file does not match input namelist") - if (.not.present(min_halo)) then - if (MOM_dom%nihalo /= NIHALO) call MOM_error(FATAL,"MOM_domains_init: " // & - "static mismatch for "//trim(nihalo_nm)//" domain size") - if (MOM_dom%njhalo /= NJHALO) call MOM_error(FATAL,"MOM_domains_init: " // & - "static mismatch for "//trim(njhalo_nm)//" domain size") - endif else call get_param(param_file, mdl, "NIGLOBAL", MOM_dom%niglobal, & "The total number of thickness grid points in the "//& @@ -1391,6 +1350,30 @@ subroutine MOM_domains_init(MOM_dom, param_file, symmetric, static_memory, & fail_if_missing=.true.) endif + call get_param(param_file, mdl, trim(nihalo_nm), MOM_dom%nihalo, & + "The number of halo points on each side in the x-direction. How this is set "//& + "varies with the calling component and static or dynamic memory configuration.", & + default=nihalo_dflt, static_value=nihalo_dflt) + call get_param(param_file, mdl, trim(njhalo_nm), MOM_dom%njhalo, & + "The number of halo points on each side in the y-direction. How this is set "//& + "varies with the calling component and static or dynamic memory configuration.", & + default=njhalo_dflt, static_value=njhalo_dflt) + if (present(min_halo)) then + MOM_dom%nihalo = max(MOM_dom%nihalo, min_halo(1)) + min_halo(1) = MOM_dom%nihalo + MOM_dom%njhalo = max(MOM_dom%njhalo, min_halo(2)) + min_halo(2) = MOM_dom%njhalo + ! These are generally used only with static memory, so they are considerd layout params. + call log_param(param_file, mdl, "!NIHALO min_halo", MOM_dom%nihalo, layoutParam=.true.) + call log_param(param_file, mdl, "!NJHALO min_halo", MOM_dom%nihalo, layoutParam=.true.) + endif + if (is_static .and. .not.present(min_halo)) then + if (MOM_dom%nihalo /= NIHALO) call MOM_error(FATAL,"MOM_domains_init: " // & + "static mismatch for "//trim(nihalo_nm)//" domain size") + if (MOM_dom%njhalo /= NJHALO) call MOM_error(FATAL,"MOM_domains_init: " // & + "static mismatch for "//trim(njhalo_nm)//" domain size") + endif + global_indices(1) = 1 ; global_indices(2) = MOM_dom%niglobal global_indices(3) = 1 ; global_indices(4) = MOM_dom%njglobal diff --git a/src/framework/MOM_file_parser.F90 b/src/framework/MOM_file_parser.F90 index 0cf049b61b..2e7a14dbe4 100644 --- a/src/framework/MOM_file_parser.F90 +++ b/src/framework/MOM_file_parser.F90 @@ -246,6 +246,7 @@ subroutine close_param_file(CS, quiet_close, component) character(len=*), optional, intent(in) :: component !< If present, this component name is used !! to generate parameter documentation file names ! Local variables + logical :: all_default character(len=128) :: docfile_default character(len=40) :: mdl ! This module's name. ! This include declares and sets the variable "version". @@ -269,8 +270,18 @@ subroutine close_param_file(CS, quiet_close, component) endif ; endif ! Log the parameters for the parser. + docfile_default = "MOM_parameter_doc" + if (present(component)) docfile_default = trim(component)//"_parameter_doc" + + all_default = (CS%log_to_stdout .eqv. log_to_stdout_default) + all_default = all_default .and. (trim(CS%doc_file) == trim(docfile_default)) + if (len_trim(CS%doc_file) > 0) then + all_default = all_default .and. (CS%complete_doc .eqv. complete_doc_default) + all_default = all_default .and. (CS%minimal_doc .eqv. minimal_doc_default) + endif + mdl = "MOM_file_parser" - call log_version(CS, mdl, version, "") + call log_version(CS, mdl, version, "", debugging=.true., log_to_all=.true., all_default=all_default) call log_param(CS, mdl, "SEND_LOG_TO_STDOUT", CS%log_to_stdout, & "If true, all log messages are also sent to stdout.", & default=log_to_stdout_default) @@ -282,8 +293,6 @@ subroutine close_param_file(CS, quiet_close, component) "If true, kill the run if there are any unused "//& "parameters.", default=unused_params_fatal_default, & debuggingParam=.true.) - docfile_default = "MOM_parameter_doc" - if (present(component)) docfile_default = trim(component)//"_parameter_doc" call log_param(CS, mdl, "DOCUMENT_FILE", CS%doc_file, & "The basename for files where run-time parameters, their "//& "settings, units and defaults are documented. Blank will "//& @@ -1240,11 +1249,17 @@ end function overrideWarningHasBeenIssued !> Log the version of a module to a log file and/or stdout, and/or to the !! parameter documentation file. -subroutine log_version_cs(CS, modulename, version, desc) +subroutine log_version_cs(CS, modulename, version, desc, log_to_all, all_default, layout, debugging) type(param_file_type), intent(in) :: CS !< File parser type character(len=*), intent(in) :: modulename !< Name of calling module character(len=*), intent(in) :: version !< Version string of module character(len=*), optional, intent(in) :: desc !< Module description + logical, optional, intent(in) :: log_to_all !< If present and true, log this parameter to the + !! ..._doc.all files, even if this module also has layout + !! or debugging parameters. + logical, optional, intent(in) :: all_default !< If true, all parameters take their default values. + logical, optional, intent(in) :: layout !< If present and true, this module has layout parameters. + logical, optional, intent(in) :: debugging !< If present and true, this module has debugging parameters. ! Local variables character(len=240) :: mesg @@ -1254,7 +1269,7 @@ subroutine log_version_cs(CS, modulename, version, desc) if (CS%log_to_stdout) write(CS%stdout,'(a)') trim(mesg) endif - if (present(desc)) call doc_module(CS%doc, modulename, desc) + if (present(desc)) call doc_module(CS%doc, modulename, desc, log_to_all, all_default, layout, debugging) end subroutine log_version_cs @@ -1274,7 +1289,7 @@ end subroutine log_version_plain !> Log the name and value of an integer model parameter in documentation files. subroutine log_param_int(CS, modulename, varname, value, desc, units, & - default, layoutParam, debuggingParam) + default, layoutParam, debuggingParam, like_default) type(param_file_type), intent(in) :: CS !< The control structure for the file_parser module, !! it is also a structure to parse for run-time parameters character(len=*), intent(in) :: modulename !< The name of the module using this parameter @@ -1288,6 +1303,8 @@ subroutine log_param_int(CS, modulename, varname, value, desc, units, & !! logged in the layout parameter file logical, optional, intent(in) :: debuggingParam !< If present and true, this parameter is !! logged in the debugging parameter file + logical, optional, intent(in) :: like_default !< If present and true, log this parameter as + !! though it has the default value, even if there is no default. character(len=240) :: mesg, myunits @@ -1300,13 +1317,13 @@ subroutine log_param_int(CS, modulename, varname, value, desc, units, & myunits=" "; if (present(units)) write(myunits(1:240),'(A)') trim(units) if (present(desc)) & call doc_param(CS%doc, varname, desc, myunits, value, default, & - layoutParam=layoutParam, debuggingParam=debuggingParam) + layoutParam=layoutParam, debuggingParam=debuggingParam, like_default=like_default) end subroutine log_param_int !> Log the name and values of an array of integer model parameter in documentation files. subroutine log_param_int_array(CS, modulename, varname, value, desc, & - units, default, layoutParam, debuggingParam) + units, default, layoutParam, debuggingParam, like_default) type(param_file_type), intent(in) :: CS !< The control structure for the file_parser module, !! it is also a structure to parse for run-time parameters character(len=*), intent(in) :: modulename !< The name of the module using this parameter @@ -1320,6 +1337,8 @@ subroutine log_param_int_array(CS, modulename, varname, value, desc, & !! logged in the layout parameter file logical, optional, intent(in) :: debuggingParam !< If present and true, this parameter is !! logged in the debugging parameter file + logical, optional, intent(in) :: like_default !< If present and true, log this parameter as + !! though it has the default value, even if there is no default. character(len=1320) :: mesg character(len=240) :: myunits @@ -1333,13 +1352,13 @@ subroutine log_param_int_array(CS, modulename, varname, value, desc, & myunits=" "; if (present(units)) write(myunits(1:240),'(A)') trim(units) if (present(desc)) & call doc_param(CS%doc, varname, desc, myunits, value, default, & - layoutParam=layoutParam, debuggingParam=debuggingParam) + layoutParam=layoutParam, debuggingParam=debuggingParam, like_default=like_default) end subroutine log_param_int_array !> Log the name and value of a real model parameter in documentation files. subroutine log_param_real(CS, modulename, varname, value, desc, units, & - default, debuggingParam) + default, debuggingParam, like_default) type(param_file_type), intent(in) :: CS !< The control structure for the file_parser module, !! it is also a structure to parse for run-time parameters character(len=*), intent(in) :: modulename !< The name of the calling module @@ -1351,6 +1370,8 @@ subroutine log_param_real(CS, modulename, varname, value, desc, units, & real, optional, intent(in) :: default !< The default value of the parameter logical, optional, intent(in) :: debuggingParam !< If present and true, this parameter is !! logged in the debugging parameter file + logical, optional, intent(in) :: like_default !< If present and true, log this parameter as + !! though it has the default value, even if there is no default. character(len=240) :: mesg, myunits @@ -1364,13 +1385,13 @@ subroutine log_param_real(CS, modulename, varname, value, desc, units, & myunits="not defined"; if (present(units)) write(myunits(1:240),'(A)') trim(units) if (present(desc)) & call doc_param(CS%doc, varname, desc, myunits, value, default, & - debuggingParam=debuggingParam) + debuggingParam=debuggingParam, like_default=like_default) end subroutine log_param_real !> Log the name and values of an array of real model parameter in documentation files. subroutine log_param_real_array(CS, modulename, varname, value, desc, & - units, default, debuggingParam) + units, default, debuggingParam, like_default) type(param_file_type), intent(in) :: CS !< The control structure for the file_parser module, !! it is also a structure to parse for run-time parameters character(len=*), intent(in) :: modulename !< The name of the calling module @@ -1382,6 +1403,8 @@ subroutine log_param_real_array(CS, modulename, varname, value, desc, & real, optional, intent(in) :: default !< The default value of the parameter logical, optional, intent(in) :: debuggingParam !< If present and true, this parameter is !! logged in the debugging parameter file + logical, optional, intent(in) :: like_default !< If present and true, log this parameter as + !! though it has the default value, even if there is no default. character(len=1320) :: mesg character(len=240) :: myunits @@ -1399,13 +1422,13 @@ subroutine log_param_real_array(CS, modulename, varname, value, desc, & myunits="not defined"; if (present(units)) write(myunits(1:240),'(A)') trim(units) if (present(desc)) & call doc_param(CS%doc, varname, desc, myunits, value, default, & - debuggingParam=debuggingParam) + debuggingParam=debuggingParam, like_default=like_default) end subroutine log_param_real_array !> Log the name and value of a logical model parameter in documentation files. subroutine log_param_logical(CS, modulename, varname, value, desc, & - units, default, layoutParam, debuggingParam) + units, default, layoutParam, debuggingParam, like_default) type(param_file_type), intent(in) :: CS !< The control structure for the file_parser module, !! it is also a structure to parse for run-time parameters character(len=*), intent(in) :: modulename !< The name of the calling module @@ -1419,6 +1442,8 @@ subroutine log_param_logical(CS, modulename, varname, value, desc, & !! logged in the layout parameter file logical, optional, intent(in) :: debuggingParam !< If present and true, this parameter is !! logged in the debugging parameter file + logical, optional, intent(in) :: like_default !< If present and true, log this parameter as + !! though it has the default value, even if there is no default. character(len=240) :: mesg, myunits @@ -1435,13 +1460,13 @@ subroutine log_param_logical(CS, modulename, varname, value, desc, & myunits="Boolean"; if (present(units)) write(myunits(1:240),'(A)') trim(units) if (present(desc)) & call doc_param(CS%doc, varname, desc, myunits, value, default, & - layoutParam=layoutParam, debuggingParam=debuggingParam) + layoutParam=layoutParam, debuggingParam=debuggingParam, like_default=like_default) end subroutine log_param_logical !> Log the name and value of a character string model parameter in documentation files. subroutine log_param_char(CS, modulename, varname, value, desc, units, & - default, layoutParam, debuggingParam) + default, layoutParam, debuggingParam, like_default) type(param_file_type), intent(in) :: CS !< The control structure for the file_parser module, !! it is also a structure to parse for run-time parameters character(len=*), intent(in) :: modulename !< The name of the calling module @@ -1455,6 +1480,8 @@ subroutine log_param_char(CS, modulename, varname, value, desc, units, & !! logged in the layout parameter file logical, optional, intent(in) :: debuggingParam !< If present and true, this parameter is !! logged in the debugging parameter file + logical, optional, intent(in) :: like_default !< If present and true, log this parameter as + !! though it has the default value, even if there is no default. character(len=240) :: mesg, myunits @@ -1468,14 +1495,14 @@ subroutine log_param_char(CS, modulename, varname, value, desc, units, & myunits=" "; if (present(units)) write(myunits(1:240),'(A)') trim(units) if (present(desc)) & call doc_param(CS%doc, varname, desc, myunits, value, default, & - layoutParam=layoutParam, debuggingParam=debuggingParam) + layoutParam=layoutParam, debuggingParam=debuggingParam, like_default=like_default) end subroutine log_param_char !> This subroutine writes the value of a time-type parameter to a log file, !! along with its name and the module it came from. subroutine log_param_time(CS, modulename, varname, value, desc, units, & - default, timeunit, layoutParam, debuggingParam, log_date) + default, timeunit, layoutParam, debuggingParam, log_date, like_default) type(param_file_type), intent(in) :: CS !< The control structure for the file_parser module, !! it is also a structure to parse for run-time parameters character(len=*), intent(in) :: modulename !< The name of the calling module @@ -1493,6 +1520,8 @@ subroutine log_param_time(CS, modulename, varname, value, desc, units, & !! logged in the layout parameter file logical, optional, intent(in) :: debuggingParam !< If present and true, this parameter is !! logged in the debugging parameter file + logical, optional, intent(in) :: like_default !< If present and true, log this parameter as + !! though it has the default value, even if there is no default. ! Local variables real :: real_time, real_default @@ -1528,10 +1557,10 @@ subroutine log_param_time(CS, modulename, varname, value, desc, units, & default_string = convert_date_to_string(default) call doc_param(CS%doc, varname, desc, myunits, date_string, & default=default_string, layoutParam=layoutParam, & - debuggingParam=debuggingParam) + debuggingParam=debuggingParam, like_default=like_default) else call doc_param(CS%doc, varname, desc, myunits, date_string, & - layoutParam=layoutParam, debuggingParam=debuggingParam) + layoutParam=layoutParam, debuggingParam=debuggingParam, like_default=like_default) endif elseif (use_timeunit) then if (present(units)) then @@ -1551,12 +1580,12 @@ subroutine log_param_time(CS, modulename, varname, value, desc, units, & real_default = (86400.0/timeunit)*days + secs/timeunit if (ticks > 0) real_default = real_default + & real(ticks) / (timeunit*get_ticks_per_second()) - call doc_param(CS%doc, varname, desc, myunits, real_time, real_default) + call doc_param(CS%doc, varname, desc, myunits, real_time, real_default, like_default=like_default) else - call doc_param(CS%doc, varname, desc, myunits, real_time) + call doc_param(CS%doc, varname, desc, myunits, real_time, like_default=like_default) endif else - call doc_param(CS%doc, varname, desc, value, default, units=units) + call doc_param(CS%doc, varname, desc, value, default, units=units, like_default=like_default) endif endif diff --git a/src/framework/MOM_hor_index.F90 b/src/framework/MOM_hor_index.F90 index fc833eeea9..a37c76ce41 100644 --- a/src/framework/MOM_hor_index.F90 +++ b/src/framework/MOM_hor_index.F90 @@ -81,7 +81,7 @@ subroutine hor_index_init(Domain, HI, param_file, local_indexing, index_offset) ! Read all relevant parameters and write them to the model log. call log_version(param_file, "MOM_hor_index", version, & - "Sets the horizontal array index types.") + "Sets the horizontal array index types.", all_default=.true.) HI%IscB = HI%isc ; HI%JscB = HI%jsc HI%IsdB = HI%isd ; HI%JsdB = HI%jsd diff --git a/src/framework/MOM_restart.F90 b/src/framework/MOM_restart.F90 index c918f3a9ee..ed29b99b55 100644 --- a/src/framework/MOM_restart.F90 +++ b/src/framework/MOM_restart.F90 @@ -1511,6 +1511,7 @@ subroutine restart_init(param_file, CS, restart_root) ! This include declares and sets the variable "version". #include "version_variable.h" character(len=40) :: mdl = "MOM_restart" ! This module's name. + logical :: all_default ! If true, all parameters are using their default values. if (associated(CS)) then call MOM_error(WARNING, "restart_init called with an associated control structure.") @@ -1518,10 +1519,25 @@ subroutine restart_init(param_file, CS, restart_root) endif allocate(CS) + ! Determine whether all paramters are set to their default values. + call get_param(param_file, mdl, "PARALLEL_RESTARTFILES", CS%parallel_restartfiles, & + default=.false., do_not_log=.true.) + call get_param(param_file, mdl, "LARGE_FILE_SUPPORT", CS%large_file_support, & + default=.true., do_not_log=.true.) + call get_param(param_file, mdl, "MAX_FIELDS", CS%max_fields, default=100, do_not_log=.true.) + call get_param(param_file, mdl, "RESTART_CHECKSUMS_REQUIRED", CS%checksum_required, & + default=.true., do_not_log=.true.) + all_default = ((.not.CS%parallel_restartfiles) .and. (CS%large_file_support) .and. & + (CS%max_fields == 100) .and. (CS%checksum_required)) + if (.not.present(restart_root)) then + call get_param(param_file, mdl, "RESTARTFILE", CS%restartfile, & + default="MOM.res", do_not_log=.true.) + all_default = (all_default .and. (trim(CS%restartfile) == trim("MOM.res"))) + endif + ! Read all relevant parameters and write them to the model log. - call log_version(param_file, mdl, version, "") - call get_param(param_file, mdl, "PARALLEL_RESTARTFILES", & - CS%parallel_restartfiles, & + call log_version(param_file, mdl, version, "", all_default=all_default) + call get_param(param_file, mdl, "PARALLEL_RESTARTFILES", CS%parallel_restartfiles, & "If true, each processor writes its own restart file, "//& "otherwise a single restart file is generated", & default=.false.) diff --git a/src/framework/MOM_unit_scaling.F90 b/src/framework/MOM_unit_scaling.F90 index ffd2452c19..fea1ac4910 100644 --- a/src/framework/MOM_unit_scaling.F90 +++ b/src/framework/MOM_unit_scaling.F90 @@ -75,7 +75,7 @@ subroutine unit_scaling_init( param_file, US ) if (present(param_file)) then ! Read all relevant parameters and write them to the model log. call log_version(param_file, mdl, version, & - "Parameters for doing unit scaling of variables.") + "Parameters for doing unit scaling of variables.", debugging=.true.) call get_param(param_file, mdl, "Z_RESCALE_POWER", Z_power, & "An integer power of 2 that is used to rescale the model's "//& "internal units of depths and heights. Valid values range from -300 to 300.", & diff --git a/src/framework/MOM_write_cputime.F90 b/src/framework/MOM_write_cputime.F90 index 7a2fb36608..1f0e001073 100644 --- a/src/framework/MOM_write_cputime.F90 +++ b/src/framework/MOM_write_cputime.F90 @@ -60,9 +60,10 @@ subroutine MOM_write_cputime_init(param_file, directory, Input_start_time, CS) ! Local variables integer :: new_cputime ! The CPU time returned by SYSTEM_CLOCK -! This include declares and sets the variable "version". -#include "version_variable.h" + ! This include declares and sets the variable "version". +# include "version_variable.h" character(len=40) :: mdl = 'MOM_write_cputime' ! This module's name. + logical :: all_default ! If true, all parameters are using their default values. if (.not.associated(CS)) then allocate(CS) @@ -71,7 +72,13 @@ subroutine MOM_write_cputime_init(param_file, directory, Input_start_time, CS) endif ! Read all relevant parameters and write them to the model log. - call log_version(param_file, mdl, version, "") + + ! Determine whether all paramters are set to their default values. + call get_param(param_file, mdl, "MAXCPU", CS%maxcpu, default=-1.0, do_not_log=.true.) + call get_param(param_file, mdl, "CPU_TIME_FILE", CS%CPUfile, default="CPU_stats", do_not_log=.true.) + all_default = (CS%maxcpu == -1.0) .and. (trim(CS%CPUfile) == trim("CPU_stats")) + + call log_version(param_file, mdl, version, "", all_default=all_default) call get_param(param_file, mdl, "MAXCPU", CS%maxcpu, & "The maximum amount of cpu time per processor for which "//& "MOM should run before saving a restart file and "//& diff --git a/src/framework/_Diagnostics.dox b/src/framework/_Diagnostics.dox index 44b3a6afe7..3db345ca1a 100644 --- a/src/framework/_Diagnostics.dox +++ b/src/framework/_Diagnostics.dox @@ -10,7 +10,6 @@ the former being diagnostics in the actual model coordinate space, and the latte \section diag_table The "diag_table" At run-time, diagnostics are controlled by the input file `diag_table` which is interpreted but the FMS package diag_manager. -The diag_table syntax is documented at http://data1.gfdl.noaa.gov/~nnz/MOM/mom5_pubrel_August2012/src/shared/diag_manager/diag_table.html. The diag_table file has three kinds of section: Title, File and Field. The title section is mandatory and always the first. There can be multiple file and field sections, typically either in pairs or grouped in to all files and all fields, diff --git a/src/initialization/MOM_fixed_initialization.F90 b/src/initialization/MOM_fixed_initialization.F90 index 1ddf6f2345..b075da4141 100644 --- a/src/initialization/MOM_fixed_initialization.F90 +++ b/src/initialization/MOM_fixed_initialization.F90 @@ -249,7 +249,7 @@ subroutine MOM_initialize_topography(D, max_depth, G, PF, US) else max_depth = diagnoseMaximumDepth(D,G) call log_param(PF, mdl, "!MAXIMUM_DEPTH", max_depth*Z_to_m, & - "The (diagnosed) maximum depth of the ocean.", units="m") + "The (diagnosed) maximum depth of the ocean.", units="m", like_default=.true.) endif if (trim(config) /= "DOME") then call limit_topography(D, G, PF, max_depth, US) diff --git a/src/ocean_data_assim/MOM_oda_driver.F90 b/src/ocean_data_assim/MOM_oda_driver.F90 index 089e1fc422..acc316cce4 100644 --- a/src/ocean_data_assim/MOM_oda_driver.F90 +++ b/src/ocean_data_assim/MOM_oda_driver.F90 @@ -1,9 +1,8 @@ !> Interfaces for MOM6 ensembles and data assimilation. module MOM_oda_driver_mod -! This file is part of MOM6. see LICENSE.md for the license. -use fms_mod, only : open_namelist_file, close_file, check_nml_error -use fms_mod, only : error_mesg, FATAL + ! This file is part of MOM6. see LICENSE.md for the license. + use mpp_mod, only : stdout, stdlog, mpp_error, npes=>mpp_npes,pe=>mpp_pe use mpp_mod, only : set_current_pelist => mpp_set_current_pelist use mpp_mod, only : set_root_pe => mpp_set_root_pe @@ -250,20 +249,6 @@ subroutine init_oda(Time, G, GV, CS) allocate(CS%tv%S(isd:ied,jsd:jed,CS%GV%ke)); CS%tv%S(:,:,:)=0.0 call set_axes_info(CS%Grid, CS%GV, CS%US, PF, CS%diag_cs, set_vertical=.true.) - do n=1,CS%ensemble_size - write(fldnam,'(a,i2.2)') 'temp_prior_',n - CS%Ocean_prior%id_t(n)=register_diag_field('ODA',trim(fldnam),CS%diag_cs%axesTL%handles,Time, & - 'ocean potential temperature','degC') - write(fldnam,'(a,i2.2)') 'salt_prior_',n - CS%Ocean_prior%id_s(n)=register_diag_field('ODA',trim(fldnam),CS%diag_cs%axesTL%handles,Time, & - 'ocean salinity','psu') - write(fldnam,'(a,i2.2)') 'temp_posterior_',n - CS%Ocean_posterior%id_t(n)=register_diag_field('ODA',trim(fldnam),CS%diag_cs%axesTL%handles,Time, & - 'ocean potential temperature','degC') - write(fldnam,'(a,i2.2)') 'salt_posterior_',n - CS%Ocean_posterior%id_s(n)=register_diag_field('ODA',trim(fldnam),CS%diag_cs%axesTL%handles,Time, & - 'ocean salinity','psu') - enddo call mpp_get_data_domain(CS%mpp_domain,isd,ied,jsd,jed) allocate(CS%oda_grid) @@ -364,10 +349,6 @@ subroutine set_prior_tracer(Time, G, GV, h, tv, CS) CS%mpp_domain, CS%Ocean_prior%T(:,:,:,m), complete=.true.) call mpp_redistribute(CS%domains(m)%mpp_domain, S,& CS%mpp_domain, CS%Ocean_prior%S(:,:,:,m), complete=.true.) - if (CS%Ocean_prior%id_t(m)>0) & - used=send_data(CS%Ocean_prior%id_t(m), CS%Ocean_prior%T(isc:iec,jsc:jec,:,m), CS%Time) - if (CS%Ocean_prior%id_s(m)>0) & - used=send_data(CS%Ocean_prior%id_s(m), CS%Ocean_prior%S(isc:iec,jsc:jec,:,m), CS%Time) enddo deallocate(T,S) @@ -478,13 +459,13 @@ subroutine init_ocean_ensemble(CS,Grid,GV,ens_size) allocate(CS%T(is:ie,js:je,nk,ens_size)) allocate(CS%S(is:ie,js:je,nk,ens_size)) allocate(CS%SSH(is:ie,js:je,ens_size)) - allocate(CS%id_t(ens_size));CS%id_t(:)=-1 - allocate(CS%id_s(ens_size));CS%id_s(:)=-1 +! allocate(CS%id_t(ens_size));CS%id_t(:)=-1 +! allocate(CS%id_s(ens_size));CS%id_s(:)=-1 ! allocate(CS%U(is:ie,js:je,nk,ens_size)) ! allocate(CS%V(is:ie,js:je,nk,ens_size)) ! allocate(CS%id_u(ens_size));CS%id_u(:)=-1 ! allocate(CS%id_v(ens_size));CS%id_v(:)=-1 - allocate(CS%id_ssh(ens_size));CS%id_ssh(:)=-1 +! allocate(CS%id_ssh(ens_size));CS%id_ssh(:)=-1 return end subroutine init_ocean_ensemble diff --git a/src/ocean_data_assim/core b/src/ocean_data_assim/core deleted file mode 120000 index e0a21d3192..0000000000 --- a/src/ocean_data_assim/core +++ /dev/null @@ -1 +0,0 @@ -../../pkg/MOM6_DA_hooks/src/core \ No newline at end of file diff --git a/src/ocean_data_assim/geoKdTree b/src/ocean_data_assim/geoKdTree deleted file mode 120000 index 61fd167bb6..0000000000 --- a/src/ocean_data_assim/geoKdTree +++ /dev/null @@ -1 +0,0 @@ -../../pkg/geoKdTree \ No newline at end of file diff --git a/src/parameterizations/lateral/MOM_MEKE.F90 b/src/parameterizations/lateral/MOM_MEKE.F90 index dbb0a41506..5cbbe9b302 100644 --- a/src/parameterizations/lateral/MOM_MEKE.F90 +++ b/src/parameterizations/lateral/MOM_MEKE.F90 @@ -1007,7 +1007,8 @@ logical function MEKE_init(Time, G, US, param_file, diag, CS, MEKE, restart_CS) isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed ! Determine whether this module will be used - call log_version(param_file, mdl, version, "") + call get_param(param_file, mdl, "USE_MEKE", MEKE_init, default=.false., do_not_log=.true.) + call log_version(param_file, mdl, version, "", all_default=.not.MEKE_init) call get_param(param_file, mdl, "USE_MEKE", MEKE_init, & "If true, turns on the MEKE scheme which calculates "// & "a sub-grid mesoscale eddy kinetic energy budget.", & diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index 0f07701eda..e0def91821 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -3,20 +3,21 @@ module MOM_lateral_mixing_coeffs ! This file is part of MOM6. See LICENSE.md for the license. -use MOM_debugging, only : hchksum, uvchksum -use MOM_error_handler, only : MOM_error, FATAL, WARNING, MOM_mesg -use MOM_diag_mediator, only : register_diag_field, safe_alloc_ptr, post_data -use MOM_diag_mediator, only : diag_ctrl, time_type, query_averaging_enabled -use MOM_domains, only : create_group_pass, do_group_pass -use MOM_domains, only : group_pass_type, pass_var, pass_vector -use MOM_file_parser, only : get_param, log_version, param_file_type +use MOM_debugging, only : hchksum, uvchksum +use MOM_error_handler, only : MOM_error, FATAL, WARNING, MOM_mesg +use MOM_diag_mediator, only : register_diag_field, safe_alloc_ptr, post_data +use MOM_diag_mediator, only : diag_ctrl, time_type, query_averaging_enabled +use MOM_domains, only : create_group_pass, do_group_pass +use MOM_domains, only : group_pass_type, pass_var, pass_vector +use MOM_file_parser, only : get_param, log_version, param_file_type use MOM_interface_heights, only : find_eta -use MOM_isopycnal_slopes, only : calc_isoneutral_slopes -use MOM_grid, only : ocean_grid_type -use MOM_unit_scaling, only : unit_scale_type -use MOM_variables, only : thermo_var_ptrs -use MOM_verticalGrid, only : verticalGrid_type -use MOM_wave_speed, only : wave_speed, wave_speed_CS, wave_speed_init +use MOM_isopycnal_slopes, only : calc_isoneutral_slopes +use MOM_grid, only : ocean_grid_type +use MOM_unit_scaling, only : unit_scale_type +use MOM_variables, only : thermo_var_ptrs +use MOM_verticalGrid, only : verticalGrid_type +use MOM_wave_speed, only : wave_speed, wave_speed_CS, wave_speed_init +use MOM_open_boundary, only : ocean_OBC_type implicit none ; private @@ -432,7 +433,7 @@ end subroutine calc_resoln_function !> Calculates and stores functions of isopycnal slopes, e.g. Sx, Sy, S*N, mostly used in the Visbeck et al. !! style scaling of diffusivity -subroutine calc_slope_functions(h, tv, dt, G, GV, US, CS) +subroutine calc_slope_functions(h, tv, dt, G, GV, US, CS, OBC) type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type @@ -440,6 +441,7 @@ subroutine calc_slope_functions(h, tv, dt, G, GV, US, CS) type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables real, intent(in) :: dt !< Time increment [T ~> s] type(VarMix_CS), pointer :: CS !< Variable mixing coefficients + type(ocean_OBC_type), optional, pointer :: OBC !< Open boundaries control structure. ! Local variables real, dimension(SZI_(G), SZJ_(G), SZK_(G)+1) :: & e ! The interface heights relative to mean sea level [Z ~> m]. @@ -453,12 +455,12 @@ subroutine calc_slope_functions(h, tv, dt, G, GV, US, CS) call find_eta(h, tv, G, GV, US, e, halo_size=2) if (CS%use_stored_slopes) then call calc_isoneutral_slopes(G, GV, US, h, e, tv, dt*CS%kappa_smooth, & - CS%slope_x, CS%slope_y, N2_u, N2_v, 1) - call calc_Visbeck_coeffs(h, CS%slope_x, CS%slope_y, N2_u, N2_v, G, GV, US, CS) + CS%slope_x, CS%slope_y, N2_u, N2_v, 1, OBC=OBC) + call calc_Visbeck_coeffs(h, CS%slope_x, CS%slope_y, N2_u, N2_v, G, GV, US, CS, OBC=OBC) ! call calc_slope_functions_using_just_e(h, G, CS, e, .false.) else !call calc_isoneutral_slopes(G, GV, h, e, tv, dt*CS%kappa_smooth, CS%slope_x, CS%slope_y) - call calc_slope_functions_using_just_e(h, G, GV, US, CS, e, .true.) + call calc_slope_functions_using_just_e(h, G, GV, US, CS, e, .true., OBC=OBC) endif endif @@ -476,7 +478,7 @@ subroutine calc_slope_functions(h, tv, dt, G, GV, US, CS) end subroutine calc_slope_functions !> Calculates factors used when setting diffusivity coefficients similar to Visbeck et al. -subroutine calc_Visbeck_coeffs(h, slope_x, slope_y, N2_u, N2_v, G, GV, US, CS) +subroutine calc_Visbeck_coeffs(h, slope_x, slope_y, N2_u, N2_v, G, GV, US, CS, OBC) type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] @@ -488,6 +490,7 @@ subroutine calc_Visbeck_coeffs(h, slope_x, slope_y, N2_u, N2_v, G, GV, US, CS) !! at v-points [T-2 ~> s-2] type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(VarMix_CS), pointer :: CS !< Variable mixing coefficients + type(ocean_OBC_type), optional, pointer :: OBC !< Open boundaries control structure. ! Local variables real :: S2 ! Interface slope squared [nondim] @@ -500,6 +503,7 @@ subroutine calc_Visbeck_coeffs(h, slope_x, slope_y, N2_u, N2_v, G, GV, US, CS) real :: H_u(SZIB_(G)), H_v(SZI_(G)) real :: S2_u(SZIB_(G), SZJ_(G)) real :: S2_v(SZI_(G), SZJB_(G)) + logical :: local_open_u_BC, local_open_v_BC if (.not. associated(CS)) call MOM_error(FATAL, "calc_slope_function:"// & "Module must be initialized before it is used.") @@ -511,6 +515,13 @@ subroutine calc_Visbeck_coeffs(h, slope_x, slope_y, N2_u, N2_v, G, GV, US, CS) is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + local_open_u_BC = .false. + local_open_v_BC = .false. + if (present(OBC)) then ; if (associated(OBC)) then + local_open_u_BC = OBC%open_u_BCs_exist_globally + local_open_v_BC = OBC%open_v_BCs_exist_globally + endif ; endif + S2max = CS%Visbeck_S_max**2 !$OMP parallel do default(shared) @@ -556,6 +567,11 @@ subroutine calc_Visbeck_coeffs(h, slope_x, slope_y, N2_u, N2_v, G, GV, US, CS) else CS%SN_u(I,j) = 0. endif + if (local_open_u_BC) then + if (OBC%segment(OBC%segnum_u(I,j))%open) then + CS%SN_u(i,J) = 0. + endif + endif enddo enddo @@ -592,6 +608,11 @@ subroutine calc_Visbeck_coeffs(h, slope_x, slope_y, N2_u, N2_v, G, GV, US, CS) else CS%SN_v(i,J) = 0. endif + if (local_open_v_BC) then + if (OBC%segment(OBC%segnum_v(i,J))%open) then + CS%SN_v(i,J) = 0. + endif + endif enddo enddo @@ -613,7 +634,7 @@ end subroutine calc_Visbeck_coeffs !> The original calc_slope_function() that calculated slopes using !! interface positions only, not accounting for density variations. -subroutine calc_slope_functions_using_just_e(h, G, GV, US, CS, e, calculate_slopes) +subroutine calc_slope_functions_using_just_e(h, G, GV, US, CS, e, calculate_slopes, OBC) type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< Layer thickness [H ~> m or kg m-2] type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure @@ -622,6 +643,7 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, US, CS, e, calculate_slop real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: e !< Interface position [Z ~> m] logical, intent(in) :: calculate_slopes !< If true, calculate slopes internally !! otherwise use slopes stored in CS + type(ocean_OBC_type), optional, pointer :: OBC !< Open boundaries control structure. ! Local variables real :: E_x(SZIB_(G), SZJ_(G)) ! X-slope of interface at u points [nondim] (for diagnostics) real :: E_y(SZI_(G), SZJB_(G)) ! Y-slope of interface at v points [nondim] (for diagnostics) @@ -637,6 +659,7 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, US, CS, e, calculate_slop integer :: i, j, k, kb_max real :: S2N2_u_local(SZIB_(G), SZJ_(G),SZK_(G)) real :: S2N2_v_local(SZI_(G), SZJB_(G),SZK_(G)) + logical :: local_open_u_BC, local_open_v_BC if (.not. associated(CS)) call MOM_error(FATAL, "calc_slope_function:"// & "Module must be initialized before it is used.") @@ -648,6 +671,13 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, US, CS, e, calculate_slop is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + local_open_u_BC = .false. + local_open_v_BC = .false. + if (present(OBC)) then ; if (associated(OBC)) then + local_open_u_BC = OBC%open_u_BCs_exist_globally + local_open_v_BC = OBC%open_v_BCs_exist_globally + endif ; endif + one_meter = 1.0 * GV%m_to_H h_neglect = GV%H_subroundoff H_cutoff = real(2*nz) * (GV%Angstrom_H + h_neglect) @@ -723,6 +753,11 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, US, CS, e, calculate_slop else CS%SN_u(I,j) = 0.0 endif + if (local_open_u_BC) then + if (OBC%segment(OBC%segnum_u(I,j))%open) then + CS%SN_u(I,j) = 0. + endif + endif enddo enddo !$OMP parallel do default(shared) @@ -740,6 +775,11 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, US, CS, e, calculate_slop else CS%SN_v(I,j) = 0.0 endif + if (local_open_v_BC) then + if (OBC%segment(OBC%segnum_v(I,j))%open) then + CS%SN_v(I,j) = 0. + endif + endif enddo enddo diff --git a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 index 0a6eac4007..37bbaa4230 100644 --- a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 +++ b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 @@ -812,7 +812,9 @@ logical function mixedlayer_restrat_init(Time, G, GV, US, param_file, diag, CS, integer :: i, j ! Read all relevant parameters and write them to the model log. - call log_version(param_file, mdl, version, "") + call get_param(param_file, mdl, "MIXEDLAYER_RESTRAT", mixedlayer_restrat_init, & + default=.false., do_not_log=.true.) + call log_version(param_file, mdl, version, "", all_default=.not.mixedlayer_restrat_init) call get_param(param_file, mdl, "MIXEDLAYER_RESTRAT", mixedlayer_restrat_init, & "If true, a density-gradient dependent re-stratifying "//& "flow is imposed in the mixed layer. Can be used in ALE mode "//& diff --git a/src/parameterizations/vertical/MOM_ALE_sponge.F90 b/src/parameterizations/vertical/MOM_ALE_sponge.F90 index 5088a92d6e..27aa43274b 100644 --- a/src/parameterizations/vertical/MOM_ALE_sponge.F90 +++ b/src/parameterizations/vertical/MOM_ALE_sponge.F90 @@ -256,7 +256,7 @@ subroutine initialize_ALE_sponge_fixed(Iresttime, G, param_file, CS, data_h, nz_ answers_2018=CS%remap_answers_2018) call log_param(param_file, mdl, "!Total sponge columns at h points", total_sponge_cols, & - "The total number of columns where sponges are applied at h points.") + "The total number of columns where sponges are applied at h points.", like_default=.true.) if (CS%sponge_uv) then @@ -300,7 +300,7 @@ subroutine initialize_ALE_sponge_fixed(Iresttime, G, param_file, CS, data_h, nz_ total_sponge_cols_u = CS%num_col_u call sum_across_PEs(total_sponge_cols_u) call log_param(param_file, mdl, "!Total sponge columns at u points", total_sponge_cols_u, & - "The total number of columns where sponges are applied at u points.") + "The total number of columns where sponges are applied at u points.", like_default=.true.) ! v points CS%num_col_v = 0 ; !CS%fldno_v = 0 @@ -336,7 +336,7 @@ subroutine initialize_ALE_sponge_fixed(Iresttime, G, param_file, CS, data_h, nz_ total_sponge_cols_v = CS%num_col_v call sum_across_PEs(total_sponge_cols_v) call log_param(param_file, mdl, "!Total sponge columns at v points", total_sponge_cols_v, & - "The total number of columns where sponges are applied at v points.") + "The total number of columns where sponges are applied at v points.", like_default=.true.) endif end subroutine initialize_ALE_sponge_fixed @@ -484,7 +484,7 @@ subroutine initialize_ALE_sponge_varying(Iresttime, G, param_file, CS) call initialize_remapping(CS%remap_cs, remapScheme, boundary_extrapolation=bndExtrapolation, & answers_2018=CS%remap_answers_2018) call log_param(param_file, mdl, "!Total sponge columns at h points", total_sponge_cols, & - "The total number of columns where sponges are applied at h points.") + "The total number of columns where sponges are applied at h points.", like_default=.true.) if (CS%sponge_uv) then allocate(Iresttime_u(G%isdB:G%iedB,G%jsd:G%jed)) ; Iresttime_u(:,:) = 0.0 allocate(Iresttime_v(G%isd:G%ied,G%jsdB:G%jedB)) ; Iresttime_v(:,:) = 0.0 @@ -513,7 +513,7 @@ subroutine initialize_ALE_sponge_varying(Iresttime, G, param_file, CS) total_sponge_cols_u = CS%num_col_u call sum_across_PEs(total_sponge_cols_u) call log_param(param_file, mdl, "!Total sponge columns at u points", total_sponge_cols_u, & - "The total number of columns where sponges are applied at u points.") + "The total number of columns where sponges are applied at u points.", like_default=.true.) ! v points CS%num_col_v = 0 ; !CS%fldno_v = 0 do J=CS%jscB,CS%jecB; do i=CS%isc,CS%iec @@ -538,7 +538,7 @@ subroutine initialize_ALE_sponge_varying(Iresttime, G, param_file, CS) total_sponge_cols_v = CS%num_col_v call sum_across_PEs(total_sponge_cols_v) call log_param(param_file, mdl, "!Total sponge columns at v points", total_sponge_cols_v, & - "The total number of columns where sponges are applied at v points.") + "The total number of columns where sponges are applied at v points.", like_default=.true.) endif end subroutine initialize_ALE_sponge_varying diff --git a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 index 3b7420aa54..e0889360b9 100644 --- a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 @@ -199,8 +199,9 @@ logical function KPP_init(paramFile, G, GV, US, diag, Time, CS, passive, Waves) 'Control structure has already been initialized') ! Read parameters + call get_param(paramFile, mdl, "USE_KPP", KPP_init, default=.false., do_not_log=.true.) call log_version(paramFile, mdl, version, 'This is the MOM wrapper to CVMix:KPP\n' // & - 'See http://cvmix.github.io/') + 'See http://cvmix.github.io/', all_default=.not.KPP_init) call get_param(paramFile, mdl, "USE_KPP", KPP_init, & "If true, turns on the [CVMix] KPP scheme of Large et al., 1994, "// & "to calculate diffusivities and non-local transport in the OBL.", & @@ -626,7 +627,6 @@ subroutine KPP_calculate(CS, G, GV, US, h, uStar, & real :: LangEnhK ! Langmuir enhancement for mixing coefficient -#ifdef __DO_SAFETY_CHECKS__ if (CS%debug) then call hchksum(h, "KPP in: h",G%HI,haloshift=0, scale=GV%H_to_m) call hchksum(uStar, "KPP in: uStar",G%HI,haloshift=0, scale=US%Z_to_m*US%s_to_T) @@ -634,7 +634,6 @@ subroutine KPP_calculate(CS, G, GV, US, h, uStar, & call hchksum(Kt, "KPP in: Kt",G%HI,haloshift=0, scale=US%Z2_T_to_m2_s) call hchksum(Ks, "KPP in: Ks",G%HI,haloshift=0, scale=US%Z2_T_to_m2_s) endif -#endif nonLocalTrans(:,:) = 0.0 @@ -861,12 +860,10 @@ subroutine KPP_calculate(CS, G, GV, US, h, uStar, & enddo ! j -#ifdef __DO_SAFETY_CHECKS__ if (CS%debug) then call hchksum(Kt, "KPP out: Kt", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) call hchksum(Ks, "KPP out: Ks", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) endif -#endif ! send diagnostics to post_data if (CS%id_OBLdepth > 0) call post_data(CS%id_OBLdepth, CS%OBLdepth, CS%diag) @@ -951,14 +948,12 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, tv, uStar, buoyFl real :: WST -#ifdef __DO_SAFETY_CHECKS__ if (CS%debug) then call hchksum(Salt, "KPP in: S",G%HI,haloshift=0) call hchksum(Temp, "KPP in: T",G%HI,haloshift=0) call hchksum(u, "KPP in: u",G%HI,haloshift=0) call hchksum(v, "KPP in: v",G%HI,haloshift=0) endif -#endif ! some constants GoRho = US%L_T_to_m_s**2*US%m_to_Z * GV%g_Earth / GV%Rho0 diff --git a/src/parameterizations/vertical/MOM_CVMix_conv.F90 b/src/parameterizations/vertical/MOM_CVMix_conv.F90 index 06974095e1..b0cac10e03 100644 --- a/src/parameterizations/vertical/MOM_CVMix_conv.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_conv.F90 @@ -76,8 +76,10 @@ logical function CVMix_conv_init(Time, G, GV, US, param_file, diag, CS) allocate(CS) ! Read parameters + call get_param(param_file, mdl, "USE_CVMix_CONVECTION", CVMix_conv_init, default=.false., do_not_log=.true.) call log_version(param_file, mdl, version, & - "Parameterization of enhanced mixing due to convection via CVMix") + "Parameterization of enhanced mixing due to convection via CVMix", & + all_default=.not.CVMix_conv_init) call get_param(param_file, mdl, "USE_CVMix_CONVECTION", CVMix_conv_init, & "If true, turns on the enhanced mixing due to convection "//& "via CVMix. This scheme increases diapycnal diffs./viscs. "//& diff --git a/src/parameterizations/vertical/MOM_CVMix_ddiff.F90 b/src/parameterizations/vertical/MOM_CVMix_ddiff.F90 index 94cb958632..8407cca459 100644 --- a/src/parameterizations/vertical/MOM_CVMix_ddiff.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_ddiff.F90 @@ -79,8 +79,10 @@ logical function CVMix_ddiff_init(Time, G, GV, US, param_file, diag, CS) allocate(CS) ! Read parameters + call get_param(param_file, mdl, "USE_CVMIX_DDIFF", CVMix_ddiff_init, default=.false., do_not_log=.true.) call log_version(param_file, mdl, version, & - "Parameterization of mixing due to double diffusion processes via CVMix") + "Parameterization of mixing due to double diffusion processes via CVMix", & + all_default=.not.CVMix_ddiff_init) call get_param(param_file, mdl, "USE_CVMIX_DDIFF", CVMix_ddiff_init, & "If true, turns on double diffusive processes via CVMix. "//& "Note that double diffusive processes on viscosity are ignored "//& diff --git a/src/parameterizations/vertical/MOM_CVMix_shear.F90 b/src/parameterizations/vertical/MOM_CVMix_shear.F90 index f099305f0c..68a56d3597 100644 --- a/src/parameterizations/vertical/MOM_CVMix_shear.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_shear.F90 @@ -221,8 +221,11 @@ logical function CVMix_shear_init(Time, G, GV, US, param_file, diag, CS) allocate(CS) ! Set default, read and log parameters + call get_param(param_file, mdl, "USE_LMD94", CS%use_LMD94, default=.false., do_not_log=.true.) + call get_param(param_file, mdl, "USE_PP81", CS%use_PP81, default=.false., do_not_log=.true.) call log_version(param_file, mdl, version, & - "Parameterization of shear-driven turbulence via CVMix (various options)") + "Parameterization of shear-driven turbulence via CVMix (various options)", & + all_default=.not.(CS%use_PP81.or.CS%use_LMD94)) call get_param(param_file, mdl, "USE_LMD94", CS%use_LMD94, & "If true, use the Large-McWilliams-Doney (JGR 1994) "//& "shear mixing parameterization.", default=.false.) diff --git a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 index 021ed4a26f..079655f787 100644 --- a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 +++ b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 @@ -3438,7 +3438,7 @@ subroutine bulkmixedlayer_init(Time, G, GV, US, param_file, diag, CS) "BULKMIXEDLAYER is true.", units="nondim", default=2) call get_param(param_file, mdl, "MSTAR", CS%mstar, & "The ratio of the friction velocity cubed to the TKE "//& - "input to the mixed layer.", "units=nondim", default=1.2) + "input to the mixed layer.", units="nondim", default=1.2) call get_param(param_file, mdl, "NSTAR", CS%nstar, & "The portion of the buoyant potential energy imparted by "//& "surface fluxes that is available to drive entrainment "//& diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 9db2b4742b..7c24b774b3 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -53,6 +53,7 @@ module MOM_diabatic_driver use MOM_CVMix_KPP, only : KPP_NonLocalTransport_temp, KPP_NonLocalTransport_saln use MOM_opacity, only : opacity_init, opacity_end, opacity_CS use MOM_opacity, only : absorbRemainingSW, optics_type, optics_nbands +use MOM_open_boundary, only : ocean_OBC_type use MOM_regularize_layers, only : regularize_layers, regularize_layers_init, regularize_layers_CS use MOM_set_diffusivity, only : set_diffusivity, set_BBL_TKE use MOM_set_diffusivity, only : set_diffusivity_init, set_diffusivity_end @@ -254,7 +255,7 @@ module MOM_diabatic_driver !> This subroutine imposes the diapycnal mass fluxes and the !! accompanying diapycnal advection of momentum and tracers. subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & - G, GV, US, CS, WAVES) + G, GV, US, CS, OBC, WAVES) type(ocean_grid_type), intent(inout) :: G !< ocean grid structure type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u !< zonal velocity [L T-1 ~> m s-1] @@ -274,6 +275,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & type(time_type), intent(in) :: Time_end !< Time at the end of the interval type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(diabatic_CS), pointer :: CS !< module control structure + type(ocean_OBC_type), optional, pointer :: OBC !< Open boundaries control structure. type(Wave_parameters_CS), optional, pointer :: Waves !< Surface gravity waves ! local variables @@ -320,7 +322,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & call diapyc_energy_req_test(h, dt, tv, G, GV, US, CS%diapyc_en_rec_CSp) call cpu_clock_begin(id_clock_set_diffusivity) - call set_BBL_TKE(u, v, h, fluxes, visc, G, GV, US, CS%set_diff_CSp) + call set_BBL_TKE(u, v, h, fluxes, visc, G, GV, US, CS%set_diff_CSp, OBC=OBC) call cpu_clock_end(id_clock_set_diffusivity) ! Frazil formation keeps the temperature above the freezing point. @@ -3223,7 +3225,8 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di ! Set default, read and log parameters call log_version(param_file, mdl, version, & - "The following parameters are used for diabatic processes.") + "The following parameters are used for diabatic processes.", & + log_to_all=.true., debugging=.true.) call get_param(param_file, mdl, "USE_LEGACY_DIABATIC_DRIVER", CS%use_legacy_diabatic, & "If true, use a legacy version of the diabatic subroutine. "//& "This is temporary and is needed to avoid change in answers.", & diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index c27270c432..5a9e67bfd9 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -191,7 +191,7 @@ module MOM_energetic_PBL Velocity_Scale, & !< The velocity scale used in getting Kd [Z T-1 ~> m s-1] Mixing_Length !< The length scale used in getting Kd [Z ~> m] !>@{ Diagnostic IDs - integer :: id_ML_depth = -1, id_TKE_wind = -1, id_TKE_mixing = -1 + integer :: id_ML_depth = -1, id_hML_depth = -1, id_TKE_wind = -1, id_TKE_mixing = -1 integer :: id_TKE_MKE = -1, id_TKE_conv = -1, id_TKE_forcing = -1 integer :: id_TKE_mech_decay = -1, id_TKE_conv_decay = -1 integer :: id_Mixing_Length = -1, id_Velocity_Scale = -1 @@ -515,6 +515,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS if (write_diags) then if (CS%id_ML_depth > 0) call post_data(CS%id_ML_depth, CS%ML_depth, CS%diag) + if (CS%id_hML_depth > 0) call post_data(CS%id_hML_depth, CS%ML_depth, CS%diag) if (CS%id_TKE_wind > 0) call post_data(CS%id_TKE_wind, CS%diag_TKE_wind, CS%diag) if (CS%id_TKE_MKE > 0) call post_data(CS%id_TKE_MKE, CS%diag_TKE_MKE, CS%diag) if (CS%id_TKE_conv > 0) call post_data(CS%id_TKE_conv, CS%diag_TKE_conv, CS%diag) @@ -2338,15 +2339,19 @@ subroutine energetic_PBL_init(Time, G, GV, US, param_file, diag, CS) !/ Logging parameters ! This gives a minimum decay scale that is typically much less than Angstrom. CS%ustar_min = 2e-4*CS%omega*(GV%Angstrom_Z + GV%H_to_Z*GV%H_subroundoff) - call log_param(param_file, mdl, "EPBL_USTAR_MIN", CS%ustar_min*US%Z_to_m*US%s_to_T, & + call log_param(param_file, mdl, "!EPBL_USTAR_MIN", CS%ustar_min*US%Z_to_m*US%s_to_T, & "The (tiny) minimum friction velocity used within the "//& - "ePBL code, derived from OMEGA and ANGSTROM.", units="m s-1") + "ePBL code, derived from OMEGA and ANGSTROM.", units="m s-1", & + like_default=.true.) !/ Checking output flags CS%id_ML_depth = register_diag_field('ocean_model', 'ePBL_h_ML', diag%axesT1, & Time, 'Surface boundary layer depth', 'm', conversion=US%Z_to_m, & cmor_long_name='Ocean Mixed Layer Thickness Defined by Mixing Scheme') + ! This is an alias for the same variable as ePBL_h_ML + CS%id_hML_depth = register_diag_field('ocean_model', 'h_ML', diag%axesT1, & + Time, 'Surface mixed layer depth based on active turbulence', 'm', conversion=US%Z_to_m) CS%id_TKE_wind = register_diag_field('ocean_model', 'ePBL_TKE_wind', diag%axesT1, & Time, 'Wind-stirring source of mixed layer TKE', 'W m-2', conversion=US%RZ3_T3_to_W_m2) CS%id_TKE_MKE = register_diag_field('ocean_model', 'ePBL_TKE_MKE', diag%axesT1, & diff --git a/src/parameterizations/vertical/MOM_full_convection.F90 b/src/parameterizations/vertical/MOM_full_convection.F90 index 1783955d53..3be6628b14 100644 --- a/src/parameterizations/vertical/MOM_full_convection.F90 +++ b/src/parameterizations/vertical/MOM_full_convection.F90 @@ -408,7 +408,7 @@ subroutine smoothed_dRdT_dRdS(h, tv, Kddt, dR_dT, dR_dS, G, GV, US, j, p_surf, h else do i=is,ie ; pres(i) = 0.0 ; enddo endif - EOSdom(:) = EOS_domain(G%HI) + EOSdom(:) = EOS_domain(G%HI, halo) call calculate_density_derivs(T_f(:,1), S_f(:,1), pres, dR_dT(:,1), dR_dS(:,1), tv%eqn_of_state, EOSdom) do i=is,ie ; pres(i) = pres(i) + h(i,j,1)*(GV%H_to_RZ*GV%g_Earth) ; enddo do K=2,nz diff --git a/src/parameterizations/vertical/MOM_kappa_shear.F90 b/src/parameterizations/vertical/MOM_kappa_shear.F90 index 12d9bfc9c0..096781f8cf 100644 --- a/src/parameterizations/vertical/MOM_kappa_shear.F90 +++ b/src/parameterizations/vertical/MOM_kappa_shear.F90 @@ -19,9 +19,6 @@ module MOM_kappa_shear implicit none ; private #include -#ifdef use_netCDF -#include -#endif public Calculate_kappa_shear, Calc_kappa_shear_vertex, kappa_shear_init public kappa_shear_is_used, kappa_shear_at_vertex @@ -99,9 +96,6 @@ module MOM_kappa_shear ! integer :: id_clock_project, id_clock_KQ, id_clock_avg, id_clock_setup -#undef DEBUG -#undef ADD_DIAGNOSTICS - contains !> Subroutine for calculating shear-driven diffusivity and TKE in tracer columns @@ -177,15 +171,6 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & ! interpolating back to the original index space [nondim]. integer :: is, ie, js, je, i, j, k, nz, nzc - ! Diagnostics that should be deleted? -#ifdef ADD_DIAGNOSTICS - real, dimension(SZK_(GV)+1) :: & ! Additional diagnostics. - I_Ld2_1d, dz_Int_1d - real, dimension(SZI_(G),SZK_(GV)+1) :: & ! 2-D versions of diagnostics. - I_Ld2_2d, dz_Int_2d - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1) :: & ! 3-D versions of diagnostics. - I_Ld2_3d, dz_Int_3d -#endif is = G%isc ; ie = G%iec; js = G%jsc ; je = G%jec ; nz = GV%ke use_temperature = .false. ; if (associated(tv%T)) use_temperature = .true. @@ -195,9 +180,6 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & dz_massless = 0.1*sqrt(k0dt) !$OMP parallel do default(private) shared(js,je,is,ie,nz,h,u_in,v_in,use_temperature,new_kappa, & -#ifdef ADD_DIAGNOSTICS - !$OMP I_Ld2_3d,dz_Int_3d, & -#endif !$OMP tv,G,GV,US,CS,kappa_io,dz_massless,k0dt,p_surf,dt,tke_io,kv_io) do j=js,je do k=1,nz ; do i=is,ie @@ -295,15 +277,9 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & do K=1,nzc+1 ; kappa(K) = kappa_2d(i,K) ; enddo endif -#ifdef ADD_DIAGNOSTICS - call kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & - dz, u0xdz, v0xdz, T0xdz, S0xdz, kappa_avg, & - tke_avg, tv, CS, GV, US, I_Ld2_1d, dz_Int_1d) -#else call kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & dz, u0xdz, v0xdz, T0xdz, S0xdz, kappa_avg, & tke_avg, tv, CS, GV, US) -#endif ! call cpu_clock_begin(id_clock_setup) ! Extrapolate from the vertically reduced grid back to the original layers. @@ -329,18 +305,10 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & endif enddo endif -#ifdef ADD_DIAGNOSTICS - do K=1,nz+1 - I_Ld2_2d(i,K) = I_Ld2_1d(K) ; dz_Int_2d(i,K) = dz_Int_1d(K) - enddo -#endif ! call cpu_clock_end(id_clock_setup) else ! Land points, still inside the i-loop. do K=1,nz+1 kappa_2d(i,K) = 0.0 ; tke_2d(i,K) = 0.0 -#ifdef ADD_DIAGNOSTICS - I_Ld2_2d(i,K) = 0.0 ; dz_Int_2d(i,K) = 0.0 -#endif enddo endif ; enddo ! i-loop @@ -348,9 +316,6 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & kappa_io(i,j,K) = G%mask2dT(i,j) * kappa_2d(i,K) tke_io(i,j,K) = G%mask2dT(i,j) * tke_2d(i,K) kv_io(i,j,K) = ( G%mask2dT(i,j) * kappa_2d(i,K) ) * CS%Prandtl_turb -#ifdef ADD_DIAGNOSTICS - I_Ld2_3d(i,j,K) = I_Ld2_2d(i,K) ; dz_Int_3d(i,j,K) = dz_Int_2d(i,K) -#endif enddo ; enddo enddo ! end of j-loop @@ -362,10 +327,6 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & if (CS%id_Kd_shear > 0) call post_data(CS%id_Kd_shear, kappa_io, CS%diag) if (CS%id_TKE > 0) call post_data(CS%id_TKE, tke_io, CS%diag) -#ifdef ADD_DIAGNOSTICS - if (CS%id_ILd2 > 0) call post_data(CS%id_ILd2, I_Ld2_3d, CS%diag) - if (CS%id_dz_Int > 0) call post_data(CS%id_dz_Int, dz_Int_3d, CS%diag) -#endif end subroutine Calculate_kappa_shear @@ -451,14 +412,6 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ integer :: IsB, IeB, JsB, JeB, i, j, k, nz, nzc, J2, J2m1 ! Diagnostics that should be deleted? -#ifdef ADD_DIAGNOSTICS - real, dimension(SZK_(GV)+1) :: & ! Additional diagnostics. - I_Ld2_1d, dz_Int_1d - real, dimension(SZI_(G),SZK_(GV)+1) :: & ! 2-D versions of diagnostics. - I_Ld2_2d, dz_Int_2d - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1) :: & ! 3-D versions of diagnostics. - I_Ld2_3d, dz_Int_3d -#endif isB = G%isc-1 ; ieB = G%iecB ; jsB = G%jsc-1 ; jeB = G%jecB ; nz = GV%ke use_temperature = .false. ; if (associated(tv%T)) use_temperature = .true. @@ -469,9 +422,6 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ I_Prandtl = 0.0 ; if (CS%Prandtl_turb > 0.0) I_Prandtl = 1.0 / CS%Prandtl_turb !$OMP parallel do default(private) shared(jsB,jeB,isB,ieB,nz,h,u_in,v_in,use_temperature,new_kappa, & -#ifdef ADD_DIAGNOSTICS - !$OMP I_Ld2_3d,dz_Int_3d, & -#endif !$OMP tv,G,GV,US,CS,kappa_io,dz_massless,k0dt,p_surf,dt,tke_io,kv_io) do J=JsB,JeB J2 = mod(J,2)+1 ; J2m1 = 3-J2 ! = mod(J-1,2)+1 @@ -597,15 +547,9 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ do K=1,nzc+1 ; kappa(K) = kappa_2d(I,K,J2) ; enddo endif -#ifdef ADD_DIAGNOSTICS - call kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & - dz, u0xdz, v0xdz, T0xdz, S0xdz, kappa_avg, & - tke_avg, tv, CS, GV, US, I_Ld2_1d, dz_Int_1d) -#else call kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & dz, u0xdz, v0xdz, T0xdz, S0xdz, kappa_avg, & tke_avg, tv, CS, GV, US) -#endif ! call cpu_clock_begin(Id_clock_setup) ! Extrapolate from the vertically reduced grid back to the original layers. if (nz == nzc) then @@ -628,27 +572,16 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ endif enddo endif -#ifdef ADD_DIAGNOSTICS - do K=1,nz+1 - I_Ld2_2d(i,K) = I_Ld2_1d(K) ; dz_Int_2d(i,K) = dz_Int_1d(K) - enddo -#endif ! call cpu_clock_end(Id_clock_setup) else ! Land points, still inside the i-loop. do K=1,nz+1 kappa_2d(I,K,J2) = 0.0 ; tke_2d(I,K) = 0.0 -#ifdef ADD_DIAGNOSTICS - I_Ld2_2d(I,K) = 0.0 ; dz_Int_2d(I,K) = 0.0 -#endif enddo endif ; enddo ! i-loop do K=1,nz+1 ; do I=IsB,IeB tke_io(I,J,K) = G%mask2dBu(I,J) * tke_2d(I,K) kv_io(I,J,K) = ( G%mask2dBu(I,J) * kappa_2d(I,K,J2) ) * CS%Prandtl_turb -#ifdef ADD_DIAGNOSTICS - I_Ld2_3d(I,J,K) = I_Ld2_2d(I,K) ; dz_Int_3d(I,J,K) = dz_Int_2d(I,K) -#endif enddo ; enddo if (J>=G%jsc) then ; do K=1,nz+1 ; do i=G%isc,G%iec ! Set the diffusivities in tracer columns from the values at vertices. @@ -666,10 +599,6 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ if (CS%id_Kd_shear > 0) call post_data(CS%id_Kd_shear, kappa_io, CS%diag) if (CS%id_TKE > 0) call post_data(CS%id_TKE, tke_io, CS%diag) -#ifdef ADD_DIAGNOSTICS - if (CS%id_ILd2 > 0) call post_data(CS%id_ILd2, I_Ld2_3d, CS%diag) - if (CS%id_dz_Int > 0) call post_data(CS%id_dz_Int, dz_Int_3d, CS%diag) -#endif end subroutine Calc_kappa_shear_vertex @@ -794,23 +723,10 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & ! to estimate the maximum permitted time step. I.e., ! the resolution is 1/2^dt_refinements. integer :: k, itt, itt_dt -#ifdef DEBUG - integer :: max_debug_itt ; parameter(max_debug_itt=20) - real :: wt(SZK_(GV)+1), wt_tot, I_wt_tot, wt_itt - real, dimension(SZK_(GV)+1) :: & - Ri_k, tke_prev, dtke, dkappa, dtke_norm, & - N2_debug, & ! A version of N2 for debugging [T-2 ~> s-2] - ksrc_av ! The average through the iterations of k_src [T-1 ~> s-1]. - real, dimension(SZK_(GV)+1,0:max_debug_itt) :: & - tke_it1, N2_it1, Sh2_it1, ksrc_it1, kappa_it1, kprev_it1 - real, dimension(SZK_(GV)+1,1:max_debug_itt) :: & - dkappa_it1, wt_it1, K_Q_it1, d_dkappa_it1, dkappa_norm - real, dimension(SZK_(GV),0:max_debug_itt) :: & - u_it1, v_it1, rho_it1, T_it1, S_it1 - real, dimension(0:max_debug_itt) :: & - dk_wt_it1, dkpos_wt_it1, dkneg_wt_it1, k_mag - real, dimension(max_debug_itt) :: dt_it1 -#endif + + ! This calculation of N2 is for debugging only. + ! real, dimension(SZK_(GV)+1) :: & + ! N2_debug, & ! A version of N2 for debugging [T-2 ~> s-2] Ri_crit = CS%Rino_crit gR0 = GV%Rho0 * GV%g_Earth @@ -916,45 +832,12 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & do K=1,nzc+1 ; dbuoy_dT(K) = -g_R0 ; dbuoy_dS(K) = 0.0 ; enddo endif -#ifdef DEBUG - N2_debug(1) = 0.0 ; N2_debug(nzc+1) = 0.0 - do K=2,nzc - N2_debug(K) = max((dbuoy_dT(K) * (T0xdz(k-1)*Idz(k-1) - T0xdz(k)*Idz(k)) + & - dbuoy_dS(K) * (S0xdz(k-1)*Idz(k-1) - S0xdz(k)*Idz(k))) * & - I_dz_int(K), 0.0) - enddo - do k=1,nzc - u_it1(k,0) = u0xdz(k)*Idz(k) ; v_it1(k,0) = v0xdz(k)*Idz(k) - T_it1(k,0) = T0xdz(k)*Idz(k) ; S_it1(k,0) = S0xdz(k)*Idz(k) - enddo - do K=1,nzc+1 - kprev_it1(K,0) = kappa(K) ; kappa_it1(K,0) = kappa(K) - tke_it1(K,0) = 0.0 - N2_it1(K,0) = N2_debug(K) ; Sh2_it1(K,0) = S2(K) ; ksrc_it1(K,0) = K_src(K) - enddo - do k=nzc+1,GV%ke - u_it1(k,0) = 0.0 ; v_it1(k,0) = 0.0 - T_it1(k,0) = 0.0 ; S_it1(k,0) = 0.0 - kprev_it1(K+1,0) = 0.0 ; kappa_it1(K+1,0) = 0.0 ; tke_it1(K+1,0) = 0.0 - N2_it1(K+1,0) = 0.0 ; Sh2_it1(K+1,0) = 0.0 ; ksrc_it1(K+1,0) = 0.0 - enddo - do itt=1,max_debug_itt - dt_it1(itt) = 0.0 - do k=1,GV%ke - u_it1(k,itt) = 0.0 ; v_it1(k,itt) = 0.0 - T_it1(k,itt) = 0.0 ; S_it1(k,itt) = 0.0 - rho_it1(k,itt) = 0.0 - enddo - do K=1,GV%ke+1 - kprev_it1(K,itt) = 0.0 ; kappa_it1(K,itt) = 0.0 ; tke_it1(K,itt) = 0.0 - N2_it1(K,itt) = 0.0 ; Sh2_it1(K,itt) = 0.0 - ksrc_it1(K,itt) = 0.0 - dkappa_it1(K,itt) = 0.0 ; wt_it1(K,itt) = 0.0 - K_Q_it1(K,itt) = 0.0 ; d_dkappa_it1(K,itt) = 0.0 - enddo - enddo - do K=1,GV%ke+1 ; ksrc_av(K) = 0.0 ; enddo -#endif + ! N2_debug(1) = 0.0 ; N2_debug(nzc+1) = 0.0 + ! do K=2,nzc + ! N2_debug(K) = max((dbuoy_dT(K) * (T0xdz(k-1)*Idz(k-1) - T0xdz(k)*Idz(k)) + & + ! dbuoy_dS(K) * (S0xdz(k-1)*Idz(k-1) - S0xdz(k)*Idz(k))) * & + ! I_dz_int(K), 0.0) + ! enddo ! This call just calculates N2 and S2. call calculate_projected_state(kappa, u, v, T, Sal, 0.0, nzc, dz, I_dz_int, & @@ -981,12 +864,6 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & ! ---------------------------------------------------- ! Calculate new values of u, v, rho, N^2 and S. ! ---------------------------------------------------- -#ifdef DEBUG - do K=1,nzc+1 - Ri_k(K) = 1e3 ; if (S2(K) > 1e-3*N2(K)) Ri_k(K) = N2(K) / S2(K) - if (itt > 1) then ; tke_prev(K) = tke(K) ; else ; tke_prev(K) = 0.0 ; endif - enddo -#endif ! call cpu_clock_begin(id_clock_KQ) call find_kappa_tke(N2, S2, kappa, Idz, dz_Int, I_L2_bdry, f2, & @@ -1099,9 +976,6 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & ! This would be here but does nothing. ! kappa_avg(K) = kappa_avg(K) + kappa_mid(K)*dt_wt tke_avg(K) = tke_avg(K) + dt_wt*tke(K) -#ifdef DEBUG - tke_pred(K) = tke(K) ; kappa_pred(K) = 0.0 ; kappa(K) = 0.0 -#endif enddo ! call cpu_clock_end(id_clock_avg) else @@ -1157,63 +1031,10 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & ! call cpu_clock_end(id_clock_project) endif -#ifdef DEBUG - if (itt <= max_debug_itt) then - dt_it1(itt) = dt_now - dk_wt_it1(itt) = 0.0 ; dkpos_wt_it1(itt) = 0.0 ; dkneg_wt_it1(itt) = 0.0 - k_mag(itt) = 0.0 - wt_itt = 1.0/real(itt) ; wt_tot = 0.0 - do K=1,nzc+1 - ksrc_av(K) = (1.0-wt_itt)*ksrc_av(K) + wt_itt*K_src(K) - wt_tot = wt_tot + dz_Int(K) * ksrc_av(K) - enddo - ! Use the 1/0=0 convention. - I_wt_tot = 0.0 ; if (wt_tot > 0.0) I_wt_tot = 1.0/wt_tot - - do K=1,nzc+1 - wt(K) = (dz_Int(K)*ksrc_av(K)) * I_wt_tot - k_mag(itt) = k_mag(itt) + wt(K)*kappa_mid(K) - dkappa_it1(K,itt) = kappa_pred(K) - kappa_out(K) - dk_wt_it1(itt) = dk_wt_it1(itt) + wt(K)*dkappa_it1(K,itt) - if (dkappa_it1(K,itt) > 0.0) then - dkpos_wt_it1(itt) = dkpos_wt_it1(itt) + wt(K)*dkappa_it1(K,itt) - else - dkneg_wt_it1(itt) = dkneg_wt_it1(itt) + wt(K)*dkappa_it1(K,itt) - endif - wt_it1(K,itt) = wt(K) - enddo - endif - do K=1,nzc+1 - Ri_k(K) = 1e3 ; if (N2(K) < 1e3 * S2(K)) Ri_k(K) = N2(K) / S2(K) - dtke(K) = tke_pred(K) - tke(K) - dtke_norm(K) = dtke(K) / (0.5*(tke(K) + tke_pred(K))) - dkappa(K) = kappa_pred(K) - kappa_out(K) - enddo - if (itt <= max_debug_itt) then - do k=1,nzc - u_it1(k,itt) = u(k) ; v_it1(k,itt) = v(k) - T_it1(k,itt) = T(k) ; S_it1(k,itt) = Sal(k) - enddo - do K=1,nzc+1 - kprev_it1(K,itt) = kappa_out(K) - kappa_it1(K,itt) = kappa_mid(K) ; tke_it1(K,itt) = 0.5*(tke(K)+tke_pred(K)) - N2_it1(K,itt)=N2(K) ; Sh2_it1(K,itt)=S2(K) - ksrc_it1(K,itt) = kappa_src(K) - K_Q_it1(K,itt) = kappa_out(K) / (TKE(K)) - if (itt > 1) then - if (abs(dkappa_it1(K,itt-1)) > 1e-20) & - d_dkappa_it1(K,itt) = dkappa_it1(K,itt) / dkappa_it1(K,itt-1) - endif - dkappa_norm(K,itt) = dkappa(K) / max(0.5*(kappa_pred(K) + kappa_out(K)), US%m2_s_to_Z2_T*1e-100) - enddo - endif -#endif - if (dt_rem <= 0.0) exit enddo ! end itt loop -#ifdef ADD_DIAGNOSTICS if (present(I_Ld2_1d)) then do K=1,GV%ke+1 ; I_Ld2_1d(K) = 0.0 ; enddo do K=2,nzc ; if (TKE(K) > 0.0) & @@ -1224,7 +1045,6 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & do K=1,nzc+1 ; dz_Int_1d(K) = dz_Int(K) ; enddo do K=nzc+2,GV%ke ; dz_Int_1d(K) = 0.0 ; enddo endif -#endif end subroutine kappa_shear_column @@ -1474,18 +1294,14 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & integer :: ks_kappa, ke_kappa, ke_tke ! The ranges of k-indices that are or integer :: ks_kappa_prev, ke_kappa_prev ! were being worked on. integer :: itt, k, k2 -#ifdef DEBUG - integer :: max_debug_itt ; parameter(max_debug_itt=20) + + ! These variables are used only for debugging. + logical, parameter :: debug_soln = .false. real :: K_err_lin, Q_err_lin, TKE_src_norm real, dimension(nz+1) :: & I_Ld2_debug, & ! A separate version of I_Ld2 for debugging [Z-2 ~> m-2]. kappa_prev, & ! The value of kappa at the start of the current iteration [Z2 T-1 ~> m2 s-1]. TKE_prev ! The value of TKE at the start of the current iteration [Z2 T-2 ~> m2 s-2]. - real, dimension(nz+1,1:max_debug_itt) :: & - tke_it1, kappa_it1, kprev_it1, & ! Various values from each iteration. - dkappa_it1, K_Q_it1, d_dkappa_it1, dkappa_norm_it1 - integer :: it2 -#endif c_N2 = CS%C_N**2 ; c_S2 = CS%C_S**2 q0 = CS%TKE_bg ; kappa0 = CS%kappa_0 @@ -1529,7 +1345,7 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & ! TKE_decay(K) = c_n*sqrt(N2(K)) + c_s*sqrt(S2(K)) ! The expression in JHL. TKE_decay(K) = sqrt(c_n2*N2(K) + c_s2*S2(K)) if ((kappa(K) > 0.0) .and. (K_Q(K) > 0.0)) then - TKE(K) = kappa(K) / K_Q(K) + TKE(K) = kappa(K) / K_Q(K) ! Perhaps take the max with TKE_min else TKE(K) = TKE_min endif @@ -1564,9 +1380,7 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & ! Calculate TKE ! ---------------------------------------------------- -#ifdef DEBUG - do K=1,nz+1 ; kappa_prev(K) = kappa(K) ; TKE_prev(K) = TKE(K) ; enddo -#endif + if (debug_soln) then ; do K=1,nz+1 ; kappa_prev(K) = kappa(K) ; TKE_prev(K) = TKE(K) ; enddo ; endif if (.not.do_Newton) then ! Use separate steps of the TKE and kappa equations, that are @@ -1792,25 +1606,20 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & dQ(ke_kappa+1) = dQ(ke_kappa+1) / (1.0 - cQ(ke_kappa+2)*e1(ke_kappa+2)) TKE(ke_kappa+1) = max(TKE(ke_kappa+1) + dQ(ke_kappa+1), TKE_min) do k=ke_kappa+2,nz+1 -#ifdef DEBUG - if (K < nz+1) then + if (debug_soln .and. (K < nz+1)) then ! Ignore this source? aQ(k) = (0.5*(kappa(K)+kappa(K+1))+kappa0) * Idz(k) - tke_src_norm = (dz_Int(K) * (kappa0*S2(K) - (TKE(K)-q0)*TKE_decay(K)) - & - (aQ(k) * (TKE(K) - TKE(K+1)) - aQ(k-1) * (TKE(K-1) - TKE(K))) ) / & - (aQ(k) + (aQ(k-1) + dz_Int(K)*TKE_decay(K))) + ! tke_src_norm = (dz_Int(K) * (kappa0*S2(K) - (TKE(K)-q0)*TKE_decay(K)) - & + ! (aQ(k) * (TKE(K) - TKE(K+1)) - aQ(k-1) * (TKE(K-1) - TKE(K))) ) / & + ! (aQ(k) + (aQ(k-1) + dz_Int(K)*TKE_decay(K))) endif -#endif dK(K) = 0.0 ! Ensure that TKE+dQ will not drop below 0.5*TKE. dQ(K) = max(e1(K)*dQ(K-1),-0.5*TKE(K)) TKE(K) = max(TKE(K) + dQ(K), TKE_min) if (abs(dQ(K)) < roundoff*TKE(K)) exit enddo -#ifdef DEBUG - do K2=K+1,ke_kappa_prev+1 ; dQ(K2) = 0.0 ; dK(K2) = 0.0 ; enddo - do K=K2,nz+1 ; if (dQ(K) == 0.0) exit ; dQ(K) = 0.0 ; dK(K) = 0.0 ; enddo -#endif + if (debug_soln) then ; do K2=K+1,nz+1 ; dQ(K2) = 0.0 ; dK(K2) = 0.0 ; enddo ; endif endif if (.not. abort_Newton) then do K=ke_kappa,2,-1 @@ -1837,10 +1646,9 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & dK(1) = 0.0 endif -#ifdef DEBUG ! Check these solutions for consistency. ! The unit conversions here have not been carefully tested. - do K=2,nz + if (debug_soln) then ; do K=2,nz ! In these equations, K_err_lin and Q_err_lin should be at round-off levels ! compared with the dominant terms, perhaps, dz_Int*I_Ld2*kappa and ! dz_Int*TKE_decay*TKE. The exception is where, either 1) the decay term has been @@ -1863,8 +1671,8 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & 0.5*(TKE_prev(K)-TKE_prev(K+1))*Idz(k) * (dK(K) + dK(K+1)) - & 0.5*(TKE_prev(K)-TKE_prev(K-1))*Idz(k-1)* (dK(K-1) + dK(K)) + & dz_Int(K) * (dK(K) * (S2(K) - N2(K)) - dQ(K)*TKE_decay(K)) - enddo -#endif + enddo ; endif + endif ! End of the Newton's method solver. ! Test kappa for convergence... @@ -1904,34 +1712,10 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & do K=2,nz ; K_Q(K) = kappa(K) / max(TKE(K), TKE_min) ; enddo endif -#ifdef DEBUG - if (itt <= max_debug_itt) then - do K=1,nz+1 - kprev_it1(K,itt) = kappa_prev(K) - kappa_it1(K,itt) = kappa(K) ; tke_it1(K,itt) = tke(K) - dkappa_it1(K,itt) = kappa(K) - kappa_prev(K) - dkappa_norm_it1(K,itt) = (kappa(K) - kappa_prev(K)) / & - (kappa0 + 0.5*(kappa(K) + kappa_prev(K))) - K_Q_it1(K,itt) = kappa(K) / max(TKE(K),TKE_min) - d_dkappa_it1(K,itt) = 0.0 - if (itt > 1) then ; if (abs(dkappa_it1(K,itt-1)) > 1e-20*US%m2_s_to_Z2_T) & - d_dkappa_it1(K,itt) = dkappa_it1(K,itt) / dkappa_it1(K,itt-1) - endif - enddo - endif -#endif - if (within_tolerance) exit enddo -#ifdef DEBUG - do it2=itt+1,max_debug_itt ; do K=1,nz+1 - kprev_it1(K,it2) = 0.0 ; kappa_it1(K,it2) = 0.0 ; tke_it1(K,it2) = 0.0 - dkappa_it1(K,it2) = 0.0 ; K_Q_it1(K,it2) = 0.0 ; d_dkappa_it1(K,it2) = 0.0 - enddo ; enddo -#endif - if (do_Newton) then ! K_Q needs to be calculated. do K=1,ks_kappa-1 ; K_Q(K) = 0.0 ; enddo do K=ks_kappa,ke_kappa ; K_Q(K) = kappa(K) / TKE(K) ; enddo @@ -1975,8 +1759,9 @@ function kappa_shear_init(Time, G, GV, US, param_file, diag, CS) ! Local variables logical :: merge_mixedlayer -! This include declares and sets the variable "version". -#include "version_variable.h" + logical :: just_read ! If true, this module is not used, so only read the parameters. + ! This include declares and sets the variable "version". +# include "version_variable.h" character(len=40) :: mdl = "MOM_kappa_shear" ! This module's name. real :: kappa_0_unscaled ! The value of kappa_0 in MKS units [m2 s-1] real :: KD_normal ! The KD of the main model, read here only as a parameter @@ -1999,68 +1784,72 @@ function kappa_shear_init(Time, G, GV, US, param_file, diag, CS) ! subgridscale inhomogeneity into account. ! Set default, read and log parameters + call get_param(param_file, mdl, "USE_JACKSON_PARAM", kappa_shear_init, default=.false., do_not_log=.true.) call log_version(param_file, mdl, version, & - "Parameterization of shear-driven turbulence following Jackson, Hallberg and Legg, JPO 2008") + "Parameterization of shear-driven turbulence following Jackson, Hallberg and Legg, JPO 2008", & + log_to_all=.true., debugging=kappa_shear_init, all_default=.not.kappa_shear_init) call get_param(param_file, mdl, "USE_JACKSON_PARAM", kappa_shear_init, & "If true, use the Jackson-Hallberg-Legg (JPO 2008) "//& "shear mixing parameterization.", default=.false.) + just_read = .not.kappa_shear_init call get_param(param_file, mdl, "VERTEX_SHEAR", CS%KS_at_vertex, & "If true, do the calculations of the shear-driven mixing "//& "at the cell vertices (i.e., the vorticity points).", & - default=.false.) + default=.false., do_not_log=just_read) call get_param(param_file, mdl, "RINO_CRIT", CS%RiNo_crit, & "The critical Richardson number for shear mixing.", & - units="nondim", default=0.25) + units="nondim", default=0.25, do_not_log=just_read) call get_param(param_file, mdl, "SHEARMIX_RATE", CS%Shearmix_rate, & "A nondimensional rate scale for shear-driven entrainment. "//& "Jackson et al find values in the range of 0.085-0.089.", & - units="nondim", default=0.089) + units="nondim", default=0.089, do_not_log=just_read) call get_param(param_file, mdl, "MAX_RINO_IT", CS%max_RiNo_it, & "The maximum number of iterations that may be used to "//& "estimate the Richardson number driven mixing.", & - units="nondim", default=50) + units="nondim", default=50, do_not_log=just_read) call get_param(param_file, mdl, "KD", KD_normal, default=0.0, do_not_log=.true.) call get_param(param_file, mdl, "KD_KAPPA_SHEAR_0", CS%kappa_0, & "The background diffusivity that is used to smooth the "//& "density and shear profiles before solving for the "//& "diffusivities. The default is the greater of KD and 1e-7 m2 s-1.", & - units="m2 s-1", default=max(KD_normal, 1.0e-7), scale=US%m2_s_to_Z2_T, unscaled=kappa_0_unscaled) + units="m2 s-1", default=max(KD_normal, 1.0e-7), scale=US%m2_s_to_Z2_T, & + unscaled=kappa_0_unscaled, do_not_log=just_read) call get_param(param_file, mdl, "KD_TRUNC_KAPPA_SHEAR", CS%kappa_trunc, & "The value of shear-driven diffusivity that is considered negligible "//& "and is rounded down to 0. The default is 1% of KD_KAPPA_SHEAR_0.", & - units="m2 s-1", default=0.01*kappa_0_unscaled, scale=US%m2_s_to_Z2_T) + units="m2 s-1", default=0.01*kappa_0_unscaled, scale=US%m2_s_to_Z2_T, do_not_log=just_read) call get_param(param_file, mdl, "FRI_CURVATURE", CS%FRi_curvature, & "The nondimensional curvature of the function of the "//& "Richardson number in the kappa source term in the "//& - "Jackson et al. scheme.", units="nondim", default=-0.97) + "Jackson et al. scheme.", units="nondim", default=-0.97, do_not_log=just_read) call get_param(param_file, mdl, "TKE_N_DECAY_CONST", CS%C_N, & "The coefficient for the decay of TKE due to "//& "stratification (i.e. proportional to N*tke). "//& "The values found by Jackson et al. are 0.24-0.28.", & - units="nondim", default=0.24) + units="nondim", default=0.24, do_not_log=just_read) ! call get_param(param_file, mdl, "LAYER_KAPPA_STAGGER", CS%layer_stagger, & -! default=.false.) +! default=.false., do_not_log=just_read) call get_param(param_file, mdl, "TKE_SHEAR_DECAY_CONST", CS%C_S, & "The coefficient for the decay of TKE due to shear (i.e. "//& "proportional to |S|*tke). The values found by Jackson "//& - "et al. are 0.14-0.12.", units="nondim", default=0.14) + "et al. are 0.14-0.12.", units="nondim", default=0.14, do_not_log=just_read) call get_param(param_file, mdl, "KAPPA_BUOY_SCALE_COEF", CS%lambda, & "The coefficient for the buoyancy length scale in the "//& "kappa equation. The values found by Jackson et al. are "//& - "in the range of 0.81-0.86.", units="nondim", default=0.82) + "in the range of 0.81-0.86.", units="nondim", default=0.82, do_not_log=just_read) call get_param(param_file, mdl, "KAPPA_N_OVER_S_SCALE_COEF2", CS%lambda2_N_S, & "The square of the ratio of the coefficients of the "//& "buoyancy and shear scales in the diffusivity equation, "//& "Set this to 0 (the default) to eliminate the shear scale. "//& "This is only used if USE_JACKSON_PARAM is true.", & - units="nondim", default=0.0) + units="nondim", default=0.0, do_not_log=just_read) call get_param(param_file, mdl, "KAPPA_SHEAR_TOL_ERR", CS%kappa_tol_err, & "The fractional error in kappa that is tolerated. "//& "Iteration stops when changes between subsequent "//& "iterations are smaller than this everywhere in a "//& "column. The peak diffusivities usually converge most "//& "rapidly, and have much smaller errors than this.", & - units="nondim", default=0.1) + units="nondim", default=0.1, do_not_log=just_read) call get_param(param_file, mdl, "TKE_BACKGROUND", CS%TKE_bg, & "A background level of TKE used in the first iteration "//& "of the kappa equation. TKE_BACKGROUND could be 0.", & @@ -2070,40 +1859,40 @@ function kappa_shear_init(Time, G, GV, US, param_file, diag, CS) "massive layers in this calculation. The default is "//& "true and I can think of no good reason why it should "//& "be false. This is only used if USE_JACKSON_PARAM is true.", & - default=.true.) + default=.true., do_not_log=just_read) call get_param(param_file, mdl, "MAX_KAPPA_SHEAR_IT", CS%max_KS_it, & "The maximum number of iterations that may be used to "//& "estimate the time-averaged diffusivity.", units="nondim", & - default=13) + default=13, do_not_log=just_read) call get_param(param_file, mdl, "PRANDTL_TURB", CS%Prandtl_turb, & - "The turbulent Prandtl number applied to shear "//& - "instability.", units="nondim", default=1.0, do_not_log=.true.) + "The turbulent Prandtl number applied to shear instability.", & + units="nondim", default=1.0, do_not_log=.true.) call get_param(param_file, mdl, "VEL_UNDERFLOW", CS%vel_underflow, & - "A negligibly small velocity magnitude below which velocity "//& - "components are set to 0. A reasonable value might be "//& - "1e-30 m/s, which is less than an Angstrom divided by "//& - "the age of the universe.", units="m s-1", default=0.0, scale=US%m_s_to_L_T) + "A negligibly small velocity magnitude below which velocity components are set "//& + "to 0. A reasonable value might be 1e-30 m/s, which is less than an "//& + "Angstrom divided by the age of the universe.", & + units="m s-1", default=0.0, scale=US%m_s_to_L_T, do_not_log=just_read) call get_param(param_file, mdl, "KAPPA_SHEAR_MAX_KAP_SRC_CHG", CS%kappa_src_max_chg, & "The maximum permitted increase in the kappa source within an iteration relative "//& "to the local source; this must be greater than 1. The lower limit for the "//& "permitted fractional decrease is (1 - 0.5/kappa_src_max_chg). These limits "//& "could perhaps be made dynamic with an improved iterative solver.", & - default=10.0, units="nondim") + default=10.0, units="nondim", do_not_log=just_read) call get_param(param_file, mdl, "DEBUG_KAPPA_SHEAR", CS%debug, & "If true, write debugging data for the kappa-shear code. \n"//& "Caution: this option is _very_ verbose and should only "//& "be used in single-column mode!", & - default=.false., debuggingParam=.true.) + default=.false., debuggingParam=.true., do_not_log=just_read) call get_param(param_file, mdl, "KAPPA_SHEAR_ITER_BUG", CS%dKdQ_iteration_bug, & "If true, use an older, dimensionally inconsistent estimate of the "//& "derivative of diffusivity with energy in the Newton's method iteration. "//& - "The bug causes undercorrections when dz > 1 m.", default=.false.) + "The bug causes undercorrections when dz > 1 m.", default=.false., do_not_log=just_read) call get_param(param_file, mdl, "KAPPA_SHEAR_ALL_LAYER_TKE_BUG", CS%all_layer_TKE_bug, & "If true, report back the latest estimate of TKE instead of the time average "//& "TKE when there is mass in all layers. Otherwise always report the time "//& "averaged TKE, as is currently done when there are some massless layers.", & - default=.false.) + default=.false., do_not_log=just_read) ! id_clock_KQ = cpu_clock_id('Ocean KS kappa_shear', grain=CLOCK_ROUTINE) ! id_clock_avg = cpu_clock_id('Ocean KS avg', grain=CLOCK_ROUTINE) ! id_clock_project = cpu_clock_id('Ocean KS project', grain=CLOCK_ROUTINE) @@ -2112,8 +1901,8 @@ function kappa_shear_init(Time, G, GV, US, param_file, diag, CS) CS%nkml = 1 if (GV%nkml>0) then call get_param(param_file, mdl, "KAPPA_SHEAR_MERGE_ML",merge_mixedlayer, & - "If true, combine the mixed layers together before "//& - "solving the kappa-shear equations.", default=.true.) + "If true, combine the mixed layers together before solving the "//& + "kappa-shear equations.", default=.true., do_not_log=just_read) if (merge_mixedlayer) CS%nkml = GV%nkml endif @@ -2122,16 +1911,10 @@ function kappa_shear_init(Time, G, GV, US, param_file, diag, CS) CS%diag => diag - CS%id_Kd_shear = register_diag_field('ocean_model','Kd_shear',diag%axesTi,Time, & + CS%id_Kd_shear = register_diag_field('ocean_model','Kd_shear', diag%axesTi, Time, & 'Shear-driven Diapycnal Diffusivity', 'm2 s-1', conversion=US%Z2_T_to_m2_s) - CS%id_TKE = register_diag_field('ocean_model','TKE_shear',diag%axesTi,Time, & + CS%id_TKE = register_diag_field('ocean_model','TKE_shear', diag%axesTi, Time, & 'Shear-driven Turbulent Kinetic Energy', 'm2 s-2', conversion=US%Z_to_m**2*US%s_to_T**2) -#ifdef ADD_DIAGNOSTICS - CS%id_ILd2 = register_diag_field('ocean_model','ILd2_shear',diag%axesTi,Time, & - 'Inverse kappa decay scale at interfaces', 'm-2', conversion=US%m_to_Z**2) - CS%id_dz_Int = register_diag_field('ocean_model','dz_Int_shear',diag%axesTi,Time, & - 'Finite volume thickness of interfaces', 'm', conversion=US%Z_to_m) -#endif end function kappa_shear_init diff --git a/src/parameterizations/vertical/MOM_regularize_layers.F90 b/src/parameterizations/vertical/MOM_regularize_layers.F90 index 56d16a8613..f21faa359d 100644 --- a/src/parameterizations/vertical/MOM_regularize_layers.F90 +++ b/src/parameterizations/vertical/MOM_regularize_layers.F90 @@ -18,7 +18,6 @@ module MOM_regularize_layers implicit none ; private #include -#undef DEBUG_CODE public regularize_layers, regularize_layers_init @@ -58,18 +57,6 @@ module MOM_regularize_layers integer :: id_def_rat = -1 !< A diagnostic ID logical :: allow_clocks_in_omp_loops !< If true, clocks can be called from inside loops that !! can be threaded. To run with multiple threads, set to False. -#ifdef DEBUG_CODE - !>@{ Diagnostic IDs - integer :: id_def_rat_2 = -1, id_def_rat_3 = -1 - integer :: id_def_rat_u = -1, id_def_rat_v = -1 - integer :: id_e1 = -1, id_e2 = -1, id_e3 = -1 - integer :: id_def_rat_u_1b = -1, id_def_rat_v_1b = -1 - integer :: id_def_rat_u_2 = -1, id_def_rat_u_2b = -1 - integer :: id_def_rat_v_2 = -1, id_def_rat_v_2b = -1 - integer :: id_def_rat_u_3 = -1, id_def_rat_u_3b = -1 - integer :: id_def_rat_v_3 = -1, id_def_rat_v_3b = -1 - !>@} -#endif end type regularize_layers_CS !>@{ Clock IDs @@ -109,10 +96,8 @@ subroutine regularize_layers(h, tv, dt, ea, eb, G, GV, US, CS) if (.not. associated(CS)) call MOM_error(FATAL, "MOM_regularize_layers: "//& "Module must be initialized before it is used.") - if (CS%regularize_surface_layers) & - call pass_var(h, G%Domain, clock=id_clock_pass) - if (CS%regularize_surface_layers) then + call pass_var(h, G%Domain, clock=id_clock_pass) call regularize_surface(h, tv, dt, ea, eb, G, GV, US, CS) endif @@ -150,17 +135,6 @@ subroutine regularize_surface(h, tv, dt, ea, eb, G, GV, US, CS) real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: & e ! The interface depths [H ~> m or kg m-2], positive upward. -#ifdef DEBUG_CODE - real, dimension(SZIB_(G),SZJ_(G)) :: & - def_rat_u_1b, def_rat_u_2, def_rat_u_2b, def_rat_u_3, def_rat_u_3b - real, dimension(SZI_(G),SZJB_(G)) :: & - def_rat_v_1b, def_rat_v_2, def_rat_v_2b, def_rat_v_3, def_rat_v_3b - real, dimension(SZI_(G),SZJB_(G)) :: & - def_rat_h2, def_rat_h3 - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: & - ef ! The filtered interface depths [H ~> m or kg m-2], positive upward. -#endif - real, dimension(SZI_(G),SZK_(G)+1) :: & e_filt, e_2d ! The interface depths [H ~> m or kg m-2], positive upward. real, dimension(SZI_(G),SZK_(G)) :: & @@ -231,12 +205,6 @@ subroutine regularize_surface(h, tv, dt, ea, eb, G, GV, US, CS) h_neglect = GV%H_subroundoff debug = (debug .or. CS%debug) -#ifdef DEBUG_CODE - debug = .true. - if (CS%id_def_rat_2 > 0) then ! Calculate over a slightly larger domain. - is = G%isc-1 ; ie = G%iec+1 ; js = G%jsc-1 ; je = G%jec+1 - endif -#endif I_dtol = 1.0 / max(CS%h_def_tol2 - CS%h_def_tol1, 1e-40) I_dtol34 = 1.0 / max(CS%h_def_tol4 - CS%h_def_tol3, 1e-40) @@ -251,11 +219,8 @@ subroutine regularize_surface(h, tv, dt, ea, eb, G, GV, US, CS) e(i,j,K+1) = e(i,j,K) - h(i,j,k) enddo ; enddo ; enddo -#ifdef DEBUG_CODE - call find_deficit_ratios(e, def_rat_u, def_rat_v, G, GV, CS, def_rat_u_1b, def_rat_v_1b, 1, h) -#else call find_deficit_ratios(e, def_rat_u, def_rat_v, G, GV, CS, h=h) -#endif + ! Determine which columns are problematic do j=js,je ; do_j(j) = .false. ; enddo do j=js,je ; do i=is,ie @@ -264,49 +229,6 @@ subroutine regularize_surface(h, tv, dt, ea, eb, G, GV, US, CS) if (def_rat_h(i,j) > CS%h_def_tol1) do_j(j) = .true. enddo ; enddo -#ifdef DEBUG_CODE - if ((CS%id_def_rat_3 > 0) .or. (CS%id_e3 > 0) .or. & - (CS%id_def_rat_u_3 > 0) .or. (CS%id_def_rat_u_3b > 0) .or. & - (CS%id_def_rat_v_3 > 0) .or. (CS%id_def_rat_v_3b > 0) ) then - do j=js-1,je+1 ; do i=is-1,ie+1 - ef(i,j,1) = 0.0 - enddo ; enddo - do K=2,nz+1 ; do j=js,je ; do i=is,ie - if (G%mask2dCu(I,j) <= 0.0) then ; e_e = e(i,j,K) ; else - e_e = max(e(i+1,j,K) + min(e(i,j,K) - e(i+1,j,nz+1), 0.0), e(i,j,nz+1)) - endif - if (G%mask2dCu(I-1,j) <= 0.0) then ; e_w = e(i,j,K) ; else - e_w = max(e(i-1,j,K) + min(e(i,j,K) - e(i-1,j,nz+1), 0.0), e(i,j,nz+1)) - endif - if (G%mask2dCv(i,J) <= 0.0) then ; e_n = e(i,j,K) ; else - e_n = max(e(i,j+1,K) + min(e(i,j,K) - e(i,j+1,nz+1), 0.0), e(i,j,nz+1)) - endif - if (G%mask2dCv(i,J-1) <= 0.0) then ; e_s = e(i,j,K) ; else - e_s = max(e(i,j-1,K) + min(e(i,j,K) - e(i,j-1,nz+1), 0.0), e(i,j,nz+1)) - endif - - wt = 1.0 - ef(i,j,k) = (1.0 - 0.5*wt) * e(i,j,K) + & - wt * 0.125 * ((e_e + e_w) + (e_n + e_s)) - enddo ; enddo ; enddo - call find_deficit_ratios(ef, def_rat_u_3, def_rat_v_3, G, GV, CS, def_rat_u_3b, def_rat_v_3b) - - ! Determine which columns are problematic - do j=js,je ; do i=is,ie - def_rat_h3(i,j) = max(def_rat_u_3(I-1,j), def_rat_u_3(I,j), & - def_rat_v_3(i,J-1), def_rat_v_3(i,J)) - enddo ; enddo - - if (CS%id_e3 > 0) call post_data(CS%id_e3, ef, CS%diag) - if (CS%id_def_rat_3 > 0) call post_data(CS%id_def_rat_3, def_rat_h3, CS%diag) - if (CS%id_def_rat_u_3 > 0) call post_data(CS%id_def_rat_u_3, def_rat_u_3, CS%diag) - if (CS%id_def_rat_u_3b > 0) call post_data(CS%id_def_rat_u_3b, def_rat_u_3b, CS%diag) - if (CS%id_def_rat_v_3 > 0) call post_data(CS%id_def_rat_v_3, def_rat_v_3, CS%diag) - if (CS%id_def_rat_v_3b > 0) call post_data(CS%id_def_rat_v_3b, def_rat_v_3b, CS%diag) - endif -#endif - - ! Now restructure the layers. !$OMP parallel do default(private) shared(is,ie,js,je,nz,do_j,def_rat_h,CS,nkmb,G,GV,US, & !$OMP e,I_dtol,h,tv,debug,h_neglect,p_ref_cv,ea, & @@ -684,40 +606,6 @@ subroutine regularize_surface(h, tv, dt, ea, eb, G, GV, US, CS) if (CS%id_def_rat > 0) call post_data(CS%id_def_rat, def_rat_h, CS%diag) -#ifdef DEBUG_CODE - if (CS%id_e1 > 0) call post_data(CS%id_e1, e, CS%diag) - if (CS%id_def_rat_u > 0) call post_data(CS%id_def_rat_u, def_rat_u, CS%diag) - if (CS%id_def_rat_u_1b > 0) call post_data(CS%id_def_rat_u_1b, def_rat_u_1b, CS%diag) - if (CS%id_def_rat_v > 0) call post_data(CS%id_def_rat_v, def_rat_v, CS%diag) - if (CS%id_def_rat_v_1b > 0) call post_data(CS%id_def_rat_v_1b, def_rat_v_1b, CS%diag) - - if ((CS%id_def_rat_2 > 0) .or. & - (CS%id_def_rat_u_2 > 0) .or. (CS%id_def_rat_u_2b > 0) .or. & - (CS%id_def_rat_v_2 > 0) .or. (CS%id_def_rat_v_2b > 0) ) then - do j=js-1,je+1 ; do i=is-1,ie+1 - e(i,j,1) = 0.0 - enddo ; enddo - do K=1,nz ; do j=js-1,je+1 ; do i=is-1,ie+1 - e(i,j,K+1) = e(i,j,K) - h(i,j,k) - enddo ; enddo ; enddo - - call find_deficit_ratios(e, def_rat_u_2, def_rat_v_2, G, GV, CS, def_rat_u_2b, def_rat_v_2b, h=h) - - ! Determine which columns are problematic - do j=js,je ; do i=is,ie - def_rat_h2(i,j) = max(def_rat_u_2(I-1,j), def_rat_u_2(I,j), & - def_rat_v_2(i,J-1), def_rat_v_2(i,J)) - enddo ; enddo - - if (CS%id_def_rat_2 > 0) call post_data(CS%id_def_rat_2, def_rat_h2, CS%diag) - if (CS%id_e2 > 0) call post_data(CS%id_e2, e, CS%diag) - if (CS%id_def_rat_u_2 > 0) call post_data(CS%id_def_rat_u_2, def_rat_u_2, CS%diag) - if (CS%id_def_rat_u_2b > 0) call post_data(CS%id_def_rat_u_2b, def_rat_u_2b, CS%diag) - if (CS%id_def_rat_v_2 > 0) call post_data(CS%id_def_rat_v_2, def_rat_v_2, CS%diag) - if (CS%id_def_rat_v_2b > 0) call post_data(CS%id_def_rat_v_2b, def_rat_v_2b, CS%diag) - endif -#endif - end subroutine regularize_surface !> This subroutine determines the amount by which the harmonic mean @@ -891,6 +779,7 @@ subroutine regularize_layers_init(Time, G, GV, param_file, diag, CS) character(len=40) :: mdl = "MOM_regularize_layers" ! This module's name. logical :: use_temperature logical :: default_2018_answers + logical :: just_read integer :: isd, ied, jsd, jed isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed @@ -904,38 +793,42 @@ subroutine regularize_layers_init(Time, G, GV, param_file, diag, CS) CS%Time => Time ! Set default, read and log parameters - call log_version(param_file, mdl, version, "") + call get_param(param_file, mdl, "REGULARIZE_SURFACE_LAYERS", CS%regularize_surface_layers, & + default=.false., do_not_log=.true.) + call log_version(param_file, mdl, version, "", all_default=.not.CS%regularize_surface_layers) call get_param(param_file, mdl, "REGULARIZE_SURFACE_LAYERS", CS%regularize_surface_layers, & "If defined, vertically restructure the near-surface "//& "layers when they have too much lateral variations to "//& "allow for sensible lateral barotropic transports.", & default=.false.) + just_read = .not.CS%regularize_surface_layers if (CS%regularize_surface_layers) then call get_param(param_file, mdl, "REGULARIZE_SURFACE_DETRAIN", CS%reg_sfc_detrain, & "If true, allow the buffer layers to detrain into the "//& "interior as a part of the restructuring when "//& - "REGULARIZE_SURFACE_LAYERS is true.", default=.true.) - call get_param(param_file, mdl, "REG_SFC_DENSE_MATCH_TOLERANCE", CS%density_match_tol, & + "REGULARIZE_SURFACE_LAYERS is true.", default=.true., do_not_log=just_read) + call get_param(param_file, mdl, "REG_SFC_DENSE_MATCH_TOLERANCE", CS%density_match_tol, & "A relative tolerance for how well the densities must match with the target "//& "densities during detrainment when regularizing the near-surface layers. The "//& - "default of 0.6 gives 20% overlaps in density", units="nondim", default=0.6) + "default of 0.6 gives 20% overlaps in density", & + units="nondim", default=0.6, do_not_log=just_read) call get_param(param_file, mdl, "DEFAULT_2018_ANSWERS", default_2018_answers, & "This sets the default value for the various _2018_ANSWERS parameters.", & - default=.false.) + default=.false., do_not_log=just_read) call get_param(param_file, mdl, "REGULARIZE_LAYERS_2018_ANSWERS", CS%answers_2018, & - "If true, use the order of arithmetic and expressions that recover the "//& - "answers from the end of 2018. Otherwise, use updated and more robust "//& - "forms of the same expressions.", default=default_2018_answers) + "If true, use the order of arithmetic and expressions that recover the answers "//& + "from the end of 2018. Otherwise, use updated and more robust forms of the "//& + "same expressions.", default=default_2018_answers, do_not_log=just_read) endif call get_param(param_file, mdl, "HMIX_MIN", CS%Hmix_min, & - "The minimum mixed layer depth if the mixed layer depth "//& - "is determined dynamically.", units="m", default=0.0, scale=GV%m_to_H) + "The minimum mixed layer depth if the mixed layer depth is determined "//& + "dynamically.", units="m", default=0.0, scale=GV%m_to_H, do_not_log=just_read) call get_param(param_file, mdl, "REG_SFC_DEFICIT_TOLERANCE", CS%h_def_tol1, & "The value of the relative thickness deficit at which "//& "to start modifying the layer structure when "//& "REGULARIZE_SURFACE_LAYERS is true.", units="nondim", & - default=0.5) + default=0.5, do_not_log=just_read) CS%h_def_tol2 = 0.2 + 0.8*CS%h_def_tol1 CS%h_def_tol3 = 0.3 + 0.7*CS%h_def_tol1 CS%h_def_tol4 = 0.5 + 0.5*CS%h_def_tol1 @@ -943,55 +836,18 @@ subroutine regularize_layers_init(Time, G, GV, param_file, diag, CS) call get_param(param_file, mdl, "DEBUG", CS%debug, default=.false.) ! if (.not. CS%debug) & ! call get_param(param_file, mdl, "DEBUG_CONSERVATION", CS%debug, & -! "If true, monitor conservation and extrema.", default=.false.) +! "If true, monitor conservation and extrema.", default=.false., do_not_log=just_read) call get_param(param_file, mdl, "ALLOW_CLOCKS_IN_OMP_LOOPS", CS%allow_clocks_in_omp_loops, & "If true, clocks can be called from inside loops that can "//& "be threaded. To run with multiple threads, set to False.", & - default=.true.) + default=.true., do_not_log=just_read) + + if (.not.CS%regularize_surface_layers) return CS%id_def_rat = register_diag_field('ocean_model', 'deficit_ratio', diag%axesT1, & Time, 'Max face thickness deficit ratio', 'nondim') -#ifdef DEBUG_CODE - CS%id_def_rat_2 = register_diag_field('ocean_model', 'deficit_rat2', diag%axesT1, & - Time, 'Corrected thickness deficit ratio', 'nondim') - CS%id_def_rat_3 = register_diag_field('ocean_model', 'deficit_rat3', diag%axesT1, & - Time, 'Filtered thickness deficit ratio', 'nondim') - CS%id_e1 = register_diag_field('ocean_model', 'er_1', diag%axesTi, & - Time, 'Intial interface depths before remapping', 'm') - CS%id_e2 = register_diag_field('ocean_model', 'er_2', diag%axesTi, & - Time, 'Intial interface depths after remapping', 'm') - CS%id_e3 = register_diag_field('ocean_model', 'er_3', diag%axesTi, & - Time, 'Intial interface depths filtered', 'm') - - CS%id_def_rat_u = register_diag_field('ocean_model', 'defrat_u', diag%axesCu1, & - Time, 'U-point thickness deficit ratio', 'nondim') - CS%id_def_rat_u_1b = register_diag_field('ocean_model', 'defrat_u_1b', diag%axesCu1, & - Time, 'U-point 2-layer thickness deficit ratio', 'nondim') - CS%id_def_rat_u_2 = register_diag_field('ocean_model', 'defrat_u_2', diag%axesCu1, & - Time, 'U-point corrected thickness deficit ratio', 'nondim') - CS%id_def_rat_u_2b = register_diag_field('ocean_model', 'defrat_u_2b', diag%axesCu1, & - Time, 'U-point corrected 2-layer thickness deficit ratio', 'nondim') - CS%id_def_rat_u_3 = register_diag_field('ocean_model', 'defrat_u_3', diag%axesCu1, & - Time, 'U-point filtered thickness deficit ratio', 'nondim') - CS%id_def_rat_u_3b = register_diag_field('ocean_model', 'defrat_u_3b', diag%axesCu1, & - Time, 'U-point filtered 2-layer thickness deficit ratio', 'nondim') - - CS%id_def_rat_v = register_diag_field('ocean_model', 'defrat_v', diag%axesCv1, & - Time, 'V-point thickness deficit ratio', 'nondim') - CS%id_def_rat_v_1b = register_diag_field('ocean_model', 'defrat_v_1b', diag%axesCv1, & - Time, 'V-point 2-layer thickness deficit ratio', 'nondim') - CS%id_def_rat_v_2 = register_diag_field('ocean_model', 'defrat_v_2', diag%axesCv1, & - Time, 'V-point corrected thickness deficit ratio', 'nondim') - CS%id_def_rat_v_2b = register_diag_field('ocean_model', 'defrat_v_2b', diag%axesCv1, & - Time, 'V-point corrected 2-layer thickness deficit ratio', 'nondim') - CS%id_def_rat_v_3 = register_diag_field('ocean_model', 'defrat_v_3', diag%axesCv1, & - Time, 'V-point filtered thickness deficit ratio', 'nondim') - CS%id_def_rat_v_3b = register_diag_field('ocean_model', 'defrat_v_3b', diag%axesCv1, & - Time, 'V-point filtered 2-layer thickness deficit ratio', 'nondim') -#endif - if (CS%allow_clocks_in_omp_loops) then id_clock_EOS = cpu_clock_id('(Ocean regularize_layers EOS)', grain=CLOCK_ROUTINE) endif diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index f2d4484c78..86f828e5fa 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -30,6 +30,8 @@ module MOM_set_diffusivity use MOM_CVMix_ddiff, only : compute_ddiff_coeffs use MOM_bkgnd_mixing, only : calculate_bkgnd_mixing, bkgnd_mixing_init, bkgnd_mixing_cs use MOM_bkgnd_mixing, only : bkgnd_mixing_end, sfc_bkgnd_mixing +use MOM_open_boundary, only : ocean_OBC_type, OBC_segment_type, OBC_NONE +use MOM_open_boundary, only : OBC_DIRECTION_E, OBC_DIRECTION_W, OBC_DIRECTION_N, OBC_DIRECTION_S use MOM_string_functions, only : uppercase use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : thermo_var_ptrs, vertvisc_type, p3d @@ -1636,7 +1638,7 @@ end subroutine add_MLrad_diffusivity !> This subroutine calculates several properties related to bottom !! boundary layer turbulence. -subroutine set_BBL_TKE(u, v, h, fluxes, visc, G, GV, US, CS) +subroutine set_BBL_TKE(u, v, h, fluxes, visc, G, GV, US, CS, OBC) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type @@ -1650,6 +1652,7 @@ subroutine set_BBL_TKE(u, v, h, fluxes, visc, G, GV, US, CS) type(vertvisc_type), intent(in) :: visc !< Structure containing vertical viscosities, bottom !! boundary layer properies, and related fields. type(set_diffusivity_CS), pointer :: CS !< Diffusivity control structure + type(ocean_OBC_type), optional, pointer :: OBC !< Open boundaries control structure. ! This subroutine calculates several properties related to bottom ! boundary layer turbulence. @@ -1674,6 +1677,15 @@ subroutine set_BBL_TKE(u, v, h, fluxes, visc, G, GV, US, CS) logical :: domore, do_i(SZI_(G)) integer :: i, j, k, is, ie, js, je, nz + logical :: local_open_u_BC, local_open_v_BC + + local_open_u_BC = .false. + local_open_v_BC = .false. + if (present(OBC)) then ; if (associated(OBC)) then + local_open_u_BC = OBC%open_u_BCs_exist_globally + local_open_v_BC = OBC%open_v_BCs_exist_globally + endif ; endif + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke if (.not.associated(CS)) call MOM_error(FATAL,"set_BBL_TKE: "//& @@ -1691,10 +1703,8 @@ subroutine set_BBL_TKE(u, v, h, fluxes, visc, G, GV, US, CS) cdrag_sqrt = sqrt(CS%cdrag) -!$OMP parallel default(none) shared(cdrag_sqrt,is,ie,js,je,nz,visc,CS,G,GV,US,vstar,h,v, & -!$OMP v2_bbl,u) & -!$OMP private(do_i,vhtot,htot,domore,hvel,uhtot,ustar,u2_bbl) -!$OMP do + !$OMP parallel default(shared) private(do_i,vhtot,htot,domore,hvel,uhtot,ustar,u2_bbl) + !$OMP do do J=js-1,je ! Determine ustar and the square magnitude of the velocity in the ! bottom boundary layer. Together these give the TKE source and @@ -1708,7 +1718,20 @@ subroutine set_BBL_TKE(u, v, h, fluxes, visc, G, GV, US, CS) do k=nz,1,-1 domore = .false. do i=is,ie ; if (do_i(i)) then - hvel = 0.5*GV%H_to_Z*(h(i,j,k) + h(i,j+1,k)) + if (local_open_v_BC) then + if (OBC%segment(OBC%segnum_v(i,J))%open) then + if (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_N) then + hvel = GV%H_to_Z*h(i,j,k) + else + hvel = GV%H_to_Z*h(i,j+1,k) + endif + else + hvel = 0.5*GV%H_to_Z*(h(i,j,k) + h(i,j+1,k)) + endif + else + hvel = 0.5*GV%H_to_Z*(h(i,j,k) + h(i,j+1,k)) + endif + if ((htot(i) + hvel) >= visc%bbl_thick_v(i,J)) then vhtot(i) = vhtot(i) + (visc%bbl_thick_v(i,J) - htot(i))*v(i,J,k) htot(i) = visc%bbl_thick_v(i,J) @@ -1727,7 +1750,7 @@ subroutine set_BBL_TKE(u, v, h, fluxes, visc, G, GV, US, CS) v2_bbl(i,J) = 0.0 endif ; enddo enddo -!$OMP do + !$OMP do do j=js,je do I=is-1,ie ; if ((G%mask2dCu(I,j) > 0.5) .and. (cdrag_sqrt*visc%bbl_thick_u(I,j) > 0.0)) then do_i(I) = .true. ; uhtot(I) = 0.0 ; htot(I) = 0.0 @@ -1737,7 +1760,20 @@ subroutine set_BBL_TKE(u, v, h, fluxes, visc, G, GV, US, CS) endif ; enddo do k=nz,1,-1 ; domore = .false. do I=is-1,ie ; if (do_i(I)) then - hvel = 0.5*GV%H_to_Z*(h(i,j,k) + h(i+1,j,k)) + if (local_open_u_BC) then + if (OBC%segment(OBC%segnum_u(I,j))%open) then + if (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_E) then + hvel = GV%H_to_Z*h(i,j,k) + else + hvel = GV%H_to_Z*h(i+1,j,k) + endif + else + hvel = 0.5*GV%H_to_Z*(h(i,j,k) + h(i+1,j,k)) + endif + else + hvel = 0.5*GV%H_to_Z*(h(i,j,k) + h(i+1,j,k)) + endif + if ((htot(I) + hvel) >= visc%bbl_thick_u(I,j)) then uhtot(I) = uhtot(I) + (visc%bbl_thick_u(I,j) - htot(I))*u(I,j,k) htot(I) = visc%bbl_thick_u(I,j) @@ -1769,7 +1805,7 @@ subroutine set_BBL_TKE(u, v, h, fluxes, visc, G, GV, US, CS) G%areaCv(i,J) * (vstar(i,J)*v2_bbl(i,J))) )*G%IareaT(i,j)) enddo enddo -!$OMP end parallel + !$OMP end parallel end subroutine set_BBL_TKE @@ -1982,7 +2018,7 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, int_tide_ "mixed layer code. This is only used if ML_RADIATION is true.", default=.true.) call get_param(param_file, mdl, "MSTAR", CS%mstar, & "The ratio of the friction velocity cubed to the TKE "//& - "input to the mixed layer.", "units=nondim", default=1.2) + "input to the mixed layer.", units="nondim", default=1.2) call get_param(param_file, mdl, "TKE_DECAY", CS%TKE_decay, & "The ratio of the natural Ekman depth to the TKE decay scale.", & units="nondim", default=2.5) diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index 4b0ead8b0d..262c1a83b8 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -249,8 +249,13 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, diag, CS) CS%diag => diag ! Read parameters + call get_param(param_file, mdl, "USE_CVMix_TIDAL", CS%use_CVMix_tidal, & + default=.false., do_not_log=.true.) + call get_param(param_file, mdl, "INT_TIDE_DISSIPATION", CS%int_tide_dissipation, & + default=CS%use_CVMix_tidal, do_not_log=.true.) call log_version(param_file, mdl, version, & - "Vertical Tidal Mixing Parameterization") + "Vertical Tidal Mixing Parameterization", & + all_default=.not.(CS%use_CVMix_tidal .or. CS%int_tide_dissipation)) call get_param(param_file, mdl, "USE_CVMix_TIDAL", CS%use_CVMix_tidal, & "If true, turns on tidal mixing via CVMix", & default=.false.) diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index 146acc4394..6e1fd8fac9 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -1571,7 +1571,7 @@ subroutine vertvisc_init(MIS, Time, G, GV, US, param_file, diag, ADp, dirs, & CS%diag => diag ; CS%ntrunc => ntrunc ; ntrunc = 0 ! Default, read and log parameters - call log_version(param_file, mdl, version, "") + call log_version(param_file, mdl, version, "", log_to_all=.true., debugging=.true.) call get_param(param_file, mdl, "DEFAULT_2018_ANSWERS", default_2018_answers, & "This sets the default value for the various _2018_ANSWERS parameters.", & default=.false.) diff --git a/src/tracer/MOM_generic_tracer.F90 b/src/tracer/MOM_generic_tracer.F90 index 3de6b4e0c6..7d2310b42f 100644 --- a/src/tracer/MOM_generic_tracer.F90 +++ b/src/tracer/MOM_generic_tracer.F90 @@ -1,12 +1,20 @@ +!> Drives the generic version of tracers TOPAZ and CFC and other GFDL BGC components module MOM_generic_tracer ! This file is part of MOM6. See LICENSE.md for the license. #include -#ifdef _USE_GENERIC_TRACER -#include +! The following macro is usually defined in but since MOM6 should not directly +! include files from FMS we replicate the macro lines here: +#ifdef NO_F2000 +#define _ALLOCATED associated +#else +#define _ALLOCATED allocated +#endif + + ! ### These imports should not reach into FMS directly ### use mpp_mod, only: stdout, mpp_error, FATAL,WARNING,NOTE use field_manager_mod, only: fm_get_index,fm_string_len @@ -46,6 +54,9 @@ module MOM_generic_tracer implicit none ; private + + !> An state hidden in module data that is very much not allowed in MOM6 + ! ### This needs to be fixed logical :: g_registered = .false. public register_MOM_generic_tracer, initialize_MOM_generic_tracer @@ -56,25 +67,24 @@ module MOM_generic_tracer public MOM_generic_tracer_min_max public MOM_generic_tracer_fluxes_accumulate + !> Control structure for generic tracers type, public :: MOM_generic_tracer_CS ; private - character(len = 200) :: IC_file ! The file in which the generic tracer initial values can - ! be found, or an empty string for internal initialization. - logical :: Z_IC_file ! If true, the generic_tracer IC_file is in Z-space. The default is false. - real :: tracer_IC_val = 0.0 ! The initial value assigned to tracers. - real :: tracer_land_val = -1.0 ! The values of tracers used where land is masked out. - logical :: tracers_may_reinit ! If true, tracers may go through the - ! initialization code if they are not found in the - ! restart files. - - type(diag_ctrl), pointer :: diag => NULL() ! A structure that is used to - ! regulate the timing of diagnostic output. - type(MOM_restart_CS), pointer :: restart_CSp => NULL() - - ! The following pointer will be directed to the first element of the - ! linked list of generic tracers. + character(len = 200) :: IC_file !< The file in which the generic tracer initial values can + !! be found, or an empty string for internal initialization. + logical :: Z_IC_file !< If true, the generic_tracer IC_file is in Z-space. The default is false. + real :: tracer_IC_val = 0.0 !< The initial value assigned to tracers. + real :: tracer_land_val = -1.0 !< The values of tracers used where land is masked out. + logical :: tracers_may_reinit !< If true, tracers may go through the + !! initialization code if they are not found in the restart files. + + type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to + !! regulate the timing of diagnostic output. + type(MOM_restart_CS), pointer :: restart_CSp => NULL() !< Restart control structure + + !> Pointer to the first element of the linked list of generic tracers. type(g_tracer_type), pointer :: g_tracer_list => NULL() - integer :: H_to_m !Auxiliary to access GV%H_to_m in routines that do not have access to GV + integer :: H_to_m !< Auxiliary to access GV%H_to_m in routines that do not have access to GV end type MOM_generic_tracer_CS @@ -820,7 +830,6 @@ subroutine end_MOM_generic_tracer(CS) endif end subroutine end_MOM_generic_tracer -#endif /* _USE_GENERIC_TRACER */ !---------------------------------------------------------------- ! Niki Zadeh ! diff --git a/src/tracer/MOM_lateral_boundary_diffusion.F90 b/src/tracer/MOM_lateral_boundary_diffusion.F90 index f244931376..4e038e7844 100644 --- a/src/tracer/MOM_lateral_boundary_diffusion.F90 +++ b/src/tracer/MOM_lateral_boundary_diffusion.F90 @@ -80,15 +80,16 @@ logical function lateral_boundary_diffusion_init(Time, G, param_file, diag, diab endif ! Log this module and master switch for turning it on/off + call get_param(param_file, mdl, "USE_LATERAL_BOUNDARY_DIFFUSION", lateral_boundary_diffusion_init, & + default=.false., do_not_log=.true.) call log_version(param_file, mdl, version, & - "This module implements lateral diffusion of tracers near boundaries") + "This module implements lateral diffusion of tracers near boundaries", & + all_default=.not.lateral_boundary_diffusion_init) call get_param(param_file, mdl, "USE_LATERAL_BOUNDARY_DIFFUSION", lateral_boundary_diffusion_init, & "If true, enables the lateral boundary tracer's diffusion module.", & default=.false.) - if (.not. lateral_boundary_diffusion_init) then - return - endif + if (.not. lateral_boundary_diffusion_init) return allocate(CS) CS%diag => diag diff --git a/src/tracer/MOM_neutral_diffusion.F90 b/src/tracer/MOM_neutral_diffusion.F90 index c3c46d85a8..4e05a44218 100644 --- a/src/tracer/MOM_neutral_diffusion.F90 +++ b/src/tracer/MOM_neutral_diffusion.F90 @@ -134,17 +134,17 @@ logical function neutral_diffusion_init(Time, G, US, param_file, diag, EOS, diab return endif - ! Log this module and master switch for turning it on/off + call get_param(param_file, mdl, "USE_NEUTRAL_DIFFUSION", neutral_diffusion_init, & + default=.false., do_not_log=.true.) call log_version(param_file, mdl, version, & - "This module implements neutral diffusion of tracers") + "This module implements neutral diffusion of tracers", & + all_default=.not.neutral_diffusion_init) call get_param(param_file, mdl, "USE_NEUTRAL_DIFFUSION", neutral_diffusion_init, & "If true, enables the neutral diffusion module.", & default=.false.) - if (.not.neutral_diffusion_init) then - return - endif + if (.not.neutral_diffusion_init) return allocate(CS) CS%diag => diag diff --git a/src/tracer/MOM_tracer_advect.F90 b/src/tracer/MOM_tracer_advect.F90 index 59131bf776..6a362d4fd5 100644 --- a/src/tracer/MOM_tracer_advect.F90 +++ b/src/tracer/MOM_tracer_advect.F90 @@ -382,7 +382,7 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & real, dimension(SZIB_(G)) :: & hlst, & ! Work variable [H L2 ~> m3 or kg]. Ihnew, & ! Work variable [H-1 L-2 ~> m-3 or kg-1]. - CFL ! A nondimensional work variable [nondim]. + CFL ! The absolute value of the advective upwind-cell CFL number [nondim]. real :: min_h ! The minimum thickness that can be realized during ! any of the passes [H ~> m or kg m-2]. real :: h_neglect ! A thickness that is so small it is usually lost @@ -459,13 +459,13 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & if (segment%direction == OBC_DIRECTION_W) then T_tmp(i,m) = segment%tr_Reg%Tr(m)%tres(i,j,k) else - T_tmp(I+1,m) = segment%tr_Reg%Tr(m)%tres(i,j,k) + T_tmp(i+1,m) = segment%tr_Reg%Tr(m)%tres(i,j,k) endif else if (segment%direction == OBC_DIRECTION_W) then T_tmp(i,m) = segment%tr_Reg%Tr(m)%OBC_inflow_conc else - T_tmp(I+1,m) = segment%tr_Reg%Tr(m)%OBC_inflow_conc + T_tmp(i+1,m) = segment%tr_Reg%Tr(m)%OBC_inflow_conc endif endif enddo @@ -757,7 +757,7 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & real, dimension(SZIB_(G)) :: & hlst, & ! Work variable [H L2 ~> m3 or kg]. Ihnew, & ! Work variable [H-1 L-2 ~> m-3 or kg-1]. - CFL ! A nondimensional work variable. + CFL ! The absolute value of the advective upwind-cell CFL number [nondim]. real :: min_h ! The minimum thickness that can be realized during ! any of the passes [H ~> m or kg m-2]. real :: h_neglect ! A thickness that is so small it is usually lost @@ -913,7 +913,7 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & endif ! Implementation of PPM-H3 - Tp = Tr(m)%t(i,j_up+1,k) ; Tc = Tr(m)%t(i,j_up,k) ; Tm = Tr(m)%t(i,j_up-1,k) + Tp = T_tmp(i,m,j_up+1) ; Tc = T_tmp(i,m,j_up) ; Tm = T_tmp(i,m,j_up-1) if (useHuynh) then aL = ( 5.*Tc + ( 2.*Tm - Tp ) )/6. ! H3 estimate @@ -955,7 +955,7 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & !aR = Tr(m)%t(i,j,k) + 0.5 * slope_y(i,m,j) !flux_y(i,m,J) = vhh(i,J)*(aR - 0.5 * slope_y(i,m,j)*CFL(i)) ! Alternative implementation of PLM - Tc = Tr(m)%t(i,j,k) + Tc = T_tmp(i,m,j) flux_y(i,m,J) = vhh(i,J)*( Tc + 0.5 * slope_y(i,m,j) * ( 1. - CFL(i) ) ) ! Original implementation of PLM !flux_y(i,m,J) = vhh(i,J)*(Tr(m)%t(i,j,k) + slope_y(i,m,j)*ts2(i)) @@ -968,7 +968,7 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & !aL = Tr(m)%t(i,j+1,k) - 0.5 * slope_y(i,m,j+1) !flux_y(i,m,J) = vhh(i,J)*( aL + 0.5 * slope_y(i,m,j+1)*CFL(i) ) ! Alternative implementation of PLM - Tc = Tr(m)%t(i,j+1,k) + Tc = T_tmp(i,m,j+1) flux_y(i,m,J) = vhh(i,J)*( Tc - 0.5 * slope_y(i,m,j+1) * ( 1. - CFL(i) ) ) ! Original implementation of PLM !flux_y(i,m,J) = vhh(i,J)*(Tr(m)%t(i,j+1,k) - slope_y(i,m,j+1)*ts2(i)) diff --git a/src/tracer/MOM_tracer_flow_control.F90 b/src/tracer/MOM_tracer_flow_control.F90 index a9bf9a03d9..5e9f01c7be 100644 --- a/src/tracer/MOM_tracer_flow_control.F90 +++ b/src/tracer/MOM_tracer_flow_control.F90 @@ -51,12 +51,10 @@ module MOM_tracer_flow_control use dyed_obc_tracer, only : register_dyed_obc_tracer, initialize_dyed_obc_tracer use dyed_obc_tracer, only : dyed_obc_tracer_column_physics use dyed_obc_tracer, only : dyed_obc_tracer_end, dyed_obc_tracer_CS -#ifdef _USE_GENERIC_TRACER use MOM_generic_tracer, only : register_MOM_generic_tracer, initialize_MOM_generic_tracer use MOM_generic_tracer, only : MOM_generic_tracer_column_physics, MOM_generic_tracer_surface_state use MOM_generic_tracer, only : end_MOM_generic_tracer, MOM_generic_tracer_get, MOM_generic_flux_init use MOM_generic_tracer, only : MOM_generic_tracer_stock, MOM_generic_tracer_min_max, MOM_generic_tracer_CS -#endif use pseudo_salt_tracer, only : register_pseudo_salt_tracer, initialize_pseudo_salt_tracer use pseudo_salt_tracer, only : pseudo_salt_tracer_column_physics, pseudo_salt_tracer_surface_state use pseudo_salt_tracer, only : pseudo_salt_stock, pseudo_salt_tracer_end, pseudo_salt_tracer_CS @@ -96,9 +94,7 @@ module MOM_tracer_flow_control type(oil_tracer_CS), pointer :: oil_tracer_CSp => NULL() type(advection_test_tracer_CS), pointer :: advection_test_tracer_CSp => NULL() type(OCMIP2_CFC_CS), pointer :: OCMIP2_CFC_CSp => NULL() -#ifdef _USE_GENERIC_TRACER type(MOM_generic_tracer_CS), pointer :: MOM_generic_tracer_CSp => NULL() -#endif type(pseudo_salt_tracer_CS), pointer :: pseudo_salt_tracer_CSp => NULL() type(boundary_impulse_tracer_CS), pointer :: boundary_impulse_tracer_CSp => NULL() type(dyed_obc_tracer_CS), pointer :: dyed_obc_tracer_CSp => NULL() @@ -132,13 +128,7 @@ subroutine call_tracer_flux_init(verbosity) if (use_OCMIP_CFCs) call flux_init_OCMIP2_CFC(verbosity=verbosity) if (use_MOM_generic_tracer) then -#ifdef _USE_GENERIC_TRACER call MOM_generic_flux_init(verbosity=verbosity) -#else - call MOM_error(FATAL, & - "call_tracer_flux_init: use_MOM_generic_tracer=.true. but MOM6 was "//& - "not compiled with _USE_GENERIC_TRACER") -#endif endif end subroutine call_tracer_flux_init @@ -217,12 +207,6 @@ subroutine call_tracer_register(HI, GV, US, param_file, CS, tr_Reg, restart_CS) "If true, use the dyed_obc_tracer tracer package.", & default=.false.) -#ifndef _USE_GENERIC_TRACER - if (CS%use_MOM_generic_tracer) call MOM_error(FATAL, & - "call_tracer_register: use_MOM_generic_tracer=.true. but MOM6 was "//& - "not compiled with _USE_GENERIC_TRACER") -#endif - ! Add other user-provided calls to register tracers for restarting here. Each ! tracer package registration call returns a logical false if it cannot be run ! for some reason. This then overrides the run-time selection from above. @@ -253,11 +237,9 @@ subroutine call_tracer_register(HI, GV, US, param_file, CS, tr_Reg, restart_CS) if (CS%use_OCMIP2_CFC) CS%use_OCMIP2_CFC = & register_OCMIP2_CFC(HI, GV, param_file, CS%OCMIP2_CFC_CSp, & tr_Reg, restart_CS) -#ifdef _USE_GENERIC_TRACER if (CS%use_MOM_generic_tracer) CS%use_MOM_generic_tracer = & register_MOM_generic_tracer(HI, GV, param_file, CS%MOM_generic_tracer_CSp, & tr_Reg, restart_CS) -#endif if (CS%use_pseudo_salt_tracer) CS%use_pseudo_salt_tracer = & register_pseudo_salt_tracer(HI, GV, param_file, CS%pseudo_salt_tracer_CSp, & tr_Reg, restart_CS) @@ -334,11 +316,9 @@ subroutine tracer_flow_control_init(restart, day, G, GV, US, h, param_file, diag if (CS%use_OCMIP2_CFC) & call initialize_OCMIP2_CFC(restart, day, G, GV, US, h, diag, OBC, CS%OCMIP2_CFC_CSp, & sponge_CSp) -#ifdef _USE_GENERIC_TRACER if (CS%use_MOM_generic_tracer) & call initialize_MOM_generic_tracer(restart, day, G, GV, US, h, param_file, diag, OBC, & CS%MOM_generic_tracer_CSp, sponge_CSp, ALE_sponge_CSp) -#endif if (CS%use_pseudo_salt_tracer) & call initialize_pseudo_salt_tracer(restart, day, G, GV, h, diag, OBC, CS%pseudo_salt_tracer_CSp, & sponge_CSp, tv) @@ -359,7 +339,6 @@ subroutine get_chl_from_model(Chl_array, G, CS) type(tracer_flow_control_CS), pointer :: CS !< The control structure returned by a !! previous call to call_tracer_register. -#ifdef _USE_GENERIC_TRACER if (CS%use_MOM_generic_tracer) then call MOM_generic_tracer_get('chl','field',Chl_array, CS%MOM_generic_tracer_CSp) else @@ -367,12 +346,6 @@ subroutine get_chl_from_model(Chl_array, G, CS) "that is unable to provide a sensible model-based value.\n"// & "CS%use_MOM_generic_tracer is false and no other viable options are on.") endif -#else - call MOM_error(FATAL, "get_chl_from_model was called in a configuration "// & - "that is unable to provide a sensible model-based value.\n"// & - "_USE_GENERIC_TRACER is undefined and no other options "//& - "are currently viable.") -#endif end subroutine get_chl_from_model @@ -488,7 +461,6 @@ subroutine call_tracer_column_fns(h_old, h_new, ea, eb, fluxes, Hml, dt, G, GV, G, GV, US, CS%OCMIP2_CFC_CSp, & evap_CFL_limit=evap_CFL_limit, & minimum_forcing_depth=minimum_forcing_depth) -#ifdef _USE_GENERIC_TRACER if (CS%use_MOM_generic_tracer) then if (US%QRZ_T_to_W_m2 /= 1.0) call MOM_error(FATAL, "MOM_generic_tracer_column_physics "//& "has not been written to permit dimensionsal rescaling. Set all 4 of the "//& @@ -498,7 +470,6 @@ subroutine call_tracer_column_fns(h_old, h_new, ea, eb, fluxes, Hml, dt, G, GV, evap_CFL_limit=evap_CFL_limit, & minimum_forcing_depth=minimum_forcing_depth) endif -#endif if (CS%use_pseudo_salt_tracer) & call pseudo_salt_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, & G, GV, US, CS%pseudo_salt_tracer_CSp, tv, debug, & @@ -544,7 +515,6 @@ subroutine call_tracer_column_fns(h_old, h_new, ea, eb, fluxes, Hml, dt, G, GV, if (CS%use_OCMIP2_CFC) & call OCMIP2_CFC_column_physics(h_old, h_new, ea, eb, fluxes, dt, & G, GV, US, CS%OCMIP2_CFC_CSp) -#ifdef _USE_GENERIC_TRACER if (CS%use_MOM_generic_tracer) then if (US%QRZ_T_to_W_m2 /= 1.0) call MOM_error(FATAL, "MOM_generic_tracer_column_physics "//& "has not been written to permit dimensionsal rescaling. Set all 4 of the "//& @@ -552,7 +522,6 @@ subroutine call_tracer_column_fns(h_old, h_new, ea, eb, fluxes, Hml, dt, G, GV, call MOM_generic_tracer_column_physics(h_old, h_new, ea, eb, fluxes, Hml, US%T_to_s*dt, & G, GV, CS%MOM_generic_tracer_CSp, tv, optics) endif -#endif if (CS%use_pseudo_salt_tracer) & call pseudo_salt_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, & G, GV, US, CS%pseudo_salt_tracer_CSp, tv, debug) @@ -661,7 +630,6 @@ subroutine call_tracer_stocks(h, stock_values, G, GV, CS, stock_names, stock_uni stock_values, set_pkg_name, max_ns, ns_tot, stock_names, stock_units) endif -#ifdef _USE_GENERIC_TRACER if (CS%use_MOM_generic_tracer) then ns = MOM_generic_tracer_stock(h, values, G, GV, CS%MOM_generic_tracer_CSp, & names, units, stock_index) @@ -673,7 +641,6 @@ subroutine call_tracer_stocks(h, stock_values, G, GV, CS, stock_names, stock_uni G, CS%MOM_generic_tracer_CSp,names, units) endif -#endif if (CS%use_pseudo_salt_tracer) then ns = pseudo_salt_stock(h, values, G, GV, CS%pseudo_salt_tracer_CSp, & names, units, stock_index) @@ -784,10 +751,8 @@ subroutine call_tracer_surface_state(sfc_state, h, G, CS) call advection_test_tracer_surface_state(sfc_state, h, G, CS%advection_test_tracer_CSp) if (CS%use_OCMIP2_CFC) & call OCMIP2_CFC_surface_state(sfc_state, h, G, CS%OCMIP2_CFC_CSp) -#ifdef _USE_GENERIC_TRACER if (CS%use_MOM_generic_tracer) & call MOM_generic_tracer_surface_state(sfc_state, h, G, CS%MOM_generic_tracer_CSp) -#endif end subroutine call_tracer_surface_state @@ -805,9 +770,7 @@ subroutine tracer_flow_control_end(CS) if (CS%use_oil) call oil_tracer_end(CS%oil_tracer_CSp) if (CS%use_advection_test_tracer) call advection_test_tracer_end(CS%advection_test_tracer_CSp) if (CS%use_OCMIP2_CFC) call OCMIP2_CFC_end(CS%OCMIP2_CFC_CSp) -#ifdef _USE_GENERIC_TRACER if (CS%use_MOM_generic_tracer) call end_MOM_generic_tracer(CS%MOM_generic_tracer_CSp) -#endif if (CS%use_pseudo_salt_tracer) call pseudo_salt_tracer_end(CS%pseudo_salt_tracer_CSp) if (CS%use_boundary_impulse_tracer) call boundary_impulse_tracer_end(CS%boundary_impulse_tracer_CSp) if (CS%use_dyed_obc_tracer) call dyed_obc_tracer_end(CS%dyed_obc_tracer_CSp) diff --git a/src/tracer/MOM_tracer_registry.F90 b/src/tracer/MOM_tracer_registry.F90 index 16ee280355..5097501b61 100644 --- a/src/tracer/MOM_tracer_registry.F90 +++ b/src/tracer/MOM_tracer_registry.F90 @@ -869,7 +869,7 @@ subroutine tracer_registry_init(param_file, Reg) else ; return ; endif ! Read all relevant parameters and write them to the model log. - call log_version(param_file, mdl, version, "") + call log_version(param_file, mdl, version, "", all_default=.true.) init_calls = init_calls + 1 if (init_calls > 1) then diff --git a/src/user/Kelvin_initialization.F90 b/src/user/Kelvin_initialization.F90 index a3215294fc..227c814b3c 100644 --- a/src/user/Kelvin_initialization.F90 +++ b/src/user/Kelvin_initialization.F90 @@ -242,20 +242,21 @@ subroutine Kelvin_set_OBC_data(OBC, CS, G, GV, US, h, Time) x = (x1 - CS%coast_offset1) * cosa + y1 * sina y = - (x1 - CS%coast_offset1) * sina + y1 * cosa if (CS%mode == 0) then - cff = sqrt(GV%g_Earth * 0.5 * (G%bathyT(i+1,j) + G%bathyT(i,j))) + ! Use inside bathymetry + cff = sqrt(GV%g_Earth * G%bathyT(i+1,j) ) val2 = fac * exp(- US%T_to_s*CS%F_0 * US%m_to_L*y / cff) segment%eta(I,j) = val2 * cos(omega * time_sec) segment%normal_vel_bt(I,j) = (val2 * (val1 * cff * cosa / & - (0.5 * (G%bathyT(i+1,j) + G%bathyT(i,j)))) ) + (G%bathyT(i+1,j) )) ) if (segment%nudged) then do k=1,nz segment%nudged_normal_vel(I,j,k) = (val2 * (val1 * cff * cosa / & - (0.5 * (G%bathyT(i+1,j) + G%bathyT(i,j)))) ) + (G%bathyT(i+1,j))) ) enddo elseif (segment%specified) then do k=1,nz segment%normal_vel(I,j,k) = (val2 * (val1 * cff * cosa / & - (0.5 * (G%bathyT(i+1,j) + G%bathyT(i,j)))) ) + (G%bathyT(i+1,j) )) ) segment%normal_trans(I,j,k) = segment%normal_vel(I,j,k) * h(i+1,j,k) * G%dyCu(I,j) enddo endif @@ -285,16 +286,16 @@ subroutine Kelvin_set_OBC_data(OBC, CS, G, GV, US, h, Time) y1 = 1000. * G%geoLatBu(I,J) x = (x1 - CS%coast_offset1) * cosa + y1 * sina y = - (x1 - CS%coast_offset1) * sina + y1 * cosa - cff =sqrt(GV%g_Earth * 0.5 * (G%bathyT(i+1,j) + G%bathyT(i,j))) + cff =sqrt(GV%g_Earth * G%bathyT(i+1,j) ) val2 = fac * exp(- US%T_to_s*CS%F_0 * US%m_to_L*y / cff) if (CS%mode == 0) then ; do k=1,nz segment%tangential_vel(I,J,k) = (val1 * val2 * cff * sina) / & - ( 0.25*((G%bathyT(i,j) + G%bathyT(i+1,j+1)) + (G%bathyT(i+1,j) + G%bathyT(i,j+1))) ) + ( 0.5*(G%bathyT(i+1,j+1) + G%bathyT(i+1,j) ) ) enddo ; endif enddo ; enddo endif - else + else ! Must be south isd = segment%HI%isd ; ied = segment%HI%ied JsdB = segment%HI%JsdB ; JedB = segment%HI%JedB do J=JsdB,JedB ; do i=isd,ied @@ -303,20 +304,20 @@ subroutine Kelvin_set_OBC_data(OBC, CS, G, GV, US, h, Time) x = (x1 - CS%coast_offset1) * cosa + y1 * sina y = - (x1 - CS%coast_offset1) * sina + y1 * cosa if (CS%mode == 0) then - cff = sqrt(GV%g_Earth * 0.5 * (G%bathyT(i,j+1) + G%bathyT(i,j))) + cff = sqrt(GV%g_Earth * G%bathyT(i,j+1) ) val2 = fac * exp(- 0.5 * (G%CoriolisBu(I,J) + G%CoriolisBu(I-1,J)) * US%m_to_L*y / cff) segment%eta(I,j) = val2 * cos(omega * time_sec) segment%normal_vel_bt(I,j) = US%L_T_to_m_s * (val1 * cff * sina / & - (0.5*(G%bathyT(i+1,j) + G%bathyT(i,j)))) * val2 + (G%bathyT(i,j+1) )) * val2 if (segment%nudged) then do k=1,nz segment%nudged_normal_vel(I,j,k) = US%L_T_to_m_s * (val1 * cff * sina / & - (0.5*(G%bathyT(i+1,j) + G%bathyT(i,j)))) * val2 + (G%bathyT(i,j+1) )) * val2 enddo elseif (segment%specified) then do k=1,nz segment%normal_vel(I,j,k) = US%L_T_to_m_s * (val1 * cff * sina / & - (0.5*(G%bathyT(i+1,j) + G%bathyT(i,j)))) * val2 + (G%bathyT(i,j+1) )) * val2 segment%normal_trans(i,J,k) = segment%normal_vel(i,J,k) * h(i,j+1,k) * G%dxCv(i,J) enddo endif @@ -344,11 +345,11 @@ subroutine Kelvin_set_OBC_data(OBC, CS, G, GV, US, h, Time) y1 = 1000. * G%geoLatBu(I,J) x = (x1 - CS%coast_offset1) * cosa + y1 * sina y = - (x1 - CS%coast_offset1) * sina + y1 * cosa - cff = sqrt(GV%g_Earth * 0.5 * (G%bathyT(i,j+1) + G%bathyT(i,j))) + cff = sqrt(GV%g_Earth * G%bathyT(i,j+1) ) val2 = fac * exp(- 0.5 * (G%CoriolisBu(I,J) + G%CoriolisBu(I-1,J)) * US%m_to_L*y / cff) if (CS%mode == 0) then ; do k=1,nz segment%tangential_vel(I,J,k) = ((val1 * val2 * cff * sina) / & - ( 0.25*((G%bathyT(i,j) + G%bathyT(i+1,j+1)) + (G%bathyT(i+1,j) + G%bathyT(i,j+1))) )) + ( 0.5*((G%bathyT(i+1,j+1)) + G%bathyT(i,j+1))) ) enddo ; endif enddo ; enddo endif diff --git a/src/user/adjustment_initialization.F90 b/src/user/adjustment_initialization.F90 index 0b9d4409f8..6dde9c68ef 100644 --- a/src/user/adjustment_initialization.F90 +++ b/src/user/adjustment_initialization.F90 @@ -220,8 +220,8 @@ subroutine adjustment_initialize_temperature_salinity(T, S, h, G, GV, param_file just_read = .false. ; if (present(just_read_params)) just_read = just_read_params ! Parameters used by main model initialization - call get_param(param_file, mdl,"S_REF",S_ref,'Reference salinity', units='1e-3', & - fail_if_missing=.not.just_read, do_not_log=just_read) + call get_param(param_file, mdl, "S_REF", S_ref, 'Reference salinity', & + default=35.0, units='1e-3', do_not_log=just_read) call get_param(param_file, mdl,"T_REF",T_ref,'Reference temperature', units='C', & fail_if_missing=.not.just_read, do_not_log=just_read) call get_param(param_file, mdl,"S_RANGE",S_range,'Initial salinity range', units='1e-3', &