gettriseg.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\utils\bief\gettriseg.f
00002 !
00076                      SUBROUTINE GETTRISEG
00077 !                    ********************
00078 !
00079      &(XAUX,AD,AX,TETA,NPOIN,MESH,NSEG3D,NSEG2D,NPLAN,NPOIN2,IELM3)
00080 !
00081 !***********************************************************************
00082 ! BIEF   V6P1                                   21/08/2010
00083 !***********************************************************************
00084 !
00085 !
00086 !
00087 !
00088 !
00089 !
00090 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00091 !| AD             |-->| DIAGONAL TERMS OF MATRIX
00092 !| AX             |-->| OFF-DIAGONAL TERMS OF MATRIX
00093 !|                |   | HERE DIMENSION 1 BECAUSE SYMMETRY
00094 !| IELM3          |-->| TYPE OF ELEMENT
00095 !| MESH           |-->| MESH STRUCTURE
00096 !| NPLAN          |-->| NUMBER OF PLANES
00097 !| NPOIN          |-->| NUMBER OF POINTS
00098 !| NPOIN2         |-->| NUMBER OF POINTS OF 2D MESH
00099 !| NSEG2D         |-->| NUMBER OF SEGMENTS IN 2D
00100 !| NSEG3D         |-->| NUMBER OF SEGMENTS IN 3D
00101 !| TETA           |-->| COEFFICIENT USED IN THE RESULT
00102 !| XAUX           |<--| THE RESULTING MATRIX
00103 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00104 !
00105       USE BIEF, EX_GETTRISEG => GETTRISEG
00106 !
00107       IMPLICIT NONE
00108       INTEGER LNG,LU
00109       COMMON/INFO/LNG,LU
00110 !
00111 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00112 !
00113       INTEGER, INTENT(IN) :: NPOIN,NSEG3D,NSEG2D,NPLAN,NPOIN2,IELM3
00114 !
00115       DOUBLE PRECISION, INTENT(IN)    :: TETA
00116       DOUBLE PRECISION, INTENT(INOUT) :: XAUX(NPOIN,*),AX(NSEG3D)
00117       DOUBLE PRECISION, INTENT(INOUT) :: AD(NPOIN)
00118 !
00119       TYPE(BIEF_MESH) :: MESH
00120 !
00121 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00122 !
00123       INTEGER I2,I3,IPLAN,IAN,ICOM,SEGUP,SEGDOWN,NSEGH,NSEGV
00124 !
00125 !-----------------------------------------------------------------------
00126 !
00127 !     CONSIDERS HERE THAT NPOIN < NELMAX TO USE XAUX AS XAUX(NPOIN,3)
00128 !
00129 !     XAUX(I,1) IS COEFFICIENT OF POINT BELOW I IN EQUATION OF POINT I
00130 !     XAUX(I,2) IS THE DIAGONAL
00131 !     XAUX(I,3) IS COEFFICIENT OF POINT ABOVE I IN EQUATION OF POINT I
00132 !
00133 !-----------------------------------------------------------------------
00134 !     INITIALISES THE DIAGONAL TERMS
00135 !-----------------------------------------------------------------------
00136 !
00137       CALL OV('X=CY    ',XAUX(1,2),AD,AD,TETA,NPOIN)
00138       CALL OV('X=CX    ',AD,AD,AD,1.D0-TETA,NPOIN)
00139 !
00140 !-----------------------------------------------------------------------
00141 !     TRIDIAGONAL TERMS
00142 !-----------------------------------------------------------------------
00143 !
00144 !     VERTICAL SEGMENTS HAVE THE SAME POSITION, SEE STOSEG41,STOSEG51
00145 !
00146       IF(IELM3.EQ.41.OR.IELM3.EQ.51) THEN
00147 !
00148         NSEGH=NSEG2D*NPLAN
00149         NSEGV=NPOIN2*(NPLAN-1)
00150 !
00151 !       PLANE ON THE BOTTOM
00152 !
00153         DO I2=1,NPOIN2
00154           SEGUP=NSEGH+I2
00155           XAUX(I2,1)=0.D0
00156           XAUX(I2,3)=TETA*AX(SEGUP)
00157         ENDDO
00158 !
00159 !       PLANE AT THE FREE SURFACE
00160 !
00161         DO I2=1,NPOIN2
00162           I3=I2+(NPLAN-1)*NPOIN2
00163           SEGDOWN=NSEGH+NPOIN2*(NPLAN-2)+I2
00164           XAUX(I3,1)=TETA*AX(SEGDOWN)
00165           XAUX(I3,3)=0.D0
00166         ENDDO
00167 !
00168 !       OTHER PLANES
00169 !
00170         IF(NPLAN.GT.2) THEN
00171           DO IPLAN=2,NPLAN-1
00172             DO I2=1,NPOIN2
00173               I3=I2+(IPLAN-1)*NPOIN2
00174               SEGDOWN=NSEGH+NPOIN2*(IPLAN-2)+I2
00175               SEGUP  =SEGDOWN+NPOIN2
00176               XAUX(I3,1)=TETA*AX(SEGDOWN)
00177               XAUX(I3,3)=TETA*AX(SEGUP)
00178             ENDDO
00179           ENDDO
00180         ENDIF
00181 !
00182         CALL OV('X=CX    ',AX(NSEGH+1:NSEGH+NSEGV),AX,AX,
00183      &          1.D0-TETA,NSEGV)
00184 !
00185       ELSE
00186         WRITE(LU,*) 'GETTRISEG: UNKNOWN ELEMENT:',IELM3
00187         CALL PLANTE(1)
00188         STOP
00189       ENDIF
00190 !
00191 !-----------------------------------------------------------------------
00192 !
00193 !     PARALLEL MODE
00194 !
00195       IF(NCSIZE.GT.1) THEN
00196         IAN    = 3
00197         ICOM   = 2
00198         CALL PARCOM2(XAUX(1,1),XAUX(1,2),XAUX(1,3),
00199      &               NPOIN2,NPLAN,ICOM,IAN,MESH)
00200       ENDIF
00201 !
00202 !-----------------------------------------------------------------------
00203 !
00204       RETURN
00205       END

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