Remove compiler warnings from chgres_cube

sorc/chgres_cube.fd/grib2_util.F90

@@ -56,7 +56,7 @@ subroutine rh2spfh(rh_sphum,p,t)
   !print *, 'es = ', es
   e = rh * es / 100.0
   !print *, 'e = ', e
-  rh_sphum = 0.622 * e / p
+  rh_sphum = real((0.622 * e / p),kind=esmf_kind_r4)
   !print *, 'q = ', sphum
 
   !if (P .eq. 100000.0) THEN
@@ -110,7 +110,7 @@ subroutine rh2spfh_gfs(rh_sphum,p,t)
   do i=1,i_input
     ES = MIN(FPVSNEW(T(I,J)),P)
     QC(i,j) = CON_EPS*ES/(P+CON_EPSM1*ES)
-    rh_sphum(i,j) = rh(i,j)*QC(i,j)/100.0
+    rh_sphum(i,j) = real((rh(i,j)*QC(i,j)/100.0),kind=esmf_kind_r4)
   end do
 end do
 
@@ -169,7 +169,7 @@ elemental function fpvsnew(t)
       c1xpvs=1.-xmin*c2xpvs
 !    xj=min(max(c1xpvs+c2xpvs*t,1.0),real(nxpvs,krealfp))
       xj=min(max(c1xpvs+c2xpvs*t,1.0),float(nxpvs))
-      jx=min(xj,float(nxpvs)-1.0)
+      jx=int(min(xj,float(nxpvs)-1.0))
       x=xmin+(jx-1)*xinc
 
       tr=con_ttp/x

sorc/chgres_cube.fd/input_data.F90

@@ -2994,7 +2994,7 @@ subroutine read_input_atm_grib2_file(localpet)
              unpack, k, gfld, iret)
 
        if (iret == 0) then ! found data
-         dummy2d = reshape(gfld%fld, (/i_input,j_input/) )
+         dummy2d = real((reshape(gfld%fld, (/i_input,j_input/) )), kind=esmf_kind_r4)
        else ! did not find data.
         if (trim(method) .eq. 'intrp' .and. .not.all_empty) then
           dummy2d = intrp_missing 
@@ -3054,7 +3054,7 @@ subroutine read_input_atm_grib2_file(localpet)
          enddo
        enddo
        do vlev=1,lev_input
-         dummy2d = dummy3d(:,:,n) 
+         dummy2d = real(dummy3d(:,:,n) , kind=esmf_kind_r4)
          if (any(dummy2d .eq. intrp_missing)) then 
            ! If we're outside the appropriate region, don't fill but error instead
            if (n == o3n .and. rlevs(vlev) .lt. lev_no_o3_fill) then
@@ -5023,6 +5023,7 @@ subroutine read_input_sfc_grib2_file(localpet)
 
    character(len=250)                    :: the_file
    character(len=250)                    :: geo_file
+   character(len=200)                    :: err_msg
    character(len=20)                     :: vname, vname_file, slev
    character(len=50)                     :: method
    character(len=20)                     :: to_upper
@@ -5528,7 +5529,7 @@ subroutine read_input_sfc_grib2_file(localpet)
 
      if (rc == 0 ) then
 !      print*,'soil type ', maxval(gfld%fld),minval(gfld%fld)
-       dummy2d = reshape(gfld%fld , (/i_input,j_input/))
+       dummy2d = reshape(real(gfld%fld,kind=esmf_kind_r4) , (/i_input,j_input/))
 
      endif
 
@@ -5575,7 +5576,7 @@ subroutine read_input_sfc_grib2_file(localpet)
        do j = 1, j_input
        do i = 1, i_input
          if(dummy2d(i,j) == 14.0_esmf_kind_r4 .and. slmsk_save(i,j) == 1) then
