From dcb5de6be9313cc198276bf4f668598121f07fe6 Mon Sep 17 00:00:00 2001 From: George Gayno Date: Tue, 13 Dec 2022 20:59:59 +0000 Subject: [PATCH 01/19] Remove warnings from program_setup.F90. Fixes #736. --- sorc/chgres_cube.fd/program_setup.F90 | 50 +++++++++++++-------------- 1 file changed, 24 insertions(+), 26 deletions(-) diff --git a/sorc/chgres_cube.fd/program_setup.F90 b/sorc/chgres_cube.fd/program_setup.F90 index 722e701a7..ecf9c4c25 100644 --- a/sorc/chgres_cube.fd/program_setup.F90 +++ b/sorc/chgres_cube.fd/program_setup.F90 @@ -8,6 +8,8 @@ !! @author George Gayno NCEP/EMC module program_setup + use esmf + implicit none private @@ -131,10 +133,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 @@ -144,15 +145,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 @@ -195,12 +195,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) @@ -304,9 +304,9 @@ 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 !------------------------------------------------------------------------- @@ -314,14 +314,14 @@ subroutine read_setup_namelist(filename) !------------------------------------------------------------------------- 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 !------------------------------------------------------------------------- @@ -330,11 +330,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 @@ -442,7 +441,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 From a9eb6019b82ce15424cd5129e037320e8951a0e6 Mon Sep 17 00:00:00 2001 From: George Gayno Date: Wed, 14 Dec 2022 13:36:20 +0000 Subject: [PATCH 02/19] Remove warnings from wam_climo_data.f90. Fixes #736 --- sorc/chgres_cube.fd/wam_climo_data.f90 | 265 ++++++++++++------------- 1 file changed, 132 insertions(+), 133 deletions(-) diff --git a/sorc/chgres_cube.fd/wam_climo_data.f90 b/sorc/chgres_cube.fd/wam_climo_data.f90 index 0ba5647bc..32ca66a9d 100644 --- a/sorc/chgres_cube.fd/wam_climo_data.f90 +++ b/sorc/chgres_cube.fd/wam_climo_data.f90 @@ -29,84 +29,84 @@ module wam_gtd7bk_mod ! msise-00 01-feb-02 ! - real :: pt1(50) !< block space data for temperature - real :: pt2(50) !< block space data for temperature - real :: pt3(50) !< block space data for temperature - real :: pa1(50) !< block space data for he denisity - real :: pa2(50) !< block space data for he denisity - real :: pa3(50) !< block space data for he denisity - real :: pb1(50) !< block space data for o density - real :: pb2(50) !< block space data for o density - real :: pb3(50) !< block space data for o density - real :: pc1(50) !< block space data for n2 density - real :: pc2(50) !< block space data for n2 density - real :: pc3(50) !< block space data for n2 density - real :: pd1(50) !< block space data for tlb - real :: pd2(50) !< block space data for tlb - real :: pd3(50) !< block space data for tlb - real :: pe1(50) !< block space data for o2 density - real :: pe2(50) !< block space data for o2 density - real :: pe3(50) !< block space data for o2 density - real :: pf1(50) !< block space data for ar density - real :: pf2(50) !< block space data for ar density - real :: pf3(50) !< block space data for ar density - real :: pg1(50) !< block space data for h density - real :: pg2(50) !< block space data for h density - real :: pg3(50) !< block space data for h density - real :: ph1(50) !< block space data for n density - real :: ph2(50) !< block space data for n density - real :: ph3(50) !< block space data for n density - real :: pi1(50) !< block space data for hot o density - real :: pi2(50) !< block space data for hot o density - real :: pi3(50) !< block space data for hot o density - real :: pj1(50) !< block space data for s param - real :: pj2(50) !< block space data for s param - real :: pj3(50) !< block space data for s param - real :: pk1(50) !< block space data for turbo - real :: pl1(50) !< block space data for tn1(2) - real :: pl2(50) !< block space data for tn1(2) - real :: pm1(50) !< block space data for tn1(3) - real :: pm2(50) !< block space data for tn1(3) - real :: pn1(50) !< block space data for tn1(4) - real :: pn2(50) !< block space data for tn1(4) - real :: po1(50) !< block space data for tn1(5) tn2(1) - real :: po2(50) !< block space data for tn1(5) tn2(1) - real :: pp1(50) !< block space data for tn2(2) - real :: pp2(50) !< block space data for tn2(2) - real :: pq1(50) !< block space data for tn2(3) - real :: pq2(50) !< block space data for tn2(3) - real :: pr1(50) !< block space data for tn2(4) tn3(1) - real :: pr2(50) !< block space data for tn2(4) tn3(1) - real :: ps1(50) !< block space data for tn3(2) - real :: ps2(50) !< block space data for tn3(2) - real :: pu1(50) !< block space data for tn3(3) - real :: pu2(50) !< block space data for tn3(3) - real :: pv1(50) !< block space data for tn3(4) - real :: pv2(50) !< block space data for tn3(4) - real :: pw1(50) !< block space data for tn3(5) surface temperature tsl - real :: pw2(50) !< block space data for tn3(5) surface temperature tsl - real :: px1(50) !< block space data for tgn3(2) surface grad tslg - real :: px2(50) !< block space data for tgn3(2) surface grad tslg - real :: py1(50) !< block space data for tgn2(1) tgn1(2) - real :: py2(50) !< block space data for tgn2(1) tgn1(2) - real :: pz1(50) !< block space data for tgn3(1) tgn2(2) - real :: pz2(50) !< block space data for tgn3(1) tgn2(2) - real :: paa1(50) !< block space data for semiannual mult sam - real :: paa2(50) !< block space data for semiannual mult sam + real :: pt1(50) !< block space data for temperature + real :: pt2(50) !< block space data for temperature + real :: pt3(50) !< block space data for temperature + real :: pa1(50) !< block space data for he denisity + real :: pa2(50) !< block space data for he denisity + real :: pa3(50) !< block space data for he denisity + real :: pb1(50) !< block space data for o density + real :: pb2(50) !< block space data for o density + real :: pb3(50) !< block space data for o density + real :: pc1(50) !< block space data for n2 density + real :: pc2(50) !< block space data for n2 density + real :: pc3(50) !< block space data for n2 density + real :: pd1(50) !< block space data for tlb + real :: pd2(50) !< block space data for tlb + real :: pd3(50) !< block space data for tlb + real :: pe1(50) !< block space data for o2 density + real :: pe2(50) !< block space data for o2 density + real :: pe3(50) !< block space data for o2 density + real :: pf1(50) !< block space data for ar density + real :: pf2(50) !< block space data for ar density + real :: pf3(50) !< block space data for ar density + real :: pg1(50) !< block space data for h density + real :: pg2(50) !< block space data for h density + real :: pg3(50) !< block space data for h density + real :: ph1(50) !< block space data for n density + real :: ph2(50) !< block space data for n density + real :: ph3(50) !< block space data for n density + real :: pi1(50) !< block space data for hot o density + real :: pi2(50) !< block space data for hot o density + real :: pi3(50) !< block space data for hot o density + real :: pj1(50) !< block space data for s param + real :: pj2(50) !< block space data for s param + real :: pj3(50) !< block space data for s param + real :: pk1(50) !< block space data for turbo + real :: pl1(50) !< block space data for tn1(2) + real :: pl2(50) !< block space data for tn1(2) + real :: pm1(50) !< block space data for tn1(3) + real :: pm2(50) !< block space data for tn1(3) + real :: pn1(50) !< block space data for tn1(4) + real :: pn2(50) !< block space data for tn1(4) + real :: po1(50) !< block space data for tn1(5) tn2(1) + real :: po2(50) !< block space data for tn1(5) tn2(1) + real :: pp1(50) !< block space data for tn2(2) + real :: pp2(50) !< block space data for tn2(2) + real :: pq1(50) !< block space data for tn2(3) + real :: pq2(50) !< block space data for tn2(3) + real :: pr1(50) !< block space data for tn2(4) tn3(1) + real :: pr2(50) !< block space data for tn2(4) tn3(1) + real :: ps1(50) !< block space data for tn3(2) + real :: ps2(50) !< block space data for tn3(2) + real :: pu1(50) !< block space data for tn3(3) + real :: pu2(50) !< block space data for tn3(3) + real :: pv1(50) !< block space data for tn3(4) + real :: pv2(50) !< block space data for tn3(4) + real :: pw1(50) !< block space data for tn3(5) surface temperature tsl + real :: pw2(50) !< block space data for tn3(5) surface temperature tsl + real :: px1(50) !< block space data for tgn3(2) surface grad tslg + real :: px2(50) !< block space data for tgn3(2) surface grad tslg + real :: py1(50) !< block space data for tgn2(1) tgn1(2) + real :: py2(50) !< block space data for tgn2(1) tgn1(2) + real :: pz1(50) !< block space data for tgn3(1) tgn2(2) + real :: pz2(50) !< block space data for tgn3(1) tgn2(2) + real :: paa1(50) !< block space data for semiannual mult sam + real :: paa2(50) !< block space data for semiannual mult sam ! - real :: ptm(10) !< block space data for lower boundary - real :: pdm(10,8) !< block space data for lower boundary + real :: ptm(10) !< block space data for lower boundary + real :: pdm(10,8) !< block space data for lower boundary ! real :: pavgm(10) !< block space data for middle atmosphere averages ! - character*4:: isdate(3) !< define date - character*4:: istime(2) !< define time - character*4:: name(2) !< define data name + character*4:: isdate(3) !< define date + character*4:: istime(2) !< define time + character*4:: name(2) !< define data name ! - integer :: imr !< define version + integer :: imr !< define version ! - real :: pr65(2,65) !< define pressures - real :: pr151(2,151) !< define pressures + real :: pr65(2,65) !< define pressures + real :: pr151(2,151) !< define pressures data imr/0/ data isdate/'01-f','eb-0','2 '/,istime/'15:4','9:27'/ @@ -878,73 +878,73 @@ end module wam_gtd7bk_mod !! @author Hann-Ming Henry Juang module gettemp_mod ! - real :: tlb !< labeled temperature - real :: s !< scale inverse to temperature difference - real :: db04 !< diffusive density at zlb for g4 - real :: db16 !< diffusive density at zlb for g18 - real :: db28 !< diffusive density at zlb for g28 - real :: db32 !< diffusive density at zlb for g32 - real :: db40 !< diffusive density at zlb for g40 - real :: db48 !< diffusive density at zlb for g48 - real :: db01 !< diffusive density at zlb for g01 - real :: za !< joining altitude of bates and spline - real :: t0 !< initial temperature - real :: z0 !< initial height - real :: g0 !< initial gradient variations - real :: rl !< correction to specified mixing ratio at ground - real :: dd !< diffusive density at alt - real :: db14 !< diffusive density at zlb for g14 - real :: tr12 !< try factor 1 or 2 + real :: tlb !< labeled temperature + real :: s !< scale inverse to temperature difference + real :: db04 !< diffusive density at zlb for g4 + real :: db16 !< diffusive density at zlb for g18 + real :: db28 !< diffusive density at zlb for g28 + real :: db32 !< diffusive density at zlb for g32 + real :: db40 !< diffusive density at zlb for g40 + real :: db48 !< diffusive density at zlb for g48 + real :: db01 !< diffusive density at zlb for g01 + real :: za !< joining altitude of bates and spline + real :: t0 !< initial temperature + real :: z0 !< initial height + real :: g0 !< initial gradient variations + real :: rl !< correction to specified mixing ratio at ground + real :: dd !< diffusive density at alt + real :: db14 !< diffusive density at zlb for g14 + real :: tr12 !< try factor 1 or 2 ! - real :: tn1(5) !< temperature at node 1 (~mesosphere) - real :: tn2(4) !< temperature at node 2 (~stratosphere) - real :: tn3(5) !< temperature at node 3 (~troposphere) - real :: tgn1(2) !< temperature gradient at node 1 (~mesosphere) - real :: tgn2(2) !< temperature gradient at node 2 (~stratosphere) - real :: tgn3(2) !< temperature gradient at node 3 (~troposphere) + real :: tn1(5) !< temperature at node 1 (~mesosphere) + real :: tn2(4) !< temperature at node 2 (~stratosphere) + real :: tn3(5) !< temperature at node 3 (~troposphere) + real :: tgn1(2) !< temperature gradient at node 1 (~mesosphere) + real :: tgn2(2) !< temperature gradient at node 2 (~stratosphere) + real :: tgn3(2) !< temperature gradient at node 3 (~troposphere) ! - real :: pt(150) !< temperature - real :: pd(150,9) !< he density - real :: ps(150) !< s parameter - real :: pdl(25,2) !< turbo - real :: ptl(100,4) !< upper temperature - real :: pma(100,10) !< middle and low temperature - real :: sam(100) !< semiannual mult sam + real :: pt(150) !< temperature + real :: pd(150,9) !< he density + real :: ps(150) !< s parameter + real :: pdl(25,2) !< turbo + real :: ptl(100,4) !< upper temperature + real :: pma(100,10) !< middle and low temperature + real :: sam(100) !< semiannual mult sam ! - real :: sw(25) !< weighting - real :: swc(25) !< weighting + real :: sw(25) !< weighting + real :: swc(25) !< weighting ! - real :: dm04 !< mixed density at alt04 - real :: dm16 !< mixed density at alt16 - real :: dm28 !< mixed density at alt28 - real :: dm32 !< mixed density at alt32 - real :: dm40 !< mixed density at alt40 - real :: dm01 !< mixed density at alt01 - real :: dm14 !< mixed density at alt14 + real :: dm04 !< mixed density at alt04 + real :: dm16 !< mixed density at alt16 + real :: dm28 !< mixed density at alt28 + real :: dm32 !< mixed density at alt32 + real :: dm40 !< mixed density at alt40 + real :: dm01 !< mixed density at alt01 + real :: dm14 !< mixed density at alt14 ! - real :: gsurf !< surface gravitation force at given latitude - real :: re !< referenced height related to gsurf + real :: gsurf !< surface gravitation force at given latitude + real :: re !< referenced height related to gsurf ! - real :: tinfg !< startinf referenced point for tt - real :: tt(15) !< referenced temperature + real :: tinfg !< startinf referenced point for tt + real :: tt(15) !< referenced temperature ! - real :: plg(9,4) !< Legendre polynomial points - real :: ctloc !< cosine of the location - real :: stloc !< sine of the location - real :: c2tloc !< cosine of 2 time location - real :: s2tloc !< sine of 2 time location - real :: c3tloc !< cosine of 3 time location - real :: s3tloc !< sine of 3 time location - real :: day !< day in a year - real :: df !< the difference of f10.7 effect - real :: dfa !< the difference to reference value - real :: apd !< parameter calcumate for magnetic activity - real :: apdf !< the same as apd - real :: apt(4) !< daily magnetic activity - real :: xlong !< a given longitude + real :: plg(9,4) !< Legendre polynomial points + real :: ctloc !< cosine of the location + real :: stloc !< sine of the location + real :: c2tloc !< cosine of 2 time location + real :: s2tloc !< sine of 2 time location + real :: c3tloc !< cosine of 3 time location + real :: s3tloc !< sine of 3 time location + real :: day !< day in a year + real :: df !< the difference of f10.7 effect + real :: dfa !< the difference to reference value + real :: apd !< parameter calcumate for magnetic activity + real :: apdf !< the same as apd + real :: apt(4) !< daily magnetic activity + real :: xlong !< a given longitude ! - integer :: isw !< indix for sw - integer :: iyr !< integer for a given year + integer :: isw !< indix for sw + integer :: iyr !< integer for a given year ! end module gettemp_mod @@ -1265,7 +1265,6 @@ subroutine gtd7(iyd,sec,alt,glat,glong,stl,f107a,f107,ap,mass,d,t) ! **** o density **** d(2)=0 d(9)=0 - 216 continue ! ***** o2 density **** d(4)=0 if(mass.ne.32.and.mass.ne.48) goto 232 @@ -2055,7 +2054,7 @@ function globe7(yrd,sec,lat,long,tloc,f107a,f107,ap,p) 10 end do if(sw(9).gt.0) sw9=1. if(sw(9).lt.0) sw9=-1. - iyr = yrd/1000. + iyr = nint(yrd/1000.) day = yrd - iyr*1000. xlong=long ! eq. a22 (remainder of code) From ffe25e52719c9d592d0603d8a68cbf02a3a14e64 Mon Sep 17 00:00:00 2001 From: George Gayno Date: Wed, 14 Dec 2022 13:49:43 +0000 Subject: [PATCH 03/19] Remove warnings from model_grid.F90. Fixes #736 --- sorc/chgres_cube.fd/model_grid.F90 | 14 ++++++-------- 1 file changed, 6 insertions(+), 8 deletions(-) diff --git a/sorc/chgres_cube.fd/model_grid.F90 b/sorc/chgres_cube.fd/model_grid.F90 index cdd91336b..f0630e5c0 100644 --- a/sorc/chgres_cube.fd/model_grid.F90 +++ b/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,12 +606,11 @@ 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 @@ -620,7 +618,7 @@ subroutine define_input_grid_grib2(localpet,npets) implicit none - integer, intent(in) :: localpet, npets + integer, intent(in) :: npets character(len=500) :: the_file From 814332c808bf4ded01619e79fffc2eda1954e5ea Mon Sep 17 00:00:00 2001 From: George Gayno Date: Wed, 14 Dec 2022 20:48:24 +0000 Subject: [PATCH 04/19] Fix some warnings in input_data.F90 Fixes #736. --- sorc/chgres_cube.fd/input_data.F90 | 32 +++++++++++++++--------------- sorc/chgres_cube.fd/utils.F90 | 2 +- 2 files changed, 17 insertions(+), 17 deletions(-) diff --git a/sorc/chgres_cube.fd/input_data.F90 b/sorc/chgres_cube.fd/input_data.F90 index 193d295de..12ad2aef2 100644 --- a/sorc/chgres_cube.fd/input_data.F90 +++ b/sorc/chgres_cube.fd/input_data.F90 @@ -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 @@ -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 @@ -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 diff --git a/sorc/chgres_cube.fd/utils.F90 b/sorc/chgres_cube.fd/utils.F90 index 568d0de0e..b57b040a9 100644 --- a/sorc/chgres_cube.fd/utils.F90 +++ b/sorc/chgres_cube.fd/utils.F90 @@ -18,7 +18,7 @@ subroutine error_handler(string, rc) integer :: ierr - print*,"- FATAL ERROR: ", string + print*,"- FATAL ERROR: ", trim(string) print*,"- IOSTAT IS: ", rc call mpi_abort(mpi_comm_world, 999, ierr) From 5e5f3ff4421d53dc1770b099a1451ecfb6bda7c8 Mon Sep 17 00:00:00 2001 From: George Gayno Date: Wed, 14 Dec 2022 20:57:52 +0000 Subject: [PATCH 05/19] Removed unused variables. Fixes #736. --- sorc/chgres_cube.fd/input_data.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/sorc/chgres_cube.fd/input_data.F90 b/sorc/chgres_cube.fd/input_data.F90 index 12ad2aef2..226a08b54 100644 --- a/sorc/chgres_cube.fd/input_data.F90 +++ b/sorc/chgres_cube.fd/input_data.F90 @@ -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 From 926d150d991110b722d07a9914a9ac8bf155b1da Mon Sep 17 00:00:00 2001 From: George Gayno Date: Thu, 15 Dec 2022 13:34:14 +0000 Subject: [PATCH 06/19] Remove warnings from surface.F90 Fixes #736. --- sorc/chgres_cube.fd/surface.F90 | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/sorc/chgres_cube.fd/surface.F90 b/sorc/chgres_cube.fd/surface.F90 index 8213d17ba..a5a9eef3c 100644 --- a/sorc/chgres_cube.fd/surface.F90 +++ b/sorc/chgres_cube.fd/surface.F90 @@ -2010,7 +2010,8 @@ subroutine adjust_soil_levels(localpet) soilm_liq_input_grid, soilm_tot_input_grid implicit none integer, intent(in) :: localpet - character(len=1000) :: msg + character(len=500) :: msg + character(len=2) :: lsoil_input_ch, lsoil_target_ch integer :: rc real(esmf_kind_r8) :: tmp(i_input,j_input), & data_one_tile(i_input,j_input,lsoil_input), & @@ -2105,12 +2106,11 @@ subroutine adjust_soil_levels(localpet) elseif (lsoil_input /= lsoil_target) then rc = -1 - - write(msg,'("NUMBER OF SOIL LEVELS IN INPUT (",I2,") and OUPUT & - (",I2,") MUST EITHER BE EQUAL OR 9 AND 4, RESPECTIVELY")') & - lsoil_input, lsoil_target - - call error_handler(trim(msg), rc) + write(lsoil_input_ch, '(i2)') lsoil_input + write(lsoil_target_ch, '(i2)') lsoil_target + msg="NUMBER OF SOIL LEVELS IN INPUT " // lsoil_input_ch // " AND OUTPUT " & + // lsoil_target_ch // " MUST EITHER BE EQUAL OR 9 AND 4 RESPECTIVELY." + call error_handler(msg, rc) endif end subroutine adjust_soil_levels From 37e14f2b454b16d66bf395e261fb5ad9c9ba7584 Mon Sep 17 00:00:00 2001 From: George Gayno Date: Thu, 15 Dec 2022 14:21:12 +0000 Subject: [PATCH 07/19] Remove some warnings from write_data.F90 Fixes #736. --- sorc/chgres_cube.fd/write_data.F90 | 88 +++++++++++++++--------------- 1 file changed, 44 insertions(+), 44 deletions(-) diff --git a/sorc/chgres_cube.fd/write_data.F90 b/sorc/chgres_cube.fd/write_data.F90 index 57b9a2983..4731ed549 100644 --- a/sorc/chgres_cube.fd/write_data.F90 +++ b/sorc/chgres_cube.fd/write_data.F90 @@ -659,16 +659,16 @@ subroutine write_fv3_atm_bndy_data_netcdf(localpet) call error_handler("IN FieldGather", error) if (localpet == 0) then - dum2d_top(:,:) = data_one_tile(i_start_top:i_end_top, j_start_top:j_end_top) + dum2d_top(:,:) = real(data_one_tile(i_start_top:i_end_top, j_start_top:j_end_top),kind=4) error = nf90_put_var( ncid, id_ps_top, dum2d_top) call netcdf_err(error, 'WRITING PS TOP' ) - dum2d_bottom(:,:) = data_one_tile(i_start_bottom:i_end_bottom, j_start_bottom:j_end_bottom) + dum2d_bottom(:,:) = real(data_one_tile(i_start_bottom:i_end_bottom, j_start_bottom:j_end_bottom),kind=4) error = nf90_put_var( ncid, id_ps_bottom, dum2d_bottom) call netcdf_err(error, 'WRITING PS BOTTOM' ) - dum2d_left(:,:) = data_one_tile(i_start_left:i_end_left, j_start_left:j_end_left) + dum2d_left(:,:) = real(data_one_tile(i_start_left:i_end_left, j_start_left:j_end_left),kind=4) error = nf90_put_var( ncid, id_ps_left, dum2d_left) call netcdf_err(error, 'WRITING PS LEFT' ) - dum2d_right(:,:) = data_one_tile(i_start_right:i_end_right, j_start_right:j_end_right) + dum2d_right(:,:) = real(data_one_tile(i_start_right:i_end_right, j_start_right:j_end_right),kind=4) error = nf90_put_var( ncid, id_ps_right, dum2d_right) call netcdf_err(error, 'WRITING PS RIGHT' ) endif @@ -697,19 +697,19 @@ subroutine write_fv3_atm_bndy_data_netcdf(localpet) call error_handler("IN FieldGather", error) if (localpet == 0) then - dum3d_top(:,:,:) = data_one_tile_3d(i_start_top:i_end_top,j_start_top:j_end_top,:) + dum3d_top(:,:,:) = real(data_one_tile_3d(i_start_top:i_end_top,j_start_top:j_end_top,:),kind=4) dum3d_top(:,:,1:levp1_target) = dum3d_top(:,:,levp1_target:1:-1) error = nf90_put_var( ncid, id_zh_top, dum3d_top) call netcdf_err(error, 'WRITING ZH TOP' ) - dum3d_bottom(:,:,:) = data_one_tile_3d(i_start_bottom:i_end_bottom,j_start_bottom:j_end_bottom,:) + dum3d_bottom(:,:,:) = real(data_one_tile_3d(i_start_bottom:i_end_bottom,j_start_bottom:j_end_bottom,:),kind=4) dum3d_bottom(:,:,1:levp1_target) = dum3d_bottom(:,:,levp1_target:1:-1) error = nf90_put_var( ncid, id_zh_bottom, dum3d_bottom) call netcdf_err(error, 'WRITING ZH BOTTOM' ) - dum3d_left(:,:,:) = data_one_tile_3d(i_start_left:i_end_left,j_start_left:j_end_left,:) + dum3d_left(:,:,:) = real(data_one_tile_3d(i_start_left:i_end_left,j_start_left:j_end_left,:),kind=4) dum3d_left(:,:,1:levp1_target) = dum3d_left(:,:,levp1_target:1:-1) error = nf90_put_var( ncid, id_zh_left, dum3d_left) call netcdf_err(error, 'WRITING ZH LEFT' ) - dum3d_right(:,:,:) = data_one_tile_3d(i_start_right:i_end_right,j_start_right:j_end_right,:) + dum3d_right(:,:,:) = real(data_one_tile_3d(i_start_right:i_end_right,j_start_right:j_end_right,:),kind=4) dum3d_right(:,:,1:levp1_target) = dum3d_right(:,:,levp1_target:1:-1) error = nf90_put_var( ncid, id_zh_right, dum3d_right) call netcdf_err(error, 'WRITING ZH RIGHT' ) @@ -741,19 +741,19 @@ subroutine write_fv3_atm_bndy_data_netcdf(localpet) call error_handler("IN FieldGather", error) if (localpet == 0) then - dum3d_top(:,:,:) = data_one_tile_3d(i_start_top:i_end_top,j_start_top:j_end_top,:) + dum3d_top(:,:,:) = real(data_one_tile_3d(i_start_top:i_end_top,j_start_top:j_end_top,:),kind=4) dum3d_top(:,:,1:lev_target) = dum3d_top(:,:,lev_target:1:-1) error = nf90_put_var( ncid, id_tracer_top(n), dum3d_top) call netcdf_err(error, 'WRITING TRACER TOP' ) - dum3d_bottom(:,:,:) = data_one_tile_3d(i_start_bottom:i_end_bottom,j_start_bottom:j_end_bottom,:) + dum3d_bottom(:,:,:) = real(data_one_tile_3d(i_start_bottom:i_end_bottom,j_start_bottom:j_end_bottom,:),kind=4) dum3d_bottom(:,:,1:lev_target) = dum3d_bottom(:,:,lev_target:1:-1) error = nf90_put_var( ncid, id_tracer_bottom(n), dum3d_bottom) call netcdf_err(error, 'WRITING TRACER BOTTOM' ) - dum3d_left(:,:,:) = data_one_tile_3d(i_start_left:i_end_left,j_start_left:j_end_left,:) + dum3d_left(:,:,:) = real(data_one_tile_3d(i_start_left:i_end_left,j_start_left:j_end_left,:),kind=4) dum3d_left(:,:,1:lev_target) = dum3d_left(:,:,lev_target:1:-1) error = nf90_put_var( ncid, id_tracer_left(n), dum3d_left) call netcdf_err(error, 'WRITING TRACER LEFT' ) - dum3d_right(:,:,:) = data_one_tile_3d(i_start_right:i_end_right,j_start_right:j_end_right,:) + dum3d_right(:,:,:) = real(data_one_tile_3d(i_start_right:i_end_right,j_start_right:j_end_right,:),kind=4) dum3d_right(:,:,1:lev_target) = dum3d_right(:,:,lev_target:1:-1) error = nf90_put_var( ncid, id_tracer_right(n), dum3d_right) call netcdf_err(error, 'WRITING TRACER RIGHT' ) @@ -769,19 +769,19 @@ subroutine write_fv3_atm_bndy_data_netcdf(localpet) call error_handler("IN FieldGather", error) if (localpet == 0) then - dum3d_top(:,:,:) = data_one_tile_3d(i_start_top:i_end_top,j_start_top:j_end_top,:) + dum3d_top(:,:,:) = real(data_one_tile_3d(i_start_top:i_end_top,j_start_top:j_end_top,:),kind=4) dum3d_top(:,:,1:lev_target) = dum3d_top(:,:,lev_target:1:-1) error = nf90_put_var( ncid, id_w_top, dum3d_top) call netcdf_err(error, 'WRITING W TOP' ) - dum3d_bottom(:,:,:) = data_one_tile_3d(i_start_bottom:i_end_bottom,j_start_bottom:j_end_bottom,:) + dum3d_bottom(:,:,:) = real(data_one_tile_3d(i_start_bottom:i_end_bottom,j_start_bottom:j_end_bottom,:),kind=4) dum3d_bottom(:,:,1:lev_target) = dum3d_bottom(:,:,lev_target:1:-1) error = nf90_put_var( ncid, id_w_bottom, dum3d_bottom) call netcdf_err(error, 'WRITING W BOTTOM' ) - dum3d_left(:,:,:) = data_one_tile_3d(i_start_left:i_end_left,j_start_left:j_end_left,:) + dum3d_left(:,:,:) = real(data_one_tile_3d(i_start_left:i_end_left,j_start_left:j_end_left,:),kind=4) dum3d_left(:,:,1:lev_target) = dum3d_left(:,:,lev_target:1:-1) error = nf90_put_var( ncid, id_w_left, dum3d_left) call netcdf_err(error, 'WRITING W LEFT' ) - dum3d_right(:,:,:) = data_one_tile_3d(i_start_right:i_end_right,j_start_right:j_end_right,:) + dum3d_right(:,:,:) = real(data_one_tile_3d(i_start_right:i_end_right,j_start_right:j_end_right,:),kind=4) dum3d_right(:,:,1:lev_target) = dum3d_right(:,:,lev_target:1:-1) error = nf90_put_var( ncid, id_w_right, dum3d_right) call netcdf_err(error, 'WRITING W RIGHT' ) @@ -795,19 +795,19 @@ subroutine write_fv3_atm_bndy_data_netcdf(localpet) call error_handler("IN FieldGather", error) if (localpet == 0) then - dum3d_top(:,:,:) = data_one_tile_3d(i_start_top:i_end_top,j_start_top:j_end_top,:) + dum3d_top(:,:,:) = real(data_one_tile_3d(i_start_top:i_end_top,j_start_top:j_end_top,:),kind=4) dum3d_top(:,:,1:lev_target) = dum3d_top(:,:,lev_target:1:-1) error = nf90_put_var( ncid, id_t_top, dum3d_top) call netcdf_err(error, 'WRITING T TOP' ) - dum3d_bottom(:,:,:) = data_one_tile_3d(i_start_bottom:i_end_bottom,j_start_bottom:j_end_bottom,:) + dum3d_bottom(:,:,:) = real(data_one_tile_3d(i_start_bottom:i_end_bottom,j_start_bottom:j_end_bottom,:),kind=4) dum3d_bottom(:,:,1:lev_target) = dum3d_bottom(:,:,lev_target:1:-1) error = nf90_put_var( ncid, id_t_bottom, dum3d_bottom) call netcdf_err(error, 'WRITING T BOTTOM' ) - dum3d_left(:,:,:) = data_one_tile_3d(i_start_left:i_end_left,j_start_left:j_end_left,:) + dum3d_left(:,:,:) = real(data_one_tile_3d(i_start_left:i_end_left,j_start_left:j_end_left,:),kind=4) dum3d_left(:,:,1:lev_target) = dum3d_left(:,:,lev_target:1:-1) error = nf90_put_var( ncid, id_t_left, dum3d_left) call netcdf_err(error, 'WRITING T LEFT' ) - dum3d_right(:,:,:) = data_one_tile_3d(i_start_right:i_end_right,j_start_right:j_end_right,:) + dum3d_right(:,:,:) = real(data_one_tile_3d(i_start_right:i_end_right,j_start_right:j_end_right,:),kind=4) dum3d_right(:,:,1:lev_target) = dum3d_right(:,:,lev_target:1:-1) error = nf90_put_var( ncid, id_t_right, dum3d_right) call netcdf_err(error, 'WRITING T RIGHT' ) @@ -821,19 +821,19 @@ subroutine write_fv3_atm_bndy_data_netcdf(localpet) call error_handler("IN FieldGather", error) if (localpet == 0) then - dum3d_top(:,:,:) = data_one_tile_3d(i_start_top:i_end_top,j_start_top:j_end_top,:) + dum3d_top(:,:,:) = real(data_one_tile_3d(i_start_top:i_end_top,j_start_top:j_end_top,:),kind=4) dum3d_top(:,:,1:lev_target) = dum3d_top(:,:,lev_target:1:-1) error = nf90_put_var( ncid, id_qnifa_top, dum3d_top) call netcdf_err(error, 'WRITING QNIFA CLIMO TOP' ) - dum3d_bottom(:,:,:) = data_one_tile_3d(i_start_bottom:i_end_bottom,j_start_bottom:j_end_bottom,:) + dum3d_bottom(:,:,:) = real(data_one_tile_3d(i_start_bottom:i_end_bottom,j_start_bottom:j_end_bottom,:),kind=4) dum3d_bottom(:,:,1:lev_target) = dum3d_bottom(:,:,lev_target:1:-1) error = nf90_put_var( ncid, id_qnifa_bottom, dum3d_bottom) call netcdf_err(error, 'WRITING QNIFA CLIMO BOTTOM' ) - dum3d_left(:,:,:) = data_one_tile_3d(i_start_left:i_end_left,j_start_left:j_end_left,:) + dum3d_left(:,:,:) = real(data_one_tile_3d(i_start_left:i_end_left,j_start_left:j_end_left,:),kind=4) dum3d_left(:,:,1:lev_target) = dum3d_left(:,:,lev_target:1:-1) error = nf90_put_var( ncid, id_qnifa_left, dum3d_left) call netcdf_err(error, 'WRITING QNIFA CLIMO LEFT' ) - dum3d_right(:,:,:) = data_one_tile_3d(i_start_right:i_end_right,j_start_right:j_end_right,:) + dum3d_right(:,:,:) = real(data_one_tile_3d(i_start_right:i_end_right,j_start_right:j_end_right,:),kind=4) dum3d_right(:,:,1:lev_target) = dum3d_right(:,:,lev_target:1:-1) error = nf90_put_var( ncid, id_qnifa_right, dum3d_right) call netcdf_err(error, 'WRITING QNIFA CLIMO RIGHT' ) @@ -845,19 +845,19 @@ subroutine write_fv3_atm_bndy_data_netcdf(localpet) call error_handler("IN FieldGather", error) if (localpet == 0) then - dum3d_top(:,:,:) = data_one_tile_3d(i_start_top:i_end_top,j_start_top:j_end_top,:) + dum3d_top(:,:,:) = real(data_one_tile_3d(i_start_top:i_end_top,j_start_top:j_end_top,:),kind=4) dum3d_top(:,:,1:lev_target) = dum3d_top(:,:,lev_target:1:-1) error = nf90_put_var( ncid, id_qnwfa_top, dum3d_top) call netcdf_err(error, 'WRITING QNWFA CLIMO TOP' ) - dum3d_bottom(:,:,:) = data_one_tile_3d(i_start_bottom:i_end_bottom,j_start_bottom:j_end_bottom,:) + dum3d_bottom(:,:,:) = real(data_one_tile_3d(i_start_bottom:i_end_bottom,j_start_bottom:j_end_bottom,:),kind=4) dum3d_bottom(:,:,1:lev_target) = dum3d_bottom(:,:,lev_target:1:-1) error = nf90_put_var( ncid, id_qnwfa_bottom, dum3d_bottom) call netcdf_err(error, 'WRITING QNWFA CLIMO BOTTOM' ) - dum3d_left(:,:,:) = data_one_tile_3d(i_start_left:i_end_left,j_start_left:j_end_left,:) + dum3d_left(:,:,:) = real(data_one_tile_3d(i_start_left:i_end_left,j_start_left:j_end_left,:),kind=4) dum3d_left(:,:,1:lev_target) = dum3d_left(:,:,lev_target:1:-1) error = nf90_put_var( ncid, id_qnwfa_left, dum3d_left) call netcdf_err(error, 'WRITING QNWFA CLIMO LEFT' ) - dum3d_right(:,:,:) = data_one_tile_3d(i_start_right:i_end_right,j_start_right:j_end_right,:) + dum3d_right(:,:,:) = real(data_one_tile_3d(i_start_right:i_end_right,j_start_right:j_end_right,:),kind=4) dum3d_right(:,:,1:lev_target) = dum3d_right(:,:,lev_target:1:-1) error = nf90_put_var( ncid, id_qnwfa_right, dum3d_right) call netcdf_err(error, 'WRITING QNWFA CLIMO RIGHT' ) @@ -977,19 +977,19 @@ subroutine write_fv3_atm_bndy_data_netcdf(localpet) call error_handler("IN FieldGather", error) if (localpet == 0) then - dum3d_top(:,:,:) = data_one_tile_3d(i_start_top:i_end_top,j_start_top:j_end_top,:) + dum3d_top(:,:,:) = real(data_one_tile_3d(i_start_top:i_end_top,j_start_top:j_end_top,:),kind=4) dum3d_top(:,:,1:lev_target) = dum3d_top(:,:,lev_target:1:-1) error = nf90_put_var( ncid, id_u_s_top, dum3d_top) call netcdf_err(error, 'WRITING U_S TOP' ) - dum3d_bottom(:,:,:) = data_one_tile_3d(i_start_bottom:i_end_bottom,j_start_bottom:j_end_bottom,:) + dum3d_bottom(:,:,:) = real(data_one_tile_3d(i_start_bottom:i_end_bottom,j_start_bottom:j_end_bottom,:),kind=4) dum3d_bottom(:,:,1:lev_target) = dum3d_bottom(:,:,lev_target:1:-1) error = nf90_put_var( ncid, id_u_s_bottom, dum3d_bottom) call netcdf_err(error, 'WRITING U_S BOTTOM' ) - dum3d_left(:,:,:) = data_one_tile_3d(i_start_left:i_end_left,j_start_left:j_end_left,:) + dum3d_left(:,:,:) = real(data_one_tile_3d(i_start_left:i_end_left,j_start_left:j_end_left,:),kind=4) dum3d_left(:,:,1:lev_target) = dum3d_left(:,:,lev_target:1:-1) error = nf90_put_var( ncid, id_u_s_left, dum3d_left) call netcdf_err(error, 'WRITING U_S LEFT' ) - dum3d_right(:,:,:) = data_one_tile_3d(i_start_right:i_end_right,j_start_right:j_end_right,:) + dum3d_right(:,:,:) = real(data_one_tile_3d(i_start_right:i_end_right,j_start_right:j_end_right,:),kind=4) dum3d_right(:,:,1:lev_target) = dum3d_right(:,:,lev_target:1:-1) error = nf90_put_var( ncid, id_u_s_right, dum3d_right) call netcdf_err(error, 'WRITING U_S RIGHT' ) @@ -1003,19 +1003,19 @@ subroutine write_fv3_atm_bndy_data_netcdf(localpet) call error_handler("IN FieldGather", error) if (localpet == 0) then - dum3d_top(:,:,:) = data_one_tile_3d(i_start_top:i_end_top,j_start_top:j_end_top,:) + dum3d_top(:,:,:) = real(data_one_tile_3d(i_start_top:i_end_top,j_start_top:j_end_top,:),kind=4) dum3d_top(:,:,1:lev_target) = dum3d_top(:,:,lev_target:1:-1) error = nf90_put_var( ncid, id_v_s_top, dum3d_top) call netcdf_err(error, 'WRITING V_S TOP' ) - dum3d_bottom(:,:,:) = data_one_tile_3d(i_start_bottom:i_end_bottom,j_start_bottom:j_end_bottom,:) + dum3d_bottom(:,:,:) = real(data_one_tile_3d(i_start_bottom:i_end_bottom,j_start_bottom:j_end_bottom,:),kind=4) dum3d_bottom(:,:,1:lev_target) = dum3d_bottom(:,:,lev_target:1:-1) error = nf90_put_var( ncid, id_v_s_bottom, dum3d_bottom) call netcdf_err(error, 'WRITING V_S BOTTOM' ) - dum3d_left(:,:,:) = data_one_tile_3d(i_start_left:i_end_left,j_start_left:j_end_left,:) + dum3d_left(:,:,:) = real(data_one_tile_3d(i_start_left:i_end_left,j_start_left:j_end_left,:),kind=4) dum3d_left(:,:,1:lev_target) = dum3d_left(:,:,lev_target:1:-1) error = nf90_put_var( ncid, id_v_s_left, dum3d_left) call netcdf_err(error, 'WRITING V_S LEFT' ) - dum3d_right(:,:,:) = data_one_tile_3d(i_start_right:i_end_right,j_start_right:j_end_right,:) + dum3d_right(:,:,:) = real(data_one_tile_3d(i_start_right:i_end_right,j_start_right:j_end_right,:),kind=4) dum3d_right(:,:,1:lev_target) = dum3d_right(:,:,lev_target:1:-1) error = nf90_put_var( ncid, id_v_s_right, dum3d_right) call netcdf_err(error, 'WRITING V_S RIGHT' ) @@ -1133,19 +1133,19 @@ subroutine write_fv3_atm_bndy_data_netcdf(localpet) call error_handler("IN FieldGather", error) if (localpet == 0) then - dum3d_top(:,:,:) = data_one_tile_3d(i_start_top:i_end_top,j_start_top:j_end_top,:) + dum3d_top(:,:,:) = real(data_one_tile_3d(i_start_top:i_end_top,j_start_top:j_end_top,:),kind=4) dum3d_top(:,:,1:lev_target) = dum3d_top(:,:,lev_target:1:-1) error = nf90_put_var( ncid, id_u_w_top, dum3d_top) call netcdf_err(error, 'WRITING U_W TOP' ) - dum3d_bottom(:,:,:) = data_one_tile_3d(i_start_bottom:i_end_bottom,j_start_bottom:j_end_bottom,:) + dum3d_bottom(:,:,:) = real(data_one_tile_3d(i_start_bottom:i_end_bottom,j_start_bottom:j_end_bottom,:),kind=4) dum3d_bottom(:,:,1:lev_target) = dum3d_bottom(:,:,lev_target:1:-1) error = nf90_put_var( ncid, id_u_w_bottom, dum3d_bottom) call netcdf_err(error, 'WRITING U_W BOTTOM' ) - dum3d_left(:,:,:) = data_one_tile_3d(i_start_left:i_end_left,j_start_left:j_end_left,:) + dum3d_left(:,:,:) = real(data_one_tile_3d(i_start_left:i_end_left,j_start_left:j_end_left,:),kind=4) dum3d_left(:,:,1:lev_target) = dum3d_left(:,:,lev_target:1:-1) error = nf90_put_var( ncid, id_u_w_left, dum3d_left) call netcdf_err(error, 'WRITING U_W LEFT' ) - dum3d_right(:,:,:) = data_one_tile_3d(i_start_right:i_end_right,j_start_right:j_end_right,:) + dum3d_right(:,:,:) = real(data_one_tile_3d(i_start_right:i_end_right,j_start_right:j_end_right,:),kind=4) dum3d_right(:,:,1:lev_target) = dum3d_right(:,:,lev_target:1:-1) error = nf90_put_var( ncid, id_u_w_right, dum3d_right) call netcdf_err(error, 'WRITING U_W RIGHT' ) @@ -1159,19 +1159,19 @@ subroutine write_fv3_atm_bndy_data_netcdf(localpet) call error_handler("IN FieldGather", error) if (localpet == 0) then - dum3d_top(:,:,:) = data_one_tile_3d(i_start_top:i_end_top,j_start_top:j_end_top,:) + dum3d_top(:,:,:) = real(data_one_tile_3d(i_start_top:i_end_top,j_start_top:j_end_top,:),kind=4) dum3d_top(:,:,1:lev_target) = dum3d_top(:,:,lev_target:1:-1) error = nf90_put_var( ncid, id_v_w_top, dum3d_top) call netcdf_err(error, 'WRITING V_W TOP' ) - dum3d_bottom(:,:,:) = data_one_tile_3d(i_start_bottom:i_end_bottom,j_start_bottom:j_end_bottom,:) + dum3d_bottom(:,:,:) = real(data_one_tile_3d(i_start_bottom:i_end_bottom,j_start_bottom:j_end_bottom,:),kind=4) dum3d_bottom(:,:,1:lev_target) = dum3d_bottom(:,:,lev_target:1:-1) error = nf90_put_var( ncid, id_v_w_bottom, dum3d_bottom) call netcdf_err(error, 'WRITING V_W BOTTOM' ) - dum3d_left(:,:,:) = data_one_tile_3d(i_start_left:i_end_left,j_start_left:j_end_left,:) + dum3d_left(:,:,:) = real(data_one_tile_3d(i_start_left:i_end_left,j_start_left:j_end_left,:),kind=4) dum3d_left(:,:,1:lev_target) = dum3d_left(:,:,lev_target:1:-1) error = nf90_put_var( ncid, id_v_w_left, dum3d_left) call netcdf_err(error, 'WRITING V_W LEFT' ) - dum3d_right(:,:,:) = data_one_tile_3d(i_start_right:i_end_right,j_start_right:j_end_right,:) + dum3d_right(:,:,:) = real(data_one_tile_3d(i_start_right:i_end_right,j_start_right:j_end_right,:),kind=4) dum3d_right(:,:,1:lev_target) = dum3d_right(:,:,lev_target:1:-1) error = nf90_put_var( ncid, id_v_w_right, dum3d_right) call netcdf_err(error, 'WRITING V_W RIGHT' ) From bc7e2e5956b9f0fe6381c8b28354c6f03fa49e94 Mon Sep 17 00:00:00 2001 From: George Gayno Date: Thu, 15 Dec 2022 15:17:40 +0000 Subject: [PATCH 08/19] Remove remaining warnings from write_data.F90 Fixes #736. --- sorc/chgres_cube.fd/write_data.F90 | 42 +++++++++++++++--------------- 1 file changed, 21 insertions(+), 21 deletions(-) diff --git a/sorc/chgres_cube.fd/write_data.F90 b/sorc/chgres_cube.fd/write_data.F90 index 4731ed549..caa5a48ec 100644 --- a/sorc/chgres_cube.fd/write_data.F90 +++ b/sorc/chgres_cube.fd/write_data.F90 @@ -1445,7 +1445,7 @@ subroutine write_fv3_atm_data_netcdf(localpet) enddo if (localpet < num_tiles_target_grid) then - dum2d(:,:) = data_one_tile(i_start:i_end, j_start:j_end) + dum2d(:,:) = real(data_one_tile(i_start:i_end, j_start:j_end),kind=4) error = nf90_put_var( ncid, id_lon, dum2d) call netcdf_err(error, 'WRITING LONGITUDE RECORD' ) endif @@ -1460,7 +1460,7 @@ subroutine write_fv3_atm_data_netcdf(localpet) enddo if (localpet < num_tiles_target_grid) then - dum2d(:,:) = data_one_tile(i_start:i_end, j_start:j_end) + dum2d(:,:) = real(data_one_tile(i_start:i_end, j_start:j_end),kind=4) error = nf90_put_var( ncid, id_lat, dum2d) call netcdf_err(error, 'WRITING LATITUDE RECORD' ) endif @@ -1475,7 +1475,7 @@ subroutine write_fv3_atm_data_netcdf(localpet) enddo if (localpet < num_tiles_target_grid) then - dum2d(:,:) = data_one_tile(i_start:i_end, j_start:j_end) + dum2d(:,:) = real(data_one_tile(i_start:i_end, j_start:j_end),kind=4) error = nf90_put_var( ncid, id_ps, dum2d) call netcdf_err(error, 'WRITING SURFACE PRESSURE RECORD' ) endif @@ -1500,7 +1500,7 @@ subroutine write_fv3_atm_data_netcdf(localpet) enddo if (localpet < num_tiles_target_grid) then - dum3d(:,:,:) = data_one_tile_3d(i_start:i_end,j_start:j_end,:) + dum3d(:,:,:) = real(data_one_tile_3d(i_start:i_end,j_start:j_end,:),kind=4) dum3d(:,:,1:levp1_target) = dum3d(:,:,levp1_target:1:-1) error = nf90_put_var( ncid, id_zh, dum3d) call netcdf_err(error, 'WRITING HEIGHT RECORD' ) @@ -1526,7 +1526,7 @@ subroutine write_fv3_atm_data_netcdf(localpet) enddo if (localpet < num_tiles_target_grid) then - dum3d(:,:,:) = data_one_tile_3d(i_start:i_end,j_start:j_end,:) + dum3d(:,:,:) = real(data_one_tile_3d(i_start:i_end,j_start:j_end,:),kind=4) dum3d(:,:,1:lev_target) = dum3d(:,:,lev_target:1:-1) print*,"MIN MAX W AT WRITE = ", minval(dum3d(:,:,:)), maxval(dum3d(:,:,:)) error = nf90_put_var( ncid, id_w, dum3d) @@ -1543,7 +1543,7 @@ subroutine write_fv3_atm_data_netcdf(localpet) enddo if (localpet < num_tiles_target_grid) then - dum3d(:,:,:) = data_one_tile_3d(i_start:i_end,j_start:j_end,:) + dum3d(:,:,:) = real(data_one_tile_3d(i_start:i_end,j_start:j_end,:),kind=4) dum3d(:,:,1:lev_target) = dum3d(:,:,lev_target:1:-1) error = nf90_put_var( ncid, id_delp, dum3d) call netcdf_err(error, 'WRITING DELP RECORD' ) @@ -1559,7 +1559,7 @@ subroutine write_fv3_atm_data_netcdf(localpet) enddo if (localpet < num_tiles_target_grid) then - dum3d(:,:,:) = data_one_tile_3d(i_start:i_end,j_start:j_end,:) + dum3d(:,:,:) = real(data_one_tile_3d(i_start:i_end,j_start:j_end,:),kind=4) dum3d(:,:,1:lev_target) = dum3d(:,:,lev_target:1:-1) error = nf90_put_var( ncid, id_t, dum3d) call netcdf_err(error, 'WRITING TEMPERTAURE RECORD' ) @@ -1577,7 +1577,7 @@ subroutine write_fv3_atm_data_netcdf(localpet) enddo if (localpet < num_tiles_target_grid) then - dum3d(:,:,:) = data_one_tile_3d(i_start:i_end,j_start:j_end,:) + dum3d(:,:,:) = real(data_one_tile_3d(i_start:i_end,j_start:j_end,:),kind=4) dum3d(:,:,1:lev_target) = dum3d(:,:,lev_target:1:-1) error = nf90_put_var( ncid, id_tracers(n), dum3d) call netcdf_err(error, 'WRITING TRACER RECORD' ) @@ -1596,7 +1596,7 @@ subroutine write_fv3_atm_data_netcdf(localpet) enddo if (localpet < num_tiles_target_grid) then - dum3d(:,:,:) = data_one_tile_3d(i_start:i_end,j_start:j_end,:) + dum3d(:,:,:) = real(data_one_tile_3d(i_start:i_end,j_start:j_end,:),kind=4) dum3d(:,:,1:lev_target) = dum3d(:,:,lev_target:1:-1) error = nf90_put_var( ncid, id_qnifa, dum3d) call netcdf_err(error, 'WRITING QNIFA RECORD' ) @@ -1612,7 +1612,7 @@ subroutine write_fv3_atm_data_netcdf(localpet) enddo if (localpet < num_tiles_target_grid) then - dum3d(:,:,:) = data_one_tile_3d(i_start:i_end,j_start:j_end,:) + dum3d(:,:,:) = real(data_one_tile_3d(i_start:i_end,j_start:j_end,:),kind=4) dum3d(:,:,1:lev_target) = dum3d(:,:,lev_target:1:-1) error = nf90_put_var( ncid, id_qnwfa, dum3d) call netcdf_err(error, 'WRITING QNWFA RECORD' ) @@ -1639,7 +1639,7 @@ subroutine write_fv3_atm_data_netcdf(localpet) enddo if (localpet < num_tiles_target_grid) then - dum2d(:,:) = data_one_tile(i_start:i_end,j_start:jp1_end) + dum2d(:,:) = real(data_one_tile(i_start:i_end,j_start:jp1_end),kind=4) error = nf90_put_var( ncid, id_lon_s, dum2d) call netcdf_err(error, 'WRITING LON_S RECORD' ) endif @@ -1652,7 +1652,7 @@ subroutine write_fv3_atm_data_netcdf(localpet) enddo if (localpet < num_tiles_target_grid) then - dum2d(:,:) = data_one_tile(i_start:i_end,j_start:jp1_end) + dum2d(:,:) = real(data_one_tile(i_start:i_end,j_start:jp1_end),kind=4) error = nf90_put_var( ncid, id_lat_s, dum2d) call netcdf_err(error, 'WRITING LAT_S RECORD' ) endif @@ -1677,7 +1677,7 @@ subroutine write_fv3_atm_data_netcdf(localpet) enddo if (localpet < num_tiles_target_grid) then - dum3d(:,:,:) = data_one_tile_3d(i_start:i_end,j_start:jp1_end,:) + dum3d(:,:,:) = real(data_one_tile_3d(i_start:i_end,j_start:jp1_end,:),kind=4) dum3d(:,:,1:lev_target) = dum3d(:,:,lev_target:1:-1) print*,"MIN MAX US AT WRITE = ", minval(dum3d(:,:,:)), maxval(dum3d(:,:,:)) error = nf90_put_var( ncid, id_u_s, dum3d) @@ -1694,7 +1694,7 @@ subroutine write_fv3_atm_data_netcdf(localpet) enddo if (localpet < num_tiles_target_grid) then - dum3d(:,:,:) = data_one_tile_3d(i_start:i_end,j_start:jp1_end,:) + dum3d(:,:,:) = real(data_one_tile_3d(i_start:i_end,j_start:jp1_end,:),kind=4) dum3d(:,:,1:lev_target) = dum3d(:,:,lev_target:1:-1) print*,"MIN MAX VS AT WRITE = ", minval(dum3d(:,:,:)), maxval(dum3d(:,:,:)) error = nf90_put_var( ncid, id_v_s, dum3d) @@ -1721,7 +1721,7 @@ subroutine write_fv3_atm_data_netcdf(localpet) enddo if (localpet < num_tiles_target_grid) then - dum2d(:,:) = data_one_tile(i_start:ip1_end,j_start:j_end) + dum2d(:,:) = real(data_one_tile(i_start:ip1_end,j_start:j_end),kind=4) error = nf90_put_var( ncid, id_lon_w, dum2d) call netcdf_err(error, 'WRITING LON_W RECORD' ) endif @@ -1734,7 +1734,7 @@ subroutine write_fv3_atm_data_netcdf(localpet) enddo if (localpet < num_tiles_target_grid) then - dum2d(:,:) = data_one_tile(i_start:ip1_end,j_start:j_end) + dum2d(:,:) = real(data_one_tile(i_start:ip1_end,j_start:j_end),kind=4) error = nf90_put_var( ncid, id_lat_w, dum2d) call netcdf_err(error, 'WRITING LAT_W RECORD' ) endif @@ -1759,7 +1759,7 @@ subroutine write_fv3_atm_data_netcdf(localpet) enddo if (localpet < num_tiles_target_grid) then - dum3d(:,:,:) = data_one_tile_3d(i_start:ip1_end,j_start:j_end,:) + dum3d(:,:,:) = real(data_one_tile_3d(i_start:ip1_end,j_start:j_end,:),kind=4) dum3d(:,:,1:lev_target) = dum3d(:,:,lev_target:1:-1) print*,"MIN MAX UW AT WRITE = ", minval(dum3d(:,:,:)), maxval(dum3d(:,:,:)) error = nf90_put_var( ncid, id_u_w, dum3d) @@ -1776,7 +1776,7 @@ subroutine write_fv3_atm_data_netcdf(localpet) enddo if (localpet < num_tiles_target_grid) then - dum3d(:,:,:) = data_one_tile_3d(i_start:ip1_end,j_start:j_end,:) + dum3d(:,:,:) = real(data_one_tile_3d(i_start:ip1_end,j_start:j_end,:),kind=4) dum3d(:,:,1:lev_target) = dum3d(:,:,lev_target:1:-1) print*,"MIN MAX VW AT WRITE = ", minval(dum3d(:,:,:)), maxval(dum3d(:,:,:)) error = nf90_put_var( ncid, id_v_w, dum3d) @@ -1916,17 +1916,17 @@ subroutine write_fv3_sfc_data_netcdf(localpet) allocate(lsoil_data(lsoil_target)) do i = 1, lsoil_target - lsoil_data(i) = float(i) + lsoil_data(i) = real(float(i),kind=4) enddo allocate(x_data(i_target_out)) do i = 1, i_target_out - x_data(i) = float(i) + x_data(i) = real(float(i),kind=4) enddo allocate(y_data(j_target_out)) do i = 1, j_target_out - y_data(i) = float(i) + y_data(i) = real(float(i),kind=4) enddo if (convert_nst) then From 6a91ac64f7638d91fc625cdb60d224d9f63f4154 Mon Sep 17 00:00:00 2001 From: George Gayno Date: Thu, 15 Dec 2022 18:59:00 +0000 Subject: [PATCH 09/19] Remove final warning from surface.F90. Fixes #736. --- sorc/chgres_cube.fd/surface.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/sorc/chgres_cube.fd/surface.F90 b/sorc/chgres_cube.fd/surface.F90 index a5a9eef3c..49d70d9a8 100644 --- a/sorc/chgres_cube.fd/surface.F90 +++ b/sorc/chgres_cube.fd/surface.F90 @@ -647,7 +647,7 @@ subroutine interp(localpet) mask_input_ptr = 1 where (nint(landmask_input_ptr) == 1) mask_input_ptr = 0 - mask_target_ptr = seamask_target_ptr + mask_target_ptr = int(seamask_target_ptr,kind=esmf_kind_i4) method=ESMF_REGRIDMETHOD_CONSERVE From 6e8c131873215b1c08397b5093d82b002e4c4f06 Mon Sep 17 00:00:00 2001 From: George Gayno Date: Thu, 15 Dec 2022 20:02:03 +0000 Subject: [PATCH 10/19] Remove some warnings from input_data.F90 Fixes #736. --- sorc/chgres_cube.fd/input_data.F90 | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/sorc/chgres_cube.fd/input_data.F90 b/sorc/chgres_cube.fd/input_data.F90 index 226a08b54..753c72980 100644 --- a/sorc/chgres_cube.fd/input_data.F90 +++ b/sorc/chgres_cube.fd/input_data.F90 @@ -6879,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) From 67181ae99830ab05693b5b265b6fcd6ca04091c9 Mon Sep 17 00:00:00 2001 From: George Gayno Date: Fri, 16 Dec 2022 14:16:17 +0000 Subject: [PATCH 11/19] Remove warnings from grib1_utils.F90 Fixes #736. --- sorc/chgres_cube.fd/grib2_util.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/sorc/chgres_cube.fd/grib2_util.F90 b/sorc/chgres_cube.fd/grib2_util.F90 index 7bd6e7c78..d42951f10 100644 --- a/sorc/chgres_cube.fd/grib2_util.F90 +++ b/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=nint(min(xj,float(nxpvs)-1.0)) x=xmin+(jx-1)*xinc tr=con_ttp/x From e785b2df9250b3254184178ea98429ee30904104 Mon Sep 17 00:00:00 2001 From: George Gayno Date: Fri, 16 Dec 2022 14:51:59 +0000 Subject: [PATCH 12/19] Change a 'nint' to 'int' to ensure consistency tests pass. Fixes #736. --- sorc/chgres_cube.fd/grib2_util.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/sorc/chgres_cube.fd/grib2_util.F90 b/sorc/chgres_cube.fd/grib2_util.F90 index d42951f10..92479e840 100644 --- a/sorc/chgres_cube.fd/grib2_util.F90 +++ b/sorc/chgres_cube.fd/grib2_util.F90 @@ -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=nint(min(xj,float(nxpvs)-1.0)) + jx=int(min(xj,float(nxpvs)-1.0)) x=xmin+(jx-1)*xinc tr=con_ttp/x From 2f81bc9afbf6f7978c67fcb0b1e30db1b7f118ab Mon Sep 17 00:00:00 2001 From: George Gayno Date: Fri, 16 Dec 2022 15:32:47 +0000 Subject: [PATCH 13/19] Remove some warnings from input_data.F90. Fixes #736. --- sorc/chgres_cube.fd/input_data.F90 | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/sorc/chgres_cube.fd/input_data.F90 b/sorc/chgres_cube.fd/input_data.F90 index 753c72980..529fb8f7d 100644 --- a/sorc/chgres_cube.fd/input_data.F90 +++ b/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 @@ -5529,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 @@ -5576,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 @@ -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 From fbbdb4b585dd2533267788934f71fad7fd30e24c Mon Sep 17 00:00:00 2001 From: George Gayno Date: Fri, 16 Dec 2022 16:02:28 +0000 Subject: [PATCH 14/19] Remove some warnings from input_data.F90. Fixes #736. --- sorc/chgres_cube.fd/input_data.F90 | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/sorc/chgres_cube.fd/input_data.F90 b/sorc/chgres_cube.fd/input_data.F90 index 529fb8f7d..0cc25c0b1 100644 --- a/sorc/chgres_cube.fd/input_data.F90 +++ b/sorc/chgres_cube.fd/input_data.F90 @@ -6923,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:" @@ -6941,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) @@ -6956,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 From 4c1b8b36be81e7781ba07eff83ecc80c86e8def2 Mon Sep 17 00:00:00 2001 From: "George.Gayno" Date: Fri, 16 Dec 2022 18:08:07 +0000 Subject: [PATCH 15/19] Remove more warnings for input_data.F90. Fixes #736. --- sorc/chgres_cube.fd/input_data.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/sorc/chgres_cube.fd/input_data.F90 b/sorc/chgres_cube.fd/input_data.F90 index 0cc25c0b1..3e2a69a1e 100644 --- a/sorc/chgres_cube.fd/input_data.F90 +++ b/sorc/chgres_cube.fd/input_data.F90 @@ -5611,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 @@ -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) From c243c59b70c1e4d2fcfeba6c58c93a96e93485b5 Mon Sep 17 00:00:00 2001 From: "George.Gayno" Date: Fri, 16 Dec 2022 18:24:07 +0000 Subject: [PATCH 16/19] Remove more warnings from input_data.F90. Fixes #736. --- sorc/chgres_cube.fd/input_data.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/sorc/chgres_cube.fd/input_data.F90 b/sorc/chgres_cube.fd/input_data.F90 index 3e2a69a1e..9b7673a5d 100644 --- a/sorc/chgres_cube.fd/input_data.F90 +++ b/sorc/chgres_cube.fd/input_data.F90 @@ -7077,7 +7077,7 @@ subroutine gridrot(lov,latin1,latin2,lon,rot) log( tan(dtor*(90.0-latin1)/2.) / tan(dtor*(90.0-latin2)/2.)) 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 @@ -7125,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 From c38e35d10ad5bf77e8c6e7eaf4df86336d11e46d Mon Sep 17 00:00:00 2001 From: "George.Gayno" Date: Fri, 16 Dec 2022 18:44:07 +0000 Subject: [PATCH 17/19] Remove another warning from input_data.F90. Fixes #736. --- sorc/chgres_cube.fd/input_data.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/sorc/chgres_cube.fd/input_data.F90 b/sorc/chgres_cube.fd/input_data.F90 index 9b7673a5d..965d199d4 100644 --- a/sorc/chgres_cube.fd/input_data.F90 +++ b/sorc/chgres_cube.fd/input_data.F90 @@ -7073,8 +7073,8 @@ 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 = real((mod(lon - lov + 180. + 3600., 360.) - 180.), kind=esmf_kind_r4) From 4a67a132d4f3d972ce81aa4e1a06331828abf348 Mon Sep 17 00:00:00 2001 From: "George.Gayno" Date: Fri, 16 Dec 2022 19:08:04 +0000 Subject: [PATCH 18/19] Remove remaining warnings from input_data.F90. Fixes #736. --- sorc/chgres_cube.fd/input_data.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/sorc/chgres_cube.fd/input_data.F90 b/sorc/chgres_cube.fd/input_data.F90 index 965d199d4..3f8657485 100644 --- a/sorc/chgres_cube.fd/input_data.F90 +++ b/sorc/chgres_cube.fd/input_data.F90 @@ -7063,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 From 7b2977c1c262d7cc6e67587888e9e66730fadcd1 Mon Sep 17 00:00:00 2001 From: George Gayno Date: Mon, 19 Dec 2022 14:22:41 +0000 Subject: [PATCH 19/19] Change variable declaration in chgres test ftst_program_setup_varmaps.F90. Was failing. Fixes #736. --- tests/chgres_cube/ftst_program_setup_varmaps.F90 | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/tests/chgres_cube/ftst_program_setup_varmaps.F90 b/tests/chgres_cube/ftst_program_setup_varmaps.F90 index db192f58e..d52ab871c 100644 --- a/tests/chgres_cube/ftst_program_setup_varmaps.F90 +++ b/tests/chgres_cube/ftst_program_setup_varmaps.F90 @@ -4,6 +4,7 @@ program ftst_program_setup_varmaps use mpi + use esmf use program_setup implicit none integer :: my_rank, nprocs @@ -19,7 +20,7 @@ program ftst_program_setup_varmaps character(len=MAX_NAME_LEN) :: expected_missing_var_methods(EXPECTED_NUM_VARS) = [character(len=20):: 'set_to_fill', 'set_to_fill', & 'set_to_fill', 'set_to_fill', 'set_to_fill', 'set_to_fill', 'set_to_fill', 'set_to_fill', 'skip', 'skip', 'skip', 'set_to_fill', 'set_to_fill', & 'set_to_fill', 'set_to_fill', 'set_to_fill', 'stop', 'set_to_fill', 'stop', 'set_to_fill', 'set_to_fill', 'set_to_fill', 'set_to_fill'] - real :: expected_missing_var_values(EXPECTED_NUM_VARS) = (/ 0.0, 1E-7, 0.0, 1E-7, 0.0, 0.0, 0.0, 0.0, 0.0, & + real(kind=esmf_kind_r4) :: expected_missing_var_values(EXPECTED_NUM_VARS) = (/ 0.0, 1E-7, 0.0, 1E-7, 0.0, 0.0, 0.0, 0.0, 0.0, & 0.0, 0.0, 0.0, 0.01, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 1.5, 0.0, 0.0 /) character(len=MAX_NAME_LEN) :: expected_tracers_input(EXPECTED_NUM_TRACERS) = [character(len=20):: 'sphum', 'liq_wat', & 'o3mr', 'ice_wat', 'rainwat', 'snowwat', 'graupel'] @@ -44,6 +45,7 @@ program ftst_program_setup_varmaps if (trim(chgres_var_names(i)) .ne. trim(expected_var_names(i))) stop 3 if (trim(field_var_names(i)) .ne. trim(expected_field_names(i))) stop 4 if (trim(missing_var_methods(i)) .ne. trim(expected_missing_var_methods(i))) stop 5 + print*,'in loop ',i,missing_var_values(i),expected_missing_var_values(i) if (missing_var_values(i) .ne. expected_missing_var_values(i)) stop 6 if (read_from_input(i) .neqv. .true.) stop 7 end do