w3wavset Module Reference

Implicit solution of wave setup problem following Dingemans for structured and unstructured grids. More...

Functions/Subroutines
subroutine	differentiate_xydir_native (VAR, DVDX, DVDY)
	Differentiate xy, using linear shape function. More...
subroutine	differentiate_xydir_mapsta (VAR, DVDX, DVDY)
	Differentiate xy based on mapsta, using linear shape function. More...
subroutine	differentiate_xydir (VAR, DVDX, DVDY)
	Driver routine for xydir. More...
subroutine	trig_compute_lh_stress (F_X, F_Y, DWNX)
	Setup boundary pointer. More...
subroutine	trig_compute_diff (IE, I1, UGRAD, VGRAD)
	Differentiate other way around. More...
subroutine	trig_wave_setup_compute_system (ASPAR, B, FX, FY, DWNX, ACTIVE, ACTIVESEC)
	Setup system matrix for solutions of wave setup eq. More...
subroutine	trig_wave_setup_apply_precond (ASPAR, TheIn, TheOut, ACTIVE, ACTIVESEC)
	Preconditioner. More...
subroutine	trig_wave_setup_apply_fct (ASPAR, TheIn, TheOut, ACTIVE, ACTIVESEC)
subroutine	trig_wave_setup_scalar_prod (V1, V2, eScal)
	Scalar product plus exchange. More...
subroutine	trig_wave_setup_solve_poisson_neumann_dir (ASPAR, B, TheOut, ACTIVE, ACTIVESEC)
	Poisson equation solver. More...
subroutine	trig_set_meanvalue_to_zero (TheVar)
	Set mean value. More...
subroutine	compute_active_node (DWNX, ACTIVE)
	Compute active node for setup comp. More...
subroutine	trig_wave_setup_computation
	Setup computation. More...
subroutine	preparation_fd_scheme (IMOD)
	Wave setup for FD grids. More...
subroutine	fd_wave_setup_apply_fct (ASPAR, TheIn, TheOut)
	Compute off diagonal for FD grids. More...
subroutine	fd_wave_setup_apply_precond (ASPAR, TheIn, TheOut)
	Preconditioning for FD grids. More...
subroutine	fd_collect_sxx_xy_yy (SXX_t, SXY_t, SYY_t)
	Radiation stresses for FD grids. More...
subroutine	fd_compute_lh_stress (SXX_t, SXY_t, SYY_t, FX, FY)
	Setup fluxes. More...
subroutine	fd_compute_diff (IEDGE, ISEA, UGRAD, VGRAD, dist)
	Differences on FD grids. More...
subroutine	fd_wave_setup_compute_system (ASPAR, B, FX, FY)
	Setup matrix on FD grids. More...
subroutine	fd_wave_setup_scalar_prod (V1, V2, eScal)
	Scalar product. More...
subroutine	fd_wave_setup_solve_poisson_neumann_dir (ASPAR, B, TheOut)
	Poisson solver on FD grids. More...
subroutine	fd_set_meanvalue_to_zero (TheVar)
	Set mean value. More...
subroutine	fd_wave_setup_computation
	Wave setup comp on FD grids. More...
subroutine	wave_setup_computation
	General driver. More...

Variables
integer, save	ient = 0
logical	do_wave_setup = .TRUE.

Detailed Description

Implicit solution of wave setup problem following Dingemans for structured and unstructured grids.

Author

Aron Roland

Mathieu Dutour-Sikiric

Date

1-Jun-2018

Function/Subroutine Documentation

compute_active_node()

subroutine w3wavset::compute_active_node	(	real(rkind), dimension(npa), intent(in)	DWNX,
		integer, dimension(npa), intent(out)	ACTIVE
	)

Compute active node for setup comp.

Parameters

[in]	DWNX
[out]	ACTIVE

Author

Aron Roland

Mathieu Dutour-Sikiric

Date

1-May-2018

Definition at line 1494 of file w3wavset.F90.

!/
!/                  +-----------------------------------+
!/                  | WAVEWATCH III           NOAA/NCEP |
!/                  |                                   |
!/                  | Aron Roland (BGS IT&E GmbH)       |
!/                  | Mathieu Dutour-Sikiric (IRB)      |
!/                  |                                   |
!/                  |                        FORTRAN 90 |
!/                  | Last update :         01-Mai-2018 |
!/                  +-----------------------------------+
!/
!/    01-Mai-2018 : Origination.                        ( version 6.04 )
!/
!  1. Purpose : Compute active node for setup comp.
!  2. Method :
!  3. Parameters :
!
!     Parameter list
!     ----------------------------------------------------------------
!     ----------------------------------------------------------------
!
!  4. Subroutines used :
!
!      Name      Type  Module   Description
!     ----------------------------------------------------------------
!      STRACE    Subr. W3SERVMD Subroutine tracing.
!     ----------------------------------------------------------------
!
!  5. Called by :
!
!      Name      Type  Module   Description
!     ----------------------------------------------------------------
!     ----------------------------------------------------------------
!
!  6. Error messages :
!  7. Remarks
!  8. Structure :
!  9. Switches :
!
!     !/S  Enable subroutine tracing.
!
! 10. Source code :
!
!/ ------------------------------------------------------------------- /
#ifdef W3_S
      USE w3servmd, ONLY: strace
#endif
!
      USE w3gdatmd, ONLY : crit_dep_stp
      USE yownodepool, only: pdlib_nnz, pdlib_ia, pdlib_ja, iplg, npa, np
      USE w3odatmd, only : iaproc
      IMPLICIT NONE
!/
!/ ------------------------------------------------------------------- /
!/ Parameter list
!/
!/ ------------------------------------------------------------------- /
!/ Local PARAMETERs
!/
#ifdef W3_S
      INTEGER, SAVE           :: IENT = 0
#endif
!/
!/ ------------------------------------------------------------------- /
!/
      REAL(rkind), INTENT(in) :: DWNX(npa)
      INTEGER, INTENT(out) :: ACTIVE(npa)
      INTEGER IP, eAct
#ifdef W3_DEBUGSTP
      INTEGER nbActive
#endif
#ifdef W3_S
      CALL strace (ient, 'VA_SETUP_IOBPD')
#endif
#ifdef W3_DEBUGSTP
      nbactive=0
#endif
      DO ip=1,npa
        IF (dwnx(ip) .ge. crit_dep_stp) THEN
          eact=1
        ELSE
          eact=0
        END IF
#ifdef W3_DEBUGSTP
        nbactive=nbactive + eact
#endif
        active(ip)=eact
      END DO
#ifdef W3_DEBUGSTP
      WRITE(740+iaproc,*) 'min/max(DWNX)=', minval(dwnx), maxval(dwnx)
      WRITE(740+iaproc,*) 'CRIT_DEP_STP=', crit_dep_stp
      WRITE(740+iaproc,*) 'nbActive=', nbactive, ' npa=', npa
      FLUSH(740+iaproc)
#endif

References w3gdatmd::crit_dep_stp, w3odatmd::iaproc, yownodepool::iplg, yownodepool::np, yownodepool::npa, yownodepool::pdlib_ia, yownodepool::pdlib_ja, yownodepool::pdlib_nnz, and w3servmd::strace().

Referenced by trig_wave_setup_computation().

differentiate_xydir()

subroutine w3wavset::differentiate_xydir	(	real(rkind), dimension(npa), intent(in)	VAR,
		real(rkind), dimension(npa), intent(out)	DVDX,
		real(rkind), dimension(npa), intent(out)	DVDY
	)

Driver routine for xydir.

Parameters

[in]	VAR
[out]	DVDX
[out]	DVDY

Author

Mathieu Dutour-Sikiric

Aron Roland

Date

1-May-2018

Definition at line 364 of file w3wavset.F90.

!/
!/                  +-----------------------------------+
!/                  | WAVEWATCH III           NOAA/NCEP |
!/                  |                                   |
!/                  | Mathieu Dutour-Sikiric (IRB)      |
!/                  | Aron Roland (BGS IT&E GmbH)       |
!/                  |                        FORTRAN 90 |
!/                  | Last update :         01-Mai-2018 |
!/                  +-----------------------------------+
!/
!/    01-Mai-2018 : Origination.                        ( version 6.04 )
!/
!  1. Purpose : Driver routine for xydir
!  2. Method :
!  3. Parameters :
!
!     Parameter list
!     ----------------------------------------------------------------
!     ----------------------------------------------------------------
!
!  4. Subroutines used :
!
!      Name      Type  Module   Description
!     ----------------------------------------------------------------
!      STRACE    Subr. W3SERVMD Subroutine tracing.
!     ----------------------------------------------------------------
!
!  5. Called by :
!
!      Name      Type  Module   Description
!     ----------------------------------------------------------------
!     ----------------------------------------------------------------
!
!  6. Error messages :
!  7. Remarks
!  8. Structure :
!  9. Switches :
!
!     !/S  Enable subroutine tracing.
!
! 10. Source code :
!
!/ ------------------------------------------------------------------- /
#ifdef W3_S
      USE w3servmd, ONLY: strace
#endif
!
      use yownodepool, only: npa
      IMPLICIT NONE
!/
!/ ------------------------------------------------------------------- /
!/ Parameter list
!/
!/ ------------------------------------------------------------------- /
!/ Local PARAMETERs
!/
#ifdef W3_S
      INTEGER, SAVE           :: IENT = 0
#endif
      REAL(rkind), INTENT(IN)  :: VAR(npa)
      REAL(rkind), INTENT(OUT) :: DVDX(npa), DVDY(npa)
!/
!/ ------------------------------------------------------------------- /
!/
#ifdef W3_S
      CALL strace (ient, 'VA_SETUP_IOBPD')
#endif
!
 
      CALL differentiate_xydir_mapsta(var, dvdx, dvdy)
!      CALL DIFFERENTIATE_XYDIR_NATIVE(VAR, DVDX, DVDY)

References differentiate_xydir_mapsta(), yownodepool::npa, and w3servmd::strace().

Referenced by trig_compute_lh_stress().

differentiate_xydir_mapsta()

subroutine w3wavset::differentiate_xydir_mapsta	(	real(rkind), dimension(npa), intent(in)	VAR,
		real(rkind), dimension(npa), intent(out)	DVDX,
		real(rkind), dimension(npa), intent(out)	DVDY
	)

Differentiate xy based on mapsta, using linear shape function.

Parameters

[in]	VAR
[out]	DVDX
[out]	DVDY

Author

Aron Roland

Mathieu Dutour-Sikiric

Date

1-May-2018

Definition at line 226 of file w3wavset.F90.

!/
!/                  +-----------------------------------+
!/                  | WAVEWATCH III           NOAA/NCEP |
!/                  |                                   |
!/                  | Aron Roland (BGS IT&E GmbH)       |
!/                  | Mathieu Dutour-Sikiric (IRB)      |
!/                  |                                   |
!/                  |                        FORTRAN 90 |
!/                  | Last update :         01-Mai-2018 |
!/                  +-----------------------------------+
!/
!/    01-Mai-2018 : Origination.                        ( version 6.04 )
!/
!  1. Purpose : differentiate xy based on mapsta
!  2. Method : linear shape function
!  3. Parameters :
!
!     Parameter list
!     ----------------------------------------------------------------
!     ----------------------------------------------------------------
!
!  4. Subroutines used :
!
!      Name      Type  Module   Description
!     ----------------------------------------------------------------
!      STRACE    Subr. W3SERVMD Subroutine tracing.
!     ----------------------------------------------------------------
!
!  5. Called by :
!
!      Name      Type  Module   Description
!     ----------------------------------------------------------------
!     ----------------------------------------------------------------
!
!  6. Error messages :
!  7. Remarks
!  8. Structure :
!  9. Switches :
!
!     !/S  Enable subroutine tracing.
!
! 10. Source code :
!
!/ ------------------------------------------------------------------- /
#ifdef W3_S
      USE w3servmd, ONLY: strace
#endif
!
      use yowexchangemodule, only : pdlib_exchange1dreal
      use yownodepool,    only : pdlib_ien, pdlib_tria, npa, iplg
      use yowelementpool, only : ine, ne
      USE w3gdatmd, ONLY : mapsta
      USE w3parall, only: init_get_isea
      IMPLICIT NONE
!/
!/ ------------------------------------------------------------------- /
!/ Parameter list
!/
!/ ------------------------------------------------------------------- /
!/ Local PARAMETERs
!/
#ifdef W3_S
      INTEGER, SAVE           :: IENT = 0
#endif
!/
!/ ------------------------------------------------------------------- /
!/
      REAL(rkind), INTENT(IN)  :: VAR(npa)
      REAL(rkind), INTENT(OUT) :: DVDX(npa), DVDY(npa)
      INTEGER           :: NI(3)
      INTEGER           :: IE, I1, I2, I3, IP, IX
      REAL(rkind)           :: DEDY(3),DEDX(3)
      REAL(rkind)           :: DVDXIE, DVDYIE
      REAL(rkind)           :: WEI(npa), eW
      INTEGER           :: IX1, IX2, IX3, ISEA
#ifdef W3_S
      CALL strace (ient, 'VA_SETUP_IOBPD')
#endif
      wei  = 0.0
      dvdx = 0.0
      dvdy = 0.0
 
      DO ie = 1, ne
        ni = ine(:,ie)
        i1 = ine(1,ie)
        i2 = ine(2,ie)
        i3 = ine(3,ie)
        ix1=iplg(i1)
        ix2=iplg(i2)
        ix3=iplg(i3)
        IF ((mapsta(1,ix1) .gt. 0).and.(mapsta(1,ix2) .gt. 0).and.(mapsta(1,ix3) .gt. 0)) THEN
          wei(ni) = wei(ni) + 2.*pdlib_tria(ie)
          dedx(1) = pdlib_ien(1,ie)
          dedx(2) = pdlib_ien(3,ie)
          dedx(3) = pdlib_ien(5,ie)
          dedy(1) = pdlib_ien(2,ie)
          dedy(2) = pdlib_ien(4,ie)
          dedy(3) = pdlib_ien(6,ie)
          dvdxie  = dot_product( var(ni),dedx)
          dvdyie  = dot_product( var(ni),dedy)
          dvdx(ni) = dvdx(ni) + dvdxie
          dvdy(ni) = dvdy(ni) + dvdyie
        END IF
      END DO
      DO ip=1,npa
        ix=iplg(ip)
        ew=wei(ip)
        IF (ew .gt. 0 .and. mapsta(1,ix) .gt. 0) THEN
          dvdx(ip)=dvdx(ip) / ew
          dvdy(ip)=dvdy(ip) / ew
        ELSE
          dvdx(ip)=0.
          dvdy(ip)=0.
        ENDIF
      END DO
      DO ip=1,npa
        ix=iplg(ip)
        IF (mapsta(1,ix) .lt. 0) THEN
          dvdx(ip)=0.
          dvdy(ip)=0.
        END IF
      END DO
      CALL pdlib_exchange1dreal(dvdx)
      CALL pdlib_exchange1dreal(dvdy)

