conwac.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\tomawac\conwac.f
00002 !
00067                      SUBROUTINE CONWAC
00068 !                    *****************
00069 !
00070      &( CX    , CY    , CT    , XK    , CG    , COSF  , TGF   , DEPTH ,
00071      &  DZX   , DZY   , FREQ  , COSTET, SINTET, NPOIN2, NPLAN , JF    ,
00072      &  NF    , PROINF, SPHE  , PROMIN, TRA01 )
00073 !
00074 !***********************************************************************
00075 ! TOMAWAC   V6P3                                   14/068/2011
00076 !***********************************************************************
00077 !
00078 !
00079 !
00080 !
00081 !
00082 !
00083 !
00084 !
00085 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00086 !| CG             |-->| DISCRETIZED GROUP VELOCITY
00087 !| COSF           |-->| COSINE OF THE LATITUDES OF THE POINTS 2D
00088 !| COSTET         |-->| COSINE OF TETA ANGLE
00089 !| CY             |<--| ADVECTION FIELD ALONG X(OR PHI)
00090 !| CX             |<--| ADVECTION FIELD ALONG Y(OR LAMBDA)
00091 !| CT             |<--| ADVECTION FIELD ALONG TETA
00092 !| DEPTH          |-->| WATER DEPTH
00093 !| DZY            |-->| SEA BOTTOM SLOPE ALONG X
00094 !| DZX            |-->| SEA BOTTOM SLOPE ALONG Y
00095 !| FREQ           |-->| DISCRETIZED FREQUENCIES
00096 !| JF             |-->| INDEX OF THE FREQUENCX
00097 !| NF             |-->| NUMBER OF FREQUENCIES
00098 !| NPLAN          |-->| NUMBER OF DIRECTIONS
00099 !| NPOIN2         |-->| NUMBER OF POINTS IN 2D MESH
00100 !| PROINF         |-->| LOGICAL INDICATING INFINITE DEPTH ASSUMPTION
00101 !| PROMIN         |-->| MINIMUM VALUE OF WATER DEPTH
00102 !| SINTET         |-->| SINE OF TETA ANGLE
00103 !| SPHE           |-->| LOGICAL INDICATING SPHERICAL COORD ASSUMPTION
00104 !| TGF            |-->| TANGENT OF THE LATITUDES OF THE POINTS 2D
00105 !| TRA01          |<->| WORK TABLE
00106 !| XK             |-->| DISCRETIZED WAVE NUMBER
00107 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00108 !
00109       USE DECLARATIONS_TOMAWAC, ONLY : GRADEG,DEUPI,SR,GRAVIT
00110 !
00111       IMPLICIT NONE
00112 !
00113       INTEGER LNG,LU
00114       COMMON/INFO/LNG,LU
00115 !
00116 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00117 !
00118       INTEGER, INTENT(IN)             :: NF,NPLAN,NPOIN2,JF
00119       DOUBLE PRECISION, INTENT(IN)    :: PROMIN
00120       DOUBLE PRECISION, INTENT(IN)    :: DEPTH(NPOIN2)
00121       DOUBLE PRECISION, INTENT(IN)    :: DZY(NPOIN2),DZX(NPOIN2)
00122       DOUBLE PRECISION, INTENT(IN)    :: COSF(NPOIN2),TGF(NPOIN2)
00123       DOUBLE PRECISION, INTENT(IN)    :: FREQ(NF)
00124       DOUBLE PRECISION, INTENT(IN)    :: COSTET(NPLAN),SINTET(NPLAN)
00125       DOUBLE PRECISION, INTENT(INOUT) :: TRA01(NPOIN2)
00126       DOUBLE PRECISION, INTENT(IN)    :: CG(NPOIN2,NF),XK(NPOIN2,NF)
00127       DOUBLE PRECISION, INTENT(INOUT) :: CY(NPOIN2,NPLAN)
00128       DOUBLE PRECISION, INTENT(INOUT) :: CX(NPOIN2,NPLAN)
00129       DOUBLE PRECISION, INTENT(INOUT) :: CT(NPOIN2,NPLAN)
00130       LOGICAL, INTENT(IN)             :: PROINF,SPHE
00131 !
00132 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00133 !
00134       INTEGER JP,IP
00135       DOUBLE PRECISION GSQP,SRCF,TFSR,DDDN,DEUKD,TR1,TR2
00136 !
00137       GSQP=GRAVIT/(2.D0*DEUPI)
00138 !
00139       IF(PROINF) THEN
00140 !
00141 !-----------------------------------------------------------------------
00142 !     INFINITE WATER DEPTH ...
00143 !-----------------------------------------------------------------------
00144 !
00145         IF(.NOT.SPHE) THEN
00146 !
00147 !       ----------------------------------------------------------------
00148 !       ... AND IN CARTESIAN COORDINATE SYSTEM
00149 !       ----------------------------------------------------------------
00150 !
00151           DO JP=1,NPLAN
00152             TR1=GSQP/FREQ(JF)*COSTET(JP)
00153             TR2=GSQP/FREQ(JF)*SINTET(JP)
00154             DO IP=1,NPOIN2
00155               CY(IP,JP)=TR1
00156               CX(IP,JP)=TR2
00157               CT(IP,JP)=0.D0
00158             ENDDO
00159           ENDDO
00160 !
00161         ELSE
00162 !
00163 !       ----------------------------------------------------------------
00164 !       ... AND IN SPHERICAL COORDINATE SYSTEM
00165 !       ----------------------------------------------------------------
00166 !
00167           DO JP=1,NPLAN
00168             TR1=GSQP/FREQ(JF)*COSTET(JP)
00169             TR2=GSQP/FREQ(JF)*SINTET(JP)
00170             DO IP=1,NPOIN2
00171               SRCF=SR/COSF(IP)
00172               TFSR=TGF(IP)*SR
00173               CY(IP,JP)=TR1*SR*GRADEG
00174               CX(IP,JP)=TR2*SRCF*GRADEG
00175               CT(IP,JP)=TR2*TFSR
00176             ENDDO
00177           ENDDO
00178 !
00179         ENDIF
00180 !
00181       ELSE
00182 !
00183 !-----------------------------------------------------------------------
00184 !     FINITE WATER DEPTH ....
00185 !-----------------------------------------------------------------------
00186 !
00187         DO IP=1,NPOIN2
00188           DEUKD=2.D0*XK(IP,JF)*DEPTH(IP)
00189           IF(DEUKD.GT.7.D2) THEN
00190             TRA01(IP)=0.D0
00191           ELSE
00192             TRA01(IP)=DEUPI*FREQ(JF)/SINH(DEUKD)
00193           ENDIF
00194         ENDDO
00195 !
00196         IF(.NOT.SPHE) THEN
00197 !
00198 !       ----------------------------------------------------------------
00199 !       ... AND IN CARTESIAN COORDINATE SYSTEM
00200 !       ----------------------------------------------------------------
00201 !
00202           DO JP=1,NPLAN
00203             DO IP=1,NPOIN2
00204               IF(DEPTH(IP).GT.PROMIN) THEN
00205                 DDDN=-SINTET(JP)*DZY(IP)+COSTET(JP)*DZX(IP)
00206                 CY(IP,JP)=CG(IP,JF)*COSTET(JP)
00207                 CX(IP,JP)=CG(IP,JF)*SINTET(JP)
00208                 CT(IP,JP)=-TRA01(IP)*DDDN
00209               ELSE
00210                 CY(IP,JP)=0.D0
00211                 CX(IP,JP)=0.D0
00212                 CT(IP,JP)=0.D0
00213               ENDIF
00214             ENDDO
00215           ENDDO
00216 !
00217         ELSE
00218 !
00219 !       ----------------------------------------------------------------
00220 !       ... AND IN SPHERICAL COORDINATE SYSTEM
00221 !       ----------------------------------------------------------------
00222 !
00223           DO JP=1,NPLAN
00224             DO IP=1,NPOIN2
00225               IF(DEPTH(IP).GT.PROMIN) THEN
00226                 SRCF=SR/COSF(IP)
00227                 TFSR=SR*TGF(IP)
00228                 DDDN=-SINTET(JP)*DZY(IP)*SR+COSTET(JP)*DZX(IP)*SRCF
00229                 CY(IP,JP)=(CG(IP,JF)*COSTET(JP))*SR*GRADEG
00230                 CX(IP,JP)=(CG(IP,JF)*SINTET(JP))*SRCF*GRADEG
00231                 CT(IP,JP)=CG(IP,JF)*SINTET(JP)*TFSR
00232      &                   -TRA01(IP)*DDDN*GRADEG
00233               ELSE
00234                 CY(IP,JP)=0.0D0
00235                 CX(IP,JP)=0.0D0
00236                 CT(IP,JP)=0.0D0
00237               ENDIF
00238             ENDDO
00239           ENDDO
00240 !
00241         ENDIF
00242 !
00243       ENDIF
00244 !
00245 !-----------------------------------------------------------------------
00246 !
00247       RETURN
00248       END

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