as3_1113.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\utils\bief\as3_1113.f
00002 !
00088                      SUBROUTINE AS3_1113
00089 !                    *******************
00090 !
00091      &(XM,NSEG11,NSEG13,XMT,NELMAX,NELEM,ELTSEG,ORISEG)
00092 !
00093 !***********************************************************************
00094 ! BIEF   V6P1                                   21/08/2010
00095 !***********************************************************************
00096 !
00097 !
00098 !
00099 !
00100 !
00101 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00102 !| ELTSEG         |-->| SEGMENTS OF A TRIANGLE
00103 !| NELEM          |-->| NUMBER OF ELEMENTS IN THE MESH
00104 !| NELMAX         |-->| FIRST DIMENSION OF IKLE AND W.
00105 !| NSEG11         |-->| NUMBER OF LINEAR SEGMENTS
00106 !| NSEG13         |-->| NUMBER OF QUADRATIC SEGMENTS -
00107 !|                |   | THE NUMBER OF PURELY QUADRATIC SEGMENTS
00108 !|                |   | (THEY ARE NOT CONSIDERED IN RECTANGULAR
00109 !|                |   | MATRICES)
00110 !| ORISEG         |-->| ORIENTATION OF SEGMENTS
00111 !| XM             |<--| ASSEMBLED OFF-DIAGONAL TERMS XA12,23,31
00112 !| XMT            |-->| ELEMENT BY ELEMENT STORAGE OF MATRIX
00113 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00114 !
00115       IMPLICIT NONE
00116       INTEGER LNG,LU
00117       COMMON/INFO/LNG,LU
00118 !
00119 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00120 !
00121       INTEGER         , INTENT(IN)    :: NELMAX,NELEM,NSEG11,NSEG13
00122       INTEGER         , INTENT(IN)    :: ELTSEG(NELMAX,15)
00123       INTEGER         , INTENT(IN)    :: ORISEG(NELMAX,15)
00124       DOUBLE PRECISION, INTENT(IN)    :: XMT(NELMAX,*)
00125       DOUBLE PRECISION, INTENT(INOUT) :: XM(NSEG11+NSEG13-3*NELEM)
00126 !
00127 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00128 !
00129       INTEGER ISEG,IELEM
00130 !
00131 !-----------------------------------------------------------------------
00132 !
00133 !     INITIALISES
00134 !
00135 !     WHERE THERE WILL BE ASSEMBLING
00136       DO ISEG = 1 , NSEG11+NSEG13-6*NELEM
00137         XM(ISEG) = 0.D0
00138       ENDDO
00139 !
00140 !     ASSEMBLES, LINEAR PART
00141 !
00142       DO IELEM = 1,NELEM
00143 !
00144 !        SEGMENT 1 (TERMS 1-2 AND 2-1)
00145 !
00146         XM(ELTSEG(IELEM,1)+NSEG11*(ORISEG(IELEM,1)-1))
00147      &  =XM(ELTSEG(IELEM,1)+NSEG11*(ORISEG(IELEM,1)-1))+XMT(IELEM,01)
00148         XM(ELTSEG(IELEM,1)+NSEG11*(2-ORISEG(IELEM,1)))
00149      &  =XM(ELTSEG(IELEM,1)+NSEG11*(2-ORISEG(IELEM,1)))+XMT(IELEM,06)
00150 !
00151 !        SEGMENT 2 (TERMS 2-3 AND 3-2)
00152 !
00153         XM(ELTSEG(IELEM,2)+NSEG11*(ORISEG(IELEM,2)-1))
00154      &  =XM(ELTSEG(IELEM,2)+NSEG11*(ORISEG(IELEM,2)-1))+XMT(IELEM,07)
00155         XM(ELTSEG(IELEM,2)+NSEG11*(2-ORISEG(IELEM,2)))
00156      &  =XM(ELTSEG(IELEM,2)+NSEG11*(2-ORISEG(IELEM,2)))+XMT(IELEM,12)
00157 !
00158 !        SEGMENT 3 (TERMS 3-1 AND 1-3)
00159 !
00160         XM(ELTSEG(IELEM,3)+NSEG11*(ORISEG(IELEM,3)-1))
00161      &  =XM(ELTSEG(IELEM,3)+NSEG11*(ORISEG(IELEM,3)-1))+XMT(IELEM,11)
00162         XM(ELTSEG(IELEM,3)+NSEG11*(2-ORISEG(IELEM,3)))
00163      &  =XM(ELTSEG(IELEM,3)+NSEG11*(2-ORISEG(IELEM,3)))+XMT(IELEM,02)
00164 !
00165       ENDDO
00166 !
00167 !     ASSEMBLES, SEGMENTS BETWEEN LINEAR AND QUADRATIC POINTS
00168 !     (I.E. THE REST BUT NOT 13, 14 AND 15)
00169 !
00170 !     ASSEMBLES THE QUADRATIC PART
00171 !     BETWEEN XM(2*NSEG11+1) AND XM(NSEG11+NSEG13-3*NELEM)
00172 !     SEE IN COMP_SEG HOW ELTSEG4,5,6,7,8,9,10,11,12 ARE BUILT,
00173 !     THEIR NUMBERING STARTS AT NSEG11+1, HENCE HERE THE STORAGE IN
00174 !     XM STARTS AT 2*NSEG11+1
00175 !
00176 !     THE 6 SEGMENTS SHARED WITH OTHER TRIANGLES NEED ASSEMBLING
00177 !
00178       DO IELEM = 1,NELEM
00179 !       TERM OF SEGMENT 1-4
00180         XM(ELTSEG(IELEM,04)+NSEG11) =
00181      &  XM(ELTSEG(IELEM,04)+NSEG11) + XMT(IELEM,03)
00182 !       TERM OF SEGMENT 2-5
00183         XM(ELTSEG(IELEM,05)+NSEG11) =
00184      &  XM(ELTSEG(IELEM,05)+NSEG11) + XMT(IELEM,09)
00185 !       TERM OF SEGMENT 3-6
00186         XM(ELTSEG(IELEM,06)+NSEG11) =
00187      &  XM(ELTSEG(IELEM,06)+NSEG11) + XMT(IELEM,15)
00188 !       TERM OF SEGMENT 2-4
00189         XM(ELTSEG(IELEM,07)+NSEG11) =
00190      &  XM(ELTSEG(IELEM,07)+NSEG11) + XMT(IELEM,08)
00191 !       TERM OF SEGMENT 3-5
00192         XM(ELTSEG(IELEM,08)+NSEG11) =
00193      &  XM(ELTSEG(IELEM,08)+NSEG11) + XMT(IELEM,14)
00194 !       TERM OF SEGMENT 1-6
00195         XM(ELTSEG(IELEM,09)+NSEG11) =
00196      &  XM(ELTSEG(IELEM,09)+NSEG11) + XMT(IELEM,05)
00197       ENDDO
00198 !
00199 !     THE 3 SEGMENTS INSIDE THE TRIANGLE NEED NO ASSEMBLY
00200 !
00201       DO IELEM = 1,NELEM
00202 !       TERM OF SEGMENT 1-5
00203         XM(ELTSEG(IELEM,10)+NSEG11) = XMT(IELEM,04)
00204 !       TERM OF SEGMENT 2-6
00205         XM(ELTSEG(IELEM,11)+NSEG11) = XMT(IELEM,10)
00206 !       TERM OF SEGMENT 3-4
00207         XM(ELTSEG(IELEM,12)+NSEG11) = XMT(IELEM,13)
00208       ENDDO
00209 !
00210 !-----------------------------------------------------------------------
00211 !
00212       RETURN
00213       END

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