References yowelementpool::ine, w3parall::init_get_isea(), yownodepool::iplg, w3gdatmd::mapsta, yowelementpool::ne, yownodepool::npa, yowexchangemodule::pdlib_exchange1dreal(), yownodepool::pdlib_ien, yownodepool::pdlib_tria, and w3servmd::strace().

Referenced by differentiate_xydir().

differentiate_xydir_native()

subroutine w3wavset::differentiate_xydir_native	(	real(rkind), dimension(npa), intent(in)	VAR,
		real(rkind), dimension(npa), intent(out)	DVDX,
		real(rkind), dimension(npa), intent(out)	DVDY
	)

Differentiate xy, using linear shape function.

Parameters

[in]	VAR
[out]	DVDX
[out]	DVDY

Author

Aron Roland

Mathieu Dutour-Sikiric

Date

1-May-2018

Definition at line 106 of file w3wavset.F90.

!/
!/                  +-----------------------------------+
!/                  | WAVEWATCH III           NOAA/NCEP |
!/                  |                                   |
!/                  | Aron Roland (BGS IT&E GmbH)       |
!/                  | Mathieu Dutour-Sikiric (IRB)      |
!/                  |                                   |
!/                  |                        FORTRAN 90 |
!/                  | Last update :         01-Mai-2018 |
!/                  +-----------------------------------+
!/
!/    01-Mai-2018 : Origination.                        ( version 6.04 )
!/
!  1. Purpose : differentiate xy
!  2. Method : linear shape function
!  3. Parameters :
!
!     Parameter list
!     ----------------------------------------------------------------
!     ----------------------------------------------------------------
!
!  4. Subroutines used :
!
!      Name      Type  Module   Description
!     ----------------------------------------------------------------
!      STRACE    Subr. W3SERVMD Subroutine tracing.
!     ----------------------------------------------------------------
!
!  5. Called by :
!
!      Name      Type  Module   Description
!     ----------------------------------------------------------------
!     ----------------------------------------------------------------
!
!  6. Error messages :
!  7. Remarks
!  8. Structure :
!  9. Switches :
!
!     !/S  Enable subroutine tracing.
!
! 10. Source code :
!
!/ ------------------------------------------------------------------- /
#ifdef W3_S
      USE w3servmd, ONLY: strace
#endif
!
      use yowexchangemodule, only : pdlib_exchange1dreal
      use yownodepool,    only : pdlib_ien, pdlib_tria, npa
      use yowelementpool, only : ine, ne
      USE w3gdatmd, ONLY : mapsta
      IMPLICIT NONE
!/
!/ ------------------------------------------------------------------- /
!/ Parameter list
!/
!/ ------------------------------------------------------------------- /
!/ Local PARAMETERs
!/
#ifdef W3_S
      INTEGER, SAVE           :: IENT = 0
#endif
!/
!/ ------------------------------------------------------------------- /
!/
!
      REAL(rkind), INTENT(IN)  :: VAR(npa)
      REAL(rkind), INTENT(OUT) :: DVDX(npa), DVDY(npa)
      INTEGER           :: NI(3)
      INTEGER           :: IE, I1, I2, I3, IP
      REAL(rkind)           :: DEDY(3),DEDX(3)
      REAL(rkind)           :: DVDXIE, DVDYIE
      REAL(rkind)           :: WEI(npa), eW
      INTEGER           :: IX
#ifdef W3_S
      CALL strace (ient, 'VA_SETUP_IOBPD')
#endif
      wei  = 0.0
      dvdx = 0.0
      dvdy = 0.0
 
      DO ie = 1, ne
        ni = ine(:,ie)
        i1 = ine(1,ie)
        i2 = ine(2,ie)
        i3 = ine(3,ie)
        wei(ni) = wei(ni) + 2.*pdlib_tria(ie)
        dedx(1) = pdlib_ien(1,ie)
        dedx(2) = pdlib_ien(3,ie)
        dedx(3) = pdlib_ien(5,ie)
        dedy(1) = pdlib_ien(2,ie)
        dedy(2) = pdlib_ien(4,ie)
        dedy(3) = pdlib_ien(6,ie)
        dvdxie  = dot_product( var(ni),dedx)
        dvdyie  = dot_product( var(ni),dedy)
        dvdx(ni) = dvdx(ni) + dvdxie
        dvdy(ni) = dvdy(ni) + dvdyie
      END DO
      DO ix=1,npa
        ew=wei(ix)
        dvdx(ix)=dvdx(ix) / ew
        dvdy(ix)=dvdy(ix) / ew
      END DO
      CALL pdlib_exchange1dreal(dvdx)
      CALL pdlib_exchange1dreal(dvdy)

References yowelementpool::ine, w3gdatmd::mapsta, yowelementpool::ne, yownodepool::npa, yowexchangemodule::pdlib_exchange1dreal(), yownodepool::pdlib_ien, yownodepool::pdlib_tria, and w3servmd::strace().

fd_collect_sxx_xy_yy()

subroutine w3wavset::fd_collect_sxx_xy_yy	(	real(rkind), dimension(nsea), intent(out)	SXX_t,
		real(rkind), dimension(nsea), intent(out)	SXY_t,
		real(rkind), dimension(nsea), intent(out)	SYY_t
	)

Radiation stresses for FD grids.

Parameters

[out]	SXX_t
[out]	SXY_t
[out]	SYY_t

Author

Mathieu Dutour-Sikiric

Aron Roland

Date

1-May-2018

Definition at line 2153 of file w3wavset.F90.

!/
!/                  +-----------------------------------+
!/                  | WAVEWATCH III           NOAA/NCEP |
!/                  |                                   |
!/                  | Mathieu Dutour-Sikiric (IRB)      |
!/                  | Aron Roland (BGS IT&E GmbH)       |
!/                  |                                   |
!/                  |                        FORTRAN 90 |
!/                  | Last update :         01-Mai-2018 |
!/                  +-----------------------------------+
!/
!/    01-Mai-2018 : Origination.                        ( version 6.04 )
!/
!  1. Purpose : Rad. stresses for FD grids
!  2. Method :
!  3. Parameters :
!
!     Parameter list
!     ----------------------------------------------------------------
!     ----------------------------------------------------------------
!
!  4. Subroutines used :
!
!      Name      Type  Module   Description
!     ----------------------------------------------------------------
!      STRACE    Subr. W3SERVMD Subroutine tracing.
!     ----------------------------------------------------------------
!
!  5. Called by :
!
!      Name      Type  Module   Description
!     ----------------------------------------------------------------
!     ----------------------------------------------------------------
!
!  6. Error messages :
!  7. Remarks
!  8. Structure :
!  9. Switches :
!
!     !/S  Enable subroutine tracing.
!
! 10. Source code :
!
!/ ------------------------------------------------------------------- /
#ifdef W3_S
      USE w3servmd, ONLY: strace
#endif
!
      USE w3adatmd, ONLY: sxx, sxy, syy
      USE w3gdatmd, ONLY: nsea, nseal
      USE w3odatmd, only : iaproc, naproc
      use yowdatapool, only: rtype, istatus
      USE w3adatmd, ONLY: mpi_comm_wcmp
      IMPLICIT NONE
!/
!/ ------------------------------------------------------------------- /
!/ Parameter list
!/
!/ ------------------------------------------------------------------- /
!/ Local PARAMETERs
!/
#ifdef W3_S
      INTEGER, SAVE           :: IENT = 0
#endif
!/
!/ ------------------------------------------------------------------- /
!/
      integer ISEA, JSEA
      integer ierr
      real(rkind), intent(out) :: SXX_t(NSEA), SXY_t(NSEA), SYY_t(NSEA)
      real(rkind) :: SXX_p(NSEAL), SXY_p(NSEAL), SYY_p(NSEAL)
      real(rkind), allocatable :: rVect(:)
      integer IPROC, NSEAL_loc
#ifdef W3_S
      CALL strace (ient, 'VA_SETUP_IOBPD')
#endif
      DO isea=1,nseal
        sxx_p(isea)=sxx(isea)
        sxy_p(isea)=sxy(isea)
        syy_p(isea)=syy(isea)
      END DO
      IF (iaproc .eq. 1) THEN
        DO jsea=1,nseal
          isea=1 + (jsea-1)*naproc
          sxx_t(isea)=sxx_p(jsea)
          sxy_t(isea)=sxy_p(jsea)
          syy_t(isea)=syy_p(jsea)
        END DO
        DO iproc=2,naproc
          nseal_loc=1 + (nsea-iproc)/naproc
          allocate(rvect(nseal_loc))
          CALL mpi_recv(rvect,nseal_loc,rtype, iproc-1, 83, mpi_comm_wcmp, istatus, ierr)
          DO jsea=1,nseal_loc
            isea = iproc + (jsea-1)*naproc
            sxx_t(isea)=rvect(jsea)
          END DO
          CALL mpi_recv(rvect,nseal_loc,rtype, iproc-1, 89, mpi_comm_wcmp, istatus, ierr)
          DO jsea=1,nseal_loc
            isea = iproc + (jsea-1)*naproc
            sxy_t(isea)=rvect(jsea)
          END DO
          CALL mpi_recv(rvect,nseal_loc,rtype, iproc-1, 97, mpi_comm_wcmp, istatus, ierr)
          DO jsea=1,nseal_loc
            isea = iproc + (jsea-1)*naproc
            syy_t(isea)=rvect(jsea)
          END DO
          deallocate(rvect)
        END DO
      ELSE
        CALL mpi_send(sxx_p,nseal,rtype, 0, 83, mpi_comm_wcmp, ierr)
        CALL mpi_send(sxy_p,nseal,rtype, 0, 83, mpi_comm_wcmp, ierr)
        CALL mpi_send(syy_p,nseal,rtype, 0, 83, mpi_comm_wcmp, ierr)
      END IF

References w3odatmd::iaproc, yowdatapool::istatus, w3adatmd::mpi_comm_wcmp, w3odatmd::naproc, w3gdatmd::nsea, w3gdatmd::nseal, yowdatapool::rtype, w3servmd::strace(), w3adatmd::sxx, w3adatmd::sxy, and w3adatmd::syy.

Referenced by fd_wave_setup_computation().

fd_compute_diff()

subroutine w3wavset::fd_compute_diff	(	integer, intent(in)	IEDGE,
		integer, intent(in)	ISEA,
		real(rkind), intent(inout)	UGRAD,
		real(rkind), intent(inout)	VGRAD,
		real(rkind), intent(inout)	dist
	)

Differences on FD grids.

Parameters

[in]	IEDGE
[in]	ISEA
[in,out]	UGRAD
[in,out]	VGRAD
[in,out]	dist

Author

Mathieu Dutour-Sikiric

Aron Roland

Date

1-May-2018

Definition at line 2434 of file w3wavset.F90.

!/
!/                  +-----------------------------------+
!/                  | WAVEWATCH III           NOAA/NCEP |
!/                  |                                   |
!/                  | Mathieu Dutour-Sikiric (IRB)      |
!/                  | Aron Roland (BGS IT&E GmbH)       |
!/                  |                                   |
!/                  |                        FORTRAN 90 |
!/                  | Last update :         01-Mai-2018 |
!/                  +-----------------------------------+
!/
!/    01-Mai-2018 : Origination.                        ( version 6.04 )
!/
!  1. Purpose : differences on FD grids
!  2. Method :
!  3. Parameters :
!
!     Parameter list
!     ----------------------------------------------------------------
!     ----------------------------------------------------------------
!
!  4. Subroutines used :
!
!      Name      Type  Module   Description
!     ----------------------------------------------------------------
!      STRACE    Subr. W3SERVMD Subroutine tracing.
!     ----------------------------------------------------------------
!
!  5. Called by :
!
!      Name      Type  Module   Description
!     ----------------------------------------------------------------
!     ----------------------------------------------------------------
!
!  6. Error messages :
!  7. Remarks
!  8. Structure :
!  9. Switches :
!
!     !/S  Enable subroutine tracing.
!
! 10. Source code :
!
!/ ------------------------------------------------------------------- /
#ifdef W3_S
      USE w3servmd, ONLY: strace
#endif
!
      USE w3gdatmd, ONLY: mapsf, edges
      USE w3gdatmd, ONLY: xgrd, ygrd
      IMPLICIT NONE
!/
!/ ------------------------------------------------------------------- /
!/ Parameter list
!/
!/ ------------------------------------------------------------------- /
!/ Local PARAMETERs
!/
#ifdef W3_S
      INTEGER, SAVE           :: IENT = 0
#endif
!/
!/ ------------------------------------------------------------------- /
!/
      INTEGER, intent(in) :: IEDGE, ISEA
      REAL(rkind), intent(inout) :: UGRAD, VGRAD, dist
      REAL(rkind) :: h
      integer I2, I3, IP1, IP2, IP3
      integer IX1, IY1, IX2, IY2
      integer ISEA1, ISEA2
      REAL(rkind) deltaX, deltaY
#ifdef W3_S
      CALL strace (ient, 'VA_SETUP_IOBPD')
#endif
      !
      isea1=edges(iedge,1)
      isea2=edges(iedge,2)
      ix1=mapsf(isea1,1)
      iy1=mapsf(isea1,2)
      ix2=mapsf(isea2,1)
      iy2=mapsf(isea2,2)
      deltax=xgrd(ix1,iy1) - xgrd(ix2,iy2)
      deltay=ygrd(ix1,iy1) - ygrd(ix2,iy2)
      dist=sqrt(deltax*deltax + deltay*deltay)
      IF (isea .eq. isea1) THEN
        ugrad= deltax/dist
        vgrad= deltay/dist
      ELSE
        ugrad=-deltax/dist
        vgrad=-deltay/dist
      END IF

References w3gdatmd::edges, w3gdatmd::mapsf, w3servmd::strace(), w3gdatmd::xgrd, and w3gdatmd::ygrd.

Referenced by fd_wave_setup_compute_system().

fd_compute_lh_stress()

subroutine w3wavset::fd_compute_lh_stress	(	real(rkind), dimension(nsea), intent(in)	SXX_t,
		real(rkind), dimension(nsea), intent(in)	SXY_t,
		real(rkind), dimension(nsea), intent(in)	SYY_t,
		real(rkind), dimension(nsea), intent(out)	FX,
		real(rkind), dimension(nsea), intent(out)	FY
	)

Setup fluxes.

Parameters

[in]	SXX_t
[in]	SXY_t
[in]	SYY_t
[out]	FX
[out]	FY

Author

Mathieu Dutour-Sikiric

Aron Roland

Date

1-May-2018

Definition at line 2282 of file w3wavset.F90.

