as3_1311.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\utils\bief\as3_1311.f
00002 !
00088                      SUBROUTINE AS3_1311
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         |-->| SEGMENT 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 !     -6*NELEM : SEGMENTS 10,11,12 NEED NO ASSEMBLY
00136 !                SEGMENTS 13,14,15 ARE NOT CONSIDERED
00137       DO ISEG = 1 , NSEG11+NSEG13-6*NELEM
00138         XM(ISEG) = 0.D0
00139       ENDDO
00140 !
00141 !     ASSEMBLES LINEAR PART
00142 !
00143       DO IELEM = 1,NELEM
00144 !
00145 !        SEGMENT 1 (TERMS 1-2 AND 2-1)
00146 !
00147         XM(ELTSEG(IELEM,1)+NSEG11*(ORISEG(IELEM,1)-1))
00148      &  =XM(ELTSEG(IELEM,1)+NSEG11*(ORISEG(IELEM,1)-1))+XMT(IELEM,01)
00149         XM(ELTSEG(IELEM,1)+NSEG11*(2-ORISEG(IELEM,1)))
00150      &  =XM(ELTSEG(IELEM,1)+NSEG11*(2-ORISEG(IELEM,1)))+XMT(IELEM,03)
00151 !
00152 !        SEGMENT 2 (TERMS 2-3 AND 3-2)
00153 !
00154         XM(ELTSEG(IELEM,2)+NSEG11*(ORISEG(IELEM,2)-1))
00155      &  =XM(ELTSEG(IELEM,2)+NSEG11*(ORISEG(IELEM,2)-1))+XMT(IELEM,04)
00156         XM(ELTSEG(IELEM,2)+NSEG11*(2-ORISEG(IELEM,2)))
00157      &  =XM(ELTSEG(IELEM,2)+NSEG11*(2-ORISEG(IELEM,2)))+XMT(IELEM,06)
00158 !
00159 !        SEGMENT 3 (TERMS 3-1 AND 1-3)
00160 !
00161         XM(ELTSEG(IELEM,3)+NSEG11*(ORISEG(IELEM,3)-1))
00162      &  =XM(ELTSEG(IELEM,3)+NSEG11*(ORISEG(IELEM,3)-1))+XMT(IELEM,05)
00163         XM(ELTSEG(IELEM,3)+NSEG11*(2-ORISEG(IELEM,3)))
00164      &  =XM(ELTSEG(IELEM,3)+NSEG11*(2-ORISEG(IELEM,3)))+XMT(IELEM,02)
00165 !
00166       ENDDO
00167 !
00168 !     ASSEMBLES, SEGMENTS BETWEEN LINEAR AND QUADRATIC POINTS
00169 !     (I.E. THE REST BUT NOT 13, 14 AND 15)
00170 !
00171 !     ASSEMBLES THE QUADRATIC PART
00172 !     BETWEEN XM(2*NSEG11+1) AND XM(NSEG11+NSEG13-3*NELEM)
00173 !     SEE IN COMP_SEG HOW ELTSEG4,5,6,7,8,9,10,11,12 ARE BUILT,
00174 !     THEIR NUMBERING STARTS AT NSEG11+1, HENCE HERE THE STORAGE IN
00175 !     XM STARTS AT 2*NSEG11+1
00176 !
00177       DO IELEM = 1,NELEM
00178 !       TERM OF SEGMENT 1-4
00179         XM(ELTSEG(IELEM,04)+NSEG11) =
00180      &  XM(ELTSEG(IELEM,04)+NSEG11) + XMT(IELEM,07)
00181 !       TERM OF SEGMENT 2-5
00182         XM(ELTSEG(IELEM,05)+NSEG11) =
00183      &  XM(ELTSEG(IELEM,05)+NSEG11) + XMT(IELEM,11)
00184 !       TERM OF SEGMENT 3-6
00185         XM(ELTSEG(IELEM,06)+NSEG11) =
00186      &  XM(ELTSEG(IELEM,06)+NSEG11) + XMT(IELEM,15)
00187 !       TERM OF SEGMENT 2-4
00188         XM(ELTSEG(IELEM,07)+NSEG11) =
00189      &  XM(ELTSEG(IELEM,07)+NSEG11) + XMT(IELEM,08)
00190 !       TERM OF SEGMENT 3-5
00191         XM(ELTSEG(IELEM,08)+NSEG11) =
00192      &  XM(ELTSEG(IELEM,08)+NSEG11) + XMT(IELEM,12)
00193 !       TERM OF SEGMENT 1-6
00194         XM(ELTSEG(IELEM,09)+NSEG11) =
00195      &  XM(ELTSEG(IELEM,09)+NSEG11) + XMT(IELEM,13)
00196       ENDDO
00197 !
00198 !     THESE 3 SEGMENTS ARE NOT SHARED, NO ASSEMBLY
00199 !
00200       DO IELEM = 1,NELEM
00201 !       TERM OF SEGMENT 1-5
00202         XM(ELTSEG(IELEM,10)+NSEG11) = XMT(IELEM,10)
00203 !       TERM OF SEGMENT 2-6
00204         XM(ELTSEG(IELEM,11)+NSEG11) = XMT(IELEM,14)
00205 !       TERM OF SEGMENT 3-4
00206         XM(ELTSEG(IELEM,12)+NSEG11) = XMT(IELEM,09)
00207       ENDDO
00208 !
00209 !-----------------------------------------------------------------------
00210 !
00211       RETURN
00212       END

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