prepro.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\tomawac\prepro.f
00002 !
00072                      SUBROUTINE PREPRO
00073 !                    *****************
00074 !
00075      &( CX    , CY    , CT    , CF    , DT    , X     , Y     ,
00076      &  TETA  , COSTET, SINTET, FREQ  , IKLE2 , IFABOR, ETAP1 , TRA01 ,
00077      &  SHP   , SHZ   , SHF   , ELT   , ETA   , FRE   ,
00078      &  DEPTH , DZHDT , DZX   , DZY   , U     , V     , DUX   , DUY   ,
00079      &  DVX   , DVY   , XK    , CG    , COSF  , TGF   , ITR01 , NPOIN3,
00080      &  NPOIN2, NELEM2, NPLAN , NF    , SURDET, COURAN, SPHE  ,
00081      &  PROINF, PROMIN, MESH  , MESH3D, SIKLE2, TB,IELM3, DIFFRA,
00082      &  MAREE , ISUB)
00083 !
00084 !***********************************************************************
00085 ! TOMAWAC   V6P3                                   25/06/2012
00086 !***********************************************************************
00087 !
00088 !
00089 !
00090 !
00091 !
00092 !
00093 !
00094 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00095 !| CF             |<->| ADVECTION FIELD ALONG FREQUENCY
00096 !| CG             |-->| DISCRETIZED GROUP VELOCITY
00097 !| COSF           |-->| COSINE OF THE LATITUDES OF THE POINTS 2D
00098 !| COSTET         |-->| COSINE OF TETA ANGLE
00099 !| COURAN         |-->| LOGICAL INDICATING IF THERE IS A CURRENT
00100 !| CX             |<->| ADVECTION FIELD ALONG X(OR PHI)
00101 !| CY             |<->| ADVECTION FIELD ALONG Y(OR LAMBDA)
00102 !| CT             |<->| ADVECTION FIELD ALONG TETA
00103 !| DEPTH          |-->| WATER DEPTH
00104 !| DIFFRA         |-->| 0: NO DIFFRACTION  1: DIFFRACTION
00105 !| DT             |-->| TIME STEP
00106 !| DUX            |-->| DERIVATIVE OF CURRENT SPEED DU/DX
00107 !| DUY            |-->| DERIVATIVE OF CURRENT SPEED DU/DY
00108 !| DVX            |-->| DERIVATIVE OF CURRENT SPEED DV/DX
00109 !| DVY            |-->| DERIVATIVE OF CURRENT SPEED DV/DY
00110 !| DZHDT          |-->| WATER DEPTH DERIVATIVE WITH RESPECT TO T
00111 !| DZX            |-->| BOTTOM SLOPE ALONG X
00112 !| DZY            |-->| BOTTOM SLOPE ALONG Y
00113 !| ELT            |<->| NUMBERS OF THE ELEMENTS 2D OF THE
00114 !|                |   | POINTS TO BE ADVECTED
00115 !| ETA            |<->| NUMBERS OF THE LAYERS OF THE
00116 !|                |   | POINTS TO BE ADVECTED
00117 !| ETAP1          |<->| HIGHER LAYERS TABLE
00118 !| FRE            |<->| NUMBER OF THE FREQUENCIES OF THE
00119 !|                |   | POINTS TO BE ADVECTED
00120 !| FREQ           |-->| DISCRETIZED FREQUENCIES
00121 !| IELM3          |-->| TYPE OF 3D ELEMENT
00122 !| IFABOR         |-->| ELEMENTS BEHIND THE EDGES OF A TRIANGLE
00123 !|                |   | IF NEGATIVE OR ZERO, THE EDGE IS A LIQUID,
00124 !|                |   | SOLID OR PERIODIC BOUNDARY
00125 !| IKLE2          |-->| TRANSITION BETWEEN LOCAL AND GLOBAL NUMBERING
00126 !|                |   | OF THE 2D MESH
00127 !| ISUB           |<->| ARRIVAL SUB-DOMAIN OF CHARACTERISTICS
00128 !| ITR01          |<->| WORK TABLE
00129 !| MESH           |-->| 2D MESH
00130 !| MESH3D         |-->| 3D MESH
00131 !| NELEM2         |-->| NUMBER OF ELEMENTS IN 2D MESH
00132 !| NF             |-->| NUMBER OF FREQUENCIES
00133 !| NPLAN          |-->| NUMBER OF DIRECTIONS
00134 !| NPOIN2         |-->| NUMBER OF POINTS IN 2D MESH
00135 !| NPOIN3         |-->| NPOIN2*NPLAN
00136 !| PROINF         |-->| LOGICAL INDICATING INFINITE DEPTH ASSUMPTION
00137 !| PROMIN         |-->| MINIMUM VALUE OF WATER DEPTH
00138 !| SHF            |<->| BARYCENTRIC COORDINATES ALONG F OF THE
00139 !|                |   | NODES IN THEIR ASSOCIATED FREQUENCIES "FRE"
00140 !| SHP            |<->| BARYCENTRIC COORDINATES OF THE NODES IN
00141 !|                |   | THEIR ASSOCIATED 2D ELEMENT "ELT"
00142 !| SHZ            |<->| BARYCENTRIC COORDINATES ALONG TETA OF THE
00143 !|                |   | NODES IN THEIR ASSOCIATED LAYER "ETA"
00144 !| SIKLE2         |-->| IKLE2 IN A BIEF_OBJ STRUCTURE
00145 !| SINTET         |-->| SINE OF TETA ANGLE
00146 !| SPHE           |-->| LOGICAL INDICATING SPHERICAL COORD ASSUMPTION
00147 !| SURDET         |-->| 1/DET. OF ELEMENTS 2D FOR ISOPARAM. TRANSF.
00148 !| TETA           |-->| DISCRETIZED DIRECTIONS
00149 !| TGF            |-->| TANGENT OF THE LATITUDES OF THE POINTS 2D
00150 !| TRA01          |<->| WORK TABLE
00151 !| U              |-->| CURRENT SPEED ALONG X
00152 !| V              |-->| CURRENT SPEED ALONG Y
00153 !| X              |-->| ABSCISSAE OF POINTS IN THE MESH
00154 !| XK             |-->| DISCRETIZED WAVE NUMBER
00155 !| Y              |-->| ORDINATES OF POINTS IN THE MESH
00156 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00157 !
00158       USE BIEF
00159       USE INTERFACE_TOMAWAC, EX_PREPRO => PREPRO
00160 !
00161       IMPLICIT NONE
00162 !
00163       INTEGER LNG,LU
00164       COMMON/INFO/ LNG,LU
00165 !
00166 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00167 !
00168       INTEGER, INTENT(IN)    :: NPOIN3,NPOIN2,NELEM2,NPLAN,NF,DIFFRA
00169       INTEGER, INTENT(INOUT) :: IELM3
00170       DOUBLE PRECISION, INTENT(IN) :: DT,PROMIN
00171       DOUBLE PRECISION DZHDT(NPOIN2)
00172       DOUBLE PRECISION X(NPOIN2),Y(NPOIN2)
00173       DOUBLE PRECISION XK(NPOIN2,NF),CG(NPOIN2,NF)
00174       DOUBLE PRECISION SINTET(NPLAN),COSTET(NPLAN)
00175       DOUBLE PRECISION COSF(NPOIN2),TGF(NPOIN2)
00176       DOUBLE PRECISION DEPTH(NPOIN2),DZX(NPOIN2),DZY(NPOIN2)
00177       DOUBLE PRECISION U(NPOIN2),DUX(NPOIN2),DUY(NPOIN2)
00178       DOUBLE PRECISION V(NPOIN2),DVX(NPOIN2),DVY(NPOIN2)
00179       DOUBLE PRECISION SURDET(NELEM2)
00180       DOUBLE PRECISION, INTENT(INOUT) :: TRA01(NPOIN3,6)
00181       INTEGER, INTENT(INOUT) :: ELT(NPOIN3,NF),ETA(NPOIN3,NF)
00182       INTEGER, INTENT(INOUT) :: ISUB(NPOIN3,NF)
00183       INTEGER, INTENT(INOUT) :: FRE(NPOIN3,NF)
00184       INTEGER, INTENT(IN)    :: IKLE2(NELEM2,3)
00185       INTEGER, INTENT(IN)    :: ETAP1(NPLAN)
00186       INTEGER, INTENT(INOUT) :: ITR01(NPOIN3,3),IFABOR(NELEM2,7)
00187       LOGICAL, INTENT(IN)    :: COURAN,SPHE,PROINF,MAREE
00188       TYPE(BIEF_OBJ), INTENT(INOUT) :: SHP,SHZ,SHF,CX,CY,CT,CF,TB
00189       TYPE(BIEF_OBJ), INTENT(IN)    :: SIKLE2,TETA,FREQ
00190       TYPE(BIEF_MESH), INTENT(INOUT):: MESH,MESH3D
00191 !
00192 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00193 !
00194       INTEGER JF,IEL,I1,I2,I3
00195       TYPE(BIEF_OBJ) :: BID
00196       TYPE(SLVCFG) :: SLVBID
00197 !
00198 !----------------------------------------------------------------------
00199 !
00200       IF(.NOT.COURAN) THEN
00201 !
00202 !   -------------------------------------------------------------------
00203 !
00204 !   RELATIVE = ABSOLUTE => ADVECTION IN 3D
00205 !   SEPARATES OUT THE FREQUENCIES
00206 !
00207         DO JF=1,NF
00208 !
00209 !      ---------------------------------------------------------------
00210 !
00211 !      COMPUTES THE ADVECTION FIELD
00212 !
00213           CALL CONWAC
00214      &( CX%R  , CY%R  , CT%R , XK    , CG    , COSF  , TGF   , DEPTH ,
00215      &  DZX   , DZY   , FREQ%R , COSTET, SINTET, NPOIN2, NPLAN , JF  ,
00216      &  NF    , PROINF, SPHE , PROMIN, TRA01)
00217 !
00218 !      ----------------------------------------------------------------
00219 !
00220           DO IEL=1,NELEM2
00221             I1=IKLE2(IEL,1)
00222             I2=IKLE2(IEL,2)
00223             I3=IKLE2(IEL,3)
00224             IF(DEPTH(I1).LT.PROMIN.AND.DEPTH(I2).LT.PROMIN.AND.
00225      &         IFABOR(IEL,1).GT.0) IFABOR(IEL,1)=-1
00226             IF(DEPTH(I2).LT.PROMIN.AND.DEPTH(I3).LT.PROMIN.AND.
00227      &         IFABOR(IEL,2).GT.0) IFABOR(IEL,2)=-1
00228             IF(DEPTH(I3).LT.PROMIN.AND.DEPTH(I1).LT.PROMIN.AND.
00229      &         IFABOR(IEL,3).GT.0) IFABOR(IEL,3)=-1
00230           ENDDO
00231 !
00232           WRITE(LU,*) 'FREQUENCE :',JF
00233 !
00234           CALL CHARAC(SHZ%ADR(JF)%P,SHZ%ADR(JF)%P,0,
00235      &            CX,CY,CT,CT,TETA,TETA,DT,MESH3D%IFABOR,IELM3,
00236      &            NPOIN2,NPLAN,1,1,.FALSE.,BID,SHP%ADR(JF)%P,
00237      &            SHZ%ADR(JF)%P,SHZ%ADR(JF)%P,TB,
00238      &            ELT(1,JF),ETA(1,JF),ETA(1,JF),ITR01,
00239      &            ISUB(1,JF),ITR01(1,2),MESH3D,NELEM2,NELEM2,
00240      &            SIKLE2,
00241      &            MESH%SURDET,
00242      &            BID,BID,SLVBID,0.D0,.FALSE.,3,BID,1,
00243 !                 A POSTERIORI INTERPOLATION
00244      &            .TRUE.,
00245 !                 AND PERIODICITY
00246      &            .TRUE.)
00247 !
00248         ENDDO ! JF
00249 !
00250       ELSE
00251 !
00252 !   ---------------------------------------------------------------
00253 !
00254 !   IN A RELATIVE REFERENCE SYSTEM => ADVECTION IN 4D
00255 !   IT IS NO LONGER POSSIBLE TO SEPARATE THE FREQUENCIES OUT
00256 !
00257         DO JF=1,NF
00258 !
00259           CALL CONW4D(CX%R,CY%R,CT%R,CF%R,
00260      &                U,V,XK,CG,COSF,TGF,DEPTH,DZHDT,DZY,DZX,DVY,DVX,
00261      &                DUY,DUX,FREQ%R,COSTET,SINTET,NPOIN2,NPLAN,
00262      &                JF,NF,PROINF,SPHE,MAREE,TRA01)
00263 !
00264         ENDDO
00265 !
00266         DO JF=1,NF
00267 !
00268           CALL CHARAC(SHZ%ADR(JF)%P,SHZ%ADR(JF)%P,0,
00269      &                CX,CY,CT,CF,TETA,FREQ,DT,MESH3D%IFABOR,IELM3,
00270      &                NPOIN2,NPLAN,JF,NF,.FALSE.,BID,SHP%ADR(JF)%P,
00271      &                SHZ%ADR(JF)%P,SHF%ADR(JF)%P,TB,
00272      &                ELT(1,JF),ETA(1,JF),FRE(1,JF),ITR01,
00273      &                ISUB(1,JF),ITR01(1,2),MESH3D,NELEM2,NELEM2,
00274      &                SIKLE2,MESH%SURDET,
00275      &                BID,BID,SLVBID,0.D0,.FALSE.,3,BID,1,
00276 !                     A POSTERIORI INTERPOLATION
00277      &                .TRUE.,
00278 !                     AND PERIODICITY
00279      &                .TRUE.,
00280 !                     AND 4D
00281      &                .TRUE.)
00282 !
00283         ENDDO
00284 !
00285       ENDIF
00286 !
00287 !----------------------------------------------------------------------
00288 !
00289       RETURN
00290       END

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