ww3_uprstr.F90 File Reference

Contains the program W3UPRSTR. More...

Go to the source code of this file.

Functions/Subroutines
program	w3uprstr
	Update restart files based on Hs from DA. More...
subroutine	update_va (PRCNTG, VATMP)
	Apply correction to the spectrum. More...
subroutine	check_prcntg (PRCNTG, PRCNTG_CAP)
	Last sanity check before the update of the spectrum. More...
subroutine	read_grbtxt (UPDPRCNT, FLNMCOR, SMCGRD)
	Read gribtxt files. More...
subroutine	read_grbtxtws (UPDPRCNT, WSPD, WDIR, FLNMCOR, SMCGRD)
	Read txt files that include wind data. More...
subroutine	swh_rsrt_1p (VA1p, ISEA1p, HSIG1p)
	Calculate the significant wave height from the restart file for 1 point. More...
subroutine	swh_rsrt_1pw (VA1p, WS, WD, ISEA1p, HSIG1p, HSIGwp, HSIGsp, VAMAPWS)
	Calculate Hs from restart for 1 point. More...
subroutine	uvtocart (UVEC, VVEC, SPD, DCART, SMCGRD)
	Calculate speed and cartesian convention directions from u,v input vectors. More...
subroutine	updtwspec (VATMP, PRCNTG, VAMAPWS)
	Updates the wind-sea part of the wave spectrum only. More...
subroutine	updtwspecf (VATMP, PRCNTG, VAMAPWS, ISEA1p, ADJALL)
	Updates the wind-sea part of the wave spectrum and shifts in frequency space. More...
subroutine	writematrix (FILENAME, RDA_A)
	Writes a 2D array to text file, column by column. More...

Detailed Description

Contains the program W3UPRSTR.

Author

Stelios Flampouris

Date

16-Feb-2017

Definition in file ww3_uprstr.F90.

Function/Subroutine Documentation

check_prcntg()

subroutine w3uprstr::check_prcntg	(	real, intent(inout)	PRCNTG,
		real, intent(in)	PRCNTG_CAP
	)

Last sanity check before the update of the spectrum.

The percentage of change is compared against a user defined cap.

Parameters

[in,out]	PRCNTG
[in,out]	PRCNTG_CAP

Author

Stelios Flampouris

Date

16-Oct-2018

Definition at line 1278 of file ww3_uprstr.F90.

    !/
    !/                  +-----------------------------------+
    !/                  | WAVEWATCH III           NOAA/NCEP |
    !/                  |         Stelios Flampouris        |
    !/                  |                        FORTRAN 90 |
    !/                  | Created       :       16-Oct-2018 |
    !/                  +-----------------------------------+
    !/
    !/    16-Oct-2018 : Original Code                       ( version 6.06 )
    !/    24-Oct-2018 : Update by Andy Saulter              ( version 7.14 )
    !/
    !/    Copyright 2010 National Weather Service (NWS),
    !/    National Oceanic and Atmospheric Administration.  All rights
    !/    reserved.  WAVEWATCH III is a trademark of the NWS.
    !/    No unauthorized use without permission.
    !/
    !  1. Purpose :
    !     Last sanity check before the update of the spectrum
    !  2. Method :
    !     The percentage of change is compared against a user defined cap.
    !  3. Parameters :
    !
    !     Local parameters.
    !     ----------------------------------------------------------------
    !
    !  4. Subroutines used :
    !
    !     ----------------------------------------------------------------
    !  Internal Subroutines:
    !
    !  5. Called by :
    !
    !  6. Error messages :
    !
    !  7. Remarks :
    !
    !  8. Structure :
    !
    !  9. Switches :
    !
    !     !/T
    !
    ! 10. Source code :
    !
    !/
    REAL, INTENT(INOUT)  ::    PRCNTG
    REAL, INTENT(IN   )  ::    PRCNTG_CAP
    ! local
    CHARACTER(12), PARAMETER :: MYNAME='CHECK_PRCNTG'
#ifdef W3_T
 
    WRITE (ndso,*) trim(myname)," The original correction is ",prcntg
    WRITE (ndso,*) trim(myname)," The cap is ",prcntg_cap
#endif
    IF ( prcntg_cap < 1. ) THEN
      WRITE (ndso,*) trim(myname)," WARNING: PRCNTG_CAP set < 1."
      WRITE (ndso,*) trim(myname),"          This may introduce spurious corrections"
    END IF
#ifdef W3_T
    WRITE (ndso,*) trim(myname)," The cap is ",prcntg_cap
#endif
    IF ( prcntg > 1. ) THEN
#ifdef W3_T
      WRITE (ndso,*) trim(myname)," PRCNTG > 1."
#endif
      prcntg = min(prcntg, 1. * prcntg_cap)
    ELSE IF ( prcntg < 1. ) THEN
#ifdef W3_T
      WRITE (ndso,*) trim(myname)," PRCNTG < 1."
#endif
      prcntg = max(prcntg, 1. / prcntg_cap)
#ifdef W3_T
 
#endif
    END IF