!/
!/                  +-----------------------------------+
!/                  | WAVEWATCH III           NOAA/NCEP |
!/                  |                                   |
!/                  | Mathieu Dutour-Sikiric (IRB)      |
!/                  | Aron Roland (BGS IT&E GmbH)       |
!/                  |                                   |
!/                  |                        FORTRAN 90 |
!/                  | Last update :         01-Mai-2018 |
!/                  +-----------------------------------+
!/
!/    01-Mai-2018 : Origination.                        ( version 6.04 )
!/
!  1. Purpose : setup fluxes
!  2. Method :
!  3. Parameters :
!
!     Parameter list
!     ----------------------------------------------------------------
!     ----------------------------------------------------------------
!
!  4. Subroutines used :
!
!      Name      Type  Module   Description
!     ----------------------------------------------------------------
!      STRACE    Subr. W3SERVMD Subroutine tracing.
!     ----------------------------------------------------------------
!
!  5. Called by :
!
!      Name      Type  Module   Description
!     ----------------------------------------------------------------
!     ----------------------------------------------------------------
!
!  6. Error messages :
!  7. Remarks
!  8. Structure :
!  9. Switches :
!
!     !/S  Enable subroutine tracing.
!
! 10. Source code :
!
!/ ------------------------------------------------------------------- /
#ifdef W3_S
      USE w3servmd, ONLY: strace
#endif
!
      USE w3gdatmd, ONLY: nx, ny, nsea, neigh
      USE w3adatmd, ONLY: sxx, sxy, syy
      IMPLICIT NONE
!/
!/ ------------------------------------------------------------------- /
!/ Parameter list
!/
!/ ------------------------------------------------------------------- /
!/ Local PARAMETERs
!/
#ifdef W3_S
      INTEGER, SAVE           :: IENT = 0
#endif
!/
!/ ------------------------------------------------------------------- /
!/
      real(rkind), intent(in) :: SXX_t(NSEA), SXY_t(NSEA), SYY_t(NSEA)
      real(rkind), intent(out) :: FX(NSEA), FY(NSEA)
      REAL(rkind) :: h
      REAL(rkind) :: SXX_X, SXX_Y
      REAL(rkind) :: SXY_X, SXY_Y
      REAL(rkind) :: SYY_X, SYY_Y
      REAL(rkind) :: eFX, eFY
      REAL(rkind) :: UGRAD, VGRAD
      INTEGER IE, I1, I2, I3, IP1, IP2, IP3
      integer ISEA, JSEA1, JSEA2, JSEA3, JSEA4
      integer NeighMat(4,2)
      real(rkind) dist_X, dist_Y
#ifdef W3_S
      CALL strace (ient, 'VA_SETUP_IOBPD')
#endif
      !
      neighmat(1,1)=1
      neighmat(1,2)=0
      neighmat(2,1)=-1
      neighmat(2,2)=0
      neighmat(3,1)=0
      neighmat(3,2)=1
      neighmat(4,1)=0
      neighmat(4,2)=-1
      fx=0
      fy=0
      DO isea=1,nsea
        jsea1=neigh(isea,1)
        jsea2=neigh(isea,2)
        jsea3=neigh(isea,3)
        jsea4=neigh(isea,4)
        sxx_x=0
        sxx_y=0
        sxy_x=0
        sxy_y=0
        syy_x=0
        syy_y=0
        IF ((jsea1 .gt. 0).and.(jsea2 .gt. 0)) THEN
          sxx_x=(sxx(jsea1) - sxx(jsea2))/(2*dist_x)
          sxy_x=(sxy(jsea1) - sxy(jsea2))/(2*dist_x)
          syy_x=(sxy(jsea1) - syy(jsea2))/(2*dist_x)
        END IF
        IF ((jsea1 .gt. 0).and.(jsea2 .eq. 0)) THEN
          sxx_x=(sxx(jsea1) - sxx(isea ))/dist_x
          sxy_x=(sxy(jsea1) - sxy(isea ))/dist_x
          syy_x=(sxy(jsea1) - syy(isea ))/dist_x
        END IF
        IF ((jsea1 .eq. 0).and.(jsea2 .gt. 0)) THEN
          sxx_x=(sxx(isea ) - sxx(jsea2))/dist_x
          sxy_x=(sxy(isea ) - sxy(jsea2))/dist_x
          syy_x=(sxy(isea ) - syy(jsea2))/dist_x
        END IF
        IF ((jsea3 .gt. 0).and.(jsea4 .gt. 0)) THEN
          sxx_x=(sxx(jsea3) - sxx(jsea4))/(2*dist_y)
          sxy_x=(sxy(jsea3) - sxy(jsea4))/(2*dist_y)
          syy_x=(sxy(jsea3) - syy(jsea4))/(2*dist_y)
        END IF
        IF ((jsea3 .eq. 0).and.(jsea4 .gt. 0)) THEN
          sxx_x=(sxx(isea ) - sxx(jsea4))/dist_y
          sxy_x=(sxy(isea ) - sxy(jsea4))/dist_y
          syy_x=(sxy(isea ) - syy(jsea4))/dist_y
        END IF
        IF ((jsea3 .gt. 0).and.(jsea4 .gt. 0)) THEN
          sxx_x=(sxx(jsea3) - sxx(isea ))/dist_y
          sxy_x=(sxy(jsea3) - sxy(isea ))/dist_y
          syy_x=(sxy(jsea3) - syy(isea ))/dist_y
        END IF
        efx=-sxx_x - sxy_y
        efy=-syy_y - sxy_x
        fx(isea)=efx
        fy(isea)=efy
      END DO

References w3gdatmd::neigh, w3gdatmd::nsea, w3gdatmd::nx, w3gdatmd::ny, w3servmd::strace(), w3adatmd::sxx, w3adatmd::sxy, and w3adatmd::syy.

Referenced by fd_wave_setup_computation().

fd_set_meanvalue_to_zero()

subroutine w3wavset::fd_set_meanvalue_to_zero

(

real(rkind), dimension(nx), intent(inout)

TheVar

)

Set mean value.

Parameters

[in,out]

TheVar

Author

Mathieu Dutour-Sikiric

Aron Roland

Date

1-May-2018

Definition at line 2864 of file w3wavset.F90.

!/
!/                  +-----------------------------------+
!/                  | WAVEWATCH III           NOAA/NCEP |
!/                  |                                   |
!/                  | Mathieu Dutour-Sikiric (IRB)      |
!/                  | Aron Roland (BGS IT&E GmbH)       |
!/                  |                                   |
!/                  |                        FORTRAN 90 |
!/                  | Last update :         01-Mai-2018 |
!/                  +-----------------------------------+
!/
!/    01-Mai-2018 : Origination.                        ( version 6.04 )
!/
!  1. Purpose : set meanvalue
!  2. Method :
!  3. Parameters :
!
!     Parameter list
!     ----------------------------------------------------------------
!     ----------------------------------------------------------------
!
!  4. Subroutines used :
!
!      Name      Type  Module   Description
!     ----------------------------------------------------------------
!      STRACE    Subr. W3SERVMD Subroutine tracing.
!     ----------------------------------------------------------------
!
!  5. Called by :
!
!      Name      Type  Module   Description
!     ----------------------------------------------------------------
!     ----------------------------------------------------------------
!
!  6. Error messages :
!  7. Remarks
!  8. Structure :
!  9. Switches :
!
!     !/S  Enable subroutine tracing.
!
! 10. Source code :
!
!/ ------------------------------------------------------------------- /
#ifdef W3_S
      USE w3servmd, ONLY: strace
#endif
!
      USE w3gdatmd, ONLY: nx, si
      IMPLICIT NONE
!/
!/ ------------------------------------------------------------------- /
!/ Parameter list
!/
!/ ------------------------------------------------------------------- /
!/ Local PARAMETERs
!/
#ifdef W3_S
      INTEGER, SAVE           :: IENT = 0
#endif
!/
!/ ------------------------------------------------------------------- /
!/
      real(rkind), intent(inout) :: TheVar(NX)
      real(rkind) :: SUM_SI_Var, SUM_SI, TheMean
      INTEGER IP
#ifdef W3_S
      CALL strace (ient, 'VA_SETUP_IOBPD')
#endif
      sum_si_var=0
      sum_si=0
      DO ip=1,nx
        sum_si_var = sum_si_var + si(ip)*thevar(ip)
        sum_si     = sum_si     + si(ip)
      END DO
      themean=sum_si_var/sum_si
      DO ip=1,nx
        thevar(ip)=thevar(ip) - themean
      END DO

References w3gdatmd::nx, w3gdatmd::si, and w3servmd::strace().

Referenced by fd_wave_setup_computation().

fd_wave_setup_apply_fct()

subroutine w3wavset::fd_wave_setup_apply_fct	(	real(rkind), dimension(nnz), intent(in)	ASPAR,
		real(rkind), dimension(nsea), intent(in)	TheIn,
		real(rkind), dimension(nsea), intent(out)	TheOut
	)

Compute off diagonal for FD grids.

Parameters

[in]	ASPAR
[in]	TheIn
[out]	TheOut

Author

Mathieu Dutour-Sikiric

Aron Roland

Date

1-May-2018

Definition at line 1946 of file w3wavset.F90.

!/
!/                  +-----------------------------------+
!/                  | WAVEWATCH III           NOAA/NCEP |
!/                  |                                   |
!/                  | Mathieu Dutour-Sikiric (IRB)      |
!/                  | Aron Roland (BGS IT&E GmbH)       |
!/                  |                                   |
!/                  |                        FORTRAN 90 |
!/                  | Last update :         01-Mai-2018 |
!/                  +-----------------------------------+
!/
!/    01-Mai-2018 : Origination.                        ( version 6.04 )
!/
!  1. Purpose : comp. off diagonal for FD grids
!  2. Method :
!  3. Parameters :
!
!     Parameter list
!     ----------------------------------------------------------------
!     ----------------------------------------------------------------
!
!  4. Subroutines used :
!
!      Name      Type  Module   Description
!     ----------------------------------------------------------------
!      STRACE    Subr. W3SERVMD Subroutine tracing.
!     ----------------------------------------------------------------
!
!  5. Called by :
!
!      Name      Type  Module   Description
!     ----------------------------------------------------------------
!     ----------------------------------------------------------------
!
!  6. Error messages :
!  7. Remarks
!  8. Structure :
!  9. Switches :
!
!     !/S  Enable subroutine tracing.
!
! 10. Source code :
!
!/ ------------------------------------------------------------------- /
#ifdef W3_S
      USE w3servmd, ONLY: strace
#endif
!
      USE w3gdatmd, ONLY: nx, nnz, iaa, jaa, nsea
      use yownodepool, only: pdlib_ia, pdlib_ja
      IMPLICIT NONE
!/
!/ ------------------------------------------------------------------- /
!/ Parameter list
!/
!/ ------------------------------------------------------------------- /
!/ Local PARAMETERs
!/
#ifdef W3_S
      INTEGER, SAVE           :: IENT = 0
#endif
!/
!/ ------------------------------------------------------------------- /
!/
      REAL(rkind), intent(in) :: ASPAR(NNZ)
      REAL(rkind), intent(in) :: TheIn(NSEA)
      REAL(rkind), intent(out) :: TheOut(NSEA)
      integer IP, J, JP
      REAL(rkind) :: eCoeff
#ifdef W3_S
      CALL strace (ient, 'VA_SETUP_IOBPD')
#endif
      theout=0
      DO ip=1,nsea
        DO j=pdlib_ia(ip),pdlib_ia(ip+1)-1
          jp=pdlib_ja(j)
          ecoeff=aspar(j)
          theout(ip)=theout(ip) + ecoeff*thein(jp)
        END DO
      END DO

References w3gdatmd::iaa, w3gdatmd::jaa, w3gdatmd::nnz, w3gdatmd::nsea, w3gdatmd::nx, yownodepool::pdlib_ia, yownodepool::pdlib_ja, and w3servmd::strace().

Referenced by fd_wave_setup_solve_poisson_neumann_dir().

fd_wave_setup_apply_precond()

subroutine w3wavset::fd_wave_setup_apply_precond	(	real(rkind), dimension(pdlib_nnz), intent(in)	ASPAR,
		real(rkind), dimension(nsea), intent(in)	TheIn,
		real(rkind), dimension(nsea), intent(out)	TheOut
	)

Preconditioning for FD grids.

Parameters

[in]	ASPAR
[in]	TheIn
[out]	TheOut

Author

Mathieu Dutour-Sikiric

Aron Roland

Date

1-May-2018

Definition at line 2040 of file w3wavset.F90.

!/
!/                  +-----------------------------------+
!/                  | WAVEWATCH III           NOAA/NCEP |
!/                  |                                   |
!/                  | Mathieu Dutour-Sikiric (IRB)      |
!/                  | Aron Roland (BGS IT&E GmbH)       |
!/                  |                                   |
!/                  |                        FORTRAN 90 |
!/                  | Last update :         01-Mai-2018 |
!/                  +-----------------------------------+
!/
!/    01-Mai-2018 : Origination.                        ( version 6.04 )
!/
!  1. Purpose : Precond. for FD grids
!  2. Method :
!  3. Parameters :
!
!     Parameter list
!     ----------------------------------------------------------------
!     ----------------------------------------------------------------
!
!  4. Subroutines used :
!
!      Name      Type  Module   Description
!     ----------------------------------------------------------------
!      STRACE    Subr. W3SERVMD Subroutine tracing.
!     ----------------------------------------------------------------
!
!  5. Called by :
!
!      Name      Type  Module   Description
!     ----------------------------------------------------------------
!     ----------------------------------------------------------------
!
!  6. Error messages :
!  7. Remarks
!  8. Structure :
!  9. Switches :
!
!     !/S  Enable subroutine tracing.
!
! 10. Source code :
!
!/ ------------------------------------------------------------------- /
#ifdef W3_S
      USE w3servmd, ONLY: strace
#endif
!
      USE yownodepool, only: pdlib_nnz, pdlib_ia, pdlib_ja, pdlib_i_diag
      USE w3gdatmd, ONLY: nsea
      IMPLICIT NONE
!/
!/ ------------------------------------------------------------------- /
!/ Parameter list
!/
!/ ------------------------------------------------------------------- /
!/ Local PARAMETERs
!/
#ifdef W3_S
      INTEGER, SAVE           :: IENT = 0
#endif
!/
!/ ------------------------------------------------------------------- /
!/
      REAL(rkind), intent(in) :: ASPAR(PDLIB_NNZ)
      REAL(rkind), intent(in) :: TheIn(NSEA)
      REAL(rkind), intent(out) :: TheOut(NSEA)
      integer IP, J1, J, JP, J2
      REAL(rkind) :: eCoeff
      INTEGER :: ThePrecond = 0
#ifdef W3_S
      CALL strace (ient, 'VA_SETUP_IOBPD')
#endif
      IF (theprecond .eq. 0) THEN
        theout=thein
      END IF
      IF (theprecond .eq. 1) THEN
        theout=0
        DO ip=1,nsea
          j1=pdlib_i_diag(ip)
          DO j=pdlib_ia(ip),pdlib_ia(ip+1)-1
            jp=pdlib_ja(j)
            IF (j .eq. j1) THEN
              ecoeff=1.0/aspar(j)
            ELSE
              j2=pdlib_i_diag(jp)
              ecoeff=-aspar(j) /(aspar(j1)*aspar(j2))
            END IF
            theout(ip)=theout(ip) + ecoeff*thein(jp)
          END DO
        END DO
      END IF
      IF (theprecond .eq. 2) THEN
 
        DO ip=1,nsea
          j=pdlib_i_diag(ip)
          theout(ip)=thein(ip)/aspar(j)
        END DO
      END IF

