diff --git a/CMakeLists.txt b/CMakeLists.txt index ee708d4c4..c56070123 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 @@ -8,6 +8,13 @@ project(ccpp_physics set(PACKAGE "ccpp-physics") set(AUTHORS "Grant Firl" "Dustin Swales" "Man Zhang" "Mike Kavulich" ) +#------------------------------------------------------------------------------ +# 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() + #------------------------------------------------------------------------------ # Set OpenMP flags for C/C++/Fortran if (OPENMP) diff --git a/physics/GWD/cires_tauamf_data.F90 b/physics/GWD/cires_tauamf_data.F90 index 77c74b1a9..4f12b2ec1 100644 --- a/physics/GWD/cires_tauamf_data.F90 +++ b/physics/GWD/cires_tauamf_data.F90 @@ -180,7 +180,6 @@ subroutine gfs_idate_calendar(idate, fhour, ddd, fddd) integer :: jdow, jdoy, jday real(8) :: rinc(5) real(4) :: rinc4(5) - integer :: w3kindreal, w3kindint integer :: iw3jdn integer :: jd1, jddd @@ -196,13 +195,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/Interstitials/UFS_SCM_NEPTUNE/GFS_debug.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_debug.F90 index ed26b795f..8313368fc 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_debug.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_debug.F90 @@ -385,7 +385,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 @@ -1055,7 +1055,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/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.fv3.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.fv3.F90 index f53ab3928..406887f00 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.fv3.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.fv3.F90 @@ -793,7 +793,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 = '' @@ -813,7 +812,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) @@ -873,13 +872,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 diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_pre.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_pre.F90 index 5da5c86fb..767d3e534 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_pre.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_pre.F90 @@ -19,7 +19,7 @@ module GFS_rrtmg_pre !>\section rrtmg_pre_gen General Algorithm subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, lextop,& ltp, imfdeepcnv, imfdeepcnv_gf, imfdeepcnv_c3, me, ncnd, ntrac, & - num_p3d, npdf3d, & + num_p3d, npdf3d, xr_cnvcld, & ncnvcld3d,ntqv, ntcw,ntiw, ntlnc, ntinc, ntrnc, ntsnc, ntccn, top_at_1,& ntrw, ntsw, ntgl, nthl, ntwa, ntoz, ntsmoke, ntdust, ntcoarsepm, & ntclamt, nleffr, nieffr, nseffr, lndp_type, kdt, & @@ -129,7 +129,7 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, lextop,& uni_cld, effr_in, do_mynnedmf, & lmfshal, lmfdeep2, pert_clds, lcrick,& lcnorm, top_at_1, lextop, mraerosol - logical, intent(in) :: rrfs_sd, aero_dir_fdb + logical, intent(in) :: rrfs_sd, aero_dir_fdb, xr_cnvcld logical, intent(in) :: nssl_ccn_on, nssl_invertccn integer, intent(in) :: spp_rad @@ -981,7 +981,7 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, lextop,& & iovr_dcorr, iovr_exp, iovr_exprand, idcor, idcor_con, & & idcor_hogan, idcor_oreopoulos, lcrick, lcnorm, & & imfdeepcnv, imfdeepcnv_gf, imfdeepcnv_c3, do_mynnedmf, & - & lgfdlmprad, & + & lgfdlmprad, xr_cnvcld, & & uni_cld, lmfshal, lmfdeep2, cldcov, clouds1, & & effrl, effri, effrr, effrs, effr_in, & & effrl_inout, effri_inout, effrs_inout, & diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_pre.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_pre.meta index 43802298b..15039e822 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_pre.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_pre.meta @@ -56,6 +56,13 @@ dimensions = () type = logical intent = in +[xr_cnvcld] + standard_name = flag_for_suspended_convective_clouds_in_Xu_Randall + long_name = flag for using suspended convective clouds in Xu Randall + units = flag + dimensions = () + type = logical + intent = in [ltp] standard_name = extra_top_layer long_name = extra top layer for radiation diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_time_vary_pre.fv3.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_time_vary_pre.fv3.F90 index 5a678a820..6a556a88d 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_time_vary_pre.fv3.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_time_vary_pre.fv3.F90 @@ -94,10 +94,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 @@ -115,19 +113,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/Interstitials/UFS_SCM_NEPTUNE/GFS_time_vary_pre.scm.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_time_vary_pre.scm.F90 index 17cf09ca9..3293e09e4 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_time_vary_pre.scm.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/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 = 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/Interstitials/UFS_SCM_NEPTUNE/iccninterp.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/iccninterp.F90 index c08b5c5e5..dd752d9b8 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/iccninterp.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/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 @@ -128,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 @@ -144,10 +145,8 @@ 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 - real(8) RINC(5) - real(4) rinc4(5) - integer w3kindreal,w3kindint ! IDAT=0 IDAT(1)=IDATE(4) @@ -156,13 +155,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/Interstitials/UFS_SCM_NEPTUNE/maximum_hourly_diagnostics.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/maximum_hourly_diagnostics.F90 index cd1016053..5ac28afe8 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/maximum_hourly_diagnostics.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/maximum_hourly_diagnostics.F90 @@ -15,6 +15,9 @@ module maximum_hourly_diagnostics real(kind=kind_phys), parameter ::PQ0=379.90516E0, A2A=17.2693882, A3=273.16, A4=35.86, RHmin=1.0E-6 ! *DH + ! Conversion from flashes per five minutes to flashes per minute. + real(kind=kind_phys), parameter :: scaling_factor = 0.2 + contains #if 0 @@ -195,7 +198,10 @@ subroutine lightning_threat_indices endif IF ( ltg1 .LT. clim1 ) ltg1 = 0. - + + ! Scale to flashes per minue + ltg1 = ltg1 * scaling_factor + IF ( ltg1 .GT. ltg1_max(i) ) THEN ltg1_max(i) = ltg1 ENDIF @@ -208,14 +214,19 @@ subroutine lightning_threat_indices ltg2 = coef2 * totice_colint(i) IF ( ltg2 .LT. clim2 ) ltg2 = 0. + + ! Scale to flashes per minute + ltg2 = ltg2 * scaling_factor IF ( ltg2 .GT. ltg2_max(i) ) THEN ltg2_max(i) = ltg2 ENDIF + ! This calculation is already in flashes per minute. ltg3_max(i) = 0.95 * ltg1_max(i) + 0.05 * ltg2_max(i) - IF ( ltg3_max(i) .LT. clim3 ) ltg3_max(i) = 0. + ! Thus, we must scale clim3. The compiler will optimize this away. + IF ( ltg3_max(i) .LT. clim3 * scaling_factor ) ltg3_max(i) = 0. enddo end subroutine lightning_threat_indices diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/maximum_hourly_diagnostics.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/maximum_hourly_diagnostics.meta index 0c2d1bcbe..5d18bd9bd 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/maximum_hourly_diagnostics.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/maximum_hourly_diagnostics.meta @@ -296,7 +296,7 @@ [ltg1_max] standard_name = lightning_threat_index_1 long_name = lightning threat index 1 - units = flashes 5 min-1 + units = flashes min-1 dimensions = (horizontal_loop_extent) type = real kind = kind_phys @@ -304,7 +304,7 @@ [ltg2_max] standard_name = lightning_threat_index_2 long_name = lightning threat index 2 - units = flashes 5 min-1 + units = flashes min-1 dimensions = (horizontal_loop_extent) type = real kind = kind_phys @@ -312,7 +312,7 @@ [ltg3_max] standard_name = lightning_threat_index_3 long_name = lightning threat index 3 - units = flashes 5 min-1 + units = flashes min-1 dimensions = (horizontal_loop_extent) type = real kind = kind_phys diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/sfcsub.F b/physics/Interstitials/UFS_SCM_NEPTUNE/sfcsub.F index 494b8f7dc..369a94358 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/sfcsub.F +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/sfcsub.F @@ -2805,7 +2805,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 ! @@ -2813,7 +2813,6 @@ subroutine fixrdg(lugb,idim,jdim,fngrib, & logical gaus real (kind=kind_io8) blno,blto real (kind=kind_dbl_prec), allocatable :: data8(:) - real (kind=kind_sngl_prec), allocatable :: data4(:) ! logical*1, allocatable :: lbms(:) ! @@ -2872,20 +2871,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(1:ndata) = real(data4(1:ndata), kind=kind_dbl_prec) - deallocate(data4) - else - write(0,*)' FATAL ERROR: Invalid w3kindreal' - call abort - endif ! if(jret == 0) then if(ndata.eq.0) then @@ -7081,7 +7068,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) @@ -7141,9 +7128,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(8) fha(5) - real(4) fha4(5) - integer w3kindreal,w3kindint + real (kind=kind_dbl_prec) fha(5) integer ida(8),jda(8),ivtyp, kpd7 ! real (kind=kind_io8), allocatable :: tsf(:,:),sno(:,:), @@ -7235,13 +7220,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) @@ -7311,13 +7290,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) @@ -8440,7 +8413,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 ! ! @@ -8452,7 +8425,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_dbl_prec), allocatable :: data8(:) - real (kind=kind_sngl_prec), allocatable :: data4(:) real (kind=kind_io8), allocatable :: rlngrb(:), rltgrb(:) ! logical lmask, yr2kc, gaus, ijordr @@ -8520,17 +8492,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(1:ndata) = real(data4(1:ndata), kind=kind_dbl_prec) - 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 @@ -8615,7 +8578,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 ! @@ -8637,7 +8600,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_dbl_prec), allocatable :: data8(:) - real (kind=kind_sngl_prec), allocatable :: data4(:) real (kind=kind_io8), allocatable :: rlngrb(:), rltgrb(:) ! logical lmask, yr2kc, gaus, ijordr @@ -8658,8 +8620,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(8) fha(5) - real(4) fha4(5) + real (kind=kind_dbl_prec) fha(5) integer ida(8),jda(8) ! allocate(data8(1:mdata)) @@ -8678,13 +8639,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) @@ -8767,17 +8722,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(1:ndata) = real(data4(1:ndata), kind=kind_dbl_prec) - 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 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/Ferrier_Aligo/mp_fer_hires.meta b/physics/MP/Ferrier_Aligo/mp_fer_hires.meta index 0f7be213e..e6d2afc5b 100644 --- a/physics/MP/Ferrier_Aligo/mp_fer_hires.meta +++ b/physics/MP/Ferrier_Aligo/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/Morrison_Gettelman/aerinterp.F90 b/physics/MP/Morrison_Gettelman/aerinterp.F90 index fcfe29607..174a1a1a1 100644 --- a/physics/MP/Morrison_Gettelman/aerinterp.F90 +++ b/physics/MP/Morrison_Gettelman/aerinterp.F90 @@ -152,7 +152,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 @@ -165,10 +165,8 @@ 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 - real(4) rinc4(5) - integer w3kindreal,w3kindint integer, allocatable :: invardims(:) ! @@ -186,13 +184,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 @@ -282,7 +274,7 @@ END SUBROUTINE setindxaer SUBROUTINE aerinterpol( me,master,nthrds,npts,IDATE,FHOUR,iflip, jindx1,jindx2, & ddy,iindx1,iindx2,ddx,lev,prsl,aerout, errmsg,errflg) ! - use machine, only: kind_phys, kind_io4, kind_io8 + use machine, only: kind_phys, kind_dbl_prec use aerclm_def implicit none @@ -304,11 +296,8 @@ 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 - real(8) RINC(5) - real(4) rinc4(5) - integer w3kindreal,w3kindint - ! errflg = 0 errmsg = ' ' @@ -319,13 +308,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 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/MP/Thompson/module_mp_thompson.F90 b/physics/MP/Thompson/module_mp_thompson.F90 index 44e552160..62e2688c7 100644 --- a/physics/MP/Thompson/module_mp_thompson.F90 +++ b/physics/MP/Thompson/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 @@ -421,7 +421,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 @@ -448,7 +448,8 @@ SUBROUTINE thompson_init(is_aerosol_aware_in, & LOGICAL, INTENT(IN) :: is_aerosol_aware_in LOGICAL, INTENT(IN) :: merra2_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 @@ -1888,7 +1889,7 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & pfil1, pfll1) #ifdef MPI - use mpi + use mpi_f08 #endif implicit none diff --git a/physics/MP/Thompson/mp_thompson.F90 b/physics/MP/Thompson/mp_thompson.F90 index 7b5b83b37..120ca30a7 100644 --- a/physics/MP/Thompson/mp_thompson.F90 +++ b/physics/MP/Thompson/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 @@ -75,7 +76,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 @@ -394,7 +395,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/mp_thompson.meta b/physics/MP/Thompson/mp_thompson.meta index ffe34bafb..a9bf02210 100644 --- a/physics/MP/Thompson/mp_thompson.meta +++ b/physics/MP/Thompson/mp_thompson.meta @@ -238,7 +238,7 @@ long_name = MPI communicator units = index dimensions = () - type = integer + type = MPI_Comm intent = in [mpirank] standard_name = mpi_rank @@ -647,7 +647,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/mp_thompson_post.F90 b/physics/MP/Thompson/mp_thompson_post.F90 index 392f734a5..c48c932f7 100644 --- a/physics/MP/Thompson/mp_thompson_post.F90 +++ b/physics/MP/Thompson/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/mp_thompson_post.meta b/physics/MP/Thompson/mp_thompson_post.meta index 43e89b29c..85704316f 100644 --- a/physics/MP/Thompson/mp_thompson_post.meta +++ b/physics/MP/Thompson/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/Radiation/RRTMGP/rrtmgp_lw_cloud_optics.F90 b/physics/Radiation/RRTMGP/rrtmgp_lw_cloud_optics.F90 index 9915c0040..059086a97 100644 --- a/physics/Radiation/RRTMGP/rrtmgp_lw_cloud_optics.F90 +++ b/physics/Radiation/RRTMGP/rrtmgp_lw_cloud_optics.F90 @@ -16,7 +16,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 @@ -89,8 +89,9 @@ subroutine rrtmgp_lw_cloud_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_clouds, 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 diff --git a/physics/Radiation/RRTMGP/rrtmgp_lw_gas_optics.F90 b/physics/Radiation/RRTMGP/rrtmgp_lw_gas_optics.F90 index 8cd38f210..7cf80e3f3 100644 --- a/physics/Radiation/RRTMGP/rrtmgp_lw_gas_optics.F90 +++ b/physics/Radiation/RRTMGP/rrtmgp_lw_gas_optics.F90 @@ -15,7 +15,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 @@ -87,8 +87,9 @@ subroutine rrtmgp_lw_gas_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, rrtmgp_lw_file_gas ! RRTMGP file containing K-distribution data character(len=*), dimension(:), intent(in) :: & active_gases_array ! List of active gases from namelist as array + 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/Radiation/RRTMGP/rrtmgp_lw_main.F90 b/physics/Radiation/RRTMGP/rrtmgp_lw_main.F90 index 01b25c925..c471f89c5 100644 --- a/physics/Radiation/RRTMGP/rrtmgp_lw_main.F90 +++ b/physics/Radiation/RRTMGP/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 @@ -60,8 +61,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/Radiation/RRTMGP/rrtmgp_lw_main.meta b/physics/Radiation/RRTMGP/rrtmgp_lw_main.meta index 572e67d94..d71e37592 100644 --- a/physics/Radiation/RRTMGP/rrtmgp_lw_main.meta +++ b/physics/Radiation/RRTMGP/rrtmgp_lw_main.meta @@ -91,7 +91,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 diff --git a/physics/Radiation/RRTMGP/rrtmgp_sw_cloud_optics.F90 b/physics/Radiation/RRTMGP/rrtmgp_sw_cloud_optics.F90 index 4293a7be6..552fda295 100644 --- a/physics/Radiation/RRTMGP/rrtmgp_sw_cloud_optics.F90 +++ b/physics/Radiation/RRTMGP/rrtmgp_sw_cloud_optics.F90 @@ -6,7 +6,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 @@ -79,8 +79,9 @@ subroutine rrtmgp_sw_cloud_optics_init( rrtmgp_root_dir, rrtmgp_sw_file_clouds, 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 diff --git a/physics/Radiation/RRTMGP/rrtmgp_sw_gas_optics.F90 b/physics/Radiation/RRTMGP/rrtmgp_sw_gas_optics.F90 index f62a75e4b..5713d188d 100644 --- a/physics/Radiation/RRTMGP/rrtmgp_sw_gas_optics.F90 +++ b/physics/Radiation/RRTMGP/rrtmgp_sw_gas_optics.F90 @@ -13,7 +13,7 @@ module rrtmgp_sw_gas_optics use radiation_tools, only: check_error_msg use netcdf #ifdef MPI - use mpi + use mpi_f08 #endif implicit none @@ -105,8 +105,9 @@ subroutine rrtmgp_sw_gas_optics_init(rrtmgp_root_dir, rrtmgp_sw_file_gas, rrtmgp_sw_file_gas ! RRTMGP file containing K-distribution data character(len=*), dimension(:), intent(in) :: & active_gases_array ! List of active gases from namelist as array + 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/Radiation/RRTMGP/rrtmgp_sw_main.F90 b/physics/Radiation/RRTMGP/rrtmgp_sw_main.F90 index 124532b03..b350334a3 100644 --- a/physics/Radiation/RRTMGP/rrtmgp_sw_main.F90 +++ b/physics/Radiation/RRTMGP/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 @@ -49,8 +50,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/Radiation/RRTMGP/rrtmgp_sw_main.meta b/physics/Radiation/RRTMGP/rrtmgp_sw_main.meta index 711d01bc1..68e84b924 100644 --- a/physics/Radiation/RRTMGP/rrtmgp_sw_main.meta +++ b/physics/Radiation/RRTMGP/rrtmgp_sw_main.meta @@ -105,7 +105,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 diff --git a/physics/Radiation/radiation_clouds.f b/physics/Radiation/radiation_clouds.f index 111be4019..979405cdb 100644 --- a/physics/Radiation/radiation_clouds.f +++ b/physics/Radiation/radiation_clouds.f @@ -348,7 +348,7 @@ subroutine radiation_clouds_prop & & iovr_dcorr, iovr_exp, iovr_exprand, idcor, idcor_con, & & idcor_hogan, idcor_oreopoulos, lcrick, lcnorm, & & imfdeepcnv, imfdeepcnv_gf, imfdeepcnv_c3, & - & do_mynnedmf, lgfdlmprad, & + & do_mynnedmf, lgfdlmprad, xr_cnvcld, & & uni_cld, lmfshal, lmfdeep2, cldcov, clouds1, & & effrl, effri, effrr, effrs, effr_in, & & effrl_inout, effri_inout, effrs_inout, & @@ -538,7 +538,8 @@ subroutine radiation_clouds_prop & logical, intent(in) :: uni_cld, lmfshal, lmfdeep2, effr_in, & - & do_mynnedmf, lgfdlmprad, top_at_1, lcrick, lcnorm + & do_mynnedmf, lgfdlmprad, top_at_1, lcrick, lcnorm, & + & xr_cnvcld real (kind=kind_phys), dimension(:,:,:), intent(in) :: ccnd, & & tracer1 @@ -727,7 +728,7 @@ subroutine radiation_clouds_prop & call progcld_thompson_wsm6 (plyr,plvl,tlyr,qlyr,qstl, & ! --- inputs & rhly,tracer1,xlat,xlon,slmsk,dz,delp, & & ntrac-1, ntcw-1,ntiw-1,ntrw-1, & - & ntsw-1,ntgl-1,con_ttp, & + & ntsw-1,ntgl-1,con_ttp,xr_cnvcld, & & IX, NLAY, NLP1, uni_cld, lmfshal, lmfdeep2, & & cldcov(:,1:NLAY), cnvw, effrl_inout, & & effri_inout, effrs_inout, & @@ -801,7 +802,7 @@ subroutine radiation_clouds_prop & call progcld_thompson_wsm6 (plyr,plvl,tlyr,qlyr,qstl, & ! --- inputs & rhly,tracer1,xlat,xlon,slmsk,dz,delp, & & ntrac-1, ntcw-1,ntiw-1,ntrw-1, & - & ntsw-1,ntgl-1,con_ttp, & + & ntsw-1,ntgl-1,con_ttp,xr_cnvcld, & & IX, NLAY, NLP1, uni_cld, lmfshal, lmfdeep2, & & cldcov(:,1:NLAY), cnvw, effrl, effri, effrs, & & lwp_ex, iwp_ex, lwp_fc, iwp_fc, & @@ -1964,7 +1965,7 @@ subroutine progcld_thompson_wsm6 & & ( plyr,plvl,tlyr,qlyr,qstl,rhly,clw, & ! --- inputs: & xlat,xlon,slmsk,dz,delp, & & ntrac,ntcw,ntiw,ntrw,ntsw,ntgl,con_ttp, & - & IX, NLAY, NLP1, & + & xr_cnvcld, IX, NLAY, NLP1, & & uni_cld, lmfshal, lmfdeep2, cldcov, cnvw, & & re_cloud,re_ice,re_snow, & & lwp_ex, iwp_ex, lwp_fc, iwp_fc, & @@ -2051,7 +2052,8 @@ subroutine progcld_thompson_wsm6 & integer, intent(in) :: IX, NLAY, NLP1 integer, intent(in) :: ntrac, ntcw, ntiw, ntrw, ntsw, ntgl - logical, intent(in) :: uni_cld, lmfshal, lmfdeep2, lcnorm + logical, intent(in) :: uni_cld, lmfshal, lmfdeep2, lcnorm, & + & xr_cnvcld real (kind=kind_phys), dimension(:,:), intent(in) :: plvl, plyr, & & tlyr, qlyr, qstl, rhly, cldcov, delp, dz, dzlay, & @@ -2122,23 +2124,43 @@ subroutine progcld_thompson_wsm6 & ! enddo ! endif +!> - Include grid-mean suspended cloud condensate in Xu-Randall cloud fraction +!> if xr_cnvcld is true: + + if(xr_cnvcld)then do k = 1, NLAY do i = 1, IX clwf(i,k) = clw(i,k,ntcw) + clw(i,k,ntiw) + clw(i,k,ntsw) & + clw(i,k,ntrw) + cnvw(i,k) enddo enddo + else + do k = 1, NLAY + do i = 1, IX + clwf(i,k) = clw(i,k,ntcw) + clw(i,k,ntiw) + clw(i,k,ntsw) + & + clw(i,k,ntrw) + enddo + enddo + endif !> - Compute total-cloud liquid/ice condensate path in \f$ g/m^2 \f$. !> The total condensate includes convective condensate. do k = 1, NLAY-1 do i = 1, IX - tem1 = cnvw(i,k)*(1.-tem2d(i,k)) + if(xr_cnvcld)then + tem1 = cnvw(i,k)*(1.-tem2d(i,k)) + else + tem1 = 0. + endif cwp(i,k) = max(0.0, (clw(i,k,ntcw)+tem1) * & gfac * delp(i,k)) if(tem1 > 1.e-12 .and. clw(i,k,ntcw) < 1.e-12) & rew(i,k)=reliq_def - tem2 = cnvw(i,k)*tem2d(i,k) + if(xr_cnvcld)then + tem2 = cnvw(i,k)*tem2d(i,k) + else + tem2 = 0. + endif cip(i,k) = max(0.0, (clw(i,k,ntiw) + & snow2ice*clw(i,k,ntsw) + tem2) * & gfac * delp(i,k)) diff --git a/physics/photochem/h2ointerp.f90 b/physics/photochem/h2ointerp.f90 index c4fb355fc..f5a1f36c6 100644 --- a/physics/photochem/h2ointerp.f90 +++ b/physics/photochem/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,10 +145,8 @@ 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 - real(8) rinc(5) - real(4) rinc4(5) - integer w3kindreal, w3kindint ! idat = 0 idat(1) = idate(4) @@ -157,13 +155,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/smoke_dust/rrfs_smoke_wrapper.F90 b/physics/smoke_dust/rrfs_smoke_wrapper.F90 index 3842cba54..37ffccb35 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_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, & @@ -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