iow_esm
/
components.flux_calculator
4
0
Fork 0
Code Issues 1 Pull Requests Projects Releases 1 Wiki Activity
Browse Source

WIP: Redistribute radiation flux on surface-types. 

With this implementation it is running but still has to be checked.
distribute-radiation-on-surface-types
Sven Karsten 2 years ago
parent
99b185a9bd
commit
a783819365
6 changed files with 101 additions and 7 deletions
Whitespace
Show all changes Ignore whitespace when comparing lines Ignore changes in amount of whitespace Ignore changes in whitespace at EOL
Split View
Diff Options
Show Stats Download Patch File Download Diff File
  1. 9
      src/flux_calculator.F90
  2. 9
      src/flux_calculator_basic.F90
  3. 21
      src/flux_calculator_calculate.F90
  4. 27
      src/flux_calculator_prepare.F90
  5. 12
      src/flux_lib/flux_library.F90
  6. 30
      src/flux_lib/radiation/distribute_radiation_flux.F90

9
src/flux_calculator.F90
Unescape View File

@ -621,6 +621,12 @@ ENDIF
ENDDO
CALL prepare_regridding(idx_RBBR, 0, local_field, my_bottom_model, regrid_u_to_t, regrid_v_to_t, regrid_t_to_u, regrid_t_to_v, grid_size)
! ! RSDD: redistribution on different surface types
! DO i=1,num_surface_types
! CALL prepare_distribute_radiation_flux(i, 1, 'test', grid_size(1), local_field) ! RSDD on t_grid
! ENDDO
! CALL prepare_regridding(idx_RSDD, 0, local_field, my_bottom_model, regrid_u_to_t, regrid_v_to_t, regrid_t_to_u, regrid_t_to_v, grid_size)
! MOMENTUM FLUXES
! UMOM:
DO i=1,num_surface_types
@ -948,6 +954,9 @@ ENDIF
CALL calc_flux_momentum_north(my_bottom_model, num_surface_types, 3, which_flux_momentum, grid_size, local_field)
CALL do_regridding(idx_VMOM, 0, local_field, regrid_u_to_t_matrix, regrid_v_to_t_matrix, regrid_t_to_u_matrix, regrid_t_to_v_matrix)
CALL distribute_shortwave_radiation_flux(my_bottom_model, num_surface_types, grid_size, local_field)
!CALL do_regridding(idx_RSDD, 0, local_field, regrid_u_to_t_matrix, regrid_v_to_t_matrix, regrid_t_to_u_matrix, regrid_t_to_v_matrix)
!#############################################################################
!# STEP 2.6: SEND NORMAL RESULTS TO COUPLER #

9
src/flux_calculator_basic.F90
Unescape View File

