w3parall Module Reference

Parallel routines for implicit solver. More...

Functions/Subroutines
subroutine	wav_my_wtime (eTime)
	NA. More...
subroutine	print_my_time (string)
	Print timings. More...
subroutine	prop_refraction_pr1 (ISEA, DTG, CAD)
	Compute refraction part in matrix. More...
subroutine	prop_refraction_pr3 (IP, ISEA, DTG, CAD, DoLimiter)
	Compute refraction part in matrix alternative approach. More...
subroutine	prop_freq_shift (IP, ISEA, CAS, DMM, DTG)
	Compute frequency shift in matrix. More...
subroutine	prop_freq_shift_m2 (IP, ISEA, CWNB_M2, DWNI_M2, DTG)
	Compute frequency shift alternative approach. More...
subroutine	synchronize_ipgl_etc_array (IMOD, IsMulti)
	Sync global local arrays. More...
subroutine	set_up_nseal_nsealm (NSEALout, NSEALMout)
	Setup NSEAL, NSEALM in context of PDLIB. More...
subroutine	init_get_jsea_isproc (ISEA, JSEA, ISPROC)
	Set JSEA for all schemes. More...
subroutine	get_jsea_ibelong (ISEA, JSEA, IBELONG)
	Set belongings of JSEA in context of PDLIB. More...
subroutine	init_get_isea (ISEA, JSEA)
	Set ISEA for all schemes. More...
subroutine	synchronize_global_array (TheVar)
	Sync global array in context of PDLIB. More...

Variables
integer, save	ient = 0
integer	pdlib_nseal
integer	pdlib_nsealm
integer, dimension(:), allocatable	jx_to_jsea
integer, dimension(:), allocatable	isea_to_jsea
integer, dimension(:), allocatable	listispnextdir
integer, dimension(:), allocatable	listispprevdir
integer, dimension(:), allocatable	listispnextfreq
integer, dimension(:), allocatable	listispprevfreq
logical, parameter	lsloc = .true.
integer, parameter	imem = 1
real, parameter	onesixth = 1.0d0/6.0d0
real, parameter	onethird = 1.0d0/3.0d0
real, parameter	zero = 0.0d0
real *8, parameter	thr8 = TINY(1.d0)
real, parameter	thr = TINY(1.0)

Detailed Description

Parallel routines for implicit solver.

Author

Aron Roland

Mathieu Dutour-Sikiric

Date

01-Jun-2018

Copyright

Copyright 2009-2022 National Weather Service (NWS), National Oceanic and Atmospheric Administration. All rights reserved. WAVEWATCH III is a trademark of the NWS. No unauthorized use without permission.

Function/Subroutine Documentation

get_jsea_ibelong()

subroutine w3parall::get_jsea_ibelong	(	integer, intent(in)	ISEA,
		integer, intent(out)	JSEA,
		integer, intent(out)	IBELONG
	)

Set belongings of JSEA in context of PDLIB.

Parameters

[in]	ISEA
[out]	JSEA
[out]	IBELONG

Author

Aron Roland

Mathieu Dutour-Sikiric

Date

01-Jun-2018

Definition at line 1271 of file w3parall.F90.

    !/ ------------------------------------------------------------------- /
    !/
    !/                  +-----------------------------------+
    !/                  | WAVEWATCH III           NOAA/NCEP |
    !/                  |                                   |
    !/                  | Aron Roland (BGS IT&E GmbH)       |
    !/                  | Mathieu Dutour-Sikiric (IRB)      |
    !/                  |                                   |
    !/                  |                        FORTRAN 90 |
    !/                  | Last update :        01-June-2018 |
    !/                  +-----------------------------------+
    !/
    !/   01-June-2018 : Origination.                        ( version 6.04 )
    !/
    !  1. Purpose : Set belongings of jsea in context of pdlib
    !  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 w3odatmd, ONLY: outpts, iaproc, naproc
    USE w3gdatmd, ONLY: gtype, ungtype, mapsf
    USE constants, ONLY : lpdlib
#ifdef W3_PDLIB
    USE yowrankmodule, only : ipgl_to_proc, ipgl_tot, ipgl_npa
    use yownodepool, only: ipgl, iplg
#endif
    IMPLICIT NONE
    !/ ------------------------------------------------------------------- /
    !/ Parameter list
    !/
    !/ ------------------------------------------------------------------- /
    !/ Local parameters
    !/
#ifdef W3_S
    INTEGER, SAVE           :: IENT = 0
#endif
    !/
    !/ ------------------------------------------------------------------- /
    !/
    INTEGER, intent(in) :: ISEA
    INTEGER, intent(out) :: JSEA, IBELONG
    INTEGER ISPROC, IX, JX
#ifdef W3_S
    CALL strace (ient, 'GET_JSEA_IBELONG')
#endif
    IF (.NOT. lpdlib) THEN
      jsea   = 1 + (isea-1)/naproc
      isproc = isea - (jsea-1)*naproc
      IF (isproc .eq. iaproc) THEN
        ibelong=1
      ELSE
        ibelong=0
      END IF
    ELSE
#ifdef W3_PDLIB
      IF (gtype .ne. ungtype) THEN
        jsea   = 1 + (isea-1)/naproc
        isproc = isea - (jsea-1)*naproc
        IF (isproc .eq. iaproc) THEN
          ibelong=1
        ELSE
          ibelong=0
        END IF
      ELSE
        IF (iaproc .le. naproc) THEN
          ix     = mapsf(isea,1)
          jx     = ipgl_npa(ix)
          IF (jx .eq. 0) THEN
            ibelong=0
            jsea=-1
          ELSE
            ibelong=1
            jsea = jx_to_jsea(jx)
          END IF
        ELSE
          ibelong=0
          jsea=-1
        END IF
      ENDIF
#endif
    ENDIF
    !/
    !/ End of INIT_GET_ISEA ---------------------------------------------- /
    !/

References w3gdatmd::gtype, w3odatmd::iaproc, yownodepool::ipgl, yowrankmodule::ipgl_npa, yowrankmodule::ipgl_to_proc, yowrankmodule::ipgl_tot, yownodepool::iplg, jx_to_jsea, constants::lpdlib, w3gdatmd::mapsf, w3odatmd::naproc, w3odatmd::outpts, w3servmd::strace(), and w3gdatmd::ungtype.

Referenced by pdlib_field_vec::unst_pdlib_read_from_file(), pdlib_field_vec::unst_pdlib_write_to_file(), w3updtmd::w3uini(), and w3updtmd::w3ulev().

init_get_isea()

subroutine w3parall::init_get_isea	(	integer, intent(out)	ISEA,
		integer, intent(in)	JSEA
	)

Set ISEA for all schemes.

Parameters

[out]	ISEA
[in]	JSEA

Author

Aron Roland

Mathieu Dutour-Sikiric

Date

01-Jun-2018

Definition at line 1398 of file w3parall.F90.

    !/ ------------------------------------------------------------------- /
    !/
    !/                  +-----------------------------------+
    !/                  | WAVEWATCH III           NOAA/NCEP |
    !/                  |                                   |
    !/                  | Aron Roland (BGS IT&E GmbH)       |
    !/                  | Mathieu Dutour-Sikiric (IRB)      |
    !/                  |                                   |
    !/                  |                        FORTRAN 90 |
    !/                  | Last update :        01-June-2018 |
    !/                  +-----------------------------------+
    !/
    !/   01-June-2018 : Origination.                        ( version 6.04 )
    !/
    !  1. Purpose : Set Isea for all schemes
    !  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 w3odatmd, ONLY: outpts, iaproc, naproc
    USE w3gdatmd, ONLY: gtype, ungtype
    USE constants, ONLY : lpdlib
#ifdef W3_PDLIB
    USE yownodepool, ONLY: iplg
