Fix argument mismatch in w3nco subroutine calls

physics/GFS_time_vary_pre.fv3.F90

@@ -70,7 +70,7 @@ subroutine GFS_time_vary_pre_timestep_init (jdat, idat, dtp, nsswr,
                   nslwr, nhfrad, idate, debug, me, master, nscyc, sec, phour, zhour, fhour,      &
                   kdt, julian, yearlen, ipt, lprnt, lssav, lsswr, lslwr, solhr, errmsg, errflg)
 
-        use machine,               only: kind_phys
+        use machine,               only: kind_phys, kind_dbl_prec, kind_sngl_prec
 
         implicit none
 
@@ -92,8 +92,10 @@ 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_phys) :: rinc(5)
+        real(kind=kind_sngl_prec) :: rinc4(5)
+        real(kind=kind_dbl_prec)  :: rinc8(5)
 
+        integer :: w3kindreal,w3kindint
         integer ::  iw3jdn
         integer :: jd0, jd1
         real    :: fjd
@@ -111,9 +113,19 @@ 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
-        rinc(1:5)   = 0
-        call w3difdat(jdat,idat,4,rinc)
-        sec = rinc(4)
+        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
         phour = sec/con_hr
         !--- set current bucket hour
         zhour = phour

physics/GFS_time_vary_pre.scm.F90

@@ -69,7 +69,7 @@ subroutine GFS_time_vary_pre_timestep_init (jdat, idat, dtp, nsswr, &
         nslwr, idate, debug, me, master, nscyc, sec, phour, zhour, fhour, kdt,   &
         julian, yearlen, ipt, lprnt, lssav, lsswr, lslwr, solhr, errmsg, errflg)
 
-        use machine,               only: kind_phys
+        use machine,               only: kind_phys, kind_dbl_prec, kind_sngl_prec
 
         implicit none
 
@@ -91,8 +91,10 @@ 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_phys) :: rinc(5)
-
+        real(kind=kind_sngl_prec) :: rinc4(5)
+        real(kind=kind_dbl_prec)  :: rinc8(5)
+
+        integer :: w3kindreal,w3kindint
         integer ::  iw3jdn      
         integer :: jd0, jd1
         real    :: fjd
@@ -112,9 +114,19 @@ 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
-        rinc(1:5)   = 0
-        call w3difdat(jdat,idat,4,rinc)
-        sec = rinc(4)
+        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
         phour = sec/con_hr
         !--- set current bucket hour
         zhour = phour

physics/aerinterp.F90

@@ -110,7 +110,8 @@ SUBROUTINE read_aerdataf ( me, master, iflip, idate, FHOUR, errmsg, errflg)
       integer      :: i, j, k, n, ii, imon, klev, n1, n2
       logical      :: file_exist
       integer  IDAT(8),JDAT(8)
-      real(kind=kind_phys) RINC(5), rjday
+      real(kind=kind_phys) rjday
+      real(8) RINC(5)
       integer jdow, jdoy, jday
       real(4) rinc4(5)
       integer w3kindreal,w3kindint      
@@ -244,8 +245,9 @@ SUBROUTINE aerinterpol( me,master,nthrds,npts,IDATE,FHOUR,iflip, jindx1,jindx2,
       real(kind=kind_phys) aerout(npts,lev,ntrcaer)
       real(kind=kind_phys) aerpm(npts,levsaer,ntrcaer)
       real(kind=kind_phys) prsl(npts,lev), aerpres(npts,levsaer)
-      real(kind=kind_phys) RINC(5), rjday
+      real(kind=kind_phys) rjday
       integer jdow, jdoy, jday
+      real(8) RINC(5)
       real(4) rinc4(5)
       integer w3kindreal,w3kindint
 

physics/cires_tauamf_data.F90

@@ -176,8 +176,9 @@ subroutine gfs_idate_calendar(idate, fhour, ddd, fddd)
 !
 !locals
 !
-      real(kind=kind_phys) :: rinc(5), rjday
+      real(kind=kind_phys) :: rjday
       integer              :: jdow, jdoy, jday
+      real(8)              :: rinc(5)
       real(4)              :: rinc4(5)
       integer              :: w3kindreal, w3kindint
 

physics/h2ointerp.f90

@@ -144,8 +144,9 @@ 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) rinc(5), rjday
+      real(kind=kind_phys) rjday
       integer              jdow, jdoy, jday
