From b3138f5f0050c23da1968c2e095894c2cb8218e6 Mon Sep 17 00:00:00 2001 From: GeorgeGayno-NOAA <52789452+GeorgeGayno-NOAA@users.noreply.github.com> Date: Tue, 3 Jan 2023 11:06:32 -0500 Subject: [PATCH] Remove compiler warnings from chgres_cube (#747) Fixes #736. --- sorc/chgres_cube.fd/atm_input_data.F90 | 34 +-- sorc/chgres_cube.fd/grib2_util.F90 | 6 +- sorc/chgres_cube.fd/model_grid.F90 | 14 +- sorc/chgres_cube.fd/program_setup.F90 | 49 ++-- sorc/chgres_cube.fd/sfc_input_data.F90 | 26 +- sorc/chgres_cube.fd/surface.F90 | 20 +- .../chgres_cube.fd/thompson_mp_climo_data.F90 | 1 + sorc/chgres_cube.fd/utils.F90 | 19 +- sorc/chgres_cube.fd/wam_climo_data.f90 | 265 +++++++++--------- sorc/chgres_cube.fd/write_data.F90 | 130 ++++----- .../ftst_program_setup_varmaps.F90 | 3 +- 11 files changed, 283 insertions(+), 284 deletions(-) diff --git a/sorc/chgres_cube.fd/atm_input_data.F90 b/sorc/chgres_cube.fd/atm_input_data.F90 index 56597ab70..cb9b1e87c 100644 --- a/sorc/chgres_cube.fd/atm_input_data.F90 +++ b/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 diff --git a/sorc/chgres_cube.fd/grib2_util.F90 b/sorc/chgres_cube.fd/grib2_util.F90 index 7bd6e7c78..92479e840 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=int(min(xj,float(nxpvs)-1.0)) x=xmin+(jx-1)*xinc tr=con_ttp/x diff --git a/sorc/chgres_cube.fd/model_grid.F90 b/sorc/chgres_cube.fd/model_grid.F90 index fa1d628c2..be52b4c64 100644 --- a/sorc/chgres_cube.fd/model_grid.F90 +++ b/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,12 +607,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 @@ -621,7 +619,7 @@ subroutine define_input_grid_grib2(localpet,npets) implicit none - integer, intent(in) :: localpet, npets + integer, intent(in) :: npets character(len=500) :: the_file diff --git a/sorc/chgres_cube.fd/program_setup.F90 b/sorc/chgres_cube.fd/program_setup.F90 index 1ab692065..1dcb4d22e 100644 --- a/sorc/chgres_cube.fd/program_setup.F90 +++ b/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,9 +305,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 !------------------------------------------------------------------------- @@ -316,14 +315,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 !------------------------------------------------------------------------- @@ -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 diff --git a/sorc/chgres_cube.fd/sfc_input_data.F90 b/sorc/chgres_cube.fd/sfc_input_data.F90 index c2233a95d..4ea4d7629 100644 --- a/sorc/chgres_cube.fd/sfc_input_data.F90 +++ b/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 diff --git a/sorc/chgres_cube.fd/surface.F90 b/sorc/chgres_cube.fd/surface.F90 index 46ae5a3a4..26066e362 100644 --- a/sorc/chgres_cube.fd/surface.F90 +++ b/sorc/chgres_cube.fd/surface.F90 @@ -120,7 +120,8 @@ subroutine surface_driver(localpet) use surface_target_data, only : cleanup_target_nst_data - use utilities, only : error_handler + use utilities, only : error_handler + implicit none integer, intent(in) :: localpet @@ -293,6 +294,7 @@ subroutine interp(localpet) xzts_input_grid, & z_c_input_grid, & zm_input_grid + use atm_input_data, only : terrain_input_grid use model_grid, only : input_grid, target_grid, & @@ -653,7 +655,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 @@ -2016,7 +2018,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), & @@ -2111,12 +2114,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 diff --git a/sorc/chgres_cube.fd/thompson_mp_climo_data.F90 b/sorc/chgres_cube.fd/thompson_mp_climo_data.F90 index 2c539cfdd..beb3c45a5 100644 --- a/sorc/chgres_cube.fd/thompson_mp_climo_data.F90 +++ b/sorc/chgres_cube.fd/thompson_mp_climo_data.F90 @@ -13,6 +13,7 @@ module thompson_mp_climo_data use program_setup, only : cycle_mon, cycle_day, cycle_hour, & thomp_mp_climo_file use utilities, only : error_handler, netcdf_err + implicit none private diff --git a/sorc/chgres_cube.fd/utils.F90 b/sorc/chgres_cube.fd/utils.F90 index 17dcc914a..c46540c5e 100644 --- a/sorc/chgres_cube.fd/utils.F90 +++ b/sorc/chgres_cube.fd/utils.F90 @@ -21,7 +21,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) @@ -131,6 +131,7 @@ subroutine handle_grib_error(vname,lev,method,value,varnum,read_from_input, iret 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 @@ -161,17 +162,17 @@ subroutine handle_grib_error(vname,lev,method,value,varnum,read_from_input, iret 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 @@ -320,7 +321,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 @@ -431,7 +432,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) 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) diff --git a/sorc/chgres_cube.fd/write_data.F90 b/sorc/chgres_cube.fd/write_data.F90 index d4bddb806..8334ae217 100644 --- a/sorc/chgres_cube.fd/write_data.F90 +++ b/sorc/chgres_cube.fd/write_data.F90 @@ -661,16 +661,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 @@ -699,19 +699,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' ) @@ -743,19 +743,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' ) @@ -771,19 +771,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' ) @@ -797,19 +797,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' ) @@ -823,19 +823,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' ) @@ -847,19 +847,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' ) @@ -979,19 +979,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' ) @@ -1005,19 +1005,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' ) @@ -1135,19 +1135,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' ) @@ -1161,19 +1161,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' ) @@ -1447,7 +1447,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 @@ -1462,7 +1462,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 @@ -1477,7 +1477,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 @@ -1502,7 +1502,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' ) @@ -1528,7 +1528,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) @@ -1545,7 +1545,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' ) @@ -1561,7 +1561,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' ) @@ -1579,7 +1579,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' ) @@ -1598,7 +1598,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' ) @@ -1614,7 +1614,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' ) @@ -1641,7 +1641,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 @@ -1654,7 +1654,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 @@ -1679,7 +1679,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) @@ -1696,7 +1696,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) @@ -1723,7 +1723,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 @@ -1736,7 +1736,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 @@ -1761,7 +1761,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) @@ -1778,7 +1778,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) @@ -1918,17 +1918,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 diff --git a/tests/chgres_cube/ftst_program_setup_varmaps.F90 b/tests/chgres_cube/ftst_program_setup_varmaps.F90 index db192f58e..0b466002f 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']