bypass_crushed_points_seg.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\telemac3d\bypass_crushed_points_seg.f
00002 !
00074                      SUBROUTINE BYPASS_CRUSHED_POINTS_SEG
00075 !                    ************************************
00076 !
00077      &(VOLU,SVOLU,VOLUN,SVOLUN,FLUX,TRA01,MESH2,MESH3,
00078      & NPOIN3,SCHCF,NPOIN2,GLOSEG,DIMGLO,NSEG,NPLAN)
00079 !
00080 !***********************************************************************
00081 ! TELEMAC3D   V6P2                                   21/08/2010
00082 !***********************************************************************
00083 !
00084 !
00085 !
00086 !
00087 !
00088 !
00089 !
00090 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00091 !| DIMGLO         |-->| FIRST DIMENSION OF GLOSEG
00092 !| FLUX           |<->| FLUXES TO BE CHANGED
00093 !| GLOSEG         |-->| 3D LIST OF SEGMENTS POINTS
00094 !| MESH2          |<->| 2D MESH
00095 !| MESH3          |<->| 3D MESH
00096 !| NPLAN          |-->| NUMBER OF PLANES IN THE 3D MESH OF PRISMS
00097 !| NPOIN2         |-->| NUMBER OF POINTS IN 2D
00098 !| NPOIN3         |-->| NUMBER OF 3D POINTS
00099 !| NSEG           |-->| NUMBER OF SEGMENTS IN 2D
00100 !| SCHCF          |-->| ADVECTION SCHEME
00101 !| SVOLU          |-->| BIEF_OBJ STRUCTURE, WITH SVOLU%R=VOLU
00102 !| SVOLUN         |-->| BIEF_OBJ STRUCTURE, WITH SVOLUN%R=VOLUN
00103 !| TRA01          |<->| WORK BIEF_OBJ STRUCTURE
00104 !| VOLU           |-->| VOLUME AROUND POINTS AT TIME N+1
00105 !| VOLUN          |-->| VOLUME AROUND POINTS AT TIME N
00106 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00107 !
00108       USE BIEF
00109       USE DECLARATIONS_TELEMAC
00110 !
00111       IMPLICIT NONE
00112       INTEGER LNG,LU
00113       COMMON/INFO/LNG,LU
00114 !
00115 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00116 !
00117       INTEGER, INTENT(IN)             :: SCHCF,NPOIN3,NPOIN2
00118       INTEGER, INTENT(IN)             :: NSEG,NPLAN,DIMGLO
00119       INTEGER, INTENT(IN)             :: GLOSEG(DIMGLO,2)
00120 !
00121       DOUBLE PRECISION, INTENT(IN)    :: VOLUN(NPOIN3),VOLU(NPOIN3)
00122 !
00123       TYPE(BIEF_OBJ), INTENT(IN)      :: SVOLU,SVOLUN
00124       TYPE(BIEF_OBJ), INTENT(INOUT)   :: TRA01
00125       TYPE(BIEF_MESH), INTENT(INOUT)  :: MESH2,MESH3
00126 !
00127       DOUBLE PRECISION, INTENT(INOUT) :: FLUX(*)
00128 !
00129 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00130 !
00131       INTEGER NSEGH,NSEGV,IHOR
00132       INTEGER I1,I2,I3,I4,IPLAN,ISEG2D,ISEG3D,ICR1,ICR2,IS1
00133 !
00134 !-----------------------------------------------------------------------
00135 !
00136       DOUBLE PRECISION EPS_VOLUME
00137       DATA EPS_VOLUME /1.D-14/
00138 !
00139 !-----------------------------------------------------------------------
00140 !
00141       NSEGH=NSEG*NPLAN
00142       NSEGV=NPOIN2*(NPLAN-1)
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 !     SEE STOSEG41.F FOR NUMBERING OF CROSSED SEGMENTS
00155 !
00156       IF(SCHCF.EQ.ADV_NSC_TF) THEN
00157 !
00158         IF(MESH3%TYPELM.EQ.40) THEN
00159 !
00160 !       PRISMS
00161 !       CASE WITH BOTH HORIZONTAL AND CROSSED FLUXES (CASE OF N-SCHEME)
00162 !
00163         DO ISEG2D=1,NSEG
00164           DO IPLAN=1,NPLAN-1
00165 !           CROSSED SEGMENT EXITING FROM POINT 1 OF HORIZONTAL SEGMENT
00166             ICR1=NSEGH+NSEGV+2*(IPLAN-1)*NSEG+ISEG2D
00167 !           CROSSED SEGMENT EXITING FROM POINT 2 OF HORIZONTAL SEGMENT
00168             ICR2=ICR1+NSEG
00169 !           HORIZONTAL SEGMENT
00170             ISEG3D=ISEG2D+(IPLAN-1)*NSEG
00171             I1=GLOSEG(ISEG3D,1)
00172             I2=GLOSEG(ISEG3D,2)
00173             I3=GLOSEG(ICR1,2)
00174             I4=GLOSEG(ICR2,2)
00175 !           FIRST CROSSED SEGMENT BYPASSED
00176             IF(TRA01%R(I1).LT.EPS_VOLUME.OR.
00177      &         TRA01%R(I3).LT.EPS_VOLUME) THEN
00178 !             FLUX ADDED TO UPPER LAYER WITH SAME ORIENTATION
00179               IHOR=ISEG3D+NSEG
00180               FLUX(IHOR)=FLUX(IHOR)+FLUX(ICR1)
00181 !             FLUX ADDED TO VERTICAL OF I1
00182               FLUX(NSEGH+I1)=FLUX(NSEGH+I1)+FLUX(ICR1)
00183 !             FLUX CANCELLED
00184               FLUX(ICR1)=0.D0
00185             ENDIF
00186 !           SECOND CROSSED SEGMENT BYPASSED
00187             IF(TRA01%R(I2).LT.EPS_VOLUME.OR.
00188      &         TRA01%R(I4).LT.EPS_VOLUME) THEN
00189 !             FLUX ADDED TO UPPER LAYER WITH OPPOSITE ORIENTATION
00190               IHOR=ISEG3D+NSEG
00191               FLUX(IHOR)=FLUX(IHOR)-FLUX(ICR2)
00192 !             FLUX ADDED TO VERTICAL OF I2
00193               FLUX(NSEGH+I2)=FLUX(NSEGH+I2)+FLUX(ICR2)
00194 !             FLUX CANCELLED
00195               FLUX(ICR2)=0.D0
00196             ENDIF
00197 !           LOWER HORIZONTAL SEGMENT BYPASSED
00198             IF(TRA01%R(I1).LT.EPS_VOLUME.OR.
00199      &         TRA01%R(I2).LT.EPS_VOLUME) THEN
00200 !             FLUX (FROM 2 TO 1) ADDED TO UPPER LAYER
00201 !             HERE IHOR HAS ALREADY BEEN COMPUTED ABOVE
00202               FLUX(IHOR)=FLUX(IHOR)+FLUX(ISEG3D)
00203 !             FLUX ADDED TO VERTICAL OF I2
00204 !             (WITH - SIGN BECAUSE POSITIVE IS FROM UP TO DOWN)
00205               FLUX(NSEGH+I2)=FLUX(NSEGH+I2)-FLUX(ISEG3D)
00206 !             FLUX REMOVED FROM VERTICAL OF I1 (WITH + SIGN)
00207               FLUX(NSEGH+I1)=FLUX(NSEGH+I1)+FLUX(ISEG3D)
00208 !             FLUX CANCELLED
00209               FLUX(ISEG3D)=0.D0
00210             ELSE
00211               EXIT
00212             ENDIF
00213           ENDDO
00214         ENDDO
00215 !
00216         ELSEIF(MESH3%TYPELM.EQ.50) THEN
00217 !
00218 !       SEE STOSEG51.F FOR NUMBERING OF CROSSED SEGMENTS
00219 !
00220 !       TETRAHEDRA
00221 !       CASE WITH BOTH HORIZONTAL AND CROSSED FLUXES (CASE OF N-SCHEME)
00222 !
00223         DO ISEG2D=1,NSEG
00224           DO IPLAN=1,NPLAN-1
00225 !           ONLY ONE CROSSED SEGMENT, EXITING FROM POINT 1 OR 2
00226             ICR1=NSEGH+NSEGV+(IPLAN-1)*NSEG+ISEG2D
00227 !           FIRST POINT OF THIS SEGMENT
00228             IS1=GLOSEG(ICR1,1)
00229 !           LOWER HORIZONTAL SEGMENT
00230             ISEG3D=ISEG2D+(IPLAN-1)*NSEG
00231             I1=GLOSEG(ISEG3D,1)
00232             I2=GLOSEG(ISEG3D,2)
00233 !           POINT ABOVE I2
00234             I3=I2+NPOIN2
00235 !           POINT ABOVE I1
00236             I4=I1+NPOIN2
00237 !           CASE OF CROSSED SEGMENT TOUCHING I1 (IS1=I1 OR IS1=I3)
00238             IF(TRA01%R(I1).LT.EPS_VOLUME.OR.
00239      &         TRA01%R(I3).LT.EPS_VOLUME) THEN
00240               IF(IS1.EQ.I1) THEN
00241 !               WITH SAME ORIENTATION
00242 !               FLUX ADDED TO UPPER LAYER WITH SAME ORIENTATION
00243                 IHOR=ISEG3D+NSEG
00244                 FLUX(IHOR)=FLUX(IHOR)+FLUX(ICR1)
00245 !               FLUX ADDED TO VERTICAL OF I1
00246                 FLUX(NSEGH+I1)=FLUX(NSEGH+I1)+FLUX(ICR1)
00247 !               FLUX CANCELLED
00248                 FLUX(ICR1)=0.D0
00249               ELSEIF(IS1.EQ.I3) THEN
00250 !               WITH OPPOSITE ORIENTATION
00251 !               FLUX ADDED TO UPPER LAYER WITH OPPOSITE ORIENTATION
00252                 IHOR=ISEG3D+NSEG
00253                 FLUX(IHOR)=FLUX(IHOR)-FLUX(ICR1)
00254 !               FLUX ADDED TO VERTICAL OF I1
00255 !               ALSO WITH - SIGN BECAUSE WITH OPPOSITE ORIENTATION
00256 !               TO VERTICAL SEGMENTS ALSO (ALL ARE FROM BOTTOM TO TOP)
00257                 FLUX(NSEGH+I1)=FLUX(NSEGH+I1)-FLUX(ICR1)
00258 !               FLUX CANCELLED
00259                 FLUX(ICR1)=0.D0
00260               ENDIF
00261             ENDIF
00262 !           CASE OF CROSSED SEGMENT TOUCHING I2 (IS1=I2 OR IS1=I4)
00263             IF(TRA01%R(I2).LT.EPS_VOLUME.OR.
00264      &         TRA01%R(I4).LT.EPS_VOLUME) THEN
00265               IF(IS1.EQ.I2) THEN
00266 !               WITH SAME ORIENTATION
00267 !               FLUX ADDED TO UPPER LAYER WITH OPPOSITE ORIENTATION
00268                 IHOR=ISEG3D+NSEG
00269                 FLUX(IHOR)=FLUX(IHOR)-FLUX(ICR1)
00270 !               FLUX ADDED TO VERTICAL OF I2
00271 !               SAME ORIENTATION AS VERTICAL SEGMENTS, HENCE +
00272                 FLUX(NSEGH+I2)=FLUX(NSEGH+I2)+FLUX(ICR1)
00273 !               FLUX CANCELLED
00274                 FLUX(ICR1)=0.D0
00275               ELSEIF(IS1.EQ.I4) THEN
00276 !               WITH OPPOSITE ORIENTATION
00277 !               FLUX ADDED TO UPPER LAYER WITH SAME ORIENTATION
00278                 IHOR=ISEG3D+NSEG
00279                 FLUX(IHOR)=FLUX(IHOR)+FLUX(ICR1)
00280 !               FLUX ADDED TO VERTICAL OF I2
00281 !               OPPOSITE ORIENTATION AS VERTICAL SEGMENTS, HENCE -
00282                 FLUX(NSEGH+I2)=FLUX(NSEGH+I2)-FLUX(ICR1)
00283 !               FLUX CANCELLED
00284                 FLUX(ICR1)=0.D0
00285               ENDIF
00286             ENDIF
00287 !           BYPASSING THE LOWER HORIZONTAL SEGMENT. EXACTLY LIKE PRISMS
00288 !           BECAUSE SAME NUMBERING OF HORIZONTAL AND VERTICAL SEGMENTS
00289             IF(TRA01%R(I1).LT.EPS_VOLUME.OR.
00290      &         TRA01%R(I2).LT.EPS_VOLUME) THEN
00291 !             FLUX (FROM 2 TO 1) ADDED TO UPPER LAYER
00292               FLUX(ISEG3D+NSEG)=FLUX(ISEG3D+NSEG)+FLUX(ISEG3D)
00293 !             FLUX ADDED TO VERTICAL OF I2 (WITH - SIGN)
00294               FLUX(NSEGH+I2)=FLUX(NSEGH+I2)-FLUX(ISEG3D)
00295 !             FLUX REMOVED FROM VERTICAL OF I1 (WITH + SIGN)
00296               FLUX(NSEGH+I1)=FLUX(NSEGH+I1)+FLUX(ISEG3D)
00297 !             FLUX CANCELLED
00298               FLUX(ISEG3D)=0.D0
00299             ELSE
00300               EXIT
00301             ENDIF
00302           ENDDO
00303         ENDDO
00304 !
00305         ELSE
00306           WRITE(LU,*) 'BYPASS_CRUSHED_POINTS_SEG'
00307           WRITE(LU,*) 'UNKNOWN TYPE OF ELEMENT: ',MESH3%TYPELM
00308           WRITE(LU,*) 'IN THE CASE OF SCHEME: ',SCHCF
00309           CALL PLANTE(1)
00310           STOP
00311         ENDIF
00312 !
00313       ELSEIF(SCHCF.EQ.ADV_LPO_TF) THEN
00314 !
00315         IF(MESH3%TYPELM.NE.40) THEN
00316           WRITE(LU,*) 'BYPASS_CRUSHED_POINTS_SEG'
00317           WRITE(LU,*) 'UNKNOWN TYPE OF ELEMENT: ',MESH3%TYPELM
00318           WRITE(LU,*) 'IN THE CASE OF SCHEME: ',SCHCF
00319           CALL PLANTE(1)
00320           STOP
00321         ENDIF
00322 !
00323 !       CASE WITH ONLY HORIZONTAL FLUXES
00324 !
00325         DO ISEG2D=1,NSEG
00326           DO IPLAN=1,NPLAN-1
00327             ISEG3D=ISEG2D+(IPLAN-1)*NSEG
00328             I1=GLOSEG(ISEG3D,1)
00329             I2=GLOSEG(ISEG3D,2)
00330             IF(TRA01%R(I1).LT.EPS_VOLUME) THEN
00331 !             FLUX (FROM 2 TO 1) ADDED TO UPPER LAYER
00332               FLUX(ISEG3D+NSEG)=FLUX(ISEG3D+NSEG)+FLUX(ISEG3D)
00333 !             FLUX ADDED TO VERTICAL OF I2 (WITH - SIGN)
00334               FLUX(NSEGH+I2)=FLUX(NSEGH+I2)-FLUX(ISEG3D)
00335 !             FLUX REMOVED FROM VERTICAL OF I1 (WITH + SIGN)
00336               FLUX(NSEGH+I1)=FLUX(NSEGH+I1)+FLUX(ISEG3D)
00337 !             FLUX CANCELLED
00338               FLUX(ISEG3D)=0.D0
00339             ELSEIF(TRA01%R(I2).LT.EPS_VOLUME) THEN
00340 !             FLUX (FROM 2 TO 1) ADDED TO UPPER LAYER
00341               FLUX(ISEG3D+NSEG)=FLUX(ISEG3D+NSEG)+FLUX(ISEG3D)
00342 !             FLUX REMOVED FROM VERTICAL OF I2
00343               FLUX(NSEGH+I2)=FLUX(NSEGH+I2)-FLUX(ISEG3D)
00344 !             FLUX ADDED TO VERTICAL OF I1
00345               FLUX(NSEGH+I1)=FLUX(NSEGH+I1)+FLUX(ISEG3D)
00346 !             FLUX CANCELLED
00347               FLUX(ISEG3D)=0.D0
00348             ELSE
00349               EXIT
00350             ENDIF
00351           ENDDO
00352         ENDDO
00353 !
00354       ELSE
00355         WRITE(LU,*) 'UNKNOWN SCHEME IN BYPASS_CRUSHED_POINTS_SEG:',SCHCF
00356         CALL PLANTE(1)
00357         STOP
00358       ENDIF
00359 !
00360 !=======================================================================
00361 !
00362       RETURN
00363       END

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