Skip to content

v12: Fixes for Flang 22 #1220

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
mathomp4 wants to merge 4 commits into
base: feature/v12-remove-mom5
Choose a base branch
from
Open

v12: Fixes for Flang 22 #1220

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
4 commits
Select commit Hold shift + click to select a range
f89a177
v12: Fixes for Flang 22
mathomp4 Mar 11, 2026
6dd4773
Use int not nint
mathomp4 Mar 11, 2026
88c37a6
Merge branch 'feature/v12-remove-mom5' into feature/fixes-for-flang
mathomp4 Mar 12, 2026
c03070a
Merge branch 'feature/v12-remove-mom5' into feature/fixes-for-flang
mathomp4 Mar 17, 2026
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
48 changes: 24 additions & 24 deletions GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSgwd_GridComp/ncar_gwd/gw_convect.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -8,7 +8,7 @@ module gw_convect
use gw_utils, only: GW_PRC, GW_R8, get_unit_vector, dot_2d, midpoint_interp
use gw_common, only: GWBand, qbo_hdepth_scaling, gw_drag_prof, hr_cf, &
calc_taucd, momentum_flux, momentum_fixer, &
energy_momentum_adjust, energy_change, energy_fixer
energy_momentum_adjust, energy_change, energy_fixer

use MAPL_ConstantsMod, only: MAPL_RGAS, MAPL_CP, MAPL_GRAV