#ifdef W3_T
    WRITE (ndso,*) trim(myname)," The updated correction is ",prcntg
#endif
    !

Referenced by w3uprstr().

read_grbtxt()

subroutine w3uprstr::read_grbtxt	(	real, dimension(:,:), intent(out)	UPDPRCNT,
		character(*), intent(in)	FLNMCOR,
		logical, intent(in)	SMCGRD
	)

Read gribtxt files.

Parameters

[in,out]	UPDPRCNT
[in,out]	FLNMCOR
[in,out]	SMCGRD

Author

Stelios Flampouris

Date

16-Oct-2018

Definition at line 1369 of file ww3_uprstr.F90.

    !/
    !/                  +-----------------------------------+
    !/                  | WAVEWATCH III           NOAA/NCEP |
    !/                  |         Stelios Flampouris        |
    !/                  |                        FORTRAN 90 |
    !/                  | Created       :       15-Mar-2017 |
    !/                  | Last Update   :       16-Oct-2018 |
    !/                  +-----------------------------------+
    !/
    !/    15-Mar-2017 : Original Code                       ( version 6.04 )
    !/    16-Oct-2018 : Generalization of the reader        ( version 6.06 )
    !/
    !/    Copyright 2010 National Weather Service (NWS),
    !/    National Oceanic and Atmospheric Administration.  All rights
    !/    reserved.  WAVEWATCH III is a trademark of the NWS.
    !/    No unauthorized use without permission.
    !/
    !  1. Purpose :
    !     Read gribtxt files
    !  2. Method :
    !
    !  3. Parameters :
    !
    !     Local parameters.
    !     ----------------------------------------------------------------
    !
    !  4. Subroutines used :
    !
    !     ----------------------------------------------------------------
    !  Internal Subroutines:
    !
    !  5. Called by :
    !
    !  6. Error messages :
    !
    !  7. Remarks :
    !
    !  8. Structure :
    !
    !  9. Switches :
    !
    !     !/T
    !
    ! 10. Source code :
    !
    !/
    REAL, DIMENSION(:,:), INTENT(OUT) :: UPDPRCNT
    CHARACTER(*), INTENT(IN) :: FLNMCOR
    LOGICAL, INTENT(IN) :: SMCGRD
    ! Local Variables
    INTEGER            :: I, J, IERR
    INTEGER            :: K, L, M, N
    REAL :: A
    INTEGER, PARAMETER :: IP_FID = 123
    CHARACTER(25), PARAMETER::myname='read_grbtxt'
    !
#ifdef W3_T
    WRITE (ndso,*) trim(myname), ' starts'
#endif
    j     = len_trim(fnmpre)
    OPEN (ip_fid,file=fnmpre(:j)//trim(flnmcor),status='OLD' &
         ,action='read',iostat=ierr)
    !
    ! Read text header and check dimensions match expected values
    IF (.NOT. smcgrd) THEN
      READ( ip_fid, *) m,n
      IF (( SIZE(updprcnt,1) /= n) .OR. ( SIZE(updprcnt,2) /= m )) THEN
        WRITE (ndso,*) trim(myname),': These are not the grid ' // &
             'dimensions: M=',m,' N=',n
        stop
      END IF
#ifdef W3_SMC
    ELSE
      READ( ip_fid, *) n
      IF ( SIZE(updprcnt,1) /= n ) THEN
        WRITE (ndso,*) trim(myname),': These are not the grid ' // &
             'dimensions: N=',n
        stop
      END IF
#endif
    END IF
    updprcnt=0
    !
    ! Read the data into its allocated array
    IF (.NOT. smcgrd) THEN
      DO l=1,n
        DO k=1,m
          a=0.
          READ(ip_fid,*)a
          updprcnt(n+1-l,k)=a
        END DO
      END DO
#ifdef W3_SMC
    ELSE
      DO l=1,n
        a=0.
        READ(ip_fid,*)a
        updprcnt(l,1)=a
      END DO
#endif
    END IF
    !
    CLOSE(ip_fid)
    !
#ifdef W3_T
    WRITE (ndso,*) trim(myname), ' ends'
#endif

References file().

Referenced by w3uprstr().

read_grbtxtws()

subroutine w3uprstr::read_grbtxtws	(	real, dimension(:,:), intent(out)	UPDPRCNT,
		real, dimension(:,:), intent(out)	WSPD,
		real, dimension(:,:), intent(out)	WDIR,
		character(*), intent(in)	FLNMCOR,
		logical, intent(in)	SMCGRD
	)

Read txt files that include wind data.

Parameters

[out]	UPDPRCNT
[out]	WSPD
[out]	WDIR
[in]	FLNMCOR
[in]	SMCGRD

Author

Andy Saulter

Date

24-Oct-2018