#endif
    !/ ------------------------------------------------------------------- /
    !/ Parameter list
    !/
    !/ ------------------------------------------------------------------- /
    !/ Local parameters
    !/
    !/ ------------------------------------------------------------------- /
    !/
    !/
    !/ ------------------------------------------------------------------- /
    !/
    !/ ------------------------------------------------------------------- /
    !
    USE w3odatmd, ONLY: outpts, iaproc, naproc
    USE w3gdatmd, ONLY: gtype, ungtype
    USE constants, ONLY : lpdlib
#ifdef W3_PDLIB
    USE yownodepool, ONLY: iplg
#endif
    IMPLICIT NONE
#ifdef W3_S
    INTEGER, SAVE           :: IENT = 0
#endif
    INTEGER, intent(in) :: JSEA
    INTEGER, intent(out) :: ISEA
#ifdef W3_S
    CALL strace (ient, 'INIT_GET_ISEA')
#endif
#ifdef W3_SHRD
    isea         = jsea
#endif
#ifdef W3_DIST
    IF (.NOT. lpdlib) THEN
      isea         = iaproc + (jsea-1)*naproc
    ELSE
#endif
#ifdef W3_PDLIB
      IF (gtype .eq. ungtype) THEN
        isea         = iplg(jsea)
      ELSE
        isea         = iaproc + (jsea-1)*naproc
      ENDIF
#endif
#ifdef W3_DIST
    ENDIF
#endif
    !/
    !/ End of INIT_GET_ISEA ------------------------------------------------ /
    !/

References w3gdatmd::gtype, w3odatmd::iaproc, yownodepool::iplg, constants::lpdlib, w3odatmd::naproc, w3odatmd::outpts, w3servmd::strace(), and w3gdatmd::ungtype.

Referenced by pdlib_w3profsmd::block_solver_init(), w3iogomd::calc_u3stokes(), w3iogomd::calc_wbt(), pdlib_w3profsmd::check_array_integral_nx_r8_maxfunct(), w3oacpmd::cpl_oasis_define(), w3wavset::differentiate_xydir_mapsta(), pdlib_field_vec::do_output_exchanges(), pdlib_w3profsmd::scal_integral_print_general(), pdlib_w3profsmd::set_iobdp_pdlib(), pdlib_w3profsmd::set_iobpa_pdlib(), w3iogomd::skewness(), w3wavset::trig_compute_lh_stress(), w3wavset::trig_wave_setup_computation(), pdlib_field_vec::unst_pdlib_write_to_file(), w3iosfmd::w3cprt(), w3wavemd::w3gath(), w3initmd::w3init(), w3iorsmd::w3iors(), w3iogomd::w3outg(), w3wavemd::w3scat(), w3snl5md::w3snl5(), w3updtmd::w3uice(), w3updtmd::w3uini(), w3updtmd::w3ulev(), w3wavemd::w3wave(), wminiomd::wmiohg(), wminiomd::wmiohs(), and pdlib_w3profsmd::write_var_to_text_file().

init_get_jsea_isproc()

subroutine w3parall::init_get_jsea_isproc	(	integer, intent(in)	ISEA,
		integer, intent(out)	JSEA,
		integer, intent(out)	ISPROC
	)

Set JSEA for all schemes.

Parameters

[in]	ISEA
[out]	JSEA
[out]	ISPROC

Author

Aron Roland

Mathieu Dutour-Sikiric

Date

01-Jun-2018

Definition at line 1163 of file w3parall.F90.

    !/ ------------------------------------------------------------------- /
    !/
    !/                  +-----------------------------------+
    !/                  | WAVEWATCH III           NOAA/NCEP |
    !/                  |                                   |
    !/                  | Aron Roland (BGS IT&E GmbH)       |
    !/                  | Mathieu Dutour-Sikiric (IRB)      |
    !/                  |                                   |
    !/                  |                        FORTRAN 90 |
    !/                  | Last update :        01-June-2018 |
    !/                  +-----------------------------------+
    !/
    !/   01-June-2018 : Origination.                        ( version 6.04 )
    !/
    !  1. Purpose : Set Jsea for all schemes
    !  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 w3odatmd, ONLY: outpts, iaproc, naproc
    USE w3gdatmd, ONLY: gtype, ungtype, mapsf
    USE constants, ONLY : lpdlib
#ifdef W3_PDLIB
    USE yowrankmodule, only : ipgl_to_proc, ipgl_tot
    use yownodepool, only: ipgl, iplg
#endif
    IMPLICIT NONE
    !/ ------------------------------------------------------------------- /
    !/ Parameter list
    !/
    !/ ------------------------------------------------------------------- /
    !/ Local parameters
    !/
#ifdef W3_S
    INTEGER, SAVE           :: IENT = 0
#endif
    !/
    !/ ------------------------------------------------------------------- /
    INTEGER, intent(in) :: ISEA
    INTEGER, intent(out) :: JSEA, ISPROC
    INTEGER IP_glob
#ifdef W3_S
    CALL strace (ient, 'INIT_GET_JSEA_ISPROC')
#endif
 
#ifdef W3_PDLIB
    IF (.NOT. lpdlib) THEN
#endif
      jsea   = 1 + (isea-1)/naproc
      isproc = isea - (jsea-1)*naproc
#ifdef W3_PDLIB
    ELSE
      ip_glob = mapsf(isea,1)
      IF (iaproc .le. naproc) THEN
        jsea   = isea_to_jsea(isea)
      ELSE
        jsea   = -1
      END IF
      isproc = ipgl_to_proc(ip_glob)
    ENDIF
#endif
    !/
    !/ End of JACOBI_INIT ------------------------------------------------ /
    !/

References w3gdatmd::gtype, w3odatmd::iaproc, yownodepool::ipgl, yowrankmodule::ipgl_to_proc, yowrankmodule::ipgl_tot, yownodepool::iplg, isea_to_jsea, constants::lpdlib, w3gdatmd::mapsf, w3odatmd::naproc, w3odatmd::outpts, w3servmd::strace(), and w3gdatmd::ungtype.

Referenced by pdlib_field_vec::do_output_exchanges(), pdlib_w3profsmd::pdlib_jacobi_gauss_seidel_block(), pdlib_w3profsmd::pdlib_w3xypfsfct2(), pdlib_w3profsmd::pdlib_w3xypfsn2(), pdlib_w3profsmd::pdlib_w3xypfspsi2(), w3iosfmd::w3cprt(), w3initmd::w3init(), w3iorsmd::w3iors(), w3iosfmd::w3iosf(), w3iotrmd::w3iotr(), w3initmd::w3mpio(), w3initmd::w3mpip(), w3wavemd::w3nmin(), w3updtmd::w3uice(), w3updtmd::w3uini(), w3updtmd::w3ulev(), wmgridmd::wmghgh(), wmgridmd::wmglow(), and wminiomd::wmiobs().

print_my_time()

subroutine w3parall::print_my_time

(

character(*), intent(in)

string

)

Print timings.

Parameters

[in]

string

Author

Aron Roland

Mathieu Dutour-Sikiric

Date

01-Jun-2018

Definition at line 200 of file w3parall.F90.

    !/
    !/                  +-----------------------------------+
    !/                  | WAVEWATCH III           NOAA/NCEP |
    !/                  |                                   |
    !/                  | Aron Roland (BGS IT&E GmbH)       |
    !/                  | Mathieu Dutour-Sikiric (IRB)      |
    !/                  |                                   |
    !/                  |                        FORTRAN 90 |
    !/                  | Last update :        01-June-2018 |
    !/                  +-----------------------------------+
    !/
    !/   01-June-2018 : Origination.                        ( version 6.04 )
    !/
    !  1. Purpose : Print timings
    !  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 w3odatmd, ONLY : iaproc
    IMPLICIT NONE
    !/
    !/ ------------------------------------------------------------------- /
    !/ Parameter list
    !/
    !/ ------------------------------------------------------------------- /
    !/ Local parameters
    !/
#ifdef W3_S
    INTEGER, SAVE           :: IENT = 0