+      real(8)              rinc(5)
       real(4)              rinc4(5)
       integer              w3kindreal, w3kindint
 !

physics/iccninterp.F90

@@ -143,8 +143,9 @@ SUBROUTINE ciinterpol(me,npts,IDATE,FHOUR,jindx1,jindx2,ddy, &
       real(kind=kind_phys) ciplout(npts,lev),cipm(npts,kcipl)
       real(kind=kind_phys) ccnout(npts,lev),ccnpm(npts,kcipl)
       real(kind=kind_phys) cipres(npts,kcipl), prsl(npts,lev)
-      real(kind=kind_phys) RINC(5), rjday
+      real(kind=kind_phys) rjday
       integer jdow, jdoy, jday
+      real(8) RINC(5)
       real(4) rinc4(5)
       integer w3kindreal,w3kindint
 !

physics/machine.F

@@ -23,7 +23,7 @@ module machine
      &,                     kind_INTEGER = 4                             ! -,,-
 
 #else
-      integer, parameter :: kind_io4  = 4, kind_io8  = 8 , kind_ior = 8 &
+      integer, parameter :: kind_io4  = 4, kind_io8  = 4 , kind_ior = 8 &
      &,                     kind_evod = 4, kind_dbl_prec = 8            &
      &,                     kind_sngl_prec = 4
 # ifdef __PGI

physics/ozinterp.f90

@@ -147,8 +147,9 @@ 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) RINC(5), rjday
+      real(kind=kind_phys) rjday
       integer jdow, jdoy, jday
+      real(8) rinc(5)
       real(4) rinc4(5)
       integer w3kindreal,w3kindint
 !

physics/sfcsub.F

@@ -2736,7 +2736,7 @@ subroutine hmskrd(lugb,imsk,jmsk,fnmskh,                          &
 !>\ingroup mod_sfcsub
       subroutine fixrdg(lugb,idim,jdim,fngrib,                          &
      &                  kpds5,gdata,gaus,blno,blto,me)
-      use machine      , only : kind_io8,kind_io4
+      use machine      , only : kind_io8,kind_dbl_prec,kind_sngl_prec
       use sfccyc_module, only : mdata
       implicit none
       integer lgrib,n,lskip,jret,j,ndata,lugi,jdim,idim,lugb,
@@ -2747,8 +2747,8 @@ 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_io4), allocatable :: data4(:)
+      real (kind=kind_dbl_prec), allocatable :: data8(:)
+      real (kind=kind_sngl_prec), allocatable :: data4(:)
 !
       logical*1, allocatable :: lbms(:)
 !
@@ -2815,7 +2815,7 @@ subroutine fixrdg(lugb,idim,jdim,fngrib,                          &
         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)
+        data8(1:ndata) = real(data4(1:ndata), kind=kind_dbl_prec)
         deallocate(data4)
       else
         write(0,*)' FATAL ERROR: Invalid w3kindreal'
