diff --git a/diag_manager/diag_manager.F90 b/diag_manager/diag_manager.F90 index 1235e20392..8a2f990002 100644 --- a/diag_manager/diag_manager.F90 +++ b/diag_manager/diag_manager.F90 @@ -348,6 +348,7 @@ MODULE diag_manager_mod MODULE PROCEDURE send_data_1d MODULE PROCEDURE send_data_2d MODULE PROCEDURE send_data_3d + MODULE PROCEDURE send_data_4d END INTERFACE !> @brief Register a diagnostic field for a given module @@ -3474,6 +3475,57 @@ LOGICAL FUNCTION diag_send_data(diag_field_id, field, time, is_in, js_in, ks_in, endIF modern_if END FUNCTION diag_send_data + !> @brief Updates the output buffer for a field based on the data for current time step + !! @return true if send is successful + LOGICAL FUNCTION send_data_4d(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 !< The field id returned from the register call + CLASS(*), INTENT(in) :: field(:,:,:,:) !< The field data for the current time step + CLASS(*), INTENT(in), OPTIONAL :: weight !< The weight to multiply the data by when averaging + TYPE (time_type), INTENT(in), OPTIONAL :: time !< The current model time + INTEGER, INTENT(in), OPTIONAL :: is_in !< Starting i index of the data + INTEGER, INTENT(in), OPTIONAL :: js_in !< Starting j index of the data + INTEGER, INTENT(in), OPTIONAL :: ks_in !< Starting k index of the data + INTEGER, INTENT(in), OPTIONAL :: ie_in !< Ending i index of the data + INTEGER, INTENT(in), OPTIONAL :: je_in !< Ending j index of the data + INTEGER, INTENT(in), OPTIONAL :: ke_in !< Ending k index of the data + LOGICAL, INTENT(in), OPTIONAL :: mask(:,:,:,:) !< Logical mask indicating the points to not average + CLASS(*), INTENT(in), OPTIONAL :: rmask(:,:,:,:) !< Real mask indicating the points to not averafe + CHARACTER(len=*), INTENT(out), OPTIONAL :: err_msg !< If some errors occurs, send_data will return the + !! error message instead of crashing + + class(*), allocatable :: rmask_local(:,:,:,:) !< Real version of the mask variable + logical, allocatable :: mask_local(:,:,:,:) !< Local version of the mask variable + + ! If diag_field_id is < 0 it means that this field is not registered, simply return + IF ( diag_field_id <= 0 ) THEN + send_data_4d = .FALSE. + RETURN + ENDIF + + if (.not. use_modern_diag) & + call mpp_error(FATAL, "Send_data_4d is only supported when diag_manager_nml::use_modern_diag=.true.") + + !< The error checking is done in accept_data + if (present(mask)) mask_local = mask + if (present(rmask)) rmask_local = rmask + + send_data_4d = fms_diag_object%fms_diag_accept_data(diag_field_id, field, mask_local, rmask_local, & + time, is_in, js_in, ks_in, ie_in, je_in, ke_in, weight, & + err_msg) + + if (present(err_msg)) then + if (err_msg .ne. "") then + call mpp_error(NOTE, trim(err_msg)) + send_data_4d = .false. + return + endif + endif + + if (allocated(rmask_local)) deallocate(rmask_local) + if (allocated(mask_local)) deallocate(mask_local) + end function send_data_4d + !> @return true if send is successful LOGICAL FUNCTION send_tile_averaged_data1d ( id, field, area, time, mask ) INTEGER, INTENT(in) :: id !< id od the diagnostic field diff --git a/test_fms/diag_manager/check_time_max.F90 b/test_fms/diag_manager/check_time_max.F90 index 51e888541c..fd835ce4a3 100644 --- a/test_fms/diag_manager/check_time_max.F90 +++ b/test_fms/diag_manager/check_time_max.F90 @@ -91,6 +91,12 @@ program check_time_max call read_data(fileobj, "var3_max", cdata_out(:,:,:,1), unlim_dim_level=i) call check_data_3d(cdata_out(:,:,:,1), i, .false.) + cdata_out = -999_r4_kind + print *, "Checking answers for var4_max - time_level:", string(i) + call read_data(fileobj, "var4_max", cdata_out(:,:,:,:), unlim_dim_level=i) + call check_data_3d(cdata_out(:,:,:,1), i, .false.) + call check_data_3d(cdata_out(:,:,:,2), i, .false.) + cdata_out = -999_r4_kind print *, "Checking answers for var3_Z_max - time_level:", string(i) call read_data(fileobj, "var3_Z_max", cdata_out(:,:,1:2,1), unlim_dim_level=i) diff --git a/test_fms/diag_manager/check_time_min.F90 b/test_fms/diag_manager/check_time_min.F90 index e56e344144..da2440a638 100644 --- a/test_fms/diag_manager/check_time_min.F90 +++ b/test_fms/diag_manager/check_time_min.F90 @@ -91,6 +91,12 @@ program check_time_min call read_data(fileobj, "var3_min", cdata_out(:,:,:,1), unlim_dim_level=i) call check_data_3d(cdata_out(:,:,:,1), i, .false.) + cdata_out = -999_r4_kind + print *, "Checking answers for var4_min - time_level:", string(i) + call read_data(fileobj, "var4_min", cdata_out(:,:,:,:), unlim_dim_level=i) + call check_data_3d(cdata_out(:,:,:,1), i, .false.) + call check_data_3d(cdata_out(:,:,:,2), i, .false.) + cdata_out = -999_r4_kind print *, "Checking answers for var3_Z_min - time_level:", string(i) call read_data(fileobj, "var3_Z_min", cdata_out(:,:,1:2,1), unlim_dim_level=i) diff --git a/test_fms/diag_manager/check_time_none.F90 b/test_fms/diag_manager/check_time_none.F90 index f703469078..e0b3f73541 100644 --- a/test_fms/diag_manager/check_time_none.F90 +++ b/test_fms/diag_manager/check_time_none.F90 @@ -91,6 +91,12 @@ program check_time_none call read_data(fileobj, "var3_none", cdata_out(:,:,:,1), unlim_dim_level=i) call check_data_3d(cdata_out(:,:,:,1), i, .false.) + cdata_out = -999_r4_kind + print *, "Checking answers for var4_none - time_level:", string(i) + call read_data(fileobj, "var4_none", cdata_out(:,:,:,:), unlim_dim_level=i) + call check_data_3d(cdata_out(:,:,:,1), i, .false.) + call check_data_3d(cdata_out(:,:,:,2), i, .false.) + cdata_out = -999_r4_kind print *, "Checking answers for var3_Z - time_level:", string(i) call read_data(fileobj, "var3_Z", cdata_out(:,:,1:2,1), unlim_dim_level=i) diff --git a/test_fms/diag_manager/check_time_sum.F90 b/test_fms/diag_manager/check_time_sum.F90 index 03d38f21a2..463e1cea5f 100644 --- a/test_fms/diag_manager/check_time_sum.F90 +++ b/test_fms/diag_manager/check_time_sum.F90 @@ -93,6 +93,12 @@ program check_time_sum call read_data(fileobj, "var3_sum", cdata_out(:,:,:,1), unlim_dim_level=ti) call check_data_3d(cdata_out(:,:,:,1), ti, .false.) + cdata_out = -999_r4_kind + print *, "Checking answers for var4_sum - time_level:", string(ti) + call read_data(fileobj, "var4_sum", cdata_out(:,:,:,:), unlim_dim_level=ti) + call check_data_3d(cdata_out(:,:,:,1), ti, .false.) + call check_data_3d(cdata_out(:,:,:,2), ti, .false.) + cdata_out = -999_r4_kind print *, "Checking answers for var3_Z - time_level:", string(ti) call read_data(fileobj, "var3_Z", cdata_out(:,:,1:2,1), unlim_dim_level=ti) diff --git a/test_fms/diag_manager/test_reduction_methods.F90 b/test_fms/diag_manager/test_reduction_methods.F90 index 5b57051065..d47d21895e 100644 --- a/test_fms/diag_manager/test_reduction_methods.F90 +++ b/test_fms/diag_manager/test_reduction_methods.F90 @@ -133,19 +133,19 @@ program test_reduction_methods select case (mask_case) case (logical_mask) clmask = allocate_logical_mask(isc, iec, jsc, jec, nz, nw) - if (mpp_pe() .eq. 0) clmask(isc, jsc, 1, 1) = .False. + if (mpp_pe() .eq. 0) clmask(isc, jsc, 1, :) = .False. if (test_case .eq. test_halos) then dlmask = allocate_logical_mask(isd, ied, jsd, jed, nz, nw) - if (mpp_pe() .eq. 0) dlmask(1+nhalox, 1+nhaloy, 1, 1) = .False. + if (mpp_pe() .eq. 0) dlmask(1+nhalox, 1+nhaloy, 1, :) = .False. endif case (real_mask) crmask = allocate_real_mask(isc, iec, jsc, jec, nz, nw) - if (mpp_pe() .eq. 0) crmask(isc, jsc, 1, 1) = 0_r8_kind + if (mpp_pe() .eq. 0) crmask(isc, jsc, 1, :) = 0_r8_kind if (test_case .eq. test_halos) then drmask = allocate_real_mask(isd, ied, jsd, jed, nz, nw) - if (mpp_pe() .eq. 0) drmask(1+nhalox, 1+nhaloy, 1, 1) = 0_r8_kind + if (mpp_pe() .eq. 0) drmask(1+nhalox, 1+nhaloy, 1, :) = 0_r8_kind endif end select @@ -190,14 +190,17 @@ program test_reduction_methods used = send_data(id_var1, cdata(:,1,1,1), Time) used = send_data(id_var2, cdata(:,:,1,1), Time) used = send_data(id_var3, cdata(:,:,:,1), Time) + used = send_data(id_var4, cdata(:,:,:,:), Time) case (real_mask) used = send_data(id_var1, cdata(:,1,1,1), Time, rmask=crmask(:,1,1,1)) used = send_data(id_var2, cdata(:,:,1,1), Time, rmask=crmask(:,:,1,1)) used = send_data(id_var3, cdata(:,:,:,1), Time, rmask=crmask(:,:,:,1)) + used = send_data(id_var4, cdata(:,:,:,:), Time, rmask=crmask(:,:,:,:)) case (logical_mask) used = send_data(id_var1, cdata(:,1,1,1), Time, mask=clmask(:,1,1,1)) used = send_data(id_var2, cdata(:,:,1,1), Time, mask=clmask(:,:,1,1)) used = send_data(id_var3, cdata(:,:,:,1), Time, mask=clmask(:,:,:,1)) + used = send_data(id_var4, cdata(:,:,:,:), Time, mask=clmask(:,:,:,:)) end select case (test_halos) call set_buffer(ddata, i) @@ -208,6 +211,8 @@ program test_reduction_methods is_in=isd1, ie_in=ied1, js_in=jsd1, je_in=jed1) used = send_data(id_var3, ddata(:,:,:,1), Time, & is_in=isd1, ie_in=ied1, js_in=jsd1, je_in=jed1) + used = send_data(id_var4, ddata(:,:,:,:), Time, & + is_in=isd1, ie_in=ied1, js_in=jsd1, je_in=jed1) case (real_mask) used = send_data(id_var1, cdata(:,1,1,1), Time, & rmask=crmask(:,1,1,1)) @@ -217,6 +222,9 @@ program test_reduction_methods used = send_data(id_var3, ddata(:,:,:,1), Time, & is_in=isd1, ie_in=ied1, js_in=jsd1, je_in=jed1, & rmask=drmask(:,:,:,1)) + used = send_data(id_var4, ddata(:,:,:,:), Time, & + is_in=isd1, ie_in=ied1, js_in=jsd1, je_in=jed1, & + rmask=drmask(:,:,:,:)) case (logical_mask) used = send_data(id_var1, cdata(:,1,1,1), Time, & mask=clmask(:,1,1,1)) @@ -226,6 +234,9 @@ program test_reduction_methods used = send_data(id_var3, ddata(:,:,:,1), Time, & is_in=isd1, ie_in=ied1, js_in=jsd1, je_in=jed1, & mask=dlmask(:,:,:,1)) + used = send_data(id_var4, ddata(:,:,:,:), Time, & + is_in=isd1, ie_in=ied1, js_in=jsd1, je_in=jed1, & + mask=dlmask(:,:,:,:)) end select case (test_openmp) select case(mask_case) @@ -255,16 +266,21 @@ program test_reduction_methods case (no_mask) used=send_data(id_var2, cdata(is1:ie1, js1:je1, 1, 1), time, is_in=is1, js_in=js1) used=send_data(id_var3, cdata(is1:ie1, js1:je1, :, 1), time, is_in=is1, js_in=js1) + used=send_data(id_var4, cdata(is1:ie1, js1:je1, :, :), time, is_in=is1, js_in=js1) case (real_mask) used=send_data(id_var2, cdata(is1:ie1, js1:je1, 1, 1), time, is_in=is1, js_in=js1, & rmask=crmask(is1:ie1, js1:je1, 1, 1)) used=send_data(id_var3, cdata(is1:ie1, js1:je1, :, 1), time, is_in=is1, js_in=js1, & rmask=crmask(is1:ie1, js1:je1, :, 1)) + used=send_data(id_var4, cdata(is1:ie1, js1:je1, :, :), time, is_in=is1, js_in=js1, & + rmask=crmask(is1:ie1, js1:je1, :, :)) case (logical_mask) used=send_data(id_var2, cdata(is1:ie1, js1:je1, 1, 1), time, is_in=is1, js_in=js1, & mask=clmask(is1:ie1, js1:je1, 1, 1)) used=send_data(id_var3, cdata(is1:ie1, js1:je1, :, 1), time, is_in=is1, js_in=js1, & mask=clmask(is1:ie1, js1:je1, :, 1)) + used=send_data(id_var4, cdata(is1:ie1, js1:je1, :, :), time, is_in=is1, js_in=js1, & + mask=clmask(is1:ie1, js1:je1, :, :)) end select enddo end select diff --git a/test_fms/diag_manager/test_time_max.sh b/test_fms/diag_manager/test_time_max.sh index b9a62b4d74..d2a0fd7cdc 100755 --- a/test_fms/diag_manager/test_time_max.sh +++ b/test_fms/diag_manager/test_time_max.sh @@ -58,6 +58,11 @@ diag_files: output_name: var3_max reduction: max kind: r4 + - module: ocn_mod + var_name: var4 + output_name: var4_max + reduction: max + kind: r4 - module: ocn_mod var_name: var3 output_name: var3_Z_max @@ -110,7 +115,7 @@ test_expect_success "Checking answers for the "max" reduction method, real mask mpirun -n 1 ../check_time_max ' -export OMP_NUM_THREADS=1 +export OMP_NUM_THREADS=2 my_test_count=`expr $my_test_count + 1` printf "&diag_manager_nml \n use_modern_diag=.true. \n / \n&test_reduction_methods_nml \n test_case = 1 \n \n/" | cat > input.nml test_expect_success "Running diag_manager with "max" reduction method with openmp (test $my_test_count)" ' @@ -137,7 +142,7 @@ test_expect_success "Running diag_manager with "max" reduction method with openm test_expect_success "Checking answers for the "max" reduction method with openmp, real mask (test $my_test_count)" ' mpirun -n 1 ../check_time_max ' -export OMP_NUM_THREADS=2 +export OMP_NUM_THREADS=1 my_test_count=`expr $my_test_count + 1` printf "&diag_manager_nml \n use_modern_diag=.true. \n / \n&test_reduction_methods_nml \n test_case = 2 \n \n/" | cat > input.nml diff --git a/test_fms/diag_manager/test_time_min.sh b/test_fms/diag_manager/test_time_min.sh index f0305d15a0..f2969d47c9 100755 --- a/test_fms/diag_manager/test_time_min.sh +++ b/test_fms/diag_manager/test_time_min.sh @@ -58,6 +58,11 @@ diag_files: output_name: var3_min reduction: min kind: r4 + - module: ocn_mod + var_name: var4 + output_name: var4_min + reduction: min + kind: r4 - module: ocn_mod var_name: var3 output_name: var3_Z_min diff --git a/test_fms/diag_manager/test_time_none.sh b/test_fms/diag_manager/test_time_none.sh index e9e444c5fb..9840e0c0ac 100755 --- a/test_fms/diag_manager/test_time_none.sh +++ b/test_fms/diag_manager/test_time_none.sh @@ -57,6 +57,11 @@ diag_files: output_name: var3_none reduction: none kind: r4 + - module: ocn_mod + var_name: var4 + output_name: var4_none + reduction: none + kind: r4 - module: ocn_mod var_name: var3 output_name: var3_Z diff --git a/test_fms/diag_manager/test_time_sum.sh b/test_fms/diag_manager/test_time_sum.sh index 18f923cbb4..c7631217a4 100755 --- a/test_fms/diag_manager/test_time_sum.sh +++ b/test_fms/diag_manager/test_time_sum.sh @@ -55,6 +55,11 @@ diag_files: output_name: var3_sum reduction: sum kind: r4 + - module: ocn_mod + var_name: var4 + output_name: var4_sum + reduction: sum + kind: r4 - module: ocn_mod var_name: var3 output_name: var3_Z