gtsh11.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\utils\bief\gtsh11.f
00002 !
00063                      SUBROUTINE GTSH11
00064 !                    *****************
00065 !
00066      &(SHP,ELT,IKLE,ELTCAR,NPOIN,NELEM,NELMAX,NSEG,QUAB,QUAD)
00067 !
00068 !***********************************************************************
00069 ! BIEF   V6P2                                   21/08/2010
00070 !***********************************************************************
00071 !
00072 !
00073 !
00074 !
00075 !
00076 !
00077 !
00078 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00079 !| ELT            |<--| ELEMENT CHOSEN FOR EVERY POINT
00080 !| ELTCAR         |-->| STARTING ELEMENT FOR LINEAR AND QUADRATIC POINTS
00081 !|                |   | MUST HAVE THE RELEVANT SIZE.
00082 !| IKLE           |-->| CONNECTIVITY TABLE
00083 !| NELEM          |-->| NUMBER OF ELEMENTS
00084 !| NELMAX         |-->| MAXIMUM NUMBER OF ELEMENTS
00085 !| NPOIN          |-->| NUMBER OF POINTS
00086 !| NSEG           |-->| NUMBER OF SEGMENTS
00087 !| QUAB           |-->| IF YES, THERE ARE QUASI-BUBBLE VARIABLES
00088 !| QUAD           |-->| IF YES, THERE ARE QUADRATIC VARIABLES
00089 !| SHP            |<--| BARYCENTRIC COORDINATES OF NODES IN THEIR
00090 !|                |   | ASSOCIATED ELEMENT "ELT"
00091 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00092 !
00093       IMPLICIT NONE
00094       INTEGER LNG,LU
00095       COMMON/INFO/LNG,LU
00096 !
00097 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00098 !
00099       INTEGER, INTENT(IN)             :: NPOIN,NELEM,NELMAX,NSEG
00100       INTEGER, INTENT(IN)             :: IKLE(NELMAX,*),ELTCAR(*)
00101 !                                            NPOIN
00102 !                                            NPOIN+NELEM
00103 !                                            NPOIN+NSEG
00104       INTEGER, INTENT(INOUT)          :: ELT(*)
00105       DOUBLE PRECISION, INTENT(INOUT) :: SHP(3,*)
00106       LOGICAL, INTENT(IN)             :: QUAB,QUAD
00107 !
00108 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00109 !
00110       INTEGER I,IELEM
00111       DOUBLE PRECISION TIERS
00112       TIERS=1.D0/3.D0
00113 !
00114 !-----------------------------------------------------------------------
00115 !
00116       DO I=1,NPOIN
00117         IELEM=ELTCAR(I)
00118         ELT(I) = IELEM
00119         IF(IELEM.NE.0) THEN
00120           IF(IKLE(IELEM,1).EQ.I) THEN
00121             SHP(1,I)=1.D0
00122             SHP(2,I)=0.D0
00123             SHP(3,I)=0.D0
00124           ELSEIF(IKLE(IELEM,2).EQ.I) THEN
00125             SHP(1,I)=0.D0
00126             SHP(2,I)=1.D0
00127             SHP(3,I)=0.D0
00128           ELSEIF(IKLE(IELEM,3).EQ.I) THEN
00129             SHP(1,I)=0.D0
00130             SHP(2,I)=0.D0
00131             SHP(3,I)=1.D0
00132           ELSE
00133             WRITE(LU,*) 'PROBLEM IN GTSH11'
00134             CALL PLANTE(1)
00135             STOP
00136           ENDIF
00137         ENDIF
00138       ENDDO
00139       IF(QUAB) THEN
00140         DO IELEM=1,NELEM
00141           I=NPOIN+IELEM
00142           ELT(I)=IELEM
00143           SHP(1,I)=TIERS
00144           SHP(2,I)=TIERS
00145           SHP(3,I)=TIERS
00146         ENDDO
00147       ENDIF
00148       IF(QUAD) THEN
00149         DO I=NPOIN+1,NPOIN+NSEG
00150           IELEM=ELTCAR(I)
00151           ELT(I)=IELEM
00152           IF(IELEM.NE.0) THEN
00153             IF(IKLE(IELEM,4).EQ.I) THEN
00154 !             POINT 4
00155               SHP(1,I)=0.5D0
00156               SHP(2,I)=0.5D0
00157               SHP(3,I)=0.D0
00158             ELSEIF(IKLE(IELEM,5).EQ.I) THEN
00159 !             POINT 5
00160               SHP(1,I)=0.D0
00161               SHP(2,I)=0.5D0
00162               SHP(3,I)=0.5D0
00163             ELSEIF(IKLE(IELEM,6).EQ.I) THEN
00164 !             POINT 6
00165               SHP(1,I)=0.5D0
00166               SHP(2,I)=0.D0
00167               SHP(3,I)=0.5D0
00168             ELSE
00169               WRITE(LU,*) 'PROBLEM IN GTSH11, QUADRATIC CASE'
00170               CALL PLANTE(1)
00171               STOP
00172             ENDIF
00173           ENDIF
00174         ENDDO
00175       ENDIF
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