References w3gdatmd::nsea, yownodepool::pdlib_i_diag, yownodepool::pdlib_ia, yownodepool::pdlib_ja, yownodepool::pdlib_nnz, and w3servmd::strace().

Referenced by fd_wave_setup_solve_poisson_neumann_dir().

fd_wave_setup_computation()

subroutine w3wavset::fd_wave_setup_computation

Wave setup comp on FD grids.

Parameters

[in,out]

TheVar

Author

Mathieu Dutour-Sikiric

Aron Roland

Date

1-May-2018

Definition at line 2955 of file w3wavset.F90.

!/
!/                  +-----------------------------------+
!/                  | WAVEWATCH III           NOAA/NCEP |
!/                  |                                   |
!/                  | Mathieu Dutour-Sikiric (IRB)      |
!/                  | Aron Roland (BGS IT&E GmbH)       |
!/                  |                                   |
!/                  |                        FORTRAN 90 |
!/                  | Last update :         01-Mai-2018 |
!/                  +-----------------------------------+
!/
!/    01-Mai-2018 : Origination.                        ( version 6.04 )
!/
!  1. Purpose : wave setup comp. on fd grids
!  2. Method :
!  3. Parameters :
!
!     Parameter list
!     ----------------------------------------------------------------
!     ----------------------------------------------------------------
!
!  4. Subroutines used :
!
!      Name      Type  Module   Description
!     ----------------------------------------------------------------
!      STRACE    Subr. W3SERVMD Subroutine tracing.
!     ----------------------------------------------------------------
!
!  5. Called by :
!
!      Name      Type  Module   Description
!     ----------------------------------------------------------------
!     ----------------------------------------------------------------
!
!  6. Error messages :
!  7. Remarks
!  8. Structure :
!  9. Switches :
!
!     !/S  Enable subroutine tracing.
!
! 10. Source code :
!
!/ ------------------------------------------------------------------- /
#ifdef W3_S
      USE w3servmd, ONLY: strace
#endif
!
      USE yownodepool, only: pdlib_nnz
      USE w3gdatmd, ONLY: nx, nsea, nseal
      USE w3wdatmd, ONLY: zeta_setup
      use yowdatapool, only: rtype, istatus
      USE w3adatmd, ONLY: mpi_comm_wcmp
      USE w3odatmd, only : iaproc, naproc
      IMPLICIT NONE
!/
!/ ------------------------------------------------------------------- /
!/ Parameter list
!/
!/ ------------------------------------------------------------------- /
!/ Local PARAMETERs
!/
#ifdef W3_S
      INTEGER, SAVE           :: IENT = 0
#endif
!/
!/ ------------------------------------------------------------------- /
!/
      REAL(rkind) :: ZETA_WORK(NSEA)
      REAL(rkind) :: F_X(NSEA), F_Y(NSEA)
      REAL(rkind) :: ASPAR(PDLIB_NNZ), B(NX)
      INTEGER ISEA, IPROC
      real(rkind) :: SXX_t(NSEA), SXY_t(NSEA), SYY_t(NSEA)
      integer ierr
#ifdef W3_DEBUGSTP
      real(rkind) max_val, min_val
#endif
#ifdef W3_S
      CALL strace (ient, 'VA_SETUP_IOBPD')
#endif
      CALL fd_collect_sxx_xy_yy(sxx_t, sxy_t, syy_t)
      IF (iaproc .eq. 1) THEN
        CALL fd_compute_lh_stress(sxx_t, sxy_t, syy_t, f_x, f_y)
        DO isea=1,nsea
          zeta_work(isea)=zeta_setup(isea)
        END DO
        CALL fd_wave_setup_compute_system(aspar, b, f_x, f_y)
        CALL fd_wave_setup_solve_poisson_neumann_dir(aspar, b, zeta_work)
        CALL fd_set_meanvalue_to_zero(zeta_work)
        DO iproc=2,naproc
          CALL mpi_send(zeta_work,nsea,rtype, iproc-1, 23, mpi_comm_wcmp, ierr)
        END DO
      ELSE
        CALL mpi_recv(zeta_work,nseal,rtype, 0, 23, mpi_comm_wcmp, istatus, ierr)
      END IF
#ifdef W3_DEBUGSTP
      max_val = zeta_work(isea)
      min_val = zeta_work(isea)
#endif
      DO isea=1,nsea
         zeta_setup(isea)=zeta_work(isea)
#ifdef W3_DEBUGSTP
         max_val = max(max_val, zeta_work(isea))
         min_val = min(min_val, zeta_work(isea))
#endif
      END DO
#ifdef W3_DEBUGSTP
      WRITE(740+iaproc,*) 'FD_WAVE_SETUP_COMPUTATION, max/min=', max_val, min_val
      FLUSH(740+iaproc)
#endif

References fd_collect_sxx_xy_yy(), fd_compute_lh_stress(), fd_set_meanvalue_to_zero(), fd_wave_setup_compute_system(), fd_wave_setup_solve_poisson_neumann_dir(), w3odatmd::iaproc, yowdatapool::istatus, w3adatmd::mpi_comm_wcmp, w3odatmd::naproc, w3gdatmd::nsea, w3gdatmd::nseal, w3gdatmd::nx, yownodepool::pdlib_nnz, yowdatapool::rtype, w3servmd::strace(), and w3wdatmd::zeta_setup.

Referenced by wave_setup_computation().

fd_wave_setup_compute_system()

subroutine w3wavset::fd_wave_setup_compute_system	(	real(rkind), dimension(pdlib_nnz), intent(out)	ASPAR,
		real(rkind), dimension(nx), intent(out)	B,
		real(rkind), dimension(nsea), intent(in)	FX,
		real(rkind), dimension(nsea), intent(in)	FY
	)

Setup matrix on FD grids.

Parameters

[out]	ASPAR
[out]	B
[in]	FX
[in]	FY

Author

Mathieu Dutour-Sikiric

Aron Roland

Date

1-May-2018

Definition at line 2540 of file w3wavset.F90.

!/
!/                  +-----------------------------------+
!/                  | WAVEWATCH III           NOAA/NCEP |
!/                  |                                   |
!/                  | Mathieu Dutour-Sikiric (IRB)      |
!/                  | Aron Roland (BGS IT&E GmbH)       |
!/                  |                                   |
!/                  |                        FORTRAN 90 |
!/                  | Last update :         01-Mai-2018 |
!/                  +-----------------------------------+
!/
!/    01-Mai-2018 : Origination.                        ( version 6.04 )
!/
!  1. Purpose : Setup matrix on FD grids
!  2. Method :
!  3. Parameters :
!
!     Parameter list
!     ----------------------------------------------------------------
!     ----------------------------------------------------------------
!
!  4. Subroutines used :
!
!      Name      Type  Module   Description
!     ----------------------------------------------------------------
!      STRACE    Subr. W3SERVMD Subroutine tracing.
!     ----------------------------------------------------------------
!
!  5. Called by :
!
!      Name      Type  Module   Description
!     ----------------------------------------------------------------
!     ----------------------------------------------------------------
!
!  6. Error messages :
!  7. Remarks
!  8. Structure :
!  9. Switches :
!
!     !/S  Enable subroutine tracing.
!
! 10. Source code :
!
!/ ------------------------------------------------------------------- /
#ifdef W3_S
      USE w3servmd, ONLY: strace
#endif
!
      USE yownodepool, only: pdlib_nnz
      USE w3gdatmd, ONLY: nx, ny, nsea, nbedge, edges
      USE w3adatmd, ONLY: dw
      IMPLICIT NONE
!/
!/ ------------------------------------------------------------------- /
!/ Parameter list
!/
!/ ------------------------------------------------------------------- /
!/ Local PARAMETERs
!/
#ifdef W3_S
      INTEGER, SAVE           :: IENT = 0
#endif
!/
!/ ------------------------------------------------------------------- /
!/
      real(rkind), intent(in)  :: FX(NSEA), FY(NSEA)
      real(rkind), intent(out) :: ASPAR(PDLIB_NNZ)
      real(rkind), intent(out) :: B(NX)
      INTEGER :: POS_TRICK(3,2), POS_SHIFT(3,3)
      integer I1, I2, I3, IP1, IP2, IP3
      integer IDX, IDX1, IDX2, IDX3
      INTEGER IE, IP, I, J, K, IPp, JPp
      real(rkind) :: eDep, eFX, eFY, eScal, eFact, eLen
      real(rkind) :: UGRAD, VGRAD, UGRAD1, VGRAD1, dist1, dist2
      INTEGER LIDX(2), KIDX(2), jdx
      INTEGER ISEAREL, JSEAREL, ISEA, JSEA, IEDGE
#ifdef W3_S
      CALL strace (ient, 'VA_SETUP_IOBPD')
#endif
      !
      aspar=0
      b=0
      DO iedge=1,nbedge
        isea=edges(iedge,1)
        jsea=edges(iedge,2)
        edep=(dw(isea) + dw(jsea))/2.0
        efx =(fx(isea) + fx(jsea))/2.0
        efy =(fy(isea) + fy(jsea))/2.0
        DO i=1,2
          isearel=edges(iedge,i)
          CALL fd_compute_diff(iedge, isearel, ugrad1, vgrad1, dist1)
          escal=ugrad1*efx + vgrad1*efy
          b(isearel) = b(isearel) + escal*dist1
          !
          DO j=1,2
            jsearel=edges(iedge,j)
            CALL fd_compute_diff(iedge, jsearel, ugrad, vgrad, dist2)
            escal=ugrad*ugrad1 + vgrad*vgrad1
            aspar(j)=aspar(j)+efact*escal
          END DO
        END DO
      END DO

References w3adatmd::dw, w3gdatmd::edges, fd_compute_diff(), w3gdatmd::nbedge, w3gdatmd::nsea, w3gdatmd::nx, w3gdatmd::ny, yownodepool::pdlib_nnz, and w3servmd::strace().

Referenced by fd_wave_setup_computation().

fd_wave_setup_scalar_prod()

subroutine w3wavset::fd_wave_setup_scalar_prod	(	real(rkind), dimension(nx), intent(in)	V1,
		real(rkind), dimension(nx), intent(in)	V2,
		real(rkind), intent(inout)	eScal
	)

Scalar product.

Parameters

[in]	V1
[in]	V2
[in,out]	eScal

Author

Mathieu Dutour-Sikiric

Aron Roland

Date

1-May-2018

Definition at line 2656 of file w3wavset.F90.

!/
!/                  +-----------------------------------+
!/                  | WAVEWATCH III           NOAA/NCEP |
!/                  |                                   |
!/                  | Mathieu Dutour-Sikiric (IRB)      |
!/                  | Aron Roland (BGS IT&E GmbH)       |
!/                  |                                   |
!/                  |                        FORTRAN 90 |
!/                  | Last update :         01-Mai-2018 |
!/                  +-----------------------------------+
!/
!/    01-Mai-2018 : Origination.                        ( version 6.04 )
!/
!  1. Purpose : scalar prod.
!  2. Method :
!  3. Parameters :
!
!     Parameter list
!     ----------------------------------------------------------------
!     ----------------------------------------------------------------
!
!  4. Subroutines used :
!
!      Name      Type  Module   Description
!     ----------------------------------------------------------------
!      STRACE    Subr. W3SERVMD Subroutine tracing.
!     ----------------------------------------------------------------
!
!  5. Called by :
!
!      Name      Type  Module   Description
!     ----------------------------------------------------------------
!     ----------------------------------------------------------------
!
!  6. Error messages :
!  7. Remarks
!  8. Structure :
!  9. Switches :
!
!     !/S  Enable subroutine tracing.
!
! 10. Source code :
!
!/ ------------------------------------------------------------------- /
#ifdef W3_S
      USE w3servmd, ONLY: strace
#endif
!
      USE w3gdatmd, ONLY: nx
      IMPLICIT NONE
!/
!/ ------------------------------------------------------------------- /
!/ Parameter list
!/
!/ ------------------------------------------------------------------- /
!/ Local PARAMETERs
!/
#ifdef W3_S
      INTEGER, SAVE           :: IENT = 0
#endif
!/
!/ ------------------------------------------------------------------- /
!/
      real(rkind), intent(in) :: V1(NX), V2(NX)
      real(rkind), intent(inout) :: eScal
      integer IP
#ifdef W3_S
      CALL strace (ient, 'VA_SETUP_IOBPD')
#endif
      escal=0
      DO ip=1,nx
        escal=escal + v1(ip)*v2(ip)
      END DO

References w3gdatmd::nx, and w3servmd::strace().

Referenced by fd_wave_setup_solve_poisson_neumann_dir().

fd_wave_setup_solve_poisson_neumann_dir()

subroutine w3wavset::fd_wave_setup_solve_poisson_neumann_dir	(	real(rkind), dimension(pdlib_nnz), intent(in)	ASPAR,
		real(rkind), dimension(nx), intent(in)	B,
		real(rkind), dimension(nx), intent(out)	TheOut
	)

Poisson solver on FD grids.

Parameters

[in]	ASPAR
[in]	B
[out]	TheOut

Author

Mathieu Dutour-Sikiric

Aron Roland

Date

1-May-2018

Definition at line 2743 of file w3wavset.F90.

!/
!/                  +-----------------------------------+
!/                  | WAVEWATCH III           NOAA/NCEP |
!/                  |                                   |
!/                  | Mathieu Dutour-Sikiric (IRB)      |
!/                  | Aron Roland (BGS IT&E GmbH)       |
!/                  |                                   |
!/                  |                        FORTRAN 90 |
!/                  | Last update :         01-Mai-2018 |
!/                  +-----------------------------------+
!/
!/    01-Mai-2018 : Origination.                        ( version 6.04 )
!/
!  1. Purpose : possoin solver on fd grids
!  2. Method :
!  3. Parameters :
!
!     Parameter list
!     ----------------------------------------------------------------
!     ----------------------------------------------------------------
!
!  4. Subroutines used :
!
!      Name      Type  Module   Description
!     ----------------------------------------------------------------
!      STRACE    Subr. W3SERVMD Subroutine tracing.
!     ----------------------------------------------------------------
!
!  5. Called by :
!
!      Name      Type  Module   Description
!     ----------------------------------------------------------------
!     ----------------------------------------------------------------
!
!  6. Error messages :
!  7. Remarks
!  8. Structure :
!  9. Switches :
!
!     !/S  Enable subroutine tracing.
!
! 10. Source code :
!
!/ ------------------------------------------------------------------- /
#ifdef W3_S
      USE w3servmd, ONLY: strace
#endif
!
      USE yownodepool, only: pdlib_nnz
      USE w3gdatmd, ONLY: nx
      IMPLICIT NONE
