From 532d04c3ff381a6b7722a44c7cd11809133f192c Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Mon, 2 May 2022 22:30:44 +0000 Subject: [PATCH 01/25] Point to sing_prec_from_main branch of ccpp/physics --- ccpp/physics | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ccpp/physics b/ccpp/physics index 7e3535134..527e1b976 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 7e3535134272169e5ae4690aa47e4e9325aefc64 +Subproject commit 527e1b976bd74dc0214a13f91f804ec2334d862c From c756e16908c96ad78d2b0be7284f6fa9991ed9b0 Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Mon, 2 May 2022 22:53:38 +0000 Subject: [PATCH 02/25] Point to sing_prec_from_main branch of ccpp/physics --- .gitmodules | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/.gitmodules b/.gitmodules index 6bb663df1..ebb742558 100644 --- a/.gitmodules +++ b/.gitmodules @@ -8,8 +8,8 @@ branch = main [submodule "ccpp/physics"] path = ccpp/physics - url = https://github.com/NCAR/ccpp-physics - branch = main + url = https://github.com/SamuelTrahanNOAA/ccpp-physics + branch = sing_prec_from_main [submodule "upp"] path = upp url = https://github.com/NOAA-EMC/UPP From b5b4ae02a55212a7746453cd277a6fc4b230fc80 Mon Sep 17 00:00:00 2001 From: Samuel Trahan Date: Wed, 4 May 2022 17:43:00 +0000 Subject: [PATCH 03/25] support 32-bit real input in module_block_data --- cpl/module_block_data.F90 | 664 ++++++++++++++++++++++++++++++++------ 1 file changed, 573 insertions(+), 91 deletions(-) diff --git a/cpl/module_block_data.F90 b/cpl/module_block_data.F90 index 9d2cc9192..ff91f6633 100644 --- a/cpl/module_block_data.F90 +++ b/cpl/module_block_data.F90 @@ -1,20 +1,29 @@ module module_block_data + ! Copies block data containing real*4, real*8, or integer into + ! ESMF_KIND_R8 arrays, with an optional scaling factor. Can also + ! fill ESMF_KIND_R8 arrays with a constant value. + use ESMF, only: ESMF_KIND_R8, ESMF_SUCCESS, & ESMF_RC_PTR_NOTALLOC, ESMF_RC_VAL_OUTOFRANGE - use GFS_typedefs, only: kind_phys use block_control_mod, only: block_control_type implicit none interface block_data_copy module procedure block_copy_1d_i4_to_2d_r8 - module procedure block_copy_1d_to_2d_r8 - module procedure block_copy_2d_to_2d_r8 - module procedure block_copy_2d_to_3d_r8 - module procedure block_copy_3d_to_3d_r8 - module procedure block_copy_1dslice_to_2d_r8 - module procedure block_copy_3dslice_to_3d_r8 + module procedure block_copy_1d_r8_to_2d_r8 + module procedure block_copy_2d_r8_to_2d_r8 + module procedure block_copy_2d_r8_to_3d_r8 + module procedure block_copy_3d_r8_to_3d_r8 + module procedure block_copy_1dslice_r8_to_2d_r8 + module procedure block_copy_3dslice_r8_to_3d_r8 + module procedure block_copy_1d_r4_to_2d_r8 + module procedure block_copy_2d_r4_to_2d_r8 + module procedure block_copy_2d_r4_to_3d_r8 + module procedure block_copy_3d_r4_to_3d_r8 + module procedure block_copy_1dslice_r4_to_2d_r8 + module procedure block_copy_3dslice_r4_to_3d_r8 end interface block_data_copy interface block_data_fill @@ -23,19 +32,26 @@ module module_block_data end interface block_data_fill interface block_data_copy_or_fill - module procedure block_copy_or_fill_1d_to_2d_r8 - module procedure block_copy_or_fill_2d_to_3d_r8 - module procedure block_copy_or_fill_1dslice_to_2d_r8 + module procedure block_copy_or_fill_1d_r8_to_2d_r8 + module procedure block_copy_or_fill_2d_r8_to_3d_r8 + module procedure block_copy_or_fill_1dslice_r8_to_2d_r8 + module procedure block_copy_or_fill_1d_r4_to_2d_r8 + module procedure block_copy_or_fill_2d_r4_to_3d_r8 + module procedure block_copy_or_fill_1dslice_r4_to_2d_r8 end interface block_data_copy_or_fill interface block_data_combine_fractions - module procedure block_combine_frac_1d_to_2d_r8 + module procedure block_combine_frac_1d_r8_to_2d_r8 + module procedure block_combine_frac_1d_r4_to_2d_r8 end interface block_data_combine_fractions interface block_atmos_copy - module procedure block_array_copy_2d_to_2d_r8 - module procedure block_array_copy_3d_to_3d_r8 - module procedure block_array_copy_3dslice_to_3d_r8 + module procedure block_array_copy_2d_r8_to_2d_r8 + module procedure block_array_copy_3d_r8_to_3d_r8 + module procedure block_array_copy_3dslice_r8_to_3d_r8 + module procedure block_array_copy_2d_r4_to_2d_r8 + module procedure block_array_copy_3d_r4_to_3d_r8 + module procedure block_array_copy_3dslice_r4_to_3d_r8 end interface block_atmos_copy private @@ -58,18 +74,18 @@ subroutine block_copy_1d_i4_to_2d_r8(destin_ptr, source_ptr, block, block_index, integer, pointer :: source_ptr(:) type(block_control_type), intent(in) :: block integer, intent(in) :: block_index - real(kind_phys), optional, intent(in) :: scale_factor + real(kind=8), optional, intent(in) :: scale_factor integer, optional, intent(out) :: rc ! -- local variables integer :: localrc integer :: i, ib, ix, j, jb - real(kind_phys) :: factor + real(kind=8) :: factor ! -- begin localrc = ESMF_RC_PTR_NOTALLOC if (associated(destin_ptr) .and. associated(source_ptr)) then - factor = 1._kind_phys + factor = 1._8 if (present(scale_factor)) factor = scale_factor !$omp parallel do private(ix,ib,jb,i,j) do ix = 1, block%blksz(block_index) @@ -77,7 +93,7 @@ subroutine block_copy_1d_i4_to_2d_r8(destin_ptr, source_ptr, block, block_index, jb = block%index(block_index)%jj(ix) i = ib - block%isc + 1 j = jb - block%jsc + 1 - destin_ptr(i,j) = factor * real(source_ptr(ix), kind=kind_phys) + destin_ptr(i,j) = factor * real(source_ptr(ix), kind=8) enddo localrc = ESMF_SUCCESS end if @@ -86,25 +102,25 @@ subroutine block_copy_1d_i4_to_2d_r8(destin_ptr, source_ptr, block, block_index, end subroutine block_copy_1d_i4_to_2d_r8 - subroutine block_copy_1d_to_2d_r8(destin_ptr, source_ptr, block, block_index, scale_factor, rc) + subroutine block_copy_1d_r8_to_2d_r8(destin_ptr, source_ptr, block, block_index, scale_factor, rc) ! -- arguments real(ESMF_KIND_R8), pointer :: destin_ptr(:,:) - real(kind_phys), pointer :: source_ptr(:) + real(kind=8), pointer :: source_ptr(:) type(block_control_type), intent(in) :: block integer, intent(in) :: block_index - real(kind_phys), optional, intent(in) :: scale_factor + real(kind=8), optional, intent(in) :: scale_factor integer, optional, intent(out) :: rc ! -- local variables integer :: localrc integer :: i, ib, ix, j, jb - real(kind_phys) :: factor + real(kind=8) :: factor ! -- begin localrc = ESMF_RC_PTR_NOTALLOC if (associated(destin_ptr) .and. associated(source_ptr)) then - factor = 1._kind_phys + factor = 1._8 if (present(scale_factor)) factor = scale_factor !$omp parallel do private(ix,ib,jb,i,j) do ix = 1, block%blksz(block_index) @@ -118,33 +134,33 @@ subroutine block_copy_1d_to_2d_r8(destin_ptr, source_ptr, block, block_index, sc end if if (present(rc)) rc = localrc - - end subroutine block_copy_1d_to_2d_r8 + + end subroutine block_copy_1d_r8_to_2d_r8 ! -- copy: 1D slice to 2D - subroutine block_copy_1dslice_to_2d_r8(destin_ptr, source_ptr, slice, block, block_index, scale_factor, rc) + subroutine block_copy_1dslice_r8_to_2d_r8(destin_ptr, source_ptr, slice, block, block_index, scale_factor, rc) ! -- arguments real(ESMF_KIND_R8), pointer :: destin_ptr(:,:) - real(kind_phys), pointer :: source_ptr(:,:) + real(kind=8), pointer :: source_ptr(:,:) integer, intent(in) :: slice type (block_control_type), intent(in) :: block integer, intent(in) :: block_index - real(kind_phys), optional, intent(in) :: scale_factor + real(kind=8), optional, intent(in) :: scale_factor integer, optional, intent(out) :: rc ! -- local variables integer :: localrc integer :: i, ib, ix, j, jb - real(kind_phys) :: factor + real(kind=8) :: factor ! -- begin localrc = ESMF_RC_PTR_NOTALLOC if (associated(destin_ptr) .and. associated(source_ptr)) then localrc = ESMF_RC_VAL_OUTOFRANGE if (slice > 0 .and. slice <= size(source_ptr, dim=2)) then - factor = 1._kind_phys + factor = 1._8 if (present(scale_factor)) factor = scale_factor !$omp parallel do private(ix,ib,jb,i,j) do ix = 1, block%blksz(block_index) @@ -160,29 +176,29 @@ subroutine block_copy_1dslice_to_2d_r8(destin_ptr, source_ptr, slice, block, blo if (present(rc)) rc = localrc - end subroutine block_copy_1dslice_to_2d_r8 + end subroutine block_copy_1dslice_r8_to_2d_r8 ! -- copy: 2D to 3D - subroutine block_copy_2d_to_3d_r8(destin_ptr, source_ptr, block, block_index, scale_factor, rc) + subroutine block_copy_2d_r8_to_3d_r8(destin_ptr, source_ptr, block, block_index, scale_factor, rc) ! -- arguments real(ESMF_KIND_R8), pointer :: destin_ptr(:,:,:) - real(kind_phys), pointer :: source_ptr(:,:) + real(kind=8), pointer :: source_ptr(:,:) type (block_control_type), intent(in) :: block integer, intent(in) :: block_index - real(kind_phys), optional, intent(in) :: scale_factor + real(kind=8), optional, intent(in) :: scale_factor integer, optional, intent(out) :: rc ! -- local variables integer :: localrc integer :: i, ib, ix, j, jb, k - real(kind_phys) :: factor + real(kind=8) :: factor ! -- begin localrc = ESMF_RC_PTR_NOTALLOC if (associated(destin_ptr) .and. associated(source_ptr)) then - factor = 1._kind_phys + factor = 1._8 if (present(scale_factor)) factor = scale_factor do k = 1, size(source_ptr, dim=2) !$omp parallel do private(ix,ib,jb,i,j) @@ -199,29 +215,29 @@ subroutine block_copy_2d_to_3d_r8(destin_ptr, source_ptr, block, block_index, sc if (present(rc)) rc = localrc - end subroutine block_copy_2d_to_3d_r8 + end subroutine block_copy_2d_r8_to_3d_r8 ! -- copy: 2D to 2D - subroutine block_copy_2d_to_2d_r8(destin_ptr, source_ptr, block, block_index, scale_factor, rc) + subroutine block_copy_2d_r8_to_2d_r8(destin_ptr, source_ptr, block, block_index, scale_factor, rc) ! -- arguments real(ESMF_KIND_R8), pointer :: destin_ptr(:,:) - real(kind_phys), pointer :: source_ptr(:,:) + real(kind=8), pointer :: source_ptr(:,:) type (block_control_type), intent(in) :: block integer, intent(in) :: block_index - real(kind_phys), optional, intent(in) :: scale_factor + real(kind=8), optional, intent(in) :: scale_factor integer, optional, intent(out) :: rc ! -- local variables integer :: localrc integer :: i, ib, ix, j, jb - real(kind_phys) :: factor + real(kind=8) :: factor ! -- begin localrc = ESMF_RC_PTR_NOTALLOC if (associated(destin_ptr) .and. associated(source_ptr)) then - factor = 1._kind_phys + factor = 1._8 if (present(scale_factor)) factor = scale_factor !$omp parallel do private(ix,ib,jb,i,j) do ix = 1, block%blksz(block_index) @@ -236,27 +252,27 @@ subroutine block_copy_2d_to_2d_r8(destin_ptr, source_ptr, block, block_index, sc if (present(rc)) rc = localrc - end subroutine block_copy_2d_to_2d_r8 + end subroutine block_copy_2d_r8_to_2d_r8 - subroutine block_array_copy_2d_to_2d_r8(destin_ptr, source_arr, block, block_index, scale_factor, rc) + subroutine block_array_copy_2d_r8_to_2d_r8(destin_ptr, source_arr, block, block_index, scale_factor, rc) ! -- arguments real(ESMF_KIND_R8), pointer :: destin_ptr(:,:) - real, intent(in) :: source_arr(:,:) + real(kind=8), intent(in) :: source_arr(:,:) type (block_control_type), intent(in) :: block integer, intent(in) :: block_index - real, optional, intent(in) :: scale_factor + real(kind=8), optional, intent(in) :: scale_factor integer, optional, intent(out) :: rc ! -- local variables integer :: localrc integer :: i, ib, ix, j, jb - real :: factor + real(kind=8) :: factor ! -- begin localrc = ESMF_RC_PTR_NOTALLOC if (associated(destin_ptr)) then - factor = 1._kind_phys + factor = 1._8 if (present(scale_factor)) factor = scale_factor !$omp parallel do private(ix,ib,jb,i,j) do ix = 1, block%blksz(block_index) @@ -271,29 +287,29 @@ subroutine block_array_copy_2d_to_2d_r8(destin_ptr, source_arr, block, block_ind if (present(rc)) rc = localrc - end subroutine block_array_copy_2d_to_2d_r8 + end subroutine block_array_copy_2d_r8_to_2d_r8 ! -- copy: 3D to 3D - subroutine block_copy_3d_to_3d_r8(destin_ptr, source_ptr, block, block_index, scale_factor, rc) + subroutine block_copy_3d_r8_to_3d_r8(destin_ptr, source_ptr, block, block_index, scale_factor, rc) ! -- arguments real(ESMF_KIND_R8), pointer :: destin_ptr(:,:,:) - real(kind_phys), pointer :: source_ptr(:,:,:) + real(kind=8), pointer :: source_ptr(:,:,:) type (block_control_type), intent(in) :: block integer, intent(in) :: block_index - real(kind_phys), optional, intent(in) :: scale_factor + real(kind=8), optional, intent(in) :: scale_factor integer, optional, intent(out) :: rc ! -- local variables integer :: localrc integer :: i, ib, ix, j, jb, k - real(kind_phys) :: factor + real(kind=8) :: factor ! -- begin localrc = ESMF_RC_PTR_NOTALLOC if (associated(destin_ptr) .and. associated(source_ptr)) then - factor = 1._kind_phys + factor = 1._8 if (present(scale_factor)) factor = scale_factor do k = 1, size(source_ptr, dim=3) !$omp parallel do private(ix,ib,jb,i,j) @@ -310,27 +326,27 @@ subroutine block_copy_3d_to_3d_r8(destin_ptr, source_ptr, block, block_index, sc if (present(rc)) rc = localrc - end subroutine block_copy_3d_to_3d_r8 + end subroutine block_copy_3d_r8_to_3d_r8 - subroutine block_array_copy_3d_to_3d_r8(destin_ptr, source_arr, block, block_index, scale_factor, rc) + subroutine block_array_copy_3d_r8_to_3d_r8(destin_ptr, source_arr, block, block_index, scale_factor, rc) ! -- arguments real(ESMF_KIND_R8), pointer :: destin_ptr(:,:,:) - real, intent(in) :: source_arr(:,:,:) + real(kind=8), intent(in) :: source_arr(:,:,:) type (block_control_type), intent(in) :: block integer, intent(in) :: block_index - real, optional, intent(in) :: scale_factor + real(kind=8), optional, intent(in) :: scale_factor integer, optional, intent(out) :: rc ! -- local variables integer :: localrc integer :: i, ib, ix, j, jb, k - real :: factor + real(kind=8) :: factor ! -- begin localrc = ESMF_RC_PTR_NOTALLOC if (associated(destin_ptr)) then - factor = 1._kind_phys + factor = 1._8 if (present(scale_factor)) factor = scale_factor do k = 1, size(source_arr, dim=3) !$omp parallel do private(ix,ib,jb,i,j) @@ -347,32 +363,32 @@ subroutine block_array_copy_3d_to_3d_r8(destin_ptr, source_arr, block, block_ind if (present(rc)) rc = localrc - end subroutine block_array_copy_3d_to_3d_r8 + end subroutine block_array_copy_3d_r8_to_3d_r8 ! -- copy: 3D slice to 3D - subroutine block_copy_3dslice_to_3d_r8(destin_ptr, source_ptr, slice, block, block_index, scale_factor, rc) + subroutine block_copy_3dslice_r8_to_3d_r8(destin_ptr, source_ptr, slice, block, block_index, scale_factor, rc) ! -- arguments real(ESMF_KIND_R8), pointer :: destin_ptr(:,:,:) - real(kind_phys), pointer :: source_ptr(:,:,:,:) + real(kind=8), pointer :: source_ptr(:,:,:,:) integer, intent(in) :: slice type (block_control_type), intent(in) :: block integer, intent(in) :: block_index - real(kind_phys), optional, intent(in) :: scale_factor + real(kind=8), optional, intent(in) :: scale_factor integer, optional, intent(out) :: rc ! -- local variables integer :: localrc integer :: i, ib, ix, j, jb, k - real(kind_phys) :: factor + real(kind=8) :: factor ! -- begin localrc = ESMF_RC_PTR_NOTALLOC if (associated(destin_ptr) .and. associated(source_ptr)) then localrc = ESMF_RC_VAL_OUTOFRANGE if (slice > 0 .and. slice <= size(source_ptr, dim=4)) then - factor = 1._kind_phys + factor = 1._8 if (present(scale_factor)) factor = scale_factor do k = 1, size(source_ptr, dim=3) !$omp parallel do private(ix,ib,jb,i,j) @@ -390,30 +406,30 @@ subroutine block_copy_3dslice_to_3d_r8(destin_ptr, source_ptr, slice, block, blo if (present(rc)) rc = localrc - end subroutine block_copy_3dslice_to_3d_r8 + end subroutine block_copy_3dslice_r8_to_3d_r8 - subroutine block_array_copy_3dslice_to_3d_r8(destin_ptr, source_arr, slice, block, block_index, scale_factor, rc) + subroutine block_array_copy_3dslice_r8_to_3d_r8(destin_ptr, source_arr, slice, block, block_index, scale_factor, rc) ! -- arguments real(ESMF_KIND_R8), pointer :: destin_ptr(:,:,:) - real, intent(in) :: source_arr(:,:,:,:) + real(kind=8), intent(in) :: source_arr(:,:,:,:) integer, intent(in) :: slice type (block_control_type), intent(in) :: block integer, intent(in) :: block_index - real, optional, intent(in) :: scale_factor + real(kind=8), optional, intent(in) :: scale_factor integer, optional, intent(out) :: rc ! -- local variables integer :: localrc integer :: i, ib, ix, j, jb, k - real :: factor + real(kind=8) :: factor ! -- begin localrc = ESMF_RC_PTR_NOTALLOC if (associated(destin_ptr)) then localrc = ESMF_RC_VAL_OUTOFRANGE if (slice > 0 .and. slice <= size(source_arr, dim=4)) then - factor = 1._kind_phys + factor = 1._8 if (present(scale_factor)) factor = scale_factor do k = 1, size(source_arr, dim=3) !$omp parallel do private(ix,ib,jb,i,j) @@ -431,7 +447,7 @@ subroutine block_array_copy_3dslice_to_3d_r8(destin_ptr, source_arr, slice, bloc if (present(rc)) rc = localrc - end subroutine block_array_copy_3dslice_to_3d_r8 + end subroutine block_array_copy_3dslice_r8_to_3d_r8 ! -- fill: 2D @@ -503,11 +519,477 @@ end subroutine block_fill_3d_r8 ! -- copy/fill: 1D to 2D - subroutine block_copy_or_fill_1d_to_2d_r8(destin_ptr, source_ptr, fill_value, block, block_index, rc) + subroutine block_copy_or_fill_1d_r8_to_2d_r8(destin_ptr, source_ptr, fill_value, block, block_index, rc) + + ! -- arguments + real(ESMF_KIND_R8), pointer :: destin_ptr(:,:) + real(kind=8), pointer :: source_ptr(:) + real(ESMF_KIND_R8), intent(in) :: fill_value + type (block_control_type), intent(in) :: block + integer, intent(in) :: block_index + integer, optional, intent(out) :: rc + + ! -- begin + if (present(rc)) rc = ESMF_RC_PTR_NOTALLOC + + if (associated(destin_ptr)) then + if (associated(source_ptr)) then + call block_copy_1d_r8_to_2d_r8(destin_ptr, source_ptr, block, block_index, rc=rc) + else + call block_fill_2d_r8(destin_ptr, fill_value, block, block_index, rc=rc) + end if + end if + + end subroutine block_copy_or_fill_1d_r8_to_2d_r8 + + ! -- copy/fill: 1D slice to 2D + + subroutine block_copy_or_fill_1dslice_r8_to_2d_r8(destin_ptr, source_ptr, slice, fill_value, block, block_index, rc) + + ! -- arguments + real(ESMF_KIND_R8), pointer :: destin_ptr(:,:) + real(kind=8), pointer :: source_ptr(:,:) + integer, intent(in) :: slice + real(ESMF_KIND_R8), intent(in) :: fill_value + type (block_control_type), intent(in) :: block + integer, intent(in) :: block_index + integer, optional, intent(out) :: rc + + ! -- begin + if (present(rc)) rc = ESMF_RC_PTR_NOTALLOC + + if (associated(destin_ptr)) then + if (associated(source_ptr)) then + call block_copy_1dslice_r8_to_2d_r8(destin_ptr, source_ptr, slice, block, block_index, rc=rc) + else + call block_fill_2d_r8(destin_ptr, fill_value, block, block_index, rc=rc) + end if + end if + + end subroutine block_copy_or_fill_1dslice_r8_to_2d_r8 + + ! -- copy/fill: 2D to 3D + + subroutine block_copy_or_fill_2d_r8_to_3d_r8(destin_ptr, source_ptr, fill_value, block, block_index, rc) + + ! -- arguments + real(ESMF_KIND_R8), pointer :: destin_ptr(:,:,:) + real(kind=8), pointer :: source_ptr(:,:) + real(ESMF_KIND_R8), intent(in) :: fill_value + type (block_control_type), intent(in) :: block + integer, intent(in) :: block_index + integer, optional, intent(out) :: rc + + ! -- begin + if (present(rc)) rc = ESMF_RC_PTR_NOTALLOC + + if (associated(destin_ptr)) then + if (associated(source_ptr)) then + call block_copy_2d_r8_to_3d_r8(destin_ptr, source_ptr, block, block_index, rc=rc) + else + call block_fill_3d_r8(destin_ptr, fill_value, block, block_index, rc=rc) + end if + end if + + end subroutine block_copy_or_fill_2d_r8_to_3d_r8 + + ! -- combine: 1D to 2D + + subroutine block_combine_frac_1d_r8_to_2d_r8(destin_ptr, fract1_ptr, fract2_ptr, block, block_index, rc) + + ! -- arguments + real(ESMF_KIND_R8), pointer :: destin_ptr(:,:) + real(kind=8), pointer :: fract1_ptr(:) + real(kind=8), pointer :: fract2_ptr(:) + type(block_control_type), intent(in) :: block + integer, intent(in) :: block_index + integer, optional, intent(out) :: rc + + ! -- local variables + integer :: localrc + integer :: i, ib, ix, j, jb + real(kind=8) :: factor + + ! -- begin + localrc = ESMF_RC_PTR_NOTALLOC + if (associated(destin_ptr) .and. & + associated(fract1_ptr) .and. associated(fract2_ptr)) then +!$omp parallel do private(ix,ib,jb,i,j) + do ix = 1, block%blksz(block_index) + ib = block%index(block_index)%ii(ix) + jb = block%index(block_index)%jj(ix) + i = ib - block%isc + 1 + j = jb - block%jsc + 1 + destin_ptr(i,j) = fract1_ptr(ix) * (1._8 - fract2_ptr(ix)) + enddo + localrc = ESMF_SUCCESS + end if + + if (present(rc)) rc = localrc + + end subroutine block_combine_frac_1d_r8_to_2d_r8 + + + ! ------------------------------------------------------------------------------------------ + + ! Real*4 Routines + + ! ------------------------------------------------------------------------------------------ + + subroutine block_copy_1d_r4_to_2d_r8(destin_ptr, source_ptr, block, block_index, scale_factor, rc) + + ! -- arguments + real(ESMF_KIND_R8), pointer :: destin_ptr(:,:) + real(kind=4), pointer :: source_ptr(:) + type(block_control_type), intent(in) :: block + integer, intent(in) :: block_index + real(kind=4), optional, intent(in) :: scale_factor + integer, optional, intent(out) :: rc + + ! -- local variables + integer :: localrc + integer :: i, ib, ix, j, jb + real(kind=4) :: factor + + ! -- begin + localrc = ESMF_RC_PTR_NOTALLOC + if (associated(destin_ptr) .and. associated(source_ptr)) then + factor = 1._4 + if (present(scale_factor)) factor = scale_factor +!$omp parallel do private(ix,ib,jb,i,j) + do ix = 1, block%blksz(block_index) + ib = block%index(block_index)%ii(ix) + jb = block%index(block_index)%jj(ix) + i = ib - block%isc + 1 + j = jb - block%jsc + 1 + destin_ptr(i,j) = factor * source_ptr(ix) + enddo + localrc = ESMF_SUCCESS + end if + + if (present(rc)) rc = localrc + + end subroutine block_copy_1d_r4_to_2d_r8 + + ! -- copy: 1D slice to 2D + + subroutine block_copy_1dslice_r4_to_2d_r8(destin_ptr, source_ptr, slice, block, block_index, scale_factor, rc) + + ! -- arguments + real(ESMF_KIND_R8), pointer :: destin_ptr(:,:) + real(kind=4), pointer :: source_ptr(:,:) + integer, intent(in) :: slice + type (block_control_type), intent(in) :: block + integer, intent(in) :: block_index + real(kind=4), optional, intent(in) :: scale_factor + integer, optional, intent(out) :: rc + + ! -- local variables + integer :: localrc + integer :: i, ib, ix, j, jb + real(kind=4) :: factor + + ! -- begin + localrc = ESMF_RC_PTR_NOTALLOC + if (associated(destin_ptr) .and. associated(source_ptr)) then + localrc = ESMF_RC_VAL_OUTOFRANGE + if (slice > 0 .and. slice <= size(source_ptr, dim=2)) then + factor = 1._4 + if (present(scale_factor)) factor = scale_factor +!$omp parallel do private(ix,ib,jb,i,j) + do ix = 1, block%blksz(block_index) + ib = block%index(block_index)%ii(ix) + jb = block%index(block_index)%jj(ix) + i = ib - block%isc + 1 + j = jb - block%jsc + 1 + destin_ptr(i,j) = factor * source_ptr(ix,slice) + enddo + localrc = ESMF_SUCCESS + end if + end if + + if (present(rc)) rc = localrc + + end subroutine block_copy_1dslice_r4_to_2d_r8 + + ! -- copy: 2D to 3D + + subroutine block_copy_2d_r4_to_3d_r8(destin_ptr, source_ptr, block, block_index, scale_factor, rc) + + ! -- arguments + real(ESMF_KIND_R8), pointer :: destin_ptr(:,:,:) + real(kind=4), pointer :: source_ptr(:,:) + type (block_control_type), intent(in) :: block + integer, intent(in) :: block_index + real(kind=4), optional, intent(in) :: scale_factor + integer, optional, intent(out) :: rc + + ! -- local variables + integer :: localrc + integer :: i, ib, ix, j, jb, k + real(kind=4) :: factor + + ! -- begin + localrc = ESMF_RC_PTR_NOTALLOC + if (associated(destin_ptr) .and. associated(source_ptr)) then + factor = 1._4 + if (present(scale_factor)) factor = scale_factor + do k = 1, size(source_ptr, dim=2) +!$omp parallel do private(ix,ib,jb,i,j) + do ix = 1, block%blksz(block_index) + ib = block%index(block_index)%ii(ix) + jb = block%index(block_index)%jj(ix) + i = ib - block%isc + 1 + j = jb - block%jsc + 1 + destin_ptr(i,j,k) = factor * source_ptr(ix,k) + enddo + enddo + localrc = ESMF_SUCCESS + end if + + if (present(rc)) rc = localrc + + end subroutine block_copy_2d_r4_to_3d_r8 + + ! -- copy: 2D to 2D + + subroutine block_copy_2d_r4_to_2d_r8(destin_ptr, source_ptr, block, block_index, scale_factor, rc) + + ! -- arguments + real(ESMF_KIND_R8), pointer :: destin_ptr(:,:) + real(kind=4), pointer :: source_ptr(:,:) + type (block_control_type), intent(in) :: block + integer, intent(in) :: block_index + real(kind=4), optional, intent(in) :: scale_factor + integer, optional, intent(out) :: rc + + ! -- local variables + integer :: localrc + integer :: i, ib, ix, j, jb + real(kind=4) :: factor + + ! -- begin + localrc = ESMF_RC_PTR_NOTALLOC + if (associated(destin_ptr) .and. associated(source_ptr)) then + factor = 1._4 + if (present(scale_factor)) factor = scale_factor +!$omp parallel do private(ix,ib,jb,i,j) + do ix = 1, block%blksz(block_index) + ib = block%index(block_index)%ii(ix) + jb = block%index(block_index)%jj(ix) + i = ib - block%isc + 1 + j = jb - block%jsc + 1 + destin_ptr(i,j) = factor * source_ptr(ib,jb) + enddo + localrc = ESMF_SUCCESS + end if + + if (present(rc)) rc = localrc + + end subroutine block_copy_2d_r4_to_2d_r8 + + subroutine block_array_copy_2d_r4_to_2d_r8(destin_ptr, source_arr, block, block_index, scale_factor, rc) + + ! -- arguments + real(ESMF_KIND_R8), pointer :: destin_ptr(:,:) + real(kind=4), intent(in) :: source_arr(:,:) + type (block_control_type), intent(in) :: block + integer, intent(in) :: block_index + real(kind=4), optional, intent(in) :: scale_factor + integer, optional, intent(out) :: rc + + ! -- local variables + integer :: localrc + integer :: i, ib, ix, j, jb + real(kind=4) :: factor + + ! -- begin + localrc = ESMF_RC_PTR_NOTALLOC + if (associated(destin_ptr)) then + factor = 1._4 + if (present(scale_factor)) factor = scale_factor +!$omp parallel do private(ix,ib,jb,i,j) + do ix = 1, block%blksz(block_index) + ib = block%index(block_index)%ii(ix) + jb = block%index(block_index)%jj(ix) + i = ib - block%isc + 1 + j = jb - block%jsc + 1 + destin_ptr(i,j) = factor * source_arr(ib,jb) + enddo + localrc = ESMF_SUCCESS + end if + + if (present(rc)) rc = localrc + + end subroutine block_array_copy_2d_r4_to_2d_r8 + + ! -- copy: 3D to 3D + + subroutine block_copy_3d_r4_to_3d_r8(destin_ptr, source_ptr, block, block_index, scale_factor, rc) + + ! -- arguments + real(ESMF_KIND_R8), pointer :: destin_ptr(:,:,:) + real(kind=4), pointer :: source_ptr(:,:,:) + type (block_control_type), intent(in) :: block + integer, intent(in) :: block_index + real(kind=4), optional, intent(in) :: scale_factor + integer, optional, intent(out) :: rc + + ! -- local variables + integer :: localrc + integer :: i, ib, ix, j, jb, k + real(kind=4) :: factor + + ! -- begin + localrc = ESMF_RC_PTR_NOTALLOC + if (associated(destin_ptr) .and. associated(source_ptr)) then + factor = 1._4 + if (present(scale_factor)) factor = scale_factor + do k = 1, size(source_ptr, dim=3) +!$omp parallel do private(ix,ib,jb,i,j) + do ix = 1, block%blksz(block_index) + ib = block%index(block_index)%ii(ix) + jb = block%index(block_index)%jj(ix) + i = ib - block%isc + 1 + j = jb - block%jsc + 1 + destin_ptr(i,j,k) = factor * source_ptr(ib,jb,k) + enddo + enddo + localrc = ESMF_SUCCESS + end if + + if (present(rc)) rc = localrc + + end subroutine block_copy_3d_r4_to_3d_r8 + + subroutine block_array_copy_3d_r4_to_3d_r8(destin_ptr, source_arr, block, block_index, scale_factor, rc) + + ! -- arguments + real(ESMF_KIND_R8), pointer :: destin_ptr(:,:,:) + real(kind=4), intent(in) :: source_arr(:,:,:) + type (block_control_type), intent(in) :: block + integer, intent(in) :: block_index + real(kind=4), optional, intent(in) :: scale_factor + integer, optional, intent(out) :: rc + + ! -- local variables + integer :: localrc + integer :: i, ib, ix, j, jb, k + real(kind=4) :: factor + + ! -- begin + localrc = ESMF_RC_PTR_NOTALLOC + if (associated(destin_ptr)) then + factor = 1._4 + if (present(scale_factor)) factor = scale_factor + do k = 1, size(source_arr, dim=3) +!$omp parallel do private(ix,ib,jb,i,j) + do ix = 1, block%blksz(block_index) + ib = block%index(block_index)%ii(ix) + jb = block%index(block_index)%jj(ix) + i = ib - block%isc + 1 + j = jb - block%jsc + 1 + destin_ptr(i,j,k) = factor * source_arr(ib,jb,k) + enddo + enddo + localrc = ESMF_SUCCESS + end if + + if (present(rc)) rc = localrc + + end subroutine block_array_copy_3d_r4_to_3d_r8 + + ! -- copy: 3D slice to 3D + + subroutine block_copy_3dslice_r4_to_3d_r8(destin_ptr, source_ptr, slice, block, block_index, scale_factor, rc) + + ! -- arguments + real(ESMF_KIND_R8), pointer :: destin_ptr(:,:,:) + real(kind=4), pointer :: source_ptr(:,:,:,:) + integer, intent(in) :: slice + type (block_control_type), intent(in) :: block + integer, intent(in) :: block_index + real(kind=4), optional, intent(in) :: scale_factor + integer, optional, intent(out) :: rc + + ! -- local variables + integer :: localrc + integer :: i, ib, ix, j, jb, k + real(kind=4) :: factor + + ! -- begin + localrc = ESMF_RC_PTR_NOTALLOC + if (associated(destin_ptr) .and. associated(source_ptr)) then + localrc = ESMF_RC_VAL_OUTOFRANGE + if (slice > 0 .and. slice <= size(source_ptr, dim=4)) then + factor = 1._4 + if (present(scale_factor)) factor = scale_factor + do k = 1, size(source_ptr, dim=3) +!$omp parallel do private(ix,ib,jb,i,j) + do ix = 1, block%blksz(block_index) + ib = block%index(block_index)%ii(ix) + jb = block%index(block_index)%jj(ix) + i = ib - block%isc + 1 + j = jb - block%jsc + 1 + destin_ptr(i,j,k) = factor * source_ptr(ib,jb,k,slice) + enddo + enddo + localrc = ESMF_SUCCESS + end if + end if + + if (present(rc)) rc = localrc + + end subroutine block_copy_3dslice_r4_to_3d_r8 + + subroutine block_array_copy_3dslice_r4_to_3d_r8(destin_ptr, source_arr, slice, block, block_index, scale_factor, rc) + + ! -- arguments + real(ESMF_KIND_R8), pointer :: destin_ptr(:,:,:) + real(kind=4), intent(in) :: source_arr(:,:,:,:) + integer, intent(in) :: slice + type (block_control_type), intent(in) :: block + integer, intent(in) :: block_index + real(kind=4), optional, intent(in) :: scale_factor + integer, optional, intent(out) :: rc + + ! -- local variables + integer :: localrc + integer :: i, ib, ix, j, jb, k + real(kind=4) :: factor + + ! -- begin + localrc = ESMF_RC_PTR_NOTALLOC + if (associated(destin_ptr)) then + localrc = ESMF_RC_VAL_OUTOFRANGE + if (slice > 0 .and. slice <= size(source_arr, dim=4)) then + factor = 1._4 + if (present(scale_factor)) factor = scale_factor + do k = 1, size(source_arr, dim=3) +!$omp parallel do private(ix,ib,jb,i,j) + do ix = 1, block%blksz(block_index) + ib = block%index(block_index)%ii(ix) + jb = block%index(block_index)%jj(ix) + i = ib - block%isc + 1 + j = jb - block%jsc + 1 + destin_ptr(i,j,k) = factor * source_arr(ib,jb,k,slice) + enddo + enddo + localrc = ESMF_SUCCESS + end if + end if + + if (present(rc)) rc = localrc + + end subroutine block_array_copy_3dslice_r4_to_3d_r8 + + ! -- copy/fill: 1D to 2D + + subroutine block_copy_or_fill_1d_r4_to_2d_r8(destin_ptr, source_ptr, fill_value, block, block_index, rc) ! -- arguments real(ESMF_KIND_R8), pointer :: destin_ptr(:,:) - real(kind_phys), pointer :: source_ptr(:) + real(kind=4), pointer :: source_ptr(:) real(ESMF_KIND_R8), intent(in) :: fill_value type (block_control_type), intent(in) :: block integer, intent(in) :: block_index @@ -518,21 +1000,21 @@ subroutine block_copy_or_fill_1d_to_2d_r8(destin_ptr, source_ptr, fill_value, bl if (associated(destin_ptr)) then if (associated(source_ptr)) then - call block_copy_1d_to_2d_r8(destin_ptr, source_ptr, block, block_index, rc=rc) + call block_copy_1d_r4_to_2d_r8(destin_ptr, source_ptr, block, block_index, rc=rc) else call block_fill_2d_r8(destin_ptr, fill_value, block, block_index, rc=rc) end if end if - end subroutine block_copy_or_fill_1d_to_2d_r8 + end subroutine block_copy_or_fill_1d_r4_to_2d_r8 ! -- copy/fill: 1D slice to 2D - subroutine block_copy_or_fill_1dslice_to_2d_r8(destin_ptr, source_ptr, slice, fill_value, block, block_index, rc) + subroutine block_copy_or_fill_1dslice_r4_to_2d_r8(destin_ptr, source_ptr, slice, fill_value, block, block_index, rc) ! -- arguments real(ESMF_KIND_R8), pointer :: destin_ptr(:,:) - real(kind_phys), pointer :: source_ptr(:,:) + real(kind=4), pointer :: source_ptr(:,:) integer, intent(in) :: slice real(ESMF_KIND_R8), intent(in) :: fill_value type (block_control_type), intent(in) :: block @@ -544,21 +1026,21 @@ subroutine block_copy_or_fill_1dslice_to_2d_r8(destin_ptr, source_ptr, slice, fi if (associated(destin_ptr)) then if (associated(source_ptr)) then - call block_copy_1dslice_to_2d_r8(destin_ptr, source_ptr, slice, block, block_index, rc=rc) + call block_copy_1dslice_r4_to_2d_r8(destin_ptr, source_ptr, slice, block, block_index, rc=rc) else call block_fill_2d_r8(destin_ptr, fill_value, block, block_index, rc=rc) end if end if - end subroutine block_copy_or_fill_1dslice_to_2d_r8 + end subroutine block_copy_or_fill_1dslice_r4_to_2d_r8 ! -- copy/fill: 2D to 3D - subroutine block_copy_or_fill_2d_to_3d_r8(destin_ptr, source_ptr, fill_value, block, block_index, rc) + subroutine block_copy_or_fill_2d_r4_to_3d_r8(destin_ptr, source_ptr, fill_value, block, block_index, rc) ! -- arguments real(ESMF_KIND_R8), pointer :: destin_ptr(:,:,:) - real(kind_phys), pointer :: source_ptr(:,:) + real(kind=4), pointer :: source_ptr(:,:) real(ESMF_KIND_R8), intent(in) :: fill_value type (block_control_type), intent(in) :: block integer, intent(in) :: block_index @@ -569,22 +1051,22 @@ subroutine block_copy_or_fill_2d_to_3d_r8(destin_ptr, source_ptr, fill_value, bl if (associated(destin_ptr)) then if (associated(source_ptr)) then - call block_copy_2d_to_3d_r8(destin_ptr, source_ptr, block, block_index, rc=rc) + call block_copy_2d_r4_to_3d_r8(destin_ptr, source_ptr, block, block_index, rc=rc) else call block_fill_3d_r8(destin_ptr, fill_value, block, block_index, rc=rc) end if end if - end subroutine block_copy_or_fill_2d_to_3d_r8 + end subroutine block_copy_or_fill_2d_r4_to_3d_r8 ! -- combine: 1D to 2D - subroutine block_combine_frac_1d_to_2d_r8(destin_ptr, fract1_ptr, fract2_ptr, block, block_index, rc) + subroutine block_combine_frac_1d_r4_to_2d_r8(destin_ptr, fract1_ptr, fract2_ptr, block, block_index, rc) ! -- arguments real(ESMF_KIND_R8), pointer :: destin_ptr(:,:) - real(kind_phys), pointer :: fract1_ptr(:) - real(kind_phys), pointer :: fract2_ptr(:) + real(kind=4), pointer :: fract1_ptr(:) + real(kind=4), pointer :: fract2_ptr(:) type(block_control_type), intent(in) :: block integer, intent(in) :: block_index integer, optional, intent(out) :: rc @@ -592,7 +1074,7 @@ subroutine block_combine_frac_1d_to_2d_r8(destin_ptr, fract1_ptr, fract2_ptr, bl ! -- local variables integer :: localrc integer :: i, ib, ix, j, jb - real(kind_phys) :: factor + real(kind=4) :: factor ! -- begin localrc = ESMF_RC_PTR_NOTALLOC @@ -604,13 +1086,13 @@ subroutine block_combine_frac_1d_to_2d_r8(destin_ptr, fract1_ptr, fract2_ptr, bl jb = block%index(block_index)%jj(ix) i = ib - block%isc + 1 j = jb - block%jsc + 1 - destin_ptr(i,j) = fract1_ptr(ix) * (1._kind_phys - fract2_ptr(ix)) + destin_ptr(i,j) = fract1_ptr(ix) * (1._4 - fract2_ptr(ix)) enddo localrc = ESMF_SUCCESS end if if (present(rc)) rc = localrc - end subroutine block_combine_frac_1d_to_2d_r8 + end subroutine block_combine_frac_1d_r4_to_2d_r8 end module module_block_data From 4077e79c7d7eb483985bec0cf046db191318b9b1 Mon Sep 17 00:00:00 2001 From: Samuel Trahan Date: Wed, 4 May 2022 17:43:55 +0000 Subject: [PATCH 04/25] Pass CCPP_32BIT to ccpp --- CMakeLists.txt | 6 ++++++ ccpp/CMakeLists.txt | 37 ++++++++++++++++++++++++++++--------- 2 files changed, 34 insertions(+), 9 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index 8f24f04fd..c0ffa4ebe 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -31,6 +31,12 @@ else() list(APPEND _fv3atm_defs_private NO_INLINE_POST) endif() +if(CCPP_32BIT) + add_definitions(-DCCPP_32BIT) +else() + remove_definitions(-DCCPP_32BIT) +endif() + if(NOT PARALLEL_NETCDF) list(APPEND _fv3atm_defs_private NO_PARALLEL_NETCDF) endif() diff --git a/ccpp/CMakeLists.txt b/ccpp/CMakeLists.txt index 8ee867056..2383c2756 100644 --- a/ccpp/CMakeLists.txt +++ b/ccpp/CMakeLists.txt @@ -53,22 +53,41 @@ endif() #------------------------------------------------------------------------------ # Set flag for 32bit dynamics build if(32BIT) - message(STATUS "Compile CCPP slow physics with 64-bit precision, fast physics with 32-bit precision") + message(STATUS "Compile CCPP fast physics with 32-bit precision") add_definitions(-DOVERLOAD_R4) - if(CMAKE_Fortran_COMPILER_ID MATCHES "Intel") - set(CMAKE_Fortran_FLAGS_PHYSICS "-real-size 64 -no-prec-div -no-prec-sqrt") - elseif(CMAKE_Fortran_COMPILER_ID MATCHES "GNU") - set(CMAKE_Fortran_FLAGS_PHYSICS "-fdefault-real-8 -fdefault-double-8") - endif() + # if(CMAKE_Fortran_COMPILER_ID MATCHES "Intel") + # set(CMAKE_Fortran_FLAGS_PHYSICS "-real-size 64 -no-prec-div -no-prec-sqrt") + # elseif(CMAKE_Fortran_COMPILER_ID MATCHES "GNU") + # set(CMAKE_Fortran_FLAGS_PHYSICS "-fdefault-real-8 -fdefault-double-8") + # endif() set(CMAKE_Fortran_FLAGS_DYNAMICS "") else() - message(STATUS "Compile CCPP physics with 64-bit precision") + message(STATUS "Compile CCPP fast physics with 64-bit precision") remove_definitions(-DOVERLOAD_R8) remove_definitions(-DOVERLOAD_R4) - set(CMAKE_Fortran_FLAGS_PHYSICS "") - set(CMAKE_Fortran_FLAGS_DYNAMICS "") endif() +if(CCPP_32BIT) + if(NOT 32BIT) + message(FATAL_ERROR "When compiling CCPP slow physics 32-bit (CCPP_32BIT=ON), you must also compile fast physics 32-bit (32BIT=ON)") + endif() + message(STATUS "Compile CCPP slow physics with 32-bit precision") + add_definitions(-DSINGLE_PREC) + if(CMAKE_Fortran_COMPILER_ID MATCHES "Intel") + set(CMAKE_Fortran_FLAGS_PHYSICS "-real-size 32") + elseif(CMAKE_Fortran_COMPILER_ID MATCHES "GNU") + set(CMAKE_Fortran_FLAGS_PHYSICS "-fdefault-real-4 -fdefault-double-8") + endif() +else(CCPP_32BIT) + message(STATUS "Compile CCPP slow physics with 64-bit precision") + remove_definitions(-DSINGLE_PREC) + if(CMAKE_Fortran_COMPILER_ID MATCHES "Intel") + set(CMAKE_Fortran_FLAGS_PHYSICS "-real-size 64 -no-prec-div -no-prec-sqrt") + elseif(CMAKE_Fortran_COMPILER_ID MATCHES "GNU") + set(CMAKE_Fortran_FLAGS_PHYSICS "-fdefault-real-8 -fdefault-double-8") + endif() +endif(CCPP_32BIT) + #------------------------------------------------------------------------------ # Add model-specific flags for C/C++/Fortran preprocessor add_definitions(-DMOIST_CAPPA -DUSE_COND -DNEMS_GSM) From 076f154e41c5b68024354eaf82502cde7ac5ada0 Mon Sep 17 00:00:00 2001 From: Samuel Trahan Date: Wed, 4 May 2022 17:44:25 +0000 Subject: [PATCH 05/25] Correct datatypes for kind_phys=4 --- atmos_model.F90 | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) diff --git a/atmos_model.F90 b/atmos_model.F90 index 35433c774..9838420a5 100644 --- a/atmos_model.F90 +++ b/atmos_model.F90 @@ -137,14 +137,14 @@ module atmos_model_mod integer :: mlon, mlat integer :: iau_offset ! iau running window length logical :: pe ! current pe. - real(kind=8), pointer, dimension(:) :: ak, bk + real(kind=GFS_kind_phys), pointer, dimension(:) :: ak, bk real(kind=GFS_kind_phys), pointer, dimension(:,:) :: lon_bnd => null() ! local longitude axis grid box corners in radians. real(kind=GFS_kind_phys), pointer, dimension(:,:) :: lat_bnd => null() ! local latitude axis grid box corners in radians. real(kind=GFS_kind_phys), pointer, dimension(:,:) :: lon => null() ! local longitude axis grid box centers in radians. real(kind=GFS_kind_phys), pointer, dimension(:,:) :: lat => null() ! local latitude axis grid box centers in radians. real(kind=GFS_kind_phys), pointer, dimension(:,:) :: dx, dy - real(kind=8), pointer, dimension(:,:) :: area - real(kind=8), pointer, dimension(:,:,:) :: layer_hgt, level_hgt + real(kind=GFS_kind_phys), pointer, dimension(:,:) :: area + real(kind=GFS_kind_phys), pointer, dimension(:,:,:) :: layer_hgt, level_hgt type(domain2d) :: domain ! domain decomposition type(time_type) :: Time ! current time type(time_type) :: Time_step ! atmospheric time step. @@ -464,9 +464,9 @@ subroutine atmos_timestep_diagnostics(Atmos) psum = psum + adiff if(adiff>=maxabs) then maxabs=adiff - pmaxloc(2:3) = (/ ATM_block%index(nb)%ii(i), ATM_block%index(nb)%jj(i) /) - pmaxloc(4:7) = (/ pdiff, GFS_data(nb)%Statein%pgr(i), & - GFS_data(nb)%Grid%xlat(i), GFS_data(nb)%Grid%xlon(i) /) + pmaxloc(2:3) = (/ dble(ATM_block%index(nb)%ii(i)), dble(ATM_block%index(nb)%jj(i)) /) + pmaxloc(4:7) = (/ dble(pdiff), dble(GFS_data(nb)%Statein%pgr(i)), & + dble(GFS_data(nb)%Grid%xlat(i)), dble(GFS_data(nb)%Grid%xlon(i)) /) endif enddo pcount = pcount+count @@ -2779,6 +2779,7 @@ subroutine setup_exportdata(rc) ! Instantaneous u wind (m/s) 10 m above ground case ('inst_zonal_wind_height10m') call block_data_copy(datar82d, GFS_data(nb)%coupling%u10mi_cpl, Atm_block, nb, rc=localrc) + !call block_data_copy(datar82d, GFS_data(nb)%coupling%u10mi_cpl, Atm_block, nb, rc=localrc) ! Instantaneous v wind (m/s) 10 m above ground case ('inst_merid_wind_height10m') call block_data_copy(datar82d, GFS_data(nb)%coupling%v10mi_cpl, Atm_block, nb, rc=localrc) From 20e912b15e57da7030756fccbce0f21842f02aea Mon Sep 17 00:00:00 2001 From: Samuel Trahan Date: Wed, 4 May 2022 17:44:46 +0000 Subject: [PATCH 06/25] Point to Sam's branches of atmos_cubed_sphere and ccpp/physics --- .gitmodules | 4 ++-- atmos_cubed_sphere | 2 +- ccpp/physics | 2 +- 3 files changed, 4 insertions(+), 4 deletions(-) diff --git a/.gitmodules b/.gitmodules index ebb742558..bb4e2d2eb 100644 --- a/.gitmodules +++ b/.gitmodules @@ -1,6 +1,6 @@ [submodule "atmos_cubed_sphere"] path = atmos_cubed_sphere - url = https://github.com/NOAA-GFDL/GFDL_atmos_cubed_sphere + url = ssh://git@github.com/SamuelTrahanNOAA/GFDL_atmos_cubed_sphere branch = dev/emc [submodule "ccpp/framework"] path = ccpp/framework @@ -8,7 +8,7 @@ branch = main [submodule "ccpp/physics"] path = ccpp/physics - url = https://github.com/SamuelTrahanNOAA/ccpp-physics + url = ssh://git@github.com/SamuelTrahanNOAA/ccpp-physics branch = sing_prec_from_main [submodule "upp"] path = upp diff --git a/atmos_cubed_sphere b/atmos_cubed_sphere index fad4c9f1f..f7b5ec3d2 160000 --- a/atmos_cubed_sphere +++ b/atmos_cubed_sphere @@ -1 +1 @@ -Subproject commit fad4c9f1fc29c0cbb47df9a07a573249155a1c42 +Subproject commit f7b5ec3d29b504052841df6be7dba9e87b1063c9 diff --git a/ccpp/physics b/ccpp/physics index 527e1b976..6871a936a 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 527e1b976bd74dc0214a13f91f804ec2334d862c +Subproject commit 6871a936a9df8054fa2b4b34c6e52ad5d5cce738 From db230f12b8a0bde2e05d0b951567dbb3b47abb4b Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Wed, 4 May 2022 22:10:07 +0000 Subject: [PATCH 07/25] Correct the 32-bit physics gnu flags --- ccpp/CMakeLists.txt | 7 +------ 1 file changed, 1 insertion(+), 6 deletions(-) diff --git a/ccpp/CMakeLists.txt b/ccpp/CMakeLists.txt index 2383c2756..350ad697e 100644 --- a/ccpp/CMakeLists.txt +++ b/ccpp/CMakeLists.txt @@ -55,11 +55,6 @@ endif() if(32BIT) message(STATUS "Compile CCPP fast physics with 32-bit precision") add_definitions(-DOVERLOAD_R4) - # if(CMAKE_Fortran_COMPILER_ID MATCHES "Intel") - # set(CMAKE_Fortran_FLAGS_PHYSICS "-real-size 64 -no-prec-div -no-prec-sqrt") - # elseif(CMAKE_Fortran_COMPILER_ID MATCHES "GNU") - # set(CMAKE_Fortran_FLAGS_PHYSICS "-fdefault-real-8 -fdefault-double-8") - # endif() set(CMAKE_Fortran_FLAGS_DYNAMICS "") else() message(STATUS "Compile CCPP fast physics with 64-bit precision") @@ -76,7 +71,7 @@ if(CCPP_32BIT) if(CMAKE_Fortran_COMPILER_ID MATCHES "Intel") set(CMAKE_Fortran_FLAGS_PHYSICS "-real-size 32") elseif(CMAKE_Fortran_COMPILER_ID MATCHES "GNU") - set(CMAKE_Fortran_FLAGS_PHYSICS "-fdefault-real-4 -fdefault-double-8") + set(CMAKE_Fortran_FLAGS_PHYSICS "-fno-default-real-8 -fdefault-double-8") endif() else(CCPP_32BIT) message(STATUS "Compile CCPP slow physics with 64-bit precision") From 92ed087f1388fab863206e711946d5272dd9d3d6 Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Thu, 5 May 2022 22:58:28 +0000 Subject: [PATCH 08/25] Revise ccpp-physics changes to pass 64-bit gnu regression tests (intel not yet tested) --- ccpp/physics | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ccpp/physics b/ccpp/physics index de90593a6..63020ec6a 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit de90593a67bd8fbc060f6d1e2c0847d4d3d2da19 +Subproject commit 63020ec6a737511a46102865458b9843e340a404 From ca36376aa1fc471dd1b7c191e06c174d690b91a2 Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Tue, 24 May 2022 14:36:43 +0000 Subject: [PATCH 09/25] switch ssh -> https --- .gitmodules | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/.gitmodules b/.gitmodules index bb4e2d2eb..a7209d8df 100644 --- a/.gitmodules +++ b/.gitmodules @@ -1,6 +1,6 @@ [submodule "atmos_cubed_sphere"] path = atmos_cubed_sphere - url = ssh://git@github.com/SamuelTrahanNOAA/GFDL_atmos_cubed_sphere + url = https://github.com/SamuelTrahanNOAA/GFDL_atmos_cubed_sphere branch = dev/emc [submodule "ccpp/framework"] path = ccpp/framework @@ -8,7 +8,7 @@ branch = main [submodule "ccpp/physics"] path = ccpp/physics - url = ssh://git@github.com/SamuelTrahanNOAA/ccpp-physics + url = https://github.com/SamuelTrahanNOAA/ccpp-physics branch = sing_prec_from_main [submodule "upp"] path = upp From 058e68f5b772d98e02f71da047f398a0084ebb1a Mon Sep 17 00:00:00 2001 From: Dusan Jovic Date: Thu, 26 May 2022 20:37:30 +0000 Subject: [PATCH 10/25] Set correct kind of coordinate arrays when constructing fcst grids --- .gitmodules | 4 ++-- ccpp/data/GFS_typedefs.F90 | 23 +++++++++++++++++++++-- ccpp/physics | 2 +- module_fcst_grid_comp.F90 | 11 +++++++++++ 4 files changed, 35 insertions(+), 5 deletions(-) diff --git a/.gitmodules b/.gitmodules index a7209d8df..0e5ac5a7a 100644 --- a/.gitmodules +++ b/.gitmodules @@ -8,8 +8,8 @@ branch = main [submodule "ccpp/physics"] path = ccpp/physics - url = https://github.com/SamuelTrahanNOAA/ccpp-physics - branch = sing_prec_from_main + url = https://github.com/DusanJovic-NOAA/ccpp-physics + branch = single_prec [submodule "upp"] path = upp url = https://github.com/NOAA-EMC/UPP diff --git a/ccpp/data/GFS_typedefs.F90 b/ccpp/data/GFS_typedefs.F90 index f125489af..b55ea324d 100644 --- a/ccpp/data/GFS_typedefs.F90 +++ b/ccpp/data/GFS_typedefs.F90 @@ -1,6 +1,6 @@ module GFS_typedefs - use machine, only: kind_phys, kind_dbl_prec + use machine, only: kind_phys, kind_dbl_prec, kind_sngl_prec use physcons, only: con_cp, con_fvirt, con_g, & con_hvap, con_hfus, con_pi, con_rd, con_rv, & con_t0c, con_cvap, con_cliq, con_eps, con_epsq, & @@ -2736,6 +2736,8 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & logical :: exists real(kind=kind_phys) :: tem real(kind=kind_phys) :: rinc(5) + real(kind=kind_sngl_prec) :: rinc4(5) + real(kind=kind_dbl_prec) :: rinc8(5) real(kind=kind_phys) :: wrk(1) real(kind=kind_phys), parameter :: con_hr = 3600. @@ -3217,7 +3219,11 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & ! max and min lon and lat for critical relative humidity integer :: max_lon=5000, max_lat=2000, min_lon=192, min_lat=94 real(kind=kind_phys) :: rhcmax = 0.9999999 !< max critical rel. hum. +#ifdef SINGLE_PREC + real(kind=kind_phys) :: huge = 9.9692099683868690E30 ! NetCDF float FillValue +#else real(kind=kind_phys) :: huge = 9.9692099683868690E36 ! NetCDF float FillValue +#endif !--- stochastic physics control parameters @@ -3245,6 +3251,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & real(kind=kind_phys) :: radar_tten_limits(2) = (/ limit_unspecified, limit_unspecified /) integer :: itime + integer :: w3kindreal,w3kindint !--- END NAMELIST VARIABLES @@ -4631,7 +4638,19 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & Model%cdec = -9999. Model%clstp = -9999 rinc(1:5) = 0 - call w3difdat(jdat,idat,4,rinc) + call w3kind(w3kindreal,w3kindint) + if (w3kindreal == 8) then + rinc8(1:5) = 0 + call w3difdat(jdat,idat,4,rinc8) + rinc = rinc8 + else if (w3kindreal == 4) then + rinc4(1:5) = 0 + call w3difdat(jdat,idat,4,rinc4) + rinc = rinc4 + else + write(0,*)' FATAL ERROR: Invalid w3kindreal' + call abort + endif Model%phour = rinc(4)/con_hr Model%fhour = (rinc(4) + Model%dtp)/con_hr Model%zhour = mod(Model%phour,Model%fhzero) diff --git a/ccpp/physics b/ccpp/physics index 63020ec6a..82250de85 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 63020ec6a737511a46102865458b9843e340a404 +Subproject commit 82250de857dab51b8de4bcc40ec147f9e229a4e6 diff --git a/module_fcst_grid_comp.F90 b/module_fcst_grid_comp.F90 index 886f23a23..a713fbeed 100644 --- a/module_fcst_grid_comp.F90 +++ b/module_fcst_grid_comp.F90 @@ -38,6 +38,8 @@ module module_fcst_grid_comp atmos_model_exchange_phase_2, & addLsmask2grid, atmos_model_get_nth_domain_info + use GFS_typedefs, only: kind_phys, kind_sngl_prec + use constants_mod, only: constants_init use fms_mod, only: error_mesg, fms_init, fms_end, & write_version_number, uppercase @@ -161,6 +163,7 @@ subroutine SetServicesNest(nest, rc) integer,dimension(2,6):: decomptile !define delayout for the 6 cubed-sphere tiles integer,dimension(2) :: regdecomp !define delayout for the nest grid type(ESMF_Decomp_Flag):: decompflagPTile(2,6) + type(ESMF_TypeKind_Flag) :: grid_typekind character(3) :: myGridStr type(ESMF_DistGrid) :: distgrid type(ESMF_Array) :: array @@ -188,6 +191,12 @@ subroutine SetServicesNest(nest, rc) call ESMF_InfoGet(info, key="layout", values=layout, rc=rc); ESMF_ERR_ABORT(rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (kind_phys == kind_sngl_prec) then + grid_typekind = ESMF_TYPEKIND_R4 + else + grid_typekind = ESMF_TYPEKIND_R8 + endif + if (trim(name)=="global") then ! global domain call ESMF_InfoGet(info, key="tilesize", value=tilesize, rc=rc); ESMF_ERR_ABORT(rc) @@ -200,6 +209,7 @@ subroutine SetServicesNest(nest, rc) enddo grid = ESMF_GridCreateCubedSphere(tileSize=tilesize, & coordSys=ESMF_COORDSYS_SPH_RAD, & + coordTypeKind=grid_typekind, & regDecompPTile=decomptile, & decompflagPTile=decompflagPTile, & name="fcst_grid", rc=rc) @@ -215,6 +225,7 @@ subroutine SetServicesNest(nest, rc) maxIndex=(/nx,ny/), & gridAlign=(/-1,-1/), & coordSys=ESMF_COORDSYS_SPH_RAD, & + coordTypeKind=grid_typekind, & decompflag=(/ESMF_DECOMP_SYMMEDGEMAX,ESMF_DECOMP_SYMMEDGEMAX/), & name="fcst_grid", & indexflag=ESMF_INDEX_DELOCAL, & From f599ef9a043b00d045b05dc8f836719afb2198e5 Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Fri, 27 May 2022 17:06:27 +0000 Subject: [PATCH 11/25] point at sam's fork --- .gitmodules | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/.gitmodules b/.gitmodules index 0e5ac5a7a..a7209d8df 100644 --- a/.gitmodules +++ b/.gitmodules @@ -8,8 +8,8 @@ branch = main [submodule "ccpp/physics"] path = ccpp/physics - url = https://github.com/DusanJovic-NOAA/ccpp-physics - branch = single_prec + url = https://github.com/SamuelTrahanNOAA/ccpp-physics + branch = sing_prec_from_main [submodule "upp"] path = upp url = https://github.com/NOAA-EMC/UPP From 9caaf80453d9daa1b35c25ecaa7b6868d8c2655f Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Fri, 27 May 2022 17:06:27 +0000 Subject: [PATCH 12/25] All suites can compile 32-bit. --- .gitmodules | 4 ++-- ccpp/CMakeLists.txt | 2 ++ ccpp/physics | 2 +- 3 files changed, 5 insertions(+), 3 deletions(-) diff --git a/.gitmodules b/.gitmodules index 0e5ac5a7a..a7209d8df 100644 --- a/.gitmodules +++ b/.gitmodules @@ -8,8 +8,8 @@ branch = main [submodule "ccpp/physics"] path = ccpp/physics - url = https://github.com/DusanJovic-NOAA/ccpp-physics - branch = single_prec + url = https://github.com/SamuelTrahanNOAA/ccpp-physics + branch = sing_prec_from_main [submodule "upp"] path = upp url = https://github.com/NOAA-EMC/UPP diff --git a/ccpp/CMakeLists.txt b/ccpp/CMakeLists.txt index 63a4871d8..960de73b4 100644 --- a/ccpp/CMakeLists.txt +++ b/ccpp/CMakeLists.txt @@ -68,6 +68,7 @@ if(CCPP_32BIT) endif() message(STATUS "Compile CCPP slow physics with 32-bit precision") add_definitions(-DSINGLE_PREC) + add_definitions(-DRTE_USE_SP) if(CMAKE_Fortran_COMPILER_ID MATCHES "Intel") set(CMAKE_Fortran_FLAGS_PHYSICS "-real-size 32") elseif(CMAKE_Fortran_COMPILER_ID MATCHES "GNU") @@ -76,6 +77,7 @@ if(CCPP_32BIT) else(CCPP_32BIT) message(STATUS "Compile CCPP slow physics with 64-bit precision") remove_definitions(-DSINGLE_PREC) + remove_definitions(-DRTE_USE_SP) if(CMAKE_Fortran_COMPILER_ID MATCHES "Intel") set(CMAKE_Fortran_FLAGS_PHYSICS "-real-size 64") elseif(CMAKE_Fortran_COMPILER_ID MATCHES "GNU") diff --git a/ccpp/physics b/ccpp/physics index 82250de85..510b51c23 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 82250de857dab51b8de4bcc40ec147f9e229a4e6 +Subproject commit 510b51c233121c463551a8d767c443cb1f51ef7f From d648c81689ae1846582752374335af0c53983b78 Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Wed, 22 Jun 2022 18:37:19 +0000 Subject: [PATCH 13/25] Clean up machine.F and get rid of kind_evod & kind_rad --- ccpp/physics | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ccpp/physics b/ccpp/physics index ad5a56f96..a9c97bba6 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit ad5a56f96b13c4ea2756a028bc60f3709024b568 +Subproject commit a9c97bba61311deef45974a2b0a60f8092fea263 From ecb3d492b33f73633c263b4609614680abde3b13 Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Thu, 23 Jun 2022 14:48:11 +0000 Subject: [PATCH 14/25] in ccpp/physics merge a35dfda1, and make similar updates to FV3 (hopefully get all suites to compile) --- ccpp/CMakeLists.txt | 5 ++--- ccpp/physics | 2 +- 2 files changed, 3 insertions(+), 4 deletions(-) diff --git a/ccpp/CMakeLists.txt b/ccpp/CMakeLists.txt index 63a4871d8..ee2b9c8b2 100644 --- a/ccpp/CMakeLists.txt +++ b/ccpp/CMakeLists.txt @@ -63,11 +63,9 @@ else() endif() if(CCPP_32BIT) - if(NOT 32BIT) - message(FATAL_ERROR "When compiling CCPP slow physics 32-bit (CCPP_32BIT=ON), you must also compile fast physics 32-bit (32BIT=ON)") - endif() message(STATUS "Compile CCPP slow physics with 32-bit precision") add_definitions(-DSINGLE_PREC) + add_definitions(-DRTE_USE_SP) if(CMAKE_Fortran_COMPILER_ID MATCHES "Intel") set(CMAKE_Fortran_FLAGS_PHYSICS "-real-size 32") elseif(CMAKE_Fortran_COMPILER_ID MATCHES "GNU") @@ -76,6 +74,7 @@ if(CCPP_32BIT) else(CCPP_32BIT) message(STATUS "Compile CCPP slow physics with 64-bit precision") remove_definitions(-DSINGLE_PREC) + remove_definitions(-DRTE_USE_SP) if(CMAKE_Fortran_COMPILER_ID MATCHES "Intel") set(CMAKE_Fortran_FLAGS_PHYSICS "-real-size 64") elseif(CMAKE_Fortran_COMPILER_ID MATCHES "GNU") diff --git a/ccpp/physics b/ccpp/physics index ddd21d3b6..78caef910 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit ddd21d3b6ec5881bd7662ddfde1a53e39e6e8350 +Subproject commit 78caef910104df9c4ee44ab010d67e19f2322a2d From 4236b3a730e6d5da138c6663285b792e97761249 Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Thu, 23 Jun 2022 18:16:33 +0000 Subject: [PATCH 15/25] FV3GFS_io store_data changes are CCPP_32BIT-only --- io/FV3GFS_io.F90 | 15 +++++++++++++++ 1 file changed, 15 insertions(+) diff --git a/io/FV3GFS_io.F90 b/io/FV3GFS_io.F90 index ef7cbf008..1b6727c7d 100644 --- a/io/FV3GFS_io.F90 +++ b/io/FV3GFS_io.F90 @@ -2819,10 +2819,17 @@ subroutine fv3gfs_diag_output(time, diag, atm_block, nx, ny, levs, ntcw, ntoz, & integer :: i, j, k, idx, nblks, nb, ix, ii, jj integer :: is_in, js_in, isc, jsc character(len=2) :: xtra +#ifdef CCPP_32BIT + real, dimension(nx*ny) :: var2p + real, dimension(nx*ny,levs) :: var3p + real, dimension(nx,ny) :: var2 + real, dimension(nx,ny,levs) :: var3 +#else real(kind=kind_phys), dimension(nx*ny) :: var2p real(kind=kind_phys), dimension(nx*ny,levs) :: var3p real(kind=kind_phys), dimension(nx,ny) :: var2 real(kind=kind_phys), dimension(nx,ny,levs) :: var3 +#endif real(kind=kind_phys) :: rdt, rtime_int, rtime_intfull, lcnvfac real(kind=kind_phys) :: rtime_radsw, rtime_radlw logical :: used @@ -3062,7 +3069,11 @@ end subroutine fv3gfs_diag_output subroutine store_data(id, work, Time, idx, intpl_method, fldname) integer, intent(in) :: id integer, intent(in) :: idx +#ifdef CCPP_32BIT + real, intent(in) :: work(:,:) +#else real(kind=kind_phys), intent(in) :: work(ieco-isco+1,jeco-jsco+1) +#endif type(time_type), intent(in) :: Time character(*), intent(in) :: intpl_method character(*), intent(in) :: fldname @@ -3142,7 +3153,11 @@ end subroutine store_data subroutine store_data3D(id, work, Time, idx, intpl_method, fldname) integer, intent(in) :: id integer, intent(in) :: idx +#ifdef CCPP_32BIT + real, intent(in) :: work(:,:,:) +#else real(kind=kind_phys), intent(in) :: work(ieco-isco+1,jeco-jsco+1,levo) +#endif type(time_type), intent(in) :: Time character(*), intent(in) :: intpl_method character(*), intent(in) :: fldname From 54701360e979af69ff28d5201076dda58bba1c02 Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Thu, 23 Jun 2022 18:17:32 +0000 Subject: [PATCH 16/25] Point to working_32bit ccpp/physics branch --- .gitmodules | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.gitmodules b/.gitmodules index a7209d8df..ebd9613c7 100644 --- a/.gitmodules +++ b/.gitmodules @@ -9,7 +9,7 @@ [submodule "ccpp/physics"] path = ccpp/physics url = https://github.com/SamuelTrahanNOAA/ccpp-physics - branch = sing_prec_from_main + branch = working_32bit [submodule "upp"] path = upp url = https://github.com/NOAA-EMC/UPP From 584a333895e4dd10ccb43ded7bbcba76c4b0c6dd Mon Sep 17 00:00:00 2001 From: Samuel Trahan Date: Thu, 23 Jun 2022 19:18:58 +0000 Subject: [PATCH 17/25] use default real kind only for CCPP_32BIT in FV3GFS_io.F90 --- io/FV3GFS_io.F90 | 15 +++++++++++++++ 1 file changed, 15 insertions(+) diff --git a/io/FV3GFS_io.F90 b/io/FV3GFS_io.F90 index ef7cbf008..1b6727c7d 100644 --- a/io/FV3GFS_io.F90 +++ b/io/FV3GFS_io.F90 @@ -2819,10 +2819,17 @@ subroutine fv3gfs_diag_output(time, diag, atm_block, nx, ny, levs, ntcw, ntoz, & integer :: i, j, k, idx, nblks, nb, ix, ii, jj integer :: is_in, js_in, isc, jsc character(len=2) :: xtra +#ifdef CCPP_32BIT + real, dimension(nx*ny) :: var2p + real, dimension(nx*ny,levs) :: var3p + real, dimension(nx,ny) :: var2 + real, dimension(nx,ny,levs) :: var3 +#else real(kind=kind_phys), dimension(nx*ny) :: var2p real(kind=kind_phys), dimension(nx*ny,levs) :: var3p real(kind=kind_phys), dimension(nx,ny) :: var2 real(kind=kind_phys), dimension(nx,ny,levs) :: var3 +#endif real(kind=kind_phys) :: rdt, rtime_int, rtime_intfull, lcnvfac real(kind=kind_phys) :: rtime_radsw, rtime_radlw logical :: used @@ -3062,7 +3069,11 @@ end subroutine fv3gfs_diag_output subroutine store_data(id, work, Time, idx, intpl_method, fldname) integer, intent(in) :: id integer, intent(in) :: idx +#ifdef CCPP_32BIT + real, intent(in) :: work(:,:) +#else real(kind=kind_phys), intent(in) :: work(ieco-isco+1,jeco-jsco+1) +#endif type(time_type), intent(in) :: Time character(*), intent(in) :: intpl_method character(*), intent(in) :: fldname @@ -3142,7 +3153,11 @@ end subroutine store_data subroutine store_data3D(id, work, Time, idx, intpl_method, fldname) integer, intent(in) :: id integer, intent(in) :: idx +#ifdef CCPP_32BIT + real, intent(in) :: work(:,:,:) +#else real(kind=kind_phys), intent(in) :: work(ieco-isco+1,jeco-jsco+1,levo) +#endif type(time_type), intent(in) :: Time character(*), intent(in) :: intpl_method character(*), intent(in) :: fldname From 34a96d99239f051a1a8aecb6d8c7e1c97e7475ec Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Mon, 27 Jun 2022 17:45:53 +0000 Subject: [PATCH 18/25] update atmos_cubed_sphere hash --- atmos_cubed_sphere | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/atmos_cubed_sphere b/atmos_cubed_sphere index e21e73a37..eacc6c025 160000 --- a/atmos_cubed_sphere +++ b/atmos_cubed_sphere @@ -1 +1 @@ -Subproject commit e21e73a37a80ec239f3c343e4efe402cc409076c +Subproject commit eacc6c02587ab30ddf3ff5f56988599059394cc9 From 41c4c0f8bb6d759feb5587863a8d48347f63a547 Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Mon, 27 Jun 2022 17:55:28 +0000 Subject: [PATCH 19/25] point to authoritative repository for rte-rrtmgp --- ccpp/physics | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ccpp/physics b/ccpp/physics index 855bf8686..d7a244fcc 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 855bf8686642361bf1f2308916297e165aa3c4b0 +Subproject commit d7a244fccc62afced1d9a8cf761c44e025058f24 From fabe6b745be364686cc2b44ca0fbcf7b4a436416 Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Mon, 27 Jun 2022 19:05:37 +0000 Subject: [PATCH 20/25] revert to an earlier atmos_cubed_sphere because the community version is out-of-sync with the NOAA-EMC fv3atm --- atmos_cubed_sphere | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/atmos_cubed_sphere b/atmos_cubed_sphere index eacc6c025..e21e73a37 160000 --- a/atmos_cubed_sphere +++ b/atmos_cubed_sphere @@ -1 +1 @@ -Subproject commit eacc6c02587ab30ddf3ff5f56988599059394cc9 +Subproject commit e21e73a37a80ec239f3c343e4efe402cc409076c From 47ffc33129a46c8150cef67d23c8ee7f6dfd64cc Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Fri, 1 Jul 2022 14:33:43 +0000 Subject: [PATCH 21/25] correct a type mismatch in a call in module_sf_noahmplsm --- ccpp/physics | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ccpp/physics b/ccpp/physics index 8b2186378..70cdc31c6 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 8b21863789372e216f57a1ffd201255d91a30fb1 +Subproject commit 70cdc31c664c5749b1088d9bff835ab332ab7bd8 From e6f31b4d29b6611e1dcb166fd57390223e62c00f Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Tue, 5 Jul 2022 16:48:28 +0000 Subject: [PATCH 22/25] better names for new variables in ccpp/physics/physics/module_sf_noahmplsm.f90 --- ccpp/physics | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ccpp/physics b/ccpp/physics index 70cdc31c6..18e35c6bd 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 70cdc31c664c5749b1088d9bff835ab332ab7bd8 +Subproject commit 18e35c6bda63d292ed441c62dbc8f8831120dd16 From a0b362fcefbd0c64e88e10ca050456a392bed899 Mon Sep 17 00:00:00 2001 From: Samuel Trahan Date: Tue, 19 Jul 2022 12:41:16 +0000 Subject: [PATCH 23/25] point to NCAR main ccpp-physics --- .gitmodules | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/.gitmodules b/.gitmodules index a7209d8df..80eea8ac3 100644 --- a/.gitmodules +++ b/.gitmodules @@ -8,8 +8,8 @@ branch = main [submodule "ccpp/physics"] path = ccpp/physics - url = https://github.com/SamuelTrahanNOAA/ccpp-physics - branch = sing_prec_from_main + url = https://github.com/NCAR/ccpp-physics + branch = main [submodule "upp"] path = upp url = https://github.com/NOAA-EMC/UPP From d3c97a42d6458ebf4a596077d31fd9adad3bd5ec Mon Sep 17 00:00:00 2001 From: Samuel Trahan Date: Tue, 19 Jul 2022 12:42:14 +0000 Subject: [PATCH 24/25] point to NCAR main ccpp-physics --- ccpp/physics | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ccpp/physics b/ccpp/physics index 948471fe2..12c115e99 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 948471fe2b2e4e63a5dbaae818a520401ecba43c +Subproject commit 12c115e992d3a265eaaa67d72fcbdb3a6f21195f From 3ec781ab6a920bd9189024c3e5cf18a632117bd3 Mon Sep 17 00:00:00 2001 From: Samuel Trahan Date: Tue, 19 Jul 2022 15:08:37 +0000 Subject: [PATCH 25/25] point to dev/emc atmos_cubed_sphere --- .gitmodules | 2 +- atmos_cubed_sphere | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/.gitmodules b/.gitmodules index 80eea8ac3..6bb663df1 100644 --- a/.gitmodules +++ b/.gitmodules @@ -1,6 +1,6 @@ [submodule "atmos_cubed_sphere"] path = atmos_cubed_sphere - url = https://github.com/SamuelTrahanNOAA/GFDL_atmos_cubed_sphere + url = https://github.com/NOAA-GFDL/GFDL_atmos_cubed_sphere branch = dev/emc [submodule "ccpp/framework"] path = ccpp/framework diff --git a/atmos_cubed_sphere b/atmos_cubed_sphere index 12f99c1ca..153cd903f 160000 --- a/atmos_cubed_sphere +++ b/atmos_cubed_sphere @@ -1 +1 @@ -Subproject commit 12f99c1ca5210e03c8a83078a6f121531615d09d +Subproject commit 153cd903f8f95a7bc41fb242fe96fd7cdd4c2b64