Skip to content

Commit

Permalink
have added writing/reading of netcdf file with weights for points
Browse files Browse the repository at this point in the history
  • Loading branch information
JessicaMeixner-NOAA committed Dec 2, 2024
1 parent cf16dd6 commit 040df5b
Showing 1 changed file with 147 additions and 5 deletions.
152 changes: 147 additions & 5 deletions model/src/w3iopomd.F90
Original file line number Diff line number Diff line change
Expand Up @@ -146,6 +146,10 @@ MODULE W3IOPOMD
!> Dimension name for the netCDF point output file, for WW3TIME
character(*), parameter, private :: DNAME_WW3TIME = 'WW3TIME'

!> Dimension name for the netCDF point weight file, WGHTLEN
!> This is 4 the dimension of weights
character(*), parameter, private :: DNAME_WGHTLEN = 'WGHTLEN'

!> Variable name for the netCDF point output file, for NK.
character(*), parameter, private :: VNAME_NK = 'NK'

Expand All @@ -158,6 +162,12 @@ MODULE W3IOPOMD
!> Variable name for the netCDF point output file, for PTNME.
character(*), parameter, private :: VNAME_PTNME = 'PTNME'

!> Variable name for the netCDF point weight file, for IPTINT
character(*), parameter, private :: VNAME_IPTINT = 'IPTINT'

!> Variable name for the netCDF point weight file, for PTIFAC
character(*), parameter, private :: VNAME_PTIFAC = 'PTIFAC'

!> Variable name for the netCDF point output file, for TIME.
character(*), parameter, private :: VNAME_TIME = 'TIME'

Expand Down Expand Up @@ -329,7 +339,8 @@ SUBROUTINE W3IOPP ( NPT, XPT, YPT, PNAMES, IMOD )
! 10. Source code :
!
!/ ------------------------------------------------------------------- /
USE W3GSRUMD
USE NETCDF
USE W3GSRUMD, ONLY: W3GRMP
USE W3GDATMD, ONLY: NTH, NK, NSPEC, NX, NY, X0, Y0, SX, GSU,&
RLGTYPE, CLGTYPE, UNGTYPE, GTYPE, FLAGLL, &
ICLOSE,ICLOSE_NONE,ICLOSE_SMPL,ICLOSE_TRPL, &
Expand All @@ -340,14 +351,15 @@ SUBROUTINE W3IOPP ( NPT, XPT, YPT, PNAMES, IMOD )
USE W3GDATMD, ONLY: PoLat, PoLon, FLAGUNR
USE W3SERVMD, ONLY: W3LLTOEQ
#endif
USE W3ODATMD, ONLY: W3DMO2
USE W3ODATMD, ONLY: W3DMO2, FNMPRE
USE W3ODATMD, ONLY: NDSE, NDST, IAPROC, NAPERR, NAPOUT, SCREEN, &
NOPTS, PTLOC, PTNME, GRDID, IPTINT, PTIFAC
USE W3SERVMD, ONLY: EXTCDE
#ifdef W3_S
USE W3SERVMD, ONLY: STRACE
#endif
USE W3TRIAMD
USE W3TRIAMD, ONLY: IS_IN_UNGRID
USE W3GDATMD, ONLY: FILEXT
!
IMPLICIT NONE
!/
Expand Down Expand Up @@ -389,6 +401,14 @@ SUBROUTINE W3IOPP ( NPT, XPT, YPT, PNAMES, IMOD )
!! Declare a few temporary variables for rotated grid. JGLi12Jun2012
REAL, ALLOCATABLE :: EquLon(:),EquLat(:),StdLon(:),StdLat(:),AnglPT(:)
#endif
! Variables for NetCDF weights file for points
character(len = 124) :: filename
logical :: pnt_wght_exists, pnt_wght_write
integer :: ncerr, fh
integer :: d_nopts, d_namelen, d_vsize, d_wghtlen
integer :: d_nopts_len, d_vsize_len,d_namelen_len,d_wghtlen_len
integer :: v_ptloc, v_ptnme, v_iptint, v_ptifac

