conw4d.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\tomawac\conw4d.f
00002 !
00073                      SUBROUTINE CONW4D
00074 !                    *****************
00075 !
00076      &(CX,CY,CT,CF,U,V,XK,CG,COSF,TGF,DEPTH,DZHDT,DZY,DZX,DVY,DVX,
00077      & DUY,DUX,FREQ,COSTET,SINTET,NPOIN2,NPLAN,JF,NF,PROINF,SPHE,
00078      & MAREE,TRA01)
00079 !
00080 !***********************************************************************
00081 ! TOMAWAC   V7P0                                   14/06/2011
00082 !***********************************************************************
00083 !
00084 !
00085 !
00086 !
00087 !
00088 !
00089 !
00090 !
00091 !
00092 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00093 !| CG             |-->| DISCRETIZED GROUP VELOCITY
00094 !| COSF           |-->| COSINE OF THE LATITUDES OF THE POINTS 2D
00095 !| COSTET         |-->| COSINE OF TETA ANGLE
00096 !| CT             |<--| ADVECTION FIELD ALONG TETA
00097 !| CY             |<--| ADVECTION FIELD ALONG X(OR PHI)
00098 !| CX             |<--| ADVECTION FIELD ALONG Y(OR LAMBDA)
00099 !| CF             |<--| ADVECTION FIELD ALONG FREQUENCX
00100 !| DEPTH          |-->| WATER DEPTH
00101 !| DVY            |-->| DERIVATIVE OF CURRENT SPEED DU/DX
00102 !| DVX            |-->| DERIVATIVE OF CURRENT SPEED DU/DY
00103 !| DUY            |-->| DERIVATIVE OF CURRENT SPEED DV/DX
00104 !| DUX            |-->| DERIVATIVE OF CURRENT SPEED DV/DY
00105 !| DZHDT          |-->| WATER DEPTH DERIVATIVE WITH RESPECT TO T
00106 !| DZY            |-->| SEA BOTTOM SLOPE ALONG X
00107 !| DZX            |-->| SEA BOTTOM SLOPE ALONG Y
00108 !| FREQ           |-->| DISCRETIZED FREQUENCIES
00109 !| JF             |-->| INDEX OF THE FREQUENCX
00110 !| NF             |-->| NUMBER OF FREQUENCIES
00111 !| NPLAN          |-->| NUMBER OF DIRECTIONS
00112 !| NPOIN2         |-->| NUMBER OF POINTS IN 2D MESH
00113 !| PROINF         |-->| LOGICAL INDICATING INFINITE DEPTH ASSUMPTION
00114 !| SINTET         |-->| SINE OF TETA ANGLE
00115 !| SPHE           |-->| LOGICAL INDICATING SPHERICAL COORD ASSUMPTION
00116 !| TGF            |-->| TANGENT OF THE LATITUDES OF THE POINTS 2D
00117 !| TRA01          |<->| WORK TABLE
00118 !| V           |-->| CURRENT SPEED ALONG X
00119 !| U           |-->| CURRENT SPEED ALONG Y
00120 !| XK             |-->| DISCRETIZED WAVE NUMBER
00121 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00122 !
00123       USE DECLARATIONS_TOMAWAC, ONLY : DEUPI,USDPI,SR,GRADEG,GRAVIT
00124 !
00125       IMPLICIT NONE
00126 !
00127       INTEGER LNG,LU
00128       COMMON/INFO/ LNG,LU
00129 !
00130 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00131 !
00132       INTEGER, INTENT(IN)             :: NF,NPLAN,NPOIN2,JF
00133 !
00134       DOUBLE PRECISION, INTENT(INOUT) :: CY(NPOIN2,NPLAN,JF)
00135       DOUBLE PRECISION, INTENT(INOUT) :: CX(NPOIN2,NPLAN,JF)
00136       DOUBLE PRECISION, INTENT(INOUT) :: CT(NPOIN2,NPLAN,JF)
00137       DOUBLE PRECISION, INTENT(INOUT) :: CF(NPOIN2,NPLAN,JF)
00138       DOUBLE PRECISION, INTENT(IN)    :: FREQ(NF)
00139       DOUBLE PRECISION, INTENT(IN)    :: CG(NPOIN2,NF),XK(NPOIN2,NF)
00140       DOUBLE PRECISION, INTENT(IN)    :: DEPTH(NPOIN2),DZHDT(NPOIN2)
00141       DOUBLE PRECISION, INTENT(IN)    :: V(NPOIN2),U(NPOIN2)
00142       DOUBLE PRECISION, INTENT(IN)    :: DZY(NPOIN2),DZX(NPOIN2)
00143       DOUBLE PRECISION, INTENT(IN)    :: DVY(NPOIN2),DVX(NPOIN2)
00144       DOUBLE PRECISION, INTENT(IN)    :: DUY(NPOIN2),DUX(NPOIN2)
00145       DOUBLE PRECISION, INTENT(IN)    :: COSTET(NPLAN),SINTET(NPLAN)
00146       DOUBLE PRECISION, INTENT(IN)    :: COSF(NPOIN2),TGF(NPOIN2)
00147       DOUBLE PRECISION, INTENT(INOUT) :: TRA01(NPOIN2)
00148       LOGICAL, INTENT(IN)             :: PROINF,SPHE,MAREE
00149 !
00150 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00151 !
00152       INTEGER IP,IPOIN
00153       DOUBLE PRECISION GSQP,SRCF,TFSR,DDDN,LSDUDN,LSDUDS
00154       DOUBLE PRECISION USGD,DEUKD,TR1,TR2
00155 !
00156 !***********************************************************************
00157 !
00158       GSQP=GRAVIT/(2.D0*DEUPI)
00159 !
00160 !-----------------------------------------------------------------------
00161 !     INFINITE WATER DEPTH ...
00162 !-----------------------------------------------------------------------
00163 !
00164       IF(PROINF) THEN
00165 !
00166 !       ----------------------------------------------------------------
00167 !       ... AND IN CARTESIAN COORDINATE SYSTEM
00168 !       ----------------------------------------------------------------
00169 !
00170         IF(.NOT.SPHE) THEN
00171 !
00172           DO IP=1,NPLAN
00173             TR1=GSQP/FREQ(JF)*COSTET(IP)
00174             TR2=GSQP/FREQ(JF)*SINTET(IP)
00175             DO IPOIN=1,NPOIN2
00176               LSDUDN= SINTET(IP)*
00177      &              (-COSTET(IP)*DVY(IPOIN)-SINTET(IP)*DUY(IPOIN))
00178      &              + COSTET(IP)*
00179      &              ( COSTET(IP)*DVX(IPOIN)+SINTET(IP)*DUX(IPOIN))
00180               LSDUDS= COSTET(IP)*
00181      &               (COSTET(IP)*DVY(IPOIN)+SINTET(IP)*DUY(IPOIN))
00182      &              + SINTET(IP)*
00183      &               (COSTET(IP)*DVX(IPOIN)+SINTET(IP)*DUX(IPOIN))
00184               CY(IPOIN,IP,JF)=TR1+V(IPOIN)
00185               CX(IPOIN,IP,JF)=TR2+U(IPOIN)
00186               CT(IPOIN,IP,JF)=-LSDUDN
00187               CF(IPOIN,IP,JF)=-CG(IPOIN,JF)*XK(IPOIN,JF)*LSDUDS*USDPI
00188             ENDDO
00189           ENDDO
00190 !
00191 !       ----------------------------------------------------------------
00192 !       ... AND IN SPHERICAL COORDINATE SYSTEM
00193 !       ----------------------------------------------------------------
00194 !
00195         ELSE
00196 !
00197           DO IP=1,NPLAN
00198             TR1=GSQP/FREQ(JF)*COSTET(IP)
00199             TR2=GSQP/FREQ(JF)*SINTET(IP)
00200             DO IPOIN=1,NPOIN2
00201               SRCF=SR/COSF(IPOIN)
00202               LSDUDN= SINTET(IP)*SR*
00203      &               (-COSTET(IP)*DVY(IPOIN)-SINTET(IP)*DUY(IPOIN))
00204      &               + COSTET(IP)*SRCF*
00205      &               ( COSTET(IP)*DVX(IPOIN)+SINTET(IP)*DUX(IPOIN))
00206               LSDUDS= COSTET(IP)*SR*
00207      &               (COSTET(IP)*DVY(IPOIN)+SINTET(IP)*DUY(IPOIN))
00208      &              + SINTET(IP)*SRCF*
00209      &               (COSTET(IP)*DVX(IPOIN)+SINTET(IP)*DUX(IPOIN))
00210               CY(IPOIN,IP,JF)=(TR1+V(IPOIN))*GRADEG*SR
00211               CX(IPOIN,IP,JF)=(TR2+U(IPOIN))*GRADEG*SRCF
00212               CT(IPOIN,IP,JF)=TR2*TGF(IPOIN)*SR - LSDUDN*GRADEG
00213               CF(IPOIN,IP,JF)= - LSDUDS*GRADEG*
00214      &                        CG(IPOIN,JF)*XK(IPOIN,JF)*USDPI
00215             ENDDO
00216           ENDDO
00217         ENDIF
00218 !
00219 !-----------------------------------------------------------------------
00220 !     FINITE WATER DEPTH ....
00221 !-----------------------------------------------------------------------
00222 !
00223       ELSE
00224 !
00225 !       ----------------------------------------------------------------
00226 !       ... AND IN CARTESIAN COORDINATE SYSTEM
00227 !       ----------------------------------------------------------------
00228 !
00229         IF(.NOT.SPHE) THEN
00230 !
00231           DO IPOIN=1,NPOIN2
00232             DEUKD=2.D0*XK(IPOIN,JF)*DEPTH(IPOIN)
00233             IF(DEUKD.GT.7.D2) THEN
00234               TRA01(IPOIN) = 0.D0
00235             ELSE
00236               TRA01(IPOIN) = DEUPI*FREQ(JF)/SINH(DEUKD)
00237             ENDIF
00238           ENDDO
00239 !
00240           DO IP=1,NPLAN
00241             DO IPOIN=1,NPOIN2
00242               DDDN=-SINTET(IP)*DZY(IPOIN)+COSTET(IP)*DZX(IPOIN)
00243               CY(IPOIN,IP,JF)=CG(IPOIN,JF)*COSTET(IP)
00244               CX(IPOIN,IP,JF)=CG(IPOIN,JF)*SINTET(IP)
00245               CT(IPOIN,IP,JF)=-TRA01(IPOIN)*DDDN
00246             ENDDO
00247           ENDDO
00248 !
00249           DO IPOIN=1,NPOIN2
00250             DEUKD=2.D0*XK(IPOIN,JF)*DEPTH(IPOIN)
00251             IF(DEUKD.GT.7.D2) THEN
00252               TRA01(IPOIN)=0.D0
00253             ELSE
00254               TRA01(IPOIN)=XK(IPOIN,JF)*DEUPI*FREQ(JF)/SINH(DEUKD)
00255             ENDIF
00256           ENDDO
00257 !
00258           IF(MAREE) THEN
00259             DO IP=1,NPLAN
00260               DO IPOIN=1,NPOIN2
00261                 LSDUDN= SINTET(IP)*
00262      &               (-COSTET(IP)*DVY(IPOIN)-SINTET(IP)*DUY(IPOIN))
00263      &              + COSTET(IP)*
00264      &               ( COSTET(IP)*DVX(IPOIN)+SINTET(IP)*DUX(IPOIN))
00265                 LSDUDS= COSTET(IP)*
00266      &               (COSTET(IP)*DVY(IPOIN)+SINTET(IP)*DUY(IPOIN))
00267      &              + SINTET(IP)*
00268      &               (COSTET(IP)*DVX(IPOIN)+SINTET(IP)*DUX(IPOIN))
00269                 USGD=V(IPOIN)*DZY(IPOIN)+U(IPOIN)*DZX(IPOIN)
00270                 CY(IPOIN,IP,JF)=CY(IPOIN,IP,JF) + V(IPOIN)
00271                 CX(IPOIN,IP,JF)=CX(IPOIN,IP,JF) + U(IPOIN)
00272                 CT(IPOIN,IP,JF)=CT(IPOIN,IP,JF) - LSDUDN
00273                 CF(IPOIN,IP,JF)= (TRA01(IPOIN)*(USGD+DZHDT(IPOIN))
00274      &                 - LSDUDS*CG(IPOIN,JF)*XK(IPOIN,JF))*USDPI
00275               ENDDO
00276             ENDDO
00277           ELSE
00278 !           IDEM BUT DZHDT=0.D0
00279             DO IP=1,NPLAN
00280               DO IPOIN=1,NPOIN2
00281                 LSDUDN= SINTET(IP)*
00282      &               (-COSTET(IP)*DVY(IPOIN)-SINTET(IP)*DUY(IPOIN))
00283      &              + COSTET(IP)*
00284      &               ( COSTET(IP)*DVX(IPOIN)+SINTET(IP)*DUX(IPOIN))
00285                 LSDUDS= COSTET(IP)*
00286      &               (COSTET(IP)*DVY(IPOIN)+SINTET(IP)*DUY(IPOIN))
00287      &              + SINTET(IP)*
00288      &               (COSTET(IP)*DVX(IPOIN)+SINTET(IP)*DUX(IPOIN))
00289                 USGD=V(IPOIN)*DZY(IPOIN)+U(IPOIN)*DZX(IPOIN)
00290                 CY(IPOIN,IP,JF)=CY(IPOIN,IP,JF) + V(IPOIN)
00291                 CX(IPOIN,IP,JF)=CX(IPOIN,IP,JF) + U(IPOIN)
00292                 CT(IPOIN,IP,JF)=CT(IPOIN,IP,JF) - LSDUDN
00293                 CF(IPOIN,IP,JF)= (TRA01(IPOIN)*USGD
00294      &             - LSDUDS*CG(IPOIN,JF)*XK(IPOIN,JF))*USDPI
00295               ENDDO
00296             ENDDO
00297           ENDIF
00298 !
00299 !       --------------------------------------------------------------
00300 !       ... AND IN SPHERICAL COORDINATE SYSTEM
00301 !       --------------------------------------------------------------
00302 !
00303         ELSE
00304 !
00305           DO IPOIN=1,NPOIN2
00306             DEUKD=2.D0*XK(IPOIN,JF)*DEPTH(IPOIN)
00307             IF(DEUKD.GT.7.D2) THEN
00308               TRA01(IPOIN) = 0.D0
00309             ELSE
00310               TRA01(IPOIN) = DEUPI*FREQ(JF)/SINH(DEUKD)
00311             ENDIF
00312           ENDDO
00313 !
00314           DO IP=1,NPLAN
00315             DO IPOIN=1,NPOIN2
00316              SRCF=SR/COSF(IPOIN)
00317              TFSR=TGF(IPOIN)*SR
00318              DDDN=-SINTET(IP)*DZY(IPOIN)*SR+COSTET(IP)*DZX(IPOIN)*SRCF
00319              CY(IPOIN,IP,JF)=(CG(IPOIN,JF)*COSTET(IP))*SR*GRADEG
00320              CX(IPOIN,IP,JF)=(CG(IPOIN,JF)*SINTET(IP))*SRCF*GRADEG
00321              CT(IPOIN,IP,JF)=CG(IPOIN,JF)*SINTET(IP)*TFSR
00322      &                                  -TRA01(IPOIN)*DDDN*GRADEG
00323             ENDDO
00324           ENDDO
00325 !
00326           DO IPOIN=1,NPOIN2
00327             DEUKD=2.D0*XK(IPOIN,JF)*DEPTH(IPOIN)
00328             IF(DEUKD.GT.7.D2) THEN
00329               TRA01(IPOIN)=0.D0
00330             ELSE
00331               TRA01(IPOIN)=XK(IPOIN,JF)*DEUPI*FREQ(JF)/SINH(DEUKD)
00332             ENDIF
00333           ENDDO
00334 !
00335           IF(MAREE) THEN
00336             DO IP=1,NPLAN
00337               DO IPOIN=1,NPOIN2
00338                 SRCF=SR/COSF(IPOIN)
00339                 LSDUDN= SINTET(IP)*SR*
00340      &               (-COSTET(IP)*DVY(IPOIN)-SINTET(IP)*DUY(IPOIN))
00341      &              + COSTET(IP)*SRCF*
00342      &               ( COSTET(IP)*DVX(IPOIN)+SINTET(IP)*DUX(IPOIN))
00343                 LSDUDS= COSTET(IP)*SR*
00344      &               ( COSTET(IP)*DVY(IPOIN)+SINTET(IP)*DUY(IPOIN))
00345      &              + SINTET(IP)*SRCF*
00346      &               ( COSTET(IP)*DVX(IPOIN)+SINTET(IP)*DUX(IPOIN))
00347                 USGD=V(IPOIN)*DZY(IPOIN)*SR
00348      &              +U(IPOIN)*DZX(IPOIN)*SRCF
00349                 CY(IPOIN,IP,JF)=CY(IPOIN,IP,JF)+V(IPOIN)*SR*GRADEG
00350                 CX(IPOIN,IP,JF)=CX(IPOIN,IP,JF)+U(IPOIN)*SRCF*GRADEG
00351                 CT(IPOIN,IP,JF)=CT(IPOIN,IP,JF)-LSDUDN*GRADEG
00352                 CF(IPOIN,IP,JF)=
00353      &           (TRA01(IPOIN)*(USGD*GRADEG+DZHDT(IPOIN))
00354      &          -LSDUDS*GRADEG*CG(IPOIN,JF)*XK(IPOIN,JF))*USDPI
00355               ENDDO
00356             ENDDO
00357           ELSE
00358 !           IDEM BUT DZHDT=0.D0
00359             DO IP=1,NPLAN
00360               DO IPOIN=1,NPOIN2
00361                 SRCF=SR/COSF(IPOIN)
00362                 LSDUDN= SINTET(IP)*SR*
00363      &               (-COSTET(IP)*DVY(IPOIN)-SINTET(IP)*DUY(IPOIN))
00364      &              + COSTET(IP)*SRCF*
00365      &               ( COSTET(IP)*DVX(IPOIN)+SINTET(IP)*DUX(IPOIN))
00366                 LSDUDS= COSTET(IP)*SR*
00367      &               ( COSTET(IP)*DVY(IPOIN)+SINTET(IP)*DUY(IPOIN))
00368      &              + SINTET(IP)*SRCF*
00369      &               ( COSTET(IP)*DVX(IPOIN)+SINTET(IP)*DUX(IPOIN))
00370                 USGD=V(IPOIN)*DZY(IPOIN)*SR
00371      &              +U(IPOIN)*DZX(IPOIN)*SRCF
00372                 CY(IPOIN,IP,JF)=CY(IPOIN,IP,JF)+V(IPOIN)*SR*GRADEG
00373                 CX(IPOIN,IP,JF)=CX(IPOIN,IP,JF)+U(IPOIN)*SRCF*GRADEG
00374                 CT(IPOIN,IP,JF)=CT(IPOIN,IP,JF)-LSDUDN*GRADEG
00375                 CF(IPOIN,IP,JF)=(TRA01(IPOIN)*USGD
00376      &              -LSDUDS*CG(IPOIN,JF)*XK(IPOIN,JF))*GRADEG*USDPI
00377               ENDDO
00378             ENDDO
00379           ENDIF
00380 !
00381         ENDIF
00382 !
00383       ENDIF
00384 !
00385 !-----------------------------------------------------------------------
00386 !
00387       RETURN
00388       END

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