!/
!/ ------------------------------------------------------------------- /
!/ Parameter list
!/
!/ ------------------------------------------------------------------- /
!/ Local PARAMETERs
!/
#ifdef W3_S
      INTEGER, SAVE           :: IENT = 0
#endif
!/
!/ ------------------------------------------------------------------- /
!/
      real(rkind), intent(in) :: ASPAR(PDLIB_NNZ)
      real(rkind), intent(in) :: B(NX)
      real(rkind), intent(out) :: TheOut(NX)
      real(rkind) :: V_X(NX), V_R(NX), V_Z(NX), V_P(NX), V_Y(NX)
      real(rkind) :: uO, uN, alphaV, h1, h2
      real(rkind) :: eNorm, beta
      real(rkind) :: SOLVERTHR
      integer IP, nbIter
#ifdef W3_S
      CALL strace (ient, 'VA_SETUP_IOBPD')
#endif
      solverthr=0.00000001
      nbiter=0
      v_x=0
      v_r=b
      CALL fd_wave_setup_apply_precond(aspar, v_r, v_z)
      v_p=v_z
      CALL fd_wave_setup_scalar_prod(v_z, v_r, uo)
      DO
        nbiter=nbiter + 1
        CALL fd_wave_setup_apply_fct(aspar, v_p, v_y)
        CALL fd_wave_setup_scalar_prod(v_p, v_y, h2)
        alphav=uo/h2
        !
        DO ip=1,nx
          v_x(ip) = v_x(ip) + alphav * v_p(ip)
          v_r(ip) = v_r(ip) - alphav * v_y(ip)
        END DO
        !
        CALL fd_wave_setup_scalar_prod(v_r, v_r, enorm)
        IF (enorm .le. solverthr) THEN
          EXIT
        END IF
        !
        CALL fd_wave_setup_apply_precond(aspar, v_r, v_z)
        CALL fd_wave_setup_scalar_prod(v_z, v_r, un)
        !
        beta=un/uo
        uo=un
        !
        DO ip=1,nx
          v_p(ip)=v_z(ip) + beta * v_p(ip)
        END DO
      END DO
      theout=v_x

References fd_wave_setup_apply_fct(), fd_wave_setup_apply_precond(), fd_wave_setup_scalar_prod(), w3gdatmd::nx, yownodepool::pdlib_nnz, and w3servmd::strace().

Referenced by fd_wave_setup_computation().

preparation_fd_scheme()

subroutine w3wavset::preparation_fd_scheme

(

integer, intent(in)

IMOD

)

Wave setup for FD grids.

Parameters

[in]

IMOD

Author

Mathieu Dutour-Sikiric

Aron Roland

Date

1-May-2018

Definition at line 1778 of file w3wavset.F90.

!/
!/                  +-----------------------------------+
!/                  | WAVEWATCH III           NOAA/NCEP |
!/                  |                                   |
!/                  | Mathieu Dutour-Sikiric (IRB)      |
!/                  | Aron Roland (BGS IT&E GmbH)       |
!/                  |                                   |
!/                  |                        FORTRAN 90 |
!/                  | Last update :         01-Mai-2018 |
!/                  +-----------------------------------+
!/
!/    01-Mai-2018 : Origination.                        ( version 6.04 )
!/
!  1. Purpose : Wave setup for FD grids
!  2. Method :
!  3. Parameters :
!
!     Parameter list
!     ----------------------------------------------------------------
!     ----------------------------------------------------------------
!
!  4. Subroutines used :
!
!      Name      Type  Module   Description
!     ----------------------------------------------------------------
!      STRACE    Subr. W3SERVMD Subroutine tracing.
!     ----------------------------------------------------------------
!
!  5. Called by :
!
!      Name      Type  Module   Description
!     ----------------------------------------------------------------
!     ----------------------------------------------------------------
!
!  6. Error messages :
!  7. Remarks
!  8. Structure :
!  9. Switches :
!
!     !/S  Enable subroutine tracing.
!
! 10. Source code :
!
!/ ------------------------------------------------------------------- /
#ifdef W3_S
      USE w3servmd, ONLY: strace
#endif
!
      USE yownodepool, only: pdlib_nnz, pdlib_ia, pdlib_ja, pdlib_i_diag
      USE w3gdatmd, ONLY: nx, ny, nsea, mapsf, grids
      IMPLICIT NONE
!/
!/ ------------------------------------------------------------------- /
!/ Parameter list
!/
!/ ------------------------------------------------------------------- /
!/ Local PARAMETERs
!/
#ifdef W3_S
      INTEGER, SAVE           :: IENT = 0
#endif
!/
!/ ------------------------------------------------------------------- /
!/
      integer, intent(in) :: IMOD
      integer IN, ISEA, nbEdge
      integer IX, IY, idx
      integer NeighMat(4,2)
      integer, allocatable :: STAT_SeaLand(:,:)
      integer, allocatable :: EDGES(:,:)
      integer IXN, JXN, JSEA, J
#ifdef W3_S
      CALL strace (ient, 'VA_SETUP_IOBPD')
#endif
      !
      allocate(grids(imod)%NEIGH(nsea,4))
      grids(imod)%NEIGH=0
      allocate(stat_sealand(nx,ny))
      stat_sealand=0
      DO isea=1,nsea
        ix=mapsf(isea,1)
        iy=mapsf(isea,2)
        stat_sealand(ix,iy)=isea
      END DO
      neighmat(1,1)=1
      neighmat(1,2)=0
      neighmat(2,1)=-1
      neighmat(2,2)=0
      neighmat(3,1)=0
      neighmat(3,2)=1
      neighmat(4,1)=0
      neighmat(4,2)=-1
      nbedge=0
      pdlib_nnz=0
      DO isea=1,nsea
        ix=mapsf(isea,1)
        iy=mapsf(isea,2)
        idx=0
        DO in=1,4
          ixn=ix+neighmat(in,1)
          jxn=ix+neighmat(in,2)
          jsea=stat_sealand(ixn,jxn)
          IF (jsea .gt. 0) THEN
            idx=idx+1
            grids(imod)%NEIGH(isea,idx)=jsea
            IF (jsea < isea) THEN
              nbedge=nbedge+1
            END IF
            pdlib_nnz=pdlib_nnz+1
          END IF
        END DO
        pdlib_nnz=pdlib_nnz+1
      END DO
      !
      grids(imod)%NBEDGE=nbedge
      ALLOCATE(grids(imod)%EDGES(nbedge,2))
      idx=0
      DO isea=1,nsea
        ix=mapsf(isea,1)
        iy=mapsf(isea,2)
        DO in=1,4
          ixn=ix+neighmat(in,1)
          jxn=ix+neighmat(in,2)
          jsea=stat_sealand(ixn,jxn)
          IF (jsea .gt. 0) THEN
            IF (jsea < isea) THEN
              idx=idx+1
              grids(imod)%EDGES(idx,1)=jsea
              grids(imod)%EDGES(idx,2)=isea
            END IF
          END IF
        END DO
      END DO
      !
      ALLOCATE(pdlib_ia(nsea+1))
      ALLOCATE(pdlib_ja(pdlib_nnz))
      ALLOCATE(pdlib_i_diag(nsea))
      pdlib_ia(1)=1
      j=0
      DO isea=1,nsea
        DO in=1,4
          ixn=ix+neighmat(in,1)
          jxn=ix+neighmat(in,2)
          jsea=stat_sealand(ixn,jxn)
          IF (jsea .gt. 0) THEN
            j=j+1
            pdlib_ja(j)=jsea
          END IF
        END DO
        j=j+1
        pdlib_ja(j)=isea
        pdlib_i_diag(isea)=j
        pdlib_ia(isea+1)=j+1
      END DO

References w3gdatmd::grids, w3gdatmd::mapsf, w3gdatmd::nsea, w3gdatmd::nx, w3gdatmd::ny, yownodepool::pdlib_i_diag, yownodepool::pdlib_ia, yownodepool::pdlib_ja, yownodepool::pdlib_nnz, and w3servmd::strace().

Referenced by w3initmd::w3init().

trig_compute_diff()

subroutine w3wavset::trig_compute_diff	(	integer, intent(in)	IE,
		integer, intent(in)	I1,
		real(rkind), intent(inout)	UGRAD,
		real(rkind), intent(inout)	VGRAD
	)

Differentiate other way around.

Parameters

[in]	IE
[in]	I1
[in,out]	UGRAD
[in,out]	VGRAD

Author

Mathieu Dutour-Sikiric

Aron Roland

Date

1-May-2018

Definition at line 599 of file w3wavset.F90.

!/
!/                  +-----------------------------------+
!/                  | WAVEWATCH III           NOAA/NCEP |
!/                  |                                   |
!/                  | Mathieu Dutour-Sikiric (IRB)      |
!/                  | Aron Roland (BGS IT&E GmbH)       |
!/                  |                                   |
!/                  |                        FORTRAN 90 |
!/                  | Last update :         01-Mai-2018 |
!/                  +-----------------------------------+
!/
!/    01-Mai-2018 : Origination.                        ( version 6.04 )
!/
!  1. Purpose : differentiate other way around ...
!  2. Method :
!  3. Parameters :
!
!     Parameter list
!     ----------------------------------------------------------------
!     ----------------------------------------------------------------
!
!  4. Subroutines used :
!
!      Name      Type  Module   Description
!     ----------------------------------------------------------------
!      STRACE    Subr. W3SERVMD Subroutine tracing.
!     ----------------------------------------------------------------
!
!  5. Called by :
!
!      Name      Type  Module   Description
!     ----------------------------------------------------------------
!     ----------------------------------------------------------------
!
!  6. Error messages :
!  7. Remarks
!  8. Structure :
!  9. Switches :
!
!     !/S  Enable subroutine tracing.
!
! 10. Source code :
!
!/ ------------------------------------------------------------------- /
#ifdef W3_S
      USE w3servmd, ONLY: strace
#endif
!
      use yowelementpool, only: ine
      use yownodepool,    only: x, y, pdlib_tria
      IMPLICIT NONE
!/
!/ ------------------------------------------------------------------- /
!/ Parameter list
!/
!/ ------------------------------------------------------------------- /
!/ Local PARAMETERs
!/
#ifdef W3_S
      INTEGER, SAVE           :: IENT = 0
#endif
!/
!/ ------------------------------------------------------------------- /
!/
      INTEGER, intent(in) :: IE, I1
      REAL(rkind), intent(inout) :: UGRAD, VGRAD
      REAL(rkind) :: h
      integer I2, I3, IP1, IP2, IP3
      INTEGER :: POS_TRICK(3,2)
#ifdef W3_S
      CALL strace (ient, 'VA_SETUP_IOBPD')
#endif
      pos_trick(1,1) = 2
      pos_trick(1,2) = 3
      pos_trick(2,1) = 3
      pos_trick(2,2) = 1
      pos_trick(3,1) = 1
      pos_trick(3,2) = 2
      i2=pos_trick(i1, 1)
      i3=pos_trick(i1, 2)
      ip1=ine(i1, ie)
      ip2=ine(i2, ie)
      ip3=ine(i3, ie)
      h=2.0*pdlib_tria(ie)
      ugrad=-(y(ip3) - y(ip2))/h
      vgrad= (x(ip3) - x(ip2))/h

References yowelementpool::ine, yownodepool::pdlib_tria, w3servmd::strace(), yownodepool::x, and yownodepool::y.

Referenced by trig_wave_setup_compute_system().

trig_compute_lh_stress()

subroutine w3wavset::trig_compute_lh_stress	(	real(rkind), dimension(npa), intent(out)	F_X,
		real(rkind), dimension(npa), intent(out)	F_Y,
		real(rkind), dimension(npa), intent(out)	DWNX
	)

Setup boundary pointer.

Parameters

[out]	F_X
[out]	F_Y
[out]	DWNX

Author

Aron Roland

Mathieu Dutour-Sikiric

Date

1-May-2018

Definition at line 449 of file w3wavset.F90.

!/
!/                  +-----------------------------------+
!/                  | WAVEWATCH III           NOAA/NCEP |
!/                  |                                   |
!/                  | Aron Roland (BGS IT&E GmbH)       |
!/                  | Mathieu Dutour-Sikiric (IRB)      |
!/                  |                                   |
!/                  |                        FORTRAN 90 |
!/                  | Last update :         01-Mai-2018 |
!/                  +-----------------------------------+
!/
!/    01-Mai-2018 : Origination.                        ( version 6.04 )
!/
!  1. Purpose : Setup boundary pointer
!  2. Method :
!  3. Parameters :
!
!     Parameter list
!     ----------------------------------------------------------------
!     ----------------------------------------------------------------
!
!  4. Subroutines used :
!
!      Name      Type  Module   Description
!     ----------------------------------------------------------------
!      STRACE    Subr. W3SERVMD Subroutine tracing.
!     ----------------------------------------------------------------
!
!  5. Called by :
!
!      Name      Type  Module   Description
!     ----------------------------------------------------------------
!     ----------------------------------------------------------------
!
!  6. Error messages :
!  7. Remarks
!  8. Structure :
!  9. Switches :
!
!     !/S  Enable subroutine tracing.
!
! 10. Source code :
!
!/ ------------------------------------------------------------------- /
#ifdef W3_S
      USE w3servmd, ONLY: strace
#endif
!
      USE constants, ONLY: grav, dwat
      use yownodepool, only: npa, iplg
      USE w3gdatmd, only : mapfs
      USE w3adatmd, ONLY: sxx, sxy, syy, wn, cg
      USE w3parall, only: init_get_isea
      USE w3odatmd, only : iaproc
      USE w3gdatmd, ONLY : nseal, mapsta
      USE w3adatmd, ONLY: dw
      IMPLICIT NONE
!/
!/ ------------------------------------------------------------------- /
!/ Parameter list
!/
!/ ------------------------------------------------------------------- /
!/ Local PARAMETERs
!/
#ifdef W3_S
      INTEGER, SAVE           :: IENT = 0
#endif
!/
!/ ------------------------------------------------------------------- /
!/
      real(rkind), intent(out) :: F_X(npa), F_Y(npa), DWNX(npa)
      REAL(rkind) :: h
      REAL(rkind) :: SXX_X, SXX_Y
      REAL(rkind) :: SXY_X, SXY_Y
      REAL(rkind) :: SYY_X, SYY_Y
      INTEGER I, IP, IX
      INTEGER JSEA, ISEA
      real(rkind) :: U_X1(npa), U_Y1(npa)
      real(rkind) :: U_X2(npa), U_Y2(npa)
      real(rkind) :: SXX_p(npa), SXY_p(npa), SYY_p(npa)
      real(rkind) :: eSXX, eSXY, eSYY
      integer :: SXXmethod = 1
#ifdef W3_S
      CALL strace (ient, 'VA_SETUP_IOBPD')