#endif
    !/
    !/ ------------------------------------------------------------------- /
    !
    character(*), intent(in) :: string
    REAL(8) :: eTime
#ifdef W3_S
    CALL strace (ient, 'PRINT_MY_TIME')
#endif
    CALL wav_my_wtime(etime)
    WRITE(740+iaproc,*) 'TIMING time=', etime, ' at step ', string
    !/
    !/ End of JACOBI_INIT ------------------------------------------------ /
    !/

References w3odatmd::iaproc, w3servmd::strace(), and wav_my_wtime().

Referenced by pdlib_field_vec::unst_pdlib_read_from_file(), w3initmd::w3init(), w3iorsmd::w3iors(), and w3wavemd::w3wave().

prop_freq_shift()

subroutine w3parall::prop_freq_shift	(	integer, intent(in)	IP,
		integer, intent(in)	ISEA,
		real, dimension(nspec), intent(out)	CAS,
		real, dimension(0:nk2), intent(out)	DMM,
		real, intent(in)	DTG
	)

Compute frequency shift in matrix.

Parameters

[in]	IP
[in]	ISEA
[out]	CAS
[out]	DMM
[in]	DTG

Author

Aron Roland

Mathieu Dutour-Sikiric

Date

01-Jun-2018

Definition at line 609 of file w3parall.F90.

    !/
    !/                  +-----------------------------------+
    !/                  | WAVEWATCH III           NOAA/NCEP |
    !/                  |                                   |
    !/                  | Aron Roland (BGS IT&E GmbH)       |
    !/                  | Mathieu Dutour-Sikiric (IRB)      |
    !/                  |                                   |
    !/                  |                        FORTRAN 90 |
    !/                  | Last update :        01-June-2018 |
    !/                  +-----------------------------------+
    !/
    !/   01-June-2018 : Origination.                        ( version 6.04 )
    !/
    !  1. Purpose : Compute freq. shift in matrix
    !  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 : lpdlib
    USE w3gdatmd, ONLY: nk, nk2, nth, nspec, sig, dsip, ecos, esin, &
         ec2, esc, es2, fachfa, mapwn, flcth, flck,  &
         ctmax, dmin, dth, mapsf
    USE w3adatmd, ONLY: cg, wn, dcxdx, dcxdy, dcydx, dcydy, cx, cy, dddx, dddy, dw
    USE w3odatmd, only : iaproc
    IMPLICIT NONE
    !/ Parameter list
    !/
    !/ ------------------------------------------------------------------- /
    !/ Local parameters
    !/
#ifdef W3_S
    INTEGER, SAVE           :: IENT = 0
#endif
    INTEGER, intent(in) :: ISEA, IP
    REAL, intent(out) :: DMM(0:NK2)
    REAL, intent(in) :: DTG
    REAL, intent(out) :: CAS(NSPEC)
    REAL :: DB(NK2), DSDD(0:NK+1)
    REAL :: eDCXDX, eDCXDY, eDCYDX, eDCYDY, eCX, eCY, eDDDX, EDDDY
    REAL :: DCXX, DCXYYX, DCYY, FKD, FACK
    REAL :: VELNOFILT, VELFAC, DEPTH
    REAL :: CFLK(NK2,NTH), FKC(NTH), FKD0
    INTEGER :: IK, ITH, ISP, IY, IX
#ifdef W3_S
    CALL strace (ient, 'PROP_FREQ_SHIFT')
#endif
    !
    IF (lpdlib) THEN
      edcxdx = dcxdx(1,ip)
      edcxdy = dcxdy(1,ip)
      edcydx = dcydx(1,ip)
      edcydy = dcydy(1,ip)
      edddx  = dddx(1,ip)
      edddy  = dddy(1,ip)
    ELSE
      ix=mapsf(isea,1)
      iy=mapsf(isea,2)
      edcxdx=dcxdx(iy,ix)
      edcxdy=dcxdy(iy,ix)
      edcydx=dcydx(iy,ix)
      edcydy=dcydy(iy,ix)
      edddx=dddx(iy,ix)
      edddy=dddy(iy,ix)
    ENDIF
    ecx=cx(isea)
    ecy=cy(isea)
    dcxx   =  -   edcxdx
    dcxyyx =  - ( edcxdy + edcydx )
    dcyy   =  -   edcydy
    fkd    =    ( ecx*edddx + ecy*edddy )
    fack = dtg
    DO ith=1, nth
      fkc(ith) = ec2(ith)*dcxx + esc(ith)*dcxyyx + es2(ith)*dcyy
    END DO
    DO ik=0, nk
      db(ik+1) = dsip(ik) / cg(ik,isea)
      dmm(ik+1) = dble(wn(ik+1,isea) - wn(ik,isea))
    END DO
    db(nk+2) = dsip(nk+1) / cg(nk+1,isea)
    dmm(nk+2) = zero
    dmm(0)=dmm(1)
    !
    depth  = max( dmin , dw(isea) )
    DO ik=0, nk+1
      IF ( depth*wn(ik,isea) .LT. 5. ) THEN
        dsdd(ik) = max( 0. , cg(ik,isea)*wn(ik,isea)-0.5*sig(ik) ) / depth
      ELSE
        dsdd(ik) = 0.
      END IF
    END DO
    DO ik=0, nk+1
      fkd0   = fkd / cg(ik,isea) * dsdd(ik)
      velfac =  fack/db(ik+1)
      DO ith=1, nth
        velnofilt = ( fkd0 + wn(ik,isea)*fkc(ith) ) * velfac
        cflk(ik+1,ith) = velnofilt/velfac
      END DO
    END DO
    DO ik=1,nk
      DO ith=1,nth
        isp=ith + (ik-1)*nth
        cas(isp)=dble(cflk(ik,ith))
      END DO
    END DO
    !/
    !/ End of JACOBI_INIT ------------------------------------------------ /
    !/

References w3adatmd::cg, w3gdatmd::ctmax, w3adatmd::cx, w3adatmd::cy, w3adatmd::dcxdx, w3adatmd::dcxdy, w3adatmd::dcydx, w3adatmd::dcydy, w3adatmd::dddx, w3adatmd::dddy, w3gdatmd::dmin, w3gdatmd::dsip, w3gdatmd::dth, w3adatmd::dw, w3gdatmd::ec2, w3gdatmd::ecos, w3gdatmd::es2, w3gdatmd::esc, w3gdatmd::esin, w3gdatmd::fachfa, w3gdatmd::flck, w3gdatmd::flcth, w3odatmd::iaproc, constants::lpdlib, w3gdatmd::mapsf, w3gdatmd::mapwn, w3gdatmd::nk, w3gdatmd::nk2, w3gdatmd::nspec, w3gdatmd::nth, w3gdatmd::sig, w3servmd::strace(), w3adatmd::wn, and zero.

Referenced by pdlib_w3profsmd::calcarray_jacobi_spectral_1(), and pdlib_w3profsmd::calcarray_jacobi_spectral_2().

prop_freq_shift_m2()

subroutine w3parall::prop_freq_shift_m2	(	integer, intent(in)	IP,
		integer, intent(in)	ISEA,
		real, dimension(1-nth:nspec), intent(out)	CWNB_M2,
		real, dimension(nk), intent(out)	DWNI_M2,
		real, intent(in)	DTG
	)

Compute frequency shift alternative approach.

Parameters

[in]	IP
[in]	ISEA
[out]	CWNB_M2
[out]	DWNI_M2
[in]	DTG

Author

Aron Roland

Mathieu Dutour-Sikiric

Date

01-Jun-2018