Definition at line 1492 of file ww3_uprstr.F90.

    !/
    !/                  +-----------------------------------+
    !/                  | WAVEWATCH III           NOAA/NCEP |
    !/                  |         Andy Saulter              |
    !/                  |                        FORTRAN 90 |
    !/                  | Original code :       24-Oct-2018 |
    !/                  | Last update :         05-Oct-2019 |
    !/                  +-----------------------------------+
    !/
    !/    24-Oct-2018 : Original Code                       ( version 6.07 )
    !/
    !/    Copyright 2010 National Weather Service (NWS),
    !/    National Oceanic and Atmospheric Administration.  All rights
    !/    reserved.  WAVEWATCH III is a trademark of the NWS.
    !/    No unauthorized use without permission.
    !/
    !  1. Purpose :
    !     Read txt files that include wind data
    !  2. Method :
    !
    !  3. Parameters :
    !
    !     Local parameters.
    !     ----------------------------------------------------------------
    !
    !  4. Subroutines used :
    !
    !     ----------------------------------------------------------------
    !  Internal Subroutines:
    !
    !  5. Called by :
    !
    !  6. Error messages :
    !
    !  7. Remarks :
    !
    !  8. Structure :
    !
    !  9. Switches :
    !
    !     !/T
    !
    ! 10. Source code :
    !
    !/
    REAL, DIMENSION(:,:), INTENT(OUT) :: UPDPRCNT, WSPD, WDIR
    CHARACTER(*), INTENT(IN) :: FLNMCOR
    LOGICAL, INTENT(IN) :: SMCGRD
    ! Local Variables
    INTEGER            :: I, J, IERR
    INTEGER            :: K, L, M, N
    REAL :: A, WS, WD
    INTEGER, PARAMETER :: IP_FID = 123
    CHARACTER(25), PARAMETER::myname='read_grbtxt'
    !
#ifdef W3_T
    WRITE (ndso,*) trim(myname), ' starts'
#endif
    j     = len_trim(fnmpre)
    OPEN (ip_fid,file=fnmpre(:j)//trim(flnmcor),status='OLD' &
         ,action='read',iostat=ierr)
    !
    ! Read text header and check dimensions match expected values
    IF (.NOT. smcgrd) THEN
      READ( ip_fid, *) m,n
      IF (( SIZE(updprcnt,1) /= n) .OR. ( SIZE(updprcnt,2) /= m )) THEN
        WRITE (ndso,*) trim(myname),': These are not the grid ' // &
             'dimensions: M=',m,' N=',n
        stop
      END IF
#ifdef W3_SMC
    ELSE
      READ( ip_fid, *) n
      IF ( SIZE(updprcnt,1) /= n ) THEN
        WRITE (ndso,*) trim(myname),': These are not the grid ' // &
             'dimensions: N=',n
        stop
      END IF
#endif
    END IF
    updprcnt=0
    wspd=0.
    wdir=0.
    !
    ! Read the data into allocated arrays
    IF (.NOT. smcgrd) THEN
      DO l=1,n
        DO k=1,m
          a=0.
          ws=0.
          wd=0.
          READ(ip_fid,*)a, ws, wd
          !SWH data read onto Y,X grid
          updprcnt(n+1-l,k)=a
          !Wind data read onto X,Y grid
          wspd(k,n+1-l)=ws
          wdir(k,n+1-l)=wd
        END DO
      END DO
#ifdef W3_SMC
    ELSE
      DO l=1,n
        a=0.
        READ(ip_fid,*)a, ws, wd
        updprcnt(l,1)=a
        wspd(l,1)=ws
        wdir(l,1)=wd
      END DO
#endif
    ENDIF
    !
    CLOSE(ip_fid)
    !
    !
#ifdef W3_T
    WRITE (ndso,*) trim(myname), ' ends'
#endif

References file().

Referenced by w3uprstr().

swh_rsrt_1p()

subroutine w3uprstr::swh_rsrt_1p	(	real, dimension(:), intent(in)	VA1p,
		integer, intent(in)	ISEA1p,
		real, intent(out)	HSIG1p
	)

Calculate the significant wave height from the restart file for 1 point.

Parameters

[in]	VA1p
[in]	ISEA1p
[out]	HSIG1p

Author

Stelios Flampouris

Date

15-May-2017

Definition at line 1621 of file ww3_uprstr.F90.

    !/
    !/                  +-----------------------------------+
    !/                  | WAVEWATCH III           NOAA/NCEP |
    !/                  |         Stelios Flampouris        |
    !/                  |                        FORTRAN 90 |
    !/                  | Last update :         15-Mar-2017 |
    !/                  +-----------------------------------+
    !/
    !/    15-Mar-2017 : Original Code                       ( version 6.04 )
    !/
    !/    Copyright 2010 National Weather Service (NWS),
    !/    National Oceanic and Atmospheric Administration.  All rights
    !/    reserved.  WAVEWATCH III is a trademark of the NWS.
    !/    No unauthorized use without permission.
    !/
    !  1. Purpose :
    !     Calculate the significant wave height from the restart file for 1 point
    !  2. Method :
    !
    !  3. Parameters :
    !
    !     Local parameters.
    !     ----------------------------------------------------------------
    !
    !  4. Subroutines used :
    !
    !     ----------------------------------------------------------------
    !  Internal Subroutines:
    !
    !  5. Called by :
    !
    !  6. Error messages :
    !
    !  7. Remarks :
    !
    !  8. Structure :
    !
    !  9. Switches :
    !
    !     !/T
    !
    ! 10. Source code :
    !
    !/
    REAL, INTENT(OUT) :: HSIG1p
    INTEGER, INTENT(IN) :: ISEA1p
    REAL, DIMENSION(:), INTENT(IN)  :: VA1p
    CHARACTER(25),PARAMETER :: myname='SWH_RSRT_1p'
    !
