# matrix.f

Go to the documentation of this file.
```00001 C:\opentelemac\v7p0\sources\utils\bief\matrix.f
00002 !
00111                      SUBROUTINE MATRIX
00112 !                    *****************
00113 !
00115 !
00116 !***********************************************************************
00117 ! BIEF   V6P3                                   21/08/2010
00118 !***********************************************************************
00119 !
00120 !
00121 !
00122 !
00123 !
00124 !
00125 !
00126 !
00127 !
00128 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00129 !| F              |-->| FUNCTION USED IN THE FORMULA
00130 !| FORMUL         |-->| FORMULA DESCRIBING THE RESULTING MATRIX
00131 !| G              |-->| FUNCTION USED IN THE FORMULA
00132 !| H              |-->| FUNCTION USED IN THE FORMULA
00133 !| IELM1          |-->| TYPE OF ELEMENT FOR LINES
00134 !| IELM2          |-->| TYPE OF ELEMENT FOR COLUMNS
00135 !| M              |<->| MATRIX TO BE BUILT OR MODIFIED
00137 !|                |   | =1. : NORMAL   =0. : MASKED ELEMENT
00138 !| MESH           |-->| MESH STRUCTURE
00139 !| MSK            |-->| IF YES, THERE IS MASKED ELEMENTS.
00140 !| OP             |-->| OPERATION TO BE DONE. IF '=' THEN M=...
00141 !|                |   |                       IF '+' THEN M=M+
00142 !| U              |-->| FUNCTION USED IN THE FORMULA (COMPONENT OF VECTOR)
00143 !| V              |-->| FUNCTION USED IN THE FORMULA (COMPONENT OF VECTOR)
00144 !| W              |-->| FUNCTION USED IN THE FORMULA (COMPONENT OF VECTOR)
00145 !| XMUL           |-->| COEFFICIENT FOR MULTIPLICATION
00146 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00147 !
00148       USE BIEF, EX_MATRIX => MATRIX
00149 !
00150       IMPLICIT NONE
00151       INTEGER LNG,LU
00152       COMMON/INFO/LNG,LU
00153 !
00154 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00155 !
00156       INTEGER, INTENT(IN)            :: IELM1,IELM2
00157 !
00158       DOUBLE PRECISION, INTENT(IN)   :: XMUL
00159 !
00160       LOGICAL, INTENT(IN)            :: MSK
00161 !
00162       CHARACTER(LEN=16), INTENT(IN)  :: FORMUL
00163       CHARACTER(LEN=8), INTENT(IN)   :: OP
00164 !
00166       TYPE(BIEF_OBJ), INTENT(INOUT)  :: M
00167       TYPE(BIEF_MESH), INTENT(INOUT) :: MESH
00168 !
00169 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00170 !
00171       INTEGER NELMAX,NELEM,NPT,SS
00172       INTEGER, DIMENSION(:), POINTER :: IKLE
00173       INTEGER, DIMENSION(:), POINTER :: ELTSEG,ORISEG
00174       DOUBLE PRECISION C
00175       LOGICAL LEGO
00176 !
00177 !-----------------------------------------------------------------------
00178 !
00179 !     STORES 1 FOR THE WROKING ARRAY
00180 !     CAN BE MODIFIED BY ASSEXT THEREAFTER
00181 !
00182       MESH%M%STO = 1
00183 !
00184 !-----------------------------------------------------------------------
00185 !  CALLS THE SHUNTING AND ASSEMBLY SUBROUTINE : MATRIY
00186 !-----------------------------------------------------------------------
00187 !
00188 !     LEGO CAN BE MODIFIED BY MATRIY
00189       LEGO = .TRUE.
00190 !
00191       IF(DIMENS(IELM1).EQ.MESH%DIM) THEN
00192 !       NORMAL MATRIX
00193         NELEM  = MESH%NELEM
00194         NELMAX = MESH%NELMAX
00195         IKLE   =>MESH%IKLE%I
00196         ELTSEG=>MESH%ELTSEG%I
00197         ORISEG=>MESH%ORISEG%I
00198       ELSE
00199 !       BOUNDARY MATRIX
00200         NELEM  = MESH%NELEB
00201         NELMAX = MESH%NELEBX
00202         IKLE   =>MESH%IKLBOR%I
00203         ELTSEG=>MESH%ELTSEGBOR%I
00204         ORISEG=>MESH%ORISEGBOR%I
00205       ENDIF
00206 !
00207 !     MATRIY FILLS THE DIAGONAL AND EXTRA DIAGONAL TERMS
00208 !
00209 !     REFLECTS CHOICE OF PRE-ASSEMBLY STORAGE
00210       IF(M%STO.EQ.1.OR.M%STO.EQ.3) THEN
00211         SS = 1
00212       ELSEIF(M%STO.EQ.2) THEN
00213         SS = 2
00214       ELSE
00215         WRITE(LU,*) 'UNKNOWN STORAGE IN MATRIX'
00216         CALL PLANTE(1)
00217         STOP
00218       ENDIF
00219 !
00220       IF(NELEM.GT.0) THEN
00221         CALL MATRIY(FORMUL,MESH%M%X%R,
00222      &              MESH%M%TYPDIA,MESH%M%TYPEXT,
00223      &              XMUL,F,G,H,U,V,W,
00224      &              F%R,G%R,H%R,U%R,V%R,W%R,
00225      &              MESH%W%R,LEGO,
00226      &              MESH%XEL%R,MESH%YEL%R,MESH%ZEL%R,
00227      &              MESH%X%R,MESH%Y%R,MESH%Z%R,
00228      &              MESH%SURFAC%R,MESH%LGSEG%R,
00229      &              MESH%IKLE%I,MESH%IKLBOR%I,MESH%NBOR%I,
00230      &              MESH%NELBOR%I,MESH%NULONE%I,
00231      &              MESH%NELEM,MESH%NELMAX,
00232      &              MESH%NELEB,MESH%NELEBX,IELM1,IELM2,SS,
00233      &              MESH%NPOIN/BIEF_NBPTS(11,MESH),MESH,NELMAX)
00234       ENDIF
00235 !
00236 !  UPDATES THE INFORMATION OF THE MATRIX
00237 !
00238       NPT = BIEF_NBPTS(MIN(IELM1,IELM2),MESH)
00239 !
00240       IF(NPT.GT.MESH%M%D%MAXDIM1) THEN
00241         IF (LNG.EQ.1) WRITE(LU,500) MESH%M%NAME
00242         IF (LNG.EQ.2) WRITE(LU,501) MESH%M%NAME
00243         IF (LNG.EQ.1) WRITE(LU,2000) IELM1
00244         IF (LNG.EQ.2) WRITE(LU,2001) IELM1
00245         IF (LNG.EQ.1) WRITE(LU,3000) IELM2
00246         IF (LNG.EQ.2) WRITE(LU,3001) IELM2
00247         CALL PLANTE(1)
00248         STOP
00249       ENDIF
00250 !
00251       MESH%M%D%ELM  = MIN(IELM1,IELM2)
00252       MESH%M%D%DIM1 = NPT
00253       MESH%M%ELMLIN = IELM1
00254       MESH%M%ELMCOL = IELM2
00255 !
00256 !  ASSEMBLES THE DIAGONAL (POSSIBLY)
00257 !
00258       IF(LEGO.AND.MESH%M%TYPDIA.EQ.'Q'.AND.NELEM.GT.0) THEN
00259 !
00260             CALL ASSVEC(MESH%M%D%R,
00261      &                  IKLE,NPT,NELEM,NELMAX,MESH%M%D%ELM,
00263      &                  BIEF_NBPEL(MESH%M%D%ELM,MESH))
00264 !
00265       ENDIF
00266 !
00267 !  MASKS EXTRA-DIAGONAL TERMS (POSSIBLY)
00268 !
00269 !     NOTE: FOR STORAGE 2, EXTRA-DIAGONAL TERMS ARE NOT WHERE
00270 !           THEY SHOULD BE BUT DOES NOT AFFECT THE MULTIPLICATION
00272 !
00273       IF(MSK.AND.NELEM.GT.0) THEN
00275       ENDIF
00276 !
00277 !  ASSEMBLES EXTRA-DIAGONAL TERMS (POSSIBLY)
00278 !
00279       IF(M%STO.EQ.3) THEN
00280 !       COPIES THE DIAGONAL
00281         CALL OS('X=Y     ',MESH%MSEG%D,MESH%M%D,MESH%M%D,0.D0)
00282         MESH%MSEG%TYPDIA(1:1)='Q'
00283 !       ASSEMBLES EXTRA-DIAGONAL TERMS
00284         IF(MESH%M%TYPEXT.EQ.'Q'.OR.MESH%M%TYPEXT.EQ.'S') THEN
00285 !
00286 !       !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
00287 !
00288 !       CASE OF MATRICES WITH INVERTED STORAGE OF OFF-DIAGONAL TERMS
00289 !       SO FAR ONLY MAMURD. SEE INVERSION OF DIM1_EXT AND DIM2_EXT
00290 !       AND 2 INSTEAD OF 1 FOR STOXMT
00291 !
00292 !       !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
00293 !
00294           IF(FORMUL(1:6).EQ.'MAMURD') THEN
00295             CALL ASSEX3(MESH%MSEG%X%R,MESH%M%STO,MESH%M%NAME,
00296      &                  MESH%M%ELMLIN,MESH%M%ELMCOL,
00297      &                  MESH%M%TYPEXT,MESH%M%X%R,
00298      &                  BIEF_DIM2_EXT(IELM1,IELM2,MESH%M%STO,
00299      &                                MESH%M%TYPEXT,MESH),
00300      &                  BIEF_DIM1_EXT(IELM1,IELM2,MESH%M%STO,
00301      &                                MESH%M%TYPEXT,MESH),
00302      &                  2,
00303      &                  MESH,NELMAX,ELTSEG,ORISEG)
00304           ELSE
00305             CALL ASSEX3(MESH%MSEG%X%R,MESH%M%STO,MESH%M%NAME,
00306      &                  MESH%M%ELMLIN,MESH%M%ELMCOL,
00307      &                  MESH%M%TYPEXT,MESH%M%X%R,
00308      &                  BIEF_DIM1_EXT(IELM1,IELM2,MESH%M%STO,
00309      &                                MESH%M%TYPEXT,MESH),
00310      &                  BIEF_DIM2_EXT(IELM1,IELM2,MESH%M%STO,
00311      &                                MESH%M%TYPEXT,MESH),
00312      &                  1,
00313      &                  MESH,NELMAX,ELTSEG,ORISEG)
00314           ENDIF
00315         ENDIF
00316         MESH%MSEG%TYPEXT=MESH%M%TYPEXT
00317         MESH%MSEG%ELMLIN = IELM1
00318         MESH%MSEG%ELMCOL = IELM2
00319         MESH%MSEG%D%ELM  = MIN(IELM1,IELM2)
00320         MESH%MSEG%D%DIM1 = NPT
00321         MESH%MSEG%X%DIM1 = BIEF_DIM1_EXT(IELM1,IELM2,M%STO,
00322      &                                   MESH%MSEG%TYPEXT,MESH)
00323         MESH%MSEG%X%DIM2 = BIEF_DIM2_EXT(IELM1,IELM2,M%STO,
00324      &                                   MESH%MSEG%TYPEXT,MESH)
00325       ENDIF
00326 !
00327 !     DIMENSIONS OF THE ARRAY WITH EXTRADIAGONAL TERMS
00328 !     BEWARE M%STO (NOT MESH%M%STO BECAUSE IT EQUALS 1)
00329 !                   SEE BEGINNING OF SUBROUTINE
00330 !
00331       MESH%M%X%DIM1 = BIEF_DIM1_EXT(IELM1,IELM2,M%STO,
00332      &                              MESH%M%TYPEXT,MESH)
00333       MESH%M%X%DIM2 = BIEF_DIM2_EXT(IELM1,IELM2,M%STO,
00334      &                              MESH%M%TYPEXT,MESH)
00335 !
00336 !-----------------------------------------------------------------------
00337 !  UPDATES M AFTER WORK ON MESH%M IS COMPLETE
00338 !-----------------------------------------------------------------------
00339 !
00340       IF(NELEM.GT.0) THEN
00341 !
00342         IF(M%STO.EQ.1) THEN
00343           CALL OM( OP , M , MESH%M , F , C , MESH )
00344         ELSEIF(M%STO.EQ.3) THEN
00345           CALL OM( OP , M , MESH%MSEG , F , C , MESH )
00346         ELSE
00347           IF(LNG.EQ.1) WRITE(LU,*) 'MATRIX : STOCKAGE INCONNU : ',M%STO
00348           IF(LNG.EQ.2) WRITE(LU,*) 'MATRIX: UNKNOWN STORAGE : ',M%STO
00349           CALL PLANTE(1)
00350           STOP
00351         ENDIF
00352 !
00353       ENDIF
00354 !
00355 !-----------------------------------------------------------------------
00356 !
00357 500   FORMAT(1X,'MATRIX (BIEF) : MATRICE ',A6,' TROP PETITE')
00358 501   FORMAT(1X,'MATRIX (BIEF) : MATRIX ',A6,' TOO SMALL')
00359 2000  FORMAT(1X,'                POUR IELM1 = ',1I6)
00360 2001  FORMAT(1X,'                FOR IELM1 = ',1I6)
00361 3000  FORMAT(1X,'                ET IELM2 = ',1I6)
00362 3001  FORMAT(1X,'                AND IELM2 = ',1I6)
00363 !
00364 !-----------------------------------------------------------------------
00365 !
00366       RETURN
00367       END
```