Definition at line 761 of file w3parall.F90.

    !/
    !/                  +-----------------------------------+
    !/                  | WAVEWATCH III           NOAA/NCEP |
    !/                  |                                   |
    !/                  | Aron Roland (BGS IT&E GmbH)       |
    !/                  | Mathieu Dutour-Sikiric (IRB)      |
    !/                  |                                   |
    !/                  |                        FORTRAN 90 |
    !/                  | Last update :        01-June-2018 |
    !/                  +-----------------------------------+
    !/
    !/   01-June-2018 : Origination.                        ( version 6.04 )
    !/
    !  1. Purpose : Compute freq. shift alternative approach
    !  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 : lpdlib
    USE w3gdatmd, ONLY: nk, nk2, nth, nspec, sig, dsip, ecos, esin, &
         ec2, esc, es2, fachfa, mapwn, flcth, flck,  &
         ctmax, dmin, dth, mapsf
    USE w3adatmd, ONLY: cg, wn, dcxdx, dcxdy, dcydx, dcydy, cx, cy, dddx, dddy, dw
    USE w3odatmd, only : iaproc
 
    IMPLICIT NONE
 
    !/ ------------------------------------------------------------------- /
    !/ Local parameters
    !/
#ifdef W3_S
    INTEGER, SAVE           :: IENT = 0
#endif
 
    INTEGER, intent(in) :: ISEA, IP
    REAL, intent(out) :: CWNB_M2(1-NTH:NSPEC)
    REAL, intent(out) :: DWNI_M2(NK)
    REAL, intent(in) :: DTG
    !
    REAL :: eDCXDX, eDCXDY, eDCYDX, eDCYDY, eCX, eCY, eDDDX, EDDDY
    REAL :: DCXX, DCXYYX, DCYY, FKD, FACK
    REAL :: DEPTH
    REAL :: FKC(NTH), FKD0
    REAL :: VCWN(1-NTH:NSPEC+NTH)
    REAL :: DSDD(0:NK+1)
    REAL :: sumDiff, sumDiff1, sumDiff2, sumDiff3
    REAL :: sumDiff0, sumDiff4, sumDiff5
    INTEGER :: IK, ITH, ISP, IY, IX
 
    !/ ------------------------------------------------------------------- /
#ifdef W3_S
    CALL strace (ient, 'PROP_FREQ_SHIFT_M2')
#endif
 
    IF (lpdlib) THEN
      edcxdx = dcxdx(1,ip)
      edcxdy = dcxdy(1,ip)
      edcydx = dcydx(1,ip)
      edcydy = dcydy(1,ip)
      edddx  = dddx(1,ip)
      edddy  = dddy(1,ip)
    ELSE
      ix=mapsf(isea,1)
      iy=mapsf(isea,2)
      edcxdx=dcxdx(iy,ix)
      edcxdy=dcxdy(iy,ix)
      edcydx=dcydx(iy,ix)
      edcydy=dcydy(iy,ix)
      edddx=dddx(iy,ix)
      edddy=dddy(iy,ix)
    ENDIF
 
    ecx = cx(isea)
    ecy = cy(isea)
    fack = dtg
    dcxx   =  - fack *   edcxdx
    dcxyyx =  - fack * ( edcxdy + edcydx )
    dcyy   =  - fack *   edcydy
    fkd    =    fack * ( ecx*edddx + ecy*edddy )
 
    DO ith=1, nth
      fkc(ith) = ec2(ith)*dcxx + esc(ith)*dcxyyx + es2(ith)*dcyy
    END DO
    !
    depth  = max( dmin , dw(isea) )
    DO ik=0, nk+1
      IF ( depth*wn(ik,isea) .LT. 5. ) THEN
        dsdd(ik) = max( 0. , cg(ik,isea)*wn(ik,isea)-0.5*sig(ik) ) / depth
      ELSE
        dsdd(ik) = 0.
      END IF
    END DO
    isp = -nth
    DO ik=0, nk+1
      fkd0   = fkd / cg(ik,isea) * dsdd(ik)
      DO ith=1, nth
        isp = isp + 1
        vcwn(isp) = fkd0 + wn(ik,isea)*fkc(ith)
      END DO
    END DO
 
    sumdiff=0
    DO isp=1-nth,nspec
      cwnb_m2(isp) = dble(0.5 * ( vcwn(isp) + vcwn(isp+nth) ))
      sumdiff = sumdiff + max(cwnb_m2(isp), zero)
    END DO
    DO ik=1,nk
      dwni_m2(ik) = dble( cg(ik,isea) / dsip(ik) )
    END DO
    !/
    !/ End of JACOBI_INIT ------------------------------------------------ /
    !/

References w3adatmd::cg, w3gdatmd::ctmax, w3adatmd::cx, w3adatmd::cy, w3adatmd::dcxdx, w3adatmd::dcxdy, w3adatmd::dcydx, w3adatmd::dcydy, w3adatmd::dddx, w3adatmd::dddy, w3gdatmd::dmin, w3gdatmd::dsip, w3gdatmd::dth, w3adatmd::dw, w3gdatmd::ec2, w3gdatmd::ecos, w3gdatmd::es2, w3gdatmd::esc, w3gdatmd::esin, w3gdatmd::fachfa, w3gdatmd::flck, w3gdatmd::flcth, w3odatmd::iaproc, constants::lpdlib, w3gdatmd::mapsf, w3gdatmd::mapwn, w3gdatmd::nk, w3gdatmd::nk2, w3gdatmd::nspec, w3gdatmd::nth, w3gdatmd::sig, w3servmd::strace(), w3adatmd::wn, and zero.

Referenced by pdlib_w3profsmd::calcarray_jacobi_spectral_1(), and pdlib_w3profsmd::calcarray_jacobi_spectral_2().

prop_refraction_pr1()

subroutine w3parall::prop_refraction_pr1	(	integer, intent(in)	ISEA,
		real, intent(in)	DTG,
		real, dimension(nspec), intent(out)	CAD
	)

Compute refraction part in matrix.

Parameters

[in]	ISEA
[in]	DTG
[out]	CAD

Author

Aron Roland

Mathieu Dutour-Sikiric

Date

01-Jun-2018

Definition at line 286 of file w3parall.F90.

    !/
    !/                  +-----------------------------------+
    !/                  | WAVEWATCH III           NOAA/NCEP |
    !/                  |                                   |
    !/                  | Aron Roland (BGS IT&E GmbH)       |
    !/                  | Mathieu Dutour-Sikiric (IRB)      |
    !/                  |                                   |
    !/                  |                        FORTRAN 90 |
    !/                  | Last update :        01-June-2018 |
    !/                  +-----------------------------------+
    !/
    !/   01-June-2018 : Origination.                        ( version 6.04 )
    !/
    !  1. Purpose : Compute refraction part in matrix
    !  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: nk, nk2, nth, nspec, sig, dsip, ecos, esin, &
         ec2, esc, es2, fachfa, mapwn, flcth, flck,  &
         ctmax, dmin, dth, cthg0s, mapsf
    USE w3adatmd, ONLY: cg, wn, dcxdx, dcxdy, dcydx, dcydy, dddx,   &
         dddy, dw
#ifdef W3_REFRX
    USE w3adatmd, ONLY: dcdx, dcdy
#endif
    USE w3idatmd, ONLY: flcur
    USE w3odatmd, only : iaproc
    IMPLICIT NONE
    !/
    !/ ------------------------------------------------------------------- /
    !/ Parameter list
    !/
    !/ ------------------------------------------------------------------- /
    !/ Local parameters
    !/
#ifdef W3_S
    INTEGER, SAVE           :: IENT = 0
#endif
    !/
    !/ ------------------------------------------------------------------- /
    !/
    !/
    REAL, intent(out) :: CAD(NSPEC)
    INTEGER, intent(in) :: ISEA
    REAL, intent(in) :: DTG
    INTEGER :: ISP, IK, ITH, IX, IY
    REAL :: FRK(NK), FRG(NK), DSDD(0:NK+1)
    REAL :: FACTH, DCXY, DCYX, DCXXYY, DTTST
    REAL :: eDCXDX, eDCXDY, eDCYDX, eDCYDY, eDDDX, eDDDY, eCTHG0
    REAL :: VCFLT(NSPEC), DEPTH, FDG
    REAL :: FDDMAX
#ifdef W3_S
    CALL strace (ient, 'PROP_REFRACTION_PR1')
