calre2.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\artemis\calre2.f
00002 !
00077                      SUBROUTINE CALRE2
00078 !                    *****************
00079 !
00080 !
00081 !***********************************************************************
00082 ! ARTEMIS   V6P1                                   21/08/2010
00083 !***********************************************************************
00084 !
00085 !
00086 !
00087 !
00088 !
00089 !
00090 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00091 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00092 !
00093       USE BIEF
00094       USE DECLARATIONS_TELEMAC
00095       USE DECLARATIONS_ARTEMIS
00096 !
00097       IMPLICIT NONE
00098       INTEGER LNG,LU
00099       COMMON/INFO/LNG,LU
00100 !
00101       INTEGER I
00102 !
00103       DOUBLE PRECISION PI,DEUXPI, DHTEST
00104 !
00105       DOUBLE PRECISION BID
00106 !
00107       INTRINSIC SQRT, ATAN2, DMOD, ABS, COS, SIN
00108 !
00109 !-----------------------------------------------------------------------
00110 !
00111       PI = 3.1415926535897932384626433D0
00112       DEUXPI = 2.D0*PI
00113       GRAV = 9.81D0
00114 !-----------------------------------------------------------------------
00115 !
00116 !   COMPUTES THE WAVE NUMBER: K
00117 !   USING AN EXPLICIT FORMULATION (SEE EDF'S EXCELLENT REPORT BY
00118 !   F. DHELLEMMES 'PRECIS SUR LES VAGUES' )
00119 !
00120 !-----------------------------------------------------------------------
00121 !
00122 !
00123 !=======================================================================
00124 ! COMPUTES MEAN OMEGA
00125 !=======================================================================
00126 !
00127 ! MEAN OMEGA STORED IN T1
00128 !
00129       CALL OS( 'X=1/Y   ', T1   , T01  , SBID  , BID    )
00130       CALL OS( 'X=CX    ', T1   , SBID , SBID  , DEUXPI )
00131 !      CALL OS( 'X=C     ', T1 , SBID , SBID , DEUXPI/PERPIC )
00132       CALL OS( 'X=Y     ',OMEGAM, T1   , SBID  , BID    )
00133 !
00134 !=======================================================================
00135 ! COMPUTES MEAN K
00136 !=======================================================================
00137 !
00138 ! OMEGA**2 * H / GRAV
00139 !
00140       CALL OS( 'X=YZ    ', X=T2 , Y=T1 , Z=T1 )
00141       CALL OS( 'X=CXY   ', T2 , H  , SBID , 1.D0/GRAV )
00142 !
00143 !     INITIALISES DHTEST
00144 !
00145       DHTEST = 1.D6
00146 !
00147       DO I=1,NPOIN
00148         T1%R(I) = 1.D0 + T2%R(I) *( 0.6522D0 +
00149      &                    T2%R(I) *( 0.4622D0 +
00150      &                    T2%R(I) *
00151      &                    T2%R(I) *( 0.0864D0 +
00152      &                    T2%R(I) *( 0.0675D0 ) )))
00153         T1%R(I) = SQRT( T2%R(I)*(T2%R(I) + 1.D0/T1%R(I)) )
00154         K%R(I)  = T1%R(I)/H%R(I)
00155         DHTEST  = MIN( DHTEST , H%R(I) )
00156       ENDDO
00157 !
00158 !
00159 !=======================================================================
00160 ! COMPUTES MEAN C
00161 !=======================================================================
00162 !
00163       CALL OS( 'X=1/Y   ', T1 , T01  , SBID  , BID )
00164       CALL OS( 'X=CX    ', T1 , SBID  , SBID  , DEUXPI )
00165       CALL OS( 'X=Y/Z   ', C  , T1   , K    , BID )
00166 !
00167 !
00168 !=======================================================================
00169 ! COMPUTES MEAN CG
00170 !=======================================================================
00171 !
00172       DO I=1,NPOIN
00173         CG%R(I) = C%R(I)/2.D0 *
00174      &             (1.D0 + 2.D0*K%R(I)*H%R(I)/SINH(2.D0*K%R(I)*H%R(I)))
00175       ENDDO
00176 !
00177       RETURN
00178       END

Generated on Fri Aug 31 2013 18:12:58 by S.E.Bourban (HRW) using doxygen 1.7.0