From d29cc355cfb09c8473d329cf799d7a4d63e726b2 Mon Sep 17 00:00:00 2001 From: GeorgeGayno-NOAA <52789452+GeorgeGayno-NOAA@users.noreply.github.com> Date: Tue, 15 Sep 2020 13:14:13 -0400 Subject: [PATCH] Updates for the Gnu compiler Some updates for the Gnu compiler. Fix argument mismatches in calls to mpi_abort. Fix syntax errors in ./lake.fd/lakefrac.F90. Add compiler flags for Gnu versions >10. See issues #140 #147. --- sorc/chgres_cube.fd/utils.f90 | 9 ++++-- sorc/fre-nctools.fd/shared_lib/mpp_domain.c | 2 +- sorc/global_chgres.fd/CMakeLists.txt | 3 ++ sorc/global_cycle.fd/CMakeLists.txt | 3 ++ sorc/global_cycle.fd/cycle.f90 | 4 +-- sorc/global_cycle.fd/read_write_data.f90 | 28 ++++++++++--------- sorc/orog_mask_tools.fd/lake.fd/lakefrac.F90 | 15 ++++++---- .../orog_mask_tools.fd/orog.fd/CMakeLists.txt | 3 ++ sorc/sfc_climo_gen.fd/interp.F90 | 4 +-- sorc/sfc_climo_gen.fd/model_grid.F90 | 6 ++-- sorc/sfc_climo_gen.fd/output.f90 | 4 +-- sorc/sfc_climo_gen.fd/utils.f90 | 9 ++++-- 12 files changed, 58 insertions(+), 32 deletions(-) diff --git a/sorc/chgres_cube.fd/utils.f90 b/sorc/chgres_cube.fd/utils.f90 index ddda0bb90..3a547eede 100644 --- a/sorc/chgres_cube.fd/utils.f90 +++ b/sorc/chgres_cube.fd/utils.f90 @@ -2,13 +2,17 @@ subroutine error_handler(string, rc) implicit none + include 'mpif.h' + character(len=*), intent(in) :: string integer, intent(in) :: rc + integer :: ierr + print*,"- FATAL ERROR: ", string print*,"- IOSTAT IS: ", rc - call mpi_abort + call mpi_abort(mpi_comm_world, 999, ierr) end subroutine error_handler @@ -20,6 +24,7 @@ subroutine netcdf_err( err, string ) integer, intent(in) :: err character(len=*), intent(in) :: string character(len=256) :: errmsg + integer :: iret include "mpif.h" @@ -28,7 +33,7 @@ subroutine netcdf_err( err, string ) print*,'' print*,'FATAL ERROR: ', trim(string), ': ', trim(errmsg) print*,'STOP.' - call mpi_abort(mpi_comm_world, 999) + call mpi_abort(mpi_comm_world, 999, iret) return end subroutine netcdf_err diff --git a/sorc/fre-nctools.fd/shared_lib/mpp_domain.c b/sorc/fre-nctools.fd/shared_lib/mpp_domain.c index 3c8b6b1cb..ea51d5ec1 100644 --- a/sorc/fre-nctools.fd/shared_lib/mpp_domain.c +++ b/sorc/fre-nctools.fd/shared_lib/mpp_domain.c @@ -13,7 +13,7 @@ /*********************************************************** global variables ***********************************************************/ -int pe, npes, root_pe; +static int pe, npes, root_pe; #define MAX_BUFFER_SIZE 10000000 double rBuffer[MAX_BUFFER_SIZE]; double sBuffer[MAX_BUFFER_SIZE]; diff --git a/sorc/global_chgres.fd/CMakeLists.txt b/sorc/global_chgres.fd/CMakeLists.txt index dc62c1a7d..4c2133a35 100644 --- a/sorc/global_chgres.fd/CMakeLists.txt +++ b/sorc/global_chgres.fd/CMakeLists.txt @@ -16,6 +16,9 @@ if(CMAKE_Fortran_COMPILER_ID MATCHES "^(Intel)$") set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -r8 -convert big_endian") elseif(CMAKE_Fortran_COMPILER_ID MATCHES "^(GNU)$") set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -fdefault-real-8 -fconvert=big-endian") + if(CMAKE_Fortran_COMPILER_VERSION VERSION_GREATER_EQUAL 10) + set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -fallow-argument-mismatch") + endif() endif() set(exe_name global_chgres) diff --git a/sorc/global_cycle.fd/CMakeLists.txt b/sorc/global_cycle.fd/CMakeLists.txt index d962bf79e..1b8e13973 100644 --- a/sorc/global_cycle.fd/CMakeLists.txt +++ b/sorc/global_cycle.fd/CMakeLists.txt @@ -9,6 +9,9 @@ if(CMAKE_Fortran_COMPILER_ID MATCHES "^(Intel)$") set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -r8 -convert big_endian") elseif(CMAKE_Fortran_COMPILER_ID MATCHES "^(GNU)$") set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -fdefault-real-8 -fconvert=big-endian") + if(CMAKE_Fortran_COMPILER_VERSION VERSION_GREATER_EQUAL 10) + set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -fallow-argument-mismatch") + endif() endif() set(exe_name global_cycle) diff --git a/sorc/global_cycle.fd/cycle.f90 b/sorc/global_cycle.fd/cycle.f90 index 5aa800f9b..290ab531f 100644 --- a/sorc/global_cycle.fd/cycle.f90 +++ b/sorc/global_cycle.fd/cycle.f90 @@ -563,7 +563,7 @@ SUBROUTINE ADJUST_NSST(RLA,RLO,SLMSK_TILE,SLMSK_FG_TILE,SKINT_TILE,& INTEGER :: ISTART, IEND, JSTART, JEND INTEGER :: MASK_TILE, MASK_FG_TILE INTEGER :: ITILE, JTILE - INTEGER :: MAX_SEARCH, J + INTEGER :: MAX_SEARCH, J, IERR INTEGER :: IGAUSP1, JGAUSP1 integer :: nintp,nsearched,nice,nland integer :: nfill,nfill_tice,nfill_clm @@ -617,7 +617,7 @@ SUBROUTINE ADJUST_NSST(RLA,RLO,SLMSK_TILE,SLMSK_FG_TILE,SKINT_TILE,& IF (NRET /= (IDIM_GAUS*JDIM_GAUS)) THEN PRINT*,'FATAL ERROR: PROBLEM IN GDSWZD. STOP.' - CALL MPI_ABORT(MPI_COMM_WORLD, 12) + CALL MPI_ABORT(MPI_COMM_WORLD, 12, IERR) ENDIF DEALLOCATE (XPTS, YPTS) diff --git a/sorc/global_cycle.fd/read_write_data.f90 b/sorc/global_cycle.fd/read_write_data.f90 index 4bbac032b..371a42668 100644 --- a/sorc/global_cycle.fd/read_write_data.f90 +++ b/sorc/global_cycle.fd/read_write_data.f90 @@ -901,7 +901,7 @@ SUBROUTINE READ_LAT_LON_OROG(RLA,RLO,OROG,OROG_UF,& IF ((NX/2) /= IDIM .OR. (NY/2) /= JDIM) THEN PRINT*,'FATAL ERROR: DIMENSIONS IN FILE: ',(NX/2),(NY/2) PRINT*,'DO NOT MATCH GRID DIMENSIONS: ',IDIM,JDIM - CALL MPI_ABORT(MPI_COMM_WORLD, 130) + CALL MPI_ABORT(MPI_COMM_WORLD, 130, ERROR) ENDIF ALLOCATE(GEOLON(NX+1,NY+1)) @@ -992,13 +992,14 @@ SUBROUTINE NETCDF_ERR( ERR, STRING ) INTEGER, INTENT(IN) :: ERR CHARACTER(LEN=*), INTENT(IN) :: STRING CHARACTER(LEN=80) :: ERRMSG + INTEGER :: IRET IF( ERR == NF90_NOERR )RETURN ERRMSG = NF90_STRERROR(ERR) PRINT*,'' PRINT*,'FATAL ERROR: ', TRIM(STRING), ': ', TRIM(ERRMSG) PRINT*,'STOP.' - CALL MPI_ABORT(MPI_COMM_WORLD, 999) + CALL MPI_ABORT(MPI_COMM_WORLD, 999, IRET) RETURN END SUBROUTINE NETCDF_ERR @@ -1123,7 +1124,7 @@ SUBROUTINE READ_DATA(TSFFCS,SMCFCS,SNOFCS,STCFCS, & INTEGER :: ERROR, NCID, MYRANK INTEGER :: IDIM, JDIM, ID_DIM - INTEGER :: ID_VAR + INTEGER :: ID_VAR, IERR REAL(KIND=8), ALLOCATABLE :: DUMMY(:,:), DUMMY3D(:,:,:) @@ -1151,7 +1152,7 @@ SUBROUTINE READ_DATA(TSFFCS,SMCFCS,SNOFCS,STCFCS, & IF ((IDIM*JDIM) /= LENSFC) THEN PRINT*,'FATAL ERROR: DIMENSIONS WRONG.' - CALL MPI_ABORT(MPI_COMM_WORLD, 88) + CALL MPI_ABORT(MPI_COMM_WORLD, 88, IERR) ENDIF ALLOCATE(DUMMY(IDIM,JDIM)) @@ -1560,7 +1561,7 @@ subroutine read_tf_clim_grb(file_sst,sst,rlats_sst,rlons_sst,mlat_sst,mlon_sst,m integer :: nlat_sst,nlon_sst integer :: iret,ni,nj - integer :: mscan,kb1 + integer :: mscan,kb1,ierr integer :: jincdir,i,iincdir,kb2,kb3,kf,kg,k,j,jf integer, dimension(22):: jgds,kgds integer, dimension(25):: jpds,kpds @@ -1575,7 +1576,7 @@ subroutine read_tf_clim_grb(file_sst,sst,rlats_sst,rlons_sst,mlat_sst,mlon_sst,m call baopenr(lu_sst,trim(file_sst),iret) if (iret /= 0 ) then write(6,*)'read_tf_clm_grb: ***error*** opening sst file' - CALL MPI_ABORT(MPI_COMM_WORLD, 111) + CALL MPI_ABORT(MPI_COMM_WORLD, 111, ierr) endif ! define sst variables for read @@ -1603,14 +1604,14 @@ subroutine read_tf_clim_grb(file_sst,sst,rlats_sst,rlons_sst,mlat_sst,mlon_sst,m if (iret /= 0) then write(6,*)'read_tf_clm_grb: ***error*** reading sst analysis data record' deallocate(lb,f) - CALL MPI_ABORT(MPI_COMM_WORLD, 111) + CALL MPI_ABORT(MPI_COMM_WORLD, 111, ierr) endif if ( (nlat_sst /= mlat_sst) .or. (nlon_sst /= mlon_sst) ) then write(6,*)'read_rtg_org: inconsistent dimensions. mlat_sst,mlon_sst=',& mlat_sst,mlon_sst,' -versus- nlat_sst,nlon_sst=',nlat_sst,nlon_sst deallocate(lb,f) - CALL MPI_ABORT(MPI_COMM_WORLD, 111) + CALL MPI_ABORT(MPI_COMM_WORLD, 111, ierr) endif ! @@ -1665,7 +1666,7 @@ subroutine read_tf_clim_grb(file_sst,sst,rlats_sst,rlons_sst,mlat_sst,mlon_sst,m call baclose(lu_sst,iret) if (iret /= 0 ) then write(6,*)'read_tf_clm_grb: ***error*** close sst file' - CALL MPI_ABORT(MPI_COMM_WORLD, 121) + CALL MPI_ABORT(MPI_COMM_WORLD, 121, ierr) endif end subroutine read_tf_clim_grb @@ -1703,7 +1704,7 @@ subroutine get_tf_clm_dim(file_sst,mlat_sst,mlon_sst) integer :: iret integer :: mscan,kb1 - integer :: kf,kg,k,j + integer :: kf,kg,k,j,ierr integer, dimension(22):: jgds,kgds integer, dimension(25):: jpds,kpds @@ -1713,7 +1714,7 @@ subroutine get_tf_clm_dim(file_sst,mlat_sst,mlon_sst) call baopenr(lu_sst,trim(file_sst),iret) if (iret /= 0 ) then write(6,*)'get_tf_clm_dim: ***error*** opening sst file' - CALL MPI_ABORT(MPI_COMM_WORLD, 111) + CALL MPI_ABORT(MPI_COMM_WORLD, 111, ierr) endif ! define sst variables for read @@ -1733,7 +1734,7 @@ subroutine get_tf_clm_dim(file_sst,mlat_sst,mlon_sst) call baclose(lu_sst,iret) if (iret /= 0 ) then write(6,*)'get_tf_clm_dim: ***error*** close sst file' - CALL MPI_ABORT(MPI_COMM_WORLD, 121) + CALL MPI_ABORT(MPI_COMM_WORLD, 121, ierr) endif end subroutine get_tf_clm_dim @@ -1848,10 +1849,11 @@ subroutine nc_check(status) include "mpif.h" integer, intent ( in) :: status + integer :: ierr if(status /= nf90_noerr) then print *, trim(nf90_strerror(status)) - CALL MPI_ABORT(MPI_COMM_WORLD, 122) + CALL MPI_ABORT(MPI_COMM_WORLD, 122, ierr) end if end subroutine nc_check diff --git a/sorc/orog_mask_tools.fd/lake.fd/lakefrac.F90 b/sorc/orog_mask_tools.fd/lake.fd/lakefrac.F90 index 9673dacfb..2c243078b 100644 --- a/sorc/orog_mask_tools.fd/lake.fd/lakefrac.F90 +++ b/sorc/orog_mask_tools.fd/lake.fd/lakefrac.F90 @@ -272,11 +272,11 @@ SUBROUTINE cal_lake_frac_depth(lakestat,cs_lakestat,lakedpth,cs_lakedpth) ENDIF ENDIF #endif - IF (two_section == .false.) THEN + IF (two_section .EQV. .false.) THEN DO i = src_grid_lon_beg, src_grid_lon_end, stride_lon p(1) = src_grid_lat(j); p(2) = src_grid_lon(i) p(:) = p(:)*d2r - IF(enclosure_cnvx(v, 4, p, co_gc) == .true.) THEN + IF(enclosure_cnvx(v, 4, p, co_gc) .EQV. .true.) THEN grid_ct = grid_ct+1 IF (lakestat((j-1)*nlon+i) /= 0) THEN lake_ct = lake_ct+1 @@ -296,7 +296,7 @@ SUBROUTINE cal_lake_frac_depth(lakestat,cs_lakestat,lakedpth,cs_lakedpth) DO i = src_grid_lon_beg1, src_grid_lon_end1, stride_lon p(1) = src_grid_lat(j); p(2) = src_grid_lon(i) p(:) = p(:)*d2r - IF(enclosure_cnvx(v, 4, p, co_gc) == .true.) THEN + IF(enclosure_cnvx(v, 4, p, co_gc) .EQV. .true.) THEN grid_ct = grid_ct+1 IF (lakestat((j-1)*nlon+i) /= 0) THEN lake_ct = lake_ct+1 @@ -315,7 +315,7 @@ SUBROUTINE cal_lake_frac_depth(lakestat,cs_lakestat,lakedpth,cs_lakedpth) DO i = src_grid_lon_beg2, src_grid_lon_end2, stride_lon p(1) = src_grid_lat(j); p(2) = src_grid_lon(i) p(:) = p(:)*d2r - IF(enclosure_cnvx(v, 4, p, co_gc) == .true.) THEN + IF(enclosure_cnvx(v, 4, p, co_gc) .EQV. .true.) THEN grid_ct = grid_ct+1 IF (lakestat((j-1)*nlon+i) /= 0) THEN lake_ct = lake_ct+1 @@ -577,7 +577,8 @@ SUBROUTINE write_lakedata_to_orodata(cs_res, cs_lakestat, cs_lakedpth) CALL nc_opchk(stat, "nf90_put_att: lake_depth:description") #endif - write(string,'(a,es8.1)') 'land_frac and lake_frac are adjusted such that their sum is 1 at points where inland=1; land_frac cutoff is',land_cutoff + write(string,'(a,es8.1)') 'land_frac and lake_frac are adjusted such that their sum '// & + 'is 1 at points where inland=1; land_frac cutoff is',land_cutoff stat = nf90_put_att(ncid, land_frac_id,'description',trim(string)) CALL nc_opchk(stat, "nf90_put_att: land_frac:description") @@ -773,7 +774,9 @@ SUBROUTINE write_reg_lakedata_to_orodata(cs_res, tile_x_dim, tile_y_dim, cs_lake CALL nc_opchk(stat, "nf90_put_att: lake_depth:description") #endif ENDIF - write(string,'(a,es8.1)') 'land_frac is adjusted to 1-lake_frac where lake_frac>0 but left unchanged where lake_frac=0. This could lead to land_frac+lake_frac<1 at some inland points; land_frac cutoff is',land_cutoff + write(string,'(a,es8.1)') 'land_frac is adjusted to 1-lake_frac where lake_frac>0 but lefti '// & + 'unchanged where lake_frac=0. This could lead to land_frac+lake_frac<1 '// & + 'at some inland points; land_frac cutoff is',land_cutoff stat = nf90_put_att(ncid, land_frac_id,'description',trim(string)) CALL nc_opchk(stat, "nf90_put_att: land_frac:description") diff --git a/sorc/orog_mask_tools.fd/orog.fd/CMakeLists.txt b/sorc/orog_mask_tools.fd/orog.fd/CMakeLists.txt index 2ef189199..5e38c7a35 100644 --- a/sorc/orog_mask_tools.fd/orog.fd/CMakeLists.txt +++ b/sorc/orog_mask_tools.fd/orog.fd/CMakeLists.txt @@ -6,6 +6,9 @@ if(CMAKE_Fortran_COMPILER_ID MATCHES "^(Intel)$") set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -r8 -convert big_endian -assume byterecl") elseif(CMAKE_Fortran_COMPILER_ID MATCHES "^(GNU)$") set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -fdefault-real-8 -fconvert=big-endian -fno-range-check") + if(CMAKE_Fortran_COMPILER_VERSION VERSION_GREATER_EQUAL 10) + set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -fallow-argument-mismatch -fallow-invalid-boz") + endif() endif() set(exe_name orog) diff --git a/sorc/sfc_climo_gen.fd/interp.F90 b/sorc/sfc_climo_gen.fd/interp.F90 index 67a8cc079..1e6141708 100644 --- a/sorc/sfc_climo_gen.fd/interp.F90 +++ b/sorc/sfc_climo_gen.fd/interp.F90 @@ -308,7 +308,7 @@ subroutine adjust_for_landice(field, vegt, idim, jdim, field_ch) integer, parameter :: landice=15 - integer :: i, j + integer :: i, j, ierr real :: landice_value @@ -364,7 +364,7 @@ subroutine adjust_for_landice(field, vegt, idim, jdim, field_ch) enddo case default print*,'- FATAL ERROR IN ROUTINE ADJUST_FOR_LANDICE. UNIDENTIFIED FIELD : ', field_ch - call mpi_abort(mpi_comm_world, 57) + call mpi_abort(mpi_comm_world, 57, ierr) end select end subroutine adjust_for_landice diff --git a/sorc/sfc_climo_gen.fd/model_grid.F90 b/sorc/sfc_climo_gen.fd/model_grid.F90 index bd0c0b5f0..056a57130 100644 --- a/sorc/sfc_climo_gen.fd/model_grid.F90 +++ b/sorc/sfc_climo_gen.fd/model_grid.F90 @@ -88,12 +88,14 @@ subroutine define_model_grid(localpet, npets) implicit none + include 'mpif.h' + integer, intent(in) :: localpet, npets character(len=500) :: the_file integer :: error, id_dim, id_tiles, ncid - integer :: id_grid_tiles + integer :: id_grid_tiles, ierr integer :: extra, rc, tile integer, allocatable :: decomptile(:,:) @@ -132,7 +134,7 @@ subroutine define_model_grid(localpet, npets) if (mod(npets,num_tiles) /= 0) then print*,'- FATAL ERROR: MUST RUN THIS PROGRAM WITH A TASK COUNT THAT' print*,'- IS A MULTIPLE OF THE NUMBER OF TILES.' - call mpi_abort + call mpi_abort(mpi_comm_world, 44, ierr) endif !----------------------------------------------------------------------- diff --git a/sorc/sfc_climo_gen.fd/output.f90 b/sorc/sfc_climo_gen.fd/output.f90 index b38aa8bea..87016e4af 100644 --- a/sorc/sfc_climo_gen.fd/output.f90 +++ b/sorc/sfc_climo_gen.fd/output.f90 @@ -50,7 +50,7 @@ subroutine output(data_one_tile, lat_one_tile, lon_one_tile, i_mdl, j_mdl, & integer :: initialsiz, fsize, error, j integer :: dim_x, dim_y, id_data - integer :: dim_time, id_times + integer :: dim_time, id_times, ierr integer :: header_buffer_val = 16384 integer :: i_out, j_out, id_lat, id_lon integer :: i_start, i_end, j_start, j_end @@ -86,7 +86,7 @@ subroutine output(data_one_tile, lat_one_tile, lon_one_tile, i_mdl, j_mdl, & out_file_with_halo = "./vegetation_type." // grid_tiles(tile) // ".halo.nc" case default print*,'- FATAL ERROR IN ROUTINE OUTPUT. UNIDENTIFIED FIELD : ', field_names(field_idx) - call mpi_abort(mpi_comm_world, 67) + call mpi_abort(mpi_comm_world, 67, ierr) end select !---------------------------------------------------------------------- diff --git a/sorc/sfc_climo_gen.fd/utils.f90 b/sorc/sfc_climo_gen.fd/utils.f90 index 373ae736c..0941737d1 100644 --- a/sorc/sfc_climo_gen.fd/utils.f90 +++ b/sorc/sfc_climo_gen.fd/utils.f90 @@ -15,6 +15,7 @@ subroutine netcdf_err( err, string ) integer, intent(in) :: err character(len=*), intent(in) :: string character(len=256) :: errmsg + integer :: ierr include "mpif.h" @@ -23,7 +24,7 @@ subroutine netcdf_err( err, string ) print*,'' print*,'FATAL ERROR: ', trim(string), ': ', trim(errmsg) print*,'STOP.' - call mpi_abort(mpi_comm_world, 999) + call mpi_abort(mpi_comm_world, 999, ierr) return end subroutine netcdf_err @@ -36,9 +37,13 @@ subroutine error_handler(string, rc) integer, optional, intent(in) :: rc + integer :: ierr + + include "mpif.h" + print*,"- FATAL ERROR: ", string if (present(rc)) print*,"- IOSTAT IS: ", rc - call mpi_abort + call mpi_abort(mpi_comm_world, 999, ierr) end subroutine error_handler