#endif
    ix=mapsf(isea,1)
    iy=mapsf(isea,2)
    edddx=dddx(iy,ix)
    edddy=dddy(iy,ix)
    ecthg0 = cthg0s(isea)
    facth  = dtg / dth
    !
    fdg    = facth * ecthg0
    depth  = max( dmin , dw(isea) )
    DO ik=0, nk+1
      IF ( depth*wn(ik,isea) .LT. 5. ) THEN
        dsdd(ik) = max( 0. , cg(ik,isea)*wn(ik,isea)-0.5*sig(ik) ) / depth
      ELSE
        dsdd(ik) = 0.
      END IF
    END DO
    fddmax=0
    DO ith=1, nth
      fddmax = max( fddmax , abs(esin(ith)*edddx - ecos(ith)*edddy ) )
    END DO
    DO ik=1, nk
      frk(ik) = facth * dsdd(ik) / wn(ik,isea)
      !FRK(IK) = FRK(IK) / MAX ( 1. , FRK(IK)*FDDMAX/CTMAX )
      frg(ik) = fdg * cg(ik,isea)
    END DO
    DO isp=1, nspec
      vcflt(isp) = frg(mapwn(isp)) * ecos(isp) +                     &
           frk(mapwn(isp)) * ( esin(isp)*edddx - ecos(isp)*edddy )
    END DO
    !
#ifdef W3_REFRX
    ! 3.c @C/@x refraction and great-circle propagation
    vcflt  = 0.
    frk    = 0.
    DO ik=1, nk
      frk(ik) = facth * cg(ik,isea) * wn(ik,isea) / sig(ik)
    END DO
    DO isp=1, nspec
      vcflt(isp) = frg(mapwn(isp)) * ecos(isp)           &
           + frk(mapwn(isp)) * ( esin(isp)*dcdx(isp,1,mapwn(isp)) &
           - ecos(isp)*dcdy(isp,1,mapwn(isp)) )
    END DO
#endif
    !
    IF ( flcur ) THEN
      edcxdx=dcxdx(iy,ix)
      edcxdy=dcxdy(iy,ix)
      edcydx=dcydx(iy,ix)
      edcydy=dcydy(iy,ix)
      dcyx   = facth *   edcydx
      dcxxyy = facth * ( edcxdx - edcydy )
      dcxy   = facth *   edcxdy
      DO isp=1, nspec
        vcflt(isp) = vcflt(isp) + es2(isp)*dcyx  + esc(isp)*dcxxyy - ec2(isp)*dcxy
      END DO
    END IF
    DO isp=1,nspec
      cad(isp)=dble(vcflt(isp))
    END DO
    !/
    !/ End of JACOBI_INIT ------------------------------------------------ /
    !/

References w3adatmd::cg, w3gdatmd::cthg0s, w3gdatmd::ctmax, w3adatmd::dcdx, w3adatmd::dcdy, w3adatmd::dcxdx, w3adatmd::dcxdy, w3adatmd::dcydx, w3adatmd::dcydy, w3adatmd::dddx, w3adatmd::dddy, w3gdatmd::dmin, w3gdatmd::dsip, w3gdatmd::dth, w3adatmd::dw, w3gdatmd::ec2, w3gdatmd::ecos, w3gdatmd::es2, w3gdatmd::esc, w3gdatmd::esin, w3gdatmd::fachfa, w3gdatmd::flck, w3gdatmd::flcth, w3idatmd::flcur, w3odatmd::iaproc, w3gdatmd::mapsf, w3gdatmd::mapwn, w3gdatmd::nk, w3gdatmd::nk2, w3gdatmd::nspec, w3gdatmd::nth, w3gdatmd::sig, w3servmd::strace(), and w3adatmd::wn.

Referenced by pdlib_w3profsmd::calcarray_jacobi_spectral_1(), and pdlib_w3profsmd::calcarray_jacobi_spectral_2().

prop_refraction_pr3()

subroutine w3parall::prop_refraction_pr3	(	integer, intent(in)	IP,
		integer, intent(in)	ISEA,
		real, intent(in)	DTG,
		real, dimension(nspec), intent(out)	CAD,
		logical, intent(in)	DoLimiter
	)

Compute refraction part in matrix alternative approach.

Parameters

[in]	IP
[in]	ISEA
[in]	DTG
[out]	CAD
[in]	DoLimiter

Author

Aron Roland

Mathieu Dutour-Sikiric

Date

01-Jun-2018

Definition at line 449 of file w3parall.F90.

    !/
    !/                  +-----------------------------------+
    !/                  | WAVEWATCH III           NOAA/NCEP |
    !/                  |                                   |
    !/                  | Aron Roland (BGS IT&E GmbH)       |
    !/                  | Mathieu Dutour-Sikiric (IRB)      |
    !/                  |                                   |
    !/                  |                        FORTRAN 90 |
    !/                  | Last update :        01-June-2018 |
    !/                  +-----------------------------------+
    !/
    !/   01-June-2018 : Origination.                        ( version 6.04 )
    !/
    !  1. Purpose : Compute refraction part in matrix alternative approach
    !  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 : lpdlib
    USE w3gdatmd, ONLY: nk, nk2, nth, nspec, sig, dsip, ecos, esin, &
         ec2, esc, es2, fachfa, mapwn, flcth, flck,  &
         ctmax, dmin, dth, cthg0s, mapsf, sig
    USE w3adatmd, ONLY: cg, wn, dcxdx, dcxdy, dcydx, dcydy, dddx,   &
         dddy, dw
    USE w3idatmd, ONLY: flcur
    USE w3odatmd, only : iaproc
    IMPLICIT NONE
    !/
    !/ ------------------------------------------------------------------- /
    !/ Parameter list
    !/
    !/ ------------------------------------------------------------------- /
    !/ Local parameters
    !/
#ifdef W3_S
    INTEGER, SAVE           :: IENT = 0
#endif
    REAL, intent(out) :: CAD(NSPEC)
    INTEGER, intent(in) :: ISEA, IP
    REAL, intent(in) :: DTG
    logical, intent(in) :: DoLimiter
    INTEGER :: ISP, IK, ITH, IX, IY
    REAL :: FRK(NK), FRG(NK), DSDD(0:NK+1)
    REAL :: FACTH, DCXY, DCYX, DCXXYY, DTTST
    REAL :: eDCXDX, eDCXDY, eDCYDX, eDCYDY, eDDDX, eDDDY, eCTHG0
    REAL :: VCFLT(NSPEC), DEPTH, FDG, CG1(0:NK+1), WN1(0:NK+1)
    REAL :: FDDMAX, CFLTHMAX, VELNOFILT, CTMAX_eff
#ifdef W3_S
    CALL strace (ient, 'PROP_REFRACTION_PR3')
#endif
 
    ix = mapsf(isea,1)
    iy = mapsf(isea,2)
    edddx=dddx(1,ip)
    edddy=dddy(1,ip)
    ecthg0 = cthg0s(isea)
    facth  = 1.0 / dth
    !
    fdg    = facth * ecthg0
    depth  = max( dmin , dw(isea) )
    DO ik=0, nk+1
      IF ( depth*wn(ik,isea) .LT. 5. ) THEN
        dsdd(ik) = max( 0. , cg(ik,isea)*wn(ik,isea)-0.5*sig(ik) ) / depth
      ELSE
        dsdd(ik) = 0.
      END IF
    END DO
    DO ik=1, nk
      frk(ik) = facth * dsdd(ik) / wn(ik,isea)
      frg(ik) = fdg * cg(ik,isea)
    END DO
    IF (flcur) THEN
      edcxdx = dcxdx(1,ip)
      edcxdy = dcxdy(1,ip)
      edcydx = dcydx(1,ip)
      edcydy = dcydy(1,ip)
      dcyx   = facth *   edcydx
      dcxxyy = facth * ( edcxdx - edcydy )
      dcxy   = facth *   edcxdy
      DO isp=1, nspec
        vcflt(isp) = es2(isp)*dcyx  + esc(isp)*dcxxyy - ec2(isp)*dcxy
      END DO
    ELSE
      vcflt=0
    END IF
    !