#endif
      sxx_p=0
      sxy_p=0
      syy_p=0
      dwnx=0
      DO jsea=1,nseal
        ip = jsea ! We remove the Z_status because now NX = NSEA
        ix=iplg(ip)
        isea=mapfs(1,ix)
        IF (sxxmethod .eq. 1) THEN
          esxx=sxx(jsea)/(dwat*grav)
          esxy=sxy(jsea)/(dwat*grav)
          esyy=syy(jsea)/(dwat*grav)
        END IF
        sxx_p(ip)=dble(esxx)
        sxy_p(ip)=dble(esxy)
        syy_p(ip)=dble(esyy)
        dwnx(ip)=dw(isea)
      END DO
      !
#ifdef W3_DEBUGSTP
      WRITE(740+iaproc,*) 'min/max(DEP)=', minval(dwnx), maxval(dwnx)
      WRITE(740+iaproc,*) 'sum(abs(SXX))=', sum(abs(sxx_p))
      WRITE(740+iaproc,*) 'sum(abs(SXY))=', sum(abs(sxy_p))
      WRITE(740+iaproc,*) 'sum(abs(SYY))=', sum(abs(syy_p))
      FLUSH(740+iaproc)
#endif
 
      CALL differentiate_xydir(sxx_p, u_x1, u_y1)
#ifdef W3_DEBUGSTP
      WRITE(740+iaproc,*) 'sum(absU_XY1)=', sum(abs(u_x1)), sum(abs(u_y1))
      FLUSH(740+iaproc)
#endif
      CALL differentiate_xydir(sxy_p, u_x2, u_y2)
#ifdef W3_DEBUGSTP
      WRITE(740+iaproc,*) 'sum(absU_XY2)=', sum(abs(u_x2)), sum(abs(u_y2))
      FLUSH(740+iaproc)
#endif
      f_x = -u_x1 - u_y2
      !
      CALL differentiate_xydir(syy_p, u_x1, u_y1)
#ifdef W3_DEBUGSTP
      WRITE(740+iaproc,*) 'sum(absU_XY1)=', sum(abs(u_x1)), sum(abs(u_y1))
      FLUSH(740+iaproc)
#endif
      f_y = -u_y1 - u_x2
#ifdef W3_DEBUGSTP
      WRITE(740+iaproc,*) 'sum(F_X)=', sum(f_x)
      WRITE(740+iaproc,*) 'sum(F_Y)=', sum(f_y)
      FLUSH(740+iaproc)
#endif

References w3adatmd::cg, differentiate_xydir(), w3adatmd::dw, constants::dwat, constants::grav, w3odatmd::iaproc, w3parall::init_get_isea(), yownodepool::iplg, w3gdatmd::mapfs, w3gdatmd::mapsta, yownodepool::npa, w3gdatmd::nseal, w3servmd::strace(), w3adatmd::sxx, w3adatmd::sxy, w3adatmd::syy, and w3adatmd::wn.

Referenced by trig_wave_setup_computation().

trig_set_meanvalue_to_zero()

subroutine w3wavset::trig_set_meanvalue_to_zero

(

real(rkind), dimension(npa), intent(inout)

TheVar

)

Set mean value.

Parameters

[in,out]

TheVar

Author

Mathieu Dutour-Sikiric

Aron Roland

Date

1-May-2018

Definition at line 1380 of file w3wavset.F90.

!/
!/                  +-----------------------------------+
!/                  | WAVEWATCH III           NOAA/NCEP |
!/                  |                                   |
!/                  | Mathieu Dutour-Sikiric (IRB)      |
!/                  | Aron Roland (BGS IT&E GmbH)       |
!/                  |                                   |
!/                  |                        FORTRAN 90 |
!/                  | Last update :         01-Mai-2018 |
!/                  +-----------------------------------+
!/
!/    01-Mai-2018 : Origination.                        ( version 6.04 )
!/
!  1. Purpose : set. mean value
!  2. Method :
!  3. Parameters :
!
!     Parameter list
!     ----------------------------------------------------------------
!     ----------------------------------------------------------------
!
!  4. Subroutines used :
!
!      Name      Type  Module   Description
!     ----------------------------------------------------------------
!      STRACE    Subr. W3SERVMD Subroutine tracing.
!     ----------------------------------------------------------------
!
!  5. Called by :
!
!      Name      Type  Module   Description
!     ----------------------------------------------------------------
!     ----------------------------------------------------------------
!
!  6. Error messages :
!  7. Remarks
!  8. Structure :
!  9. Switches :
!
!     !/S  Enable subroutine tracing.
!
! 10. Source code :
!
!/ ------------------------------------------------------------------- /
#ifdef W3_S
      USE w3servmd, ONLY: strace
#endif
!
      USE yownodepool, only: pdlib_si
      USE w3gdatmd, ONLY: nx, si
      USE w3gdatmd, ONLY: nseal
      USE w3adatmd, ONLY: mpi_comm_wcmp
      USE w3odatmd, only : iaproc, naproc, ntproc
      use yowdatapool, only: rtype, istatus
      use yownodepool, only: np, npa
      USE mpi, only : mpi_sum
      IMPLICIT NONE
!/
!/ ------------------------------------------------------------------- /
!/ Parameter list
!/
!/ ------------------------------------------------------------------- /
!/ Local PARAMETERs
!/
#ifdef W3_S
      INTEGER, SAVE           :: IENT = 0
#endif
!/
!/ ------------------------------------------------------------------- /
!/
      real(rkind), intent(inout) :: TheVar(npa)
      real(rkind) :: SUM_SI_Var, SUM_SI, TheMean
      INTEGER IP, ierr
      real(rkind) :: eVect_loc(2), eVect_gl(2)
      integer iProc
#ifdef W3_S
      CALL strace (ient, 'VA_SETUP_IOBPD')
#endif
      sum_si_var=0
      sum_si=0
      DO ip=1,np
        sum_si_var = sum_si_var + pdlib_si(ip)*thevar(ip)
        sum_si     = sum_si     + pdlib_si(ip)
      END DO
      evect_loc(1)=sum_si_var
      evect_loc(2)=sum_si
#ifdef W3_DEBUGSTP
      WRITE(740+iaproc,*) 'SUM_SI_Var=', sum_si_var, 'SUM_SI=', sum_si
      FLUSH(740+iaproc)
#endif
      CALL mpi_allreduce(evect_loc,evect_gl,2,rtype,mpi_sum,mpi_comm_wcmp,ierr)
      sum_si_var=evect_gl(1)
      sum_si    =evect_gl(2)
      themean=sum_si_var/sum_si
#ifdef W3_DEBUGSTP
      WRITE(740+iaproc,*) 'TheMean=', themean
      FLUSH(740+iaproc)
#endif
      DO ip=1,npa
        thevar(ip)=thevar(ip) - themean
      END DO

References w3odatmd::iaproc, yowdatapool::istatus, w3adatmd::mpi_comm_wcmp, w3odatmd::naproc, yownodepool::np, yownodepool::npa, w3gdatmd::nseal, w3odatmd::ntproc, w3gdatmd::nx, yownodepool::pdlib_si, yowdatapool::rtype, w3gdatmd::si, and w3servmd::strace().

Referenced by trig_wave_setup_computation().

trig_wave_setup_apply_fct()

subroutine w3wavset::trig_wave_setup_apply_fct	(	real(rkind), dimension(pdlib_nnz), intent(in)	ASPAR,
		real(rkind), dimension(npa), intent(in)	TheIn,
		real(rkind), dimension(npa), intent(out)	TheOut,
		integer, dimension(npa), intent(in)	ACTIVE,
		integer, dimension(npa), intent(in)	ACTIVESEC
	)

Parameters

[in]	ASPAR
[in]	TheIn
[out]	TheOut
[in]	ACTIVE
[in]	ACTIVESEC

Author

Mathieu Dutour-Sikiric

Aron Roland

Date

1-May-2018

Definition at line 1021 of file w3wavset.F90.

!/
!/                  +-----------------------------------+
!/                  | WAVEWATCH III           NOAA/NCEP |
!/                  |                                   |
!/                  | Mathieu Dutour-Sikiric (IRB)      |
!/                  | Aron Roland (BGS IT&E GmbH)       |
!/                  |                                   |
!/                  |                        FORTRAN 90 |
!/                  | Last update :         01-Mai-2018 |
!/                  +-----------------------------------+
!/
!/    01-Mai-2018 : Origination.                        ( version 6.04 )
!/
!  1. Purpose : compute off diagonal contr.
!  2. Method :
!  3. Parameters :
!
!     Parameter list
!     ----------------------------------------------------------------
!     ----------------------------------------------------------------
!
!  4. Subroutines used :
!
!      Name      Type  Module   Description
!     ----------------------------------------------------------------
!      STRACE    Subr. W3SERVMD Subroutine tracing.
!     ----------------------------------------------------------------
!
!  5. Called by :
!
!      Name      Type  Module   Description
!     ----------------------------------------------------------------
!     ----------------------------------------------------------------
!
!  6. Error messages :
!  7. Remarks
!  8. Structure :
!  9. Switches :
!
!     !/S  Enable subroutine tracing.
!
! 10. Source code :
!
!/ ------------------------------------------------------------------- /
#ifdef W3_S
      USE w3servmd, ONLY: strace
#endif
!
      use yowexchangemodule, only : pdlib_exchange1dreal
      USE yownodepool, only: pdlib_ia, pdlib_ja, pdlib_nnz
      use yownodepool, only: np, npa
      USE w3gdatmd, ONLY: nseal
      IMPLICIT NONE
!/
!/ ------------------------------------------------------------------- /
!/ Parameter list
!/
!/ ------------------------------------------------------------------- /
!/ Local PARAMETERs
!/
#ifdef W3_S
      INTEGER, SAVE           :: IENT = 0
#endif
!/
!/ ------------------------------------------------------------------- /
!/
      REAL(rkind), intent(in) :: ASPAR(PDLIB_NNZ)
      REAL(rkind), intent(in) :: TheIn(npa)
      REAL(rkind), intent(out) :: TheOut(npa)
      INTEGER, intent(in) :: ACTIVE(npa), ACTIVESEC(npa)
      integer IP, J, JP
      REAL(rkind) :: eCoeff
#ifdef W3_S
      CALL strace (ient, 'VA_SETUP_IOBPD')
#endif
      theout=0
      DO ip=1,npa
        IF (activesec(ip) .eq. 1) THEN
          DO j=pdlib_ia(ip),pdlib_ia(ip+1)-1
            jp=pdlib_ja(j)
            ecoeff=aspar(j)
            theout(ip)=theout(ip) + ecoeff*thein(jp)
          END DO
        END IF
      END DO
      CALL pdlib_exchange1dreal(theout)

References yownodepool::np, yownodepool::npa, w3gdatmd::nseal, yowexchangemodule::pdlib_exchange1dreal(), yownodepool::pdlib_ia, yownodepool::pdlib_ja, yownodepool::pdlib_nnz, and w3servmd::strace().

Referenced by trig_wave_setup_solve_poisson_neumann_dir().

trig_wave_setup_apply_precond()

subroutine w3wavset::trig_wave_setup_apply_precond	(	real(rkind), dimension(pdlib_nnz), intent(in)	ASPAR,
		real(rkind), dimension(npa), intent(in)	TheIn,
		real(rkind), dimension(npa), intent(out)	TheOut,
		integer, dimension(npa), intent(in)	ACTIVE,
		integer, dimension(npa), intent(in)	ACTIVESEC
	)

Preconditioner.

Parameters

[in]	ASPAR
[in]	TheIn
[out]	TheOut
[in]	ACTIVE
[in]	ACTIVESEC

Author

Mathieu Dutour-Sikiric

Aron Roland

Date

1-May-2018

Definition at line 893 of file w3wavset.F90.

!/
!/                  +-----------------------------------+
!/                  | WAVEWATCH III           NOAA/NCEP |
!/                  |                                   |
!/                  | Mathieu Dutour-Sikiric (IRB)      |
!/                  | Aron Roland (BGS IT&E GmbH)       |
!/                  |                                   |
!/                  |                        FORTRAN 90 |
!/                  | Last update :         01-Mai-2018 |
!/                  +-----------------------------------+
!/
!/    01-Mai-2018 : Origination.                        ( version 6.04 )
!/
!  1. Purpose : preconditioner
!  2. Method :
!  3. Parameters :
!
!     Parameter list
!     ----------------------------------------------------------------
!     ----------------------------------------------------------------
!
!  4. Subroutines used :
!
!      Name      Type  Module   Description
!     ----------------------------------------------------------------
!      STRACE    Subr. W3SERVMD Subroutine tracing.
!     ----------------------------------------------------------------
!
!  5. Called by :
!
!      Name      Type  Module   Description
!     ----------------------------------------------------------------
!     ----------------------------------------------------------------
!
!  6. Error messages :
!  7. Remarks
!  8. Structure :
!  9. Switches :
!
!     !/S  Enable subroutine tracing.
!
! 10. Source code :
!
!/ ------------------------------------------------------------------- /
#ifdef W3_S
      USE w3servmd, ONLY: strace
#endif
!
      use yowexchangemodule, only : pdlib_exchange1dreal
      use yownodepool, only: pdlib_nnz, pdlib_ia, pdlib_ja, pdlib_i_diag
      use yownodepool, only: npa
      USE w3odatmd, only : iaproc
      USE w3odatmd, only : iaproc
      USE yownodepool, only: iplg
      IMPLICIT NONE
!/
!/ ------------------------------------------------------------------- /
!/ Parameter list
!/
!/ ------------------------------------------------------------------- /
!/ Local PARAMETERs
!/
#ifdef W3_S
      INTEGER, SAVE           :: IENT = 0
#endif
!/
!/ ------------------------------------------------------------------- /
!/
      REAL(rkind), intent(in) :: ASPAR(PDLIB_NNZ)
      REAL(rkind), intent(in) :: TheIn(npa)
      REAL(rkind), intent(out) :: TheOut(npa)
      INTEGER, intent(IN) :: ACTIVE(npa), ACTIVESEC(npa)
      integer IP, J1, J, JP, J2
      REAL(rkind) :: eCoeff
      INTEGER :: ThePrecond = 2
#ifdef W3_S
      CALL strace (ient, 'VA_SETUP_IOBPD')
#endif
      IF (theprecond .eq. 0) THEN
        theout=thein
      END IF
      IF (theprecond .eq. 1) THEN
        theout=0
        DO ip=1,npa
          IF (active(ip) .eq. 1) THEN
            j1=pdlib_i_diag(ip)
            DO j=pdlib_ia(ip),pdlib_ia(ip+1)-1
              jp=pdlib_ja(j)
              IF (activesec(jp) .eq. 1) THEN
                IF (j .eq. j1) THEN
                  ecoeff=1.0/aspar(j)
                ELSE
                  j2=pdlib_i_diag(jp)
                  ecoeff=-aspar(j) /(aspar(j1)*aspar(j2))
                END IF
                theout(ip)=theout(ip) + ecoeff*thein(jp)
              END IF
            END DO
          END IF
        END DO
      END IF
      IF (theprecond .eq. 2) THEN
        DO ip=1,npa
          IF (activesec(ip) .eq. 1) THEN
            j=pdlib_i_diag(ip)
            theout(ip)=thein(ip)/aspar(j)
          ELSE
            theout(ip)=thein(ip)
          END IF
        END DO
      END IF
      CALL pdlib_exchange1dreal(theout)

