Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Code changes to address GFDL FMS code review comments #11

Merged
merged 1 commit into from
Nov 12, 2021
Merged

Code changes to address GFDL FMS code review comments #11

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
4 changes: 4 additions & 0 deletions diag_manager/diag_axis.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -236,6 +236,8 @@ INTEGER FUNCTION diag_axis_init(name, DATA, units, cart_name, long_name, directi
Axes(diag_axis_init)%data = DATA(1:axlen)
TYPE IS (real(kind=r8_kind))
Axes(diag_axis_init)%data = DATA(1:axlen)
CLASS DEFAULT
CALL error_mesg('diag_axis_mod::diag_axis_init', 'unsupported kind', FATAL)
END SELECT
Axes(diag_axis_init)%units = units
Axes(diag_axis_init)%length = axlen
Expand Down Expand Up @@ -491,6 +493,8 @@ SUBROUTINE get_diag_axis(id, name, units, long_name, cart_name,&
DATA(1:Axes(id)%length) = Axes(id)%data(1:Axes(id)%length)
TYPE IS (real(kind=r8_kind))
DATA(1:Axes(id)%length) = Axes(id)%data(1:Axes(id)%length)
CLASS DEFAULT
CALL error_mesg('diag_axis_mod::get_diag_axis', 'unsupported kind', FATAL)
END SELECT
END IF
IF ( PRESENT(num_attributes) ) THEN
Expand Down
12 changes: 12 additions & 0 deletions diag_manager/diag_grid.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -259,27 +259,35 @@ SUBROUTINE diag_grid_init(domain, glo_lat, glo_lon, aglo_lat, aglo_lon)
diag_global_grid%aglo_lat = TRANSPOSE(aglo_lat)
TYPE IS (real(kind=r8_kind))
diag_global_grid%aglo_lat = TRANSPOSE(aglo_lat)
CLASS DEFAULT
CALL error_mesg('diag_grid_mod::diag_grid_init', 'unsupported kind', FATAL)
END SELECT

SELECT TYPE (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)
CLASS DEFAULT
CALL error_mesg('diag_grid_mod::diag_grid_init', 'unsupported kind', FATAL)
END SELECT
ELSE
SELECT TYPE (aglo_lat)
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
CLASS DEFAULT
CALL error_mesg('diag_grid_mod::diag_grid_init', 'unsupported kind', FATAL)
END SELECT

SELECT TYPE (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
CLASS DEFAULT
CALL error_mesg('diag_grid_mod::diag_grid_init', 'unsupported kind', FATAL)
END SELECT
END IF

Expand All @@ -288,13 +296,17 @@ SUBROUTINE diag_grid_init(domain, glo_lat, glo_lon, aglo_lat, aglo_lon)
diag_global_grid%glo_lat = glo_lat
TYPE IS (real(kind=r8_kind))
diag_global_grid%glo_lat = glo_lat
CLASS DEFAULT
CALL error_mesg('diag_grid_mod::diag_grid_init', 'unsupported kind', FATAL)
END SELECT

SELECT TYPE (glo_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
CLASS DEFAULT
CALL error_mesg('diag_grid_mod::diag_grid_init', 'unsupported kind', FATAL)
END SELECT

diag_global_grid%dimI = i_dim
Expand Down
26 changes: 26 additions & 0 deletions diag_manager/diag_manager.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -647,6 +647,8 @@ INTEGER FUNCTION register_static_field(module_name, field_name, axes, long_name,
missing_value_use = missing_value
TYPE IS (real(kind=r8_kind))
missing_value_use = missing_value
CLASS DEFAULT
CALL error_mesg ('diag_manager_mod::register_static_field', 'unsupported kind', FATAL)
END SELECT
END IF
END IF
Expand Down Expand Up @@ -807,6 +809,8 @@ INTEGER FUNCTION register_static_field(module_name, field_name, axes, long_name,
range_use = range
TYPE IS (real(kind=r8_kind))
range_use = range
CLASS DEFAULT
CALL error_mesg ('diag_manager_mod::register_static_field', 'unsupported kind', FATAL)
END SELECT
input_fields(field)%range = range_use
! don't use the range if it is not a valid range
Expand Down Expand Up @@ -1294,6 +1298,8 @@ LOGICAL FUNCTION send_data_0d(diag_field_id, field, time, err_msg)
field_out(1, 1, 1) = field
TYPE IS (real(kind=r8_kind))
field_out(1, 1, 1) = field
CLASS DEFAULT
CALL error_mesg ('diag_manager_mod::send_data_0d', 'unsupported kind', FATAL)
END SELECT

send_data_0d = send_data_3d(diag_field_id, field_out, time, err_msg=err_msg)
Expand Down Expand Up @@ -1325,6 +1331,8 @@ LOGICAL FUNCTION send_data_1d(diag_field_id, field, time, is_in, mask, rmask, ie
field_out(:, 1, 1) = field
TYPE IS (real(kind=r8_kind))
field_out(:, 1, 1) = field
CLASS DEFAULT
CALL error_mesg ('diag_manager_mod::send_data_1d', 'unsupported kind', FATAL)
END SELECT

! Default values for mask
Expand All @@ -1340,6 +1348,8 @@ LOGICAL FUNCTION send_data_1d(diag_field_id, field, time, is_in, mask, rmask, ie
WHERE (rmask < 0.5) mask_out(:, 1, 1) = .FALSE.
TYPE IS (real(kind=r8_kind))
WHERE (rmask < 0.5) mask_out(:, 1, 1) = .FALSE.
CLASS DEFAULT
CALL error_mesg ('diag_manager_mod::send_data_1d', 'unsupported kind', FATAL)
END SELECT
END IF

Expand Down Expand Up @@ -1388,6 +1398,8 @@ LOGICAL FUNCTION send_data_2d(diag_field_id, field, time, is_in, js_in, &
field_out(:, :, 1) = field
TYPE IS (real(kind=r8_kind))
field_out(:, :, 1) = field
CLASS DEFAULT
CALL error_mesg ('diag_manager_mod::send_data_2d', 'unsupported kind', FATAL)
END SELECT

! Default values for mask
Expand All @@ -1403,6 +1415,8 @@ LOGICAL FUNCTION send_data_2d(diag_field_id, field, time, is_in, js_in, &
WHERE ( rmask < 0.5 ) mask_out(:, :, 1) = .FALSE.
TYPE IS (real(kind=r8_kind))
WHERE ( rmask < 0.5 ) mask_out(:, :, 1) = .FALSE.
CLASS DEFAULT
CALL error_mesg ('diag_manager_mod::send_data_2d', 'unsupported kind', FATAL)
END SELECT
END IF

Expand Down Expand Up @@ -1646,6 +1660,8 @@ LOGICAL FUNCTION send_data_3d(diag_field_id, field, time, is_in, js_in, ks_in, &
field_out = field
TYPE IS (real(kind=r8_kind))
field_out = field
CLASS DEFAULT
CALL error_mesg ('diag_manager_mod::send_data_3d', 'unsupported kind', FATAL)
END SELECT

! oor_mask is only used for checking out of range values.
Expand All @@ -1668,6 +1684,8 @@ LOGICAL FUNCTION send_data_3d(diag_field_id, field, time, is_in, js_in, ks_in, &
WHERE ( rmask < 0.5_r4_kind ) oor_mask = .FALSE.
TYPE IS (real(kind=r8_kind))
WHERE ( rmask < 0.5_r8_kind ) oor_mask = .FALSE.
CLASS DEFAULT
CALL error_mesg ('diag_manager_mod::send_data_3d', 'unsupported kind', FATAL)
END SELECT
END IF

Expand Down Expand Up @@ -1774,6 +1792,8 @@ LOGICAL FUNCTION send_data_3d(diag_field_id, field, time, is_in, js_in, ks_in, &
weight1 = weight
TYPE IS (real(kind=r8_kind))
weight1 = weight
CLASS DEFAULT
CALL error_mesg ('diag_manager_mod::send_data_3d', 'unsupported kind', FATAL)
END SELECT
ELSE
weight1 = 1.
Expand Down Expand Up @@ -3132,6 +3152,8 @@ LOGICAL FUNCTION send_data_3d(diag_field_id, field, time, is_in, js_in, ks_in, &
END DO
END DO
END DO
CLASS DEFAULT
CALL error_mesg ('diag_manager_mod::send_data_3d', 'unsupported kind', FATAL)
END SELECT
ELSE IF ( reduced_k_range ) THEN
ksr= l_start(3)
Expand All @@ -3157,6 +3179,8 @@ LOGICAL FUNCTION send_data_3d(diag_field_id, field, time, is_in, js_in, ks_in, &
END DO
END DO
END DO
CLASS DEFAULT
CALL error_mesg ('diag_manager_mod::send_data_3d', 'unsupported kind', FATAL)
END SELECT
ELSE
SELECT TYPE (rmask)
Expand All @@ -3178,6 +3202,8 @@ LOGICAL FUNCTION send_data_3d(diag_field_id, field, time, is_in, js_in, ks_in, &
END DO
END DO
END DO
CLASS DEFAULT
CALL error_mesg ('diag_manager_mod::send_data_3d', 'unsupported kind', FATAL)
END SELECT
END IF
END IF
Expand Down
12 changes: 9 additions & 3 deletions diag_manager/diag_util.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -650,9 +650,11 @@ SUBROUTINE log_diag_field_info(module_name, field_name, axes, long_name, units,&
IF ( mpp_pe().NE.mpp_root_pe() ) RETURN

! Fatal error if range is present and its extent is not 2.
IF ( PRESENT(range) .AND. (SIZE(range) .NE. 2) ) THEN
! <ERROR STATUS="FATAL">extent of range should be 2</ERROR>
CALL error_mesg ('diag_util_mod::log_diag_field_info', 'extent of range should be 2', FATAL)
IF ( PRESENT(range) ) THEN
IF ( SIZE(range) .NE. 2 ) THEN
! <ERROR STATUS="FATAL">extent of range should be 2</ERROR>
CALL error_mesg ('diag_util_mod::log_diag_field_info', 'extent of range should be 2', FATAL)
END IF
END IF

lmodule = TRIM(module_name)
Expand Down Expand Up @@ -681,6 +683,8 @@ SUBROUTINE log_diag_field_info(module_name, field_name, axes, long_name, units,&
missing_value_use = missing_value
TYPE IS (real(kind=r8_kind))
missing_value_use = missing_value
CLASS DEFAULT
CALL error_mesg ('diag_util_mod::log_diag_field_info', 'unsupported kind', FATAL)
END SELECT
WRITE (lmissval,*) missing_value_use
END IF
Expand All @@ -694,6 +698,8 @@ SUBROUTINE log_diag_field_info(module_name, field_name, axes, long_name, units,&
range_use = range
TYPE IS (real(kind=r8_kind))
range_use = range
CLASS DEFAULT
CALL error_mesg ('diag_util_mod::log_diag_field_info', 'unsupported kind', FATAL)
END SELECT
WRITE (lmin,*) range_use(1)
WRITE (lmax,*) range_use(2)
Expand Down
18 changes: 18 additions & 0 deletions sat_vapor_pres/sat_vapor_pres.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -2626,6 +2626,8 @@ function check_1d ( temp ) result ( nbad )
ind = int(dtinv*(temp(i)-tmin+teps))
if (ind < 0 .or. ind > nlim) nbad = nbad+1
enddo
class default
call error_mesg ('sat_vapor_pres_mod::check_1d', 'unsupported kind', FATAL)
end select

end function check_1d
Expand All @@ -2648,6 +2650,8 @@ function check_2d ( temp ) result ( nbad )
do j = 1, size(temp,2)
nbad = nbad + check_1d ( temp(:,j) )
enddo
class default
call error_mesg ('sat_vapor_pres_mod::check_2d', 'unsupported kind', FATAL)
end select

end function check_2d
Expand All @@ -2665,6 +2669,8 @@ subroutine temp_check_1d ( temp )
write(unit,*) 'Bad temperatures (dimension 1): ', (check_1d(temp(i:i)),i=1,size(temp,1))
type is (real(kind=r8_kind))
write(unit,*) 'Bad temperatures (dimension 1): ', (check_1d(temp(i:i)),i=1,size(temp,1))
class default
call error_mesg ('sat_vapor_pres_mod::temp_check_1d', 'unsupported kind', FATAL)
end select

end subroutine temp_check_1d
Expand All @@ -2684,6 +2690,8 @@ subroutine temp_check_2d ( temp )
type is (real(kind=r8_kind))
write(unit,*) 'Bad temperatures (dimension 1): ', (check_1d(temp(i,:)),i=1,size(temp,1))
write(unit,*) 'Bad temperatures (dimension 2): ', (check_1d(temp(:,j)),j=1,size(temp,2))
class default
call error_mesg ('sat_vapor_pres_mod::temp_check_2d', 'unsupported kind', FATAL)
end select

end subroutine temp_check_2d
Expand All @@ -2705,6 +2713,8 @@ subroutine temp_check_3d ( temp )
write(unit,*) 'Bad temperatures (dimension 1): ', (check_2d(temp(i,:,:)),i=1,size(temp,1))
write(unit,*) 'Bad temperatures (dimension 2): ', (check_2d(temp(:,j,:)),j=1,size(temp,2))
write(unit,*) 'Bad temperatures (dimension 3): ', (check_2d(temp(:,:,k)),k=1,size(temp,3))
class default
call error_mesg ('sat_vapor_pres_mod::temp_check_3d', 'unsupported kind', FATAL)
end select

end subroutine temp_check_3d
Expand All @@ -2728,6 +2738,8 @@ subroutine show_all_bad_0d ( temp )
if (ind < 0 .or. ind > nlim) then
write(unit,'(a,e10.3,a,i6)') 'Bad temperature=',temp,' pe=',mpp_pe()
endif
class default
call error_mesg ('sat_vapor_pres_mod::show_all_bad_0d', 'unsupported kind', FATAL)
end select

end subroutine show_all_bad_0d
Expand Down Expand Up @@ -2755,6 +2767,8 @@ subroutine show_all_bad_1d ( temp )
write(unit,'(a,e10.3,a,i4,a,i6)') 'Bad temperature=',temp(i),' at i=',i,' pe=',mpp_pe()
endif
enddo
class default
call error_mesg ('sat_vapor_pres_mod::show_all_bad_1d', 'unsupported kind', FATAL)
end select

end subroutine show_all_bad_1d
Expand Down Expand Up @@ -2786,6 +2800,8 @@ subroutine show_all_bad_2d ( temp )
endif
enddo
enddo
class default
call error_mesg ('sat_vapor_pres_mod::show_all_bad_2d', 'unsupported kind', FATAL)
end select

end subroutine show_all_bad_2d
Expand Down Expand Up @@ -2821,6 +2837,8 @@ subroutine show_all_bad_3d ( temp )
enddo
enddo
enddo
class default
call error_mesg ('sat_vapor_pres_mod::show_all_bad_3d', 'unsupported kind', FATAL)
end select

end subroutine show_all_bad_3d
Expand Down
Loading