#ifdef W3_REFRX
    ! 3.c @C/@x refraction and great-circle propagation
    DO ik=1, nk
      frk(ik) = facth * cg(ik,isea) * wn(ik,isea) / sig(ik)
    END DO
#endif
    !
    ctmax_eff=ctmax/dtg
    DO isp=1, nspec
      velnofilt = vcflt(isp)                                       &
           + frg(mapwn(isp)) * ecos(isp)                             &
           + frk(mapwn(isp)) * (esin(isp)*edddx - ecos(isp)*edddy)
      !
      ! Puts filtering on total velocity (including currents and great circle effects)
      ! the filtering limits VCFLT to be less than CTMAX
      ! this modification was proposed by F. Ardhuin 2011/03/06
      !
      IF (dolimiter) THEN
        vcflt(isp)=sign(min(abs(velnofilt),ctmax_eff),velnofilt)
      ELSE
        vcflt(isp)=velnofilt
      END IF
    END DO
    DO isp=1,nspec
      cad(isp)=dble(vcflt(isp))
    END DO
    !/
    !/ End of JACOBI_INIT ------------------------------------------------ /
    !/

References w3adatmd::cg, w3gdatmd::cthg0s, w3gdatmd::ctmax, w3adatmd::dcxdx, w3adatmd::dcxdy, w3adatmd::dcydx, w3adatmd::dcydy, w3adatmd::dddx, w3adatmd::dddy, w3gdatmd::dmin, w3gdatmd::dsip, w3gdatmd::dth, w3adatmd::dw, w3gdatmd::ec2, w3gdatmd::ecos, w3gdatmd::es2, w3gdatmd::esc, w3gdatmd::esin, w3gdatmd::fachfa, w3gdatmd::flck, w3gdatmd::flcth, w3idatmd::flcur, w3odatmd::iaproc, constants::lpdlib, w3gdatmd::mapsf, w3gdatmd::mapwn, w3gdatmd::nk, w3gdatmd::nk2, w3gdatmd::nspec, w3gdatmd::nth, w3gdatmd::sig, w3servmd::strace(), and w3adatmd::wn.

Referenced by pdlib_w3profsmd::calcarray_jacobi_spectral_1(), and pdlib_w3profsmd::calcarray_jacobi_spectral_2().

set_up_nseal_nsealm()

subroutine w3parall::set_up_nseal_nsealm	(	integer, intent(out)	NSEALout,
		integer, intent(out)	NSEALMout
	)

Setup NSEAL, NSEALM in context of PDLIB.

Parameters

[out]	NSEALout
[out]	NSEALMout

Author

Aron Roland

Mathieu Dutour-Sikiric

Date

01-Jun-2018

Definition at line 1040 of file w3parall.F90.

    !/
    !/                  +-----------------------------------+
    !/                  | WAVEWATCH III           NOAA/NCEP |
    !/                  |                                   |
    !/                  | Aron Roland (BGS IT&E GmbH)       |
    !/                  | Mathieu Dutour-Sikiric (IRB)      |
    !/                  |                                   |
    !/                  |                        FORTRAN 90 |
    !/                  | Last update :        01-June-2018 |
    !/                  +-----------------------------------+
    !/
    !/   01-June-2018 : Origination.                        ( version 6.04 )
    !/
    !  1. Purpose : Setup nseal, nsealm in contect of pdlib
    !  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
    !/
    !/ ------------------------------------------------------------------- /
#ifdef W3_PDLIB
    use yowdatapool, only: istatus
    use yownodepool, only: npa
    use yowrankmodule, only : rank
    USE w3gdatmd, ONLY: gtype, ungtype
#endif
#ifdef W3_MPI
    USE w3adatmd, ONLY: mpi_comm_wave, mpi_comm_wcmp
#endif
    USE constants, ONLY : lpdlib
    USE w3gdatmd, ONLY: nsea
    USE w3odatmd, ONLY: ntproc, naproc, iaproc
    IMPLICIT NONE
    INTEGER, intent(out) :: NSEALout, NSEALMout
    !/ Local parameters
    !/
#ifdef W3_S
    INTEGER, SAVE           :: IENT = 0
#endif
    !/
    !/ ------------------------------------------------------------------- /
    !/
#ifdef W3_S
    CALL strace (ient, 'SET_UP_NSEAL_NSEALM')
#endif
 
#ifdef W3_SHRD
    nsealout  = nsea
    nsealmout = nsea
#endif
    !
#ifdef W3_DIST
    IF (.NOT. lpdlib ) THEN
      IF ( iaproc .LE. naproc ) THEN
        nsealout  = 1 + (nsea-iaproc)/naproc
      ELSE
        nsealout  = 0
      END IF
      nsealmout = 1 + (nsea-1)/naproc
    ELSE
#endif
#ifdef W3_PDLIB
      IF (gtype .eq. ungtype) THEN
        nsealout  = pdlib_nseal
        nsealmout = pdlib_nsealm
      ELSE
        IF ( iaproc .LE. naproc ) THEN
          nsealout  = 1 + (nsea-iaproc)/naproc
        ELSE
          nsealout  = 0
        END IF
        nsealmout = 1 + (nsea-1)/naproc
      ENDIF
#endif
#ifdef W3_DIST
    ENDIF
#endif
    !/
    !/ End of JACOBI_INIT ------------------------------------------------ /
    !/

References w3gdatmd::gtype, w3odatmd::iaproc, yowdatapool::istatus, constants::lpdlib, w3adatmd::mpi_comm_wave, w3adatmd::mpi_comm_wcmp, w3odatmd::naproc, yownodepool::npa, w3gdatmd::nsea, w3odatmd::ntproc, pdlib_nseal, pdlib_nsealm, yowrankmodule::rank, w3servmd::strace(), and w3gdatmd::ungtype.

Referenced by w3wdatmd::w3dimw(), and w3initmd::w3init().

synchronize_global_array()

subroutine w3parall::synchronize_global_array

(

double precision, dimension(nx), intent(inout)

TheVar

)

Sync global array in context of PDLIB.

An array of size (NSEA) is send but only the (1:NSEAL) values are correct. The program synchonizes everything on all nodes.

Parameters

[in,out]

TheVar

Author

Aron Roland

Mathieu Dutour-Sikiric

Date

01-Jun-2018

Definition at line 1517 of file w3parall.F90.

    !/ ------------------------------------------------------------------- /
    !**********************************************************************
    !*  An array of size (NSEA) is send but only the (1:NSEAL) values     *
    !*  are correct. The program synchonizes everything on all nodes.     *
    !**********************************************************************
    !/
    !/                  +-----------------------------------+
    !/                  | WAVEWATCH III           NOAA/NCEP |
    !/                  |                                   |
    !/                  | Aron Roland (BGS IT&E GmbH)       |
    !/                  | Mathieu Dutour-Sikiric (IRB)      |
    !/                  |                                   |
    !/                  |                        FORTRAN 90 |
    !/                  | Last update :        01-June-2018 |
    !/                  +-----------------------------------+
    !/
    !/   01-June-2018 : Origination.                        ( version 6.04 )
    !/
    !  1. Purpose : Sync global array in context of pdlib
    !  2. Method :
    !           An array of size (NSEA) is send but only the (1:NSEAL) values
    !           are correct. The program synchonizes everything on all nodes.
    !  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: nseal, nsea, nx
#ifdef W3_PDLIB
    USE w3odatmd, only : iaproc, naproc, ntproc
    USE w3adatmd, ONLY: mpi_comm_wcmp
    use yowdatapool, only: rtype, istatus
    USE yownodepool, only: npa
    use yownodepool, only: iplg
    use yowdatapool, only: rkind
