Merge pull request #1490 from cacraigucar/cam_ifx

Fixes to CAM for the ifx compiler

Author: jimmielin

doc/ChangeLog

@@ -1,3 +1,56 @@
+===============================================================
+
+Tag name: cam6_4_155
+Originator(s): cacraig, jimmielin
+Date: Feb 24, 2026
+One-line Summary: Fixes to CAM for the ifx compiler
+Github PR URL: https://github.com/ESCOMP/CAM/pull/1490
+
+Purpose of changes (include the issue number and title text for each relevant GitHub issue):
+- Closes #1484 Changing to the ifx compiler - prealpha tests are failing
+
+Describe any changes made to build system: N/A
+
+Describe any changes made to the namelist: N/A
+
+List any changes to the defaults for the boundary datasets: N/A
+
+Describe any substantial timing or memory changes: N/A
+
+Code reviewed by: cacraig, jimmielin, fvitt (reviewed edyn_mpi.F90 changes via email)
+
+List all files eliminated: N/A
+
+List all files added and what they do: N/A
+
+List all existing files that have been modified, and describe the changes:
+M       src/dynamics/se/dyn_comp.F90
+M       src/physics/rrtmgp/rrtmgp_inputs_cam.F90
+  - short-circuiting is not permitted in Fortran standard leading to comparisons against NaN
+  - resolves #1484 (FHISTC_LTso, rrtmgp regression test failures)
+
+M       src/ionosphere/waccmx/edyn_mpi.F90
+  - ifx enforces maximum MPI tag size
+  - resolves #1484 (WACCM-X regression test failure)
+
+If there were any failures reported from running test_driver.sh on any test
+platform, and checkin with these failures has been OK'd by the gatekeeper,
+then copy the lines from the td.*.status files for the failed tests to the
+appropriate machine below.  All failed tests must be justified.
+
+derecho/intel/aux_cam:
+  ERI_D_Ln18.ne16pg3_ne16pg3_mt232.FHIST_C4.derecho_intel.cam-outfrq3s_eri (Overall: FAIL) details:
+     - pre-existing failure
+          ERI bug in CICE -- See: https://github.com/ESCOMP/CESM_CICE/issues/34
+
+derecho/nvhpc/aux_cam: All PASS
+
+izumi/nag/aux_cam: All PASS
+
+izumi/gnu/aux_cam: All PASS
+
+===============================================================
+
 Tag name: cam6_4_154
 Originator(s): pel, cacraig
 Date: Feb 24, 2026

src/dynamics/se/dyn_comp.F90

@@ -2217,7 +2217,18 @@ subroutine read_dyn_field_2d(fieldname, fh, dimname, buffer)
    ! to NaN.  In that case infld can return NaNs where the element GLL points
    ! are not "unique columns"
    ! Set NaNs or fillvalue points to zero
-   where (isnan(buffer) .or. (buffer==fillvalue)) buffer = 0.0_r8
+   where (isnan(buffer))
+      ! check for NaN first, as comparing NaN to fillvalue raises floating invalid.
+      buffer = 0.0_r8
+   end where
+
+   if (.not. isnan(fillvalue)) then
+      ! only compare against fillvalue if fillvalue is not NaN, otherwise the comparison
+      ! will raise floating invalid.
+      where (buffer == fillvalue)
+         buffer = 0.0_r8
+      end where
+   end if
 
 end subroutine read_dyn_field_2d
 
@@ -2247,7 +2258,18 @@ subroutine read_dyn_field_3d(fieldname, fh, dimname, buffer)
    ! to NaN.  In that case infld can return NaNs where the element GLL points
    ! are not "unique columns"
    ! Set NaNs or fillvalue points to zero
-   where (isnan(buffer) .or. (buffer == fillvalue)) buffer = 0.0_r8
+   where (isnan(buffer))
+      ! check for NaN first, as comparing NaN to fillvalue raises floating invalid.
+      buffer = 0.0_r8
+   end where
+
+   if (.not. isnan(fillvalue)) then
+      ! only compare against fillvalue if fillvalue is not NaN, otherwise the comparison
+      ! will raise floating invalid.
+      where (buffer == fillvalue)
+         buffer = 0.0_r8
+      end where
+   end if
 
 end subroutine read_dyn_field_3d
 

