bypass_crushed_points_ebe.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\telemac3d\bypass_crushed_points_ebe.f
00002 !
00084                      SUBROUTINE BYPASS_CRUSHED_POINTS_EBE
00085 !                    ************************************
00086 !
00087      &(VOLU,SVOLU,VOLUN,SVOLUN,FLUX,TRA01,MESH2,MESH3,
00088      & NPOIN3,NELEM2,NELEM3,NPLAN,IKLE)
00089 !
00090 !***********************************************************************
00091 ! TELEMAC3D   V6P2                                   21/08/2010
00092 !***********************************************************************
00093 !
00094 !
00095 !
00096 !
00097 !
00098 !
00099 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00100 !| FLUX           |<->| FLUXES TO BE CHANGED
00101 !| IKLE           |-->| CONNECTIVITY TABLE
00102 !| MESH2          |<->| 2D MESH
00103 !| MESH3          |<->| 3D MESH
00104 !| NELEM2         |-->| NUMBER OF ELEMENTS IN 2D
00105 !| NELEM3         |-->| NUMBER OF ELEMENTS IN 3D
00106 !| NPLAN          |-->| NUMBER OF PLANES IN THE 3D MESH OF PRISMS
00107 !| NPOIN3         |-->| NUMBER OF 3D POINTS
00108 !| SVOLU          |-->| BIEF_OBJ STRUCTURE, WITH SVOLU%R=VOLU
00109 !| SVOLUN         |-->| BIEF_OBJ STRUCTURE, WITH SVOLUN%R=VOLUN
00110 !| TRA01          |<->| WORK BIEF_OBJ STRUCTURE
00111 !| VOLU           |-->| VOLUME AROUND POINTS AT TIME N+1
00112 !| VOLUN          |-->| VOLUME AROUND POINTS AT TIME N
00113 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00114 !
00115       USE BIEF
00116       USE DECLARATIONS_TELEMAC
00117 !
00118       IMPLICIT NONE
00119       INTEGER LNG,LU
00120       COMMON/INFO/LNG,LU
00121 !
00122 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00123 !
00124       INTEGER, INTENT(IN)             :: NPOIN3,NELEM3,NELEM2,NPLAN
00125       INTEGER, INTENT(IN)             :: IKLE(NELEM3,6)
00126 !
00127       DOUBLE PRECISION, INTENT(IN)    :: VOLUN(NPOIN3),VOLU(NPOIN3)
00128 !
00129       TYPE(BIEF_OBJ), INTENT(IN)      :: SVOLU,SVOLUN
00130       TYPE(BIEF_OBJ), INTENT(INOUT)   :: TRA01
00131       TYPE(BIEF_MESH), INTENT(INOUT)  :: MESH2,MESH3
00132 !
00133       DOUBLE PRECISION, INTENT(INOUT) :: FLUX(30,NELEM3)
00134 !
00135 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00136 !
00137       INTEGER IELEM2,IELEM3,I,I1,I2,I3,I4,I5,I6,IPLAN
00138 !
00139 !-----------------------------------------------------------------------
00140 !
00141       DOUBLE PRECISION EPS_VOLUME
00142       DATA EPS_VOLUME /1.D-14/
00143 !
00144 !-----------------------------------------------------------------------
00145 !
00146 !     TRA01=VOLU+VOLUN=0 MEANS THAT BOTH VOLU AND VOLUN ARE EQUAL TO 0
00147 !
00148       CALL OS('X=Y+Z   ',X=TRA01,Y=SVOLU,Z=SVOLUN)
00149 !
00150       IF(NCSIZE.GT.1) THEN
00151         CALL PARCOM(TRA01,2,MESH3)
00152       ENDIF
00153 !
00154 !     GROUPS FLUXES
00155 !
00156       DO IELEM3=1,NELEM3
00157         DO I=1,15
00158           FLUX(I,IELEM3)=FLUX(I,IELEM3)-FLUX(I+15,IELEM3)
00159         ENDDO
00160       ENDDO
00161 !
00162 !     BYPASSES FLUXES
00163 !
00164       DO IELEM2=1,NELEM2
00165         DO IPLAN=1,NPLAN-1
00166           IELEM3=IELEM2+(IPLAN-1)*NELEM2
00167           I1=IKLE(IELEM3,1)
00168           I2=IKLE(IELEM3,2)
00169           I3=IKLE(IELEM3,3)
00170 !
00171           IF(TRA01%R(I1).LT.EPS_VOLUME.OR.
00172      &       TRA01%R(I2).LT.EPS_VOLUME.OR.
00173      &       TRA01%R(I3).LT.EPS_VOLUME    ) THEN
00174 !
00175           I4=IKLE(IELEM3,4)
00176           I5=IKLE(IELEM3,5)
00177           I6=IKLE(IELEM3,6)
00178 !
00179 !         STEP 1: DIVERTING CROSSED SEGMENTS
00180 !
00181 !         ISSUED FROM 1
00182           IF(TRA01%R(I1).LT.EPS_VOLUME.OR.
00183      &       TRA01%R(I5).LT.EPS_VOLUME) THEN
00184             FLUX(13,IELEM3)=FLUX(13,IELEM3)+FLUX(04,IELEM3)
00185             FLUX(03,IELEM3)=FLUX(03,IELEM3)+FLUX(04,IELEM3)
00186             FLUX(04,IELEM3)=0.D0
00187           ENDIF
00188           IF(TRA01%R(I1).LT.EPS_VOLUME.OR.
00189      &       TRA01%R(I6).LT.EPS_VOLUME) THEN
00190             FLUX(14,IELEM3)=FLUX(14,IELEM3)+FLUX(05,IELEM3)
00191             FLUX(03,IELEM3)=FLUX(03,IELEM3)+FLUX(05,IELEM3)
00192             FLUX(05,IELEM3)=0.D0
00193           ENDIF
00194 !         ISSUED FROM 2
00195           IF(TRA01%R(I2).LT.EPS_VOLUME.OR.
00196      &       TRA01%R(I4).LT.EPS_VOLUME) THEN
00197             FLUX(13,IELEM3)=FLUX(13,IELEM3)-FLUX(07,IELEM3)
00198             FLUX(08,IELEM3)=FLUX(08,IELEM3)+FLUX(07,IELEM3)
00199             FLUX(07,IELEM3)=0.D0
00200           ENDIF
00201           IF(TRA01%R(I2).LT.EPS_VOLUME.OR.
00202      &       TRA01%R(I6).LT.EPS_VOLUME) THEN
00203             FLUX(15,IELEM3)=FLUX(15,IELEM3)+FLUX(09,IELEM3)
00204             FLUX(08,IELEM3)=FLUX(08,IELEM3)+FLUX(09,IELEM3)
00205             FLUX(09,IELEM3)=0.D0
00206           ENDIF
00207 !         ISSUED FROM 3
00208           IF(TRA01%R(I3).LT.EPS_VOLUME.OR.
00209      &       TRA01%R(I4).LT.EPS_VOLUME) THEN
00210             FLUX(14,IELEM3)=FLUX(14,IELEM3)-FLUX(10,IELEM3)
00211             FLUX(12,IELEM3)=FLUX(12,IELEM3)+FLUX(10,IELEM3)
00212             FLUX(10,IELEM3)=0.D0
00213           ENDIF
00214           IF(TRA01%R(I3).LT.EPS_VOLUME.OR.
00215      &       TRA01%R(I5).LT.EPS_VOLUME) THEN
00216             FLUX(15,IELEM3)=FLUX(15,IELEM3)-FLUX(11,IELEM3)
00217             FLUX(12,IELEM3)=FLUX(12,IELEM3)+FLUX(11,IELEM3)
00218             FLUX(11,IELEM3)=0.D0
00219           ENDIF
00220 !
00221 !         STEP 2: LOWER HORIZONTAL SEGMENTS
00222 !
00223           IF(TRA01%R(I1).LT.EPS_VOLUME) THEN
00224 !           ISSUED FROM 1
00225             FLUX(13,IELEM3)=FLUX(13,IELEM3)+FLUX(01,IELEM3)
00226             FLUX(14,IELEM3)=FLUX(14,IELEM3)+FLUX(02,IELEM3)
00227             FLUX(03,IELEM3)=FLUX(03,IELEM3)+FLUX(01,IELEM3)
00228      &                                     +FLUX(02,IELEM3)
00229             FLUX(08,IELEM3)=FLUX(08,IELEM3)-FLUX(01,IELEM3)
00230             FLUX(12,IELEM3)=FLUX(12,IELEM3)-FLUX(02,IELEM3)
00231             FLUX(01,IELEM3)=0.D0
00232             FLUX(02,IELEM3)=0.D0
00233           ENDIF
00234           IF(TRA01%R(I2).LT.EPS_VOLUME) THEN
00235 !           ISSUED FROM 2
00236             FLUX(13,IELEM3)=FLUX(13,IELEM3)+FLUX(01,IELEM3)
00237             FLUX(15,IELEM3)=FLUX(15,IELEM3)+FLUX(06,IELEM3)
00238             FLUX(08,IELEM3)=FLUX(08,IELEM3)-FLUX(01,IELEM3)
00239      &                                     +FLUX(06,IELEM3)
00240             FLUX(03,IELEM3)=FLUX(03,IELEM3)+FLUX(01,IELEM3)
00241             FLUX(12,IELEM3)=FLUX(12,IELEM3)-FLUX(06,IELEM3)
00242             FLUX(01,IELEM3)=0.D0
00243             FLUX(06,IELEM3)=0.D0
00244           ENDIF
00245           IF(TRA01%R(I3).LT.EPS_VOLUME) THEN
00246 !           ISSUED FROM 3
00247             FLUX(15,IELEM3)=FLUX(15,IELEM3)+FLUX(06,IELEM3)
00248             FLUX(14,IELEM3)=FLUX(14,IELEM3)+FLUX(02,IELEM3)
00249             FLUX(12,IELEM3)=FLUX(12,IELEM3)-FLUX(06,IELEM3)
00250      &                                     -FLUX(02,IELEM3)
00251             FLUX(03,IELEM3)=FLUX(03,IELEM3)+FLUX(02,IELEM3)
00252             FLUX(08,IELEM3)=FLUX(08,IELEM3)+FLUX(06,IELEM3)
00253             FLUX(06,IELEM3)=0.D0
00254             FLUX(02,IELEM3)=0.D0
00255           ENDIF
00256 !
00257 !         STEP 3
00258 !
00259 !         THESE PROPERTIES SHOULD BE ENSURED AFTER ASSEMBLING
00260 !         (ONLY ONE VERTICAL FLUX REMAINS AND IT SHOULD BE ZERO
00261 !          BECAUSE THE VOLUME OF THE POINT REMAINS ZERO)
00262 !         BUT SMALL MASS ERROR IF 3 FOLLOWING LINES ARE DELETED (WHY ?)
00263 !         HINT: THIS COEFFICIENTS ARE CHANGED BY PSI SCHEME AND
00264 !               AFTER THIS TREATMENT IT COULD BE THAT THEY NO
00265 !               LONGER SUM TO 0 (BUT THIS CANNOT BE THE ONLY REASON,
00266 !               AS THE SAME BEHAVIOUR IS OBSERVED WITH N-SCHEME)
00267 !
00268           IF(TRA01%R(I1).LT.EPS_VOLUME) FLUX(03,IELEM3)=0.D0
00269           IF(TRA01%R(I2).LT.EPS_VOLUME) FLUX(08,IELEM3)=0.D0
00270           IF(TRA01%R(I3).LT.EPS_VOLUME) FLUX(12,IELEM3)=0.D0
00271 !
00272 !         STEP 4
00273 !
00274 !         UPPER HORIZONTAL SEGMENTS CANNOT BE TREATED
00275 !         NO DEGREE OF FREEDOM LEFT, THEY ARE TRANSFERRED
00276 !         TO UPPER LEVEL
00277 !         NOTE JMH: THIS DOES NOT CHANGE ASSEMBLED FLUXES, BUT COULD
00278 !                   CHANGE THE PSI SCHEME (PHIP AND PHIM IN MURD3D.F,
00279 !                   WHICH ARE DONE ELEMENT BY ELEMENT).
00280 !
00281           IF(IPLAN.NE.NPLAN-1) THEN
00282             FLUX(01,IELEM3+NELEM2)=FLUX(01,IELEM3+NELEM2)
00283      &                            +FLUX(13,IELEM3)
00284             FLUX(02,IELEM3+NELEM2)=FLUX(02,IELEM3+NELEM2)
00285      &                            +FLUX(14,IELEM3)
00286             FLUX(06,IELEM3+NELEM2)=FLUX(06,IELEM3+NELEM2)
00287      &                            +FLUX(15,IELEM3)
00288             FLUX(13,IELEM3)=0.D0
00289             FLUX(14,IELEM3)=0.D0
00290             FLUX(15,IELEM3)=0.D0
00291           ENDIF
00292 !
00293         ELSE
00294 !         NO MORE CRUSHED POINTS ABOVE, EXIT LOOP ON PLANES
00295           EXIT
00296         ENDIF
00297 !
00298         ENDDO
00299       ENDDO
00300 !
00301 !     UNGROUPS FLUXES
00302 !
00303       DO IELEM3=1,NELEM3
00304         DO I=1,15
00305           IF(FLUX(I,IELEM3).GT.0.D0) THEN
00306             FLUX(I+15,IELEM3)=0.D0
00307           ELSE
00308             FLUX(I+15,IELEM3)=-FLUX(I,IELEM3)
00309             FLUX(I,IELEM3)=0.D0
00310           ENDIF
00311         ENDDO
00312       ENDDO
00313 !
00314 !=======================================================================
00315 !
00316       RETURN
00317       END

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