#ifdef W3_FT
    WRITE (ndso,*)' '
    WRITE (ndso,*) trim(myname), ' starts'
#endif
    hsig1p = 0.
    depth  = max( dmin , -zb(isea1p) )
    etot   = 0.
    !
    DO ik=1, nk
      CALL wavnu1 ( sig(ik), depth, wn, cg )
      e1i    = 0.
      DO ith=1, nth
        e1i    = e1i + va1p(ith+(ik-1)*nth)  *  sig(ik) / cg
      END DO
      etot   = etot + e1i*dsip(ik)
    END DO
    !
    hsig1p = 4. * sqrt( etot * dth )
    !
#ifdef W3_FT
    WRITE (ndso,*) ' ', trim(myname), ' ends'
    WRITE (ndso,*)' '
#endif

Referenced by w3uprstr().

swh_rsrt_1pw()

subroutine w3uprstr::swh_rsrt_1pw	(	real, dimension(:), intent(in)	VA1p,
		real, intent(in)	WS,
		real, intent(in)	WD,
		integer, intent(in)	ISEA1p,
		real, intent(out)	HSIG1p,
		real, intent(out)	HSIGwp,
		real, intent(out)	HSIGsp,
		integer, dimension(:), intent(out)	VAMAPWS
	)

Calculate Hs from restart for 1 point.

Calculate the significant wave height for total, wind sea and swell components from the restart file for 1 point

Parameters

[in]	VA1p
[in]	WS
[in]	WD
[in]	ISEA1p
[out]	HSIG1p
[out]	HSIGwp
[out]	HSIGsp
[out]	VAMAPWS

Author

Andy Saulter

Date

05-0ct-2019

Definition at line 1714 of file ww3_uprstr.F90.

    !/
    !/                  +-----------------------------------+
    !/                  | WAVEWATCH III           NOAA/NCEP |
    !/                  |         Andy Saulter              |
    !/                  |                        FORTRAN 90 |
    !/                  | Original code :       24-Oct-2018 |
    !/                  | Last update :         05-Oct-2019 |
    !/                  +-----------------------------------+
    !/
    !/    24-Oct-2018 : Original Code                       ( version 6.07 )
    !/
    !/    Copyright 2010 National Weather Service (NWS),
    !/    National Oceanic and Atmospheric Administration.  All rights
    !/    reserved.  WAVEWATCH III is a trademark of the NWS.
    !/    No unauthorized use without permission.
    !/
    !  1. Purpose :
    !     Calculate the significant wave height for total, wind sea and
    !     swell components from the restart file for 1 point
    !  2. Method :
    !
    !  3. Parameters :
    !
    !     Local parameters.
    !     ----------------------------------------------------------------
    !
    !  4. Subroutines used :
    !
    !     ----------------------------------------------------------------
    !  Internal Subroutines:
    !
    !  5. Called by :
    !
    !  6. Error messages :
    !
    !  7. Remarks :
    !
    !  8. Structure :
    !
    !  9. Switches :
    !
    !     !/T
    !
    ! 10. Source code :
    !
    !/
    USE w3gdatmd, ONLY: th
    USE w3odatmd, ONLY: wsmult !same wind sea cut-off factor for sea/swell outputs
    !
    REAL, INTENT(OUT) :: HSIG1p, HSIGwp, HSIGsp
    INTEGER, INTENT(IN) :: ISEA1p
    REAL, INTENT(IN) :: WS, WD
    REAL, DIMENSION(:), INTENT(IN)  :: VA1p
    INTEGER, DIMENSION(:), INTENT(OUT) :: VAMAPWS ! Wind-sea id for spectral bins
    REAL :: RELWS, ETOTw, ETOTs, EwI, EsI
    CHARACTER(25),PARAMETER :: myname='SWH_RSRT_1pw'
    !
#ifdef W3_T
    WRITE (ndso,*) trim(myname), ' starts'
#endif
    hsig1p = 0.
    hsigwp = 0.
    hsigsp = 0.
    depth  = max( dmin , -zb(isea1p) )
    etot   = 0.
    etotw  = 0.
    etots  = 0.
    !
    DO ik=1, nk
      CALL wavnu1 ( sig(ik), depth, wn, cg )
      e1i    = 0.
      ewi    = 0.
      esi    = 0.
      DO ith=1, nth
        ! Relative wind-sea calc assumes input with in direction toward
        ! i.e. same as for the wave spectrum
        relws = wsmult * ws * max(0.0, cos(wd - th(ith)))
        e1i    = e1i + va1p(ith+(ik-1)*nth) * sig(ik) / cg
        IF ( relws > (sig(ik)/wn) ) THEN
          ewi = ewi + va1p(ith+(ik-1)*nth) * sig(ik) / cg
          vamapws(ith+(ik-1)*nth) = 1
        ELSE
          esi = esi + va1p(ith+(ik-1)*nth) * sig(ik) / cg
          vamapws(ith+(ik-1)*nth) = 0
        END IF
      END DO
      etot   = etot + e1i*dsip(ik)
      etotw  = etotw + ewi*dsip(ik)
      etots  = etots + esi*dsip(ik)
    END DO
    !
    hsig1p = 4. * sqrt( etot * dth )
    hsigwp = 4. * sqrt( etotw * dth )
    hsigsp = 4. * sqrt( etots * dth )
    !
