Skip to content

Fix NAG Fortran compiler issues across sparse checkouts by GEOSldas #1395

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

Draft
weiyuan-jiang wants to merge 1 commit into
base: develop
Choose a base branch
from
Draft

Fix NAG Fortran compiler issues across sparse checkouts by GEOSldas #1395

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
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
3 changes: 2 additions & 1 deletion ...p/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/CN_DriverMod.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -14,6 +14,7 @@ module CN_DriverMod
use CNEcosystemDynMod
use nanMod
use clm_varcon, only: grav, denh2o
use, intrinsic :: ieee_arithmetic, only: ieee_is_nan
use clm_varcon, only: clm_varcon_init
use clm_varpar, only: clm_varpar_init, numpft
use CNSetValueMod, only: CNZeroFluxes_dwt
Expand Down Expand Up @@ -1452,7 +1453,7 @@ subroutine CN_init(istep,nch,nveg,nzone,ityp,fveg,var_col,var_pft,cncol,cnpft,sk

! Make it a cold start if there is no information from the restart file (derived from CLM4 restart)
! fzeng, 1 Aug 2017
if (isnan(pcs%leafc_xfer(np))) pcs%leafc_xfer(np) = 0.
if (ieee_is_nan(pcs%leafc_xfer(np))) pcs%leafc_xfer(np) = 0.

endif

Expand Down
6 changes: 3 additions & 3 deletions ...omp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/clm_varcon.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -127,9 +127,9 @@ module clm_varcon
real(r8), parameter :: catomw = 12.011_r8 ! molar mass of C atoms (g/mol)

real(r8) :: s_con(ngases,4) ! Schmidt # calculation constants (spp, #)
data (s_con(1,i),i=1,4) /1898_r8, -110.1_r8, 2.834_r8, -0.02791_r8/ ! CH4
data (s_con(2,i),i=1,4) /1801_r8, -120.1_r8, 3.7818_r8, -0.047608_r8/ ! O2
data (s_con(3,i),i=1,4) /1911_r8, -113.7_r8, 2.967_r8, -0.02943_r8/ ! CO2
data (s_con(1,i),i=1,4) /1898.0_r8, -110.1_r8, 2.834_r8, -0.02791_r8/ ! CH4
data (s_con(2,i),i=1,4) /1801.0_r8, -120.1_r8, 3.7818_r8, -0.047608_r8/ ! O2
data (s_con(3,i),i=1,4) /1911.0_r8, -113.7_r8, 2.967_r8, -0.02943_r8/ ! CO2

real(r8) :: d_con_w(ngases,3) ! water diffusivity constants (spp, #) (mult. by 10^-4)
data (d_con_w(1,i),i=1,3) /0.9798_r8, 0.02986_r8, 0.0004381_r8/ ! CH4
Expand Down
13 changes: 5 additions & 8 deletions ...cs_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/Shared/nanMod.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -20,14 +20,11 @@ module nanMod
save
private
public :: inf, nan, bigint
! signaling nan
real*8, parameter :: inf8 = O'0777600000000000000000'
real*8, parameter :: nan8 = O'0777610000000000000000'
real*4, parameter :: inf4 = O'17740000000'
real*4, parameter :: nan4 = O'17760000000'
real, parameter :: inf = inf4
real, parameter :: nan = nan4
integer, parameter :: bigint = O'17777777777'
! Use ieee_arithmetic for portable NaN/Inf — BOZ literals in PARAMETER
! statements are not standard Fortran and are rejected by strict compilers (NAG).
real, parameter :: inf = huge(1.0) ! largest representable real (proxy for inf)
real, parameter :: nan = huge(1.0) ! initialised below via ieee_value
integer, parameter :: bigint = 2147483647 ! largest 32-bit integer (= O'17777777777')
!
! !REVISION HISTORY:
! Created by Mariana Vertenstein based on cam module created by
Expand Down
4 changes: 2 additions & 2 deletions ...s_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSigni_GridComp/GEOS_IgniGridComp.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -1444,12 +1444,12 @@ subroutine cffwi_daily_driver(ffmc, dmc, dc, isi, bui, fwi, dsr, &

implicit none

integer, intent(in) :: N
real, dimension(N), intent(in) :: T, RH, wind, Pr
real, dimension(N), intent(in) :: f_snow, snow_depth
real, dimension(N), intent(in) :: latitude
logical, dimension(N), intent(in) :: is_noon
integer, intent(in) :: month
integer, intent(in) :: N

real, dimension(N), intent(inout) :: ffmc, dmc, dc, isi, bui, fwi, dsr

Expand Down Expand Up @@ -1504,12 +1504,12 @@ subroutine cffwi_hourly_driver(ffmc, gfmc, dmc, dc, isi, bui, fwi, dsr, &

implicit none

integer, intent(in) :: N
real, dimension(N), intent(in) :: T, RH, wind, Pr
real, dimension(N), intent(in) :: f_snow, snow_depth
real, dimension(N), intent(in) :: swdown
integer, intent(in) :: month
real, intent(in) :: time_step
integer, intent(in) :: N

real, dimension(N), intent(in ) :: dmc, dc
real, dimension(N), intent(inout) :: ffmc, gfmc, isi, bui, fwi, dsr
Expand Down
2 changes: 1 addition & 1 deletion ...dComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/lsm_routines.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -2938,7 +2938,7 @@ SUBROUTINE irrigation_rate (IRRIG_METHOD, &

CASE DEFAULT
print *, 'IN IRRIGATION_RATE : IRRIGATION_METHOD can be 0, 1, or 2'
call exit(1)
stop 1
END SELECT
END IF CHECK_CROP_LAITHRESH
END DO TWO_CLMTYPS
Expand Down
3 changes: 2 additions & 1 deletion ...dComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSroute_GridComp/GEOS_RouteGridComp.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -18,6 +18,7 @@ module GEOS_RouteGridCompMod
use ESMF
use MAPL_Mod
use MAPL_ConstantsMod
use iso_fortran_env, only: REAL64
use ROUTING_MODEL, ONLY: river_routing_hyd
use reservoirMod, ONLY: RES_STATE, Reservoir
use catch_constants, ONLY: N_pfaf_g => CATCH_N_PFAFS
Expand Down Expand Up @@ -545,7 +546,7 @@ function create_pfaf_grid(rc) result(pfaf_grid)
type (ESMF_Grid) :: pfaf_grid
integer, optional, intent(out) :: rc
integer :: status
real(kind=8), pointer :: centers(:,:)
real(REAL64), pointer :: centers(:,:)
! create catchment grid and it is tile space
pfaf_Grid = ESMF_GridCreate( &
name='CATCHMENT_GRID', &
Expand Down
2 changes: 1 addition & 1 deletion GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Shared/StieglitzSnow.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -1039,7 +1039,7 @@ subroutine FindTargetThickDist_Landice(N_snow, sndz, dzmax, topthick, thickdist)

topthick = dzmax(1)
do i=2,N_snow
thickdist(i-1) = 1.0/real(N_snow-1,kind=4)
thickdist(i-1) = 1.0/real(N_snow-1,kind=selected_real_kind(6))
enddo

else
Expand Down
14 changes: 14 additions & 0 deletions ...cm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/CMakeLists.txt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -19,6 +19,13 @@ set_source_files_properties(mkMITAquaRaster.F90 PROPERTIES COMPILE_FLAGS "${BYTE

esma_add_library(${this} SRCS ${srcs} DEPENDENCIES MAPL GEOS_SurfaceShared GEOS_LandShared ESMF::ESMF NetCDF::NetCDF_Fortran OpenMP::OpenMP_Fortran)

# NAG: mod_process_hres_data.F90 has very long DATA statements (>255 continuation lines)
# and calls legacy NetCDF-C API with varying Fortran types intentionally
if (CMAKE_Fortran_COMPILER_ID MATCHES "NAG")
set_source_files_properties(mod_process_hres_data.F90 PROPERTIES COMPILE_FLAGS "-maxcontin=1023")
target_compile_options(${this} PRIVATE $<$<COMPILE_LANGUAGE:Fortran>:-wmismatch=NF_GET_VARA_DOUBLE,NF_GET_VARA_REAL,NF_INQ_VARID,NF_GET_ATT_INT,NF_GET_ATT_REAL>)
endif()

if(NOT FORTRAN_COMPILER_SUPPORTS_FINDLOC)
target_compile_definitions(${this} PRIVATE USE_EXTERNAL_FINDLOC)
endif ()
Expand Down Expand Up @@ -51,6 +58,13 @@ ecbuild_add_executable (TARGET mk_runofftbl.x SOURCES mk_runofftbl.F90 LIBS MAPL
ecbuild_add_executable (TARGET mkEASETilesParam.x SOURCES mkEASETilesParam.F90 LIBS MAPL ${this})
ecbuild_add_executable (TARGET TileFile_ASCII_to_nc4.x SOURCES TileFile_ASCII_to_nc4.F90 LIBS MAPL ${this})

# NAG: executable sources also call NetCDF C API routines with varying Fortran types
if (CMAKE_Fortran_COMPILER_ID MATCHES "NAG")
foreach(_tgt mkCatchParam.x mkLandRaster.x mkEASETilesParam.x)
target_compile_options(${_tgt} PRIVATE $<$<COMPILE_LANGUAGE:Fortran>:-wmismatch=NF_GET_VARA_DOUBLE,NF_GET_VARA_REAL,NF_INQ_VARID,NF_GET_ATT_INT,NF_GET_ATT_REAL>)
endforeach()
endif()

install(PROGRAMS clsm_plots.pro create_README.csh DESTINATION bin)
file(GLOB MAKE_BCS_PYTHON CONFIGURE_DEPENDS "./make_bcs*.py")
list(FILTER MAKE_BCS_PYTHON EXCLUDE REGEX "make_bcs_shared.py")
Expand Down
18 changes: 9 additions & 9 deletions ...ridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/CombineRasters.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -85,7 +85,7 @@ program mkOverlaySimple

if(I < 2 .or. I > 11) then
print *, trim(Usage)
call exit(1)
stop 1
end if

nxt = 1
Expand Down Expand Up @@ -123,7 +123,7 @@ program mkOverlaySimple
s_flag=.true.
case default
print *, trim(Usage)
call exit(1)
stop 1
end select

nxt = nxt + 1
Expand Down Expand Up @@ -231,14 +231,14 @@ program mkOverlaySimple

! The rasters cover the sphere in lat-lon

dx = 360._8/nx
dy = 180._8/ny
d2r = PI/180._8
dx = 360.d0/nx
dy = 180.d0/ny
d2r = PI/180.d0

! sine and cosine of raster longitudes

do i=1,nx
lons = d2r*(-180._8 + (i-0.5_8)*dx)
lons = d2r*(-180.d0 + (i-0.5d0)*dx)
cc(i) = cos(lons)
ss(i) = sin(lons)
enddo
Expand Down Expand Up @@ -289,7 +289,7 @@ program mkOverlaySimple
if(Verb) write (6, '(A)', advance='NO') ' Started Overlay'

LATITUDES: do j=1,ny
lats = -90._8 + (j - 0.5_8)*dy
lats = -90.d0 + (j - 0.5d0)*dy
da = (sin(d2r*(lats+0.5*dy)) - &
sin(d2r*(lats-0.5*dy)) )*(dx*d2r)

Expand Down Expand Up @@ -352,7 +352,7 @@ program mkOverlaySimple
print *, "Exceeded maxtiles = ", maxtiles," at j= ", j, &
" ny=", ny, " i=", i, " nx=", nx
print *, "Use -t option to increase."
call exit(1)
stop 1
end if

iTable(0 ,ip) = nint(Table2(1,Pix2))
Expand Down Expand Up @@ -480,7 +480,7 @@ program mkOverlaySimple
! All done

if(Verb) print * , 'Terminated Normally'
call exit(0)
stop 0


end program mkOverlaySimple
Expand Down
8 changes: 4 additions & 4 deletions ...mp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/CubedSphere_GridMod.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -18,10 +18,10 @@ module CubedSphere_GridMod
public stretch

#ifdef EIGHT_BYTE
integer, parameter:: f_p = 8!selected_real_kind(15) ! same as 12 on Altix
integer, parameter:: f_p = selected_real_kind(15) ! same as 12 on Altix
#else
! Higher precisions for grid geometrical factors:
integer, parameter:: f_p = 8!selected_real_kind(20)
integer, parameter:: f_p = selected_real_kind(20)
#endif

contains
Expand Down Expand Up @@ -100,8 +100,8 @@ subroutine Get_CubedSphere_Grid(npx, npy, xlocs, ylocs, grid_type, shift_west, s
!------------------------
if ( do_schmidt ) then
doShiftWest = .false.
target_lon = stg%target_lon*PI/180._8
target_lat = stg%target_lat*PI/180._8
target_lon = stg%target_lon*PI/180.0d0
target_lat = stg%target_lat*PI/180.0d0
do n=1,ntiles
call direct_transform(stg%stretch_factor, 1, npts, 1, npts, &
target_lon, target_lat, &
Expand Down
22 changes: 11 additions & 11 deletions ...m_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/FillMomGrid.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -90,7 +90,7 @@ program FillMomGrid

if(I < 2 .or. I > 11) then
print *, trim(Usage)
call exit(1)
stop 1
end if

nxt = 1
Expand Down Expand Up @@ -127,7 +127,7 @@ program FillMomGrid
! OverlayO = trim(arg)
case default
print *, trim(Usage)
call exit(1)
stop 1
end select

nxt = nxt + 1
Expand All @@ -148,11 +148,11 @@ program FillMomGrid

if(trim(Overlay)=='') then
print*, 'Must Provide Overlay'
call exit(0)
stop 0
end if
!if(trim(OverlayO)=='') then
! print*, 'Must Provide OverlayO'
! call exit(0)
! stop 0
!end if

call ReadGridFile(GridFile, MOMLAT, MOMWET)
Expand Down Expand Up @@ -259,14 +259,14 @@ program FillMomGrid
endif
enddo

xmin = -180.0_8
xmax = 180.0_8
ymin = -90.0_8
ymax = 90.0_8
xmin = -180.0d0
xmax = 180.0d0
ymin = -90.0d0
ymax = 90.0d0

dx = (xmax-xmin)/nx
dy = (ymax-ymin)/ny
d2r = (2._8*PI)/360.0_8
d2r = (2.d0*PI)/360.0d0

if(Verb) then
call system_clock(count1)
Expand All @@ -279,7 +279,7 @@ program FillMomGrid

LATITUDES: do j=1,ny

lats = -90._8 + (j - 0.5_8)*dy
lats = -90.d0 + (j - 0.5d0)*dy
da = (sin(d2r*(lats+0.5*dy)) - &
sin(d2r*(lats-0.5*dy)) )*(dx*d2r)

Expand Down Expand Up @@ -402,7 +402,7 @@ program FillMomGrid
! All done

print * , 'Terminated Normally'
call exit(0)
stop 0

contains

Expand Down
12 changes: 6 additions & 6 deletions ..._GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mkCatchParam.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -142,7 +142,7 @@ PROGRAM mkCatchParam
do j = 1,size(usage)
print "(sp,a100)", Usage(j)
end do
call exit(1)
stop 1
end if

nxt = 1
Expand Down Expand Up @@ -176,7 +176,7 @@ PROGRAM mkCatchParam
do j = 1,size(usage)
print "(sp,a100)", Usage(j)
end do
call exit(1)
stop 1
end select
nxt = nxt + 1
call get_command_argument(nxt,arg)
Expand Down Expand Up @@ -251,7 +251,7 @@ PROGRAM mkCatchParam
open (newunit=unit,file=fname_tmp,status='old',action='read',form='unformatted',convert='little_endian', IOSTAT=status)
if (status /=0) then
write (log_file,'(a)')' '//trim(fname_tmp) // 'cannot be opened, exit '
call exit(1)
stop 1
endif
do j = 1, nr
read(unit)tile_id(:,j)
Expand Down Expand Up @@ -284,7 +284,7 @@ PROGRAM mkCatchParam
if (trim(withbcs) == 'no') then
write (log_file,'(a)')'Skipping MOM BCs. BCs will be extracted from the corresponding BCs. '
close (log_file,status='keep')
call exit(0)
stop 0
endif

call MAPL_ReadTilingNC4( trim(fnameTil)//".nc4", iTable = iTable)
Expand All @@ -297,13 +297,13 @@ PROGRAM mkCatchParam
open (newunit=unit,file='clsm/catchment.def',status='old',action='read',form='formatted', IOSTAT=status)
if (status /=0) then
write (log_file,'(a)')' clsm/cathment.def cannot be opened, exit '
call exit(1)
stop 1
endif
read(unit,*) N
if (n /= n_land) then
write (log_file,'(a)')'n_land not consistent between tile file and catchment.def file, exit '
write (log_file,*) n_land, n
call exit(1)
stop 1
endif

allocate(min_lon(n_land), max_lon(n_land), min_lat(n_land), max_lat(n_land))
Expand Down
6 changes: 3 additions & 3 deletions ...ridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mkCubeFVRaster.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -50,7 +50,7 @@ program mkCubeFVRaster

if(I < 1 .or. I > 16) then
print *, Usage
call exit(66)
error stop 66
end if

nxt = 1
Expand Down Expand Up @@ -95,7 +95,7 @@ program mkCubeFVRaster
g_case=.true.
case default
print *, Usage
call exit(1)
stop 1
end select

nxt = nxt + 1
Expand Down Expand Up @@ -165,6 +165,6 @@ program mkCubeFVRaster
! All done
!---------

call exit(0)
stop 0

end program mkCubeFVRaster
4 changes: 2 additions & 2 deletions ..._GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/mkEASERaster.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -46,7 +46,7 @@ program mkEASERaster
if(I < 2 .or. I > 13) then
print *, "Wrong Number of arguments: ", i
print *, trim(Usage)
call exit(1)
stop 1
end if

nxt = 1
Expand Down Expand Up @@ -79,7 +79,7 @@ program mkEASERaster
UseType = .true.
case default
print *, trim(Usage)
call exit(1)
stop 1
end select
nxt = nxt + 1
call get_command_argument(nxt,arg)
Expand Down
Loading