assex3.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\utils\bief\assex3.f
00002 !
00070                      SUBROUTINE ASSEX3
00071 !                    *****************
00072 !
00073      &(XM,STO,NAME,IELM1,IELM2,TYPEXT,XMT,DIM1XMT,DIM2XMT,STOXMT,
00074      & MESH,NELMAX,ELTSEG,ORISEG)
00075 !
00076 !***********************************************************************
00077 ! BIEF   V6P3                                   21/08/2010
00078 !***********************************************************************
00079 !
00080 !
00081 !
00082 !
00083 !
00084 !
00085 !
00086 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00087 !| DIM1XMT        |-->| FIRST DIMENSION OF XMT
00088 !| DIM2XMT        |-->| SECOND DIMENSION OF XMT
00089 !| ELTSEG         |-->| SEGMENTS IN AN ELEMENT
00090 !| IELM1          |-->| ELEMENT OF LINES IN THE MATRIX
00091 !| IELM2          |-->| ELEMENT OF ROWS IN THE MATRIX
00092 !| MESH           |-->| MESH-STRUCTURE
00093 !| NAME           |-->| FORTRAN NAME OF THE MATRIX
00094 !| NELMAX         |-->| MAXIMUM NUMBER OF ELEMENTS IN THE MESH
00095 !| ORISEG         |-->| ORIENTATION OF SEGMENTS
00096 !| STO            |-->| STORAGE REQUIRED IN XM 1: EBE  3: EDGE-BASED
00097 !| STOXMT         |-->| STORAGE OF OFF-DIAGONAL TERMS
00098 !|                |   | 1: XMT(NELMAX,*)  2: XMT(*,NELMAX)
00099 !| TYPEXT         |-->| TYPE OF OFF-DIAGONAL TERMS
00100 !| XM             |<->| ASSEMBLED OFF-DIAGONAL TERMS
00101 !| XMT            |<->| OFF-DIAGONAL TERMS OF THE WORK MATRIX
00102 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00103 !
00104       USE BIEF, EX_ASSEX3 => ASSEX3
00105 !
00106       IMPLICIT NONE
00107       INTEGER LNG,LU
00108       COMMON/INFO/LNG,LU
00109 !
00110 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00111 !
00112       INTEGER         , INTENT(INOUT) :: STO
00113       CHARACTER(LEN=6), INTENT(IN)    :: NAME
00114       INTEGER         , INTENT(IN)    :: IELM1,IELM2,NELMAX
00115       INTEGER         , INTENT(IN)    :: DIM1XMT,DIM2XMT,STOXMT
00116       INTEGER         , INTENT(IN)    :: ELTSEG(NELMAX,*)
00117       INTEGER         , INTENT(IN)    :: ORISEG(NELMAX,*)
00118       CHARACTER(LEN=1), INTENT(IN)    :: TYPEXT
00119       DOUBLE PRECISION, INTENT(INOUT) :: XMT(DIM1XMT,DIM2XMT)
00120       DOUBLE PRECISION, INTENT(INOUT) :: XM(*)
00121       TYPE(BIEF_MESH) , INTENT(IN)    :: MESH
00122 !
00123 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00124 !
00125       INTEGER NELEM,STOM
00126 !
00127 !-----------------------------------------------------------------------
00128 !
00129 !  EXTRACTS MATRIX M CHARACTERISTICS
00130 !
00131       STOM = STO
00132       IF(STOM.NE.1) THEN
00133         IF (LNG.EQ.1) WRITE(LU,500) NAME,STOM
00134         IF (LNG.EQ.2) WRITE(LU,501) NAME,STOM
00135 500     FORMAT(1X,'ASSEX3 (BIEF) : MATRICE M (NOM REEL : ',A6,')',/,1X,
00136      &            '                STOCKAGE NON PREVU : ',1I6)
00137 501     FORMAT(1X,'ASSEX3 (BIEF) : MATRIX  M (REAL NAME:',A6,')',/,1X,
00138      &            '                UNEXPECTED STORAGE: ',1I6)
00139         CALL PLANTE(1)
00140         STOP
00141       ENDIF
00142 !
00143 !-----------------------------------------------------------------------
00144 !
00145       IF( (DIMENS(IELM1).NE.MESH%DIM) .AND.
00146      &   (IELM1.NE.81.AND.IELM2.NE.81) ) THEN
00147 !       BOUNDARY MATRIX : NOT TREATED HERE
00148         IF (LNG.EQ.1) WRITE(LU,100) NAME
00149         IF (LNG.EQ.2) WRITE(LU,101) NAME
00150         IF (LNG.EQ.1) WRITE(LU,200) IELM1,IELM2
00151         IF (LNG.EQ.2) WRITE(LU,201) IELM1,IELM2
00152         IF (LNG.EQ.1) WRITE(LU,300)
00153         IF (LNG.EQ.2) WRITE(LU,301)
00154         CALL PLANTE(1)
00155         STOP
00156       ENDIF
00157 !
00158       IF(DIMENS(IELM1).EQ.MESH%DIM) THEN
00159 !       NORMAL MATRIX
00160         NELEM  = MESH%NELEM
00161       ELSE
00162 !       BOUNDARY MATRIX
00163         NELEM  = MESH%NELEB
00164       ENDIF
00165 !
00166 !-----------------------------------------------------------------------
00167 !
00168       IF(IELM1.EQ.11.AND.IELM2.EQ.11) THEN
00169 !
00170 !       P1-P1 TRIANGLES MATRIX
00171 !
00172         IF(TYPEXT.EQ.'S') THEN
00173           CALL AS3_1111_S(XM,BIEF_NBSEG(11,MESH),
00174      &                    XMT,NELMAX,NELEM,
00175      &                    ELTSEG(1,1),ELTSEG(1,2),ELTSEG(1,3))
00176         ELSEIF(TYPEXT.EQ.'Q') THEN
00177           CALL AS3_1111_Q(XM,BIEF_NBSEG(11,MESH),
00178      &                    XMT,DIM1XMT,DIM2XMT,NELMAX,NELEM,STOXMT,
00179      &                    ELTSEG(1,1),ELTSEG(1,2),ELTSEG(1,3),
00180      &                    ORISEG(1,1),ORISEG(1,2),ORISEG(1,3))
00181         ENDIF
00182 !
00183       ELSEIF(IELM1.EQ.11.AND.IELM2.EQ.12) THEN
00184 !
00185 !       P1-QB TRIANGLES MATRIX
00186 !
00187           CALL AS3_1112(XM,BIEF_NBSEG(IELM1,MESH),
00188      &                  BIEF_NBSEG(IELM2,MESH),
00189      &                  XMT,NELMAX,NELEM,
00190      &                  ELTSEG(1,1),ELTSEG(1,2),ELTSEG(1,3),
00191      &                  ELTSEG(1,4),ELTSEG(1,5),ELTSEG(1,6),
00192      &                  ORISEG(1,1),ORISEG(1,2),ORISEG(1,3))
00193 !
00194       ELSEIF(IELM1.EQ.11.AND.IELM2.EQ.13) THEN
00195 !
00196 !       P1-QUADRATIC TRIANGLES MATRIX
00197 !
00198           CALL AS3_1113(XM,BIEF_NBSEG(IELM1,MESH),
00199      &                  BIEF_NBSEG(IELM2,MESH),
00200      &                  XMT,NELMAX,NELEM,ELTSEG,ORISEG)
00201 !
00202       ELSEIF(IELM1.EQ.13.AND.IELM2.EQ.11) THEN
00203 !
00204 !       QUADRATIC-P1 TRIANGLES MATRIX
00205 !
00206           CALL AS3_1311(XM,BIEF_NBSEG(IELM2,MESH),
00207      &                  BIEF_NBSEG(IELM1,MESH),
00208      &                  XMT,NELMAX,NELEM,ELTSEG,ORISEG)
00209 !
00210       ELSEIF(IELM1.EQ.12.AND.IELM2.EQ.11) THEN
00211 !
00212 !       P1-QB TRIANGLES MATRIX
00213 !
00214           CALL AS3_1211(XM,BIEF_NBSEG(11,MESH),
00215      &                  BIEF_NBSEG(12,MESH),
00216      &                  XMT,NELMAX,NELEM,
00217      &                  ELTSEG(1,1),ELTSEG(1,2),ELTSEG(1,3),
00218      &                  ELTSEG(1,4),ELTSEG(1,5),ELTSEG(1,6),
00219      &                  ORISEG(1,1),ORISEG(1,2),ORISEG(1,3))
00220 !
00221       ELSEIF(IELM1.EQ.12.AND.IELM2.EQ.12) THEN
00222 !
00223 !       QB-QB TRIANGLES MATRIX
00224 !
00225         IF(TYPEXT.EQ.'S') THEN
00226           CALL AS3_1212_S(XM,BIEF_NBSEG(11,MESH),
00227      &                    BIEF_NBSEG(12,MESH),XMT,NELMAX,NELEM,
00228      &                    ELTSEG(1,1),ELTSEG(1,2),ELTSEG(1,3),
00229      &                    ELTSEG(1,4),ELTSEG(1,5),ELTSEG(1,6))
00230         ELSEIF(TYPEXT.EQ.'Q') THEN
00231           CALL AS3_1212_Q(XM,BIEF_NBSEG(11,MESH),
00232      &                    BIEF_NBSEG(12,MESH),
00233      &                    XMT,NELMAX,NELEM,
00234      &                    ELTSEG(1,1),ELTSEG(1,2),ELTSEG(1,3),
00235      &                    ELTSEG(1,4),ELTSEG(1,5),ELTSEG(1,6),
00236      &                    ORISEG(1,1),ORISEG(1,2),ORISEG(1,3))
00237         ENDIF
00238 !
00239       ELSEIF(IELM1.EQ.13.AND.IELM2.EQ.13) THEN
00240 !
00241 !       QUADRATIC TRIANGLES MATRIX
00242 !
00243         IF(TYPEXT.EQ.'S') THEN
00244           CALL AS3_1313_S(XM,BIEF_NBSEG(IELM1,MESH),
00245      &                    XMT,DIM1XMT,DIM2XMT,STOXMT,
00246      &                    NELMAX,NELEM,ELTSEG)
00247         ELSEIF(TYPEXT.EQ.'Q') THEN
00248           CALL AS3_1313_Q(XM,BIEF_NBSEG(IELM1,MESH),
00249      &                    XMT,DIM1XMT,DIM2XMT,STOXMT,
00250      &                    NELMAX,NELEM,ELTSEG,ORISEG)
00251         ENDIF
00252 !
00253       ELSEIF(IELM1.EQ.41.AND.IELM2.EQ.41) THEN
00254 !
00255 !       PRISMS MATRIX
00256 !
00257         IF(TYPEXT.EQ.'S') THEN
00258           CALL AS3_4141_S(XM,BIEF_NBSEG(IELM1,MESH),
00259      &                    XMT,DIM1XMT,DIM2XMT,STOXMT,
00260      &                    NELMAX,NELEM,ELTSEG)
00261         ELSEIF(TYPEXT.EQ.'Q') THEN
00262           CALL AS3_4141_Q(XM,BIEF_NBSEG(IELM1,MESH),
00263      &                    XMT,DIM1XMT,DIM2XMT,STOXMT,
00264      &                    NELMAX,NELEM,ELTSEG,ORISEG)
00265         ENDIF
00266 !
00267       ELSEIF( (IELM1.EQ.31.AND.IELM2.EQ.31).OR.
00268      &        (IELM1.EQ.51.AND.IELM2.EQ.51)     ) THEN
00269 !
00270 !       TETRAHEDRONS MATRIX
00271 !
00272         IF(TYPEXT.EQ.'S') THEN
00273           CALL AS3_3131_S(XM,BIEF_NBSEG(IELM1,MESH),
00274      &                    XMT,DIM1XMT,DIM2XMT,STOXMT,
00275      &                    NELMAX,NELEM,
00276      &                    ELTSEG(1,1),ELTSEG(1,2),ELTSEG(1,3),
00277      &                    ELTSEG(1,4),ELTSEG(1,5),ELTSEG(1,6))
00278         ELSEIF(TYPEXT.EQ.'Q') THEN
00279           CALL AS3_3131_Q(XM,BIEF_NBSEG(IELM1,MESH),
00280      &                    XMT,DIM1XMT,DIM2XMT,STOXMT,
00281      &                    NELMAX,NELEM,
00282      &                    ELTSEG(1,1),ELTSEG(1,2),ELTSEG(1,3),
00283      &                    ELTSEG(1,4),ELTSEG(1,5),ELTSEG(1,6),
00284      &                    ORISEG(1,1),ORISEG(1,2),ORISEG(1,3),
00285      &                    ORISEG(1,4),ORISEG(1,5),ORISEG(1,6))
00286         ENDIF
00287 !
00288       ELSEIF(IELM1.EQ.81.AND.IELM2.EQ.81) THEN
00289 !
00290 !       TETRAHEDRONS MATRIX
00291 !
00292         IF(TYPEXT.EQ.'S') THEN
00293           CALL AS3_8181_S(XM,BIEF_NBSEG(IELM1,MESH),
00294      &                    XMT,DIM1XMT,DIM2XMT,STOXMT,
00295      &                    NELMAX,NELEM,
00296      &                    ELTSEG(1,1),ELTSEG(1,2),ELTSEG(1,3))
00297         ELSEIF(TYPEXT.EQ.'Q') THEN
00298           CALL AS3_8181_Q(XM,BIEF_NBSEG(IELM1,MESH),
00299      &                    XMT,DIM1XMT,DIM2XMT,STOXMT,
00300      &                    NELMAX,NELEM,
00301      &                    ELTSEG(1,1),ELTSEG(1,2),ELTSEG(1,3),
00302      &                    ORISEG(1,1),ORISEG(1,2),ORISEG(1,3))
00303         ENDIF
00304 !
00305       ELSE
00306 !
00307 !       IELM1 / IELM2 COMBINATION NOT IMPLEMENTED: ERROR
00308 !
00309         IF (LNG.EQ.1) WRITE(LU,100) NAME
00310         IF (LNG.EQ.2) WRITE(LU,101) NAME
00311         IF (LNG.EQ.1) WRITE(LU,200) IELM1,IELM2
00312         IF (LNG.EQ.2) WRITE(LU,201) IELM1,IELM2
00313         IF (LNG.EQ.1) WRITE(LU,300)
00314         IF (LNG.EQ.2) WRITE(LU,301)
00315         CALL PLANTE(1)
00316         STOP
00317 !
00318       ENDIF
00319 !
00320 !-----------------------------------------------------------------------
00321 !
00322 !  NEW TYPE OF STORAGE
00323 !
00324       STO=3
00325 !
00326 !-----------------------------------------------------------------------
00327 !
00328 100   FORMAT(1X,'ASSEX3 (BIEF) : MATRICE M (NOM REEL : ',A6,')')
00329 200   FORMAT(1X,'                IELM1 = ',1I6,' IELM2 = ',1I6)
00330 300   FORMAT(1X,'                CAS NON PREVU')
00331 !
00332 101   FORMAT(1X,'ASSEX3 (BIEF) : MATRIX  M (REAL NAME:',A6,')')
00333 201   FORMAT(1X,'                IELM1 = ',1I6,' IELM2 = ',1I6)
00334 301   FORMAT(1X,'                THIS CASE IS NOT IMPLEMENTED')
00335 !
00336 !-----------------------------------------------------------------------
00337 !
00338       RETURN
00339       END

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