calres.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\artemis\calres.f
00002 !
00077                      SUBROUTINE CALRES
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,RADDEG
00104       DOUBLE PRECISION ZERO, BID
00105 !
00106       INTRINSIC SQRT, ATAN2, DMOD, ABS, COS, SIN
00107 !
00108 !-----------------------------------------------------------------------
00109 !
00110       PARAMETER (ZERO = 1.D-10)
00111       PARAMETER (PI = 3.1415926535897932384626433D0)
00112       PARAMETER (RADDEG = 57.29577951D0)
00113 !
00114 !=======================================================================
00115 ! WAVE HEIGHT HHO <=> Hm0
00116 !=======================================================================
00117 !
00118       CALL OS( 'X=N(Y,Z)', T1, PHIR, PHII , BID             )
00119       IF (COURANT) THEN
00120 !     WE USE WR (RELATIVE PULSATION)
00121         CALL OS( 'X=CY    ', X=T2   ,Y=WR, C=2.D0/GRAV)
00122         CALL OS( 'X=YZ    ', X=HHO  ,Y=T1, Z=T2 )
00123       ELSE
00124 !     WE USE OMEGA
00125         CALL OS( 'X=CY    ', X=HHO  ,Y=T1, C=2.D0*OMEGA/GRAV)
00126       ENDIF
00127 !
00128 !=======================================================================
00129 ! PHASE OF THE POTENTIAL (IN RADIAN)
00130 !=======================================================================
00131 !
00132       DO I=1,NPOIN
00133         IF (T1%R(I).LT.ZERO) THEN
00134           PHAS%R(I) = 0.D0
00135         ELSE
00136           PHAS%R(I) = ATAN2( PHII%R(I),PHIR%R(I) )
00137         ENDIF
00138       ENDDO
00139 !
00140 !=======================================================================
00141 ! FREE SURFACE ELEVATION
00142 !=======================================================================
00143       IF (COURANT) THEN
00144         DO I=1,NPOIN
00145           S%R(I) = -WR%R(I)/GRAV*PHII%R(I) + H%R(I) + ZF%R(I)
00146         ENDDO
00147       ELSE
00148         DO I=1,NPOIN
00149           S%R(I) = -OMEGA/GRAV*PHII%R(I) + H%R(I) + ZF%R(I)
00150         ENDDO
00151       ENDIF
00152 !
00153 !=======================================================================
00154 ! WAVE INIDENCE USING SPEEDS AT THE SURFACE (AT T=0 AND T=OMEGA/4)
00155 !=======================================================================
00156       CALL CALDIR()
00157 !=======================================================================
00158 !    NOMBRES D INTERET POUR LE COURANT, ATTENTION IL FAUT DECLARER 4 VARIABLES
00159 !                                                 PRIVEES DANS LE .cas
00160 !      IF (COURANT) THEN
00161 !      ON IMPRIME LE COURANT ET LE VECTEUR D ONDE
00162 !       DO I=1,NPOIN
00163 !        PRIVE%ADR(1)%P%R(I) = UC%R(I)
00164 !        PRIVE%ADR(2)%P%R(I) = VC%R(I)
00165 !        PRIVE%ADR(3)%P%R(I) = T5%R(I)
00166 !        PRIVE%ADR(4)%P%R(I) = T6%R(I)
00167 !       ENDDO
00168 !      ENDIF
00169 
00170 !=======================================================================
00171 !
00172       RETURN
00173       END SUBROUTINE

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