Merge pull request NCAR#160 from DusanJovic-NOAA/no_arg_mismatch

Resolve various subroutine argument mismatches
climbfuji · Mar 19, 2024 · 9839680 · 9839680
2 parents 9f4a96b + 94596b3
commit 9839680
Show file tree

Hide file tree

Showing 29 changed files with 105 additions and 209 deletions.
diff --git 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
@@ -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
@@ -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
@@ -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_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
@@ -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
@@ -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