#ifdef W3_T
    WRITE (ndso,*) trim(myname), ' ends'
#endif

References w3gdatmd::th, and w3odatmd::wsmult.

Referenced by w3uprstr().

update_va()

subroutine w3uprstr::update_va	(	real, intent(in)	PRCNTG,
		real, dimension(:), intent(inout)	VATMP
	)

Apply correction to the spectrum.

The factor is (swh_anal/swh_bkg)**2 as applying to wave energy.

Parameters

[in]	PRCNTG
[in,out]	VATMP

Author

Stelios Flampouris

Date

16-Oct-2018

Definition at line 1214 of file ww3_uprstr.F90.

    !/
    !/                  +-----------------------------------+
    !/                  | WAVEWATCH III           NOAA/NCEP |
    !/                  |         Stelios Flampouris        |
    !/                  |                        FORTRAN 90 |
    !/                  | Created       :       16-Oct-2018 |
    !/                  +-----------------------------------+
    !/
    !/    16-Oct-2018 : Original Code                       ( version 6.06 )
    !/
    !/    Copyright 2010 National Weather Service (NWS),
    !/    National Oceanic and Atmospheric Administration.  All rights
    !/    reserved.  WAVEWATCH III is a trademark of the NWS.
    !/    No unauthorized use without permission.
    !/
    !  1. Purpose :
    !     Apply correction to the spectrum
    !
    !  2. Method :
    !     The factor is (swh_anal/swh_bkg)**2 as applying to wave energy
    !  3. Parameters :
    !
    !     Local parameters.
    !     ----------------------------------------------------------------
    !
    !  4. Subroutines used :
    !
    !     ----------------------------------------------------------------
    !  Internal Subroutines:
    !
    !  5. Called by :
    !
    !  6. Error messages :
    !
    !  7. Remarks :
    !
    !  8. Structure :
    !
    !  9. Switches :
    !
    !     !/T
    !
    ! 10. Source code :
    !
    !/
    REAL, INTENT(IN) :: PRCNTG
    REAL, DIMENSION(:), INTENT(INOUT)  :: VATMP
    !
    vatmp = (prcntg**2)*vatmp
    !

Referenced by w3uprstr().

updtwspec()

subroutine w3uprstr::updtwspec	(	real, dimension(:), intent(inout)	VATMP,
		real, intent(in)	PRCNTG,
		integer, dimension(:), intent(in)	VAMAPWS
	)

Updates the wind-sea part of the wave spectrum only.

Parameters

[in,out]	VATMP
[in]	PRCNTG
[in]	VAMAPWS

Author

Andy Saulter

Date

05-Oct-2019

Definition at line 1920 of file ww3_uprstr.F90.

    !/
    !/                  +-----------------------------------+
    !/                  | WAVEWATCH III           NOAA/NCEP |
    !/                  |         Andy Saulter              |
    !/                  |                        FORTRAN 90 |
    !/                  | Original code :       24-Oct-2018 |
    !/                  | Last update :         05-Oct-2019 |
    !/                  +-----------------------------------+
    !/
    !/    24-Oct-2018 : Original Code                       ( version 6.07 )
    !/
    !/    Copyright 2010 National Weather Service (NWS),
    !/    National Oceanic and Atmospheric Administration.  All rights
    !/    reserved.  WAVEWATCH III is a trademark of the NWS.
    !/    No unauthorized use without permission.
    !/
    !  1. Purpose :
    !     Updates the wind-sea part of the wave spectrum only
    !  2. Method :
    !
    !  3. Parameters :
    !
    !     Local parameters.
    !     ----------------------------------------------------------------
    !
    !  4. Subroutines used :
    !
    !     ----------------------------------------------------------------
    !  Internal Subroutines:
    !
    !  5. Called by :
    !
    !  6. Error messages :
    !
    !  7. Remarks :
    !
    !  8. Structure :
    !
    !  9. Switches :
    !
    !     !/T
    !
    ! 10. Source code :
    !
    !/
    REAL, DIMENSION(:), INTENT(INOUT)  :: VATMP
    INTEGER, DIMENSION(:), INTENT(IN) :: VAMAPWS
    REAL, INTENT(IN) :: PRCNTG
    CHARACTER(25),PARAMETER :: myname='UPDTWSPEC'
    !
#ifdef W3_T
    WRITE (ndso,*) trim(myname), ' starts'
