caldir.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\artemis\caldir.f
00002 !
00062                      SUBROUTINE CALDIR
00063 !                    *****************
00064 !
00065 !
00066 !***********************************************************************
00067 ! ARTEMIS   V6P3                                   30/06/2013
00068 !***********************************************************************
00069 !
00070 !
00071 !
00072 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00073 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00074 !
00075       USE BIEF
00076       USE DECLARATIONS_TELEMAC
00077       USE DECLARATIONS_ARTEMIS
00078 !
00079       IMPLICIT NONE
00080       INTEGER LNG,LU
00081       COMMON/INFO/LNG,LU
00082 !
00083       INTEGER I
00084 !
00085       DOUBLE PRECISION PI,RADDEG
00086       DOUBLE PRECISION ZERO, BID
00087       DOUBLE PRECISION A1, A2 ,ALPHA0, D1, D2, PHI, PHI1, PHI2 ,MODPHI
00088       DOUBLE PRECISION TETA01, XU1 ,XU2, XV1, XV2, WT0
00089 !
00090       INTRINSIC SQRT, ATAN2, DMOD, ABS, COS, SIN
00091 !
00092 !-----------------------------------------------------------------------
00093 !
00094       PARAMETER (ZERO = 1.D-10)
00095       PARAMETER (PI = 3.1415926535897932384626433D0)
00096       PARAMETER (RADDEG = 57.29577951D0)
00097 !
00098 !=======================================================================
00099 ! SPEEDS AT THE SURFACE (AT T=0 AND T=OMEGA/4)
00100 !=======================================================================
00101 !
00102 ! COMPUTES THE GRADIENTS (PHIR AND PHII)
00103 !
00104 !
00105       CALL VECTOR(U0 , '=' , 'GRADF          X' , IELM ,
00106      &            1.D0 , PHIR , SBID, SBID , SBID , SBID , SBID ,
00107      &            MESH , MSK , MASKEL )
00108 !
00109       CALL VECTOR(V0 , '=' , 'GRADF          Y' , IELM ,
00110      &            1.D0 , PHIR , SBID , SBID , SBID , SBID , SBID ,
00111      &            MESH , MSK , MASKEL )
00112 !
00113 !     THE OLD VARIABLE U1 IS STORED IN T3
00114 !     BECAUSE IT IS USED TO COMPUTE INCI
00115 !
00116       CALL VECTOR(T3 , '=' , 'GRADF          X' , IELM ,
00117      &            1.D0 , PHII , SBID , SBID , SBID , SBID , SBID ,
00118      &            MESH , MSK , MASKEL )
00119 !
00120 !     THE OLD VARIABLE V1 IS STORED IN T4
00121 !     BECAUSE IT IS USED TO COMPUTE INCI
00122 !
00123       CALL VECTOR(T4 , '=' , 'GRADF          Y' , IELM ,
00124      &            1.D0 , PHII , SBID , SBID , SBID , SBID , SBID ,
00125      &            MESH , MSK , MASKEL )
00126 !
00127       CALL VECTOR(T1 , '=' , 'MASBAS          ' , IELM ,
00128      &            1.D0 , SBID , SBID , SBID , SBID , SBID , SBID ,
00129      &            MESH , MSK , MASKEL )
00130 !
00131       CALL OS( 'X=Y/Z   ' , U0    , U0    , T1 , BID )
00132       CALL OS( 'X=Y/Z   ' , V0    , V0    , T1 , BID )
00133       CALL OS( 'X=Y/Z   ' , T3    , T3    , T1 , BID )
00134       CALL OS( 'X=Y/Z   ' , T4    , T4    , T1 , BID )
00135 !
00136 !=======================================================================
00137 ! COMPUTES WAVE INCIDENCE
00138 !=======================================================================
00139 !
00140 !        U0 (D(PHIR)/DX) : A      U1 (D(PHII)/DX): B
00141 !        V0 (D(PHIR)/DY) : C      V1 (D(PHII)/DY): D
00142 ! FROM U= A COS WT + B SIN WT  TO : U = A1 COS ( WT - PHI1)
00143 !      V= C COS WT + D SIN WT       V = A2 COS ( WT - PHI2)
00144 !
00145       DO I=1,NPOIN
00146         A1 = SQRT ( U0%R(I)*U0%R(I) + T3%R(I)*T3%R(I) )
00147         PHI1 = ATAN2( T3%R(I),U0%R(I) )
00148         A2 = SQRT ( V0%R(I)*V0%R(I) + T4%R(I)*T4%R(I) )
00149         PHI2 = ATAN2( T4%R(I),V0%R(I) )
00150 !
00151 ! WRITTEN AS : U = A1 COS ( (WT - PHI1))
00152 !              V = A2 COS ( (WT - PHI1) - PHI )
00153 ! WHERE PHI IS BETWEEN 0 AND 2*PI
00154 !
00155         PHI = PHI2 - PHI1
00156         IF (PHI.LT.0.D0)   PHI = PHI+2.D0*PI
00157 !
00158 ! ESTIMATES THE DIRECTION AND (WT0) WHEN THE ELLIPSE'S MAJOR AXIS
00159 ! IS REACHED.
00160 ! TREATS INDIVIDUAL CASES (LINEAR POLARISATION)
00161 !
00162         MODPHI = DMOD( PHI, PI )
00163         IF ( (MODPHI.LT.ZERO).OR.((PI-MODPHI).LT.ZERO) ) THEN
00164           WT0 = PHI1
00165           IF ( (PHI.LT.2D0*ZERO).OR.((2.D0*PI-PHI).LT.2D0*ZERO) )THEN
00166             ALPHA0 = ATAN2( A2,A1 )
00167           ELSE
00168 !                  (ABS(PHI-PI).LT.2D0*ZERO)
00169             ALPHA0 = 2.D0*PI - ATAN2( A2,A1 )
00170           ENDIF
00171         ELSE
00172 ! GENERAL CASE: ELLIPTIC POLARISATION
00173 !        TAN(2*(WT0 - PHI1)) = A2**2*SIN(2*PHI)/(A1**2+A2**2*COS(2*PHI))
00174           TETA01 = ATAN2( (A2*A2*SIN(2*PHI)) ,
00175      &                    (A1*A1 + A2*A2*COS(2*PHI)) ) / 2.D0
00176           XU1 = A1 * COS ( TETA01)
00177           XV1 = A2 * COS ( TETA01 - PHI )
00178           XU2 = -A1 * SIN ( TETA01)
00179           XV2 = -A2 * SIN ( TETA01 - PHI )
00180           D1 = XU1*XU1 + XV1*XV1
00181           D2 = XU2*XU2 + XV2*XV2
00182           IF (D2.GT.D1) THEN
00183              TETA01 = TETA01 + PI/2.D0
00184              XU1    = XU2
00185              XV1    = XV2
00186           ENDIF
00187           WT0    = TETA01 + PHI1
00188           ALPHA0 = ATAN2( XV1,XU1 )
00189         ENDIF
00190         INCI%R(I)  = ALPHA0
00191         T2%R(I) = WT0
00192       ENDDO
00193 !
00194 ! FREE SURFACE IN PHASE WITH ALPHA0
00195 ! INCIDENCE IS CONSIDERED POSITIVE WHEN THE FREE SURFACE IS
00196 ! POSITIVE.
00197 !
00198       DO I=1,NPOIN
00199         A1 = -(PHII%R(I)*COS(T2%R(I))-PHIR%R(I)*SIN(T2%R(I)))
00200         IF (A1.LT.0.D0) THEN
00201           IF (INCI%R(I).GE.0.D0) THEN
00202             INCI%R(I) = INCI%R(I) - PI
00203           ELSE
00204             INCI%R(I) = INCI%R(I) + PI
00205           ENDIF
00206         ENDIF
00207       ENDDO
00208 
00209 
00210 !=======================================================================
00211 !
00212       RETURN
00213       END

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