Skip to content

Commit

Permalink
Merge dev/master for verona_201701 release
Browse files Browse the repository at this point in the history
  • Loading branch information
@underwoo
underwoo committed Jan 23, 2017
2 parents 4346ec2 + f62ba41 commit 022f4a0
Show file tree
Hide file tree
Showing 23 changed files with 1,054 additions and 133 deletions.
3 changes: 2 additions & 1 deletion axis_utils/axis_utils.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -131,7 +131,8 @@ subroutine get_axis_bounds(axis,axis_bound,axes,bnd_name,err_msg)
type(axistype), intent(in) :: axis
type(axistype), intent(inout) :: axis_bound
type(axistype), intent(in), dimension(:) :: axes
character(len=*), intent(out), optional :: bnd_name, err_msg
character(len=*), intent(inout), optional :: bnd_name
character(len=*), intent(out), optional :: err_msg

real, dimension(:), allocatable :: data, tmp

Expand Down
157 changes: 128 additions & 29 deletions coupler/atmos_ocean_fluxes.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -126,7 +126,7 @@ module atmos_ocean_fluxes_mod !{
!
!----------------------------------------------------------------------
!

public :: atmos_ocean_dep_fluxes_calc
public :: atmos_ocean_fluxes_calc
public :: atmos_ocean_fluxes_init
public :: aof_set_coupler_flux
Expand Down Expand Up @@ -1140,16 +1140,20 @@ subroutine atmos_ocean_fluxes_calc(gas_fields_atm, gas_fields_ice, &

endif !}
elseif (gas_fluxes%bc(n)%flux_type .eq. 'air_sea_deposition') then !}{

cycle !air_sea_deposition is done in another subroutine

elseif (gas_fluxes%bc(n)%flux_type .eq. 'land_sea_runoff') then !}{

if (gas_fluxes%bc(n)%param(1) .le. 0.0) then
write (error_string, '(1pe10.3)') gas_fluxes%bc(n)%param(1)
call mpp_error(FATAL, ' Bad parameter (' // trim(error_string) // &
') for air_sea_deposition for ' // trim(gas_fluxes%bc(n)%name))
') for land_sea_runoff for ' // trim(gas_fluxes%bc(n)%name))
endif

length = size(gas_fluxes%bc(n)%field(1)%values(:))

if (gas_fluxes%bc(n)%implementation .eq. 'dry') then !{
if (gas_fluxes%bc(n)%implementation .eq. 'river') then !{

do i = 1, length !{
if (seawater(i) == 1.) then !{
Expand All @@ -1160,35 +1164,126 @@ subroutine atmos_ocean_fluxes_calc(gas_fields_atm, gas_fields_ice, &
endif !}
enddo !} i

elseif (gas_fluxes%bc(n)%implementation .eq. 'wet') then !}{

do i = 1, length !{
if (seawater(i) == 1.) then !{
gas_fluxes%bc(n)%field(ind_flux)%values(i) = &
gas_fields_atm%bc(n)%field(ind_deposition)%values(i) / gas_fluxes%bc(n)%param(1)
else !}{
gas_fluxes%bc(n)%field(ind_flux)%values(i) = 0.0
endif !}
enddo !} i

else !}{

call mpp_error(FATAL, ' Unknown implementation (' // trim(gas_fluxes%bc(n)%implementation) // &
') for ' // trim(gas_fluxes%bc(n)%name))

endif !}

elseif (gas_fluxes%bc(n)%flux_type .eq. 'land_sea_runoff') then !}{
else !}{

call mpp_error(FATAL, ' Unknown flux_type (' // trim(gas_fluxes%bc(n)%flux_type) // &
') for ' // trim(gas_fluxes%bc(n)%name))

endif !}

endif !}

enddo !} n

if (allocated(kw)) then
deallocate(kw)
deallocate(cair)
endif

return
end subroutine atmos_ocean_fluxes_calc !}
! </SUBROUTINE> NAME="atmos_ocean_fluxes_calc"

subroutine atmos_ocean_dep_fluxes_calc(gas_fields_atm, gas_fields_ice, &
gas_fluxes, seawater) !{

!
!-----------------------------------------------------------------------
! modules (have to come first)
!-----------------------------------------------------------------------
!

implicit none

!
!-----------------------------------------------------------------------
! arguments
!-----------------------------------------------------------------------
!

type(coupler_1d_bc_type), intent(in) :: gas_fields_atm
type(coupler_1d_bc_type), intent(in) :: gas_fields_ice
type(coupler_1d_bc_type), intent(inout) :: gas_fluxes
real, intent(in), dimension(:) :: seawater

!
!-----------------------------------------------------------------------
! local parameters
!-----------------------------------------------------------------------
!

character(len=64), parameter :: sub_name = 'atmos_ocean_dep_fluxes_calc'
character(len=256), parameter :: error_header = &
'==>Error from ' // trim(mod_name) // '(' // trim(sub_name) // '):'

!
!-----------------------------------------------------------------------
! local variables
!-----------------------------------------------------------------------
!

integer :: n
integer :: i
integer :: length
real, dimension(:), allocatable :: kw
real, dimension(:), allocatable :: cair
character(len=128) :: error_string

real, parameter :: epsln=1.0e-30
real, parameter :: permeg=1.0e-6

!
! Return if no fluxes to be calculated
!

if (gas_fluxes%num_bcs .le. 0) then
return
endif

!
! check some things
!

if (.not. associated(gas_fluxes%bc)) then !{
if (gas_fluxes%num_bcs .ne. 0) then !{
call mpp_error(FATAL, trim(error_header) // ' Number of gas fluxes not zero')
else !}{
return
endif !}
endif !}

!
! =====================================================================
! begin executable code
! =====================================================================
!

do n = 1, gas_fluxes%num_bcs !{

!
! only do calculations if the flux has not been overridden
!

if ( .not. gas_fluxes%bc(n)%field(ind_flux)%override) then !{

if (gas_fluxes%bc(n)%flux_type .eq. 'air_sea_deposition') then !}{

if (gas_fluxes%bc(n)%param(1) .le. 0.0) then
write (error_string, '(1pe10.3)') gas_fluxes%bc(n)%param(1)
call mpp_error(FATAL, ' Bad parameter (' // trim(error_string) // &
') for land_sea_runoff for ' // trim(gas_fluxes%bc(n)%name))
call mpp_error(FATAL, 'atmos_ocean_dep_fluxes_calc: Bad parameter (' // trim(error_string) // &
') for air_sea_deposition for ' // trim(gas_fluxes%bc(n)%name))
endif

length = size(gas_fluxes%bc(n)%field(1)%values(:))

if (gas_fluxes%bc(n)%implementation .eq. 'river') then !{
if (gas_fluxes%bc(n)%implementation .eq. 'dry') then !{

do i = 1, length !{
if (seawater(i) == 1.) then !{
Expand All @@ -1199,31 +1294,35 @@ subroutine atmos_ocean_fluxes_calc(gas_fields_atm, gas_fields_ice, &
endif !}
enddo !} i

elseif (gas_fluxes%bc(n)%implementation .eq. 'wet') then !}{

do i = 1, length !{
if (seawater(i) == 1.) then !{
gas_fluxes%bc(n)%field(ind_flux)%values(i) = &
gas_fields_atm%bc(n)%field(ind_deposition)%values(i) / gas_fluxes%bc(n)%param(1)
else !}{
gas_fluxes%bc(n)%field(ind_flux)%values(i) = 0.0
endif !}
enddo !} i

else !}{

call mpp_error(FATAL, ' Unknown implementation (' // trim(gas_fluxes%bc(n)%implementation) // &
') for ' // trim(gas_fluxes%bc(n)%name))
call mpp_error(FATAL, 'atmos_ocean_dep_fluxes_calc: Unknown implementation ('&
// trim(gas_fluxes%bc(n)%implementation) // ') for ' // trim(gas_fluxes%bc(n)%name))

endif !}

else !}{

call mpp_error(FATAL, ' Unknown flux_type (' // trim(gas_fluxes%bc(n)%flux_type) // &
') for ' // trim(gas_fluxes%bc(n)%name))
cycle

endif !}

endif !}

enddo !} n

if (allocated(kw)) then
deallocate(kw)
deallocate(cair)
endif

return
end subroutine atmos_ocean_fluxes_calc !}
! </SUBROUTINE> NAME="atmos_ocean_fluxes_calc"
end subroutine atmos_ocean_dep_fluxes_calc !}

end module atmos_ocean_fluxes_mod !}
66 changes: 64 additions & 2 deletions data_override/data_override.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -25,7 +25,7 @@
module data_override_mod
!
! <CONTACT EMAIL="Zhi.Liang@noaa.gov">
! G.T. Nong
! Z. Liang
! </CONTACT>
!
! <CONTACT EMAIL="Matthew.Harrison@noaa.gov">
Expand Down Expand Up @@ -144,7 +144,7 @@ module data_override_mod
module procedure data_override_3d
end interface

public :: data_override_init, data_override
public :: data_override_init, data_override, data_override_unset_domains

contains
!===============================================================================================
Expand Down Expand Up @@ -440,6 +440,68 @@ subroutine data_override_init(Atm_domain_in, Ocean_domain_in, Ice_domain_in, Lan
end subroutine data_override_init
! </SUBROUTINE>
!===============================================================================================

!===============================================================================================
! <SUBROUTINE NAME="data_override_unset_domain">
! <DESCRIPTION>
! Unset domains that had previously been set for use by data_override.
! </DESCRIPTION>
! <TEMPLATE>
! call data_override_unset_domain
! </TEMPLATE>
subroutine data_override_unset_domains(unset_Atm, unset_Ocean, &
unset_Ice, unset_Land, must_be_set)
logical, intent(in), optional :: unset_Atm, unset_Ocean, unset_Ice, unset_Land
logical, intent(in), optional :: must_be_set

! <NOTE>
! This subroutine deallocates any data override domains that have been set.
! </NOTE>
logical :: fail_if_not_set

fail_if_not_set = .true. ; if (present(must_be_set)) fail_if_not_set = must_be_set

if (.not.module_is_initialized) call mpp_error(FATAL, &
"data_override_unset_domains called with an unititialized data_override module.")

if (PRESENT(unset_Atm)) then ; if (unset_Atm) then
if (fail_if_not_set .and. .not.atm_on) call mpp_error(FATAL, &
"data_override_unset_domains attempted to work on an Atm_domain that had not been set.")
atm_domain = NULL_DOMAIN2D
atm_on = .false.
if (allocated(lon_local_atm)) deallocate(lon_local_atm)
if (allocated(lat_local_atm)) deallocate(lat_local_atm)
endif ; endif
if (PRESENT(unset_Ocean)) then ; if (unset_Ocean) then
if (fail_if_not_set .and. .not.ocn_on) call mpp_error(FATAL, &
"data_override_unset_domains attempted to work on an Ocn_domain that had not been set.")
ocn_domain = NULL_DOMAIN2D
ocn_on = .false.
if (allocated(lon_local_ocn)) deallocate(lon_local_ocn)
if (allocated(lat_local_ocn)) deallocate(lat_local_ocn)
endif ; endif
if (PRESENT(unset_Land)) then ; if (unset_Land) then
if (fail_if_not_set .and. .not.lnd_on) call mpp_error(FATAL, &
"data_override_unset_domains attempted to work on a Land_domain that had not been set.")
lnd_domain = NULL_DOMAIN2D
lnd_on = .false.
if (allocated(lon_local_lnd)) deallocate(lon_local_lnd)
if (allocated(lat_local_lnd)) deallocate(lat_local_lnd)
endif ; endif
if (PRESENT(unset_Ice)) then ; if (unset_Ice) then
if (fail_if_not_set .and. .not.ice_on) call mpp_error(FATAL, &
"data_override_unset_domains attempted to work on an Ice_domain that had not been set.")
ice_domain = NULL_DOMAIN2D
ice_on = .false.
if (allocated(lon_local_ice)) deallocate(lon_local_ice)
if (allocated(lat_local_ice)) deallocate(lat_local_ice)
endif ; endif

end subroutine data_override_unset_domains
! </SUBROUTINE>
!===============================================================================================


subroutine check_grid_sizes(domain_name, Domain, nlon, nlat)
character(len=12), intent(in) :: domain_name
type (domain2d), intent(in) :: Domain
Expand Down
1 change: 1 addition & 0 deletions diag_manager/diag_axis.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -246,6 +246,7 @@ INTEGER FUNCTION diag_axis_init(name, DATA, units, cart_name, long_name, directi
Axes(diag_axis_init)%end = -1
Axes(diag_axis_init)%subaxis_name = ""
Axes(diag_axis_init)%shift = 0
Axes(diag_axis_init)%num_attributes = 0

IF ( PRESENT(long_name) ) THEN
Axes(diag_axis_init)%long_name = long_name
Expand Down
8 changes: 6 additions & 2 deletions diag_manager/diag_data.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -487,6 +487,7 @@ MODULE diag_data_mod
LOGICAL :: static
LOGICAL :: time_max ! true if the output field is maximum over time interval
LOGICAL :: time_min ! true if the output field is minimum over time interval
LOGICAL :: time_sum ! true if the output field is summed over time interval
LOGICAL :: time_ops ! true if any of time_min, time_max, time_rms or time_average is true
INTEGER :: pack
INTEGER :: pow_value !< Power value to use for mean_pow(n) calculations
Expand Down Expand Up @@ -685,8 +686,11 @@ MODULE diag_data_mod

INTEGER :: max_field_attributes = 2 !< Maximum number of user definable attributes per field.
INTEGER :: max_file_attributes = 2 !< Maximum number of user definable global attributes per file.
INTEGER :: max_axis_attributes = 2 !< Maximum number of user definable attributes per axis.
LOGICAL :: prepend_date = .TRUE.
INTEGER :: max_axis_attributes = 4 !< Maximum number of user definable attributes per axis.
LOGICAL :: prepend_date = .TRUE. !< Should the history file have the start date prepended to the file name
LOGICAL :: write_manifest_file = .FALSE. !< Indicates if the manifest file should be written. If writing many
!! regional files, then the termination time may increase causing job to time out.

! <!-- netCDF variable -->
! <DATA NAME="FILL_VALUE" TYPE="REAL" DEFAULT="NF90_FILL_REAL">
! Fill value used. Value will be <TT>NF90_FILL_REAL</TT> if using the
Expand Down
Loading

0 comments on commit 022f4a0

Please sign in to comment.