na_flux3d_lim.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\utils\bief\na_flux3d_lim.f
00002 !
00039                      SUBROUTINE NA_FLUX3D_LIM
00040 !                    ************************
00041 !
00042      &(W,FLULIM,NSEG2D,NELEM,NELMAX,NELEM2,NELMAX2,ELTSEG,ORISEG)
00043 !
00044 !***********************************************************************
00045 ! BIEF   V6P2                                   24/08/2012
00046 !***********************************************************************
00047 !
00048 !         ELEMENT ARRAY. FOR PRISMS. FIRST THE FLUXES ARE COMPUTED
00049 !         WITH THE FINITE ELEMENT FLUXES. THEN LIMITATION IS DONE,
00050 !         THEN FINITE ELEMENT FLUXES ARE REASSEMBLED.
00051 !
00052 !
00053 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00054 !| ELTSEG         |-->| ELEMENTS THAT FORM A TRIANGLE
00055 !| FLULIM         |-->| LIMITING FACTOR OF 2D SEGMENTS
00056 !| NELEM          |-->| NUMBER OF ELEMENTS IN 3D
00057 !| NELEM2         |-->| NUMBER OF ELEMENTS IN 2D
00058 !| NSEG2D         |-->| NUMBER OF SEGMENTS IN 2D
00059 !| NELMAX         |-->| MAXIMUM NUMBER OF ELEMENTS IN 3D
00060 !| NELMAX2        |-->| MAXIMUM NUMBER OF ELEMENTS IN 2D
00061 !| W              |-->| FINITE ELEMENT FLUXES (I.E. LEAVING POINTS)
00062 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00063 !
00064       USE BIEF
00065 !
00066       IMPLICIT NONE
00067       INTEGER LNG,LU
00068       COMMON/INFO/LNG,LU
00069 !
00070 !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
00071 !
00072       INTEGER, INTENT(IN)             :: NSEG2D,NELMAX
00073       INTEGER, INTENT(IN)             :: NELEM,NELEM2,NELMAX2
00074       INTEGER, INTENT(IN)             :: ELTSEG(NELMAX2,3)
00075       INTEGER, INTENT(IN)             :: ORISEG(NELMAX2,3)
00076       DOUBLE PRECISION, INTENT(INOUT) :: W(NELMAX,6)
00077       DOUBLE PRECISION, INTENT(IN)    :: FLULIM(NSEG2D)
00078 !
00079 !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
00080 !
00081       INTEGER IELEM,IELEM2
00082       DOUBLE PRECISION F12,F23,F31,A1,A2,A3,F1,F2,F3
00083 !
00084 !-----------------------------------------------------------------------
00085 !
00086 !     LIMITS 3D HORIZONTAL FLUXES BY COEFFICIENT OF 2D FLUXES
00087 !
00088 !     POINT TO POINT FLUXES ARE COMPUTED
00089 !     SEE FLUX_EF_VF IN BIEF, OPTION 2
00090 !     THEN THEY ARE REGROUPED ON POINTS
00091 !
00092 !-----------------------------------------------------------------------
00093 !
00094 !     HORIZONTAL SEGMENTS
00095 !
00096       DO IELEM=1,NELEM
00097 !
00098         IELEM2=MOD(IELEM-1,NELEM2)+1
00099 !
00100 !       LOWER LEVEL (SUM OF 3 W MUST BE 0, IT IS WITH VC04PP)
00101 !
00102         F1 = W(IELEM,1)
00103         F2 = W(IELEM,2)
00104         F3 = W(IELEM,3)
00105         A1 = ABS(F1)
00106         A2 = ABS(F2)
00107         A3 = ABS(F3)
00108         F12=0.D0
00109         F23=0.D0
00110         F31=0.D0
00111         IF(A1.GE.A2.AND.A1.GE.A3) THEN
00112 !         ALL FLOW TO AND FROM NODE 1
00113           F12 = - F2
00114           F31 = + F3
00115         ELSEIF(A2.GE.A1.AND.A2.GE.A3) THEN
00116 !         ALL FLOW TO AND FROM NODE 2
00117           F12 = + F1
00118           F23 = - F3
00119         ELSE
00120 !         ALL FLOW TO AND FROM NODE 3
00121           F23 = + F2
00122           F31 = - F1
00123         ENDIF
00124 !       LIMITATION
00125         F12=F12*FLULIM(ELTSEG(IELEM2,1))
00126         F23=F23*FLULIM(ELTSEG(IELEM2,2))
00127         F31=F31*FLULIM(ELTSEG(IELEM2,3))
00128 !       REGROUPING
00129         W(IELEM,1)=F12-F31
00130         W(IELEM,2)=F23-F12
00131         W(IELEM,3)=F31-F23
00132 !
00133 !       UPPER LEVEL (SUM OF 3 W MUST BE 0, IT IS WITH VC04PP)
00134 !
00135         F1 = W(IELEM,4)
00136         F2 = W(IELEM,5)
00137         F3 = W(IELEM,6)
00138         A1 = ABS(F1)
00139         A2 = ABS(F2)
00140         A3 = ABS(F3)
00141         F12=0.D0
00142         F23=0.D0
00143         F31=0.D0
00144         IF(A1.GE.A2.AND.A1.GE.A3) THEN
00145 !         ALL FLOW TO AND FROM NODE 1
00146           F12 = - F2
00147           F31 = + F3
00148         ELSEIF(A2.GE.A1.AND.A2.GE.A3) THEN
00149 !         ALL FLOW TO AND FROM NODE 2
00150           F12 = + F1
00151           F23 = - F3
00152         ELSE
00153 !         ALL FLOW TO AND FROM NODE 3
00154           F23 = + F2
00155           F31 = - F1
00156         ENDIF
00157 !       LIMITATION
00158         F12=F12*FLULIM(ELTSEG(IELEM2,1))
00159         F23=F23*FLULIM(ELTSEG(IELEM2,2))
00160         F31=F31*FLULIM(ELTSEG(IELEM2,3))
00161 !       REGROUPING
00162         W(IELEM,4)=F12-F31
00163         W(IELEM,5)=F23-F12
00164         W(IELEM,6)=F31-F23
00165       ENDDO
00166 !
00167 !-----------------------------------------------------------------------
00168 !
00169       RETURN
00170       END

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