References w3odatmd::iaproc, yownodepool::iplg, yownodepool::npa, yowexchangemodule::pdlib_exchange1dreal(), yownodepool::pdlib_i_diag, yownodepool::pdlib_ia, yownodepool::pdlib_ja, yownodepool::pdlib_nnz, and w3servmd::strace().

Referenced by trig_wave_setup_solve_poisson_neumann_dir().

trig_wave_setup_computation()

subroutine w3wavset::trig_wave_setup_computation

Setup computation.

Author

Mathieu Dutour-Sikiric

Aron Roland

Date

1-May-2018

Definition at line 1598 of file w3wavset.F90.

!/
!/                  +-----------------------------------+
!/                  | WAVEWATCH III           NOAA/NCEP |
!/                  |                                   |
!/                  | Mathieu Dutour-Sikiric (IRB)      |
!/                  | Aron Roland (BGS IT&E GmbH)       |
!/                  |                                   |
!/                  |                        FORTRAN 90 |
!/                  | Last update :         01-Mai-2018 |
!/                  +-----------------------------------+
!/
!/    01-Mai-2018 : Origination.                        ( version 6.04 )
!/
!  1. Purpose : Setup computation
!  2. Method :
!  3. Parameters :
!
!     Parameter list
!     ----------------------------------------------------------------
!     ----------------------------------------------------------------
!
!  4. Subroutines used :
!
!      Name      Type  Module   Description
!     ----------------------------------------------------------------
!      STRACE    Subr. W3SERVMD Subroutine tracing.
!     ----------------------------------------------------------------
!
!  5. Called by :
!
!      Name      Type  Module   Description
!     ----------------------------------------------------------------
!     ----------------------------------------------------------------
!
!  6. Error messages :
!  7. Remarks
!  8. Structure :
!  9. Switches :
!
!     !/S  Enable subroutine tracing.
!
! 10. Source code :
!
!/ ------------------------------------------------------------------- /
#ifdef W3_S
      USE w3servmd, ONLY: strace
#endif
!
      USE yownodepool, only: pdlib_nnz, pdlib_ia, pdlib_ja, iplg, npa, np
      USE w3gdatmd, only : mapfs
      USE w3parall, only : synchronize_global_array
      USE w3adatmd, ONLY: dw
      USE w3gdatmd, ONLY: nseal, nsea, nx
      USE w3wdatmd, ONLY: zeta_setup
      USE w3odatmd, only : iaproc, naproc, ntproc
      USE w3parall, only: init_get_isea
      use yowexchangemodule, only : pdlib_exchange1dreal
      IMPLICIT NONE
!/
!/ ------------------------------------------------------------------- /
!/ Parameter list
!/
!/ ------------------------------------------------------------------- /
!/ Local PARAMETERs
!/
#ifdef W3_S
      INTEGER, SAVE           :: IENT = 0
#endif
!/
!/ ------------------------------------------------------------------- /
!/
!
!      CALL W3SETG
      REAL(rkind) :: ZETA_WORK(npa)
      REAL(rkind) :: ZETA_WORK_ALL(NX)
      REAL(rkind) :: F_X(npa), F_Y(npa), DWNX(npa)
      REAL(rkind) :: ASPAR(PDLIB_NNZ), B(npa)
      INTEGER I, ISEA, JSEA, IX, IP, IP_glob
      INTEGER :: ACTIVE(npa), ACTIVESEC(npa)
      REAL(rkind) max_val, min_val
#ifdef W3_S
      CALL strace (ient, 'VA_SETUP_IOBPD')
#endif
!   ZETA_SETUP is allocated on 1:NSEA
!   ZETA_WORK is on 1:npa
#ifdef W3_DEBUGSTP
      WRITE(740+iaproc,*) 'NAPROC=', naproc, ' NTPROC=', ntproc
      WRITE(740+iaproc,*) 'NSEAL=', nseal
      WRITE(740+iaproc,*) 'npa=', npa, ' np=', np
      FLUSH(740+iaproc)
#endif
      zeta_work=0
      DO ip=1,npa
        ix=iplg(ip)
        isea=mapfs(1,ix)
        IF (isea .gt. 0) THEN
          zeta_work(ip)=zeta_setup(isea)
        END IF
      END DO
#ifdef W3_DEBUGSTP
      WRITE(740+iaproc,*) 'Before TRIG_COMPUTE_LH_STRESS'
      FLUSH(740+iaproc)
#endif
 
      CALL trig_compute_lh_stress(f_x, f_y, dwnx)
#ifdef W3_DEBUGSTP
      WRITE(740+iaproc,*) 'After TRIG_COMPUTE_LH_STRESS'
      FLUSH(740+iaproc)
#endif
      CALL compute_active_node(dwnx, active)
#ifdef W3_DEBUGSTP
      WRITE(740+iaproc,*) 'After COMPUTE_ACTIVE_NODE'
      FLUSH(740+iaproc)
#endif
      CALL trig_wave_setup_compute_system(aspar, b, f_x, f_y, dwnx, active, activesec)
#ifdef W3_DEBUGSTP
      WRITE(740+iaproc,*) 'Before,B,min=', minval(b), ' max=', maxval(b)
      FLUSH(740+iaproc)
#endif
 
 
!      CALL TRIG_SET_MEANVALUE_TO_ZERO(B)
#ifdef W3_DEBUGSTP
      WRITE(740+iaproc,*) 'After,B,min=', minval(b), ' max=', maxval(b)
      FLUSH(740+iaproc)
#endif
 
 
      CALL trig_wave_setup_solve_poisson_neumann_dir(aspar, b, zeta_work, active, activesec)
 
      CALL trig_set_meanvalue_to_zero(zeta_work)
#ifdef W3_DEBUGSTP
      WRITE(740+iaproc,*) 'After SET_MEAN ZETA_WORK(min/max)=', minval(zeta_work), maxval(zeta_work)
      FLUSH(740+iaproc)
#endif
      CALL pdlib_exchange1dreal(zeta_work)
      max_val = -100000000
      min_val = -100000000
      DO ip=1,npa
        ix=iplg(ip)
        isea=mapfs(1,ix)
        IF (isea .gt. 0) THEN
           zeta_setup(isea) = zeta_work(ip)
           max_val = max(max_val, zeta_work(ip))
           min_val = max(min_val, zeta_work(ip))
        END IF
      END DO
#ifdef W3_DEBUGSTP
      WRITE(740+iaproc,*) 'TRIG_WAVE_SETUP_COMPUTATION, max/min=', max_val, min_val
      FLUSH(740+iaproc)
#endif
      zeta_work_all = 0.
      DO ip = 1, npa
        isea = iplg(ip)
        zeta_work_all(isea) = zeta_work(ip)
      END DO
      CALL synchronize_global_array(zeta_work_all)
      DO ix = 1, nx
        zeta_setup(ix) = zeta_work_all(ix)
      END DO
      IF (iaproc .EQ. 1) THEN
        write(6666)  1. 
        write(6666)  (zeta_work_all(ix), zeta_work_all(ix), zeta_work_all(ix), ix = 1, nx)
      ENDIF
#ifdef W3_DEBUGSTP
      WRITE(740+iaproc,*) 'Now exiting TRIG_WAVE_SETUP_COMPUTATION'
      FLUSH(740+iaproc)
#endif

References compute_active_node(), w3adatmd::dw, w3odatmd::iaproc, w3parall::init_get_isea(), yownodepool::iplg, w3gdatmd::mapfs, w3odatmd::naproc, yownodepool::np, yownodepool::npa, w3gdatmd::nsea, w3gdatmd::nseal, w3odatmd::ntproc, w3gdatmd::nx, yowexchangemodule::pdlib_exchange1dreal(), yownodepool::pdlib_ia, yownodepool::pdlib_ja, yownodepool::pdlib_nnz, w3servmd::strace(), w3parall::synchronize_global_array(), trig_compute_lh_stress(), trig_set_meanvalue_to_zero(), trig_wave_setup_compute_system(), trig_wave_setup_solve_poisson_neumann_dir(), and w3wdatmd::zeta_setup.

Referenced by wave_setup_computation().

trig_wave_setup_compute_system()

subroutine w3wavset::trig_wave_setup_compute_system	(	real(rkind), dimension(pdlib_nnz), intent(out)	ASPAR,
		real(rkind), dimension(npa), intent(out)	B,
		real(rkind), dimension(npa), intent(in)	FX,
		real(rkind), dimension(npa), intent(in)	FY,
		real(rkind), dimension(npa), intent(in)	DWNX,
		integer, dimension(npa), intent(in)	ACTIVE,
		integer, dimension(npa), intent(out)	ACTIVESEC
	)

Setup system matrix for solutions of wave setup eq.

Parameters

[in]	FX
[in]	FY
[in]	DWNX
[out]	ASPAR
[out]	B
[in]	ACTIVE
[out]	ACTIVESEC

Author

Mathieu Dutour-Sikiric

Aron Roland

Date

1-May-2018

Definition at line 703 of file w3wavset.F90.

!/
!/                  +-----------------------------------+
!/                  | WAVEWATCH III           NOAA/NCEP |
!/                  |                                   |
!/                  | Mathieu Dutour-Sikiric (IRB)      |
!/                  | Aron Roland (BGS IT&E GmbH)       |
!/                  |                                   |
!/                  |                        FORTRAN 90 |
!/                  | Last update :         01-Mai-2018 |
!/                  +-----------------------------------+
!/
!/    01-Mai-2018 : Origination.                        ( version 6.04 )
!/
!  1. Purpose : Setup system matrix for solutions of wave setup eq.
!  2. Method :
!  3. Parameters :
!
!     Parameter list
!     ----------------------------------------------------------------
!     ----------------------------------------------------------------
!
!  4. Subroutines used :
!
!      Name      Type  Module   Description
!     ----------------------------------------------------------------
!      STRACE    Subr. W3SERVMD Subroutine tracing.
!     ----------------------------------------------------------------
!
!  5. Called by :
!
!      Name      Type  Module   Description
!     ----------------------------------------------------------------
!     ----------------------------------------------------------------
!
!  6. Error messages :
!  7. Remarks
!  8. Structure :
!  9. Switches :
!
!     !/S  Enable subroutine tracing.
!
! 10. Source code :
!
!/ ------------------------------------------------------------------- /
#ifdef W3_S
      USE w3servmd, ONLY: strace
#endif
!
      use yowelementpool, only: ine, ne
      use yownodepool, only: pdlib_nnz, pdlib_ja_ie, pdlib_tria, npa, np
      use yownodepool, only: pdlib_i_diag
      USE yownodepool, only: iplg
      USE w3odatmd, only : iaproc
      IMPLICIT NONE
!/
!/ ------------------------------------------------------------------- /
!/ Parameter list
!/
!/ ------------------------------------------------------------------- /
!/ Local PARAMETERs
!/
#ifdef W3_S
      INTEGER, SAVE           :: IENT = 0
#endif
!/
!/ ------------------------------------------------------------------- /
!/
      real(rkind), intent(in)  :: FX(npa), FY(npa), DWNX(npa)
      real(rkind), intent(out) :: ASPAR(PDLIB_NNZ)
      real(rkind), intent(out) :: B(npa)
      integer, intent(in)  :: ACTIVE(npa)
      integer, intent(out)  :: ACTIVESEC(npa)
      INTEGER :: POS_TRICK(3,2), POS_SHIFT(3,3)
      integer I1, I2, I3, IP1, IP2, IP3
      integer IDX, IDX1, IDX2, IDX3
      INTEGER IE, IP, I, J, K, IPp, JPp
      real(rkind) :: eDep, eFX, eFY, eScal, eFact, eArea
      real(rkind) :: UGRAD, VGRAD, UGRAD1, VGRAD1
      real(rkind) :: eOff
      logical DoPrintOut
      INTEGER sumActive
      INTEGER LIDX(2), KIDX(2), jdx
      INTEGER IPglob1, IPglob2, IPglob3
#ifdef W3_DEBUGSTP
      REAL(rkind) :: ListDiag(npa)
#endif
#ifdef W3_S
      CALL strace (ient, 'VA_SETUP_IOBPD')
#endif
      pos_trick(1,1) = 2
      pos_trick(1,2) = 3
      pos_trick(2,1) = 3
      pos_trick(2,2) = 1
      pos_trick(3,1) = 1
      pos_trick(3,2) = 2
      aspar=0
      b=0
      DO i=1,3
        DO j=1,3
          k= i-j+1
          IF (k .le. 0) THEN
            k=k+3
          END IF
          IF (k .ge. 4) THEN
            k=k-3
          END IF
          pos_shift(i,j)=k
        END DO
      END DO
      DO i=1,3
        jdx=0
        DO idx=1,3
          k=pos_shift(i,idx)
          IF (k .ne. i) THEN
            jdx=jdx+1
            lidx(jdx)=idx
            kidx(jdx)=k
          END IF
        END DO
        pos_shift(i,lidx(1))=kidx(2)
        pos_shift(i,lidx(2))=kidx(1)
      END DO
      activesec=0
      DO ie=1,ne
        ip1=ine(1,ie)
        ip2=ine(2,ie)
        ip3=ine(3,ie)
        efx =(fx(ip1) + fx(ip2) + fx(ip3))/3
        efy =(fy(ip1) + fy(ip2) + fy(ip3))/3
        sumactive=active(ip1) + active(ip2) + active(ip3)
        IF (sumactive .eq. 3) THEN
          activesec(ip1)=1
          activesec(ip2)=1
          activesec(ip3)=1
          edep=(dwnx(ip1) + dwnx(ip2) + dwnx(ip3))/3.0
          earea=pdlib_tria(ie)
          efact=edep*earea
          DO i1=1,3
            i2=pos_trick(i1,1)
            i3=pos_trick(i1,2)
            ip1=ine(i1,ie)
            ip2=ine(i2,ie)
            ip3=ine(i3,ie)
            idx1=pdlib_ja_ie(i1,1,ie)
            idx2=pdlib_ja_ie(i1,2,ie)
            idx3=pdlib_ja_ie(i1,3,ie)
            CALL trig_compute_diff(ie, i1, ugrad1, vgrad1)
            escal=ugrad1*efx + vgrad1*efy
            b(ip1) = b(ip1) + escal*earea
            !
            DO idx=1,3
              k=pos_shift(i1, idx)
              CALL trig_compute_diff(ie, k, ugrad, vgrad)
              escal=ugrad*ugrad1 + vgrad*vgrad1
              j=pdlib_ja_ie(i1,idx,ie)
              aspar(j)=aspar(j) + efact*escal
            END DO
          END DO
        END IF
      END DO
      doprintout=.true.
      IF (doprintout .eqv. .true.) THEN
        DO ip=1,np
          eoff=0
        END DO
      END IF
