mt15pp.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\utils\bief\mt15pp.f
00002 !
00044                      SUBROUTINE MT15PP
00045 !                    *****************
00046 !
00047      &(T,XM,PPQ,XMUL,SF,F,ZPT,SURFAC,IKLE,NELEM,NELMAX)
00048 !
00049 !***********************************************************************
00050 ! BIEF   V7P0                                  03/06/2014
00051 !***********************************************************************
00052 !
00053 !
00054 !
00055 !
00056 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00057 !| F              |-->| FUNCTION USED IN THE FORMULA
00058 !| IKLE           |-->| CONNECTIVITY TABLE
00059 !| NELEM          |-->| NUMBER OF ELEMENTS
00060 !| NELMAX         |-->| MAXIMUM NUMBER OF ELEMENTS
00061 !| PPQ            |-->| STORAGE IN XM OF OFF-DIAGONAL ELEMENTS
00062 !| SF             |-->| BIEF_OBJ STRUCTURE OF F
00063 !| SURFAC         |-->| AREA OF 2D ELEMENTS
00064 !| T              |<->| WORK ARRAY FOR ELEMENT BY ELEMENT DIAGONAL
00065 !| XM             |<->| OFF-DIAGONAL TERMS
00066 !| XMUL           |-->| COEFFICIENT FOR MULTIPLICATION
00067 !| ZPT            |-->| Z COORDINATES
00068 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00069 !
00070       USE BIEF, EX_MT15PP => MT15PP
00071 !
00072       IMPLICIT NONE
00073       INTEGER LNG,LU
00074       COMMON/INFO/LNG,LU
00075 !
00076 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00077 !
00078       INTEGER, INTENT(IN) :: NELEM,NELMAX
00079       INTEGER, INTENT(IN) :: IKLE(NELMAX,6),PPQ(6,6)
00080 !
00081       DOUBLE PRECISION, INTENT(INOUT) :: T(NELMAX,6),XM(NELMAX,30)
00082 !
00083       DOUBLE PRECISION, INTENT(IN) :: XMUL
00084       DOUBLE PRECISION, INTENT(IN) :: F(*),ZPT(*)
00085 !
00086       TYPE(BIEF_OBJ), INTENT(IN) :: SF
00087 !
00088       DOUBLE PRECISION, INTENT(IN) :: SURFAC(NELMAX)
00089 !
00090 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00091 !
00092 !     DECLARATIONS SPECIFIC TO THIS SUBROUTINE
00093 !
00094       INTEGER IELEM,I1,I2,I3,I4,I5,I6
00095       DOUBLE PRECISION XSUR3
00096 !
00097 !-----------------------------------------------------------------------
00098 !
00099       XSUR3=XMUL/3.D0
00100 !
00101 !=======================================================================
00102 !
00103       DO IELEM=1,NELEM
00104 !
00105         I1=IKLE(IELEM,1)
00106         I2=IKLE(IELEM,2)
00107         I3=IKLE(IELEM,3)
00108         I4=IKLE(IELEM,4)
00109         I5=IKLE(IELEM,5)
00110         I6=IKLE(IELEM,6)
00111 !
00112         T(IELEM,1)=0.D0
00113         T(IELEM,2)=0.D0
00114         T(IELEM,3)=0.D0
00115 !
00116         XM(IELEM, 1)=0.D0
00117         XM(IELEM, 2)=0.D0
00118         XM(IELEM, 4)=0.D0
00119         XM(IELEM, 5)=0.D0
00120         XM(IELEM, 6)=0.D0
00121         XM(IELEM, 7)=0.D0
00122         XM(IELEM, 9)=0.D0
00123         XM(IELEM,10)=0.D0
00124         XM(IELEM,11)=0.D0
00125         XM(IELEM,13)=0.D0
00126         XM(IELEM,14)=0.D0
00127         XM(IELEM,15)=0.D0
00128 !
00129         XM(IELEM,16)=0.D0
00130         XM(IELEM,17)=0.D0
00131         XM(IELEM,18)=0.D0
00132         XM(IELEM,19)=0.D0
00133         XM(IELEM,20)=0.D0
00134         XM(IELEM,21)=0.D0
00135         XM(IELEM,22)=0.D0
00136         XM(IELEM,23)=0.D0
00137         XM(IELEM,24)=0.D0
00138         XM(IELEM,25)=0.D0
00139         XM(IELEM,26)=0.D0
00140         XM(IELEM,27)=0.D0
00141         XM(IELEM,28)=0.D0
00142         XM(IELEM,29)=0.D0
00143         XM(IELEM,30)=0.D0
00144 !
00145 !-----------------------------------------------------------------------
00146 !
00147 !     EXTRA-DIAGONAL TERMS: BOTTOM POINTS RECEIVE FROM UPPER POINT
00148 !                           A FLUX EQUAL TO WC*SURFAC/3 MULTIPLIED
00149 !                           BY CONCENTRATION OF UPPER POINT
00150 !     DIAGONAL TERMS : TOP POINTS GIVE TO LOWER POINTS
00151 !                      A FLUX EQUAL TO WC*SURFAC/3 MULTIPLIED
00152 !                      BY ITS CONCENTRATION.
00153 !
00154 !-----------------------------------------------------------------------
00155 !
00156         IF(ZPT(I4)-ZPT(I1).GT.1.D-4) THEN
00157 !         TERM 4-4
00158           T(IELEM,4)=   F(I4)*SURFAC(IELEM)*XSUR3
00159 !         TERM 1-4
00160           XM(IELEM, 3)=-F(I4)*SURFAC(IELEM)*XSUR3
00161         ENDIF
00162         IF(ZPT(I5)-ZPT(I2).GT.1.D-4) THEN
00163 !         TERM 5-5
00164           T(IELEM,5)=   F(I5)*SURFAC(IELEM)*XSUR3
00165 !         TERM 2-5
00166           XM(IELEM, 8)=-F(I5)*SURFAC(IELEM)*XSUR3
00167         ENDIF
00168         IF(ZPT(I6)-ZPT(I3).GT.1.D-4) THEN
00169 !         TERM 6-6
00170           T(IELEM,6)=   F(I6)*SURFAC(IELEM)*XSUR3
00171 !         TERM 3-6
00172           XM(IELEM,12)=-F(I6)*SURFAC(IELEM)*XSUR3
00173         ENDIF
00174 !
00175       ENDDO
00176 !
00177 !-----------------------------------------------------------------------
00178 !
00179       RETURN
00180       END

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