The TELEMAC-MASCARET system  trunk
calres.f
Go to the documentation of this file.
1 ! *****************
2  SUBROUTINE calres
3 ! *****************
4 !
5 !
6 !***********************************************************************
7 ! ARTEMIS V7P3 Aug 2017
8 !***********************************************************************
9 !
10 !brief COMPUTES THE WAVE HEIGHT AND PHASE, SPEEDS
11 !+ AND THE FREE SURFACE ELEVATION.
12 !
13 !history J-M HERVOUET (LNH)
14 !+
15 !+
16 !+ LINKED TO BIEF 5.0
17 !
18 !history D. AELBRECHT (LNH)
19 !+ 04/06/1999
20 !+ V5P1
21 !+
22 !
23 !history N.DURAND (HRW), S.E.BOURBAN (HRW)
24 !+ 13/07/2010
25 !+ V6P0
26 !+ Translation of French comments within the FORTRAN sources into
27 !+ English comments
28 !
29 !history N.DURAND (HRW), S.E.BOURBAN (HRW)
30 !+ 21/08/2010
31 !+ V6P0
32 !+ Creation of DOXYGEN tags for automated documentation and
33 !+ cross-referencing of the FORTRAN sources
34 !
35 !history N.DURAND (HRW)
36 !+ August 2017
37 !+ V7P3
38 !+ Removed unnecessary references to PI
39 !
40 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
41 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
42 !
43  USE bief
46 !
48  IMPLICIT NONE
49 !
50  INTEGER I
51 !
52  INTRINSIC sqrt, atan2, mod, abs, cos, sin, atan
53 !
54 !-----------------------------------------------------------------------
55 !
56  DOUBLE PRECISION, PARAMETER :: ZERO = 1.d-10
57 !
58 !=======================================================================
59 ! WAVE HEIGHT HHO <=> Hm0
60 !=======================================================================
61 !
62  CALL os('X=N(Y,Z)', x=t1, y=phir, z=phii)
63  IF (courant) THEN
64 ! WE USE WR (RELATIVE PULSATION)
65  CALL os('X=CY ', x=t2 ,y=wr, c=2.d0/grav)
66  CALL os('X=YZ ', x=hho ,y=t1, z=t2 )
67  ELSE
68 ! WE USE OMEGA
69  CALL os('X=CY ', x=hho ,y=t1, c=2.d0*omega/grav)
70  ENDIF
71 !
72 !=======================================================================
73 ! PHASE OF THE POTENTIAL (IN RADIAN)
74 !=======================================================================
75 !
76  DO i=1,npoin
77  IF (t1%R(i).LT.zero) THEN
78  phas%R(i) = 0.d0
79  ELSE
80  phas%R(i) = atan2( phii%R(i),phir%R(i) )
81  ENDIF
82  ENDDO
83 !
84 !=======================================================================
85 ! FREE SURFACE ELEVATION
86 !=======================================================================
87  IF (courant) THEN
88  DO i=1,npoin
89  s%R(i) = -wr%R(i)/grav*phii%R(i) + h%R(i) + zf%R(i)
90  ENDDO
91  ELSE
92  DO i=1,npoin
93  s%R(i) = -omega/grav*phii%R(i) + h%R(i) + zf%R(i)
94  ENDDO
95  ENDIF
96 !
97 !=======================================================================
98 ! WAVE INIDENCE USING SPEEDS AT THE SURFACE (AT T=0 AND T=OMEGA/4)
99 !=======================================================================
100  CALL caldir()
101 !=======================================================================
102 ! NOMBRES D INTERET POUR LE COURANT, ATTENTION IL FAUT DECLARER 4 VARIABLES
103 ! PRIVEES DANS LE .cas
104 ! IF (COURANT) THEN
105 ! ON IMPRIME LE COURANT ET LE VECTEUR D ONDE
106 ! DO I=1,NPOIN
107 ! PRIVE%ADR(1)%P%R(I) = UC%R(I)
108 ! PRIVE%ADR(2)%P%R(I) = VC%R(I)
109 ! PRIVE%ADR(3)%P%R(I) = T5%R(I)
110 ! PRIVE%ADR(4)%P%R(I) = T6%R(I)
111 ! ENDDO
112 ! ENDIF
113 
114 !=======================================================================
115 !
116  RETURN
117  END SUBROUTINE
type(bief_obj), target h
type(bief_obj), target zf
subroutine calres
Definition: calres.f:4
double precision, dimension(:), pointer y
type(bief_obj), target hho
type(bief_obj), target phii
type(bief_obj), pointer t2
subroutine caldir
Definition: caldir.f:4
type(bief_obj), target wr
type(bief_obj), target phir
type(bief_obj), target phas
double precision, dimension(:), pointer x
subroutine os(OP, X, Y, Z, C, IOPT, INFINI, ZERO)
Definition: os.f:7
type(bief_obj), pointer t1
type(bief_obj), target c
type(bief_obj), target s
Definition: bief.f:3