src/ionosphere/waccmx/edyn_mpi.F90

@@ -1684,7 +1684,7 @@ subroutine mp_mag_jslot(fin,mlon00,mlon11,mlat00,mlat11, &
       integer :: ier,njneed,i,j,n,nj,idest, &
            icount,len,nlons,isrc,msgid,ifld,sndbuf_cntr
       integer :: tij ! rank in cols_comm (0 to nmagtaskj-1)
-      integer :: jhave(mxneed),njhave,wid
+      integer :: jhave(mxneed),njhave
       integer :: peersneed(mxneed,0:nmagtaskj-1)
       integer :: jneedall (mxneed,0:nmagtaskj-1)
       real(r8) :: sndbuf(mxmaglon+2,mxneed,nf,sndbuf_cntr_max)
@@ -1730,7 +1730,6 @@ subroutine mp_mag_jslot(fin,mlon00,mlon11,mlat00,mlat11, &
                njhave = njhave+1
                jhave(njhave) = peersneed(j,n)
                idest = n
-               wid = itask_table_geo(mytidi,idest)
             endif
          enddo
          if (njhave > 0) then
@@ -1749,7 +1748,9 @@ subroutine mp_mag_jslot(fin,mlon00,mlon11,mlat00,mlat11, &
                enddo
             enddo
             len = nlons*njhave*nf
-            msgid = mytid+wid*10000
+            ! sending tag uniquely identifies sender - tij is comm. rank
+            ! within this communicator only.
+            msgid = tij
             call mpi_ibsend(sndbuf(1:nlons,1:njhave,:,sndbuf_cntr),len,MPI_REAL8, &
                  idest,msgid,cols_comm,ibsend_requests(sndbuf_cntr),ier)
             if (ier /= 0) &
@@ -1783,7 +1784,8 @@ subroutine mp_mag_jslot(fin,mlon00,mlon11,mlat00,mlat11, &
                isrc = tasks(n)%magtidj ! task id in cols_comm to recv from
                nlons = mlon11-mlon00+1
                len = nlons*njhave*nf
-               msgid = mytid*10000+n
+               ! receive tag is sender rank (tij from sender == magtidj)
+               msgid = isrc
                rcvbuf = 0._r8
                call mpi_recv(rcvbuf(1:nlons,1:njhave,:),len,MPI_REAL8, &
                     isrc,msgid,cols_comm,irstat,ier)

src/physics/rrtmgp/rrtmgp_inputs_cam.F90

@@ -198,11 +198,19 @@ subroutine rrtmgp_set_aer_sw( &
          ! set aerosol optical depth, clip to zero
          aer_sw%optical_props%tau(i,ktoprad:,:) = max(aer_tau(idxday(i),ktopcam:,:), 0._r8)
          ! set value of single scattering albedo
-         aer_sw%optical_props%ssa(i,ktoprad:,:) = merge(aer_tau_w(idxday(i),ktopcam:,:)/aer_tau(idxday(i),ktopcam:,:), &
-                                          1._r8, aer_tau(idxday(i),ktopcam:,:) > 0._r8)
+         where (aer_tau(idxday(i),ktopcam:,:) > 0._r8)
+            aer_sw%optical_props%ssa(i,ktoprad:,:) = aer_tau_w(idxday(i),ktopcam:,:) &
+                                                   / aer_tau(idxday(i),ktopcam:,:)
+         elsewhere
+            aer_sw%optical_props%ssa(i,ktoprad:,:) = 1._r8
+         end where
          ! set value of asymmetry
-         aer_sw%optical_props%g(i,ktoprad:,:) = merge(aer_tau_w_g(idxday(i),ktopcam:,:)/aer_tau_w(idxday(i),ktopcam:,:), &
-                                        0._r8, aer_tau_w(idxday(i),ktopcam:,:) > tiny)
+         where (aer_tau_w(idxday(i),ktopcam:,:) > tiny)
+            aer_sw%optical_props%g(i,ktoprad:,:) = aer_tau_w_g(idxday(i),ktopcam:,:) &
+                                                 / aer_tau_w(idxday(i),ktopcam:,:)
+         elsewhere
+            aer_sw%optical_props%g(i,ktoprad:,:) = 0._r8
+         end where
       end do
 
       ! impose limits on the components