WW3/w3wavset_8F90_source.html

!     ----------------------------------------------------------------

      MODULE w3wavset

!/                  +-----------------------------------+

!/                  | WAVEWATCH III           NOAA/NCEP |

!/                  |                                   |

!/                  | Aron Roland (BGS IT&E GmbH)       |

!/                  | Mathieu Dutour-Sikiric (IRB)      |

!/                  |                                   |

!/                  |                        FORTRAN 95 |

!/                  | Last update :         1-June-2018 |

!/                  +-----------------------------------+

!/

!/    01-June-2016 : Origination                        ( version 6.04 )

!/

!  1. Purpose : Implicit solution of wave setup problem following

!               Dingemans for structured and unstructured grids

!

!  2. Method :  To be described

!

!  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 yowdatapool, only: rkind

!/

!/ ------------------------------------------------------------------- /

!/ Parameter list

!/

!/ ------------------------------------------------------------------- /

!/ Local PARAMETERs

!/

      IMPLICIT NONE

!/

!/ ------------------------------------------------------------------- /

!/ Parameter list

!/

!/ ------------------------------------------------------------------- /

!/ Local PARAMETERs

!/

#ifdef W3_S

      INTEGER, SAVE           :: ient = 0

#endif

!/

!/ ------------------------------------------------------------------- /

!/


      LOGICAL :: do_wave_setup = .true.

      CONTAINS

!/ ------------------------------------------------------------------- /

      SUBROUTINE differentiate_xydir_native(VAR, DVDX, DVDY)

!/

!/                  +-----------------------------------+

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

      END SUBROUTINE

!/ ------------------------------------------------------------------- /

      SUBROUTINE differentiate_xydir_mapsta(VAR, DVDX, DVDY)

!/

!/                  +-----------------------------------+

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

      END SUBROUTINE

!/ ------------------------------------------------------------------- /

      SUBROUTINE differentiate_xydir(VAR, DVDX, DVDY)

!/

!/                  +-----------------------------------+

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

      END SUBROUTINE

!/ ------------------------------------------------------------------- /

      SUBROUTINE trig_compute_lh_stress(F_X, F_Y, DWNX)

!/

!/                  +-----------------------------------+

!/                  | 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

      END SUBROUTINE

!/ ------------------------------------------------------------------- /

      SUBROUTINE trig_compute_diff(IE, I1, UGRAD, VGRAD)

!/

!/                  +-----------------------------------+

!/                  | 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

      END SUBROUTINE

!/ ------------------------------------------------------------------- /

      SUBROUTINE trig_wave_setup_compute_system(ASPAR, B, FX, FY, DWNX, ACTIVE, ACTIVESEC)

!/

!/                  +-----------------------------------+

!/                  | 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

      END SUBROUTINE

!/ ------------------------------------------------------------------- /

      SUBROUTINE trig_wave_setup_apply_precond(ASPAR, TheIn, TheOut, ACTIVE, ACTIVESEC)

!/

!/                  +-----------------------------------+

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

      END SUBROUTINE

!/ ------------------------------------------------------------------- /

      SUBROUTINE trig_wave_setup_apply_fct(ASPAR, TheIn, TheOut, ACTIVE, ACTIVESEC)

!/

!/                  +-----------------------------------+

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

      END SUBROUTINE

!/ ------------------------------------------------------------------- /

      SUBROUTINE trig_wave_setup_scalar_prod(V1, V2, eScal)

!/

!/                  +-----------------------------------+

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

      END SUBROUTINE

!/ ------------------------------------------------------------------- /

      SUBROUTINE trig_wave_setup_solve_poisson_neumann_dir(ASPAR, B, TheOut, ACTIVE, ACTIVESEC)

!/

!/                  +-----------------------------------+

!/                  | 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

      END SUBROUTINE

!/ ------------------------------------------------------------------- /

      SUBROUTINE trig_set_meanvalue_to_zero(TheVar)

!/

!/                  +-----------------------------------+

!/                  | 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

      END SUBROUTINE

!/ ------------------------------------------------------------------- /

      SUBROUTINE compute_active_node(DWNX, ACTIVE)

!/

!/                  +-----------------------------------+

!/                  | 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

      END SUBROUTINE

!/ ------------------------------------------------------------------- /

      SUBROUTINE trig_wave_setup_computation

!/

!/                  +-----------------------------------+

!/                  | 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

      END SUBROUTINE

!/ ------------------------------------------------------------------- /

      SUBROUTINE preparation_fd_scheme(IMOD)

!/

!/                  +-----------------------------------+

!/                  | 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

      END SUBROUTINE

!/ ------------------------------------------------------------------- /

      SUBROUTINE fd_wave_setup_apply_fct(ASPAR, TheIn, TheOut)

!/

!/                  +-----------------------------------+

!/                  | 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

      END SUBROUTINE

!/ ------------------------------------------------------------------- /

      SUBROUTINE fd_wave_setup_apply_precond(ASPAR, TheIn, TheOut)

!/

!/                  +-----------------------------------+

!/                  | 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

      END SUBROUTINE

!/ ------------------------------------------------------------------- /

      SUBROUTINE fd_collect_sxx_xy_yy(SXX_t, SXY_t, SYY_t)

!/

!/                  +-----------------------------------+

!/                  | 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

      END SUBROUTINE

!/ ------------------------------------------------------------------- /

      SUBROUTINE fd_compute_lh_stress(SXX_t, SXY_t, SYY_t, FX, FY)

!/

!/                  +-----------------------------------+

!/                  | 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

      END SUBROUTINE

!/ ------------------------------------------------------------------- /

      SUBROUTINE fd_compute_diff(IEDGE, ISEA, UGRAD, VGRAD, dist)

!/

!/                  +-----------------------------------+

!/                  | 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

      END SUBROUTINE

!/ ------------------------------------------------------------------- /

      SUBROUTINE fd_wave_setup_compute_system(ASPAR, B, FX, FY)

!/

!/                  +-----------------------------------+

!/                  | 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

      END SUBROUTINE

!/ ------------------------------------------------------------------- /

      SUBROUTINE fd_wave_setup_scalar_prod(V1, V2, eScal)

!/

!/                  +-----------------------------------+

!/                  | 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

      END SUBROUTINE

!/ ------------------------------------------------------------------- /

      SUBROUTINE fd_wave_setup_solve_poisson_neumann_dir(ASPAR, B, TheOut)

!/

!/                  +-----------------------------------+

!/                  | 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

      END SUBROUTINE

!/ ------------------------------------------------------------------- /

      SUBROUTINE fd_set_meanvalue_to_zero(TheVar)

!/

!/                  +-----------------------------------+

!/                  | 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

      END SUBROUTINE

!/ ------------------------------------------------------------------- /

      SUBROUTINE fd_wave_setup_computation

!/

!/                  +-----------------------------------+

!/                  | 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

      END SUBROUTINE

!/ ------------------------------------------------------------------- /

      SUBROUTINE wave_setup_computation

!/

!/                  +-----------------------------------+

!/                  | 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

      END SUBROUTINE

!/ ------------------------------------------------------------------- /

      END MODULE

!/ ------------------------------------------------------------------- /