vc05oo.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\utils\bief\vc05oo.f
00002 !
00072                      SUBROUTINE VC05OO
00073 !                    *****************
00074 !
00075      &(XMUL,SU,SV,U,V,XNOR,YNOR,LGSEG,IKLE,NBOR,NELEM,NELMAX,W1,W2 )
00076 !
00077 !***********************************************************************
00078 ! BIEF   V6P1                                   21/08/2010
00079 !***********************************************************************
00080 !
00081 !
00082 !
00083 !
00084 !
00085 !
00086 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00087 !| IKLE           |-->| CONNECTIVITY TABLE
00088 !| LGSEG          |-->| LENGTH OF SEGMENTS
00089 !| NBOR           |-->| GLOBAL NUMBER OF BOUNDARY POINTS
00090 !| NELEM          |-->| NUMBER OF ELEMENTS
00091 !| NELMAX         |-->| MAXIMUM NUMBER OF ELEMENTS
00092 !| SU             |-->| BIEF_OBJ STRUCTURE OF U
00093 !| SV             |-->| BIEF_OBJ STRUCTURE OF V
00094 !| U              |-->| FUNCTION USED IN THE VECTOR FORMULA
00095 !| V              |-->| FUNCTION USED IN THE VECTOR FORMULA
00096 !| W1             |<--| RESULT IN NON ASSEMBLED FORM
00097 !| W2             |<--| RESULT IN NON ASSEMBLED FORM
00098 !| XMUL           |-->| MULTIPLICATION COEFFICIENT
00099 !| XNOR           |-->| FIRST COMPONENT OF NORMAL TO ELEMENT
00100 !| YNOR           |-->| SECOND COMPONENT OF NORMAL TO ELEMENT
00101 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00102 !
00103       USE BIEF, EX_VC05OO => VC05OO
00104 !
00105       IMPLICIT NONE
00106       INTEGER LNG,LU
00107       COMMON/INFO/LNG,LU
00108 !
00109 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00110 !
00111       INTEGER, INTENT(IN) :: NELEM,NELMAX
00112       INTEGER, INTENT(IN) :: IKLE(NELMAX,*)
00113       INTEGER, INTENT(IN) :: NBOR(*)
00114 !
00115       DOUBLE PRECISION, INTENT(IN)    :: XNOR(NELMAX),YNOR(NELMAX)
00116       DOUBLE PRECISION, INTENT(INOUT) :: W1(NELMAX),W2(NELMAX)
00117       DOUBLE PRECISION, INTENT(IN)    :: LGSEG(NELMAX)
00118       DOUBLE PRECISION, INTENT(IN)    :: XMUL
00119 !
00120 !     STRUCTURES OF U, V AND REAL DATA
00121 !
00122       TYPE(BIEF_OBJ)  , INTENT(IN) :: SU,SV
00123       DOUBLE PRECISION, INTENT(IN) :: U(*),V(*)
00124 !
00125 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00126 !
00127       INTEGER N1,N2,NG1,NG2,IELEM,IELMU,IELMV
00128       DOUBLE PRECISION XSUR06,U1,U2,V1,V2,VX1,VY1,VX2,VY2
00129 !
00130 !-----------------------------------------------------------------------
00131 !
00132       XSUR06 = XMUL/6.D0
00133 !
00134 !-----------------------------------------------------------------------
00135 !
00136       IELMU=SU%ELM
00137       IELMV=SV%ELM
00138 !
00139 !-----------------------------------------------------------------------
00140 !         ->
00141 !   F AND U LINEAR FUNCTIONS ON TRIANGLES OR QUADRILATERALS
00142 !
00143       IF( (IELMU.EQ.11.OR.IELMU.EQ.12.OR.IELMU.EQ.21) .AND.
00144      &    (IELMV.EQ.11.OR.IELMV.EQ.12.OR.IELMV.EQ.21)       ) THEN
00145 !
00146       DO IELEM =1,NELEM
00147 !
00148 !     NUMBERING OF THE BOUNDARY NODES
00149 !
00150 !     GLOBAL NUMBERING
00151 !
00152       NG1= NBOR(IKLE(IELEM,1))
00153       NG2= NBOR(IKLE(IELEM,2))
00154 !
00155       U1 = U(NG1)
00156       U2 = U(NG2)
00157       V1 = V(NG1)
00158       V2 = V(NG2)
00159 !
00160 !   DETERMINES THE BASE FUNCTIONS AT THE BOUNDARY:
00161 !
00162       VX1 = XSUR06 * ( U2 + U1 + U1 )
00163       VY1 = XSUR06 * ( V2 + V1 + V1 )
00164       VX2 = XSUR06 * ( U1 + U2 + U2 )
00165       VY2 = XSUR06 * ( V1 + V2 + V2 )
00166 !
00167       W1(IELEM) = LGSEG(IELEM) * ( VX1*XNOR(IELEM) + VY1*YNOR(IELEM) )
00168       W2(IELEM) = LGSEG(IELEM) * ( VX2*XNOR(IELEM) + VY2*YNOR(IELEM) )
00169 !
00170       ENDDO
00171 !
00172 !-----------------------------------------------------------------------
00173 !   ->
00174 !   U LINEAR FUNCTIONS ON SEGMENTS
00175 !
00176       ELSEIF(IELMU.EQ.1.AND.IELMV.EQ.1) THEN
00177 !
00178       DO IELEM =1,NELEM
00179 !
00180 !     NUMBERING OF THE BOUNDARY NODES
00181 !
00182       N1 = IKLE(IELEM,1)
00183       N2 = IKLE(IELEM,2)
00184 !
00185 !     GLOBAL NUMBERING
00186 !
00187       NG1= NBOR(N1)
00188       NG2= NBOR(N2)
00189 !
00190       U1 = U(N1)
00191       U2 = U(N2)
00192       V1 = V(N1)
00193       V2 = V(N2)
00194 !
00195 !   DETERMINES THE BASE FUNCTIONS AT THE BOUNDARY:
00196 !
00197       VX1 = XSUR06 * ( U2 + U1 + U1 )
00198       VY1 = XSUR06 * ( V2 + V1 + V1 )
00199       VX2 = XSUR06 * ( U1 + U2 + U2 )
00200       VY2 = XSUR06 * ( V1 + V2 + V2 )
00201 !
00202       W1(IELEM) = LGSEG(IELEM) * ( VX1*XNOR(IELEM) + VY1*YNOR(IELEM) )
00203       W2(IELEM) = LGSEG(IELEM) * ( VX2*XNOR(IELEM) + VY2*YNOR(IELEM) )
00204 !
00205       ENDDO
00206 !
00207 !-----------------------------------------------------------------------
00208 !
00209       ELSE
00210 !
00211 !-----------------------------------------------------------------------
00212 !
00213         IF (LNG.EQ.1) WRITE(LU,100)
00214         IF (LNG.EQ.1) WRITE(LU,102) IELMU,SU%NAME
00215         IF (LNG.EQ.1) WRITE(LU,103) IELMV,SV%NAME
00216         IF (LNG.EQ.1) WRITE(LU,104)
00217         IF (LNG.EQ.2) WRITE(LU,110)
00218         IF (LNG.EQ.2) WRITE(LU,112) IELMU,SU%NAME
00219         IF (LNG.EQ.2) WRITE(LU,113) IELMV,SV%NAME
00220         IF (LNG.EQ.2) WRITE(LU,114)
00221 100     FORMAT(1X,'VC05OO (BIEF) :')
00222 102     FORMAT(1X,'DISCRETISATION DE U : ',1I6,
00223      &         1X,'NOM REEL : ',A6)
00224 103     FORMAT(1X,'DISCRETISATION DE V : ',1I6,
00225      &         1X,'NOM REEL : ',A6)
00226 104     FORMAT(1X,'CAS NON PREVU')
00227 110     FORMAT(1X,'VC05OO (BIEF):')
00228 112     FORMAT(1X,'DISCRETIZATION OF U:',1I6,
00229      &         1X,'REAL NAME: ',A6)
00230 113     FORMAT(1X,'DISCRETIZATION OF V:',1I6,
00231      &         1X,'REAL NAME: ',A6)
00232 114     FORMAT(1X,'CASE NOT IMPLEMENTED')
00233         CALL PLANTE(1)
00234         STOP
00235 !
00236       ENDIF
00237 !
00238 !-----------------------------------------------------------------------
00239 !
00240       RETURN
00241       END

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