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

First version for bias correction in flux_calculator

experiments/bias-correction
Sven Karsten 8 months ago
parent
2e603e0125
commit
46628b0f30
4 changed files with 265 additions and 2 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. 3
      build_hlrng.sh
  2. 254
      src/bias_corrections.F90
  3. 8
      src/flux_calculator.F90
  4. 2
      src/flux_lib/radiation/distribute_radiation_flux.F90

3
build_hlrng.sh
Unescape View File

@ -65,6 +65,7 @@ $FC -c $FFLAGS ../src/flux_calculator_calculate.F90
$FC -c $FFLAGS ../src/flux_calculator_parse_arg.F90
$FC -c $FFLAGS ../src/flux_calculator_io.F90 -I${IOW_ESM_NETCDF_INCLUDE} $LIBS
$FC -c $FFLAGS ../src/flux_calculator_create_namcouple.F90
$FC $FFLAGS -o ../"${bin_dir}"/flux_calculator ../src/flux_calculator.F90 flux_calculator_basic.o flux_calculator_prepare.o flux_calculator_calculate.o flux_calculator_io.o flux_calculator_parse_arg.o flux_calculator_create_namcouple.o flux_library.a $INCLUDES $LIBS -Wl,-rpath,${IOW_ESM_NETCDF_LIBRARY}
$FC -c $FFLAGS ../src/bias_corrections.F90 -I${IOW_ESM_NETCDF_INCLUDE} $LIBS
$FC $FFLAGS -o ../"${bin_dir}"/flux_calculator ../src/flux_calculator.F90 flux_calculator_basic.o flux_calculator_prepare.o flux_calculator_calculate.o flux_calculator_io.o flux_calculator_parse_arg.o flux_calculator_create_namcouple.o bias_corrections.o flux_library.a $INCLUDES $LIBS -Wl,-rpath,${IOW_ESM_NETCDF_LIBRARY}
cd -

254
src/bias_corrections.F90
Unescape View File