Expand Down Expand Up @@ -83,7 +83,7 @@ subroutine gw_beres_init (file_name, band, desc, pgwv, gw_dc, fcrit2, wavelength

! Vars needed by NetCDF operators
integer :: ncid, dimid, varid, status

status = nf_open(file_name , 0, ncid)

status = NF_INQ_DIMID(ncid, 'PS', dimid)
Expand All @@ -100,7 +100,7 @@ subroutine gw_beres_init (file_name, band, desc, pgwv, gw_dc, fcrit2, wavelength

allocate( mfcc(hd_mfcc , mw_mfcc, ps_mfcc) )
allocate( hdcc(hd_mfcc) )

status = NF_INQ_VARID(ncid, 'HD', varid)
IF (status .NE. NF_NOERR) CALL HANDLE_ERR(status)
status = NF_GET_VAR_DOUBLE(ncid, varid, hdcc )
Expand Down Expand Up @@ -131,7 +131,7 @@ subroutine gw_beres_init (file_name, band, desc, pgwv, gw_dc, fcrit2, wavelength

! midpoint of spectrum in netcdf file is ps_mfcc (odd number) divided by 2, plus 1
! E.g., ps_mfcc = 81. So, ps_mfcc_mid = 41
! 1 11 21 31 32 33 34 35 36 37 38 39 40 41 42 43 ...
! 1 11 21 31 32 33 34 35 36 37 38 39 40 41 42 43 ...
! -40 -30 -20 -10 -9 -8 -7 -6 -5 -4 -3 -2 -1 0 +1 +2 ...
ps_mfcc_mid= INT(ngwv_file/2) + 1

Expand All @@ -142,9 +142,9 @@ subroutine gw_beres_init (file_name, band, desc, pgwv, gw_dc, fcrit2, wavelength

allocate(desc%mfcc(desc%maxh,-desc%maxuh:desc%maxuh,-band%ngwv:band%ngwv), stat=status )

desc%mfcc( : , -desc%maxuh:desc%maxuh , -band%ngwv :band%ngwv ) &
desc%mfcc( : , -desc%maxuh:desc%maxuh , -band%ngwv :band%ngwv ) &
= mfcc( :, : , -band%ngwv+ps_mfcc_mid:band%ngwv+ps_mfcc_mid )

! While not currently documented in the file, it uses kilometers. Convert
! to meters.
desc%hd = hdcc * 1000.0
Expand Down Expand Up @@ -176,7 +176,7 @@ subroutine gw_beres_init (file_name, band, desc, pgwv, gw_dc, fcrit2, wavelength
cw(kc) = 10.0*(4.0/real(band%ngwv))*kc
cw(kc) = exp(-(cw(kc)/30.)**2)
enddo
cw = cw*(sum(cw4)/sum(cw))
cw = cw*(sum(cw4)/sum(cw))
desc%et_bkg_dqcdt_forcing = et_use_dqcdt
do i=1,ncol
! include forced background stress in extra tropics
Expand All @@ -199,7 +199,7 @@ subroutine gw_beres_init (file_name, band, desc, pgwv, gw_dc, fcrit2, wavelength
enddo
deallocate( cw, cw4 )
end if

end subroutine gw_beres_init

!------------------------------------
Expand Down Expand Up @@ -377,15 +377,15 @@ subroutine gw_beres_src(ncol, pver, band, desc, pint, u, v, &

! Source wind speed and direction.
do i=1,ncol
uconv(i) = u(i,desc%k(i))
vconv(i) = v(i,desc%k(i))
uconv(i) = u(i,int(desc%k(i)))
vconv(i) = v(i,int(desc%k(i)))
enddo

! Get the unit vector components and magnitude at the source level.
ubi1d = 0.0
call get_unit_vector(uconv, vconv, xv, yv, ubi1d)
do i=1,ncol
ubi(i,desc%k(i)+1) = ubi1d(i)
ubi(i,int(desc%k(i))+1) = ubi1d(i)
enddo

! Project the local wind at midpoints onto the source wind.
Expand All @@ -408,12 +408,12 @@ subroutine gw_beres_src(ncol, pver, band, desc, pint, u, v, &
uh(i) = uh(i)/(boti(i)-topi(i)+1)
! Find the cell speed where the storm speed is > 10 m/s.
! Storm speed is taken to be the source wind speed.
CS(i) = sign(max(abs(ubm(i,desc%k(i)))-10.0, 0.0), ubm(i,desc%k(i)))
CS(i) = sign(max(abs(ubm(i,int(desc%k(i))))-10.0, 0.0), ubm(i,int(desc%k(i))))
uh(i) = uh(i) - CS(i)
else
! For shallow convection, wind is relative to ground, and "heating
! region" wind is just the source level wind.
uh(i) = ubm(i,desc%k(i))
uh(i) = ubm(i,int(desc%k(i)))
endif
enddo

Expand Down Expand Up @@ -466,7 +466,7 @@ subroutine gw_beres_src(ncol, pver, band, desc, pint, u, v, &

! Adjust for critical level filtering.
tau0(Umini(i):Umaxi(i)) = 0.0

tau(i,:,topi(i)+1) = tau0

else
Expand All @@ -476,9 +476,9 @@ subroutine gw_beres_src(ncol, pver, band, desc, pint, u, v, &
! use latitudinal dependence
! include forced background stress in extra tropical large-scale systems
! Set the phase speeds and wave numbers in the direction of the source wind.
! Set the source stress magnitude (positive only, note that the sign of the
! Set the source stress magnitude (positive only, note that the sign of the
! stress is the same as (c-u).
tau(i,:,desc%k(i)+1) = desc%taubck(i,:)
tau(i,:,int(desc%k(i))+1) = desc%taubck(i,:)
topi(i) = desc%k(i)
else
! Find largest condensate change level, for frontal detection
Expand All @@ -491,9 +491,9 @@ subroutine gw_beres_src(ncol, pver, band, desc, pint, u, v, &
end do
! include forced background stress in extra tropical large-scale systems
! Set the phase speeds and wave numbers in the direction of the source wind.
! Set the source stress magnitude (positive only, note that the sign of the
! Set the source stress magnitude (positive only, note that the sign of the
! stress is the same as (c-u).
tau(i,:,desc%k(i)+1) = desc%taubck(i,:) * MIN(10.0,MAX(1.0,abs(q0(i)/1.e-9)))
tau(i,:,int(desc%k(i))+1) = desc%taubck(i,:) * MIN(10.0,MAX(1.0,abs(q0(i)/1.e-9)))
topi(i) = desc%k(i)
endif

Expand Down Expand Up @@ -618,7 +618,7 @@ subroutine gw_beres_ifc( band, &
ubm, ubi, xv, yv, c, hdepth, maxq0, lats, dqcdt=dqcdt)

! Solve for the drag profile with convective sources.
call gw_drag_prof(ncol, pver, band, pint, delp, rdelp, &
call gw_drag_prof(ncol, pver, band, pint, delp, rdelp, &
src_level, tend_level, dt, t, &
piln, rhoi, nm, ni, ubm, ubi, xv, yv, &
c, kvtt, tau, utgw, vtgw, ttgw, gwut, alpha)
Expand All @@ -642,18 +642,18 @@ end subroutine gw_beres_ifc
!--------------------------------------------------------------------------

subroutine handle_err(status)

implicit none

#include <netcdf.inc>

integer status

if (status .ne. nf_noerr) then
print *, nf_strerror(status)
stop 'Stopped'
endif

end subroutine handle_err


Expand Down
2 changes: 1 addition & 1 deletion GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/CMakeLists.txt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -65,7 +65,7 @@ endif ()

esma_add_library (${this}
SRCS ${srcs}
DEPENDENCIES GEOS_Shared GMAO_mpeu MAPL Chem_Shared Chem_Base ESMF::ESMF FMS::fms)
DEPENDENCIES GEOS_Shared GMAO_mpeu MAPL Chem_Shared Chem_Base ESMF::ESMF)

file (GLOB_RECURSE rc_files CONFIGURE_DEPENDS RELATIVE ${CMAKE_CURRENT_SOURCE_DIR} *.rc *.yaml)
foreach ( file ${rc_files} )
Expand Down
33 changes: 17 additions & 16 deletions ...idComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mkMITAquaRaster.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -5,7 +5,7 @@ program MAIN

use LogRectRasterizeMod, ONLY: LRRasterize
use MAPL_ExceptionHandling
use, intrinsic :: iso_fortran_env, only: REAL64
use, intrinsic :: iso_fortran_env, only: REAL64, INT64
implicit none

integer, parameter :: IUNIT = 11, OUNIT = 12
Expand All @@ -14,9 +14,9 @@ program MAIN
INTEGER :: NC
INTEGER :: NX, NY

integer :: STATARRAY(12)
integer(REAL64) :: filesize
integer(REAL64) :: Length
integer :: ios
integer(INT64) :: filesize
integer(INT64) :: Length
integer :: K
integer :: i, j
integer :: KF, L, NF
Expand Down Expand Up @@ -84,7 +84,7 @@ program MAIN
! 161,162,179,180,197,198,215,216,233,234]
!#15x15 nprocs = 360
!# blankList(1:108)
! [1,2,3,4,5,6,7,8,9,10,11,12,14,15,16,17,18,21,22,23,24,&
! [1,2,3,4,5,6,7,8,9,10,11,12,14,15,16,17,18,21,22,23,24,&
! 65,71,75,76,90,95,96,101,102,109,110,111,112,113,114,115,116,117,118,119,&
! 120,121,122,123,124,125,126,127,128,129,130,131,132,&
! 188,189,190,193,194,195,196,199,&
Expand Down Expand Up @@ -112,7 +112,7 @@ program MAIN
print *, trim(Usage)
call exit(1)
end if

nxt = 1
call get_command_argument(nxt,arg)
do while(arg(1:1)=='-')
Expand Down Expand Up @@ -152,10 +152,11 @@ program MAIN
BLNKSZ = count(blanklist /= 0)

! Open Facet 3 first. It is always a square (CS or LLC)
open (IUNIT,file=trim(GridDir)//'/tile003.mitgrid', status='old')
call fstat(IUNIT,statarray)
close (IUNIT)
filesize = statarray(8)
inquire(file=trim(GridDir)//'/tile003.mitgrid', size=filesize, iostat=ios)
if (ios /= 0) then
print *, 'Error opening file: ', trim(GridDir)//'/tile003.mitgrid'
call exit(1)
end if

!ALT: Kludge for LLC4320
if (filesize <= 0) filesize = 2389893248
Expand All @@ -181,11 +182,11 @@ program MAIN
LENGTH = nx*ny*REAL64

! Open Facet 1 to check sizes CS or LLC)
open (IUNIT,file=trim(GridDir)//'/tile001.mitgrid', status='old')
call fstat(IUNIT,statarray)
close (IUNIT)

filesize = statarray(8)
inquire(file=trim(GridDir)//'/tile001.mitgrid', size=filesize, iostat=ios)
if (ios /= 0) then
print *, 'Error opening file: ', trim(GridDir)//'/tile001.mitgrid'
call exit(1)
end if

!ALT: Kludge for LLC4320
if (filesize <= 0) filesize = 7168573568
Expand Down Expand Up @@ -303,7 +304,7 @@ program MAIN
open (IUNIT, FILE=trim(GridDir)//trim(FACEFILE), &
ACCESS='DIRECT', RECL=LENGTH, STATUS='OLD',convert='big_endian')

! read (IUNIT,REC=5) rA
! read (IUNIT,REC=5) rA
read (IUNIT,REC=6) XG
read (IUNIT,REC=7) YG

Expand Down
Loading
Loading