!/
!/ ------------------------------------------------------------------- /
!/
Expand Down Expand Up @@ -423,10 +443,22 @@ SUBROUTINE W3IOPP ( NPT, XPT, YPT, PNAMES, IMOD )

#endif
!
! Removed by F.A. 2011/04/04 /T CALL W3GSUP( GSU, NDST )
!If unstructured grid, check to see if a netcdf point weight file exists:
filename = 'pnt_wght.'//FILEXT(:LEN_TRIM(FILEXT))//'.nc'
IF (GTYPE .NE. UNGTYPE) THEN
!skipping weights file for non-unstructured grids.
!likely could be used after proper testing if initialization time is long
pnt_wght_exists = .FALSE.
pnt_wght_write = .FALSE.
ELSE
!for unstructured grid, use saved weights file if exists:
INQUIRE(FILE=filename, EXIST=pnt_wght_exists)
pnt_wght_write = .NOT. pnt_wght_exists
ENDIF
!
! Loop over output points
! Loop over output points if saved weights do not exist
!
IF (.NOT. pnt_wght_exists) THEN
DO IPT=1, NPT
!
#ifdef W3_T
Expand Down Expand Up @@ -503,6 +535,116 @@ SUBROUTINE W3IOPP ( NPT, XPT, YPT, PNAMES, IMOD )
PTNME(NOPTS) = PNAMES(IPT)
!
END DO ! End loop over output points (IPT).
ELSE
!READ from file
!open file
! read NOPTS
! READ PTLOC
! READ IPTINT(2, 4, NOPTS)
! READ PTIFAC(4, NOPOTS)
! READ PTNME(NOPTS)

! Open the netCDF file.
ncerr = nf90_open(filename, NF90_NOWRITE, fh)
if (nf90_err(ncerr) .ne. 0) return

! Read the dimension information for NOPTS.
ncerr = nf90_inq_dimid(fh, DNAME_NOPTS, d_nopts)
if (nf90_err(ncerr) .ne. 0) return
ncerr = nf90_inquire_dimension(fh, d_nopts, len = d_nopts_len)
if (nf90_err(ncerr) .ne. 0) return
NOPTS=d_nopts_len

! Read the dimension information for VSIZE.
ncerr = nf90_inq_dimid(fh, DNAME_VSIZE, d_vsize)
if (nf90_err(ncerr) .ne. 0) return
ncerr = nf90_inquire_dimension(fh, d_vsize, len = d_vsize_len)
if (nf90_err(ncerr) .ne. 0) return

! Read the dimension information for NAMELEN.
ncerr = nf90_inq_dimid(fh, DNAME_NAMELEN, d_namelen)
if (nf90_err(ncerr) .ne. 0) return
ncerr = nf90_inquire_dimension(fh, d_namelen, len = d_namelen_len)
if (nf90_err(ncerr) .ne. 0) return

! Read the dimension information for WGHTLEN.
ncerr = nf90_inq_dimid(fh, DNAME_WGHTLEN, d_wghtlen)
if (nf90_err(ncerr) .ne. 0) return
ncerr = nf90_inquire_dimension(fh, d_wghtlen, len = d_wghtlen_len)
if (nf90_err(ncerr) .ne. 0) return

! Read vars
ncerr = nf90_inq_varid(fh, VNAME_PTLOC, v_ptloc)
if (nf90_err(ncerr) .ne. 0) return
ncerr = nf90_get_var(fh, v_ptloc, PTLOC, start = (/ 1, 1/), &
count = (/ d_vsize_len, d_nopts_len /))
if (nf90_err(ncerr) .ne. 0) return