-           dummy1d(:) = dummy3d_stype(i,j,:)
+           dummy1d(:) = real(dummy3d_stype(i,j,:),kind=esmf_kind_r4)
            dummy1d(14) = 0.0_esmf_kind_r4
            dummy2d(i,j) = real(MAXLOC(dummy1d, 1),esmf_kind_r4)
          endif
@@ -5610,7 +5611,7 @@ subroutine read_input_sfc_grib2_file(localpet)
      if (.not. sotyp_from_climo) then
        do j = 1, j_input
        do i = 1, i_input
-         if(dummy2d(i,j) == 14.0_esmf_kind_r4 .and. slmsk_save(i,j) == 1) dummy2d(i,j) = -99999.9   
+         if(dummy2d(i,j) == 14.0_esmf_kind_r4 .and. slmsk_save(i,j) == 1) dummy2d(i,j) = -99999.9_esmf_kind_r4
        enddo
        enddo
 
@@ -5660,8 +5661,8 @@ subroutine read_input_sfc_grib2_file(localpet)
                unpack, k, gfld, rc)
 
        if (rc /= 0 )then
-         call error_handler("COULD NOT FIND VEGETATION FRACTION IN FILE.  &
-           PLEASE SET VGFRC_FROM_CLIMO=.TRUE. EXITING", rc)
+         err_msg="COULD NOT FIND VEGETATION FRACTION IN FILE. PLEASE SET VGFRC_FROM_CLIMO=.TRUE."
+         call error_handler(err_msg, rc)
        else
          if (maxval(gfld%fld) > 2.0) gfld%fld = gfld%fld / 100.0
 !        print*,'vfrac ', maxval(gfld%fld),minval(gfld%fld)
@@ -5705,8 +5706,8 @@ subroutine read_input_sfc_grib2_file(localpet)
            j = 1151 ! Have to search by record number.
            call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, &
                   unpack, k, gfld, rc)
-           if (rc/=0) call error_handler("COULD NOT FIND MIN VEGETATION FRACTION IN FILE. &
-             PLEASE SET MINMAX_VGFRC_FROM_CLIMO=.TRUE. . EXITING",rc)
+           err_msg="COULD NOT FIND MIN VEGETATION FRACTION IN FILE. SET MINMAX_VGFRC_FROM_CLIMO=.TRUE."
+           if (rc/=0) call error_handler(err_msg, rc)
          endif
        endif
 
@@ -5744,8 +5745,8 @@ subroutine read_input_sfc_grib2_file(localpet)
            j = 1152 ! Have to search by record number.
            call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, &
                 unpack, k, gfld, rc)
-           if (rc <= 0) call error_handler("COULD NOT FIND MAX VEGETATION FRACTION IN FILE. &
-             PLEASE SET MINMAX_VGFRC_FROM_CLIMO=.TRUE. . EXITING",rc)
+           err_msg="COULD NOT FIND MAX VEGETATION FRACTION IN FILE. SET MINMAX_VGFRC_FROM_CLIMO=.TRUE."
+           if (rc <= 0) call error_handler(err_msg, rc)
          endif
        endif
 
@@ -5780,10 +5781,8 @@ subroutine read_input_sfc_grib2_file(localpet)
        call getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, &
              unpack, k, gfld, rc)
 