#endif
    IMPLICIT NONE
    !/ ------------------------------------------------------------------- /
    !/ Parameter list
    !/
    !/ ------------------------------------------------------------------- /
    !/ Local parameters
    !/
#ifdef W3_S
    INTEGER, SAVE           :: IENT = 0
#endif
    !/
    !/ ------------------------------------------------------------------- /
    !/
#ifdef W3_MPI
    include "mpif.h"
#endif
    INTEGER ISEA, JSEA, Status(NX), rStatus(NX)
    INTEGER IPROC, I, ierr, IP, IX, IP_glob
#ifdef W3_PDLIB
    REAL(rkind), intent(inout) :: TheVar(NX)
    REAL(rkind) ::  rVect(NX)
#else
    DOUBLE PRECISION, intent(inout) :: TheVar(NX)
    DOUBLE PRECISION                ::  rVect(NX)
#endif
    status=0
#ifdef W3_S
    CALL strace (ient, 'SYNCHRONIZE_GLOBAL_ARRAY')
#endif
#ifdef W3_PDLIB
    DO ip=1,npa
      ip_glob=iplg(ip)
      status(ip_glob)=1
    END DO
    IF (iaproc .eq. 1) THEN
      DO iproc=2,naproc
        CALL mpi_recv(rvect,nx,rtype, iproc-1, 19, mpi_comm_wcmp, istatus, ierr)
        CALL mpi_recv(rstatus,nx,mpi_integer, iproc-1, 23, mpi_comm_wcmp, istatus, ierr)
        DO i=1,nx
          IF (rstatus(i) .eq. 1) THEN
            thevar(i)=rvect(i)
            status(i)=1
          END IF
        END DO
      END DO
      DO iproc=2,naproc
        CALL mpi_send(thevar,nx,rtype, iproc-1, 29, mpi_comm_wcmp, ierr)
      END DO
    ELSE
      CALL mpi_send(thevar,nx,rtype, 0, 19, mpi_comm_wcmp, ierr)
      CALL mpi_send(status,nx,mpi_integer, 0, 23, mpi_comm_wcmp, ierr)
      CALL mpi_recv(thevar,nx,rtype, 0, 29, mpi_comm_wcmp, istatus, ierr)
    END IF
#endif
    !/
    !/ End of JACOBI_INIT ------------------------------------------------ /
    !/

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

Referenced by w3wavset::trig_wave_setup_computation().

synchronize_ipgl_etc_array()

subroutine w3parall::synchronize_ipgl_etc_array	(	integer, intent(in)	IMOD,
		logical, intent(in)	IsMulti
	)

Sync global local arrays.

Parameters

[in]	IMOD
[in]	IsMulti

Author

Aron Roland

Mathieu Dutour-Sikiric

Date

01-Jun-2018

Definition at line 916 of file w3parall.F90.

    !/
    !/                  +-----------------------------------+
    !/                  | WAVEWATCH III           NOAA/NCEP |
    !/                  |                                   |
    !/                  | Aron Roland (BGS IT&E GmbH)       |
    !/                  | Mathieu Dutour-Sikiric (IRB)      |
    !/                  |                                   |
    !/                  |                        FORTRAN 90 |
    !/                  | Last update :        01-June-2018 |
    !/                  +-----------------------------------+
    !/
    !/   01-June-2018 : Origination.                        ( version 6.04 )
    !/
    !  1. Purpose : Sync global local arrays
    !  2. Method :
    !       All the process need to have IPGL_tot and IPGL_TO_PROC
    !       This is especially the case for the output process.
    !       So we need some painful exportation business
    !  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
#ifdef W3_PDLIB
    USE yowdatapool, only: istatus
    USE yownodepool, only: np_global
    USE w3odatmd, ONLY: ntproc, naproc, iaproc
    USE w3gdatmd, ONLY: mapsf, nsea
    USE w3adatmd, ONLY: mpi_comm_wave, mpi_comm_wcmp
    USE yowrankmodule, only : ipgl_to_proc, ipgl_tot
    USE wmmdatmd, ONLY: mdatas
#endif
    IMPLICIT NONE
#ifdef W3_PDLIB
    include "mpif.h"
#endif
    INTEGER, intent(in) :: IMOD
    logical, intent(in) :: IsMulti
#ifdef W3_S
    INTEGER, SAVE           :: IENT = 0
#endif
#ifdef W3_PDLIB
    INTEGER :: Iarr(1)
    INTEGER :: ISEA, IP_glob
    INTEGER :: IPROC, IERR_MPI, istat
#endif
 
#ifdef W3_S
    CALL strace (ient, 'SYNCHRONIZE_IPGL_ETC_ARRAY')
#endif
 
#ifdef W3_PDLIB
    IF (iaproc .le. naproc) THEN
      IF (iaproc .eq. 1) THEN
        iarr(1)=np_global
        DO iproc=naproc+1,ntproc
          CALL mpi_send(iarr,1,mpi_int, iproc-1, 37, mpi_comm_wave, ierr_mpi)
        END DO
        DO iproc=naproc+1,ntproc
          CALL mpi_send(ipgl_tot,np_global,mpi_int, iproc-1, 43, mpi_comm_wave, ierr_mpi)
          CALL mpi_send(ipgl_to_proc,np_global,mpi_int, iproc-1, 91, mpi_comm_wave, ierr_mpi)
        END DO
      END IF
    ELSE
      CALL mpi_recv(iarr,1,mpi_int, 0, 37, mpi_comm_wave, istatus, ierr_mpi)
      np_global=iarr(1)
      allocate(ipgl_tot(np_global), ipgl_to_proc(np_global), stat=istat)
      CALL mpi_recv(ipgl_tot,np_global,mpi_int, 0, 43, mpi_comm_wave, istatus, ierr_mpi)
      CALL mpi_recv(ipgl_to_proc,np_global,mpi_int, 0, 91, mpi_comm_wave, istatus, ierr_mpi)
    END IF
    IF (ismulti) THEN
      WRITE(*,*) ' Before allocation of MDATAS % SEA_IPGL, SEA_IPGL_TO_PROC : IMOD=', imod, ' NSEA=', nsea
      ALLOCATE(mdatas(imod)%SEA_IPGL(nsea), mdatas(imod)%SEA_IPGL_TO_PROC(nsea), stat=istat)
      !CHECK_ALLOC_STATUS ( ISTAT )
      DO isea=1,nsea
        ip_glob = mapsf(isea, 1)
        mdatas(imod)%SEA_IPGL(isea) = ipgl_tot(ip_glob)
        mdatas(imod)%SEA_IPGL_TO_PROC(isea) = ipgl_to_proc(ip_glob)
      END DO
    END IF
#endif
    !/
    !/ End of JACOBI_INIT ------------------------------------------------ /
    !/

References w3odatmd::iaproc, include(), yowrankmodule::ipgl_to_proc, yowrankmodule::ipgl_tot, yowdatapool::istatus, w3gdatmd::mapsf, wmmdatmd::mdatas, w3adatmd::mpi_comm_wave, w3adatmd::mpi_comm_wcmp, w3odatmd::naproc, yownodepool::np_global, w3gdatmd::nsea, w3odatmd::ntproc, and w3servmd::strace().

Referenced by w3initmd::w3init().

wav_my_wtime()

subroutine w3parall::wav_my_wtime

(

real(8), intent(out)

eTime

)

NA.

Parameters

[out]

eTime

Author

Aron Roland

Mathieu Dutour-Sikiric

Date

01-Jun-2018

Definition at line 110 of file w3parall.F90.

    !/ ------------------------------------------------------------------- /
    !/
    !/                  +-----------------------------------+
    !/                  | WAVEWATCH III           NOAA/NCEP |
    !/                  |                                   |
    !/                  | Aron Roland (BGS IT&E GmbH)       |
    !/                  | Mathieu Dutour-Sikiric (IRB)      |
    !/                  |                                   |
    !/                  |                        FORTRAN 90 |
    !/                  | Last update :        01-June-2018 |
    !/                  +-----------------------------------+
    !/
    !/   01-June-2018 : Origination.                        ( version 6.04 )
    !/
    !  1. Purpose :
    !  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
    !/
    !/ ------------------------------------------------------------------- /
    !/ Parameter list
    !/
    !/ ------------------------------------------------------------------- /
    !/ Local parameters
    !/
    IMPLICIT NONE
