Change FVCOM background IO to read 32-bit surface restart files. (ufs…

…-community#848)

Required by the RRFS system is using 32-bit CCPP.

Fixes ufs-community#847.

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)

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))

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

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/