Remove compiler warnings from chgres_cube (#747)

Fixes #736.

sorc/chgres_cube.fd/atm_input_data.F90

@@ -2489,7 +2489,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 
@@ -2549,7 +2549,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
@@ -2986,17 +2986,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)
@@ -3030,7 +3030,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:"
@@ -3048,7 +3048,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)
@@ -3063,9 +3063,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
@@ -3170,7 +3170,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
@@ -3180,11 +3180,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
@@ -3232,7 +3232,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
 

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/model_grid.F90

@@ -125,9 +125,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
@@ -142,10 +142,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
 
@@ -161,7 +160,7 @@ subroutine define_input_grid_gaussian(localpet, npets)
 
  implicit none
 
- integer, intent(in)              :: localpet, npets
+ integer, intent(in)              :: npets
 
  character(len=250)               :: the_file
 
@@ -608,20 +607,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
 

sorc/chgres_cube.fd/program_setup.F90

@@ -8,6 +8,7 @@
 !! @author George Gayno NCEP/EMC
  module program_setup
 
+ use esmf
  use utilities, only                    : error_handler, to_lower
 
  implicit none
@@ -133,10 +134,9 @@ module program_setup
  real, allocatable, public       :: wltsmc_target(:) !< Plant wilting point soil moisture content target grid.
  real, allocatable, public       :: bb_target(:)  !<  Soil 'b' parameter, target grid
  real, allocatable, public       :: satpsi_target(:) !<   Saturated soil potential, target grid
- real, allocatable, public       :: missing_var_values(:) !< If input GRIB2 record is missing, the variable
-                                                          !! is set to this value.
+ real(kind=esmf_kind_r4), allocatable, public :: missing_var_values(:) !< If input GRIB2 record is missing, the variable
+                                                                       !! is set to this value.
 
-
  public :: read_setup_namelist
  public :: calc_soil_params_driver
  public :: read_varmap
@@ -146,15 +146,14 @@ module program_setup
 
 !> Reads program configuration namelist.
 !!
