fix - gnu and pgi issue with class(*) in send_data3d (#1149)

NOAA-GFDL · Mar 9, 2023 · 9b83c8c · 9b83c8c
1 parent 74d8e73
commit 9b83c8c
Showing 1 changed file with 35 additions and 11 deletions.
diff --git a/diag_manager/diag_manager.F90 b/diag_manager/diag_manager.F90
@@ -1315,7 +1315,7 @@ LOGICAL FUNCTION send_data_0d(diag_field_id, field, time, err_msg)
             & 'The field is not one of the supported types of real(kind=4) or real(kind=8)', FATAL)
     END SELECT
 
-    send_data_0d = send_data_3d(diag_field_id, field_out, time, err_msg=err_msg)
+    send_data_0d = diag_send_data(diag_field_id, field_out, time, err_msg=err_msg)
   END FUNCTION send_data_0d
 
   !> @return true if send is successful
@@ -1370,18 +1370,18 @@ LOGICAL FUNCTION send_data_1d(diag_field_id, field, time, is_in, mask, rmask, ie
 
     IF ( PRESENT(mask) .OR. PRESENT(rmask) ) THEN
        IF ( PRESENT(is_in) .OR. PRESENT(ie_in) ) THEN
-          send_data_1d = send_data_3d(diag_field_id, field_out, time, is_in=is_in, js_in=1, ks_in=1,&
+          send_data_1d = diag_send_data(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 = send_data_3d(diag_field_id, field_out, time, mask=mask_out,&
+          send_data_1d = diag_send_data(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 = send_data_3d(diag_field_id, field_out, time, is_in=is_in, js_in=1, ks_in=1,&
+          send_data_1d = diag_send_data(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 = send_data_3d(diag_field_id, field_out, time, weight=weight, err_msg=err_msg)
+          send_data_1d = diag_send_data(diag_field_id, field_out, time, weight=weight, err_msg=err_msg)
        END IF
     END IF
   END FUNCTION send_data_1d
@@ -1438,10 +1438,10 @@ LOGICAL FUNCTION send_data_2d(diag_field_id, field, time, is_in, js_in, &
     END IF
 
     IF ( PRESENT(mask) .OR. PRESENT(rmask) ) THEN
-       send_data_2d = send_data_3d(diag_field_id, field_out, time, is_in=is_in, js_in=js_in, ks_in=1, mask=mask_out,&
-            & ie_in=ie_in, je_in=je_in, ke_in=1, weight=weight, err_msg=err_msg)
+       send_data_2d = diag_send_data(diag_field_id, field_out, time, is_in=is_in, js_in=js_in, ks_in=1,&
+            & mask=mask_out, ie_in=ie_in, je_in=je_in, ke_in=1, weight=weight, err_msg=err_msg)
     ELSE
-       send_data_2d = send_data_3d(diag_field_id, field_out, time, is_in=is_in, js_in=js_in, ks_in=1,&
+       send_data_2d = diag_send_data(diag_field_id, field_out, time, is_in=is_in, js_in=js_in, ks_in=1,&
             & ie_in=ie_in, je_in=je_in, ke_in=1, weight=weight, err_msg=err_msg)
     END IF
   END FUNCTION send_data_2d
@@ -1454,6 +1454,30 @@ LOGICAL FUNCTION send_data_3d(diag_field_id, field, time, is_in, js_in, ks_in, &
     CLASS(*), 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
+    LOGICAL, DIMENSION(:,:,:), INTENT(in), OPTIONAL :: mask
+    CLASS(*), DIMENSION(:,:,:), INTENT(in), OPTIONAL :: rmask
+    CHARACTER(len=*), INTENT(out), OPTIONAL :: err_msg
+
+    if (present(mask) .and. present(rmask)) then
+      send_data_3d = diag_send_data(diag_field_id, field, time=time, is_in=is_in, js_in=js_in, ks_in=ks_in, &
+                               mask=mask, rmask=rmask, ie_in=ie_in, je_in=je_in, ke_in=ke_in, weight=weight, &
+                               err_msg=err_msg)
+    elseif (present(rmask)) then
+      send_data_3d = diag_send_data(diag_field_id, field, time=time, is_in=is_in, js_in=js_in, ks_in=ks_in, &
+                               rmask=rmask, ie_in=ie_in, je_in=je_in, ke_in=ke_in, weight=weight, err_msg=err_msg)
+    else
+      send_data_3d = diag_send_data(diag_field_id, field, time=time, is_in=is_in, js_in=js_in, ks_in=ks_in, &
+                               ie_in=ie_in, je_in=je_in, ke_in=ke_in, weight=weight, err_msg=err_msg)
+    endif
+  END FUNCTION send_data_3d
+  !> @return true if send is successful
+  LOGICAL FUNCTION diag_send_data(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
+    CLASS(*), DIMENSION(:,:,:), INTENT(in) :: field
+    CLASS(*), 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
     LOGICAL, DIMENSION(:,:,:), INTENT(in), OPTIONAL, contiguous, target :: mask
     CLASS(*), DIMENSION(:,:,:), INTENT(in), OPTIONAL, target :: rmask
     CHARACTER(len=*), INTENT(out), OPTIONAL :: err_msg
@@ -1503,10 +1527,10 @@ LOGICAL FUNCTION send_data_3d(diag_field_id, field, time, is_in, js_in, ks_in, &
 
     ! If diag_field_id is < 0 it means that this field is not registered, simply return
     IF ( diag_field_id <= 0 ) THEN
-       send_data_3d = .FALSE.
+       diag_send_data = .FALSE.
        RETURN
     ELSE
-       send_data_3d = .TRUE.
+       diag_send_data = .TRUE.
     END IF
 
     IF ( PRESENT(err_msg) ) err_msg = ''
@@ -3219,7 +3243,7 @@ LOGICAL FUNCTION send_data_3d(diag_field_id, field, time, is_in, js_in, ks_in, &
 
     DEALLOCATE(field_out)
     DEALLOCATE(oor_mask)
-  END FUNCTION send_data_3d
+  END FUNCTION diag_send_data
 
   !> @return true if send is successful
   LOGICAL FUNCTION send_tile_averaged_data1d ( id, field, area, time, mask )