mesh_prop.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\telemac3d\mesh_prop.f
00002 !
00076                      SUBROUTINE MESH_PROP
00077 !                    ********************
00078 !
00079      &(HPROP,HN,H,PROLIN,HAULIN,TETA,NSOUSI,ZPROP,
00080      & IPBOT,NPOIN2,NPLAN,OPTBAN,SIGMAG,OPT_HNEG,
00081      & MDIFF,MESH3D,VOLU3D,VOLU3DPAR,UNSV3D,MSK,MASKEL,IELM3)
00082 !
00083 !***********************************************************************
00084 ! TELEMAC3D   V6P2                                   21/08/2010
00085 !***********************************************************************
00086 !
00087 !
00088 !
00089 !
00090 !
00091 !
00092 !
00093 !
00094 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00095 !| H              |-->| WATER DEPTH
00096 !| HAULIN         |-->| MEAN DEPTH FOR LINEARISATION
00097 !| HN             |-->| WATER DEPTH AT TIME N
00098 !| HPROP          |<->| PROPAGATION DEPTH (DONE IN CVDFTR)
00099 !| IELM3          |-->| TYPE OF ELEMENT
00100 !| IPBOT          |-->| PLANE NUMBER OF LAST CRUSHED PLANE (0 IF NONE)
00101 !| MASKEL         |-->| MASKING OF ELEMENTS
00102 !|                |   | =1. : NORMAL   =0. : MASKED ELEMENT
00103 !| MDIFF          |<->| MASS MATRIX
00104 !| MESH3D         |<->| 3D MESH
00105 !| MSK            |-->| IF YES, THERE IS MASKED ELEMENTS.
00106 !| NPLAN          |-->| NUMBER OF PLANES IN THE 3D MESH OF PRISMS
00107 !| NPOIN2         |-->| NUMBER OF POINTS IN 2D
00108 !| NSOUSI         |-->| SUB-ITERATIONS NUMBER
00109 !| OPTBAN         |-->| OPTION FOR TIDAL FLATS, IF 1, FREE SURFACE
00110 !|                |   | MODIFIED AND PIECE-WISE LINEAR
00111 !| OPT_HNEG       |-->| OPTION FOR NEGATIVE DEPTHS
00112 !| PROLIN         |-->| CORRESPOND TO KEYWORD "LINEARIZED PROPAGATON"
00113 !| SIGMAG         |-->| LOGICAL FOR GENERALISED SIGMA TRANSFORMATION
00114 !| TETA           |-->| SEMI-IMPLICITATION FOR H
00115 !| UNSV3D         |<->| INVERSE OF VOLUME OF BASIS FUNCTIONS
00116 !| VOLU3D         |<->| INTEGRAL OF TEST FUNCTIONS IN 3D
00117 !| VOLU3DPAR      |<->| VOLU3D FOR EACH DOMAIN IN PARALLEL MODE
00118 !| ZPROP          |<->| Z DURING PROPAGATION
00119 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00120 !
00121       USE BIEF
00122       USE DECLARATIONS_TELEMAC3D, ONLY : AGGLOH
00123 !
00124       IMPLICIT NONE
00125       INTEGER LNG,LU
00126       COMMON/INFO/LNG,LU
00127 !
00128 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00129 !
00130       INTEGER, INTENT(IN)            :: NSOUSI,NPOIN2,NPLAN,OPT_HNEG
00131       INTEGER, INTENT(IN)            :: OPTBAN,IELM3
00132       LOGICAL, INTENT(IN)            :: PROLIN,SIGMAG,MSK
00133       DOUBLE PRECISION, INTENT(IN)   :: TETA,HAULIN
00134       TYPE(BIEF_OBJ),   INTENT(IN)   :: HN,H,MASKEL
00135       TYPE(BIEF_OBJ),   INTENT(INOUT):: IPBOT
00136       TYPE(BIEF_OBJ),  INTENT(INOUT) :: HPROP,ZPROP,MDIFF,UNSV3D,VOLU3D
00137       TYPE(BIEF_OBJ),  INTENT(INOUT) :: VOLU3DPAR
00138       TYPE(BIEF_MESH), INTENT(INOUT) :: MESH3D
00139 !
00140 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00141 !
00142       DOUBLE PRECISION, POINTER, DIMENSION(:) :: SAVEZ
00143       DOUBLE PRECISION MINIMUM_VOLUME
00144       MINIMUM_VOLUME=1.D-6
00145 !
00146 !-----------------------------------------------------------------------
00147 !
00148       IF(PROLIN) THEN
00149         CALL OS( 'X=C     ' , X=HPROP , C=HAULIN    )
00150       ELSEIF(NSOUSI.EQ.1) THEN
00151         CALL OS( 'X=Y     ' , X=HPROP , Y=HN )
00152       ELSE
00153         CALL OS( 'X=CY    ' , X=HPROP , Y=HN , C=1.D0-TETA )
00154         CALL OS( 'X=X+CY  ' , X=HPROP , Y=H  , C= TETA )
00155       ENDIF
00156 !
00157 !-----------------------------------------------------------------------
00158 !
00159 !     CLIPS HPROP
00160 !
00161       IF(OPTBAN.EQ.1.AND.OPT_HNEG.NE.2) THEN
00162         CALL OS('X=+(Y,C)',X=HPROP,Y=HPROP,C=0.D0)
00163       ENDIF
00164 !
00165 !     COMPUTES THE NEW MESH
00166 !
00167       CALL CALCOT(ZPROP%R,HPROP%R)
00168 !
00169 !     COMPUTES THE REAL BOTTOM PLANE
00170 !
00171       CALL PLANE_BOTTOM(IPBOT%I,ZPROP%R,NPOIN2,NPLAN,SIGMAG,OPTBAN)
00172 !
00173 !     COMPUTES THE INVERSE OF VOLUME OF BASIS FUNCTIONS 3D IN UNSV3D
00174 !
00175 !     ZPROP IS TEMPORARILY PUT IN MESH3D%Z
00176 !
00177       SAVEZ     =>MESH3D%Z%R
00178       MESH3D%Z%R=>ZPROP%R
00179 !
00180 !     6.2 NEW COMPUTATION COMPATIBLE WITH CONTINUITY EQUATION
00181 !         LUMPING DONE LIKE FOR CONTINUITY EQUATIONS
00182 !
00183       CALL VECTOR(VOLU3D, '=', 'MASBAS          ',IELM3,1.D0-AGGLOH,
00184      &  ZPROP,ZPROP,ZPROP,ZPROP,ZPROP,ZPROP,MESH3D,.FALSE.,MASKEL)
00185       IF(AGGLOH.GT.1.D-6) THEN
00186         CALL VECTOR(VOLU3D, '+', 'MASBAS2         ',IELM3,AGGLOH,
00187      &  ZPROP,ZPROP,ZPROP,ZPROP,ZPROP,ZPROP,MESH3D,.FALSE.,MASKEL)
00188       ENDIF
00189 !
00190       IF(NCSIZE.GT.1) THEN
00191         CALL OS('X=Y     ',X=VOLU3DPAR,Y=VOLU3D)
00192         CALL PARCOM(VOLU3DPAR,2,MESH3D)
00193         CALL OS('X=1/Y   ',X=UNSV3D,Y=VOLU3DPAR,
00194      &          IOPT=2,INFINI=1.D0/MINIMUM_VOLUME,ZERO=MINIMUM_VOLUME)
00195 !               VERSION 6.1
00196 !    &          IOPT=2,INFINI=0.D0,ZERO=MINIMUM_VOLUME)
00197       ELSE
00198         CALL OS('X=1/Y   ',X=UNSV3D,Y=VOLU3D,
00199      &          IOPT=2,INFINI=1.D0/MINIMUM_VOLUME,ZERO=MINIMUM_VOLUME)
00200 !               VERSION 6.1
00201 !    &          IOPT=2,INFINI=0.D0,ZERO=MINIMUM_VOLUME)
00202       ENDIF
00203 !
00204 !     RESTORES Z
00205 !
00206       MESH3D%Z%R=>SAVEZ
00207 !
00208 !-----------------------------------------------------------------------
00209 !
00210       RETURN
00211       END

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