-!! @param filename the name of the configuration file (defaults to
+!! @param filename The name of the configuration file (defaults to
 !! ./fort.41).
 !! @author George Gayno NCEP/EMC
  subroutine read_setup_namelist(filename)
  implicit none
 
  character(len=*), intent(in), optional :: filename
- character(:), allocatable :: filename_to_use
-
+ character(len=250), allocatable :: filename_to_use
 
  integer                     :: is, ie, ierr
 
@@ -197,12 +196,12 @@ subroutine read_setup_namelist(filename)
  print*,"- READ SETUP NAMELIST"
 
  if (present(filename)) then
-    filename_to_use = filename
+   filename_to_use = filename
  else
-    filename_to_use = "./fort.41"
+   filename_to_use = "./fort.41"
  endif
 
- open(41, file=filename_to_use, iostat=ierr)
+ open(41, file=trim(filename_to_use), iostat=ierr)
  if (ierr /= 0) call error_handler("OPENING SETUP NAMELIST.", ierr)
  read(41, nml=config, iostat=ierr)
  if (ierr /= 0) call error_handler("READING SETUP NAMELIST.", ierr)
@@ -306,24 +305,24 @@ subroutine read_setup_namelist(filename)
 !-------------------------------------------------------------------------
 
  if (trim(input_type) == "grib2") then
-	 if (trim(grib2_file_input_grid) == "NULL" .or. trim(grib2_file_input_grid) == "") then
-		 call error_handler("FOR GRIB2 DATA, PLEASE PROVIDE GRIB2_FILE_INPUT_GRID", 1)
-	 endif
+   if (trim(grib2_file_input_grid) == "NULL" .or. trim(grib2_file_input_grid) == "") then
+     call error_handler("FOR GRIB2 DATA, PLEASE PROVIDE GRIB2_FILE_INPUT_GRID", 1)
+   endif
  endif
 
  !-------------------------------------------------------------------------
 ! For grib2 input, warn about possibly unsupported external model types
 !-------------------------------------------------------------------------
 
  if (trim(input_type) == "grib2") then
-	 if (.not. any((/character(4)::"GFS","NAM","RAP","HRRR"/)==trim(external_model))) then
-		 call error_handler( "KNOWN SUPPORTED external_model INPUTS ARE GFS, NAM, RAP, AND HRRR. " // &
-		 "IF YOU WISH TO PROCESS GRIB2 DATA FROM ANOTHER MODEL, YOU MAY ATTEMPT TO DO SO AT YOUR OWN RISK. " // &
-		 "ONE WAY TO DO THIS IS PROVIDE NAM FOR external_model AS IT IS A RELATIVELY STRAIGHT-" // &
-		 "FORWARD REGIONAL GRIB2 FILE. YOU MAY ALSO COMMENT OUT THIS ERROR MESSAGE IN " // &
-		 "program_setup.f90 LINE 389. NO GUARANTEE IS PROVIDED THAT THE CODE WILL WORK OR "// &
-		 "THAT THE RESULTING DATA WILL BE CORRECT OR WORK WITH THE ATMOSPHERIC MODEL.", 1)
-	 endif
+   if (.not. any((/character(4)::"GFS","NAM","RAP","HRRR"/)==trim(external_model))) then
+     call error_handler( "KNOWN SUPPORTED external_model INPUTS ARE GFS, NAM, RAP, AND HRRR. " // &
+    "IF YOU WISH TO PROCESS GRIB2 DATA FROM ANOTHER MODEL, YOU MAY ATTEMPT TO DO SO AT YOUR OWN RISK. " // &
+    "ONE WAY TO DO THIS IS PROVIDE NAM FOR external_model AS IT IS A RELATIVELY STRAIGHT-" // &
+    "FORWARD REGIONAL GRIB2 FILE. YOU MAY ALSO COMMENT OUT THIS ERROR MESSAGE IN " // &
+    "program_setup.f90 LINE 389. NO GUARANTEE IS PROVIDED THAT THE CODE WILL WORK OR "// &
+    "THAT THE RESULTING DATA WILL BE CORRECT OR WORK WITH THE ATMOSPHERIC MODEL.", 1)
+   endif
  endif
 
 !-------------------------------------------------------------------------
@@ -332,11 +331,10 @@ subroutine read_setup_namelist(filename)
 !-------------------------------------------------------------------------
 
  if (trim(input_type) == "grib2" .and. trim(external_model)=="HRRR") then
-	 if (trim(geogrid_file_input_grid) == "NULL" .or. trim(grib2_file_input_grid) == "") then
-		 print*, "HRRR DATA DOES NOT CONTAIN SOIL TYPE INFORMATION. WITHOUT &
-			GEOGRID_FILE_INPUT_GRID SPECIFIED, SOIL MOISTURE INTERPOLATION MAY BE LESS &
-			ACCURATE. "
-	 endif
+   if (trim(geogrid_file_input_grid) == "NULL" .or. trim(grib2_file_input_grid) == "") then
+     print*, "HRRR DATA DOES NOT CONTAIN SOIL TYPE INFORMATION. WITHOUT"
+     print*, "GEOGRID_FILE_INPUT_GRID SPECIFIED, SOIL MOISTURE INTERPOLATION MAY BE LESS ACCURATE."
+   endif
  endif
 
  if (trim(thomp_mp_climo_file) /= "NULL") then
@@ -444,7 +442,6 @@ end subroutine read_varmap
 !! @author Jeff Beck
 subroutine get_var_cond(var_name,this_miss_var_method,this_miss_var_value, &
                             this_field_var_name, loc)
-  use esmf
 
   implicit none
   character(len=20), intent(in) :: var_name

sorc/chgres_cube.fd/sfc_input_data.F90

@@ -1774,9 +1774,9 @@ 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
 
    integer                               :: rc, varnum, iret, i, j,k
    integer                               :: ncid2d, varid, varsize
@@ -2279,7 +2279,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
 
@@ -2326,7 +2326,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
@@ -2361,7 +2361,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
 
@@ -2411,8 +2411,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)
@@ -2456,8 +2456,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
 
@@ -2495,8 +2495,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
 
@@ -2531,8 +2531,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)
+       err_msg="COULD NOT FIND LAI IN FILE. SET LAI_FROM_CLIMO=.TRUE."
+       if (rc /= 0) call error_handler(err_msg, rc)
 
 !      print*,'lai ', maxval(gfld%fld),minval(gfld%fld)
        dummy2d_8 = reshape(gfld%fld , (/i_input,j_input/))
@@ -3287,7 +3287,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