@ -0,0 +1,254 @@
MODULE bias_corrections
USE netcdf, ONLY : &
nf90_open, &
nf90_close, &
nf90_get_var, &
nf90_inq_varid, &
nf90_get_att, &
NF90_NOWRITE, &
NF90_NOERR
IMPLICIT NONE
PUBLIC initialize_bias_corrections
ENUM, BIND(C)
ENUMERATOR :: E_MASS_EVAP_CORRECTION = 1
ENUMERATOR :: E_N_CORRECTIONS = 1
ENDENUM
! initializes names for corrextion -> corresponds to out variable that is corrected
CHARACTER(len=8), PARAMETER, DIMENSION(E_N_CORRECTIONS) :: corrections_names = [ &
'mass_evap' &
]
INTEGER :: &
init_date
REAL, ALLOCATABLE :: &
corrections(:,:,:) ! (variable, month, space)
LOGICAL :: &
lcorrections(E_N_CORRECTIONS) = .FALSE.
CONTAINS
SUBROUTINE process_input_corrections (n, errstat)
! Parameter list:
INTEGER, INTENT (IN) :: &
n ! Unit number for Namelist INPUT file
INTEGER, INTENT (OUT) :: &
errstat ! error status variable
! Local variables:
INTEGER :: &
i
! Define the namelist group
NAMELIST /correctionsctl/ init_date, lcorrections
!------------------------------------------------------------------------------
!- End of header -
!------------------------------------------------------------------------------
!------------------------------------------------------------------------------
!- Begin SUBROUTINE input_oasisctl
!------------------------------------------------------------------------------
errstat = 0
!------------------------------------------------------------------------------
!- Section 3: Input of the namelist values
!------------------------------------------------------------------------------
READ (n, correctionsctl, IOSTAT=errstat)
IF (errstat /= 0) THEN
errstat = 1
DO i = 1, E_N_CORRECTIONS
lcorrections(i) = .FALSE.
ENDDO
WRITE(*,*) "Could not read INPUT_BIAS set lcorrections to default: ", lcorrections
RETURN
ENDIF
!------------------------------------------------------------------------------
!- Section 4: Check values for errors and consistency
!------------------------------------------------------------------------------
DO i = 1, E_N_CORRECTIONS
IF ( lcorrections(i) /= .FALSE. .and. lcorrections(i) /= .TRUE.) THEN
WRITE (*,*) ' ERROR *** Wrong value ', lcorrections(i) , ' for correction ', i
errstat = 2
WRITE (*,*) ' ERROR *** Error while checking values of the namelist oasisctl *** '
RETURN
ENDIF
ENDDO
!------------------------------------------------------------------------------
!- Section 6: Output of the namelist variables and their default values
!------------------------------------------------------------------------------
WRITE (*,*) 'Apply bias corrections for:'
DO i = 1, E_N_CORRECTIONS
WRITE (*,*) corrections_names(i), lcorrections(i)
ENDDO
!------------------------------------------------------------------------------
!- End of the Subroutine
!------------------------------------------------------------------------------
END SUBROUTINE process_input_corrections
SUBROUTINE read_namelist_corrections(filename, errstat)
CHARACTER (LEN= *), INTENT(IN) :: &
filename ! error message
INTEGER, INTENT(OUT) :: errstat
INTEGER :: n
n = 10
! -----------------------------------------------------------------
! 1 Open NAMELIST-INPUT file
! ----------------------------------------------------------------
errstat = 0
WRITE (*,*) ' INPUT OF THE NAMELIST FOR BIAS CORRECTIONS'
OPEN (n, FILE=filename, FORM='FORMATTED', STATUS='UNKNOWN', IOSTAT=errstat)
IF (errstat /= 0) THEN
errstat = 1
WRITE(*,*) ' ERROR *** Error while opening file '//filename//' *** '
RETURN
ENDIF
! -----------------------------------------------------------------
! 2 read the NAMELIST group oasisctl
! ----------------------------------------------------------------
CALL process_input_corrections (n, errstat)
IF (errstat /= 0) THEN
WRITE (*,*) ' ERROR *** Wrong values occured in NAMELIST group /correctionsctl/ *** '
errstat = 2
RETURN
ENDIF
! -----------------------------------------------------------------
! 3 Close NAMELIST-INPUT file
! ----------------------------------------------------------------
CLOSE (n, STATUS='KEEP', IOSTAT=errstat)
IF (errstat /= 0) THEN
WRITE(*,*) ' ERROR *** while closing file '//filename//'*** '
errstat = 4
ENDIF
!------------------------------------------------------------------------------
!- End of the Subroutine
!------------------------------------------------------------------------------
END SUBROUTINE read_namelist_corrections
SUBROUTINE initialize_bias_corrections(filename, grid_offset, grid_size)
CHARACTER (LEN= *), INTENT(IN) :: &
filename ! name of input file
INTEGER, INTENT(IN) :: &
grid_offset, &
grid_size
INTEGER :: &
istatus, & ! NetCDF status
ncfileid, ncvarid, & ! NetCDF IDs
nerror, &
i, j
REAL:: &
fillvalue
CHARACTER(LEN=128) :: correction_filename
CHARACTER(LEN=2) :: yj
! Read namelist for corrections
CALL read_namelist_corrections(filename, nerror)
! allocate resources for each process
ALLOCATE(corrections(E_N_CORRECTIONS, 12, grid_size))
! Read in correction for each month
DO i = 1, E_N_CORRECTIONS
IF (.NOT. lcorrections(i)) THEN
CYCLE
ENDIF
DO j = 1, 12
WRITE (yj,'(I2.2)') j
yj = ADJUSTL(yj)
correction_filename = 'corrections/'//TRIM(corrections_names(i))//'-'//TRIM(yj)//'.nc'
istatus = nf90_open(TRIM(filename), NF90_NOWRITE, ncfileid)
IF (istatus /= NF90_NOERR) THEN
WRITE(*,*) 'Could not open ', TRIM(filename), ' for bias correction. Unset correction.'
CYCLE
ENDIF
istatus = nf90_inq_varid(ncfileid, TRIM(corrections_names(i)) , ncvarid)
IF (istatus /= NF90_NOERR) THEN
WRITE(*,*) 'Could not get varid for variable '//TRIM(corrections_names(i))//'. Unset correction.'
CYCLE
ENDIF
istatus = nf90_get_var(ncfileid, ncvarid, corrections(i,j,:), &
(/ grid_offset/), &
(/ grid_size/))
IF (istatus /= NF90_NOERR) THEN
WRITE(*,*) 'Could not get variable '//TRIM(corrections_names(i))//'. Unset correction.'
corrections(i,j,:) = 0.0
CYCLE
ENDIF
istatus = nf90_get_att(ncfileid, ncvarid, "_FillValue", fillvalue)
IF (istatus /= NF90_NOERR) THEN
WRITE(*,*) 'Could not get fill value. Unset correction.'
corrections(i,j,:) = 0.0
CYCLE
ENDIF
istatus = nf90_close(ncfileid)
IF (istatus /= NF90_NOERR) THEN
WRITE(*,*) 'Could not close ', TRIM(filename), 'for bias correction.'
CYCLE
ENDIF
WHERE (corrections(i,j,:) == fillvalue) corrections(i,j,:) = 0.0
ENDDO
ENDDO
WRITE (*,*) "Read in bias correction fields."
END SUBROUTINE initialize_bias_corrections
SUBROUTINE finalize_bias_corrections
DEALLOCATE(corrections)
END SUBROUTINE finalize_bias_corrections
END MODULE bias_corrections

8
src/flux_calculator.F90
Unescape View File

@ -15,6 +15,8 @@ PROGRAM flux_calculator
USE flux_calculator_parse_arg
USE flux_calculator_create_namcouple
USE bias_corrections, ONLY : initialize_bias_corrections
! Use OASIS communication library
USE mod_oasis
@ -175,6 +177,8 @@ PROGRAM flux_calculator
WRITE(*,nml=input)
CLOSE(10)
! Initialize the idx_???? variables which store the index of a variable name
CALL init_varname_idx
@ -844,6 +848,10 @@ ENDIF
ENDIF
WRITE (w_unit,*) 'Finished initialization.'
!### if available, initialize bias corrections
CALL initialize_bias_corrections('flux_calculator.nml', grid_offset(1), grid_size(1))
!###############################################################################
!# STEP 2: TIME LOOP #
!###############################################################################

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

@ -21,7 +21,7 @@ module distribute_radiation_flux_mod
! apply surface-type-dependent albedo and get rid of averaged albedo
flux_radiation_surface_type = flux_radiation_averaged * (1.0 - albedo_surface_type) / (1.0 - albedo_averaged)
flux_radiation_surface_type = flux_radiation_averaged * (1.0 - albedo_surface_type) !/ (1.0 - albedo_averaged)
end subroutine distribute_radiation_flux

Write Preview
Loading…
Cancel
Save