#ifdef W3_S
    INTEGER, SAVE           :: IENT = 0
#endif
    INTEGER mpimode
    REAL(8), intent(out) :: eTime
#ifdef W3_MPI
    REAL(8) mpi_wtime
#endif
    mpimode=0
#ifdef W3_MPI
    mpimode=1
    etime=mpi_wtime()
#endif
#ifdef W3_S
    CALL strace (ient, 'WAV_MY_WTIME')
#endif
    IF (mpimode .eq. 0) THEN
      CALL cpu_time(etime)
    END IF
    !/
    !/ End of JACOBI_INIT ------------------------------------------------ /
    !/

References w3servmd::strace().

Referenced by print_my_time().

Variable Documentation

ient

integer, save w3parall::ient = 0

Definition at line 78 of file w3parall.F90.

  INTEGER, SAVE           :: IENT = 0

imem

integer, parameter w3parall::imem = 1

Definition at line 90 of file w3parall.F90.

  INTEGER, PARAMETER   :: IMEM = 1

Referenced by pdlib_w3profsmd::calcarray_jacobi2(), pdlib_w3profsmd::calcarray_jacobi_source_1(), pdlib_w3profsmd::calcarray_jacobi_source_2(), pdlib_w3profsmd::calcarray_jacobi_spectral_1(), pdlib_w3profsmd::calcarray_jacobi_spectral_2(), pdlib_w3profsmd::deallocate_pdlib_global(), pdlib_w3profsmd::jacobi_finalize(), pdlib_w3profsmd::jacobi_init(), pdlib_w3profsmd::pdlib_jacobi_gauss_seidel_block(), and w3srcemd::w3srce().

isea_to_jsea

integer, dimension(:), allocatable w3parall::isea_to_jsea

Definition at line 83 of file w3parall.F90.

Referenced by pdlib_w3profsmd::apply_boundary_condition_va(), init_get_jsea_isproc(), pdlib_w3profsmd::pdlib_init(), and w3initmd::w3init().

jx_to_jsea

integer, dimension(:), allocatable w3parall::jx_to_jsea

Definition at line 83 of file w3parall.F90.

  INTEGER, ALLOCATABLE :: JX_TO_JSEA(:), ISEA_TO_JSEA(:)

Referenced by get_jsea_ibelong(), pdlib_w3profsmd::pdlib_init(), and pdlib_w3profsmd::pdlib_jacobi_gauss_seidel_block().

listispnextdir

integer, dimension(:), allocatable w3parall::listispnextdir

Definition at line 86 of file w3parall.F90.

  INTEGER, ALLOCATABLE :: ListISPnextDir(:), ListISPprevDir(:)

Referenced by pdlib_w3profsmd::block_solver_init(), and pdlib_w3profsmd::pdlib_jacobi_gauss_seidel_block().

listispnextfreq

integer, dimension(:), allocatable w3parall::listispnextfreq

Definition at line 87 of file w3parall.F90.

  INTEGER, ALLOCATABLE :: ListISPnextFreq(:), ListISPprevFreq(:)

Referenced by pdlib_w3profsmd::block_solver_init().

listispprevdir

integer, dimension(:), allocatable w3parall::listispprevdir

Definition at line 86 of file w3parall.F90.

Referenced by pdlib_w3profsmd::block_solver_init(), and pdlib_w3profsmd::pdlib_jacobi_gauss_seidel_block().

listispprevfreq

integer, dimension(:), allocatable w3parall::listispprevfreq

Definition at line 87 of file w3parall.F90.

Referenced by pdlib_w3profsmd::block_solver_init().

lsloc

logical, parameter w3parall::lsloc = .true.

Definition at line 89 of file w3parall.F90.

  LOGICAL, PARAMETER   :: LSLOC = .true.

Referenced by pdlib_w3profsmd::pdlib_jacobi_gauss_seidel_block(), w3wdatmd::w3dimw(), w3srcemd::w3srce(), and w3wavemd::w3wave().

onesixth

real, parameter w3parall::onesixth = 1.0d0/6.0d0

Definition at line 92 of file w3parall.F90.

  REAL,  PARAMETER     :: ONESIXTH  = 1.0d0/6.0d0

Referenced by pdlib_w3profsmd::calcarray_jacobi(), pdlib_w3profsmd::calcarray_jacobi2(), pdlib_w3profsmd::calcarray_jacobi3(), pdlib_w3profsmd::calcarray_jacobi4(), pdlib_w3profsmd::calcarray_jacobi_vec(), pdlib_w3profsmd::pdlib_w3xypfsfct2(), pdlib_w3profsmd::pdlib_w3xypfsn2(), and pdlib_w3profsmd::pdlib_w3xypfspsi2().

onethird

real, parameter w3parall::onethird = 1.0d0/3.0d0

Definition at line 93 of file w3parall.F90.

  REAL,  PARAMETER     :: ONETHIRD  = 1.0d0/3.0d0

Referenced by pdlib_w3profsmd::calcarray_jacobi3(), and pdlib_w3profsmd::calcarray_jacobi4().

pdlib_nseal

integer w3parall::pdlib_nseal

Definition at line 82 of file w3parall.F90.

  INTEGER :: PDLIB_NSEAL, PDLIB_NSEALM

Referenced by pdlib_w3profsmd::pdlib_init(), set_up_nseal_nsealm(), and w3wavemd::w3wave().

pdlib_nsealm

integer w3parall::pdlib_nsealm

Definition at line 82 of file w3parall.F90.

Referenced by pdlib_w3profsmd::pdlib_init(), set_up_nseal_nsealm(), and w3wavemd::w3wave().

thr

real, parameter w3parall::thr = TINY(1.0)

Definition at line 97 of file w3parall.F90.

  REAL,  PARAMETER     :: THR       = tiny(1.0)

Referenced by pdlib_w3profsmd::calcarray_jacobi(), pdlib_w3profsmd::calcarray_jacobi2(), pdlib_w3profsmd::calcarray_jacobi3(), pdlib_w3profsmd::calcarray_jacobi4(), pdlib_w3profsmd::calcarray_jacobi_vec(), pdlib_w3profsmd::pdlib_w3xypfsfct2(), pdlib_w3profsmd::pdlib_w3xypfsn2(), and pdlib_w3profsmd::pdlib_w3xypfspsi2().

thr8

real*8, parameter w3parall::thr8 = TINY(1.d0)

Definition at line 96 of file w3parall.F90.

  real*8,  PARAMETER     :: thr8      = tiny(1.d0)

Referenced by pdlib_w3profsmd::pdlib_jacobi_gauss_seidel_block().

zero

real, parameter w3parall::zero = 0.0d0

Definition at line 94 of file w3parall.F90.

  REAL,  PARAMETER     :: ZERO      = 0.0d0

Referenced by pdlib_w3profsmd::calcarray_jacobi(), pdlib_w3profsmd::calcarray_jacobi2(), pdlib_w3profsmd::calcarray_jacobi3(), pdlib_w3profsmd::calcarray_jacobi4(), pdlib_w3profsmd::calcarray_jacobi_spectral_1(), pdlib_w3profsmd::calcarray_jacobi_spectral_2(), pdlib_w3profsmd::calcarray_jacobi_vec(), pdlib_w3profsmd::pdlib_jacobi_gauss_seidel_block(), pdlib_w3profsmd::pdlib_w3xypfsfct2(), pdlib_w3profsmd::pdlib_w3xypfsn2(), pdlib_w3profsmd::pdlib_w3xypfspsi2(), prop_freq_shift(), and prop_freq_shift_m2().