From 1c6c1d831a1a1e65a70ec0bf6bb5a411f543afa8 Mon Sep 17 00:00:00 2001 From: Dusan Jovic Date: Thu, 24 Mar 2022 14:45:19 +0000 Subject: [PATCH 01/11] Resolve argument mismatch errors when using gfortran Switch from 'use mpi' to 'use mpi_f08' --- physics/GFS_debug.F90 | 4 +- physics/aerinterp.F90 | 33 ++++--------- physics/cires_tauamf_data.F90 | 9 +--- physics/h2ointerp.f90 | 10 +--- physics/iccninterp.F90 | 47 ++++++++---------- physics/module_mp_thompson.F90 | 9 ++-- physics/mp_fer_hires.meta | 2 +- physics/mp_thompson.F90 | 5 +- physics/mp_thompson.meta | 4 +- physics/mp_thompson_post.F90 | 3 +- physics/mp_thompson_post.meta | 2 +- physics/ozinterp.f90 | 10 +--- physics/rrtmgp_lw_cloud_optics.F90 | 5 +- physics/rrtmgp_lw_cloud_optics.meta | 2 +- physics/rrtmgp_lw_gas_optics.F90 | 5 +- physics/rrtmgp_lw_gas_optics.meta | 2 +- physics/rrtmgp_sw_cloud_optics.F90 | 5 +- physics/rrtmgp_sw_cloud_optics.meta | 2 +- physics/rrtmgp_sw_gas_optics.F90 | 5 +- physics/rrtmgp_sw_gas_optics.meta | 2 +- physics/sfcsub.F | 74 ++++------------------------- 21 files changed, 74 insertions(+), 166 deletions(-) diff --git a/physics/GFS_debug.F90 b/physics/GFS_debug.F90 index f01f25cbc..0b74bf851 100644 --- a/physics/GFS_debug.F90 +++ b/physics/GFS_debug.F90 @@ -388,7 +388,7 @@ subroutine GFS_diagtoscreen_run (Model, Statein, Stateout, Sfcprop, Coupling, nthreads, blkno, errmsg, errflg) #ifdef MPI - use mpi + use mpi_f08 #endif #ifdef _OPENMP use omp_lib @@ -1041,7 +1041,7 @@ subroutine GFS_interstitialtoscreen_run (Model, Statein, Stateout, Sfcprop, Coup nthreads, blkno, errmsg, errflg) #ifdef MPI - use mpi + use mpi_f08 #endif #ifdef _OPENMP use omp_lib diff --git a/physics/aerinterp.F90 b/physics/aerinterp.F90 index 30ff97dff..b4673a7bd 100644 --- a/physics/aerinterp.F90 +++ b/physics/aerinterp.F90 @@ -112,8 +112,6 @@ SUBROUTINE read_aerdataf ( me, master, iflip, idate, FHOUR, errmsg, errflg) integer IDAT(8),JDAT(8) real(kind=kind_phys) RINC(5), rjday integer jdow, jdoy, jday - real(4) rinc4(5) - integer w3kindreal,w3kindint integer, allocatable :: invardims(:) ! @@ -131,13 +129,7 @@ SUBROUTINE read_aerdataf ( me, master, iflip, idate, FHOUR, errmsg, errflg) IDAT(5) = IDATE(1) RINC = 0. RINC(2) = FHOUR - call w3kind(w3kindreal,w3kindint) - if(w3kindreal == 4) then - rinc4 = rinc - CALL W3MOVDAT(RINC4,IDAT,JDAT) - else - CALL W3MOVDAT(RINC,IDAT,JDAT) - endif + CALL W3MOVDAT(RINC,IDAT,JDAT) ! jdow = 0 jdoy = 0 @@ -246,8 +238,6 @@ SUBROUTINE aerinterpol( me,master,nthrds,npts,IDATE,FHOUR,iflip, jindx1,jindx2, real(kind=kind_phys) prsl(npts,lev), aerpres(npts,levsaer) real(kind=kind_phys) RINC(5), rjday integer jdow, jdoy, jday - real(4) rinc4(5) - integer w3kindreal,w3kindint ! IDAT = 0 @@ -257,13 +247,7 @@ SUBROUTINE aerinterpol( me,master,nthrds,npts,IDATE,FHOUR,iflip, jindx1,jindx2, IDAT(5) = IDATE(1) RINC = 0. RINC(2) = FHOUR - call w3kind(w3kindreal,w3kindint) - if(w3kindreal == 4) then - rinc4 = rinc - CALL W3MOVDAT(RINC4,IDAT,JDAT) - else - CALL W3MOVDAT(RINC,IDAT,JDAT) - endif + CALL W3MOVDAT(RINC,IDAT,JDAT) ! jdow = 0 jdoy = 0 @@ -393,6 +377,7 @@ subroutine read_netfaer(nf, iflip,nt) use aerclm_def use netcdf integer, intent(in) :: iflip, nf, nt + integer :: ncerr integer :: ncid, varid, i,j,k,ii,klev character :: fname*50, mn*2, vname*10 real(kind=kind_io4),allocatable,dimension(:,:,:) :: buff @@ -406,11 +391,11 @@ subroutine read_netfaer(nf, iflip,nt) write(mn,'(i2.2)') nf fname=trim("aeroclim.m"//mn//".nc") - call nf_open(fname , nf90_NOWRITE, ncid) + ncerr = nf90_open(fname , NF90_NOWRITE, ncid) ! ====> construct 3-d pressure array (Pa) - call nf_inq_varid(ncid, "DELP", varid) - call nf_get_var(ncid, varid, buff) + ncerr = nf90_inq_varid(ncid, "DELP", varid) + ncerr = nf90_get_var(ncid, varid, buff) do j = jamin, jamax do i = iamin, iamax @@ -439,8 +424,8 @@ subroutine read_netfaer(nf, iflip,nt) ! for GFS, iflip 0: toa to sfc; 1: sfc to toa DO ii = 1, ntrcaerm vname=trim(specname(ii)) - call nf_inq_varid(ncid, vname, varid) - call nf_get_var(ncid, varid, buffx) + ncerr = nf90_inq_varid(ncid, vname, varid) + ncerr = nf90_get_var(ncid, varid, buffx) do j = jamin, jamax do k = 1, levsaer @@ -462,7 +447,7 @@ subroutine read_netfaer(nf, iflip,nt) ENDDO ! ii-loop (ntracaerm) ! close the file - call nf_close(ncid) + ncerr = nf90_close(ncid) deallocate (buff, pres_tmp) deallocate (buffx) return diff --git a/physics/cires_tauamf_data.F90 b/physics/cires_tauamf_data.F90 index e0d43e74e..52bfb67bd 100644 --- a/physics/cires_tauamf_data.F90 +++ b/physics/cires_tauamf_data.F90 @@ -179,7 +179,6 @@ subroutine gfs_idate_calendar(idate, fhour, ddd, fddd) real(kind=kind_phys) :: rinc(5), rjday integer :: jdow, jdoy, jday real(4) :: rinc4(5) - integer :: w3kindreal, w3kindint integer :: iw3jdn integer :: jd1, jddd @@ -195,13 +194,7 @@ subroutine gfs_idate_calendar(idate, fhour, ddd, fddd) rinc(1:5) = 0. rinc(2) = fhour ! - call w3kind(w3kindreal,w3kindint) - if(w3kindreal==4) then - rinc4 = rinc - call w3movdat(rinc4, idat,jdat) - else - call w3movdat(rinc, idat,jdat) - endif + call w3movdat(rinc, idat,jdat) ! jdate(8)- date and time (yr, mo, day, [tz], hr, min, sec) jdow = 0 jdoy = 0 diff --git a/physics/h2ointerp.f90 b/physics/h2ointerp.f90 index f26ae6c0c..de5eb855d 100644 --- a/physics/h2ointerp.f90 +++ b/physics/h2ointerp.f90 @@ -146,8 +146,6 @@ subroutine h2ointerpol(me,npts,idate,fhour,jindx1,jindx2,h2oplout,ddy) real(kind=kind_phys) h2oplout(npts,levh2o,h2o_coeff) real(kind=kind_phys) rinc(5), rjday integer jdow, jdoy, jday - real(4) rinc4(5) - integer w3kindreal, w3kindint ! idat = 0 idat(1) = idate(4) @@ -156,13 +154,7 @@ subroutine h2ointerpol(me,npts,idate,fhour,jindx1,jindx2,h2oplout,ddy) idat(5) = idate(1) rinc = 0. rinc(2) = fhour - call w3kind(w3kindreal,w3kindint) - if(w3kindreal==4) then - rinc4 = rinc - CALL W3MOVDAT(RINC4,IDAT,JDAT) - else - CALL W3MOVDAT(RINC,IDAT,JDAT) - endif + CALL W3MOVDAT(RINC,IDAT,JDAT) ! jdow = 0 jdoy = 0 diff --git a/physics/iccninterp.F90 b/physics/iccninterp.F90 index a3a08dee8..37e0bfb00 100644 --- a/physics/iccninterp.F90 +++ b/physics/iccninterp.F90 @@ -23,6 +23,7 @@ SUBROUTINE read_cidata (me, master) integer, intent(in) :: me integer, intent(in) :: master !--- locals + integer :: ncerr integer :: i, n, k, ncid, varid,j,it real(kind=kind_phys), allocatable, dimension(:) :: hyam,hybm real(kind=4), allocatable, dimension(:,:,:) :: ci_ps @@ -31,29 +32,29 @@ SUBROUTINE read_cidata (me, master) allocate (ciplin(lonscip,latscip,kcipl,timeci)) allocate (ccnin(lonscip,latscip,kcipl,timeci)) allocate (ci_pres(lonscip,latscip,kcipl,timeci)) - call nf_open("cam5_4_143_NAAI_monclimo2.nc", NF90_NOWRITE, ncid) - call nf_inq_varid(ncid, "lat", varid) - call nf_get_var(ncid, varid, ci_lat) - call nf_inq_varid(ncid, "lon", varid) - call nf_get_var(ncid, varid, ci_lon) - call nf_inq_varid(ncid, "PS", varid) - call nf_get_var(ncid, varid, ci_ps) - call nf_inq_varid(ncid, "hyam", varid) - call nf_get_var(ncid, varid, hyam) - call nf_inq_varid(ncid, "hybm", varid) - call nf_get_var(ncid, varid, hybm) - call nf_inq_varid(ncid, "NAAI", varid) - call nf_get_var(ncid, varid, ciplin) + ncerr = nf90_open("cam5_4_143_NAAI_monclimo2.nc", NF90_NOWRITE, ncid) + ncerr = nf90_inq_varid(ncid, "lat", varid) + ncerr = nf90_get_var(ncid, varid, ci_lat) + ncerr = nf90_inq_varid(ncid, "lon", varid) + ncerr = nf90_get_var(ncid, varid, ci_lon) + ncerr = nf90_inq_varid(ncid, "PS", varid) + ncerr = nf90_get_var(ncid, varid, ci_ps) + ncerr = nf90_inq_varid(ncid, "hyam", varid) + ncerr = nf90_get_var(ncid, varid, hyam) + ncerr = nf90_inq_varid(ncid, "hybm", varid) + ncerr = nf90_get_var(ncid, varid, hybm) + ncerr = nf90_inq_varid(ncid, "NAAI", varid) + ncerr = nf90_get_var(ncid, varid, ciplin) do it = 1,timeci do k=1, kcipl ci_pres(:,:,k,it)=hyam(k)*1.e5+hybm(k)*ci_ps(:,:,it) end do end do - call nf_close(ncid) - call nf_open("cam5_4_143_NPCCN_monclimo2.nc", NF90_NOWRITE, ncid) - call nf_inq_varid(ncid, "NPCCN", varid) - call nf_get_var(ncid, varid, ccnin) - call nf_close(ncid) + ncerr = nf90_close(ncid) + ncerr = nf90_open("cam5_4_143_NPCCN_monclimo2.nc", NF90_NOWRITE, ncid) + ncerr = nf90_inq_varid(ncid, "NPCCN", varid) + ncerr = nf90_get_var(ncid, varid, ccnin) + ncerr = nf90_close(ncid) !--- deallocate (hyam, hybm, ci_ps) if (me == master) then @@ -145,8 +146,6 @@ SUBROUTINE ciinterpol(me,npts,IDATE,FHOUR,jindx1,jindx2,ddy, & real(kind=kind_phys) cipres(npts,kcipl), prsl(npts,lev) real(kind=kind_phys) RINC(5), rjday integer jdow, jdoy, jday - real(4) rinc4(5) - integer w3kindreal,w3kindint ! IDAT=0 IDAT(1)=IDATE(4) @@ -155,13 +154,7 @@ SUBROUTINE ciinterpol(me,npts,IDATE,FHOUR,jindx1,jindx2,ddy, & IDAT(5)=IDATE(1) RINC=0. RINC(2)=FHOUR - call w3kind(w3kindreal,w3kindint) - if(w3kindreal==4) then - rinc4=rinc - CALL W3MOVDAT(RINC4,IDAT,JDAT) - else - CALL W3MOVDAT(RINC,IDAT,JDAT) - endif + CALL W3MOVDAT(RINC,IDAT,JDAT) ! jdow = 0 jdoy = 0 diff --git a/physics/module_mp_thompson.F90 b/physics/module_mp_thompson.F90 index c23b6d1d8..75f199305 100644 --- a/physics/module_mp_thompson.F90 +++ b/physics/module_mp_thompson.F90 @@ -64,7 +64,7 @@ MODULE module_mp_thompson USE module_mp_radar #ifdef MPI - use mpi + use mpi_f08 #endif IMPLICIT NONE @@ -419,7 +419,7 @@ MODULE module_mp_thompson REAL:: t1_qs_me, t2_qs_me, t1_qg_me, t2_qg_me !..MPI communicator - INTEGER:: mpi_communicator + TYPE(MPI_Comm):: mpi_communicator !..Write tables with master MPI task after computing them in thompson_init LOGICAL:: thompson_table_writer @@ -444,7 +444,8 @@ SUBROUTINE thompson_init(is_aerosol_aware_in, & IMPLICIT NONE LOGICAL, INTENT(IN) :: is_aerosol_aware_in - INTEGER, INTENT(IN) :: mpicomm, mpirank, mpiroot + TYPE(MPI_Comm), INTENT(IN) :: mpicomm + INTEGER, INTENT(IN) :: mpirank, mpiroot INTEGER, INTENT(IN) :: threads CHARACTER(len=*), INTENT(INOUT) :: errmsg INTEGER, INTENT(INOUT) :: errflg @@ -1810,7 +1811,7 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & qgten1, qiten1, niten1, nrten1, ncten1, qcten1) #ifdef MPI - use mpi + use mpi_f08 #endif implicit none diff --git a/physics/mp_fer_hires.meta b/physics/mp_fer_hires.meta index 9f7c63d4d..058154856 100644 --- a/physics/mp_fer_hires.meta +++ b/physics/mp_fer_hires.meta @@ -55,7 +55,7 @@ long_name = MPI communicator units = index dimensions = () - type = integer + type = MPI_Comm intent = in [mpirank] standard_name = mpi_rank diff --git a/physics/mp_thompson.F90 b/physics/mp_thompson.F90 index 7c76ea933..eb6166b3d 100644 --- a/physics/mp_thompson.F90 +++ b/physics/mp_thompson.F90 @@ -6,6 +6,7 @@ !! This module contains the aerosol-aware Thompson microphysics scheme. module mp_thompson + use mpi_f08 use machine, only : kind_phys use module_mp_thompson, only : thompson_init, mp_gt_driver, thompson_finalize, calc_effectRad @@ -72,7 +73,7 @@ subroutine mp_thompson_init(ncol, nlev, con_g, con_rd, con_eps, & real(kind_phys), intent(in ) :: phil(:,:) real(kind_phys), intent(in ) :: area(:) ! MPI information - integer, intent(in ) :: mpicomm + type(MPI_Comm), intent(in ) :: mpicomm integer, intent(in ) :: mpirank integer, intent(in ) :: mpiroot ! Threading/blocking information @@ -362,7 +363,7 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & integer, intent(in) :: decfl ! MPI and block information integer, intent(in) :: blkno - integer, intent(in) :: mpicomm + type(MPI_Comm), intent(in) :: mpicomm integer, intent(in) :: mpirank integer, intent(in) :: mpiroot ! Extended diagnostic output diff --git a/physics/mp_thompson.meta b/physics/mp_thompson.meta index a3bc20615..c728cd14a 100644 --- a/physics/mp_thompson.meta +++ b/physics/mp_thompson.meta @@ -221,7 +221,7 @@ long_name = MPI communicator units = index dimensions = () - type = integer + type = MPI_Comm intent = in [mpirank] standard_name = mpi_rank @@ -593,7 +593,7 @@ long_name = MPI communicator units = index dimensions = () - type = integer + type = MPI_Comm intent = in [mpirank] standard_name = mpi_rank diff --git a/physics/mp_thompson_post.F90 b/physics/mp_thompson_post.F90 index c53f61b0c..9ab841928 100644 --- a/physics/mp_thompson_post.F90 +++ b/physics/mp_thompson_post.F90 @@ -1,5 +1,6 @@ module mp_thompson_post + use mpi_f08 use machine, only : kind_phys implicit none @@ -66,7 +67,7 @@ subroutine mp_thompson_post_run(ncol, nlev, tgrs_save, tgrs, prslk, dtp, ttendli real(kind_phys), intent(in) :: ttendlim integer, intent(in) :: kdt ! MPI information - integer, intent(in ) :: mpicomm + type(MPI_Comm), intent(in ) :: mpicomm integer, intent(in ) :: mpirank integer, intent(in ) :: mpiroot ! CCPP error handling diff --git a/physics/mp_thompson_post.meta b/physics/mp_thompson_post.meta index 82b035e99..7b843000e 100644 --- a/physics/mp_thompson_post.meta +++ b/physics/mp_thompson_post.meta @@ -101,7 +101,7 @@ long_name = MPI communicator units = index dimensions = () - type = integer + type = MPI_Comm intent = in [mpirank] standard_name = mpi_rank diff --git a/physics/ozinterp.f90 b/physics/ozinterp.f90 index 6fe86c8e1..2f0a28128 100644 --- a/physics/ozinterp.f90 +++ b/physics/ozinterp.f90 @@ -149,8 +149,6 @@ SUBROUTINE ozinterpol(me,npts,IDATE,FHOUR,jindx1,jindx2,ozplout,ddy) real(kind=kind_phys) ozplout(npts,levozp,oz_coeff) real(kind=kind_phys) RINC(5), rjday integer jdow, jdoy, jday - real(4) rinc4(5) - integer w3kindreal,w3kindint ! IDAT=0 IDAT(1)=IDATE(4) @@ -159,13 +157,7 @@ SUBROUTINE ozinterpol(me,npts,IDATE,FHOUR,jindx1,jindx2,ozplout,ddy) IDAT(5)=IDATE(1) RINC=0. RINC(2)=FHOUR - call w3kind(w3kindreal,w3kindint) - if(w3kindreal==4) then - rinc4=rinc - CALL W3MOVDAT(RINC4,IDAT,JDAT) - else - CALL W3MOVDAT(RINC,IDAT,JDAT) - endif + CALL W3MOVDAT(RINC,IDAT,JDAT) ! jdow = 0 jdoy = 0 diff --git a/physics/rrtmgp_lw_cloud_optics.F90 b/physics/rrtmgp_lw_cloud_optics.F90 index 5ddcec078..28f1f5fb4 100644 --- a/physics/rrtmgp_lw_cloud_optics.F90 +++ b/physics/rrtmgp_lw_cloud_optics.F90 @@ -8,7 +8,7 @@ module rrtmgp_lw_cloud_optics use radiation_tools, only: check_error_msg use netcdf #ifdef MPI - use mpi + use mpi_f08 #endif implicit none @@ -81,8 +81,9 @@ subroutine rrtmgp_lw_cloud_optics_init(nrghice, mpicomm, mpirank, mpiroot, doGP_cldoptics_LUT ! Use RRTMGP cloud-optics: LUTs? integer, intent(inout) :: & nrghice ! Number of ice-roughness categories + type(MPI_Comm), intent(in) :: & + mpicomm ! MPI communicator integer, intent(in) :: & - mpicomm, & ! MPI communicator mpirank, & ! Current MPI rank mpiroot ! Master MPI rank character(len=128),intent(in) :: & diff --git a/physics/rrtmgp_lw_cloud_optics.meta b/physics/rrtmgp_lw_cloud_optics.meta index 35e27979e..3d34884cb 100644 --- a/physics/rrtmgp_lw_cloud_optics.meta +++ b/physics/rrtmgp_lw_cloud_optics.meta @@ -70,7 +70,7 @@ long_name = MPI communicator units = index dimensions = () - type = integer + type = MPI_Comm intent = in [errmsg] standard_name = ccpp_error_message diff --git a/physics/rrtmgp_lw_gas_optics.F90 b/physics/rrtmgp_lw_gas_optics.F90 index 67a888911..af47d86ab 100644 --- a/physics/rrtmgp_lw_gas_optics.F90 +++ b/physics/rrtmgp_lw_gas_optics.F90 @@ -8,7 +8,7 @@ module rrtmgp_lw_gas_optics use radiation_tools, only: check_error_msg use netcdf #ifdef MPI - use mpi + use mpi_f08 #endif implicit none @@ -82,8 +82,9 @@ subroutine rrtmgp_lw_gas_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, mpicom character(len=128),intent(in) :: & rrtmgp_root_dir, & ! RTE-RRTMGP root directory rrtmgp_lw_file_gas ! RRTMGP file containing coefficients used to compute gaseous optical properties + type(MPI_Comm),intent(in) :: & + mpicomm ! MPI communicator integer,intent(in) :: & - mpicomm, & ! MPI communicator mpirank, & ! Current MPI rank mpiroot ! Master MPI rank diff --git a/physics/rrtmgp_lw_gas_optics.meta b/physics/rrtmgp_lw_gas_optics.meta index 0b484b6ac..37b44f502 100644 --- a/physics/rrtmgp_lw_gas_optics.meta +++ b/physics/rrtmgp_lw_gas_optics.meta @@ -42,7 +42,7 @@ long_name = MPI communicator units = index dimensions = () - type = integer + type = MPI_Comm intent = in [minGPpres] standard_name = minimum_pressure_in_RRTMGP diff --git a/physics/rrtmgp_sw_cloud_optics.F90 b/physics/rrtmgp_sw_cloud_optics.F90 index f80440522..2a175a0e6 100644 --- a/physics/rrtmgp_sw_cloud_optics.F90 +++ b/physics/rrtmgp_sw_cloud_optics.F90 @@ -8,7 +8,7 @@ module rrtmgp_sw_cloud_optics use radiation_tools, only: check_error_msg use netcdf #ifdef MPI - use mpi + use mpi_f08 #endif implicit none @@ -81,8 +81,9 @@ subroutine rrtmgp_sw_cloud_optics_init(doG_cldoptics, doGP_cldoptics_PADE, doGP_cldoptics_LUT ! Use RRTMGP cloud-optics: LUTs? integer, intent(inout) :: & nrghice ! Number of ice-roughness categories + type(MPI_Comm), intent(in) :: & + mpicomm ! MPI communicator integer, intent(in) :: & - mpicomm, & ! MPI communicator mpirank, & ! Current MPI rank mpiroot ! Master MPI rank character(len=128),intent(in) :: & diff --git a/physics/rrtmgp_sw_cloud_optics.meta b/physics/rrtmgp_sw_cloud_optics.meta index d73258cb2..f852cf7cb 100644 --- a/physics/rrtmgp_sw_cloud_optics.meta +++ b/physics/rrtmgp_sw_cloud_optics.meta @@ -70,7 +70,7 @@ long_name = MPI communicator units = index dimensions = () - type = integer + type = MPI_Comm intent = in [errmsg] standard_name = ccpp_error_message diff --git a/physics/rrtmgp_sw_gas_optics.F90 b/physics/rrtmgp_sw_gas_optics.F90 index 260f65fe7..9f2078a51 100644 --- a/physics/rrtmgp_sw_gas_optics.F90 +++ b/physics/rrtmgp_sw_gas_optics.F90 @@ -7,7 +7,7 @@ module rrtmgp_sw_gas_optics use mo_optical_props, only: ty_optical_props_2str use netcdf #ifdef MPI - use mpi + use mpi_f08 #endif implicit none @@ -86,8 +86,9 @@ subroutine rrtmgp_sw_gas_optics_init(rrtmgp_root_dir, rrtmgp_sw_file_gas, character(len=128),intent(in) :: & rrtmgp_root_dir, & ! RTE-RRTMGP root directory rrtmgp_sw_file_gas ! RRTMGP file containing coefficients used to compute gaseous optical properties + type(MPI_Comm),intent(in) :: & + mpicomm ! MPI communicator integer,intent(in) :: & - mpicomm, & ! MPI communicator mpirank, & ! Current MPI rank mpiroot ! Master MPI rank character(len=*), dimension(:), intent(in) :: & diff --git a/physics/rrtmgp_sw_gas_optics.meta b/physics/rrtmgp_sw_gas_optics.meta index 1fdbc946b..8a018172d 100644 --- a/physics/rrtmgp_sw_gas_optics.meta +++ b/physics/rrtmgp_sw_gas_optics.meta @@ -50,7 +50,7 @@ long_name = MPI communicator units = index dimensions = () - type = integer + type = MPI_Comm intent = in [errmsg] standard_name = ccpp_error_message diff --git a/physics/sfcsub.F b/physics/sfcsub.F index e8b61f083..321e87a98 100644 --- a/physics/sfcsub.F +++ b/physics/sfcsub.F @@ -2740,7 +2740,7 @@ subroutine fixrdg(lugb,idim,jdim,fngrib, & use sfccyc_module, only : mdata implicit none integer lgrib,n,lskip,jret,j,ndata,lugi,jdim,idim,lugb, - & iret, me,kpds5,kdata,i,w3kindreal,w3kindint + & iret, me,kpds5,kdata,i ! character*(*) fngrib ! @@ -2748,7 +2748,6 @@ subroutine fixrdg(lugb,idim,jdim,fngrib, & logical gaus real (kind=kind_io8) blno,blto real (kind=kind_io8), allocatable :: data8(:) - real (kind=kind_io4), allocatable :: data4(:) ! logical*1, allocatable :: lbms(:) ! @@ -2807,20 +2806,8 @@ subroutine fixrdg(lugb,idim,jdim,fngrib, & jpds = kpds0 lskip = -1 kdata=idim*jdim - call w3kind(w3kindreal,w3kindint) - if (w3kindreal == 8) then call getgb(lugb,lugi,kdata,lskip,jpds,jgds,ndata,lskip, & kpds,kgds,lbms,data8,jret) - else if (w3kindreal == 4) then - allocate(data4(1:idim*jdim)) - call getgb(lugb,lugi,kdata,lskip,jpds,jgds,ndata,lskip, - & kpds,kgds,lbms,data4,jret) - data8 = real(data4, kind=kind_io8) - deallocate(data4) - else - write(0,*)' FATAL ERROR: Invalid w3kindreal' - call abort - endif ! if(jret == 0) then if(ndata.eq.0) then @@ -7041,8 +7028,6 @@ subroutine clima(lugb,iy,im,id,ih,fh,len,lsoil,slmskl,slmskw, & & 196.5,227.5,258.0,288.5,319.0,349.5,380.5/ ! real (kind=kind_io8) fha(5) - real(4) fha4(5) - integer w3kindreal,w3kindint integer ida(8),jda(8),ivtyp, kpd7 ! real (kind=kind_io8), allocatable :: tsf(:,:),sno(:,:), @@ -7134,13 +7119,7 @@ subroutine clima(lugb,iy,im,id,ih,fh,len,lsoil,slmskl,slmskw, & ida(2) = im ida(3) = id ida(5) = ih - call w3kind(w3kindreal,w3kindint) - if(w3kindreal == 4) then - fha4 = fha - call w3movdat(fha4,ida,jda) - else - call w3movdat(fha,ida,jda) - endif + call w3movdat(fha,ida,jda) jy = jda(1) jm = jda(2) jd = jda(3) @@ -7210,13 +7189,7 @@ subroutine clima(lugb,iy,im,id,ih,fh,len,lsoil,slmskl,slmskw, & ida(2) = im ida(3) = id ida(5) = ih - call w3kind(w3kindreal,w3kindint) - if(w3kindreal == 4) then - fha4 = fha - call w3movdat(fha4,ida,jda) - else - call w3movdat(fha,ida,jda) - endif + call w3movdat(fha,ida,jda) jy = jda(1) jm = jda(2) jd = jda(3) @@ -8310,7 +8283,7 @@ subroutine fixrdc(lugb,fngrib,kpds5,kpds7,mon,slmask, & implicit none integer imax,jmax,ijmax,i,j,n,jret,inttyp,iret,imsk, & & jmsk,len,lugb,kpds5,mon,lskip,lgrib,ndata,lugi,me,kmami & - &, jj,w3kindreal,w3kindint + &, jj real (kind=kind_io8) wlon,elon,rnlat,dlat,dlon,rslat,blno,blto ! ! @@ -8322,7 +8295,6 @@ subroutine fixrdc(lugb,fngrib,kpds5,kpds7,mon,slmask, & real (kind=kind_io8) gdata(len), slmask(len) real (kind=kind_io8), allocatable :: data(:,:), rslmsk(:,:) real (kind=kind_io8), allocatable :: data8(:) - real (kind=kind_io4), allocatable :: data4(:) real (kind=kind_io8), allocatable :: rlngrb(:), rltgrb(:) ! logical lmask, yr2kc, gaus, ijordr @@ -8390,17 +8362,8 @@ subroutine fixrdc(lugb,fngrib,kpds5,kpds7,mon,slmask, & jpds = kpds0 jpds(9) = mon if(jpds(9).eq.13) jpds(9) = 1 - call w3kind(w3kindreal,w3kindint) - if (w3kindreal==8) then - call getgb(lugb,lugi,mdata,lskip,jpds,jgds,ndata,lskip, - & kpds,kgds,lbms,data8,jret) - else if (w3kindreal==4) then - allocate(data4(1:mdata)) - call getgb(lugb,lugi,mdata,lskip,jpds,jgds,ndata,lskip, - & kpds,kgds,lbms,data4,jret) - data8 = real(data4, kind=kind_io8) - deallocate(data4) - endif + call getgb(lugb,lugi,mdata,lskip,jpds,jgds,ndata,lskip, + & kpds,kgds,lbms,data8,jret) if (me .eq. 0) write(6,*) ' input grib file dates=', & (kpds(i),i=8,11) if(jret.eq.0) then @@ -8485,7 +8448,7 @@ subroutine fixrda(lugb,fngrib,kpds5,slmask, & integer nrepmx,nvalid,imo,iyr,idy,jret,ihr,nrept,lskip,lugi, & & lgrib,j,ndata,i,inttyp,jmax,imax,ijmax,ij,jday,len,iret, & & jmsk,imsk,ih,kpds5,lugb,iy,id,im,jh,jd,jdoy,jdow,jm,me, & - & monend,jy,iy4,kmami,iret2,jj,w3kindreal,w3kindint + & monend,jy,iy4,kmami,iret2,jj real (kind=kind_io8) rnlat,rslat,wlon,elon,dlon,dlat,fh,blno, & & rjday,blto ! @@ -8507,7 +8470,6 @@ subroutine fixrda(lugb,fngrib,kpds5,slmask, & real (kind=kind_io8) gdata(len), slmask(len) real (kind=kind_io8), allocatable :: data(:,:),rslmsk(:,:) real (kind=kind_io8), allocatable :: data8(:) - real (kind=kind_io4), allocatable :: data4(:) real (kind=kind_io8), allocatable :: rlngrb(:), rltgrb(:) ! logical lmask, yr2kc, gaus, ijordr @@ -8529,7 +8491,6 @@ subroutine fixrda(lugb,fngrib,kpds5,slmask, & data mjday/31,28,31,30,31,30,31,31,30,31,30,31/ ! real (kind=kind_io8) fha(5) - real(4) fha4(5) integer ida(8),jda(8) ! allocate(data8(1:mdata)) @@ -8548,13 +8509,7 @@ subroutine fixrda(lugb,fngrib,kpds5,slmask, & ida(2)=im ida(3)=id ida(5)=ih - call w3kind(w3kindreal,w3kindint) - if(w3kindreal==4) then - fha4=fha - call w3movdat(fha4,ida,jda) - else - call w3movdat(fha,ida,jda) - endif + call w3movdat(fha,ida,jda) jy=jda(1) jm=jda(2) jd=jda(3) @@ -8637,17 +8592,8 @@ subroutine fixrda(lugb,fngrib,kpds5,slmask, & jpds(10)=idy ! jpds(11)=ihr jpds(21)=(iyr-1)/100+1 - call w3kind(w3kindreal,w3kindint) - if (w3kindreal == 8) then - call getgb(lugb,lugi,mdata,lskip,jpds,jgds,ndata,lskip, - & kpds,kgds,lbms,data8,jret) - elseif (w3kindreal == 4) then - allocate (data4(1:mdata)) - call getgb(lugb,lugi,mdata,lskip,jpds,jgds,ndata,lskip, - & kpds,kgds,lbms,data4,jret) - data8 = real(data4, kind=kind_io8) - deallocate(data4) - endif + call getgb(lugb,lugi,mdata,lskip,jpds,jgds,ndata,lskip, + & kpds,kgds,lbms,data8,jret) if (me .eq. 0) write(6,*) ' input grib file dates=', & (kpds(i),i=8,11) if(jret.eq.0) then From 16ef7f241efb568da6b860e27a7aac3e9b423036 Mon Sep 17 00:00:00 2001 From: Dusan Jovic Date: Tue, 19 Jul 2022 21:14:44 +0000 Subject: [PATCH 02/11] Declare variables passed to w3nco library as double precission --- physics/aerinterp.F90 | 7 ++++--- physics/h2ointerp.f90 | 3 ++- physics/iccninterp.F90 | 3 ++- physics/ozinterp.f90 | 3 ++- physics/sfcsub.F | 12 ++++++------ 5 files changed, 16 insertions(+), 12 deletions(-) diff --git a/physics/aerinterp.F90 b/physics/aerinterp.F90 index 90765e4d5..790aa0096 100644 --- a/physics/aerinterp.F90 +++ b/physics/aerinterp.F90 @@ -98,7 +98,7 @@ END SUBROUTINE read_aerdata ! !********************************************************************** SUBROUTINE read_aerdataf ( me, master, iflip, idate, FHOUR, errmsg, errflg) - use machine, only: kind_phys, kind_io4, kind_io8 + use machine, only: kind_phys, kind_dbl_prec use aerclm_def !--- in/out @@ -111,7 +111,7 @@ SUBROUTINE read_aerdataf ( me, master, iflip, idate, FHOUR, errmsg, errflg) logical :: file_exist integer IDAT(8),JDAT(8) real(kind=kind_phys) rjday - real(8) RINC(5) + real(kind=kind_dbl_prec) rinc(5) integer jdow, jdoy, jday integer, allocatable :: invardims(:) @@ -218,7 +218,7 @@ END SUBROUTINE setindxaer SUBROUTINE aerinterpol( me,master,nthrds,npts,IDATE,FHOUR,iflip, jindx1,jindx2, & ddy,iindx1,iindx2,ddx,lev,prsl,aerout) ! - use machine, only: kind_phys, kind_io4, kind_io8 + use machine, only: kind_phys, kind_dbl_prec use aerclm_def implicit none @@ -238,6 +238,7 @@ SUBROUTINE aerinterpol( me,master,nthrds,npts,IDATE,FHOUR,iflip, jindx1,jindx2, real(kind=kind_phys) aerpm(npts,levsaer,ntrcaer) real(kind=kind_phys) prsl(npts,lev), aerpres(npts,levsaer) real(kind=kind_phys) rjday + real(kind=kind_dbl_prec) rinc(5) integer jdow, jdoy, jday ! IDAT = 0 diff --git a/physics/h2ointerp.f90 b/physics/h2ointerp.f90 index 2d16decc0..f5a1f36c6 100644 --- a/physics/h2ointerp.f90 +++ b/physics/h2ointerp.f90 @@ -131,7 +131,7 @@ subroutine h2ointerpol(me,npts,idate,fhour,jindx1,jindx2,h2oplout,ddy) ! ! May 2015 Shrinivas Moorthi - Prepare for H2O interpolation ! - use machine , only : kind_phys + use machine , only : kind_phys, kind_dbl_prec use h2o_def implicit none integer j,j1,j2,l,npts,nc,n1,n2 @@ -145,6 +145,7 @@ subroutine h2ointerpol(me,npts,idate,fhour,jindx1,jindx2,h2oplout,ddy) real(kind=kind_phys) ddy(npts) real(kind=kind_phys) h2oplout(npts,levh2o,h2o_coeff) real(kind=kind_phys) rjday + real(kind=kind_dbl_prec) rinc(5) integer jdow, jdoy, jday ! idat = 0 diff --git a/physics/iccninterp.F90 b/physics/iccninterp.F90 index 1d613c53c..dd752d9b8 100644 --- a/physics/iccninterp.F90 +++ b/physics/iccninterp.F90 @@ -129,7 +129,7 @@ END SUBROUTINE setindxci SUBROUTINE ciinterpol(me,npts,IDATE,FHOUR,jindx1,jindx2,ddy, & iindx1,iindx2,ddx,lev, prsl, ciplout,ccnout) ! - USE MACHINE, ONLY : kind_phys + USE MACHINE, ONLY : kind_phys, kind_dbl_prec use iccn_def implicit none integer i1,i2, iday,j,j1,j2,l,npts,nc,n1,n2,lev,k,i @@ -145,6 +145,7 @@ SUBROUTINE ciinterpol(me,npts,IDATE,FHOUR,jindx1,jindx2,ddy, & real(kind=kind_phys) ccnout(npts,lev),ccnpm(npts,kcipl) real(kind=kind_phys) cipres(npts,kcipl), prsl(npts,lev) real(kind=kind_phys) rjday + real(kind=kind_dbl_prec) rinc(5) integer jdow, jdoy, jday ! IDAT=0 diff --git a/physics/ozinterp.f90 b/physics/ozinterp.f90 index f92140eb1..e26d5a56e 100644 --- a/physics/ozinterp.f90 +++ b/physics/ozinterp.f90 @@ -135,7 +135,7 @@ END SUBROUTINE setindxoz ! SUBROUTINE ozinterpol(me,npts,IDATE,FHOUR,jindx1,jindx2,ozplout,ddy) ! - USE MACHINE, ONLY : kind_phys + USE MACHINE, ONLY : kind_phys, kind_dbl_prec USE OZNE_DEF implicit none integer iday,j,j1,j2,l,npts,nc,n1,n2 @@ -148,6 +148,7 @@ SUBROUTINE ozinterpol(me,npts,IDATE,FHOUR,jindx1,jindx2,ozplout,ddy) real(kind=kind_phys) DDY(npts) real(kind=kind_phys) ozplout(npts,levozp,oz_coeff) real(kind=kind_phys) rjday + real(kind=kind_dbl_prec) rinc(5) integer jdow, jdoy, jday ! IDAT=0 diff --git a/physics/sfcsub.F b/physics/sfcsub.F index d5a1d997d..4c7168b90 100644 --- a/physics/sfcsub.F +++ b/physics/sfcsub.F @@ -2747,7 +2747,7 @@ subroutine fixrdg(lugb,idim,jdim,fngrib, & real (kind=kind_io8) gdata(idim*jdim) logical gaus real (kind=kind_io8) blno,blto - real (kind=kind_io8), allocatable :: data8(:) + real (kind=kind_dbl_prec), allocatable :: data8(:) ! logical*1, allocatable :: lbms(:) ! @@ -6969,7 +6969,7 @@ subroutine clima(lugb,iy,im,id,ih,fh,len,lsoil,slmskl,slmskw, & &, gaus, blno, blto, me,lprnt,iprnt, fnalbc2, ialb & &, tile_num_ch, i_index, j_index) ! - use machine , only : kind_io8,kind_io4 + use machine , only : kind_io8,kind_io4, kind_dbl_prec implicit none character(len=*), intent(in) :: tile_num_ch integer, intent(in) :: i_index(len), j_index(len) @@ -7029,7 +7029,7 @@ subroutine clima(lugb,iy,im,id,ih,fh,len,lsoil,slmskl,slmskw, & data dayhf/ 15.5, 45.0, 74.5,105.0,135.5,166.0, & 196.5,227.5,258.0,288.5,319.0,349.5,380.5/ ! - real (kind=kind_io8) fha(5) + real (kind=kind_dbl_prec) fha(5) integer ida(8),jda(8),ivtyp, kpd7 ! real (kind=kind_io8), allocatable :: tsf(:,:),sno(:,:), @@ -8296,7 +8296,7 @@ subroutine fixrdc(lugb,fngrib,kpds5,kpds7,mon,slmask, & ! real (kind=kind_io8) gdata(len), slmask(len) real (kind=kind_io8), allocatable :: data(:,:), rslmsk(:,:) - real (kind=kind_io8), allocatable :: data8(:) + real (kind=kind_dbl_prec), allocatable :: data8(:) real (kind=kind_io8), allocatable :: rlngrb(:), rltgrb(:) ! logical lmask, yr2kc, gaus, ijordr @@ -8471,7 +8471,7 @@ subroutine fixrda(lugb,fngrib,kpds5,slmask, & ! real (kind=kind_io8) gdata(len), slmask(len) real (kind=kind_io8), allocatable :: data(:,:),rslmsk(:,:) - real (kind=kind_io8), allocatable :: data8(:) + real (kind=kind_dbl_prec), allocatable :: data8(:) real (kind=kind_io8), allocatable :: rlngrb(:), rltgrb(:) ! logical lmask, yr2kc, gaus, ijordr @@ -8492,7 +8492,7 @@ subroutine fixrda(lugb,fngrib,kpds5,slmask, & integer mjday(12) data mjday/31,28,31,30,31,30,31,31,30,31,30,31/ ! - real (kind=kind_io8) fha(5) + real (kind=kind_dbl_prec) fha(5) integer ida(8),jda(8) ! allocate(data8(1:mdata)) From 696c0ea32d86259836016977621d05c316db0d73 Mon Sep 17 00:00:00 2001 From: Dusan Jovic Date: Wed, 20 Jul 2022 11:48:43 -0500 Subject: [PATCH 03/11] More argument mismatch fixes --- physics/GFS_time_vary_pre.fv3.F90 | 18 +++--------------- physics/GFS_time_vary_pre.scm.F90 | 18 +++--------------- 2 files changed, 6 insertions(+), 30 deletions(-) diff --git a/physics/GFS_time_vary_pre.fv3.F90 b/physics/GFS_time_vary_pre.fv3.F90 index 86dfe3f40..ba661f578 100644 --- a/physics/GFS_time_vary_pre.fv3.F90 +++ b/physics/GFS_time_vary_pre.fv3.F90 @@ -92,10 +92,8 @@ subroutine GFS_time_vary_pre_timestep_init (jdat, idat, dtp, nsswr, real(kind=kind_phys), parameter :: con_24 = 24.0_kind_phys real(kind=kind_phys), parameter :: con_hr = 3600.0_kind_phys - real(kind=kind_sngl_prec) :: rinc4(5) real(kind=kind_dbl_prec) :: rinc8(5) - integer :: w3kindreal,w3kindint integer :: iw3jdn integer :: jd0, jd1 real :: fjd @@ -113,19 +111,9 @@ subroutine GFS_time_vary_pre_timestep_init (jdat, idat, dtp, nsswr, !--- jdat is being updated directly inside of FV3GFS_cap.F90 !--- update calendars and triggers - call w3kind(w3kindreal,w3kindint) - if (w3kindreal == 8) then - rinc8(1:5) = 0 - call w3difdat(jdat,idat,4,rinc8) - sec = rinc8(4) - else if (w3kindreal == 4) then - rinc4(1:5) = 0 - call w3difdat(jdat,idat,4,rinc4) - sec = rinc4(4) - else - write(0,*)' FATAL ERROR: Invalid w3kindreal' - call abort - endif + rinc8(1:5) = 0 + call w3difdat(jdat,idat,4,rinc8) + sec = rinc8(4) phour = sec/con_hr !--- set current bucket hour zhour = phour diff --git a/physics/GFS_time_vary_pre.scm.F90 b/physics/GFS_time_vary_pre.scm.F90 index 2bb6b3ceb..3293e09e4 100644 --- a/physics/GFS_time_vary_pre.scm.F90 +++ b/physics/GFS_time_vary_pre.scm.F90 @@ -91,10 +91,8 @@ subroutine GFS_time_vary_pre_timestep_init (jdat, idat, dtp, nsswr, & real(kind=kind_phys), parameter :: con_24 = 24.0_kind_phys real(kind=kind_phys), parameter :: con_hr = 3600.0_kind_phys - real(kind=kind_sngl_prec) :: rinc4(5) real(kind=kind_dbl_prec) :: rinc8(5) - integer :: w3kindreal,w3kindint integer :: iw3jdn integer :: jd0, jd1 real :: fjd @@ -114,19 +112,9 @@ subroutine GFS_time_vary_pre_timestep_init (jdat, idat, dtp, nsswr, & !--- jdat is being updated directly inside of the time integration !--- loop of scm.F90 !--- update calendars and triggers - call w3kind(w3kindreal,w3kindint) - if (w3kindreal == 8) then - rinc8(1:5) = 0 - call w3difdat(jdat,idat,4,rinc8) - sec = rinc8(4) - else if (w3kindreal == 4) then - rinc4(1:5) = 0 - call w3difdat(jdat,idat,4,rinc4) - sec = rina4c(4) - else - write(0,*)' FATAL ERROR: Invalid w3kindreal' - call abort - endif + rinc8(1:5) = 0 + call w3difdat(jdat,idat,4,rinc8) + sec = rinc8(4) phour = sec/con_hr !--- set current bucket hour zhour = phour From 92b8c857bd211770e53b2b3b80ecdf5115ba7e57 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Mon, 7 Nov 2022 11:35:12 -0700 Subject: [PATCH 04/11] If MPI is used, find package --- CMakeLists.txt | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/CMakeLists.txt b/CMakeLists.txt index d14778b06..4de7aa24e 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -8,6 +8,12 @@ project(ccpp_physics set(PACKAGE "ccpp-physics") set(AUTHORS "Grant Firl" "Dom Heinzeller" "Man Zhang" "Mike Kavulich" "Chunxi Zhang") +#------------------------------------------------------------------------------ +# Set MPI flags for C/C++/Fortran +if (MPI) + find_package(MPI REQUIRED C Fortran) +endif (OPENMP) + #------------------------------------------------------------------------------ # Set OpenMP flags for C/C++/Fortran if (OPENMP) From f943d204fa9bb2200ce8b5ae545919c62c003664 Mon Sep 17 00:00:00 2001 From: Dusan Jovic Date: Fri, 18 Nov 2022 20:59:10 +0000 Subject: [PATCH 05/11] Fixed cmake if/endif mismatch --- CMakeLists.txt | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index 4de7aa24e..8a88fadac 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -12,7 +12,7 @@ set(AUTHORS "Grant Firl" "Dom Heinzeller" "Man Zhang" "Mike Kavulich" "Chunxi Zh # Set MPI flags for C/C++/Fortran if (MPI) find_package(MPI REQUIRED C Fortran) -endif (OPENMP) +endif() #------------------------------------------------------------------------------ # Set OpenMP flags for C/C++/Fortran From 347d74520d1bb8312ad4cceba1ec6c6038b8c650 Mon Sep 17 00:00:00 2001 From: Dusan Jovic Date: Thu, 16 Mar 2023 17:46:04 +0000 Subject: [PATCH 06/11] Use mpi_f08 in rrtmgp_lw_main and rrtmgp_sw_main --- physics/rrtmgp_lw_main.F90 | 4 +++- physics/rrtmgp_lw_main.meta | 4 ++-- physics/rrtmgp_sw_main.F90 | 4 +++- physics/rrtmgp_sw_main.meta | 2 +- 4 files changed, 9 insertions(+), 5 deletions(-) diff --git a/physics/rrtmgp_lw_main.F90 b/physics/rrtmgp_lw_main.F90 index c0bc99d35..f3a2f5ba6 100644 --- a/physics/rrtmgp_lw_main.F90 +++ b/physics/rrtmgp_lw_main.F90 @@ -7,6 +7,7 @@ !! ! ########################################################################################### module rrtmgp_lw_main + use mpi_f08 use machine, only: kind_phys, kind_dbl_prec use mo_optical_props, only: ty_optical_props_1scl, ty_optical_props_2str use mo_cloud_optics, only: ty_cloud_optics @@ -68,8 +69,9 @@ subroutine rrtmgp_lw_main_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, rrtmgp_lw_fi doGP_sgs_cnv ! Flag to include sgs convective clouds integer, intent(inout) :: & nrghice ! Number of ice-roughness categories + type(MPI_Comm),intent(in) :: & + mpicomm ! MPI communicator integer,intent(in) :: & - mpicomm, & ! MPI communicator mpirank, & ! Current MPI rank mpiroot, & ! Master MPI rank rrtmgp_phys_blksz, & ! Number of horizontal points to process at once. diff --git a/physics/rrtmgp_lw_main.meta b/physics/rrtmgp_lw_main.meta index fd96eb14b..ebff48750 100644 --- a/physics/rrtmgp_lw_main.meta +++ b/physics/rrtmgp_lw_main.meta @@ -90,7 +90,7 @@ long_name = MPI communicator units = index dimensions = () - type = integer + type = MPI_Comm intent = in [rrtmgp_phys_blksz] standard_name = number_of_columns_per_RRTMGP_LW_block @@ -638,4 +638,4 @@ units = 1 dimensions = () type = integer - intent = out \ No newline at end of file + intent = out diff --git a/physics/rrtmgp_sw_main.F90 b/physics/rrtmgp_sw_main.F90 index b25e093e7..b1a8e7cc4 100644 --- a/physics/rrtmgp_sw_main.F90 +++ b/physics/rrtmgp_sw_main.F90 @@ -1,6 +1,7 @@ ! ########################################################################################### ! ########################################################################################### module rrtmgp_sw_main + use mpi_f08 use machine, only: kind_phys, kind_dbl_prec use mo_optical_props, only: ty_optical_props_2str use mo_cloud_optics, only: ty_cloud_optics @@ -55,8 +56,9 @@ subroutine rrtmgp_sw_main_init(rrtmgp_root_dir, rrtmgp_sw_file_gas, rrtmgp_sw_fi doGP_sgs_cnv ! Flag to include sgs convective clouds integer, intent(inout) :: & nrghice ! Number of ice-roughness categories + type(MPI_Comm),intent(in) :: & + mpicomm ! MPI communicator integer,intent(in) :: & - mpicomm, & ! MPI communicator mpirank, & ! Current MPI rank mpiroot, & ! Master MPI rank rrtmgp_phys_blksz, & ! Number of horizontal points to process at once. diff --git a/physics/rrtmgp_sw_main.meta b/physics/rrtmgp_sw_main.meta index dbb93a5df..c2b6555b5 100644 --- a/physics/rrtmgp_sw_main.meta +++ b/physics/rrtmgp_sw_main.meta @@ -104,7 +104,7 @@ long_name = MPI communicator units = index dimensions = () - type = integer + type = MPI_Comm intent = in [active_gases_array] standard_name = list_of_active_gases_used_by_RRTMGP From 360a612a4ff606096acb32c09c3e7276c4075224 Mon Sep 17 00:00:00 2001 From: Dusan Jovic Date: Fri, 3 Nov 2023 13:48:20 -0500 Subject: [PATCH 07/11] Update GFS_phys_time_vary.fv3.F90 to compile without '-fallow-argument-mismatch' --- physics/GFS_phys_time_vary.fv3.F90 | 11 ++--------- 1 file changed, 2 insertions(+), 9 deletions(-) diff --git a/physics/GFS_phys_time_vary.fv3.F90 b/physics/GFS_phys_time_vary.fv3.F90 index 4b6909f74..2d0b35d79 100644 --- a/physics/GFS_phys_time_vary.fv3.F90 +++ b/physics/GFS_phys_time_vary.fv3.F90 @@ -830,7 +830,6 @@ subroutine GFS_phys_time_vary_timestep_init ( real(kind_phys) :: rannie(cny) real(kind_phys) :: rndval(cnx*cny*nrcm) real(kind_dbl_prec) :: rinc(5) - real(kind_sngl_prec) :: rinc4(5) ! Initialize CCPP error handling variables errmsg = '' @@ -850,7 +849,7 @@ subroutine GFS_phys_time_vary_timestep_init ( !$OMP shared(ozpl,ddy_o3,h2o_phys,jindx1_h,jindx2_h,h2opl,ddy_h,iaerclm,master) & !$OMP shared(levs,prsl,iccn,jindx1_ci,jindx2_ci,ddy_ci,iindx1_ci,iindx2_ci) & !$OMP shared(ddx_ci,in_nm,ccn_nm,do_ugwp_v1,jindx1_tau,jindx2_tau,ddy_j1tau) & -!$OMP shared(ddy_j2tau,tau_amf,iflip,ozphys,rjday,n1,n2,idat,jdat,rinc,rinc4) & +!$OMP shared(ddy_j2tau,tau_amf,iflip,ozphys,rjday,n1,n2,idat,jdat,rinc) & !$OMP shared(w3kindreal,w3kindint,jdow,jdoy,jday) & !$OMP private(iseed,iskip,i,j,k) @@ -910,13 +909,7 @@ subroutine GFS_phys_time_vary_timestep_init ( idat(5)=idate(1) rinc=0. rinc(2)=fhour - call w3kind(w3kindreal,w3kindint) - if(w3kindreal==4) then - rinc4=rinc - CALL w3movdat(rinc4,idat,jdat) - else - CALL w3movdat(rinc,idat,jdat) - endif + CALL w3movdat(rinc,idat,jdat) jdow = 0 jdoy = 0 jday = 0 From bac19946862a08b453e94678727c868f1b60c450 Mon Sep 17 00:00:00 2001 From: Dusan Jovic Date: Wed, 7 Feb 2024 16:47:36 +0000 Subject: [PATCH 08/11] Change the type of mpi communicator in few more files --- physics/MP/Ferrier_Aligo/mp_fer_hires.F90 | 3 ++- physics/MP/NSSL/mp_nssl.F90 | 4 ++-- physics/MP/NSSL/mp_nssl.meta | 2 +- physics/smoke_dust/rrfs_smoke_wrapper.F90 | 3 ++- physics/smoke_dust/rrfs_smoke_wrapper.meta | 2 +- 5 files changed, 8 insertions(+), 6 deletions(-) diff --git a/physics/MP/Ferrier_Aligo/mp_fer_hires.F90 b/physics/MP/Ferrier_Aligo/mp_fer_hires.F90 index 938beae5d..47e80e9d9 100644 --- a/physics/MP/Ferrier_Aligo/mp_fer_hires.F90 +++ b/physics/MP/Ferrier_Aligo/mp_fer_hires.F90 @@ -36,6 +36,7 @@ subroutine mp_fer_hires_init(ncol, nlev, dtp, imp_physics, & mpicomm, mpirank,mpiroot, & threads, errmsg, errflg) + USE mpi_f08 USE machine, ONLY : kind_phys USE MODULE_MP_FER_HIRES, ONLY : FERRIER_INIT_HR implicit none @@ -45,7 +46,7 @@ subroutine mp_fer_hires_init(ncol, nlev, dtp, imp_physics, & real(kind_phys), intent(in) :: dtp integer, intent(in) :: imp_physics integer, intent(in) :: imp_physics_fer_hires - integer, intent(in) :: mpicomm + type(MPI_Comm), intent(in) :: mpicomm integer, intent(in) :: mpirank integer, intent(in) :: mpiroot integer, intent(in) :: threads diff --git a/physics/MP/NSSL/mp_nssl.F90 b/physics/MP/NSSL/mp_nssl.F90 index 0b111f7cd..5c47bce73 100644 --- a/physics/MP/NSSL/mp_nssl.F90 +++ b/physics/MP/NSSL/mp_nssl.F90 @@ -40,7 +40,7 @@ subroutine mp_nssl_init(ncol, nlev, errflg, errmsg, threads, restart, & use module_mp_nssl_2mom, only: nssl_2mom_init, nssl_2mom_init_const #ifdef MPI - use mpi + use mpi_f08 #endif implicit none @@ -56,7 +56,7 @@ subroutine mp_nssl_init(ncol, nlev, errflg, errmsg, threads, restart, & integer, intent(in) :: mpirank integer, intent(in) :: mpiroot - integer, intent(in) :: mpicomm + type(MPI_Comm), intent(in) :: mpicomm integer, intent(in) :: imp_physics integer, intent(in) :: imp_physics_nssl real(kind_phys), intent(in) :: nssl_cccn, nssl_alphah, nssl_alphahl diff --git a/physics/MP/NSSL/mp_nssl.meta b/physics/MP/NSSL/mp_nssl.meta index 8449f26cf..deb96569d 100644 --- a/physics/MP/NSSL/mp_nssl.meta +++ b/physics/MP/NSSL/mp_nssl.meta @@ -68,7 +68,7 @@ long_name = MPI communicator units = index dimensions = () - type = integer + type = MPI_Comm intent = in [qc] standard_name = cloud_liquid_water_mixing_ratio diff --git a/physics/smoke_dust/rrfs_smoke_wrapper.F90 b/physics/smoke_dust/rrfs_smoke_wrapper.F90 index 3842cba54..0ac285b23 100755 --- a/physics/smoke_dust/rrfs_smoke_wrapper.F90 +++ b/physics/smoke_dust/rrfs_smoke_wrapper.F90 @@ -4,6 +4,7 @@ module rrfs_smoke_wrapper + use mpi_f90 use machine , only : kind_phys use rrfs_smoke_config, only : kemit, dust_opt, seas_opt, do_plumerise, & addsmoke_flag, plumerisefire_frq, wetdep_ls_opt, & @@ -225,7 +226,7 @@ subroutine rrfs_smoke_wrapper_run(im, kte, kme, ktau, dt, garea, land, jdate, integer :: i, j, k, kp, n ! MPI variables integer :: mpiid - integer, intent(in) :: mpicomm + type(MPI_comm), intent(in) :: mpicomm integer, intent(in) :: mpirank integer, intent(in) :: mpiroot diff --git a/physics/smoke_dust/rrfs_smoke_wrapper.meta b/physics/smoke_dust/rrfs_smoke_wrapper.meta index 271d2dd36..1f26e5a93 100755 --- a/physics/smoke_dust/rrfs_smoke_wrapper.meta +++ b/physics/smoke_dust/rrfs_smoke_wrapper.meta @@ -774,7 +774,7 @@ long_name = MPI communicator units = index dimensions = () - type = integer + type = MPI_Comm intent = in [mpirank] standard_name = mpi_rank From 8c68c2f9b63ae1456678cf31a74fe0005a8bcb7c Mon Sep 17 00:00:00 2001 From: Dusan Jovic Date: Wed, 7 Feb 2024 14:52:01 -0600 Subject: [PATCH 09/11] Fix mpi use statement --- physics/smoke_dust/rrfs_smoke_wrapper.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/smoke_dust/rrfs_smoke_wrapper.F90 b/physics/smoke_dust/rrfs_smoke_wrapper.F90 index 0ac285b23..37ffccb35 100755 --- a/physics/smoke_dust/rrfs_smoke_wrapper.F90 +++ b/physics/smoke_dust/rrfs_smoke_wrapper.F90 @@ -4,7 +4,7 @@ module rrfs_smoke_wrapper - use mpi_f90 + use mpi_f08 use machine , only : kind_phys use rrfs_smoke_config, only : kemit, dust_opt, seas_opt, do_plumerise, & addsmoke_flag, plumerisefire_frq, wetdep_ls_opt, & From bb9b90fefdadb82a97d68e9fee2c6d7326e6020f Mon Sep 17 00:00:00 2001 From: Dusan Jovic Date: Mon, 26 Feb 2024 13:44:20 +0000 Subject: [PATCH 10/11] Update MPI find_package and check if MPI F08 module is supported --- CMakeLists.txt | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index d0d265437..b8cf73f7c 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -1,4 +1,4 @@ -cmake_minimum_required(VERSION 3.3) +cmake_minimum_required(VERSION 3.10) project(ccpp_physics VERSION 5.0.0 @@ -9,9 +9,10 @@ set(PACKAGE "ccpp-physics") set(AUTHORS "Grant Firl" "Dustin Swales" "Man Zhang" "Mike Kavulich" ) #------------------------------------------------------------------------------ -# Set MPI flags for C/C++/Fortran -if (MPI) - find_package(MPI REQUIRED C Fortran) +# Set MPI flags for C/C++/Fortran with MPI F08 interface +find_package(MPI REQUIRED C Fortran) +if(NOT MPI_Fortran_HAVE_F08_MODULE) + message(FATAL_ERROR "MPI implementation does not support the Fortran 2008 mpi_f08 interface") endif() #------------------------------------------------------------------------------ From 0cb5d97355d347f5448568bba1b64409f6e1ddf5 Mon Sep 17 00:00:00 2001 From: Dusan Jovic Date: Tue, 27 Feb 2024 00:01:41 +0000 Subject: [PATCH 11/11] Remove C from MPI find_package --- CMakeLists.txt | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index b8cf73f7c..c56070123 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -9,8 +9,8 @@ set(PACKAGE "ccpp-physics") set(AUTHORS "Grant Firl" "Dustin Swales" "Man Zhang" "Mike Kavulich" ) #------------------------------------------------------------------------------ -# Set MPI flags for C/C++/Fortran with MPI F08 interface -find_package(MPI REQUIRED C Fortran) +# Set MPI flags for Fortran with MPI F08 interface +find_package(MPI REQUIRED Fortran) if(NOT MPI_Fortran_HAVE_F08_MODULE) message(FATAL_ERROR "MPI implementation does not support the Fortran 2008 mpi_f08 interface") endif()