#ifdef W3_DEBUGSTP
      DO ip=1,npa
         j=pdlib_i_diag(ip)
         listdiag(ip)=aspar(j)
      END DO
      WRITE(740+iaproc,*) 'Diag, min=', minval(listdiag), ' max=', maxval(listdiag)
      WRITE(740+iaproc,*) 'Diag, quot=', maxval(listdiag)/minval(listdiag)
#endif

References w3odatmd::iaproc, yowelementpool::ine, yownodepool::iplg, yowelementpool::ne, yownodepool::np, yownodepool::npa, yownodepool::pdlib_i_diag, yownodepool::pdlib_ja_ie, yownodepool::pdlib_nnz, yownodepool::pdlib_tria, w3servmd::strace(), and trig_compute_diff().

Referenced by trig_wave_setup_computation().

trig_wave_setup_scalar_prod()

subroutine w3wavset::trig_wave_setup_scalar_prod	(	real(rkind), dimension(npa), intent(in)	V1,
		real(rkind), dimension(npa), intent(in)	V2,
		real(rkind), intent(inout)	eScal
	)

Scalar product plus exchange.

Parameters

[in]	V1
[in]	V2
[in,out]	eScal

Author

Mathieu Dutour-Sikiric

Aron Roland

Date

1-May-2018

Definition at line 1121 of file w3wavset.F90.

!/
!/                  +-----------------------------------+
!/                  | WAVEWATCH III           NOAA/NCEP |
!/                  |                                   |
!/                  | Mathieu Dutour-Sikiric (IRB)      |
!/                  | Aron Roland (BGS IT&E GmbH)       |
!/                  |                                   |
!/                  |                        FORTRAN 90 |
!/                  | Last update :         01-Mai-2018 |
!/                  +-----------------------------------+
!/
!/    01-Mai-2018 : Origination.                        ( version 6.04 )
!/
!  1. Purpose : scalar prod. + exchange
!  2. Method :
!  3. Parameters :
!
!     Parameter list
!     ----------------------------------------------------------------
!     ----------------------------------------------------------------
!
!  4. Subroutines used :
!
!      Name      Type  Module   Description
!     ----------------------------------------------------------------
!      STRACE    Subr. W3SERVMD Subroutine tracing.
!     ----------------------------------------------------------------
!
!  5. Called by :
!
!      Name      Type  Module   Description
!     ----------------------------------------------------------------
!     ----------------------------------------------------------------
!
!  6. Error messages :
!  7. Remarks
!  8. Structure :
!  9. Switches :
!
!     !/S  Enable subroutine tracing.
!
! 10. Source code :
!
!/ ------------------------------------------------------------------- /
#ifdef W3_S
      USE w3servmd, ONLY: strace
#endif
!
      USE w3gdatmd, ONLY: nx
      USE w3adatmd, ONLY: mpi_comm_wcmp
      use yowdatapool, only: rtype, istatus
      use yownodepool, only: np, npa
      USE w3odatmd, only : iaproc, naproc, ntproc
      USE w3gdatmd, ONLY: nseal
      USE mpi, only : mpi_sum
      IMPLICIT NONE
!/
!/ ------------------------------------------------------------------- /
!/ Parameter list
!/
!/ ------------------------------------------------------------------- /
!/ Local PARAMETERs
!/
#ifdef W3_S
      INTEGER, SAVE           :: IENT = 0
#endif
!/
!/ ------------------------------------------------------------------- /
!/
      real(rkind), intent(in) :: V1(npa), V2(npa)
      real(rkind), intent(inout) :: eScal
      integer IP
      real(rkind) :: lScal_loc(1), lScal_gl(1)
      integer ierr
#ifdef W3_S
      CALL strace (ient, 'VA_SETUP_IOBPD')
#endif
      lscal_loc = 0
      DO ip=1,np
        lscal_loc(1) = lscal_loc(1) + v1(ip)*v2(ip)
      END DO
      CALL mpi_allreduce(lscal_loc,lscal_gl,1,rtype,mpi_sum,mpi_comm_wcmp,ierr)
      escal = lscal_gl(1)

References w3odatmd::iaproc, yowdatapool::istatus, w3adatmd::mpi_comm_wcmp, w3odatmd::naproc, yownodepool::np, yownodepool::npa, w3gdatmd::nseal, w3odatmd::ntproc, w3gdatmd::nx, yowdatapool::rtype, and w3servmd::strace().

Referenced by trig_wave_setup_solve_poisson_neumann_dir().

trig_wave_setup_solve_poisson_neumann_dir()

subroutine w3wavset::trig_wave_setup_solve_poisson_neumann_dir	(	real(rkind), dimension(pdlib_nnz), intent(in)	ASPAR,
		real(rkind), dimension(npa), intent(in)	B,
		real(rkind), dimension(npa), intent(out)	TheOut,
		integer, dimension(npa), intent(in)	ACTIVE,
		integer, dimension(npa), intent(in)	ACTIVESEC
	)

Poisson equation solver.

Parameters

[in]	ASPAR
[in]	B
[out]	TheOut
[in]	ACTIVE
[in]	ACTIVESEC

Author

Mathieu Dutour-Sikiric

Aron Roland

Date

1-May-2018

Definition at line 1220 of file w3wavset.F90.

!/
!/                  +-----------------------------------+
!/                  | WAVEWATCH III           NOAA/NCEP |
!/                  |                                   |
!/                  | Mathieu Dutour-Sikiric (IRB)      |
!/                  | Aron Roland (BGS IT&E GmbH)       |
!/                  |                                   |
!/                  |                        FORTRAN 90 |
!/                  | Last update :         01-Mai-2018 |
!/                  +-----------------------------------+
!/
!/    01-Mai-2018 : Origination.                        ( version 6.04 )
!/
!  1. Purpose : poisson eq. solver
!  2. Method :
!  3. Parameters :
!
!     Parameter list
!     ----------------------------------------------------------------
!     ----------------------------------------------------------------
!
!  4. Subroutines used :
!
!      Name      Type  Module   Description
!     ----------------------------------------------------------------
!      STRACE    Subr. W3SERVMD Subroutine tracing.
!     ----------------------------------------------------------------
!
!  5. Called by :
!
!      Name      Type  Module   Description
!     ----------------------------------------------------------------
!     ----------------------------------------------------------------
!
!  6. Error messages :
!  7. Remarks
!  8. Structure :
!  9. Switches :
!
!     !/S  Enable subroutine tracing.
!
! 10. Source code :
!
!/ ------------------------------------------------------------------- /
#ifdef W3_S
      USE w3servmd, ONLY: strace
#endif
!
      USE yownodepool, only: pdlib_nnz
      USE w3gdatmd, ONLY: nseal, solverthr_stp
      USE w3odatmd, only : iaproc
      use yownodepool, only: np, npa
      IMPLICIT NONE
!/
!/ ------------------------------------------------------------------- /
!/ Parameter list
!/
!/ ------------------------------------------------------------------- /
!/ Local PARAMETERs
!/
#ifdef W3_S
      INTEGER, SAVE           :: IENT = 0
#endif
!/
!/ ------------------------------------------------------------------- /
!/
      real(rkind), intent(in) :: ASPAR(PDLIB_NNZ)
      real(rkind), intent(in) :: B(npa)
      real(rkind), intent(out) :: TheOut(npa)
      integer, intent(in) :: ACTIVE(npa), ACTIVESEC(npa)
      real(rkind) :: V_X(npa), V_R(npa), V_Z(npa), V_P(npa), V_Y(npa)
      real(rkind) :: uO, uN, alphaV, h1, h2
      real(rkind) :: eNorm, beta
      real(rkind) :: SOLVERTHR
      integer IP, nbIter
#ifdef W3_S
      CALL strace (ient, 'VA_SETUP_IOBPD')
#endif
      solverthr = solverthr_stp
 
#ifdef W3_DEBUGSTP
      WRITE(740+iaproc,*) 'Begin TRIG_WAVE_SETUP_SOLVE ....'
      FLUSH(740+iaproc)
#endif
      nbiter=0
      v_x=0
      v_r=b
      CALL trig_wave_setup_apply_precond(aspar, v_r, v_z, active, activesec)
      v_p=v_z
      CALL trig_wave_setup_scalar_prod(v_z, v_r, uo)
#ifdef W3_DEBUGSTP
      WRITE(740+iaproc,*) 'uO=', uo
      FLUSH(740+iaproc)
#endif
      CALL trig_wave_setup_scalar_prod(b, b, enorm)
#ifdef W3_DEBUGSTP
      WRITE(740+iaproc,*) 'eNorm(B)=', enorm
      WRITE(740+iaproc,*) 'SOLVERTHR=', solverthr
      WRITE(740+iaproc,*) 'SOLVERTHR=', solverthr, ' eNorm(B)=', enorm
      FLUSH(740+iaproc)
#endif
      IF (enorm .le. solverthr) THEN
#ifdef W3_DEBUGSTP
        WRITE(740+iaproc,*) 'Leaving here, zero solution'
        FLUSH(740+iaproc)
#endif
        theout=v_x
        RETURN
      END IF
      DO
        nbiter=nbiter + 1
        CALL trig_wave_setup_apply_fct(aspar, v_p, v_y, active, activesec)
        CALL trig_wave_setup_scalar_prod(v_p, v_y, h2)
        alphav=uo/h2
        !
        DO ip=1,npa
          v_x(ip) = v_x(ip) + alphav * v_p(ip)
          v_r(ip) = v_r(ip) - alphav * v_y(ip)
        END DO
        !
        CALL trig_wave_setup_scalar_prod(v_r, v_r, enorm)
#ifdef W3_DEBUGSTP
        WRITE(740+iaproc,*) 'nbIter=', nbiter, ' eNorm(res)=', enorm
        FLUSH(740+iaproc)
#endif
        IF (enorm .le. solverthr) THEN
          EXIT
        END IF
        !
        CALL trig_wave_setup_apply_precond(aspar, v_r, v_z, active, activesec)
        CALL trig_wave_setup_scalar_prod(v_z, v_r, un)
        !
        beta=un/uo
        uo=un
#ifdef W3_DEBUGSTP
        WRITE(740+iaproc,*) '  beta=', beta, ' uN=', un, ' alphaV=', alphav, ' h2=', h2
        FLUSH(740+iaproc)
#endif
        !
        DO ip=1,npa
          v_p(ip)=v_z(ip) + beta * v_p(ip)
        END DO
      END DO
      theout=v_x
#ifdef W3_DEBUGSTP
      WRITE(740+iaproc,*) 'TRIG_WAVE_SETUP_SOLVE_POISSON_NEUMANN_DIR, max/min=', maxval(theout), minval(theout)
      FLUSH(740+iaproc)
#endif

References w3odatmd::iaproc, yownodepool::np, yownodepool::npa, w3gdatmd::nseal, yownodepool::pdlib_nnz, w3gdatmd::solverthr_stp, w3servmd::strace(), trig_wave_setup_apply_fct(), trig_wave_setup_apply_precond(), and trig_wave_setup_scalar_prod().

Referenced by trig_wave_setup_computation().

wave_setup_computation()

subroutine w3wavset::wave_setup_computation

General driver.

Author

Aron Roland

Mathieu Dutour-Sikiric

Date

1-May-2018

Definition at line 3075 of file w3wavset.F90.

!/
!/                  +-----------------------------------+
!/                  | WAVEWATCH III           NOAA/NCEP |
!/                  |                                   |
!/                  | Aron Roland (BGS IT&E GmbH)       |
!/                  | Mathieu Dutour-Sikiric (IRB)      |
!/                  |                                   |
!/                  |                        FORTRAN 90 |
!/                  | Last update :         01-Mai-2018 |
!/                  +-----------------------------------+
!/
!/    01-Mai-2018 : Origination.                        ( version 6.04 )
!/
!  1. Purpose : general driver
!  2. Method :
!  3. Parameters :
!
!     Parameter list
!     ----------------------------------------------------------------
!     ----------------------------------------------------------------
!
!  4. Subroutines used :
!
!      Name      Type  Module   Description
!     ----------------------------------------------------------------
!      STRACE    Subr. W3SERVMD Subroutine tracing.
!     ----------------------------------------------------------------
!
!  5. Called by :
!
!      Name      Type  Module   Description
!     ----------------------------------------------------------------
!     ----------------------------------------------------------------
!
!  6. Error messages :
!  7. Remarks
!  8. Structure :
!  9. Switches :
!
!     !/S  Enable subroutine tracing.
!
! 10. Source code :
!
!/ ------------------------------------------------------------------- /
#ifdef W3_S
      USE w3servmd, ONLY: strace
#endif
!
      USE w3gdatmd, ONLY: nsea, nseal
      USE w3gdatmd, ONLY: gtype, ungtype
      USE w3odatmd, only : iaproc, naproc, ntproc
      IMPLICIT NONE
!/
!/ ------------------------------------------------------------------- /
!/ Parameter list
!/
!/ ------------------------------------------------------------------- /
!/ Local PARAMETERs
!/
#ifdef W3_S
      INTEGER, SAVE           :: IENT = 0
#endif
!/
!/ ------------------------------------------------------------------- /
!/
      INTEGER ISEA, JSEA
      REAL(rkind), allocatable :: ZETA_WORK(:)
#ifdef W3_S
      CALL strace (ient, 'VA_SETUP_IOBPD')
#endif
#ifdef W3_DEBUGSTP
      WRITE(740+iaproc,*) 'NAPROC=', naproc
      WRITE(740+iaproc,*) 'NTPROC=', ntproc
      FLUSH(740+iaproc)
#endif
      IF (iaproc .le. naproc) THEN
#ifdef W3_DEBUGSTP
      WRITE(740+iaproc,*) 'Begin WAVE_SETUP_COMPUTATION'
      FLUSH(740+iaproc)
#endif
        IF (do_wave_setup) THEN
          IF (gtype .EQ. ungtype) THEN
            CALL trig_wave_setup_computation
          ELSE
            CALL fd_wave_setup_computation
          END IF
        END IF
      END IF
#ifdef W3_DEBUGSTP
      WRITE(740+iaproc,*) 'End WAVE_SETUP_COMPUTATION'
      FLUSH(740+iaproc)
#endif

References do_wave_setup, fd_wave_setup_computation(), w3gdatmd::gtype, w3odatmd::iaproc, w3odatmd::naproc, w3gdatmd::nsea, w3gdatmd::nseal, w3odatmd::ntproc, w3servmd::strace(), trig_wave_setup_computation(), and w3gdatmd::ungtype.

Referenced by w3wavemd::w3wave().

Variable Documentation

do_wave_setup

logical w3wavset::do_wave_setup = .TRUE.

Definition at line 91 of file w3wavset.F90.

      LOGICAL :: DO_WAVE_SETUP = .true.

Referenced by wave_setup_computation().

ient

integer, save w3wavset::ient = 0

Definition at line 85 of file w3wavset.F90.

      INTEGER, SAVE           :: IENT = 0