diff --git a/model/src/w3iopomd.F90 b/model/src/w3iopomd.F90 index bbdfda34c..420991ddd 100644 --- a/model/src/w3iopomd.F90 +++ b/model/src/w3iopomd.F90 @@ -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' @@ -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' @@ -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, & @@ -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 !/ @@ -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 + !/ !/ ------------------------------------------------------------------- / !/ @@ -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 @@ -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 )