Skip to content

Commit

Permalink
Make changes to address review comments on class(*) and select type (#11
Browse files Browse the repository at this point in the history 
)
  • Loading branch information
@MinsukJi-NOAA
MinsukJi-NOAA authored Nov 12, 2021
1 parent 91fc755 commit 9242fe4
Show file tree
Hide file tree
Showing 8 changed files with 1,033 additions and 3 deletions.
4 changes: 4 additions & 0 deletions diag_manager/diag_axis.F90
View file
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
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
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
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
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

0 comments on commit 9242fe4

Please sign in to comment.