Xgrid and gradient_mod r8 precision (#828)

Explicitly sets reals to r8_kind in xgrid.F90 and gradient.F90 Removes overloaded routines in mosaic2 and replaces with class(*) Adds additional r8 routines for send_data in diag_manager
NOAA-GFDL · Oct 14, 2021 · e0b9983 · e0b9983
1 parent 23cb941
commit e0b9983
Show file tree

Hide file tree

Showing 6 changed files with 1,054 additions and 565 deletions.
diff --git a/diag_manager/diag_manager.F90 b/diag_manager/diag_manager.F90
@@ -331,6 +331,8 @@ MODULE diag_manager_mod
      MODULE PROCEDURE send_data_2d
      MODULE PROCEDURE send_data_3d
 #ifdef OVERLOAD_R8
+     MODULE PROCEDURE send_data_0d_r8
+     MODULE PROCEDURE send_data_1d_r8
      MODULE PROCEDURE send_data_2d_r8
      MODULE PROCEDURE send_data_3d_r8
 #endif
@@ -1345,11 +1347,79 @@ LOGICAL FUNCTION send_data_2d(diag_field_id, field, time, is_in, js_in, &
   END FUNCTION send_data_2d
 
 #ifdef OVERLOAD_R8
+
+  !> @return true if send is successful
+  LOGICAL FUNCTION send_data_0d_r8(diag_field_id, field, time, err_msg)
+    INTEGER, INTENT(in) :: diag_field_id
+    REAL(r8_kind), INTENT(in) :: field
+    TYPE(time_type), INTENT(in), OPTIONAL :: time
+    CHARACTER(len=*), INTENT(out), OPTIONAL :: err_msg
+
+    REAL(r8_kind) :: field_out(1, 1, 1)
+
+    ! If diag_field_id is < 0 it means that this field is not registered, simply return
+    IF ( diag_field_id <= 0 ) THEN
+       send_data_0d_r8 = .FALSE.
+       RETURN
+    END IF
+    ! First copy the data to a three d array with last element 1
+    field_out(1, 1, 1) = field
+    send_data_0d_r8 = send_data_3d_r8(diag_field_id, field_out, time, err_msg=err_msg)
+  END FUNCTION send_data_0d_r8
+
+  !> @return true if send is successful
+  LOGICAL FUNCTION send_data_1d_r8(diag_field_id, field, time, is_in, mask, rmask, ie_in, weight, err_msg)
+    INTEGER, INTENT(in) :: diag_field_id
+    REAL(r8_kind), DIMENSION(:), INTENT(in) :: field
+    REAL, INTENT(in), OPTIONAL :: weight
+    REAL, INTENT(in), DIMENSION(:), OPTIONAL :: rmask
+    TYPE (time_type), INTENT(in), OPTIONAL :: time
+    INTEGER, INTENT(in), OPTIONAL :: is_in, ie_in
+    LOGICAL, INTENT(in), DIMENSION(:), OPTIONAL :: mask
+    CHARACTER(len=*), INTENT(out), OPTIONAL :: err_msg
+
+    REAL(r8_kind), DIMENSION(SIZE(field(:)), 1, 1) :: field_out
+    LOGICAL, DIMENSION(SIZE(field(:)), 1, 1) ::  mask_out
+
+    ! If diag_field_id is < 0 it means that this field is not registered, simply return
+    IF ( diag_field_id <= 0 ) THEN
+       send_data_1d_r8 = .FALSE.
+       RETURN
+    END IF
+
+    ! First copy the data to a three d array with last element 1
+    field_out(:, 1, 1) = field
+
+    ! Default values for mask
+    IF ( PRESENT(mask) ) THEN
+       mask_out(:, 1, 1) = mask
+    ELSE
+       mask_out = .TRUE.
+    END IF
+
+    IF ( PRESENT(rmask) ) WHERE (rmask < 0.5) mask_out(:, 1, 1) = .FALSE.
+    IF ( PRESENT(mask) .OR. PRESENT(rmask) ) THEN
+       IF ( PRESENT(is_in) .OR. PRESENT(ie_in) ) THEN
+          send_data_1d_r8 = send_data_3d_r8(diag_field_id, field_out, time, is_in=is_in, js_in=1, ks_in=1,&
+               & mask=mask_out, ie_in=ie_in, je_in=1, ke_in=1, weight=weight, err_msg=err_msg)
+       ELSE
+          send_data_1d_r8 = send_data_3d_r8(diag_field_id, field_out, time, mask=mask_out,&
+               & weight=weight, err_msg=err_msg)
+       END IF
+    ELSE
+       IF ( PRESENT(is_in) .OR. PRESENT(ie_in) ) THEN
+          send_data_1d_r8 = send_data_3d_r8(diag_field_id, field_out, time, is_in=is_in, js_in=1, ks_in=1,&
+               & ie_in=ie_in, je_in=1, ke_in=1, weight=weight, err_msg=err_msg)
+       ELSE
+          send_data_1d_r8 = send_data_3d_r8(diag_field_id, field_out, time, weight=weight, err_msg=err_msg)
+       END IF
+    END IF
+  END FUNCTION send_data_1d_r8
   !> @return true if send is successful
   LOGICAL FUNCTION send_data_2d_r8(diag_field_id, field, time, is_in, js_in, &
        & mask, rmask, ie_in, je_in, weight, err_msg)
     INTEGER, INTENT(in) :: diag_field_id
-    REAL(kind=8), INTENT(in), DIMENSION(:,:) :: field
+    REAL(r8_kind), INTENT(in), DIMENSION(:,:) :: field
     REAL, INTENT(in), OPTIONAL :: weight
     TYPE (time_type), INTENT(in), OPTIONAL :: time
     INTEGER, INTENT(in), OPTIONAL :: is_in, js_in, ie_in, je_in
@@ -1390,7 +1460,7 @@ END FUNCTION send_data_2d_r8
   LOGICAL FUNCTION send_data_3d_r8(diag_field_id, field, time, is_in, js_in, ks_in, &
              & mask, rmask, ie_in, je_in, ke_in, weight, err_msg)
     INTEGER, INTENT(in) :: diag_field_id
-    REAL(kind=8), INTENT(in), DIMENSION(:,:,:) :: field
+    REAL(r8_kind), INTENT(in), DIMENSION(:,:,:) :: field
     REAL, INTENT(in), OPTIONAL :: weight
     TYPE (time_type), INTENT(in), OPTIONAL :: time
     INTEGER, INTENT(in), OPTIONAL :: is_in, js_in, ks_in,ie_in,je_in, ke_in