-       if (rc /= 0) call error_handler("COULD NOT FIND LAI IN FILE. &
-             PLEASE SET LAI_FROM_CLIMO=.TRUE. . EXITING",rc)
-
-!      print*,'lai ', maxval(gfld%fld),minval(gfld%fld)
+       err_msg="COULD NOT FIND LAI IN FILE. SET LAI_FROM_CLIMO=.TRUE."
+       if (rc /= 0) call error_handler(err_msg, rc)
        dummy2d_8 = reshape(gfld%fld , (/i_input,j_input/))
 
      endif !localpet==0
@@ -6880,17 +6879,17 @@ subroutine read_winds(u,v,localpet,octet_23,rlevs,lugb,pdt_num)
 
    if (gfld%igdtnum == 32769) then ! grid definition template number - rotated lat/lon grid
 
-     latin1 = float(gfld%igdtmpl(15))/1.0E6
-     lov = float(gfld%igdtmpl(16))/1.0E6
+     latin1 = real(float(gfld%igdtmpl(15))/1.0E6, kind=esmf_kind_r4)
+     lov = real(float(gfld%igdtmpl(16))/1.0E6, kind=esmf_kind_r4)
 
      print*, "- CALL CALCALPHA_ROTLATLON with center lat,lon = ",latin1,lov
      call calcalpha_rotlatlon(lat,lon,latin1,lov,alpha)
 
    elseif (gfld%igdtnum == 30) then ! grid definition template number - lambert conformal grid.
 
-     lov = float(gfld%igdtmpl(14))/1.0E6
-     latin1 = float(gfld%igdtmpl(19))/1.0E6
-     latin2 = float(gfld%igdtmpl(20))/1.0E6
+     lov = real(float(gfld%igdtmpl(14))/1.0E6, kind=esmf_kind_r4)
+     latin1 = real(float(gfld%igdtmpl(19))/1.0E6, kind=esmf_kind_r4)
+     latin2 = real(float(gfld%igdtmpl(20))/1.0E6, kind=esmf_kind_r4)
 
      print*, "- CALL GRIDROT for LC grid with lov,latin1/2 = ",lov,latin1,latin2
      call gridrot(lov,latin1,latin2,lon,alpha)
@@ -6924,7 +6923,7 @@ subroutine read_winds(u,v,localpet,octet_23,rlevs,lugb,pdt_num)
         endif
      else
        dum2d = reshape(gfld%fld, (/i_input,j_input/) )
-       u_tmp(:,:) = dum2d
+       u_tmp(:,:) = real(dum2d, kind=esmf_kind_r4)
      endif
 
      vname = ":VGRD:"
@@ -6942,7 +6941,7 @@ subroutine read_winds(u,v,localpet,octet_23,rlevs,lugb,pdt_num)
         endif
      else
        dum2d = reshape(gfld%fld, (/i_input,j_input/) )
-       v_tmp(:,:) = dum2d
+       v_tmp(:,:) = real(dum2d, kind=esmf_kind_r4)
      endif
 
      deallocate(dum2d)
@@ -6957,9 +6956,9 @@ subroutine read_winds(u,v,localpet,octet_23,rlevs,lugb,pdt_num)
         endif
       else if (gfld%igdtnum == 32769) then ! grid definition template number - rotated lat/lon grid
         ws = sqrt(u_tmp**2 + v_tmp**2)
-        wd = atan2(-u_tmp,-v_tmp) / d2r ! calculate grid-relative wind direction
-        wd = wd + alpha + 180.0 ! Rotate from grid- to earth-relative direction
-        wd = 270.0 - wd ! Convert from meteorological (true N) to mathematical direction
+        wd = real((atan2(-u_tmp,-v_tmp) / d2r), kind=esmf_kind_r4) ! calculate grid-relative wind direction
+        wd = real((wd + alpha + 180.0), kind=esmf_kind_r4) ! Rotate from grid- to earth-relative direction
+        wd = real((270.0 - wd), kind=esmf_kind_r4) ! Convert from meteorological (true N) to mathematical direction
         u(:,:,vlev) = -ws*cos(wd*d2r)
         v(:,:,vlev) = -ws*sin(wd*d2r)
       else
@@ -7064,7 +7063,7 @@ subroutine gridrot(lov,latin1,latin2,lon,rot)
   real(esmf_kind_r8), intent(in)      :: lon(i_input,j_input)
 
   real(esmf_kind_r4)                  :: trot(i_input,j_input), tlon(i_input,j_input)
-  real(esmf_kind_r4)                  :: dtor = 3.14159265359/180.0_esmf_kind_r4
+  real(esmf_kind_r4)                  :: dtor = 3.14159265359_esmf_kind_r4/180.0_esmf_kind_r4
   real(esmf_kind_r4)                  :: an
   !trot_tmp = real(lon,esmf_kind_r4)-lov
   !trot = trot_tmp
@@ -7074,11 +7073,11 @@ subroutine gridrot(lov,latin1,latin2,lon,rot)
   if ( (latin1 - latin2) .lt. 0.000001 ) then
         an = sin(latin1*dtor)
   else
-        an = log( cos(latin1*dtor) / cos(latin2*dtor) ) / &
-             log( tan(dtor*(90.0-latin1)/2.) / tan(dtor*(90.0-latin2)/2.))
+        an = real(log( cos(latin1*dtor) / cos(latin2*dtor) ) / &
+             log( tan(dtor*(90.0-latin1)/2.) / tan(dtor*(90.0-latin2)/2.)), kind=esmf_kind_r4)
   end if
 
-  tlon = mod(lon - lov + 180. + 3600., 360.) - 180.
+  tlon = real((mod(lon - lov + 180. + 3600., 360.) - 180.), kind=esmf_kind_r4)
   trot = an * tlon
 
   rot = trot * dtor
@@ -7126,7 +7125,7 @@ subroutine calcalpha_rotlatlon(latgrid,longrid,cenlat,cenlon,alpha)
   tlon = -tlon + lon0_r
   tph  = asin(cphi0*sin(tlat) - sphi0*cos(tlat)*cos(tlon))
   sinalpha = sphi0 * sin(tlon) / cos(tph)
-  alpha = -asin(sinalpha)/D2R
+  alpha = real((-asin(sinalpha)/D2R), kind=esmf_kind_r4)
   ! returns alpha in degrees
 end subroutine calcalpha_rotlatlon
 
@@ -7155,6 +7154,7 @@ subroutine handle_grib_error(vname,lev,method,value,varnum, iret,var,var8,var3d)
   real(esmf_kind_r8), intent(inout), optional  :: var3d(:,:,:)
 
   character(len=20), intent(in)     :: vname, lev, method
+  character(len=200)                :: err_msg
 
   integer, intent(in)               :: varnum 
   integer, intent(inout)            :: iret
@@ -7185,17 +7185,17 @@ subroutine handle_grib_error(vname,lev,method,value,varnum, iret,var,var8,var3d)
     if(present(var8)) var8(:,:) = ieee_value(var8,IEEE_QUIET_NAN)
     if(present(var3d)) var3d(:,:,:) = ieee_value(var3d,IEEE_QUIET_NAN)
   elseif (trim(method) == "stop") then
-    call error_handler("READING "//trim(vname)// " at level "//lev//". TO MAKE THIS NON- &
-                        FATAL, CHANGE STOP TO SKIP FOR THIS VARIABLE IN YOUR VARMAP &
-                        FILE.", iret)
+    err_msg="READING " // trim(vname) // " at level " //lev// ". TO MAKE THIS NON-" // &
+            "FATAL, CHANGE STOP TO SKIP FOR THIS VARIABLE IN YOUR VARMAP FILE."
+    call error_handler(err_msg, iret)
   elseif (trim(method) == "intrp") then
     print*, "WARNING: ,"//trim(vname)//" NOT AVAILABLE AT LEVEL "//trim(lev)// &
           ". WILL INTERPOLATE INTERSPERSED MISSING LEVELS AND/OR FILL MISSING"//&
           " LEVELS AT EDGES."
   else
-    call error_handler("ERROR USING MISSING_VAR_METHOD. PLEASE SET VALUES IN" // &
-                       " VARMAP TABLE TO ONE OF: set_to_fill, set_to_NaN,"// &
-                       " , intrp, skip, or stop.", 1)
+    err_msg="ERROR USING MISSING_VAR_METHOD. PLEASE SET VALUES IN" // &
+            " VARMAP TABLE TO ONE OF: set_to_fill, set_to_NaN, intrp, skip, or stop."
+    call error_handler(err_msg, 1)
   endif
 
 end subroutine handle_grib_error
@@ -7293,7 +7293,7 @@ subroutine read_grib_soil(vname, vname_file, lugb, pdt_num, dummy3d)
      iscale2 = 10 ** gfld%ipdtmpl(14)
 !    print*,'getgb2 top of soil layer in m ', float(gfld%ipdtmpl(12))/float(iscale1)
 !    print*,'getgb2 bot of soil layer in m ', float(gfld%ipdtmpl(15))/float(iscale2)
-     dummy2d = reshape(gfld%fld, (/i_input,j_input/) )
+     dummy2d = reshape(real(gfld%fld,kind=esmf_kind_r4), (/i_input,j_input/) )
    endif 
 
    j = k
@@ -7549,7 +7549,7 @@ SUBROUTINE DINT2P(PPIN,XXIN,NPIN,PPOUT,XXOUT,NPOUT   &
       real*8 POUT(NPOUT),XOUT(NPOUT)
 
 ! local
-      INTEGER J1,NP,NL,NIN,NLMAX,NPLVL,NLSAVE,NP1,NO1,N1,N2,LOGLIN,   &
+      INTEGER NP,NL,NLMAX,NLSAVE,NP1,NO1,N1,N2,LOGLIN,   &
              NLSTRT
       real*8 SLOPE,PA,PB,PC
 
@@ -7660,7 +7660,7 @@ SUBROUTINE DINT2P(PPIN,XXIN,NPIN,PPOUT,XXOUT,NPOUT   &
                       if (p(nl+1).gt.0.d0) then
                           PC = LOG(P(NL+1))
                       else
-                          PC = LOG(1.d-4)
+                          PC = LOG(1.E-4)
                       end if
 
                       SLOPE = (X(NL)-X(NL+1))/ (PA-PC)

sorc/chgres_cube.fd/model_grid.F90

@@ -124,9 +124,9 @@ subroutine define_input_grid(localpet, npets)
      trim(input_type) == "gfs_gaussian_nemsio" .or. &
      trim(input_type) == "gfs_sigio" .or. &
      trim(input_type) == "gaussian_netcdf") then
-   call define_input_grid_gaussian(localpet, npets)
+   call define_input_grid_gaussian(npets)
  elseif (trim(input_type) == "grib2") then
-   call define_input_grid_grib2(localpet,npets)
+   call define_input_grid_grib2(npets)
  else
    call define_input_grid_mosaic(localpet, npets)
  endif
@@ -141,10 +141,9 @@ end subroutine define_input_grid
 !!  - spectral gfs sigio  (prior to July 19, 2017)
 !!  - spectral gfs sfcio  (prior to July 19, 2017)
 !!
-!! @param [in] localpet ESMF local persistent execution thread 
 !! @param [in] npets  Number of  persistent execution threads.
 !! @author George Gayno NCEP/EMC   
- subroutine define_input_grid_gaussian(localpet, npets)
+ subroutine define_input_grid_gaussian(npets)
 
  use nemsio_module
 
@@ -160,7 +159,7 @@ subroutine define_input_grid_gaussian(localpet, npets)
 
  implicit none
 
- integer, intent(in)              :: localpet, npets
+ integer, intent(in)              :: npets
 
  character(len=250)               :: the_file
 
@@ -607,20 +606,19 @@ end subroutine define_input_grid_mosaic
 
 !> Define input grid object for grib2 input data.
 !!
-!! @param [in] localpet ESMF local persistent execution thread 
 !! @param [in] npets  Number of persistent execution threads
 !! @author Larissa Reames
 !! @author Jeff Beck
 !! @author George Gayno
- subroutine define_input_grid_grib2(localpet,npets)
+ subroutine define_input_grid_grib2(npets)
 
  use grib_mod
  use gdswzd_mod
  use program_setup, only       : grib2_file_input_grid, data_dir_input_grid
 
  implicit none
 
- integer, intent(in)              :: localpet, npets
+ integer, intent(in)              :: npets
 
  character(len=500)               :: the_file