#endif
    DO ik=1, nk
      DO ith=1, nth
        IF ( vamapws(ith+(ik-1)*nth) .EQ. 1 ) THEN
          vatmp(ith+(ik-1)*nth) = vatmp(ith+(ik-1)*nth) * prcntg**2
        END IF
      END DO
    END DO
    !
#ifdef W3_T
    WRITE (ndso,*) trim(myname), ' ends'
#endif

Referenced by w3uprstr().

updtwspecf()

subroutine w3uprstr::updtwspecf	(	real, dimension(:), intent(inout)	VATMP,
		real, intent(in)	PRCNTG,
		integer, dimension(:), intent(in)	VAMAPWS,
		integer, intent(in)	ISEA1p,
		logical, intent(in)	ADJALL
	)

Updates the wind-sea part of the wave spectrum and shifts in frequency space.

Parameters

[in,out]	VATMP
[in]	PRCNTG
[in]	VAMAPWS
[in]	ISEA1p
[in]	ADJALL

Author

Andy Saulter

Date

05-Oct-2019

Definition at line 2000 of file ww3_uprstr.F90.

    !/
    !/                  +-----------------------------------+
    !/                  | WAVEWATCH III           NOAA/NCEP |
    !/                  |         Andy Saulter              |
    !/                  |                        FORTRAN 90 |
    !/                  | Original code :       24-Oct-2018 |
    !/                  | Last update :         05-Oct-2019 |
    !/                  +-----------------------------------+
    !/
    !/    24-Oct-2018 : Original Code                       ( version 6.07 )
    !/
    !/    Copyright 2010 National Weather Service (NWS),
    !/    National Oceanic and Atmospheric Administration.  All rights
    !/    reserved.  WAVEWATCH III is a trademark of the NWS.
    !/    No unauthorized use without permission.
    !/
    !  1. Purpose :
    !     Updates the wind-sea part of the wave spectrum and shifts in frequency
    !     space
    !  2. Method :
    !
    !  3. Parameters :
    !
    !     Local parameters.
    !     ----------------------------------------------------------------
    !
    !  4. Subroutines used :
    !
    !     ----------------------------------------------------------------
    !  Internal Subroutines:
    !
    !  5. Called by :
    !
    !  6. Error messages :
    !
    !  7. Remarks :
    !
    !  8. Structure :
    !
    !  9. Switches :
    !
    !     !/T
    !
    ! 10. Source code :
    !
    !/
    REAL, DIMENSION(:), INTENT(INOUT)  :: VATMP
    INTEGER, DIMENSION(:), INTENT(IN) :: VAMAPWS
    REAL, INTENT(IN) :: PRCNTG
    INTEGER, INTENT(IN) :: ISEA1p
    LOGICAL, INTENT(IN) :: ADJALL
    CHARACTER(25),PARAMETER :: myname='UPDTWSPECF'
    REAL :: FFAC, SIGSHFT, FDM1, FDM2, WN1, CG1, WN2, CG2
    INTEGER :: LPF, M1, M2
    REAL, ALLOCATABLE :: VASHFT(:)
    !
#ifdef W3_T
    WRITE (ndso,*) trim(myname), ' starts'
#endif
    depth  = max( dmin , -zb(isea1p))
    ALLOCATE(vashft(SIZE(vatmp)))
    vashft(:) = 0.0
    !
    ! 1st iteration shifts wind-sea energy in freq space
    ffac = (1. / prcntg**2)**(1.0/3.0) ! uses Toba's relationship
    DO ik=1, nk
      CALL wavnu1(sig(ik), depth, wn, cg)
      sigshft = ffac * sig(ik)
      DO ith=1, nth
        IF ( vamapws(ith+(ik-1)*nth) .EQ. 1 ) THEN
          ! Interpolate frequency bin according to f-shift
          lpf = 1
          DO WHILE (lpf < nk)
            IF (sig(lpf) >= sigshft) THEN
              IF (lpf .EQ. 1) THEN
                CALL wavnu1(sig(lpf), depth, wn1, cg1)
                vashft(ith+(lpf-1)*nth) = vashft(ith+(lpf-1)*nth) + &
                     vatmp(ith+(ik-1)*nth) *  &
                     (dsip(ik)*sig(ik)/cg) /  &
                     (dsip(lpf)*sig(lpf)/cg1)
              ELSE
                m2 = lpf
                m1 = lpf - 1
                fdm1 = sigshft - sig(m1)
                fdm2 = sig(m2) - sig(m1)
                CALL wavnu1(sig(m1), depth, wn1, cg1)
                CALL wavnu1(sig(m2), depth, wn2, cg2)
                vashft(ith+(m1-1)*nth) = vashft(ith+(m1-1)*nth) + &
                     (fdm1 / fdm2) *         &
                     vatmp(ith+(ik-1)*nth) * &
                     (dsip(ik)*sig(ik)/cg) / &
                     (dsip(m1)*sig(m1)/cg1)
                vashft(ith+(m2-1)*nth) = vashft(ith+(m2-1)*nth) + &
                     (1.0 - fdm1 / fdm2) *   &
                     vatmp(ith+(ik-1)*nth) * &
                     (dsip(ik)*sig(ik)/cg) / &
                     (dsip(m2)*sig(m2)/cg2)
              END IF
              lpf = nk + 1
            ENDIF
            lpf = lpf + 1
          END DO
          IF (lpf .EQ. nk) THEN
            CALL wavnu1(sig(lpf), depth, wn1, cg1)
            vashft(ith+(lpf-1)*nth) = vashft(ith+(lpf-1)*nth) + &
                 vatmp(ith+(ik-1)*nth) *  &
                 (dsip(ik)*sig(ik)/cg) /  &
                 (dsip(lpf)*sig(lpf)/cg1)
          END IF
        END IF
      END DO
    END DO
    ! 2nd iteration scales wind-sea energy
    DO ik=1, nk
      DO ith=1, nth
        IF ( vamapws(ith+(ik-1)*nth) .EQ. 1 ) THEN
          vashft(ith+(ik-1)*nth) = vashft(ith+(ik-1)*nth) * prcntg**2
        END IF
      END DO
    END DO
    ! 3rd iteration combines wind-sea and swell energy
    DO ik=1, nk
      DO ith=1, nth
        IF ( vamapws(ith+(ik-1)*nth) .EQ. 1 ) THEN
          vatmp(ith+(ik-1)*nth) = vashft(ith+(ik-1)*nth)
        ELSE
          IF ( adjall ) THEN
            ! Swell components are also re-scaled
            vatmp(ith+(ik-1)*nth) = vatmp(ith+(ik-1)*nth) * &
                 prcntg**2            + &
                 vashft(ith+(ik-1)*nth)
          ELSE
            ! Re-scaling wind-sea only
            vatmp(ith+(ik-1)*nth) = vatmp(ith+(ik-1)*nth) + &
                 vashft(ith+(ik-1)*nth)
          END IF
        END IF
      END DO
    END DO
    !
    DEALLOCATE(vashft)
    !