@ -133,7 +133,7 @@ MODULE flux_calculator_basic
input_field(num_input_fields)%which_grid = which_grid
input_field(num_input_fields)%field => local_field%var(i)%field
input_field(num_input_fields)%early=.FALSE.
IF ((myname=="FARE") .OR. (myname=="TSUR") .OR. (myname=="FICE") .OR. (myname=="ALBE")) THEN
IF ((myname=="FARE") .OR. (myname=="TSUR") .OR. (myname=="FICE") .OR. ((myname=="ALBE") .AND. (my_letter /= 'A'))) THEN
input_field(num_input_fields)%early=.TRUE.
ENDIF
input_field(num_input_fields)%surface_type = surface_type
@ -173,6 +173,11 @@ MODULE flux_calculator_basic
DO i=1,num_input_fields
IF (trim(input_field(i)%name)=="R"//my_letter//myname//appendstring) found=.TRUE.
ENDDO
IF (found) THEN
IF((trim(myname) == "ALBE") .AND. (trim(my_letter) == 'A')) THEN
found = .FALSE.
ENDIF
ENDIF
IF (.NOT. found) THEN ! Okay field does not come as input
DO i=1,MAX_VARNAMES
IF (varnames(i) == myname) THEN
@ -536,7 +541,7 @@ MODULE flux_calculator_basic
IF (varnames(i) == 'RSID') idx_RSID = i ! Radiation flux (shortwave indirect downward, neg. val.) (W/m2)
IF (varnames(i) == 'RSIU') idx_RSIU = i ! Radiation flux (shortwave indirect upward) (W/m2)
IF (varnames(i) == 'RSIN') idx_RSIN = i ! Radiation flux (shortwave indirect net upward) (W/m2)
IF (varnames(i) == 'RSDD') idx_RSID = i ! Radiation flux (shortwave directed downward, neg. val.) (W/m2)
IF (varnames(i) == 'RSDD') idx_RSDD = i ! Radiation flux (shortwave directed downward, neg. val.) (W/m2)
IF (varnames(i) == 'UMOM') idx_UMOM = i ! Upward flux of eastward momentum (N/m2)
IF (varnames(i) == 'VMOM') idx_VMOM = i ! Upward flux of northward momentum (N/m2)
ENDDO

21
src/flux_calculator_calculate.F90
Unescape View File

@ -249,6 +249,27 @@ MODULE flux_calculator_calculate
CALL average_across_surface_types(1,idx_RBBR,num_surface_types,grid_size,local_field)
END SUBROUTINE calc_flux_radiation_blackbody
SUBROUTINE distribute_shortwave_radiation_flux(my_bottom_model, num_surface_types, grid_size, local_field)
! calculates blackbody radiation on t_grid
INTEGER, INTENT(IN) :: my_bottom_model
INTEGER, INTENT(IN) :: num_surface_types
INTEGER, DIMENSION(:), INTENT(IN) :: grid_size
TYPE(local_fields_type), DIMENSION(0:,:), INTENT(INOUT) :: local_field
INTEGER :: i, j
DO i=1,num_surface_types
local_field(i,1)%var(idx_RSDD)%field(:) = 0.0
DO j=1,grid_size(1)
CALL distribute_radiation_flux(local_field(i,1)%var(idx_RSDD)%field(j), &
local_field(0,1)%var(idx_RSDD)%field(j), &
local_field(0,1)%var(idx_ALBE)%field(j), &
local_field(i,1)%var(idx_ALBE)%field(j), &
local_field(i,1)%var(idx_FARE)%field(j))
ENDDO
ENDDO
!CALL average_across_surface_types(1,idx_RSDD,num_surface_types,grid_size,local_field)
END SUBROUTINE distribute_shortwave_radiation_flux
!!!!!!!!!! AVERAGING ROUTINE !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
SUBROUTINE average_across_surface_types(which_grid, my_idx, num_surface_types, grid_size, local_field)

27
src/flux_calculator_prepare.F90
Unescape View File

@ -252,4 +252,31 @@ MODULE flux_calculator_prepare
CALL do_prepare_calculation(missing_field, idx_RBBR, myvarname, surface_type, which_grid, method, grid_size, local_field)
ENDIF
END SUBROUTINE prepare_flux_radiation_blackbody
! SUBROUTINE prepare_distribute_radiation_flux(surface_type, which_grid, method, grid_size, local_field)
! INTEGER, INTENT(IN) :: surface_type
! INTEGER, INTENT(IN) :: which_grid ! 1=t_grid, 2=u_grid, 3=v_grid
! CHARACTER(len=20), INTENT(IN) :: method
! INTEGER, INTENT(IN) :: grid_size ! to allocate the array to the correct size
! TYPE(local_fields_type), DIMENSION(0:,:), INTENT(INOUT) :: local_field ! pass the entire field because method can be "copy"
! CHARACTER(len=4), PARAMETER :: myvarname = 'RBBR'
! CHARACTER(len=200) :: missing_field
! missing_field=''
! IF (trim(method) /= 'none') THEN
! IF (trim(method)=='copy') THEN ! copy from surface_type=1
! IF (.NOT. ASSOCIATED( local_field(1,which_grid)%var(idx_RSDD)%field )) missing_field=myvarname//' for surface_type=1 '
! ELSEIF (trim(method)=='zero') THEN
! ! nothing to be done
! ELSEIF (trim(method)=='test') THEN
! IF (.NOT. ASSOCIATED( local_field(surface_type,which_grid)%var(idx_RSDD)%field )) missing_field=trim(missing_field)//' RSDD'
! IF (.NOT. ASSOCIATED( local_field(surface_type,which_grid)%var(idx_ALBE)%field )) missing_field=trim(missing_field)//' ALBE'
! IF (.NOT. ASSOCIATED( local_field(surface_type,which_grid)%var(idx_FARE)%field )) missing_field=trim(missing_field)//' FARE'
! ELSE
! WRITE (w_unit,*) "Error calculating ",myvarname," for surface_type ",surface_type," on the grid ",grid_name(which_grid),":"
! WRITE (w_unit,*) " Method ",method," is not known. "
! CALL mpi_finalize(1)
! ENDIF
! CALL do_prepare_calculation(missing_field, idx_RSDD, myvarname, surface_type, which_grid, method, grid_size, local_field)
! ENDIF
! END SUBROUTINE prepare_distribute_radiation_flux
END MODULE flux_calculator_prepare

12
src/flux_lib/flux_library.F90
Unescape View File

@ -16,14 +16,15 @@ module flux_library
! import flux calculation functions from different modules:
! mass fluxes
use flux_mass_evap, only: flux_mass_evap_cclm
use flux_mass_evap, only: flux_mass_evap_cclm
! heat fluxes
use flux_heat_latent, only: flux_heat_latent_ice, flux_heat_latent_water
use flux_heat_sensible, only: flux_heat_sensible_cclm
use flux_heat_latent, only: flux_heat_latent_ice, flux_heat_latent_water
use flux_heat_sensible, only: flux_heat_sensible_cclm
! radiation fluxes
use flux_radiation_blackbody, only: flux_radiation_blackbody_StBo
use flux_radiation_blackbody, only: flux_radiation_blackbody_StBo
use distribute_radiation_flux_mod, only: distribute_radiation_flux
! momentum fluxes
use flux_momentum, only: flux_momentum_cclm
use flux_momentum, only: flux_momentum_cclm
implicit none ; private
@ -34,6 +35,7 @@ module flux_library
public flux_mass_evap_cclm
public flux_momentum_cclm
public flux_radiation_blackbody_StBo
public distribute_radiation_flux
public spec_vapor_surface_cclm
!contains

30
src/flux_lib/radiation/distribute_radiation_flux.F90
Unescape View File

@ -0,0 +1,30 @@
module distribute_radiation_flux_mod
use flux_constants, only: prec
implicit none ; private
! expose all functions
public distribute_radiation_flux !
contains
subroutine distribute_radiation_flux( &
flux_radiation_surface_type, & ! RESULT, surface-dependent radiation flux sent to bottom
flux_radiation_averaged, & ! surface-independent radiation flux from atmosphere
albedo_averaged, & ! surface-independent albedo from atmosphere
albedo_surface_type, & ! surface-dependent albedo received from ocean
fraction_surface_type & ! fraction of surface in exchange-grid cell
)
real(prec), intent(out) :: flux_radiation_surface_type ! RESULT
real(prec), intent(in) :: flux_radiation_averaged, albedo_averaged, albedo_surface_type, fraction_surface_type
flux_radiation_surface_type = fraction_surface_type * flux_radiation_averaged * (1.0 - albedo_surface_type) / (1.0 - albedo_averaged)
end subroutine distribute_radiation_flux
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
end module distribute_radiation_flux_mod
Write Preview
Loading…
Cancel
Save