ncerr = nf90_inq_varid(fh, VNAME_PTNME, v_ptnme)
if (nf90_err(ncerr) .ne. 0) return
ncerr = nf90_get_var(fh, v_ptnme, PTNME, start = (/ 1, 1/), &
count = (/ d_namelen_len, d_nopts_len /))
if (nf90_err(ncerr) .ne. 0) return

ncerr = nf90_inq_varid(fh, VNAME_IPTINT, v_iptint)
if (nf90_err(ncerr) .ne. 0) return
ncerr = nf90_get_var(fh, v_iptint, IPTINT, start = (/ 1, 1/), &
count = (/ d_vsize_len, d_wghtlen_len, d_nopts_len /))
if (nf90_err(ncerr) .ne. 0) return

ncerr = nf90_inq_varid(fh, VNAME_PTIFAC, v_ptifac)
if (nf90_err(ncerr) .ne. 0) return
ncerr = nf90_get_var(fh, v_ptifac, PTIFAC, start = (/ 1, 1/), &
count = (/ d_wghtlen_len, d_nopts_len /))
if (nf90_err(ncerr) .ne. 0) return

ENDIF
IF ( pnt_wght_write .AND. (NOPTS > 0) ) THEN

! Create the netCDF file.
ncerr = nf90_create(filename, NF90_NETCDF4, fh)
if (nf90_err(ncerr) .ne. 0) return

! Define dimensions.
ncerr = nf90_def_dim(fh, DNAME_NOPTS, NOPTS, d_nopts)
if (nf90_err(ncerr) .ne. 0) return
ncerr = nf90_def_dim(fh, DNAME_NAMELEN, 40, d_namelen)
if (nf90_err(ncerr) .ne. 0) return
ncerr = nf90_def_dim(fh, DNAME_VSIZE, 2, d_vsize)
if (nf90_err(ncerr) .ne. 0) return
ncerr = nf90_def_dim(fh, DNAME_WGHTLEN, 4, d_wghtlen)
if (nf90_err(ncerr) .ne. 0) return

! Define vars with nopts as a dimension. Point location and name
ncerr = nf90_def_var(fh, VNAME_PTLOC, NF90_FLOAT, (/d_vsize, d_nopts/), v_ptloc)
if (nf90_err(ncerr) .ne. 0) return
ncerr = nf90_def_var(fh, VNAME_PTNME, NF90_CHAR, (/d_namelen, d_nopts/), v_ptnme)
if (nf90_err(ncerr) .ne. 0) return
ncerr = nf90_def_var(fh, VNAME_IPTINT, NF90_FLOAT, (/d_vsize, d_wghtlen, d_nopts/), v_iptint)
if (nf90_err(ncerr) .ne. 0) return
ncerr = nf90_def_var(fh, VNAME_PTIFAC, NF90_FLOAT, (/d_wghtlen, d_nopts/), v_ptifac)
if (nf90_err(ncerr) .ne. 0) return

! End of all variable definitions
ncerr = nf90_enddef(fh)
if (nf90_err(ncerr) .ne. 0) return

!write variables to file
ncerr = nf90_put_var(fh, v_ptloc, PTLOC(:,1:NOPTS))
if (nf90_err(ncerr) .ne. 0) return
ncerr = nf90_put_var(fh, v_ptnme, PTNME(1:NOPTS))
if (nf90_err(ncerr) .ne. 0) return

ncerr = nf90_put_var(fh, v_iptint, IPTINT(:,:,1:NOPTS))
if (nf90_err(ncerr) .ne. 0) return
ncerr = nf90_put_var(fh, v_ptifac, PTIFAC(:,1:NOPTS))
if (nf90_err(ncerr) .ne. 0) return

! Close the file.
ncerr = nf90_close(fh)
if (nf90_err(ncerr) .ne. 0) return

ENDIF
!
#ifdef W3_RTD
DEALLOCATE( EquLon, EquLat, StdLon, StdLat, AnglPT )
Expand Down

0 comments on commit 040df5b

Please sign in to comment.