@@ -6165,7 +6165,7 @@ subroutine qcbyfc(tsffcs,snofcs,qctsfs,qcsnos,qctsfi,             &
       subroutine setrmsk(kpds5,slmask,igaul,jgaul,wlon,rnlat,           &
      &                   data,imax,jmax,rlnout,rltout,lmask,rslmsk      &
      &,                  gaus,blno, blto, kgds1, kpds4, lbms)
-      use machine , only : kind_io8,kind_io4
+      use machine , only : kind_io8,kind_io4,kind_dbl_prec
       use sfccyc_module
       implicit none
       real (kind=kind_io8) blno,blto,wlon,rnlat,crit,data_max
@@ -6177,7 +6177,8 @@ subroutine setrmsk(kpds5,slmask,igaul,jgaul,wlon,rnlat,           &
       real (kind=kind_io8)    slmask(igaul,jgaul)
       real (kind=kind_io8)    data(imax,jmax),rslmsk(imax,jmax)
      &,                       rlnout(imax), rltout(jmax)
-      real (kind=kind_io8)    a(jmax), w(jmax), radi, dlat, dlon
+      real (kind=kind_io8)    radi, dlat, dlon
+      real (kind=kind_dbl_prec) a(jmax), w(jmax)
       logical lmask, gaus
 !
 !     set the longitude and latitudes for the grib file
@@ -6650,7 +6651,7 @@ subroutine setrmsk(kpds5,slmask,igaul,jgaul,wlon,rnlat,           &
 !! This subroutine interpolates from lat/lon grid to other lat/lon grid.
       subroutine ga2la(gauin,imxin,jmxin,regout,imxout,jmxout,          &
      &                 wlon,rnlat,rlnout,rltout,gaus,blno, blto)
-      use machine , only : kind_io8,kind_io4
+      use machine , only : kind_io8,kind_io4,kind_dbl_prec
       use sfccyc_module , only : num_threads
       implicit none
       integer i1,i2,j2,ishft,i,jj,j1,jtem,jmxout,imxin,jmxin,imxout,    &
@@ -6673,7 +6674,7 @@ subroutine ga2la(gauin,imxin,jmxin,regout,imxout,jmxout,          &
       data    jmxsav/0/
       save    jmxsav, gaul, dlati
       real (kind=kind_io8) radi
-      real (kind=kind_io8) a(jmxin), w(jmxin)
+      real (kind=kind_dbl_prec) a(jmxin), w(jmxin)
 !
 !
       logical first
@@ -6917,11 +6918,12 @@ end subroutine landtyp
 !>\ingroup mod_sfcsub
       subroutine gaulat(gaul,k)
 !
-      use machine , only : kind_io8,kind_io4
+      use machine , only : kind_io8,kind_io4,kind_dbl_prec
       implicit none
       integer n,k
       real (kind=kind_io8) radi
-      real (kind=kind_io8) a(k), w(k), gaul(k)
+      real (kind=kind_io8) gaul(k)
+      real (kind=kind_dbl_prec) a(k), w(k)
 !
       call splat(4, k, a, w)
 !
@@ -7040,7 +7042,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(8) fha(5)
       real(4) fha4(5)
       integer w3kindreal,w3kindint
       integer ida(8),jda(8),ivtyp, kpd7
@@ -8305,7 +8307,7 @@ subroutine fixrdc(lugb,fngrib,kpds5,kpds7,mon,slmask,             &
      &                 gdata,len,iret                                   &
      &,                imsk, jmsk, slmskh, gaus,blno, blto              &
      &,                outlat, outlon, me)
-      use machine ,      only : kind_io8,kind_io4
+      use machine ,      only : kind_io8,kind_dbl_prec,kind_sngl_prec
       use sfccyc_module, only : mdata
       implicit none
       integer imax,jmax,ijmax,i,j,n,jret,inttyp,iret,imsk,              &
@@ -8321,8 +8323,8 @@ 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_dbl_prec), allocatable :: data8(:)
+      real (kind=kind_sngl_prec), allocatable :: data4(:)
       real (kind=kind_io8), allocatable :: rlngrb(:), rltgrb(:)
 !
       logical lmask, yr2kc, gaus, ijordr
@@ -8398,7 +8400,7 @@ subroutine fixrdc(lugb,fngrib,kpds5,kpds7,mon,slmask,             &
         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)
+        data8(1:ndata) = real(data4(1:ndata), kind=kind_dbl_prec)
         deallocate(data4)
       endif
       if (me .eq. 0) write(6,*) ' input grib file dates=',
@@ -8479,7 +8481,7 @@ subroutine fixrda(lugb,fngrib,kpds5,slmask,                       &
      &                  iy,im,id,ih,fh,gdata,len,iret                   &
      &,                 imsk, jmsk, slmskh, gaus,blno, blto             &
      &,                 outlat, outlon, me)
-      use machine      , only : kind_io8,kind_io4
+      use machine      , only : kind_io8,kind_dbl_prec,kind_sngl_prec
       use sfccyc_module, only : mdata
       implicit none
       integer nrepmx,nvalid,imo,iyr,idy,jret,ihr,nrept,lskip,lugi,      &
@@ -8506,8 +8508,8 @@ 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_dbl_prec), allocatable :: data8(:)
+      real (kind=kind_sngl_prec), allocatable :: data4(:)
       real (kind=kind_io8), allocatable :: rlngrb(:), rltgrb(:)
 !
       logical lmask, yr2kc, gaus, ijordr
@@ -8528,7 +8530,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(8) fha(5)
       real(4) fha4(5)
       integer ida(8),jda(8)
 !
@@ -8645,7 +8647,7 @@ subroutine fixrda(lugb,fngrib,kpds5,slmask,                       &
         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)
+        data8(1:ndata) = real(data4(1:ndata), kind=kind_dbl_prec)
         deallocate(data4)
       endif
       if (me .eq. 0) write(6,*) ' input grib file dates=',