#ifdef W3_T
    WRITE (ndso,*) trim(myname), ' ends'
#endif

Referenced by w3uprstr().

uvtocart()

subroutine w3uprstr::uvtocart	(	real, dimension(:,:), intent(in)	UVEC,
		real, dimension(:,:), intent(in)	VVEC,
		real, dimension(:,:), intent(out)	SPD,
		real, dimension(:,:), intent(out)	DCART,
		logical, intent(in)	SMCGRD
	)

Calculate speed and cartesian convention directions from u,v input vectors.

Parameters

[in]	UVEC
[in]	VVEC
[out]	SPD
[out]	DCART
[in]	SMCGRD

Author

Andy Saulter

Date

05-Oct-2019

Definition at line 1828 of file ww3_uprstr.F90.

    !/
    !/                  +-----------------------------------+
    !/                  | WAVEWATCH III           NOAA/NCEP |
    !/                  |         Andy Saulter              |
    !/                  |                        FORTRAN 90 |
    !/                  | Original code :       05-Oct-2019 |
    !/                  +-----------------------------------+
    !/
    !/    05-Oct-2019 : Original Code                       ( version 6.07 )
    !/
    !/    Copyright 2010 National Weather Service (NWS),
    !/    National Oceanic and Atmospheric Administration.  All rights
    !/    reserved.  WAVEWATCH III is a trademark of the NWS.
    !/    No unauthorized use without permission.
    !/
    !  1. Purpose :
    !     Calculate speed and cartesian convention directions from u,v
    !     input vectors
    !  2. Method :
    !
    !  3. Parameters :
    !
    !     Local parameters.
    !     ----------------------------------------------------------------
    !
    !  4. Subroutines used :
    !
    !     ----------------------------------------------------------------
    !  Internal Subroutines:
    !
    !  5. Called by :
    !
    !  6. Error messages :
    !
    !  7. Remarks :
    !
    !  8. Structure :
    !
    !  9. Switches :
    !
    !     !/T
    !
    ! 10. Source code :
    !
    !/
    USE constants, ONLY: tpi
    !
    REAL, DIMENSION(:,:), INTENT(OUT) :: SPD, DCART
    REAL, DIMENSION(:,:), INTENT(IN) :: UVEC, VVEC
    LOGICAL, INTENT(IN) :: SMCGRD
    !
#ifdef W3_T
    WRITE (ndso,*) trim(myname), ' starts'
#endif
    !
    DO isea=1, nsea, 1
      IF (.NOT. smcgrd) THEN
        ix = mapsf(isea,1)
        iy = mapsf(isea,2)
#ifdef W3_SMC
      ELSE
        ix = 1
        iy = isea
#endif
      ENDIF
      !
      spd(iy,ix) = sqrt( uvec(iy,ix)**2 + vvec(iy,ix)**2 )
      IF( spd(iy,ix) .GT. 1.e-7) THEN
        dcart = mod( tpi+atan2(uvec(iy,ix),vvec(iy,ix)) , tpi )
      ELSE
        dcart = 0
      END IF
      spd(iy,ix) = max( spd(iy,ix) , 0.001 )
    END DO
    !
#ifdef W3_T
    WRITE (ndso,*) trim(myname), ' ends'
