as3_4141_q.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\utils\bief\as3_4141_q.f
00002 !
00100                      SUBROUTINE AS3_4141_Q
00101 !                    *********************
00102 !
00103      &(XM,NSEG1,XMT,DIM1XMT,DIM2XMT,STOXMT,NELMAX,NELEM,ELTSEG,ORISEG)
00104 !
00105 !***********************************************************************
00106 ! BIEF   V6P1                                   21/08/2010
00107 !***********************************************************************
00108 !
00109 !
00110 !
00111 !
00112 !
00113 !
00114 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00115 !| DIM1XMT        |-->| FIRST DIMENSION OF XMT
00116 !| DIM2XMT        |-->| SECOND DIMENSION OF XMT
00117 !| ELTSEG         |-->| SEGMENTS OF A TRIANGLE
00118 !| NELEM          |-->| NUMBER OF ELEMENTS IN THE MESH
00119 !| NELMAX         |-->| FIRST DIMENSION OF IKLE AND W.
00120 !| NSEG1          |-->| NUMBER OF SEGMENTS
00121 !| ORISEG         |-->| ORIENTATION OF SEGMENTS
00122 !| STOXMT         |-->| STORAGE OF XMT 1: (NELMAX,*)
00123 !|                |   |                2: (*,NELMAX)
00124 !| XM             |<--| ASSEMBLED OFF-DIAGONAL TERMS XA12,23,31
00125 !| XMT            |-->| ELEMENT BY ELEMENT STORAGE OF MATRIX
00126 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00127 !
00128       IMPLICIT NONE
00129       INTEGER LNG,LU
00130       COMMON/INFO/LNG,LU
00131 !
00132 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00133 !
00134       INTEGER         , INTENT(IN)    :: NELMAX,NELEM,NSEG1
00135       INTEGER         , INTENT(IN)    :: DIM1XMT,DIM2XMT,STOXMT
00136       INTEGER         , INTENT(IN)    :: ELTSEG(NELMAX,15)
00137       INTEGER         , INTENT(IN)    :: ORISEG(NELMAX,15)
00138       DOUBLE PRECISION, INTENT(IN)    :: XMT(DIM1XMT,DIM2XMT)
00139       DOUBLE PRECISION, INTENT(INOUT) :: XM(NSEG1,2)
00140 !
00141 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00142 !
00143       INTEGER ISEG,IELEM
00144 !
00145 !-----------------------------------------------------------------------
00146 !
00147 !     INITIALISES
00148 !
00149       DO ISEG = 1 , NSEG1
00150         XM(ISEG,1) = 0.D0
00151         XM(ISEG,2) = 0.D0
00152       ENDDO
00153 !
00154 !-----------------------------------------------------------------------
00155 !
00156       IF(STOXMT.EQ.1) THEN
00157 !
00158 !     ASSEMBLES
00159 !
00160       DO IELEM = 1,NELEM
00161 !
00162 !         SEGMENT 01 (TERMS 1-2 AND 2-1)
00163           XM(ELTSEG(IELEM,01),ORISEG(IELEM,01))
00164      &  = XM(ELTSEG(IELEM,01),ORISEG(IELEM,01))   + XMT(IELEM,01)
00165           XM(ELTSEG(IELEM,01),3-ORISEG(IELEM,01))
00166      &  = XM(ELTSEG(IELEM,01),3-ORISEG(IELEM,01)) + XMT(IELEM,16)
00167 !
00168 !         SEGMENT 02 (TERMS 2-3 AND 3-2)
00169           XM(ELTSEG(IELEM,02),ORISEG(IELEM,02))
00170      &  = XM(ELTSEG(IELEM,02),ORISEG(IELEM,02))   + XMT(IELEM,06)
00171           XM(ELTSEG(IELEM,02),3-ORISEG(IELEM,02))
00172      &  = XM(ELTSEG(IELEM,02),3-ORISEG(IELEM,02)) + XMT(IELEM,21)
00173 !
00174 !         SEGMENT 03 (TERMS 3-1 AND 1-3)
00175           XM(ELTSEG(IELEM,03),ORISEG(IELEM,03))
00176      &  = XM(ELTSEG(IELEM,03),ORISEG(IELEM,03))   + XMT(IELEM,17)
00177           XM(ELTSEG(IELEM,03),3-ORISEG(IELEM,03))
00178      &  = XM(ELTSEG(IELEM,03),3-ORISEG(IELEM,03)) + XMT(IELEM,02)
00179 !
00180 !         SEGMENT 04 (TERMS 4-5 AND 5-4)
00181           XM(ELTSEG(IELEM,04),ORISEG(IELEM,04))
00182      &  = XM(ELTSEG(IELEM,04),ORISEG(IELEM,04))   + XMT(IELEM,13)
00183           XM(ELTSEG(IELEM,04),3-ORISEG(IELEM,04))
00184      &  = XM(ELTSEG(IELEM,04),3-ORISEG(IELEM,04)) + XMT(IELEM,28)
00185 !
00186 !         SEGMENT 05 (TERMS 5-6 AND 6-5)
00187           XM(ELTSEG(IELEM,05),ORISEG(IELEM,05))
00188      &  = XM(ELTSEG(IELEM,05),ORISEG(IELEM,05))   + XMT(IELEM,15)
00189           XM(ELTSEG(IELEM,05),3-ORISEG(IELEM,05))
00190      &  = XM(ELTSEG(IELEM,05),3-ORISEG(IELEM,05)) + XMT(IELEM,30)
00191 !
00192 !         SEGMENT 06 (TERMS 6-4 AND 4-6)
00193           XM(ELTSEG(IELEM,06),ORISEG(IELEM,06))
00194      &  = XM(ELTSEG(IELEM,06),ORISEG(IELEM,06))   + XMT(IELEM,29)
00195           XM(ELTSEG(IELEM,06),3-ORISEG(IELEM,06))
00196      &  = XM(ELTSEG(IELEM,06),3-ORISEG(IELEM,06)) + XMT(IELEM,14)
00197 !
00198 !         SEGMENT 7 (TERMS 1-4 AND 4-1)
00199           XM(ELTSEG(IELEM,7),1)=XM(ELTSEG(IELEM,7),1) + XMT(IELEM,03)
00200           XM(ELTSEG(IELEM,7),2)=XM(ELTSEG(IELEM,7),2) + XMT(IELEM,18)
00201 !
00202 !         SEGMENT 8 (TERMS 2-5 AND 5-2)
00203           XM(ELTSEG(IELEM,8),1)=XM(ELTSEG(IELEM,8),1) + XMT(IELEM,08)
00204           XM(ELTSEG(IELEM,8),2)=XM(ELTSEG(IELEM,8),2) + XMT(IELEM,23)
00205 !
00206 !         SEGMENT 9 (TERMS 3-6 AND 6-3)
00207           XM(ELTSEG(IELEM,9),1)=XM(ELTSEG(IELEM,9),1) + XMT(IELEM,12)
00208           XM(ELTSEG(IELEM,9),2)=XM(ELTSEG(IELEM,9),2) + XMT(IELEM,27)
00209 !
00210 !         SEGMENT 10 (TERMS 1-5 AND 5-1)
00211           XM(ELTSEG(IELEM,10),1)=XM(ELTSEG(IELEM,10),1) + XMT(IELEM,04)
00212           XM(ELTSEG(IELEM,10),2)=XM(ELTSEG(IELEM,10),2) + XMT(IELEM,19)
00213 !
00214 !         SEGMENT 11 (TERMS 2-4 AND 4-2)
00215           XM(ELTSEG(IELEM,11),1)=XM(ELTSEG(IELEM,11),1) + XMT(IELEM,07)
00216           XM(ELTSEG(IELEM,11),2)=XM(ELTSEG(IELEM,11),2) + XMT(IELEM,22)
00217 !
00218 !         SEGMENT 12 (TERMS 2-6 AND 6-2)
00219           XM(ELTSEG(IELEM,12),1)=XM(ELTSEG(IELEM,12),1) + XMT(IELEM,09)
00220           XM(ELTSEG(IELEM,12),2)=XM(ELTSEG(IELEM,12),2) + XMT(IELEM,24)
00221 !
00222 !         SEGMENT 13 (TERMS 3-5 AND 5-3)
00223           XM(ELTSEG(IELEM,13),1)=XM(ELTSEG(IELEM,13),1) + XMT(IELEM,11)
00224           XM(ELTSEG(IELEM,13),2)=XM(ELTSEG(IELEM,13),2) + XMT(IELEM,26)
00225 !
00226 !         SEGMENT 14 (TERMS 3-4 AND 4-3)
00227           XM(ELTSEG(IELEM,14),1)=XM(ELTSEG(IELEM,14),1) + XMT(IELEM,10)
00228           XM(ELTSEG(IELEM,14),2)=XM(ELTSEG(IELEM,14),2) + XMT(IELEM,25)
00229 !
00230 !         SEGMENT 15 (TERMS 1-6 AND 6-1)
00231           XM(ELTSEG(IELEM,15),1)=XM(ELTSEG(IELEM,15),1) + XMT(IELEM,05)
00232           XM(ELTSEG(IELEM,15),2)=XM(ELTSEG(IELEM,15),2) + XMT(IELEM,20)
00233 !
00234       ENDDO
00235 !
00236 !-----------------------------------------------------------------------
00237 !
00238       ELSEIF(STOXMT.EQ.2) THEN
00239 !
00240 !     ASSEMBLES
00241 !
00242       DO IELEM = 1,NELEM
00243 !
00244 !         SEGMENT 01 (TERMS 1-2 AND 2-1)
00245           XM(ELTSEG(IELEM,01),ORISEG(IELEM,01))
00246      &  = XM(ELTSEG(IELEM,01),ORISEG(IELEM,01))   + XMT(01,IELEM)
00247           XM(ELTSEG(IELEM,01),3-ORISEG(IELEM,01))
00248      &  = XM(ELTSEG(IELEM,01),3-ORISEG(IELEM,01)) + XMT(16,IELEM)
00249 !
00250 !         SEGMENT 02 (TERMS 2-3 AND 3-2)
00251           XM(ELTSEG(IELEM,02),ORISEG(IELEM,02))
00252      &  = XM(ELTSEG(IELEM,02),ORISEG(IELEM,02))   + XMT(06,IELEM)
00253           XM(ELTSEG(IELEM,02),3-ORISEG(IELEM,02))
00254      &  = XM(ELTSEG(IELEM,02),3-ORISEG(IELEM,02)) + XMT(21,IELEM)
00255 !
00256 !         SEGMENT 03 (TERMS 3-1 AND 1-3)
00257           XM(ELTSEG(IELEM,03),ORISEG(IELEM,03))
00258      &  = XM(ELTSEG(IELEM,03),ORISEG(IELEM,03))   + XMT(17,IELEM)
00259           XM(ELTSEG(IELEM,03),3-ORISEG(IELEM,03))
00260      &  = XM(ELTSEG(IELEM,03),3-ORISEG(IELEM,03)) + XMT(02,IELEM)
00261 !
00262 !         SEGMENT 04 (TERMS 4-5 AND 5-4)
00263           XM(ELTSEG(IELEM,04),ORISEG(IELEM,04))
00264      &  = XM(ELTSEG(IELEM,04),ORISEG(IELEM,04))   + XMT(13,IELEM)
00265           XM(ELTSEG(IELEM,04),3-ORISEG(IELEM,04))
00266      &  = XM(ELTSEG(IELEM,04),3-ORISEG(IELEM,04)) + XMT(28,IELEM)
00267 !
00268 !         SEGMENT 05 (TERMS 5-6 AND 6-5)
00269           XM(ELTSEG(IELEM,05),ORISEG(IELEM,05))
00270      &  = XM(ELTSEG(IELEM,05),ORISEG(IELEM,05))   + XMT(15,IELEM)
00271           XM(ELTSEG(IELEM,05),3-ORISEG(IELEM,05))
00272      &  = XM(ELTSEG(IELEM,05),3-ORISEG(IELEM,05)) + XMT(30,IELEM)
00273 !
00274 !         SEGMENT 06 (TERMS 6-4 AND 4-6)
00275           XM(ELTSEG(IELEM,06),ORISEG(IELEM,06))
00276      &  = XM(ELTSEG(IELEM,06),ORISEG(IELEM,06))   + XMT(29,IELEM)
00277           XM(ELTSEG(IELEM,06),3-ORISEG(IELEM,06))
00278      &  = XM(ELTSEG(IELEM,06),3-ORISEG(IELEM,06)) + XMT(14,IELEM)
00279 !
00280 !         SEGMENT 7 (TERMS 1-4 AND 4-1)
00281           XM(ELTSEG(IELEM,7),1)=XM(ELTSEG(IELEM,7),1) + XMT(03,IELEM)
00282           XM(ELTSEG(IELEM,7),2)=XM(ELTSEG(IELEM,7),2) + XMT(18,IELEM)
00283 !
00284 !         SEGMENT 8 (TERMS 2-5 AND 5-2)
00285           XM(ELTSEG(IELEM,8),1)=XM(ELTSEG(IELEM,8),1) + XMT(08,IELEM)
00286           XM(ELTSEG(IELEM,8),2)=XM(ELTSEG(IELEM,8),2) + XMT(23,IELEM)
00287 !
00288 !         SEGMENT 9 (TERMS 3-6 AND 6-3)
00289           XM(ELTSEG(IELEM,9),1)=XM(ELTSEG(IELEM,9),1) + XMT(12,IELEM)
00290           XM(ELTSEG(IELEM,9),2)=XM(ELTSEG(IELEM,9),2) + XMT(27,IELEM)
00291 !         SEGMENT 10 (TERMS 1-5 AND 5-1)
00292           XM(ELTSEG(IELEM,10),1)=XM(ELTSEG(IELEM,10),1) + XMT(04,IELEM)
00293           XM(ELTSEG(IELEM,10),2)=XM(ELTSEG(IELEM,10),2) + XMT(19,IELEM)
00294 !
00295 !         SEGMENT 11 (TERMS 2-4 AND 4-2)
00296           XM(ELTSEG(IELEM,11),1)=XM(ELTSEG(IELEM,11),1) + XMT(07,IELEM)
00297           XM(ELTSEG(IELEM,11),2)=XM(ELTSEG(IELEM,11),2) + XMT(22,IELEM)
00298 !
00299 !         SEGMENT 12 (TERMS 2-6 AND 6-2)
00300           XM(ELTSEG(IELEM,12),1)=XM(ELTSEG(IELEM,12),1) + XMT(09,IELEM)
00301           XM(ELTSEG(IELEM,12),2)=XM(ELTSEG(IELEM,12),2) + XMT(24,IELEM)
00302 !
00303 !         SEGMENT 13 (TERMS 3-5 AND 5-3)
00304           XM(ELTSEG(IELEM,13),1)=XM(ELTSEG(IELEM,13),1) + XMT(11,IELEM)
00305           XM(ELTSEG(IELEM,13),2)=XM(ELTSEG(IELEM,13),2) + XMT(26,IELEM)
00306 !
00307 !         SEGMENT 14 (TERMS 3-4 AND 4-3)
00308           XM(ELTSEG(IELEM,14),1)=XM(ELTSEG(IELEM,14),1) + XMT(10,IELEM)
00309           XM(ELTSEG(IELEM,14),2)=XM(ELTSEG(IELEM,14),2) + XMT(25,IELEM)
00310 !
00311 !         SEGMENT 15 (TERMS 1-6 AND 6-1)
00312           XM(ELTSEG(IELEM,15),1)=XM(ELTSEG(IELEM,15),1) + XMT(05,IELEM)
00313           XM(ELTSEG(IELEM,15),2)=XM(ELTSEG(IELEM,15),2) + XMT(20,IELEM)
00314 !
00315       ENDDO
00316 !
00317 !-----------------------------------------------------------------------
00318 !
00319       ELSE
00320         IF(LNG.EQ.1) THEN
00321           WRITE(LU,*) 'AS3_4141_Q : STOCKAGE DE XMT INCONNU : ',STOXMT
00322         ENDIF
00323         IF(LNG.EQ.2) THEN
00324           WRITE(LU,*) 'AS3_4141_Q: UNKNOWN STORAGE OF XMT : ',STOXMT
00325         ENDIF
00326         CALL PLANTE(1)
00327         STOP
00328       ENDIF
00329 !
00330 !-----------------------------------------------------------------------
00331 !
00332       RETURN
00333       END

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