From 751bb1856ea345df12bfc708ac420e051ca4e1b5 Mon Sep 17 00:00:00 2001 From: Ming Hu Date: Wed, 4 Oct 2023 14:24:34 -0600 Subject: [PATCH] Change FVCOM background IO to read 32-bit surface restart files. (#848) Required by the RRFS system is using 32-bit CCPP. Fixes #847. --- sorc/fvcom_tools.fd/module_ncio.f90 | 34 ++++++++++-- sorc/fvcom_tools.fd/module_nwp.f90 | 62 +++++++++++++--------- sorc/fvcom_tools.fd/process_FVCOM.f90 | 20 +++---- tests/fvcom_tools/ftst_readfvcomnetcdf.F90 | 16 +++--- 4 files changed, 86 insertions(+), 46 deletions(-) diff --git a/sorc/fvcom_tools.fd/module_ncio.f90 b/sorc/fvcom_tools.fd/module_ncio.f90 index 00fc79be8..9abd999b4 100644 --- a/sorc/fvcom_tools.fd/module_ncio.f90 +++ b/sorc/fvcom_tools.fd/module_ncio.f90 @@ -2511,15 +2511,17 @@ end subroutine convert_theta2t_2dgrid !! @param[in] dname3 3rd dimension name !! @param[in] lname long name output for netcdf variable !! @param[in] units units to use in netcdf variable + !! @param[in] dtype date type of netcdf variable !! !! @author David.M.Wright org: UM/GLERL @date 2020-09-01 - subroutine add_new_var_3d(this,varname,dname1,dname2,dname3,lname,units) + subroutine add_new_var_3d(this,varname,dname1,dname2,dname3,lname,units,dtype) implicit none ! class(ncio) :: this character(len=*),intent(in) :: varname,dname1,dname2,dname3 & ,lname,units integer :: status, ncid, dim1id, dim2id, dim3id, varid + character(len=*),intent(in) :: dtype status = nf90_redef(this%ncid) !Enter Define Mode if (status /= nf90_noerr) call this%handle_err(status) @@ -2531,8 +2533,19 @@ subroutine add_new_var_3d(this,varname,dname1,dname2,dname3,lname,units) status = nf90_inq_dimid(this%ncid, dname3, dim3id) if (status /= nf90_noerr) call this%handle_err(status) - status = nf90_def_var(this%ncid, varname, nf90_double, & + if(trim(dtype)=="double") then + status = nf90_def_var(this%ncid, varname, nf90_double, & (/ dim1id, dim2id, dim3id /), varid) + elseif(trim(dtype)=="float") then + status = nf90_def_var(this%ncid, varname, nf90_float, & + (/ dim1id, dim2id, dim3id /), varid) + elseif(trim(dtype)=="int") then + status = nf90_def_var(this%ncid, varname, nf90_int, & + (/ dim1id, dim2id, dim3id /), varid) + else + write(*,*) ' undefined data type ', trim(dtype) + call this%handle_err(status) + endif if (status /= nf90_noerr) call this%handle_err(status) status = nf90_put_att(this%ncid, varid, 'long_name', lname) @@ -2555,15 +2568,17 @@ end subroutine add_new_var_3d !! @param[in] dname2 2nd dimension name !! @param[in] lname long name output for netcdf variable !! @param[in] units units to use in netcdf variable + !! @param[in] dtype data type of netcdf variable !! !! @author David.M.Wright org: UM/GLERL @date 2021-10-07 - subroutine add_new_var_2d(this,varname,dname1,dname2,lname,units) + subroutine add_new_var_2d(this,varname,dname1,dname2,lname,units,dtype) implicit none ! class(ncio) :: this character(len=*),intent(in) :: varname,dname1,dname2 & ,lname,units integer :: status, ncid, dim1id, dim2id, varid + character(len=*),intent(in) :: dtype status = nf90_redef(this%ncid) !Enter Define Mode if (status /= nf90_noerr) call this%handle_err(status) @@ -2573,8 +2588,19 @@ subroutine add_new_var_2d(this,varname,dname1,dname2,lname,units) status = nf90_inq_dimid(this%ncid, dname2, dim2id) if (status /= nf90_noerr) call this%handle_err(status) - status = nf90_def_var(this%ncid, varname, nf90_double, & + if(trim(dtype)=="double") then + status = nf90_def_var(this%ncid, varname, nf90_double, & + (/ dim1id, dim2id /), varid) + elseif(trim(dtype)=="float") then + status = nf90_def_var(this%ncid, varname, nf90_float, & (/ dim1id, dim2id /), varid) + elseif(trim(dtype)=="int") then + status = nf90_def_var(this%ncid, varname, nf90_int, & + (/ dim1id, dim2id /), varid) + else + write(*,*) ' undefined data type ', trim(dtype) + call this%handle_err(status) + endif if (status /= nf90_noerr) call this%handle_err(status) status = nf90_put_att(this%ncid, varid, 'long_name', lname) diff --git a/sorc/fvcom_tools.fd/module_nwp.f90 b/sorc/fvcom_tools.fd/module_nwp.f90 index 878233112..1967fd787 100644 --- a/sorc/fvcom_tools.fd/module_nwp.f90 +++ b/sorc/fvcom_tools.fd/module_nwp.f90 @@ -47,22 +47,22 @@ module module_nwp character(len=20), allocatable :: dimnameDATE !< String dimension name. character(len=1), allocatable :: times(:,:) !< Array of times in FVCOM. - real(r_kind), allocatable :: nwp_mask_c(:,:) !< cold start land/water mask 3d array - real(r_kind), allocatable :: nwp_sst_c(:,:,:) !< cold start sst 3d array - real(r_kind), allocatable :: nwp_ice_c(:,:,:) !< cold start over water ice concentration 3d array - real(r_kind), allocatable :: nwp_sfct_c(:,:,:) !< cold start skin temperature 3d array - real(r_kind), allocatable :: nwp_icet_c(:,:,:) !< cold start ice skin temperature 3d array - real(r_kind), allocatable :: nwp_zorl_c(:,:,:) !< cold start surface roughness - real(r_kind), allocatable :: nwp_hice_c(:,:,:) !< cold start ice thickness - - real(r_kind), allocatable :: nwp_mask_w(:,:) !< warm start land/water mask 3d array - real(r_kind), allocatable :: nwp_sst_w(:,:) !< warm start sst 3d array - real(r_kind), allocatable :: nwp_ice_w(:,:) !< warm start over water ice concentration 3d array - real(r_kind), allocatable :: nwp_sfct_w(:,:) !< warm start skin temperature 3d array - real(r_kind), allocatable :: nwp_icet_w(:,:) !< warm start ice skin temperature 3d array - real(r_kind), allocatable :: nwp_sfctl_w(:,:) !< warm start skin temperature 3d array - real(r_kind), allocatable :: nwp_zorl_w(:,:) !< warm start surface roughness - real(r_kind), allocatable :: nwp_hice_w(:,:) !< warm start ice thickness + real(r_single), allocatable :: nwp_mask_c(:,:) !< cold start land/water mask 3d array + real(r_single), allocatable :: nwp_sst_c(:,:,:) !< cold start sst 3d array + real(r_single), allocatable :: nwp_ice_c(:,:,:) !< cold start over water ice concentration 3d array + real(r_single), allocatable :: nwp_sfct_c(:,:,:) !< cold start skin temperature 3d array + real(r_single), allocatable :: nwp_icet_c(:,:,:) !< cold start ice skin temperature 3d array + real(r_single), allocatable :: nwp_zorl_c(:,:,:) !< cold start surface roughness + real(r_single), allocatable :: nwp_hice_c(:,:,:) !< cold start ice thickness + + real(r_single), allocatable :: nwp_mask_w(:,:) !< warm start land/water mask 3d array + real(r_single), allocatable :: nwp_sst_w(:,:) !< warm start sst 3d array + real(r_single), allocatable :: nwp_ice_w(:,:) !< warm start over water ice concentration 3d array + real(r_single), allocatable :: nwp_sfct_w(:,:) !< warm start skin temperature 3d array + real(r_single), allocatable :: nwp_icet_w(:,:) !< warm start ice skin temperature 3d array + real(r_single), allocatable :: nwp_sfctl_w(:,:) !< warm start skin temperature 3d array + real(r_single), allocatable :: nwp_zorl_w(:,:) !< warm start surface roughness + real(r_single), allocatable :: nwp_hice_w(:,:) !< warm start ice thickness contains procedure :: initial => initial_nwp !< Defines vars and names. @return @@ -267,9 +267,12 @@ subroutine read_nwp(this,filename,itype,wcstart,numlon,numlat,numtimes,time_to_g integer, intent(in) :: ybegin,yend integer, intent(inout) :: numlon, numlat, numtimes ! real(r_single), intent(inout) :: mask(:,:), sst(:,:), ice(:,:), sfcT(:,:) - real(r_kind), intent(inout) :: mask(:,:),sst(:,:),ice(:,:),sfcT(:,:) & + real(r_single), intent(inout) :: mask(:,:),sst(:,:),ice(:,:),sfcT(:,:) & ,iceT(:,:),sfcTl(:,:),zorl(:,:),hice(:,:) + real(r_kind),allocatable :: tmp2d8b(:,:) + real(r_kind),allocatable :: tmp3d8b(:,:,:) + ! ! Open the file using module_ncio.f90 code, and find the number of ! lat/lon points @@ -297,6 +300,8 @@ subroutine read_nwp(this,filename,itype,wcstart,numlon,numlat,numtimes,time_to_g allocate(this%nwp_iceT_c(this%xlon,this%xlat,this%xtime)) allocate(this%nwp_zorl_c(this%xlon,this%xlat,this%xtime)) allocate(this%nwp_hice_c(this%xlon,this%xlat,this%xtime)) + allocate(tmp2d8b(this%xlon,this%xlat)) + allocate(tmp3d8b(this%xlon,this%xlat,this%xtime)) ! Get variables from the data file, but only if the variable is ! defined for that data type. @@ -309,40 +314,49 @@ subroutine read_nwp(this,filename,itype,wcstart,numlon,numlat,numtimes,time_to_g if (this%i_mask .gt. 0) then call ncdata%get_var(this%varnames(this%i_mask),this%xlon, & - this%xlat,this%nwp_mask_c) + this%xlat,tmp2d8b) + this%nwp_mask_c=tmp2d8b mask = this%nwp_mask_c(:,ybegin:yend) end if if (this%i_sst .gt. 0) then write(6,*) 'get sst for cold or FVCOM' call ncdata%get_var(this%varnames(this%i_sst),this%xlon, & - this%xlat,this%xtime,this%nwp_sst_c) + this%xlat,this%xtime,tmp3d8b) + this%nwp_sst_c=tmp3d8b sst = this%nwp_sst_c(:,ybegin:yend,time_to_get) end if if (this%i_ice .gt. 0) then call ncdata%get_var(this%varnames(this%i_ice),this%xlon, & - this%xlat,this%xtime,this%nwp_ice_c) + this%xlat,this%xtime,tmp3d8b) + this%nwp_ice_c=tmp3d8b ice = this%nwp_ice_c(:,ybegin:yend,time_to_get) end if if (this%i_sfcT .gt. 0) then call ncdata%get_var(this%varnames(this%i_sfcT),this%xlon, & - this%xlat,this%xtime,this%nwp_sfcT_c) + this%xlat,this%xtime,tmp3d8b) + this%nwp_sfcT_c=tmp3d8b sfcT = this%nwp_sfcT_c(:,ybegin:yend,time_to_get) end if if (this%i_iceT .gt. 0) then call ncdata%get_var(this%varnames(this%i_iceT),this%xlon, & - this%xlat,this%xtime,this%nwp_iceT_c) + this%xlat,this%xtime,tmp3d8b) + this%nwp_iceT_c=tmp3d8b iceT = this%nwp_iceT_c(:,ybegin:yend,time_to_get) end if if (this%i_zorl .gt. 0) then call ncdata%get_var(this%varnames(this%i_zorl),this%xlon, & - this%xlat,this%xtime,this%nwp_zorl_c) + this%xlat,this%xtime,tmp3d8b) + this%nwp_zorl_c=tmp3d8b zorl = this%nwp_zorl_c(:,ybegin:yend,time_to_get) end if if (this%i_hice .gt. 0) then call ncdata%get_var(this%varnames(this%i_hice),this%xlon, & - this%xlat,this%xtime,this%nwp_hice_c) + this%xlat,this%xtime,tmp3d8b) + this%nwp_hice_c=tmp3d8b hice = this%nwp_hice_c(:,ybegin:yend,time_to_get) end if + deallocate(tmp2d8b) + deallocate(tmp3d8b) else if (wcstart == 'warm') then allocate(this%nwp_mask_w(this%xlon,this%xlat)) diff --git a/sorc/fvcom_tools.fd/process_FVCOM.f90 b/sorc/fvcom_tools.fd/process_FVCOM.f90 index c82121927..68ff9614e 100755 --- a/sorc/fvcom_tools.fd/process_FVCOM.f90 +++ b/sorc/fvcom_tools.fd/process_FVCOM.f90 @@ -77,14 +77,14 @@ program process_FVCOM integer :: fv3_io_layout_y integer,allocatable :: fv3_layout_begin(:),fv3_layout_end(:) - real(r_kind), allocatable :: fv3ice(:,:), fv3sst(:,:) - real(r_kind), allocatable :: fv3sfcT(:,:), fv3mask(:,:) - real(r_kind), allocatable :: fv3iceT(:,:), fv3sfcTl(:,:) - real(r_kind), allocatable :: fv3zorl(:,:), fv3hice(:,:) - real(r_kind), allocatable :: lbcice(:,:), lbcsst(:,:) - real(r_kind), allocatable :: lbcsfcT(:,:), lbcmask(:,:) - real(r_kind), allocatable :: lbciceT(:,:), lbczorl(:,:) - real(r_kind), allocatable :: lbchice(:,:) + real(r_single), allocatable :: fv3ice(:,:), fv3sst(:,:) + real(r_single), allocatable :: fv3sfcT(:,:), fv3mask(:,:) + real(r_single), allocatable :: fv3iceT(:,:), fv3sfcTl(:,:) + real(r_single), allocatable :: fv3zorl(:,:), fv3hice(:,:) + real(r_single), allocatable :: lbcice(:,:), lbcsst(:,:) + real(r_single), allocatable :: lbcsfcT(:,:), lbcmask(:,:) + real(r_single), allocatable :: lbciceT(:,:), lbczorl(:,:) + real(r_single), allocatable :: lbchice(:,:) ! Declare namelists ! SETUP (general control namelist) : @@ -378,14 +378,14 @@ program process_FVCOM if (wcstart == 'cold') then ! Add_New_Var takes names of (Variable,Dim1,Dim2,Dim3,Long_Name,Units) call geo%replace_var("zorl",NLON,NLAT,fv3zorl) - call geo%add_new_var('glmsk','xaxis_1','yaxis_1','Time','glmsk','none') + call geo%add_new_var('glmsk','xaxis_1','yaxis_1','Time','glmsk','none','float') call geo%replace_var('glmsk',NLON,NLAT,lbcmask) end if if (wcstart == 'warm') then call geo%replace_var("zorli",NLON,NLAT,fv3zorl) call geo%replace_var("tsfc",NLON,NLAT,fv3sfcT) call geo%replace_var("tsfcl",NLON,NLAT,fv3sfcTl) - call geo%add_new_var('glmsk','xaxis_1','yaxis_1','Time','glmsk','none') + call geo%add_new_var('glmsk','xaxis_1','yaxis_1','Time','glmsk','none','float') call geo%replace_var('glmsk',NLON,NLAT,lbcmask) end if call geo%close diff --git a/tests/fvcom_tools/ftst_readfvcomnetcdf.F90 b/tests/fvcom_tools/ftst_readfvcomnetcdf.F90 index a472f660f..71de50fb3 100644 --- a/tests/fvcom_tools/ftst_readfvcomnetcdf.F90 +++ b/tests/fvcom_tools/ftst_readfvcomnetcdf.F90 @@ -40,14 +40,14 @@ program readfvcomnetcdf real :: lbcvice_expected(NUM_VALUES) !expected fvcom ice thickness values ! Create allocabable arrays to read from .nc files - real, allocatable :: fv3ice(:,:), fv3sst(:,:) - real, allocatable :: fv3sfcT(:,:), fv3mask(:,:) - real, allocatable :: fv3iceT(:,:), fv3sfcTl(:,:) - real, allocatable :: fv3zorl(:,:), fv3hice(:,:) - real, allocatable :: lbcice(:,:), lbcsst(:,:) - real, allocatable :: lbcsfcT(:,:), lbcmask(:,:) - real, allocatable :: lbciceT(:,:), lbchice(:,:) - real, allocatable :: lbczorl(:,:) + real(4), allocatable :: fv3ice(:,:), fv3sst(:,:) + real(4), allocatable :: fv3sfcT(:,:), fv3mask(:,:) + real(4), allocatable :: fv3iceT(:,:), fv3sfcTl(:,:) + real(4), allocatable :: fv3zorl(:,:), fv3hice(:,:) + real(4), allocatable :: lbcice(:,:), lbcsst(:,:) + real(4), allocatable :: lbcsfcT(:,:), lbcmask(:,:) + real(4), allocatable :: lbciceT(:,:), lbchice(:,:) + real(4), allocatable :: lbczorl(:,:) ! Expected values from the dummy files data lat_lon_expected_values /5, 5/ data fv3mask_expected /1, 0/