#endif

References constants::tpi.

Referenced by w3uprstr().

w3uprstr()

program w3uprstr

Update restart files based on Hs from DA.

Update the WAVEWATCH III restart files based on the significant wave height analysis from any data assimilation system.

The W3UPRSTR is the intermediator between the background WW3 and the analysis of the wave field, it modifies the original restart file according to the analysis. For the wave modeling and DA, the ww3_uprstr program applies the operator from the diagnostic to the prognostic variable.

Author

Stelios Flampouris

Date

16-Feb-2017

Definition at line 22 of file ww3_uprstr.F90.

References check_prcntg(), w3gdatmd::dmin, w3gdatmd::dsip, w3gdatmd::dth, w3servmd::extcde(), file(), w3odatmd::fnmpre, w3gdatmd::fswnd, w3gdatmd::gname, w3gdatmd::gtype, w3odatmd::iaproc, w3odatmd::idout, w3servmd::itrace(), w3gdatmd::mapsf, w3gdatmd::mapsta, w3odatmd::naperr, w3odatmd::naplog, w3odatmd::napout, w3odatmd::nds, w3odatmd::ndse, w3odatmd::ndso, w3odatmd::ndst, w3servmd::nextln(), w3gdatmd::nk, w3gdatmd::nsea, w3gdatmd::nseal, w3adatmd::nsealm, w3gdatmd::nth, w3gdatmd::nx, w3gdatmd::ny, read_grbtxt(), read_grbtxtws(), w3gdatmd::rstype, w3gdatmd::sig, w3gdatmd::smctype, swh_rsrt_1p(), swh_rsrt_1pw(), w3wdatmd::time, update_va(), updtwspec(), updtwspecf(), uvtocart(), w3wdatmd::va, w3iogrmd::w3iogr(), w3iorsmd::w3iors(), w3adatmd::w3naux(), w3wdatmd::w3ndat(), w3idatmd::w3ninp(), w3nmluprstrmd::w3nmluprstr(), w3gdatmd::w3nmod(), w3odatmd::w3nout(), w3adatmd::w3seta(), w3gdatmd::w3setg(), w3idatmd::w3seti(), w3odatmd::w3seto(), w3wdatmd::w3setw(), w3dispmd::wavnu1(), writematrix(), and w3gdatmd::zb.

writematrix()

subroutine w3uprstr::writematrix	(	character(*), intent(in)	FILENAME,
		real, dimension(:, :), intent(in)	RDA_A
	)

Writes a 2D array to text file, column by column.

Parameters

[in,out]	FILENAME	Path to the output file.
[in,out]	RDA_A	2D array to write.

Author

Stelios Flampouris

Date

15-Mar-2017

Definition at line 2157 of file ww3_uprstr.F90.

    !/
    !/                  +-----------------------------------+
    !/                  | WAVEWATCH III           NOAA/NCEP |
    !/                  |         Stelios Flampouris        |
    !/                  |                        FORTRAN 90 |
    !/                  | Last update :         15-Mar-2017 |
    !/                  +-----------------------------------+
    !/
    !/    15-Mar-2017 : Original Code                       ( version 6.04 )
    !/
    !/    Copyright 2010 National Weather Service (NWS),
    !/    National Oceanic and Atmospheric Administration.  All rights
    !/    reserved.  WAVEWATCH III is a trademark of the NWS.
    !/    No unauthorized use without permission.
    !/
    !  1. Purpose :
    !     Writes a 2D array to text file, column by column
    !  2. Method :
    !
    !  3. Parameters :
    !     fileName path to the output file
    !     rda_A 2D array to write
    !
    !     Local parameters.
    !     ----------------------------------------------------------------
    !
    !  4. Subroutines used :
    !
    !     ----------------------------------------------------------------
    !  Internal Subroutines:
    !
    !  5. Called by :
    !  Any routine that has to write 2d arrays !?!
    !
    !  6. Error messages :
    !
    !  7. Remarks :
    !
    !  8. Structure :
    !
    !  9. Switches :
    !
    !     !/T
    !
    ! 10. Source code :
    !
    !/
    REAL, DIMENSION(:, :), INTENT(IN) :: RDA_A
    CHARACTER(*)         , INTENT(IN) :: FILENAME
    INTEGER IB_I, IB_J, IL_IOS
    INTEGER, PARAMETER :: IP_FID = 123
    !
    OPEN( unit = ip_fid, file = filename, status = 'REPLACE', &
         form = 'FORMATTED', iostat = il_ios)
    IF (il_ios /= 0) print*,'In writeMatrix : Error creating file'//filename
    DO ib_j = 1, SIZE(rda_a,2)
      DO ib_i = 1, SIZE(rda_a,1)
        !               write(unit=ip_fid, fmt='(I, $)') rda_A(ib_i,ib_j)
        WRITE(unit=ip_fid, fmt='(E18.8, $)') rda_a(ib_i,ib_j)
      END DO
      WRITE(unit=ip_fid, fmt=*)''
    END DO
    CLOSE(ip_fid)
    !

References file().

Referenced by w3uprstr().