diff --git a/diag_manager/diag_axis.F90 b/diag_manager/diag_axis.F90 index 13daf3cf35..8f19ed865b 100644 --- a/diag_manager/diag_axis.F90 +++ b/diag_manager/diag_axis.F90 @@ -235,7 +235,7 @@ INTEGER FUNCTION diag_axis_init(name, DATA, units, cart_name, long_name, directi TYPE IS (real(kind=r4_kind)) Axes(diag_axis_init)%data = DATA(1:axlen) TYPE IS (real(kind=r8_kind)) - Axes(diag_axis_init)%data = DATA(1:axlen) + Axes(diag_axis_init)%data = real(DATA(1:axlen)) CLASS DEFAULT CALL error_mesg('diag_axis_mod::diag_axis_init',& & 'The axis data is not one of the supported types of real(kind=4) or real(kind=8)', FATAL) @@ -491,7 +491,7 @@ SUBROUTINE get_diag_axis(id, name, units, long_name, cart_name,& ELSE SELECT TYPE (DATA) TYPE IS (real(kind=r4_kind)) - DATA(1:Axes(id)%length) = Axes(id)%data(1:Axes(id)%length) + DATA(1:Axes(id)%length) = real(Axes(id)%data(1:Axes(id)%length), kind=r4_kind) TYPE IS (real(kind=r8_kind)) DATA(1:Axes(id)%length) = Axes(id)%data(1:Axes(id)%length) CLASS DEFAULT diff --git a/diag_manager/diag_grid.F90 b/diag_manager/diag_grid.F90 index 99a474c9a3..12b9c9115f 100644 --- a/diag_manager/diag_grid.F90 +++ b/diag_manager/diag_grid.F90 @@ -258,7 +258,7 @@ SUBROUTINE diag_grid_init(domain, glo_lat, glo_lon, aglo_lat, aglo_lon) TYPE IS (real(kind=r4_kind)) diag_global_grid%aglo_lat = TRANSPOSE(aglo_lat) TYPE IS (real(kind=r8_kind)) - diag_global_grid%aglo_lat = TRANSPOSE(aglo_lat) + diag_global_grid%aglo_lat = TRANSPOSE(real(aglo_lat)) CLASS DEFAULT CALL error_mesg('diag_grid_mod::diag_grid_init',& & 'The a-grid latitude data is not one of the supported types of real(kind=4) or real(kind=8)', FATAL) @@ -268,7 +268,7 @@ SUBROUTINE diag_grid_init(domain, glo_lat, glo_lon, aglo_lat, aglo_lon) TYPE IS (real(kind=r4_kind)) diag_global_grid%aglo_lon = TRANSPOSE(aglo_lon) TYPE IS (real(kind=r8_kind)) - diag_global_grid%aglo_lon = TRANSPOSE(aglo_lon) + diag_global_grid%aglo_lon = TRANSPOSE(real(aglo_lon)) CLASS DEFAULT CALL error_mesg('diag_grid_mod::diag_grid_init',& & 'The a-grid longitude data is not one of the supported types of real(kind=4) or real(kind=8)', FATAL) @@ -278,7 +278,7 @@ SUBROUTINE diag_grid_init(domain, glo_lat, glo_lon, aglo_lat, aglo_lon) TYPE IS (real(kind=r4_kind)) diag_global_grid%aglo_lat = aglo_lat TYPE IS (real(kind=r8_kind)) - diag_global_grid%aglo_lat = aglo_lat + diag_global_grid%aglo_lat = real(aglo_lat) CLASS DEFAULT CALL error_mesg('diag_grid_mod::diag_grid_init',& & 'The a-grid latitude data is not one of the supported types of real(kind=4) or real(kind=8)', FATAL) @@ -288,7 +288,7 @@ SUBROUTINE diag_grid_init(domain, glo_lat, glo_lon, aglo_lat, aglo_lon) TYPE IS (real(kind=r4_kind)) diag_global_grid%aglo_lon = aglo_lon TYPE IS (real(kind=r8_kind)) - diag_global_grid%aglo_lon = aglo_lon + diag_global_grid%aglo_lon = real(aglo_lon) CLASS DEFAULT CALL error_mesg('diag_grid_mod::diag_grid_init',& & 'The a-grid longitude data is not one of the supported types of real(kind=4) or real(kind=8)', FATAL) @@ -299,7 +299,7 @@ SUBROUTINE diag_grid_init(domain, glo_lat, glo_lon, aglo_lat, aglo_lon) TYPE IS (real(kind=r4_kind)) diag_global_grid%glo_lat = glo_lat TYPE IS (real(kind=r8_kind)) - diag_global_grid%glo_lat = glo_lat + diag_global_grid%glo_lat = real(glo_lat) CLASS DEFAULT CALL error_mesg('diag_grid_mod::diag_grid_init',& & 'The grid latitude data is not one of the supported types of real(kind=4) or real(kind=8)', FATAL) @@ -309,7 +309,7 @@ SUBROUTINE diag_grid_init(domain, glo_lat, glo_lon, aglo_lat, aglo_lon) TYPE IS (real(kind=r4_kind)) diag_global_grid%glo_lon = glo_lon TYPE IS (real(kind=r8_kind)) - diag_global_grid%glo_lon = glo_lon + diag_global_grid%glo_lon = real(glo_lon) CLASS DEFAULT CALL error_mesg('diag_grid_mod::diag_grid_init',& & 'The grid longitude data is not one of the supported types of real(kind=4) or real(kind=8)', FATAL) diff --git a/diag_manager/diag_manager.F90 b/diag_manager/diag_manager.F90 index 4d80482432..8c81793331 100644 --- a/diag_manager/diag_manager.F90 +++ b/diag_manager/diag_manager.F90 @@ -622,8 +622,8 @@ INTEGER FUNCTION register_static_field(module_name, field_name, axes, long_name, INTEGER, OPTIONAL, INTENT(in) :: volume !< Field ID for the volume field associated with this field CHARACTER(len=*), OPTIONAL, INTENT(in) :: realm !< String to set as the value to the modeling_realm attribute - REAL :: missing_value_use - REAL, DIMENSION(2) :: range_use + REAL :: missing_value_use !< Local copy of missing_value + REAL, DIMENSION(2) :: range_use !< Local copy of range INTEGER :: field, num_axes, j, out_num, k INTEGER, DIMENSION(3) :: siz, local_siz, local_start, local_end ! indices of local domain of global axes INTEGER :: tile, file_num @@ -646,7 +646,7 @@ INTEGER FUNCTION register_static_field(module_name, field_name, axes, long_name, TYPE IS (real(kind=r4_kind)) missing_value_use = missing_value TYPE IS (real(kind=r8_kind)) - missing_value_use = missing_value + missing_value_use = real(missing_value) CLASS DEFAULT CALL error_mesg ('diag_manager_mod::register_static_field',& & 'The missing_value is not one of the supported types of real(kind=4) or real(kind=8)', FATAL) @@ -809,7 +809,7 @@ INTEGER FUNCTION register_static_field(module_name, field_name, axes, long_name, TYPE IS (real(kind=r4_kind)) range_use = range TYPE IS (real(kind=r8_kind)) - range_use = range + range_use = real(range) CLASS DEFAULT CALL error_mesg ('diag_manager_mod::register_static_field',& & 'The range is not one of the supported types of real(kind=4) or real(kind=8)', FATAL) @@ -1286,7 +1286,7 @@ LOGICAL FUNCTION send_data_0d(diag_field_id, field, time, err_msg) TYPE(time_type), INTENT(in), OPTIONAL :: time CHARACTER(len=*), INTENT(out), OPTIONAL :: err_msg - REAL :: field_out(1, 1, 1) + REAL :: field_out(1, 1, 1) !< Local copy of field ! If diag_field_id is < 0 it means that this field is not registered, simply return IF ( diag_field_id <= 0 ) THEN @@ -1299,7 +1299,7 @@ LOGICAL FUNCTION send_data_0d(diag_field_id, field, time, err_msg) TYPE IS (real(kind=r4_kind)) field_out(1, 1, 1) = field TYPE IS (real(kind=r8_kind)) - field_out(1, 1, 1) = field + field_out(1, 1, 1) = real(field) CLASS DEFAULT CALL error_mesg ('diag_manager_mod::send_data_0d',& & 'The field is not one of the supported types of real(kind=4) or real(kind=8)', FATAL) @@ -1319,8 +1319,8 @@ LOGICAL FUNCTION send_data_1d(diag_field_id, field, time, is_in, mask, rmask, ie LOGICAL, INTENT(in), DIMENSION(:), OPTIONAL :: mask CHARACTER(len=*), INTENT(out), OPTIONAL :: err_msg - REAL, DIMENSION(SIZE(field(:)), 1, 1) :: field_out - LOGICAL, DIMENSION(SIZE(field(:)), 1, 1) :: mask_out + REAL, DIMENSION(SIZE(field(:)), 1, 1) :: field_out !< Local copy of field + LOGICAL, DIMENSION(SIZE(field(:)), 1, 1) :: mask_out !< Local copy of mask ! If diag_field_id is < 0 it means that this field is not registered, simply return IF ( diag_field_id <= 0 ) THEN @@ -1333,7 +1333,7 @@ LOGICAL FUNCTION send_data_1d(diag_field_id, field, time, is_in, mask, rmask, ie TYPE IS (real(kind=r4_kind)) field_out(:, 1, 1) = field TYPE IS (real(kind=r8_kind)) - field_out(:, 1, 1) = field + field_out(:, 1, 1) = real(field) CLASS DEFAULT CALL error_mesg ('diag_manager_mod::send_data_1d',& & 'The field is not one of the supported types of real(kind=4) or real(kind=8)', FATAL) @@ -1349,9 +1349,9 @@ LOGICAL FUNCTION send_data_1d(diag_field_id, field, time, is_in, mask, rmask, ie IF ( PRESENT(rmask) ) THEN SELECT TYPE (rmask) TYPE IS (real(kind=r4_kind)) - WHERE (rmask < 0.5) mask_out(:, 1, 1) = .FALSE. + WHERE (rmask < 0.5_r4_kind) mask_out(:, 1, 1) = .FALSE. TYPE IS (real(kind=r8_kind)) - WHERE (rmask < 0.5) mask_out(:, 1, 1) = .FALSE. + WHERE (rmask < 0.5_r8_kind) mask_out(:, 1, 1) = .FALSE. CLASS DEFAULT CALL error_mesg ('diag_manager_mod::send_data_1d',& & 'The rmask is not one of the supported types of real(kind=4) or real(kind=8)', FATAL) @@ -1388,8 +1388,8 @@ LOGICAL FUNCTION send_data_2d(diag_field_id, field, time, is_in, js_in, & CLASS(*), INTENT(in), DIMENSION(:,:),OPTIONAL :: rmask CHARACTER(len=*), INTENT(out), OPTIONAL :: err_msg - REAL, DIMENSION(SIZE(field,1),SIZE(field,2),1) :: field_out - LOGICAL, DIMENSION(SIZE(field,1),SIZE(field,2),1) :: mask_out + REAL, DIMENSION(SIZE(field,1),SIZE(field,2),1) :: field_out !< Local copy of field + LOGICAL, DIMENSION(SIZE(field,1),SIZE(field,2),1) :: mask_out !< Local copy of mask ! If diag_field_id is < 0 it means that this field is not registered, simply return IF ( diag_field_id <= 0 ) THEN @@ -1402,7 +1402,7 @@ LOGICAL FUNCTION send_data_2d(diag_field_id, field, time, is_in, js_in, & TYPE IS (real(kind=r4_kind)) field_out(:, :, 1) = field TYPE IS (real(kind=r8_kind)) - field_out(:, :, 1) = field + field_out(:, :, 1) = real(field) CLASS DEFAULT CALL error_mesg ('diag_manager_mod::send_data_2d',& & 'The field is not one of the supported types of real(kind=4) or real(kind=8)', FATAL) @@ -1418,9 +1418,9 @@ LOGICAL FUNCTION send_data_2d(diag_field_id, field, time, is_in, js_in, & IF ( PRESENT(rmask) ) THEN SELECT TYPE (rmask) TYPE IS (real(kind=r4_kind)) - WHERE ( rmask < 0.5 ) mask_out(:, :, 1) = .FALSE. + WHERE ( rmask < 0.5_r4_kind ) mask_out(:, :, 1) = .FALSE. TYPE IS (real(kind=r8_kind)) - WHERE ( rmask < 0.5 ) mask_out(:, :, 1) = .FALSE. + WHERE ( rmask < 0.5_r8_kind ) mask_out(:, :, 1) = .FALSE. CLASS DEFAULT CALL error_mesg ('diag_manager_mod::send_data_2d',& & 'The rmask is not one of the supported types of real(kind=4) or real(kind=8)', FATAL) @@ -1631,7 +1631,7 @@ LOGICAL FUNCTION send_data_3d(diag_field_id, field, time, is_in, js_in, ks_in, & CHARACTER(len=256) :: err_msg_local CHARACTER(len=128) :: error_string, error_string1 - REAL, ALLOCATABLE, DIMENSION(:,:,:) :: field_out + REAL, ALLOCATABLE, DIMENSION(:,:,:) :: field_out !< Local copy of field ! If diag_field_id is < 0 it means that this field is not registered, simply return IF ( diag_field_id <= 0 ) THEN @@ -1666,7 +1666,7 @@ LOGICAL FUNCTION send_data_3d(diag_field_id, field, time, is_in, js_in, ks_in, & TYPE IS (real(kind=r4_kind)) field_out = field TYPE IS (real(kind=r8_kind)) - field_out = field + field_out = real(field) CLASS DEFAULT CALL error_mesg ('diag_manager_mod::send_data_3d',& & 'The field is not one of the supported types of real(kind=4) or real(kind=8)', FATAL) @@ -1800,7 +1800,7 @@ LOGICAL FUNCTION send_data_3d(diag_field_id, field, time, is_in, js_in, ks_in, & TYPE IS (real(kind=r4_kind)) weight1 = weight TYPE IS (real(kind=r8_kind)) - weight1 = weight + weight1 = real(weight) CLASS DEFAULT CALL error_mesg ('diag_manager_mod::send_data_3d',& & 'The weight is not one of the supported types of real(kind=4) or real(kind=8)', FATAL) diff --git a/diag_manager/diag_util.F90 b/diag_manager/diag_util.F90 index fe3be65786..10598cedf1 100644 --- a/diag_manager/diag_util.F90 +++ b/diag_manager/diag_util.F90 @@ -643,8 +643,8 @@ SUBROUTINE log_diag_field_info(module_name, field_name, axes, long_name, units,& CHARACTER(len=1) :: sep = '|' CHARACTER(len=256) :: axis_name, axes_list INTEGER :: i - REAL :: missing_value_use - REAL, DIMENSION(2) :: range_use + REAL :: missing_value_use !< Local copy of missing_value + REAL, DIMENSION(2) :: range_use !< Local copy of range IF ( .NOT.do_diag_field_log ) RETURN IF ( mpp_pe().NE.mpp_root_pe() ) RETURN @@ -682,7 +682,7 @@ SUBROUTINE log_diag_field_info(module_name, field_name, axes, long_name, units,& TYPE IS (real(kind=r4_kind)) missing_value_use = missing_value TYPE IS (real(kind=r8_kind)) - missing_value_use = missing_value + missing_value_use = real(missing_value) CLASS DEFAULT CALL error_mesg ('diag_util_mod::log_diag_field_info',& & 'The missing_value is not one of the supported types of real(kind=4) or real(kind=8)', FATAL) @@ -698,7 +698,7 @@ SUBROUTINE log_diag_field_info(module_name, field_name, axes, long_name, units,& TYPE IS (real(kind=r4_kind)) range_use = range TYPE IS (real(kind=r8_kind)) - range_use = range + range_use = real(range) CLASS DEFAULT CALL error_mesg ('diag_util_mod::log_diag_field_info',& & 'The range is not one of the supported types of real(kind=4) or real(kind=8)', FATAL) diff --git a/sat_vapor_pres/sat_vapor_pres_k.F90 b/sat_vapor_pres/sat_vapor_pres_k.F90 index 15e0562a6d..3a1ba4f43b 100644 --- a/sat_vapor_pres/sat_vapor_pres_k.F90 +++ b/sat_vapor_pres/sat_vapor_pres_k.F90 @@ -488,8 +488,8 @@ subroutine compute_qs_k_3d (temp, press, eps, zvir, qs, nbad, q, hc, & logical,intent(in), optional :: es_over_liq logical,intent(in), optional :: es_over_liq_and_ice - real(kind=r4_kind), allocatable, dimension(:,:,:) :: esloc_r4, desat_r4, denom_r4 - real(kind=r8_kind), allocatable, dimension(:,:,:) :: esloc_r8, desat_r8, denom_r8 + real(kind=r4_kind), allocatable, dimension(:,:,:) :: esloc_r4, desat_r4, denom_r4 !< Local variables to use when called with r4 arguments + real(kind=r8_kind), allocatable, dimension(:,:,:) :: esloc_r8, desat_r8, denom_r8 !< Local variables to use when called with r8 arguments integer :: i, j, k real :: hc_loc logical :: valid_types = .false. !< For checking if variable types match @@ -613,7 +613,7 @@ subroutine compute_qs_k_3d (temp, press, eps, zvir, qs, nbad, q, hc, & type is (real(kind=r4_kind)) hc_loc = hc type is (real(kind=r8_kind)) - hc_loc = hc + hc_loc = real(hc) end select else hc_loc = 1.0 @@ -624,7 +624,7 @@ subroutine compute_qs_k_3d (temp, press, eps, zvir, qs, nbad, q, hc, & select type (temp) type is (real(kind=r4_kind)) call lookup_es2_des2_k (temp, esloc_r4, desat_r4, nbad) - desat_r4 = desat_r4*hc_loc + desat_r4 = desat_r4*real(hc_loc, kind=r4_kind) type is (real(kind=r8_kind)) call lookup_es2_des2_k (temp, esloc_r8, desat_r8, nbad) desat_r8 = desat_r8*hc_loc @@ -642,7 +642,7 @@ subroutine compute_qs_k_3d (temp, press, eps, zvir, qs, nbad, q, hc, & select type (temp) type is (real(kind=r4_kind)) call lookup_es3_des3_k (temp, esloc_r4, desat_r4, nbad) - desat_r4 = desat_r4*hc_loc + desat_r4 = desat_r4*real(hc_loc, kind=r4_kind) type is (real(kind=r8_kind)) call lookup_es3_des3_k (temp, esloc_r8, desat_r8, nbad) desat_r8 = desat_r8*hc_loc @@ -660,7 +660,7 @@ subroutine compute_qs_k_3d (temp, press, eps, zvir, qs, nbad, q, hc, & select type (temp) type is (real(kind=r4_kind)) call lookup_es_des_k (temp, esloc_r4, desat_r4, nbad) - desat_r4 = desat_r4*hc_loc + desat_r4 = desat_r4*real(hc_loc, kind=r4_kind) type is (real(kind=r8_kind)) call lookup_es_des_k (temp, esloc_r8, desat_r8, nbad) desat_r8 = desat_r8*hc_loc @@ -677,7 +677,7 @@ subroutine compute_qs_k_3d (temp, press, eps, zvir, qs, nbad, q, hc, & select type (temp) type is (real(kind=r4_kind)) - esloc_r4 = esloc_r4*hc_loc + esloc_r4 = esloc_r4*real(hc_loc, kind=r4_kind) type is (real(kind=r8_kind)) esloc_r8 = esloc_r8*hc_loc end select @@ -699,23 +699,23 @@ subroutine compute_qs_k_3d (temp, press, eps, zvir, qs, nbad, q, hc, & if (present (q) .and. use_exact_qs) then select type (q) type is (real(kind=r4_kind)) - qs = (1.0 + zvir*q)*eps*esloc_r4/press + qs = (1.0_r4_kind + real(zvir, kind=r4_kind)*q)*real(eps, kind=r4_kind)*esloc_r4/press if (present (dqsdT)) then select type (dqsdT) type is (real(kind=r4_kind)) - dqsdT = (1.0 + zvir*q)*eps*desat_r4/press + dqsdT = (1.0_r4_kind + real(zvir, kind=r4_kind)*q)*real(eps, kind=r4_kind)*desat_r4/press end select endif end select else ! (present(q)) - denom_r4 = press - (1.0 - eps)*esloc_r4 + denom_r4 = press - (1.0_r4_kind - real(eps, kind=r4_kind))*esloc_r4 do k=1,size(qs,3) do j=1,size(qs,2) do i=1,size(qs,1) - if (denom_r4(i,j,k) > 0.0) then - qs(i,j,k) = eps*esloc_r4(i,j,k)/denom_r4(i,j,k) + if (denom_r4(i,j,k) > 0.0_r4_kind) then + qs(i,j,k) = real(eps, kind=r4_kind)*esloc_r4(i,j,k)/denom_r4(i,j,k) else - qs(i,j,k) = eps + qs(i,j,k) = real(eps, kind=r4_kind) endif end do end do @@ -723,7 +723,7 @@ subroutine compute_qs_k_3d (temp, press, eps, zvir, qs, nbad, q, hc, & if (present (dqsdT)) then select type (dqsdT) type is (real(kind=r4_kind)) - dqsdT = eps*press*desat_r4/denom_r4**2 + dqsdT = real(eps, kind=r4_kind)*press*desat_r4/denom_r4**2 end select endif endif ! (present(q)) @@ -767,14 +767,14 @@ subroutine compute_qs_k_3d (temp, press, eps, zvir, qs, nbad, q, hc, & else ! (nbad = 0) select type (qs) type is (real(kind=r4_kind)) - qs = -999. + qs = -999.0_r4_kind type is (real(kind=r8_kind)) qs = -999. end select if (present (dqsdT)) then select type (dqsdT) type is (real(kind=r4_kind)) - dqsdT = -999. + dqsdT = -999.0_r4_kind type is (real(kind=r8_kind)) dqsdT = -999. end select @@ -782,7 +782,7 @@ subroutine compute_qs_k_3d (temp, press, eps, zvir, qs, nbad, q, hc, & if (present (esat)) then select type (esat) type is (real(kind=r4_kind)) - esat = -999. + esat = -999.0_r4_kind type is (real(kind=r8_kind)) esat = -999. end select @@ -813,8 +813,8 @@ subroutine compute_qs_k_2d (temp, press, eps, zvir, qs, nbad, q, hc, & logical,intent(in), optional :: es_over_liq logical,intent(in), optional :: es_over_liq_and_ice - real(kind=r4_kind), allocatable, dimension(:,:) :: esloc_r4, desat_r4, denom_r4 - real(kind=r8_kind), allocatable, dimension(:,:) :: esloc_r8, desat_r8, denom_r8 + real(kind=r4_kind), allocatable, dimension(:,:) :: esloc_r4, desat_r4, denom_r4 !< Local variables to use when called with r4 arguments + real(kind=r8_kind), allocatable, dimension(:,:) :: esloc_r8, desat_r8, denom_r8 !< Local variables to use when called with r8 arguments integer :: i, j real :: hc_loc logical :: valid_types = .false. !< For checking if variable types match @@ -938,7 +938,7 @@ subroutine compute_qs_k_2d (temp, press, eps, zvir, qs, nbad, q, hc, & type is (real(kind=r4_kind)) hc_loc = hc type is (real(kind=r8_kind)) - hc_loc = hc + hc_loc = real(hc) end select else hc_loc = 1.0 @@ -949,7 +949,7 @@ subroutine compute_qs_k_2d (temp, press, eps, zvir, qs, nbad, q, hc, & select type (temp) type is (real(kind=r4_kind)) call lookup_es2_des2_k (temp, esloc_r4, desat_r4, nbad) - desat_r4 = desat_r4*hc_loc + desat_r4 = desat_r4*real(hc_loc, kind=r4_kind) type is (real(kind=r8_kind)) call lookup_es2_des2_k (temp, esloc_r8, desat_r8, nbad) desat_r8 = desat_r8*hc_loc @@ -967,7 +967,7 @@ subroutine compute_qs_k_2d (temp, press, eps, zvir, qs, nbad, q, hc, & select type (temp) type is (real(kind=r4_kind)) call lookup_es3_des3_k (temp, esloc_r4, desat_r4, nbad) - desat_r4 = desat_r4*hc_loc + desat_r4 = desat_r4*real(hc_loc, kind=r4_kind) type is (real(kind=r8_kind)) call lookup_es3_des3_k (temp, esloc_r8, desat_r8, nbad) desat_r8 = desat_r8*hc_loc @@ -985,7 +985,7 @@ subroutine compute_qs_k_2d (temp, press, eps, zvir, qs, nbad, q, hc, & select type (temp) type is (real(kind=r4_kind)) call lookup_es_des_k (temp, esloc_r4, desat_r4, nbad) - desat_r4 = desat_r4*hc_loc + desat_r4 = desat_r4*real(hc_loc, kind=r4_kind) type is (real(kind=r8_kind)) call lookup_es_des_k (temp, esloc_r8, desat_r8, nbad) desat_r8 = desat_r8*hc_loc @@ -1002,7 +1002,7 @@ subroutine compute_qs_k_2d (temp, press, eps, zvir, qs, nbad, q, hc, & select type (temp) type is (real(kind=r4_kind)) - esloc_r4 = esloc_r4*hc_loc + esloc_r4 = esloc_r4*real(hc_loc, kind=r4_kind) type is (real(kind=r8_kind)) esloc_r8 = esloc_r8*hc_loc end select @@ -1024,29 +1024,29 @@ subroutine compute_qs_k_2d (temp, press, eps, zvir, qs, nbad, q, hc, & if (present (q) .and. use_exact_qs) then select type (q) type is (real(kind=r4_kind)) - qs = (1.0 + zvir*q)*eps*esloc_r4/press + qs = (1.0_r4_kind + real(zvir, kind=r4_kind)*q)*real(eps, kind=r4_kind)*esloc_r4/press if (present (dqsdT)) then select type (dqsdT) type is (real(kind=r4_kind)) - dqsdT = (1.0 + zvir*q)*eps*desat_r4/press + dqsdT = (1.0_r4_kind + real(zvir, kind=r4_kind)*q)*real(eps, kind=r4_kind)*desat_r4/press end select endif end select else ! (present(q)) - denom_r4 = press - (1.0 - eps)*esloc_r4 + denom_r4 = press - (1.0_r4_kind - real(eps, kind=r4_kind))*esloc_r4 do j=1,size(qs,2) do i=1,size(qs,1) - if (denom_r4(i,j) > 0.0) then - qs(i,j) = eps*esloc_r4(i,j)/denom_r4(i,j) + if (denom_r4(i,j) > 0.0_r4_kind) then + qs(i,j) = real(eps, kind=r4_kind)*esloc_r4(i,j)/denom_r4(i,j) else - qs(i,j) = eps + qs(i,j) = real(eps, kind=r4_kind) endif end do end do if (present (dqsdT)) then select type (dqsdT) type is (real(kind=r4_kind)) - dqsdT = eps*press*desat_r4/denom_r4**2 + dqsdT = real(eps, kind=r4_kind)*press*desat_r4/denom_r4**2 end select endif endif ! (present(q)) @@ -1088,14 +1088,14 @@ subroutine compute_qs_k_2d (temp, press, eps, zvir, qs, nbad, q, hc, & else ! (nbad = 0) select type (qs) type is (real(kind=r4_kind)) - qs = -999. + qs = -999.0_r4_kind type is (real(kind=r8_kind)) qs = -999. end select if (present (dqsdT)) then select type (dqsdT) type is (real(kind=r4_kind)) - dqsdT = -999. + dqsdT = -999.0_r4_kind type is (real(kind=r8_kind)) dqsdT = -999. end select @@ -1103,7 +1103,7 @@ subroutine compute_qs_k_2d (temp, press, eps, zvir, qs, nbad, q, hc, & if (present (esat)) then select type (esat) type is (real(kind=r4_kind)) - esat = -999. + esat = -999.0_r4_kind type is (real(kind=r8_kind)) esat = -999. end select @@ -1134,8 +1134,8 @@ subroutine compute_qs_k_1d (temp, press, eps, zvir, qs, nbad, q, hc, & logical,intent(in), optional :: es_over_liq logical,intent(in), optional :: es_over_liq_and_ice - real(kind=r4_kind), allocatable, dimension(:) :: esloc_r4, desat_r4, denom_r4 - real(kind=r8_kind), allocatable, dimension(:) :: esloc_r8, desat_r8, denom_r8 + real(kind=r4_kind), allocatable, dimension(:) :: esloc_r4, desat_r4, denom_r4 !< Local variables to use when called with r4 arguments + real(kind=r8_kind), allocatable, dimension(:) :: esloc_r8, desat_r8, denom_r8 !< Local variables to use when called with r8 arguments integer :: i real :: hc_loc logical :: valid_types = .false. !< For checking if variable types match @@ -1259,7 +1259,7 @@ subroutine compute_qs_k_1d (temp, press, eps, zvir, qs, nbad, q, hc, & type is (real(kind=r4_kind)) hc_loc = hc type is (real(kind=r8_kind)) - hc_loc = hc + hc_loc = real(hc) end select else hc_loc = 1.0 @@ -1270,7 +1270,7 @@ subroutine compute_qs_k_1d (temp, press, eps, zvir, qs, nbad, q, hc, & select type (temp) type is (real(kind=r4_kind)) call lookup_es2_des2_k (temp, esloc_r4, desat_r4, nbad) - desat_r4 = desat_r4*hc_loc + desat_r4 = desat_r4*real(hc_loc, kind=r4_kind) type is (real(kind=r8_kind)) call lookup_es2_des2_k (temp, esloc_r8, desat_r8, nbad) desat_r8 = desat_r8*hc_loc @@ -1288,7 +1288,7 @@ subroutine compute_qs_k_1d (temp, press, eps, zvir, qs, nbad, q, hc, & select type (temp) type is (real(kind=r4_kind)) call lookup_es3_des3_k (temp, esloc_r4, desat_r4, nbad) - desat_r4 = desat_r4*hc_loc + desat_r4 = desat_r4*real(hc_loc, kind=r4_kind) type is (real(kind=r8_kind)) call lookup_es3_des3_k (temp, esloc_r8, desat_r8, nbad) desat_r8 = desat_r8*hc_loc @@ -1306,7 +1306,7 @@ subroutine compute_qs_k_1d (temp, press, eps, zvir, qs, nbad, q, hc, & select type (temp) type is (real(kind=r4_kind)) call lookup_es_des_k (temp, esloc_r4, desat_r4, nbad) - desat_r4 = desat_r4*hc_loc + desat_r4 = desat_r4*real(hc_loc, kind=r4_kind) type is (real(kind=r8_kind)) call lookup_es_des_k (temp, esloc_r8, desat_r8, nbad) desat_r8 = desat_r8*hc_loc @@ -1323,7 +1323,7 @@ subroutine compute_qs_k_1d (temp, press, eps, zvir, qs, nbad, q, hc, & select type (temp) type is (real(kind=r4_kind)) - esloc_r4 = esloc_r4*hc_loc + esloc_r4 = esloc_r4*real(hc_loc, kind=r4_kind) type is (real(kind=r8_kind)) esloc_r8 = esloc_r8*hc_loc end select @@ -1345,27 +1345,27 @@ subroutine compute_qs_k_1d (temp, press, eps, zvir, qs, nbad, q, hc, & if (present (q) .and. use_exact_qs) then select type (q) type is (real(kind=r4_kind)) - qs = (1.0 + zvir*q)*eps*esloc_r4/press + qs = (1.0_r4_kind + real(zvir, kind=r4_kind)*q)*real(eps, kind=r4_kind)*esloc_r4/press if (present (dqsdT)) then select type (dqsdT) type is (real(kind=r4_kind)) - dqsdT = (1.0 + zvir*q)*eps*desat_r4/press + dqsdT = (1.0_r4_kind + real(zvir, kind=r4_kind)*q)*real(eps, kind=r4_kind)*desat_r4/press end select endif end select else ! (present(q)) - denom_r4 = press - (1.0 - eps)*esloc_r4 + denom_r4 = press - (1.0_r4_kind - real(eps, kind=r4_kind))*esloc_r4 do i=1,size(qs,1) - if (denom_r4(i) > 0.0) then - qs(i) = eps*esloc_r4(i)/denom_r4(i) + if (denom_r4(i) > 0.0_r4_kind) then + qs(i) = real(eps, kind=r4_kind)*esloc_r4(i)/denom_r4(i) else - qs(i) = eps + qs(i) = real(eps, kind=r4_kind) endif end do if (present (dqsdT)) then select type (dqsdT) type is (real(kind=r4_kind)) - dqsdT = eps*press*desat_r4/denom_r4**2 + dqsdT = real(eps, kind=r4_kind)*press*desat_r4/denom_r4**2 end select endif endif ! (present(q)) @@ -1405,14 +1405,14 @@ subroutine compute_qs_k_1d (temp, press, eps, zvir, qs, nbad, q, hc, & else ! (nbad = 0) select type (qs) type is (real(kind=r4_kind)) - qs = -999. + qs = -999.0_r4_kind type is (real(kind=r8_kind)) qs = -999. end select if (present (dqsdT)) then select type (dqsdT) type is (real(kind=r4_kind)) - dqsdT = -999. + dqsdT = -999.0_r4_kind type is (real(kind=r8_kind)) dqsdT = -999. end select @@ -1420,7 +1420,7 @@ subroutine compute_qs_k_1d (temp, press, eps, zvir, qs, nbad, q, hc, & if (present (esat)) then select type (esat) type is (real(kind=r4_kind)) - esat = -999. + esat = -999.0_r4_kind type is (real(kind=r8_kind)) esat = -999. end select @@ -1451,8 +1451,8 @@ subroutine compute_qs_k_0d (temp, press, eps, zvir, qs, nbad, q, hc, & logical,intent(in), optional :: es_over_liq logical,intent(in), optional :: es_over_liq_and_ice - real(kind=r4_kind) :: esloc_r4, desat_r4, denom_r4 - real(kind=r8_kind) :: esloc_r8, desat_r8, denom_r8 + real(kind=r4_kind) :: esloc_r4, desat_r4, denom_r4 !< Local variables to use when called with r4 arguments + real(kind=r8_kind) :: esloc_r8, desat_r8, denom_r8 !< Local variables to use when called with r8 arguments real :: hc_loc logical :: valid_types = .false. !< For checking if variable types match @@ -1564,7 +1564,7 @@ subroutine compute_qs_k_0d (temp, press, eps, zvir, qs, nbad, q, hc, & type is (real(kind=r4_kind)) hc_loc = hc type is (real(kind=r8_kind)) - hc_loc = hc + hc_loc = real(hc) end select else hc_loc = 1.0 @@ -1575,7 +1575,7 @@ subroutine compute_qs_k_0d (temp, press, eps, zvir, qs, nbad, q, hc, & select type (temp) type is (real(kind=r4_kind)) call lookup_es2_des2_k (temp, esloc_r4, desat_r4, nbad) - desat_r4 = desat_r4*hc_loc + desat_r4 = desat_r4*real(hc_loc, kind=r4_kind) type is (real(kind=r8_kind)) call lookup_es2_des2_k (temp, esloc_r8, desat_r8, nbad) desat_r8 = desat_r8*hc_loc @@ -1593,7 +1593,7 @@ subroutine compute_qs_k_0d (temp, press, eps, zvir, qs, nbad, q, hc, & select type (temp) type is (real(kind=r4_kind)) call lookup_es3_des3_k (temp, esloc_r4, desat_r4, nbad) - desat_r4 = desat_r4*hc_loc + desat_r4 = desat_r4*real(hc_loc, kind=r4_kind) type is (real(kind=r8_kind)) call lookup_es3_des3_k (temp, esloc_r8, desat_r8, nbad) desat_r8 = desat_r8*hc_loc @@ -1611,7 +1611,7 @@ subroutine compute_qs_k_0d (temp, press, eps, zvir, qs, nbad, q, hc, & select type (temp) type is (real(kind=r4_kind)) call lookup_es_des_k (temp, esloc_r4, desat_r4, nbad) - desat_r4 = desat_r4*hc_loc + desat_r4 = desat_r4*real(hc_loc, kind=r4_kind) type is (real(kind=r8_kind)) call lookup_es_des_k (temp, esloc_r8, desat_r8, nbad) desat_r8 = desat_r8*hc_loc @@ -1628,7 +1628,7 @@ subroutine compute_qs_k_0d (temp, press, eps, zvir, qs, nbad, q, hc, & select type (temp) type is (real(kind=r4_kind)) - esloc_r4 = esloc_r4*hc_loc + esloc_r4 = esloc_r4*real(hc_loc, kind=r4_kind) type is (real(kind=r8_kind)) esloc_r8 = esloc_r8*hc_loc end select @@ -1650,25 +1650,25 @@ subroutine compute_qs_k_0d (temp, press, eps, zvir, qs, nbad, q, hc, & if (present (q) .and. use_exact_qs) then select type (q) type is (real(kind=r4_kind)) - qs = (1.0 + zvir*q)*eps*esloc_r4/press + qs = (1.0_r4_kind + real(zvir, kind=r4_kind)*q)*real(eps, kind=r4_kind)*esloc_r4/press if (present (dqsdT)) then select type (dqsdT) type is (real(kind=r4_kind)) - dqsdT = (1.0 + zvir*q)*eps*desat_r4/press + dqsdT = (1.0_r4_kind + real(zvir, kind=r4_kind)*q)*real(eps, kind=r4_kind)*desat_r4/press end select endif end select else ! (present(q)) - denom_r4 = press - (1.0 - eps)*esloc_r4 - if (denom_r4 > 0.0) then - qs = eps*esloc_r4/denom_r4 + denom_r4 = press - (1.0_r4_kind - real(eps, kind=r4_kind))*esloc_r4 + if (denom_r4 > 0.0_r4_kind) then + qs = real(eps, kind=r4_kind)*esloc_r4/denom_r4 else - qs = eps + qs = real(eps, kind=r4_kind) endif if (present (dqsdT)) then select type (dqsdT) type is (real(kind=r4_kind)) - dqsdT = eps*press*desat_r4/denom_r4**2 + dqsdT = real(eps, kind=r4_kind)*press*desat_r4/denom_r4**2 end select endif endif ! (present(q)) @@ -1706,14 +1706,14 @@ subroutine compute_qs_k_0d (temp, press, eps, zvir, qs, nbad, q, hc, & else ! (nbad = 0) select type (qs) type is (real(kind=r4_kind)) - qs = -999. + qs = -999.0_r4_kind type is (real(kind=r8_kind)) qs = -999. end select if (present (dqsdT)) then select type (dqsdT) type is (real(kind=r4_kind)) - dqsdT = -999. + dqsdT = -999.0_r4_kind type is (real(kind=r8_kind)) dqsdT = -999. end select @@ -1721,7 +1721,7 @@ subroutine compute_qs_k_0d (temp, press, eps, zvir, qs, nbad, q, hc, & if (present (esat)) then select type (esat) type is (real(kind=r4_kind)) - esat = -999. + esat = -999.0_r4_kind type is (real(kind=r8_kind)) esat = -999. end select @@ -2121,8 +2121,8 @@ subroutine lookup_es_des_k_3d (temp, esat, desat, nbad) nbad = nbad+1 else del = tmp-dtres*real(ind) - esat(i,j,k) = TABLE(ind+1) + del*(DTABLE(ind+1)+del*D2TABLE(ind+1)) - desat(i,j,k) = DTABLE(ind+1) + 2.*del*D2TABLE(ind+1) + esat(i,j,k) = real(( TABLE(ind+1) + del*(DTABLE(ind+1)+del*D2TABLE(ind+1)) ), kind=r4_kind) + desat(i,j,k) = real(( DTABLE(ind+1) + 2.*del*D2TABLE(ind+1) ), kind=r4_kind) endif enddo enddo @@ -2137,7 +2137,7 @@ subroutine lookup_es_des_k_3d (temp, esat, desat, nbad) do k = 1, size(temp,3) do j = 1, size(temp,2) do i = 1, size(temp,1) - tmp = temp(i,j,k)-tminl + tmp = real(temp(i,j,k))-tminl ind = int(dtinvl*(tmp+tepsl)) if (ind < 0 .or. ind >= table_siz) then nbad = nbad+1 @@ -2205,8 +2205,8 @@ subroutine lookup_es_des_k_2d (temp, esat, desat, nbad) nbad = nbad+1 else del = tmp-dtres*real(ind) - esat(i,j) = TABLE(ind+1) + del*(DTABLE(ind+1)+del*D2TABLE(ind+1)) - desat(i,j) = DTABLE(ind+1) + 2.*del*D2TABLE(ind+1) + esat(i,j) = real(( TABLE(ind+1) + del*(DTABLE(ind+1)+del*D2TABLE(ind+1)) ), kind=r4_kind) + desat(i,j) = real(( DTABLE(ind+1) + 2.*del*D2TABLE(ind+1) ), kind=r4_kind) endif enddo enddo @@ -2219,7 +2219,7 @@ subroutine lookup_es_des_k_2d (temp, esat, desat, nbad) type is (real(kind=r8_kind)) do j = 1, size(temp,2) do i = 1, size(temp,1) - tmp = temp(i,j)-tminl + tmp = real(temp(i,j))-tminl ind = int(dtinvl*(tmp+tepsl)) if (ind < 0 .or. ind >= table_siz) then nbad = nbad+1 @@ -2285,8 +2285,8 @@ subroutine lookup_es_des_k_1d (temp, esat, desat, nbad) nbad = nbad+1 else del = tmp-dtres*real(ind) - esat(i) = TABLE(ind+1) + del*(DTABLE(ind+1)+del*D2TABLE(ind+1)) - desat(i) = DTABLE(ind+1) + 2.*del*D2TABLE(ind+1) + esat(i) = real(( TABLE(ind+1) + del*(DTABLE(ind+1)+del*D2TABLE(ind+1)) ), kind=r4_kind) + desat(i) = real(( DTABLE(ind+1) + 2.*del*D2TABLE(ind+1) ), kind=r4_kind) endif enddo end select @@ -2297,7 +2297,7 @@ subroutine lookup_es_des_k_1d (temp, esat, desat, nbad) select type (desat) type is (real(kind=r8_kind)) do i = 1, size(temp,1) - tmp = temp(i)-tminl + tmp = real(temp(i))-tminl ind = int(dtinvl*(tmp+tepsl)) if (ind < 0 .or. ind >= table_siz) then nbad = nbad+1 @@ -2329,7 +2329,7 @@ subroutine lookup_es_des_k_0d (temp, esat, desat, nbad) type is (real(kind=r4_kind)) tmp = temp-tminl type is (real(kind=r8_kind)) - tmp = temp-tminl + tmp = real(temp)-tminl class default call error_mesg ('sat_vapor_pres_k_mod::lookup_es_des_k_0d',& & 'temp is not one of the supported types of real(kind=4) or real(kind=8)', FATAL) @@ -2342,7 +2342,7 @@ subroutine lookup_es_des_k_0d (temp, esat, desat, nbad) del = tmp-dtres*real(ind) select type (esat) type is (real(kind=r4_kind)) - esat = TABLE(ind+1)+del*(DTABLE(ind+1)+del*D2TABLE(ind+1)) + esat = real(( TABLE(ind+1)+del*(DTABLE(ind+1)+del*D2TABLE(ind+1)) ), kind=r4_kind) type is (real(kind=r8_kind)) esat = TABLE(ind+1)+del*(DTABLE(ind+1)+del*D2TABLE(ind+1)) class default @@ -2352,7 +2352,7 @@ subroutine lookup_es_des_k_0d (temp, esat, desat, nbad) select type (desat) type is (real(kind=r4_kind)) - desat = DTABLE(ind+1) + 2.*del*D2TABLE(ind+1) + desat = real(( DTABLE(ind+1) + 2.*del*D2TABLE(ind+1) ), kind=r4_kind) type is (real(kind=r8_kind)) desat = DTABLE(ind+1) + 2.*del*D2TABLE(ind+1) class default @@ -2405,7 +2405,7 @@ subroutine lookup_es_k_3d(temp, esat, nbad) nbad = nbad+1 else del = tmp-dtres*real(ind) - esat(i,j,k) = TABLE(ind+1)+del*(DTABLE(ind+1)+del*D2TABLE(ind+1)) + esat(i,j,k) = real(( TABLE(ind+1)+del*(DTABLE(ind+1)+del*D2TABLE(ind+1)) ), kind=r4_kind) endif enddo enddo @@ -2417,7 +2417,7 @@ subroutine lookup_es_k_3d(temp, esat, nbad) do k = 1, size(temp,3) do j = 1, size(temp,2) do i = 1, size(temp,1) - tmp = temp(i,j,k)-tminl + tmp = real(temp(i,j,k))-tminl ind = int(dtinvl*(tmp+tepsl)) if (ind < 0 .or. ind >= table_siz) then nbad = nbad+1 @@ -2475,7 +2475,7 @@ subroutine lookup_des_k_3d(temp, desat, nbad) nbad = nbad+1 else del = tmp-dtres*real(ind) - desat(i,j,k) = DTABLE(ind+1) + 2.*del*D2TABLE(ind+1) + desat(i,j,k) = real(( DTABLE(ind+1) + 2.*del*D2TABLE(ind+1) ), kind=r4_kind) endif enddo enddo @@ -2487,7 +2487,7 @@ subroutine lookup_des_k_3d(temp, desat, nbad) do k = 1, size(temp,3) do j = 1, size(temp,2) do i = 1, size(temp,1) - tmp = temp(i,j,k)-tminl + tmp = real(temp(i,j,k))-tminl ind = int(dtinvl*(tmp+tepsl)) if (ind < 0 .or. ind >= table_siz) then nbad = nbad+1 @@ -2543,7 +2543,7 @@ subroutine lookup_des_k_2d(temp, desat, nbad) nbad = nbad+1 else del = tmp-dtres*real(ind) - desat(i,j) = DTABLE(ind+1) + 2.*del*D2TABLE(ind+1) + desat(i,j) = real(( DTABLE(ind+1) + 2.*del*D2TABLE(ind+1) ), kind=r4_kind) endif enddo enddo @@ -2553,7 +2553,7 @@ subroutine lookup_des_k_2d(temp, desat, nbad) type is (real(kind=r8_kind)) do j = 1, size(temp,2) do i = 1, size(temp,1) - tmp = temp(i,j)-tminl + tmp = real(temp(i,j))-tminl ind = int(dtinvl*(tmp+tepsl)) if (ind < 0 .or. ind >= table_siz) then nbad = nbad+1 @@ -2607,7 +2607,7 @@ subroutine lookup_es_k_2d(temp, esat, nbad) nbad = nbad+1 else del = tmp-dtres*real(ind) - esat(i,j) = TABLE(ind+1)+del*(DTABLE(ind+1)+del*D2TABLE(ind+1)) + esat(i,j) = real(( TABLE(ind+1)+del*(DTABLE(ind+1)+del*D2TABLE(ind+1)) ), kind=r4_kind) endif enddo enddo @@ -2617,7 +2617,7 @@ subroutine lookup_es_k_2d(temp, esat, nbad) type is (real(kind=r8_kind)) do j = 1, size(temp,2) do i = 1, size(temp,1) - tmp = temp(i,j)-tminl + tmp = real(temp(i,j))-tminl ind = int(dtinvl*(tmp+tepsl)) if (ind < 0 .or. ind >= table_siz) then nbad = nbad+1 @@ -2670,7 +2670,7 @@ subroutine lookup_des_k_1d(temp, desat, nbad) nbad = nbad+1 else del = tmp-dtres*real(ind) - desat(i) = DTABLE(ind+1) + 2.*del*D2TABLE(ind+1) + desat(i) = real(( DTABLE(ind+1) + 2.*del*D2TABLE(ind+1) ), kind=r4_kind) endif enddo end select @@ -2678,7 +2678,7 @@ subroutine lookup_des_k_1d(temp, desat, nbad) select type (desat) type is (real(kind=r8_kind)) do i = 1, size(temp,1) - tmp = temp(i)-tminl + tmp = real(temp(i))-tminl ind = int(dtinvl*(tmp+tepsl)) if (ind < 0 .or. ind >= table_siz) then nbad = nbad+1 @@ -2730,7 +2730,7 @@ subroutine lookup_es_k_1d(temp, esat, nbad) nbad = nbad+1 else del = tmp-dtres*real(ind) - esat(i) = TABLE(ind+1) + del*(DTABLE(ind+1) + del*D2TABLE(ind+1)) + esat(i) = real(( TABLE(ind+1) + del*(DTABLE(ind+1) + del*D2TABLE(ind+1)) ), kind=r4_kind) endif enddo end select @@ -2738,7 +2738,7 @@ subroutine lookup_es_k_1d(temp, esat, nbad) select type (esat) type is (real(kind=r8_kind)) do i = 1, size(temp,1) - tmp = temp(i)-tminl + tmp = real(temp(i))-tminl ind = int(dtinvl*(tmp+tepsl)) if (ind < 0 .or. ind >= table_siz) then nbad = nbad+1 @@ -2765,7 +2765,7 @@ subroutine lookup_des_k_0d(temp, desat, nbad) type is (real(kind=r4_kind)) tmp = temp-tminl type is (real(kind=r8_kind)) - tmp = temp-tminl + tmp = real(temp)-tminl class default call error_mesg ('sat_vapor_pres_k_mod::lookup_des_k_0d',& & 'temp is not one of the supported types of real(kind=4) or real(kind=8)', FATAL) @@ -2778,7 +2778,7 @@ subroutine lookup_des_k_0d(temp, desat, nbad) del = tmp-dtres*real(ind) select type (desat) type is (real(kind=r4_kind)) - desat = DTABLE(ind+1) + 2.*del*D2TABLE(ind+1) + desat = real(( DTABLE(ind+1) + 2.*del*D2TABLE(ind+1) ), kind=r4_kind) type is (real(kind=r8_kind)) desat = DTABLE(ind+1) + 2.*del*D2TABLE(ind+1) class default @@ -2802,7 +2802,7 @@ subroutine lookup_es_k_0d(temp, esat, nbad) type is (real(kind=r4_kind)) tmp = temp-tminl type is (real(kind=r8_kind)) - tmp = temp-tminl + tmp = real(temp)-tminl class default call error_mesg ('sat_vapor_pres_k_mod::lookup_k_0d',& & 'temp is not one of the supported types of real(kind=4) or real(kind=8)', FATAL) @@ -2815,7 +2815,7 @@ subroutine lookup_es_k_0d(temp, esat, nbad) del = tmp-dtres*real(ind) select type (esat) type is (real(kind=r4_kind)) - esat = TABLE(ind+1) + del*(DTABLE(ind+1) + del*D2TABLE(ind+1)) + esat = real(( TABLE(ind+1) + del*(DTABLE(ind+1) + del*D2TABLE(ind+1)) ), kind=r4_kind) type is (real(kind=r8_kind)) esat = TABLE(ind+1) + del*(DTABLE(ind+1) + del*D2TABLE(ind+1)) class default @@ -2876,8 +2876,8 @@ subroutine lookup_es2_des2_k_3d (temp, esat, desat, nbad) nbad = nbad+1 else del = tmp-dtres*real(ind) - esat(i,j,k) = TABLE2(ind+1) + del*(DTABLE2(ind+1)+del*D2TABLE2(ind+1)) - desat(i,j,k) = DTABLE2(ind+1) + 2.*del*D2TABLE2(ind+1) + esat(i,j,k) = real(( TABLE2(ind+1) + del*(DTABLE2(ind+1)+del*D2TABLE2(ind+1)) ), kind=r4_kind) + desat(i,j,k) = real(( DTABLE2(ind+1) + 2.*del*D2TABLE2(ind+1) ), kind=r4_kind) endif enddo enddo @@ -2892,7 +2892,7 @@ subroutine lookup_es2_des2_k_3d (temp, esat, desat, nbad) do k = 1, size(temp,3) do j = 1, size(temp,2) do i = 1, size(temp,1) - tmp = temp(i,j,k)-tminl + tmp = real(temp(i,j,k))-tminl ind = int(dtinvl*(tmp+tepsl)) if (ind < 0 .or. ind >= table_siz) then nbad = nbad+1 @@ -2960,8 +2960,8 @@ subroutine lookup_es2_des2_k_2d (temp, esat, desat, nbad) nbad = nbad+1 else del = tmp-dtres*real(ind) - esat(i,j) = TABLE2(ind+1) + del*(DTABLE2(ind+1)+del*D2TABLE2(ind+1)) - desat(i,j) = DTABLE2(ind+1) + 2.*del*D2TABLE2(ind+1) + esat(i,j) = real(( TABLE2(ind+1) + del*(DTABLE2(ind+1)+del*D2TABLE2(ind+1)) ), kind=r4_kind) + desat(i,j) = real(( DTABLE2(ind+1) + 2.*del*D2TABLE2(ind+1) ), kind=r4_kind) endif enddo enddo @@ -2974,7 +2974,7 @@ subroutine lookup_es2_des2_k_2d (temp, esat, desat, nbad) type is (real(kind=r8_kind)) do j = 1, size(temp,2) do i = 1, size(temp,1) - tmp = temp(i,j)-tminl + tmp = real(temp(i,j))-tminl ind = int(dtinvl*(tmp+tepsl)) if (ind < 0 .or. ind >= table_siz) then nbad = nbad+1 @@ -3040,8 +3040,8 @@ subroutine lookup_es2_des2_k_1d (temp, esat, desat, nbad) nbad = nbad+1 else del = tmp-dtres*real(ind) - esat(i) = TABLE2(ind+1) + del*(DTABLE2(ind+1)+del*D2TABLE2(ind+1)) - desat(i) = DTABLE2(ind+1) + 2.*del*D2TABLE2(ind+1) + esat(i) = real(( TABLE2(ind+1) + del*(DTABLE2(ind+1)+del*D2TABLE2(ind+1)) ), kind=r4_kind) + desat(i) = real(( DTABLE2(ind+1) + 2.*del*D2TABLE2(ind+1) ), kind=r4_kind) endif enddo end select @@ -3052,7 +3052,7 @@ subroutine lookup_es2_des2_k_1d (temp, esat, desat, nbad) select type (desat) type is (real(kind=r8_kind)) do i = 1, size(temp,1) - tmp = temp(i)-tminl + tmp = real(temp(i))-tminl ind = int(dtinvl*(tmp+tepsl)) if (ind < 0 .or. ind >= table_siz) then nbad = nbad+1 @@ -3084,7 +3084,7 @@ subroutine lookup_es2_des2_k_0d (temp, esat, desat, nbad) type is (real(kind=r4_kind)) tmp = temp-tminl type is (real(kind=r8_kind)) - tmp = temp-tminl + tmp = real(temp)-tminl class default call error_mesg ('sat_vapor_pres_k_mod::lookup_es2_des2_k_0d',& & 'temp is not one of the supported types of real(kind=4) or real(kind=8)', FATAL) @@ -3097,7 +3097,7 @@ subroutine lookup_es2_des2_k_0d (temp, esat, desat, nbad) del = tmp-dtres*real(ind) select type (esat) type is (real(kind=r4_kind)) - esat = TABLE2(ind+1) + del*(DTABLE2(ind+1)+del*D2TABLE2(ind+1)) + esat = real(( TABLE2(ind+1) + del*(DTABLE2(ind+1)+del*D2TABLE2(ind+1)) ), kind=r4_kind) type is (real(kind=r8_kind)) esat = TABLE2(ind+1) + del*(DTABLE2(ind+1)+del*D2TABLE2(ind+1)) class default @@ -3107,7 +3107,7 @@ subroutine lookup_es2_des2_k_0d (temp, esat, desat, nbad) select type (desat) type is (real(kind=r4_kind)) - desat = DTABLE2(ind+1) + 2.*del*D2TABLE2(ind+1) + desat = real(( DTABLE2(ind+1) + 2.*del*D2TABLE2(ind+1) ), kind=r4_kind) type is (real(kind=r8_kind)) desat = DTABLE2(ind+1) + 2.*del*D2TABLE2(ind+1) class default @@ -3160,7 +3160,7 @@ subroutine lookup_es2_k_3d(temp, esat, nbad) nbad = nbad+1 else del = tmp-dtres*real(ind) - esat(i,j,k) = TABLE2(ind+1)+del*(DTABLE2(ind+1)+del*D2TABLE2(ind+1)) + esat(i,j,k) = real(( TABLE2(ind+1)+del*(DTABLE2(ind+1)+del*D2TABLE2(ind+1)) ), kind=r4_kind) endif enddo enddo @@ -3172,7 +3172,7 @@ subroutine lookup_es2_k_3d(temp, esat, nbad) do k = 1, size(temp,3) do j = 1, size(temp,2) do i = 1, size(temp,1) - tmp = temp(i,j,k)-tminl + tmp = real(temp(i,j,k))-tminl ind = int(dtinvl*(tmp+tepsl)) if (ind < 0 .or. ind >= table_siz) then nbad = nbad+1 @@ -3230,7 +3230,7 @@ subroutine lookup_des2_k_3d(temp, desat, nbad) nbad = nbad+1 else del = tmp-dtres*real(ind) - desat(i,j,k) = DTABLE2(ind+1) + 2.*del*D2TABLE2(ind+1) + desat(i,j,k) = real(( DTABLE2(ind+1) + 2.*del*D2TABLE2(ind+1) ), kind=r4_kind) endif enddo enddo @@ -3242,7 +3242,7 @@ subroutine lookup_des2_k_3d(temp, desat, nbad) do k = 1, size(temp,3) do j = 1, size(temp,2) do i = 1, size(temp,1) - tmp = temp(i,j,k)-tminl + tmp = real(temp(i,j,k))-tminl ind = int(dtinvl*(tmp+tepsl)) if (ind < 0 .or. ind >= table_siz) then nbad = nbad+1 @@ -3298,7 +3298,7 @@ subroutine lookup_des2_k_2d(temp, desat, nbad) nbad = nbad+1 else del = tmp-dtres*real(ind) - desat(i,j) = DTABLE2(ind+1) + 2.*del*D2TABLE2(ind+1) + desat(i,j) = real(( DTABLE2(ind+1) + 2.*del*D2TABLE2(ind+1) ), kind=r4_kind) endif enddo enddo @@ -3308,7 +3308,7 @@ subroutine lookup_des2_k_2d(temp, desat, nbad) type is (real(kind=r8_kind)) do j = 1, size(temp,2) do i = 1, size(temp,1) - tmp = temp(i,j)-tminl + tmp = real(temp(i,j))-tminl ind = int(dtinvl*(tmp+tepsl)) if (ind < 0 .or. ind >= table_siz) then nbad = nbad+1 @@ -3362,7 +3362,7 @@ subroutine lookup_es2_k_2d(temp, esat, nbad) nbad = nbad+1 else del = tmp-dtres*real(ind) - esat(i,j) = TABLE2(ind+1)+del*(DTABLE2(ind+1)+del*D2TABLE2(ind+1)) + esat(i,j) = real(( TABLE2(ind+1)+del*(DTABLE2(ind+1)+del*D2TABLE2(ind+1)) ), kind=r4_kind) endif enddo enddo @@ -3372,7 +3372,7 @@ subroutine lookup_es2_k_2d(temp, esat, nbad) type is (real(kind=r8_kind)) do j = 1, size(temp,2) do i = 1, size(temp,1) - tmp = temp(i,j)-tminl + tmp = real(temp(i,j))-tminl ind = int(dtinvl*(tmp+tepsl)) if (ind < 0 .or. ind >= table_siz) then nbad = nbad+1 @@ -3425,7 +3425,7 @@ subroutine lookup_des2_k_1d(temp, desat, nbad) nbad = nbad+1 else del = tmp-dtres*real(ind) - desat(i) = DTABLE2(ind+1) + 2.*del*D2TABLE2(ind+1) + desat(i) = real(( DTABLE2(ind+1) + 2.*del*D2TABLE2(ind+1) ), kind=r4_kind) endif enddo end select @@ -3433,7 +3433,7 @@ subroutine lookup_des2_k_1d(temp, desat, nbad) select type (desat) type is (real(kind=r8_kind)) do i = 1, size(temp,1) - tmp = temp(i)-tminl + tmp = real(temp(i))-tminl ind = int(dtinvl*(tmp+tepsl)) if (ind < 0 .or. ind >= table_siz) then nbad = nbad+1 @@ -3485,7 +3485,7 @@ subroutine lookup_es2_k_1d(temp, esat, nbad) nbad = nbad+1 else del = tmp-dtres*real(ind) - esat(i) = TABLE2(ind+1) + del*(DTABLE2(ind+1) + del*D2TABLE2(ind+1)) + esat(i) = real(( TABLE2(ind+1) + del*(DTABLE2(ind+1) + del*D2TABLE2(ind+1)) ), kind=r4_kind) endif enddo end select @@ -3493,7 +3493,7 @@ subroutine lookup_es2_k_1d(temp, esat, nbad) select type (esat) type is (real(kind=r8_kind)) do i = 1, size(temp,1) - tmp = temp(i)-tminl + tmp = real(temp(i))-tminl ind = int(dtinvl*(tmp+tepsl)) if (ind < 0 .or. ind >= table_siz) then nbad = nbad+1 @@ -3520,7 +3520,7 @@ subroutine lookup_des2_k_0d(temp, desat, nbad) type is (real(kind=r4_kind)) tmp = temp-tminl type is (real(kind=r8_kind)) - tmp = temp-tminl + tmp = real(temp)-tminl class default call error_mesg ('sat_vapor_pres_k_mod::lookup_des2_k_0d',& & 'temp is not one of the supported types of real(kind=4) or real(kind=8)', FATAL) @@ -3533,7 +3533,7 @@ subroutine lookup_des2_k_0d(temp, desat, nbad) del = tmp-dtres*real(ind) select type (desat) type is (real(kind=r4_kind)) - desat = DTABLE2(ind+1) + 2.*del*D2TABLE2(ind+1) + desat = real(( DTABLE2(ind+1) + 2.*del*D2TABLE2(ind+1) ), kind=r4_kind) type is (real(kind=r8_kind)) desat = DTABLE2(ind+1) + 2.*del*D2TABLE2(ind+1) class default @@ -3557,7 +3557,7 @@ subroutine lookup_es2_k_0d(temp, esat, nbad) type is (real(kind=r4_kind)) tmp = temp-tminl type is (real(kind=r8_kind)) - tmp = temp-tminl + tmp = real(temp)-tminl class default call error_mesg ('sat_vapor_pres_k_mod::lookup_es2_k_0d',& & 'temp is not one of the supported types of real(kind=4) or real(kind=8)', FATAL) @@ -3570,7 +3570,7 @@ subroutine lookup_es2_k_0d(temp, esat, nbad) del = tmp-dtres*real(ind) select type (esat) type is (real(kind=r4_kind)) - esat = TABLE2(ind+1) + del*(DTABLE2(ind+1) + del*D2TABLE2(ind+1)) + esat = real(( TABLE2(ind+1) + del*(DTABLE2(ind+1) + del*D2TABLE2(ind+1))), kind=r4_kind) type is (real(kind=r8_kind)) esat = TABLE2(ind+1) + del*(DTABLE2(ind+1) + del*D2TABLE2(ind+1)) class default @@ -3633,8 +3633,8 @@ subroutine lookup_es3_des3_k_3d (temp, esat, desat, nbad) nbad = nbad+1 else del = tmp-dtres*real(ind) - esat(i,j,k) = TABLE3(ind+1) + del*(DTABLE3(ind+1)+del*D2TABLE3(ind+1)) - desat(i,j,k) = DTABLE3(ind+1) + 2.*del*D2TABLE3(ind+1) + esat(i,j,k) = real(( TABLE3(ind+1) + del*(DTABLE3(ind+1)+del*D2TABLE3(ind+1)) ), kind=r4_kind) + desat(i,j,k) = real(( DTABLE3(ind+1) + 2.*del*D2TABLE3(ind+1) ), kind=r4_kind) endif enddo enddo @@ -3649,7 +3649,7 @@ subroutine lookup_es3_des3_k_3d (temp, esat, desat, nbad) do k = 1, size(temp,3) do j = 1, size(temp,2) do i = 1, size(temp,1) - tmp = temp(i,j,k)-tminl + tmp = real(temp(i,j,k))-tminl ind = int(dtinvl*(tmp+tepsl)) if (ind < 0 .or. ind >= table_siz) then nbad = nbad+1 @@ -3717,8 +3717,8 @@ subroutine lookup_es3_des3_k_2d (temp, esat, desat, nbad) nbad = nbad+1 else del = tmp-dtres*real(ind) - esat(i,j) = TABLE3(ind+1) + del*(DTABLE3(ind+1)+del*D2TABLE3(ind+1)) - desat(i,j) = DTABLE3(ind+1) + 2.*del*D2TABLE3(ind+1) + esat(i,j) = real(( TABLE3(ind+1) + del*(DTABLE3(ind+1)+del*D2TABLE3(ind+1)) ), kind=r4_kind) + desat(i,j) = real(( DTABLE3(ind+1) + 2.*del*D2TABLE3(ind+1) ), kind=r4_kind) endif enddo enddo @@ -3731,7 +3731,7 @@ subroutine lookup_es3_des3_k_2d (temp, esat, desat, nbad) type is (real(kind=r8_kind)) do j = 1, size(temp,2) do i = 1, size(temp,1) - tmp = temp(i,j)-tminl + tmp = real(temp(i,j))-tminl ind = int(dtinvl*(tmp+tepsl)) if (ind < 0 .or. ind >= table_siz) then nbad = nbad+1 @@ -3797,8 +3797,8 @@ subroutine lookup_es3_des3_k_1d (temp, esat, desat, nbad) nbad = nbad+1 else del = tmp-dtres*real(ind) - esat(i) = TABLE3(ind+1) + del*(DTABLE3(ind+1)+del*D2TABLE3(ind+1)) - desat(i) = DTABLE3(ind+1) + 2.*del*D2TABLE3(ind+1) + esat(i) = real(( TABLE3(ind+1) + del*(DTABLE3(ind+1)+del*D2TABLE3(ind+1)) ), kind=r4_kind) + desat(i) = real(( DTABLE3(ind+1) + 2.*del*D2TABLE3(ind+1) ), kind=r4_kind) endif enddo end select @@ -3809,7 +3809,7 @@ subroutine lookup_es3_des3_k_1d (temp, esat, desat, nbad) select type (desat) type is (real(kind=r8_kind)) do i = 1, size(temp,1) - tmp = temp(i)-tminl + tmp = real(temp(i))-tminl ind = int(dtinvl*(tmp+tepsl)) if (ind < 0 .or. ind >= table_siz) then nbad = nbad+1 @@ -3841,7 +3841,7 @@ subroutine lookup_es3_des3_k_0d (temp, esat, desat, nbad) type is (real(kind=r4_kind)) tmp = temp-tminl type is (real(kind=r8_kind)) - tmp = temp-tminl + tmp = real(temp)-tminl class default call error_mesg ('sat_vapor_pres_k_mod::lookup_es3_des3_k_0d',& & 'temp is not one of the supported types of real(kind=4) or real(kind=8)', FATAL) @@ -3854,7 +3854,7 @@ subroutine lookup_es3_des3_k_0d (temp, esat, desat, nbad) del = tmp-dtres*real(ind) select type (esat) type is (real(kind=r4_kind)) - esat = TABLE3(ind+1) + del*(DTABLE3(ind+1)+del*D2TABLE3(ind+1)) + esat = real(( TABLE3(ind+1) + del*(DTABLE3(ind+1)+del*D2TABLE3(ind+1)) ), kind=r4_kind) type is (real(kind=r8_kind)) esat = TABLE3(ind+1) + del*(DTABLE3(ind+1)+del*D2TABLE3(ind+1)) class default @@ -3864,7 +3864,7 @@ subroutine lookup_es3_des3_k_0d (temp, esat, desat, nbad) select type (desat) type is (real(kind=r4_kind)) - desat = DTABLE3(ind+1) + 2.*del*D2TABLE3(ind+1) + desat = real(( DTABLE3(ind+1) + 2.*del*D2TABLE3(ind+1) ), kind=r4_kind) type is (real(kind=r8_kind)) desat = DTABLE3(ind+1) + 2.*del*D2TABLE3(ind+1) class default @@ -3917,7 +3917,7 @@ subroutine lookup_es3_k_3d(temp, esat, nbad) nbad = nbad+1 else del = tmp-dtres*real(ind) - esat(i,j,k) = TABLE3(ind+1)+del*(DTABLE3(ind+1)+del*D2TABLE3(ind+1)) + esat(i,j,k) = real(( TABLE3(ind+1)+del*(DTABLE3(ind+1)+del*D2TABLE3(ind+1)) ), kind=r4_kind) endif enddo enddo @@ -3929,7 +3929,7 @@ subroutine lookup_es3_k_3d(temp, esat, nbad) do k = 1, size(temp,3) do j = 1, size(temp,2) do i = 1, size(temp,1) - tmp = temp(i,j,k)-tminl + tmp = real(temp(i,j,k))-tminl ind = int(dtinvl*(tmp+tepsl)) if (ind < 0 .or. ind >= table_siz) then nbad = nbad+1 @@ -3987,7 +3987,7 @@ subroutine lookup_des3_k_3d(temp, desat, nbad) nbad = nbad+1 else del = tmp-dtres*real(ind) - desat(i,j,k) = DTABLE3(ind+1) + 2.*del*D2TABLE3(ind+1) + desat(i,j,k) = real(( DTABLE3(ind+1) + 2.*del*D2TABLE3(ind+1) ), kind=r4_kind) endif enddo enddo @@ -3999,7 +3999,7 @@ subroutine lookup_des3_k_3d(temp, desat, nbad) do k = 1, size(temp,3) do j = 1, size(temp,2) do i = 1, size(temp,1) - tmp = temp(i,j,k)-tminl + tmp = real(temp(i,j,k))-tminl ind = int(dtinvl*(tmp+tepsl)) if (ind < 0 .or. ind >= table_siz) then nbad = nbad+1 @@ -4055,7 +4055,7 @@ subroutine lookup_des3_k_2d(temp, desat, nbad) nbad = nbad+1 else del = tmp-dtres*real(ind) - desat(i,j) = DTABLE3(ind+1) + 2.*del*D2TABLE3(ind+1) + desat(i,j) = real(( DTABLE3(ind+1) + 2.*del*D2TABLE3(ind+1) ), kind=r4_kind) endif enddo enddo @@ -4065,7 +4065,7 @@ subroutine lookup_des3_k_2d(temp, desat, nbad) type is (real(kind=r8_kind)) do j = 1, size(temp,2) do i = 1, size(temp,1) - tmp = temp(i,j)-tminl + tmp = real(temp(i,j))-tminl ind = int(dtinvl*(tmp+tepsl)) if (ind < 0 .or. ind >= table_siz) then nbad = nbad+1 @@ -4119,7 +4119,7 @@ subroutine lookup_es3_k_2d(temp, esat, nbad) nbad = nbad+1 else del = tmp-dtres*real(ind) - esat(i,j) = TABLE3(ind+1)+del*(DTABLE3(ind+1)+del*D2TABLE3(ind+1)) + esat(i,j) = real(( TABLE3(ind+1)+del*(DTABLE3(ind+1)+del*D2TABLE3(ind+1)) ), kind=r4_kind) endif enddo enddo @@ -4129,7 +4129,7 @@ subroutine lookup_es3_k_2d(temp, esat, nbad) type is (real(kind=r8_kind)) do j = 1, size(temp,2) do i = 1, size(temp,1) - tmp = temp(i,j)-tminl + tmp = real(temp(i,j))-tminl ind = int(dtinvl*(tmp+tepsl)) if (ind < 0 .or. ind >= table_siz) then nbad = nbad+1 @@ -4182,7 +4182,7 @@ subroutine lookup_des3_k_1d(temp, desat, nbad) nbad = nbad+1 else del = tmp-dtres*real(ind) - desat(i) = DTABLE3(ind+1) + 2.*del*D2TABLE3(ind+1) + desat(i) = real(( DTABLE3(ind+1) + 2.*del*D2TABLE3(ind+1) ), kind=r4_kind) endif enddo end select @@ -4190,7 +4190,7 @@ subroutine lookup_des3_k_1d(temp, desat, nbad) select type (desat) type is (real(kind=r8_kind)) do i = 1, size(temp,1) - tmp = temp(i)-tminl + tmp = real(temp(i))-tminl ind = int(dtinvl*(tmp+tepsl)) if (ind < 0 .or. ind >= table_siz) then nbad = nbad+1 @@ -4242,7 +4242,7 @@ subroutine lookup_es3_k_1d(temp, esat, nbad) nbad = nbad+1 else del = tmp-dtres*real(ind) - esat(i) = TABLE3(ind+1) + del*(DTABLE3(ind+1) + del*D2TABLE3(ind+1)) + esat(i) = real(( TABLE3(ind+1) + del*(DTABLE3(ind+1) + del*D2TABLE3(ind+1)) ), kind=r4_kind) endif enddo end select @@ -4250,7 +4250,7 @@ subroutine lookup_es3_k_1d(temp, esat, nbad) select type (esat) type is (real(kind=r8_kind)) do i = 1, size(temp,1) - tmp = temp(i)-tminl + tmp = real(temp(i))-tminl ind = int(dtinvl*(tmp+tepsl)) if (ind < 0 .or. ind >= table_siz) then nbad = nbad+1 @@ -4277,7 +4277,7 @@ subroutine lookup_des3_k_0d(temp, desat, nbad) type is (real(kind=r4_kind)) tmp = temp-tminl type is (real(kind=r8_kind)) - tmp = temp-tminl + tmp = real(temp)-tminl class default call error_mesg ('sat_vapor_pres_k_mod::lookup_des3_k_0d',& & 'temp is not one of the supported types of real(kind=4) or real(kind=8)', FATAL) @@ -4290,7 +4290,7 @@ subroutine lookup_des3_k_0d(temp, desat, nbad) del = tmp-dtres*real(ind) select type (desat) type is (real(kind=r4_kind)) - desat = DTABLE3(ind+1) + 2.*del*D2TABLE3(ind+1) + desat = real(( DTABLE3(ind+1) + 2.*del*D2TABLE3(ind+1) ), kind=r4_kind) type is (real(kind=r8_kind)) desat = DTABLE3(ind+1) + 2.*del*D2TABLE3(ind+1) class default @@ -4314,7 +4314,7 @@ subroutine lookup_es3_k_0d(temp, esat, nbad) type is (real(kind=r4_kind)) tmp = temp-tminl type is (real(kind=r8_kind)) - tmp = temp-tminl + tmp = real(temp)-tminl class default call error_mesg ('sat_vapor_pres_k_mod::lookup_es3_k_0d',& & 'temp is not one of the supported types of real(kind=4) or real(kind=8)', FATAL) @@ -4327,7 +4327,7 @@ subroutine lookup_es3_k_0d(temp, esat, nbad) del = tmp-dtres*real(ind) select type (esat) type is (real(kind=r4_kind)) - esat = TABLE3(ind+1) + del*(DTABLE3(ind+1) + del*D2TABLE3(ind+1)) + esat = real(( TABLE3(ind+1) + del*(DTABLE3(ind+1) + del*D2TABLE3(ind+1))), kind=r4_kind) type is (real(kind=r8_kind)) esat = TABLE3(ind+1) + del*(DTABLE3(ind+1) + del*D2TABLE3(ind+1)) class default diff --git a/time_manager/time_manager.F90 b/time_manager/time_manager.F90 index fd2d1f4e3a..02eee5721c 100644 --- a/time_manager/time_manager.F90 +++ b/time_manager/time_manager.F90 @@ -1218,7 +1218,7 @@ function real_to_time_type(x,err_msg) result(t) type is (real(kind=r4_kind)) a = x/spd type is (real(kind=r8_kind)) - a = x/spd + a = real(x)/spd class default call error_mesg('time_manager_mod::real_to_time_type',& & 'x is not one of the supported types of real(kind=4) or real(kind=8)', FATAL) @@ -1230,7 +1230,7 @@ function real_to_time_type(x,err_msg) result(t) type is (real(kind=r4_kind)) a = x - real(days)*spd type is (real(kind=r8_kind)) - a = x - real(days)*spd + a = real(x) - real(days)*spd class default call error_mesg('time_manager_mod::real_to_time_type',& & 'x is not one of the supported types of real(kind=4) or real(kind=8)', FATAL)