comp_seg.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\utils\bief\comp_seg.f
00002 !
00081                      SUBROUTINE COMP_SEG
00082 !                    *******************
00083 !
00084      &(NELEM,NELMAX,IELM,IKLE,GLOSEG,MAXSEG,ELTSEG,ORISEG,NSEG)
00085 !
00086 !***********************************************************************
00087 ! BIEF   V6P1                                   21/08/2010
00088 !***********************************************************************
00089 !
00090 !
00091 !
00092 !
00093 !
00094 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00095 !| ELTSEG         |<--| SEGMENTS OF EVERY TRIANGLE.
00096 !| GLOSEG         |<--| GLOBAL NUMBERS OF POINTS OF SEGMENTS.
00097 !| IELM           |-->| 11: TRIANGLES.
00098 !|                |   | 21: QUADRILATERES.
00099 !| IKLE           |-->| NUMEROS GLOBAUX DES POINTS DE CHAQUE ELEMENT.
00100 !| MAXSEG         |<--| 1st DIMENSION OF MAXSEG.
00101 !| NELEM          |-->| NOMBRE D'ELEMENTS DANS LE MAILLAGE.
00102 !| NELMAX         |-->| NOMBRE MAXIMUM D'ELEMENTS DANS LE MAILLAGE.
00103 !|                |   | (CAS DES MAILLAGES ADAPTATIFS)
00104 !| NSEG           |<--| NUMBER OF SEGMENTS OF THE MESH.
00105 !| ORISEG         |-->| ORIENTATION OF SEGMENTS
00106 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00107 !
00108       USE BIEF, EX_COMP_SEG => COMP_SEG
00109 !
00110       IMPLICIT NONE
00111       INTEGER LNG,LU
00112       COMMON/INFO/LNG,LU
00113 !
00114 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00115 !
00116       INTEGER, INTENT(IN)    :: NELMAX,NSEG,MAXSEG,IELM,NELEM
00117       INTEGER, INTENT(IN)    :: IKLE(NELMAX,*)
00118       INTEGER, INTENT(INOUT) :: GLOSEG(MAXSEG,2),ELTSEG(NELMAX,*)
00119       INTEGER, INTENT(INOUT) :: ORISEG(NELMAX,*)
00120 !
00121 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00122 !
00123       INTEGER IELEM,IAD
00124 !
00125 !-----------------------------------------------------------------------
00126 !
00127       IF(IELM.EQ.12) THEN
00128 !
00129 !       3 ADDITIONAL SEGMENTS WITHIN QUASI-BUBBLE ELEMENTS
00130 !       FOR THEM ORISEG IS IMPLICITLY 1 AND IS NEVER USED
00131 !
00132         DO IELEM = 1 , NELEM
00133           ELTSEG(IELEM,4) = NSEG + 3*(IELEM-1) + 1
00134           ELTSEG(IELEM,5) = NSEG + 3*(IELEM-1) + 2
00135           ELTSEG(IELEM,6) = NSEG + 3*(IELEM-1) + 3
00136 !         PRINCIPLE: FROM LINEAR POINT TO QUASI-BUBBLE POINT
00137           GLOSEG(ELTSEG(IELEM,4),1) = IKLE(IELEM,1)
00138           GLOSEG(ELTSEG(IELEM,4),2) = IKLE(IELEM,4)
00139           GLOSEG(ELTSEG(IELEM,5),1) = IKLE(IELEM,2)
00140           GLOSEG(ELTSEG(IELEM,5),2) = IKLE(IELEM,4)
00141           GLOSEG(ELTSEG(IELEM,6),1) = IKLE(IELEM,3)
00142           GLOSEG(ELTSEG(IELEM,6),2) = IKLE(IELEM,4)
00143         ENDDO
00144 !
00145       ELSEIF(IELM.EQ.13) THEN
00146 !
00147 !       12 ADDITIONAL SEGMENTS IN QUADRATIC ELEMENTS
00148 !       SEE GLOSEG BELOW
00149 !
00150         DO IELEM = 1 , NELEM
00151 !         6 SMALL LATERAL SEGMENTS (NUMBERED LIKE THEIR LARGER
00152 !         SEGMENT WITH A SHIFT, AND SO THAT NUMBERS CORRESPOND
00153 !         ON EITHER SIDE)
00154           IF(ORISEG(IELEM,1).EQ.1) THEN
00155             ELTSEG(IELEM,04)=NSEG+ELTSEG(IELEM,01)
00156             ELTSEG(IELEM,07)=NSEG+ELTSEG(IELEM,01)+NSEG
00157           ELSE
00158             ELTSEG(IELEM,04)=NSEG+ELTSEG(IELEM,01)+NSEG
00159             ELTSEG(IELEM,07)=NSEG+ELTSEG(IELEM,01)
00160           ENDIF
00161           IF(ORISEG(IELEM,2).EQ.1) THEN
00162             ELTSEG(IELEM,05)=NSEG+ELTSEG(IELEM,02)
00163             ELTSEG(IELEM,08)=NSEG+ELTSEG(IELEM,02)+NSEG
00164           ELSE
00165             ELTSEG(IELEM,05)=NSEG+ELTSEG(IELEM,02)+NSEG
00166             ELTSEG(IELEM,08)=NSEG+ELTSEG(IELEM,02)
00167           ENDIF
00168           IF(ORISEG(IELEM,3).EQ.1) THEN
00169             ELTSEG(IELEM,06)=NSEG+ELTSEG(IELEM,03)
00170             ELTSEG(IELEM,09)=NSEG+ELTSEG(IELEM,03)+NSEG
00171           ELSE
00172             ELTSEG(IELEM,06)=NSEG+ELTSEG(IELEM,03)+NSEG
00173             ELTSEG(IELEM,09)=NSEG+ELTSEG(IELEM,03)
00174           ENDIF
00175         ENDDO
00176         IAD=3*NSEG
00177         DO IELEM = 1 , NELEM
00178 !         THE 3 LARGE SEGMENTS INSIDE THE ELEMENT
00179           ELTSEG(IELEM,10) = IAD + 3*(IELEM-1) + 1
00180           ELTSEG(IELEM,11) = IAD + 3*(IELEM-1) + 2
00181           ELTSEG(IELEM,12) = IAD + 3*(IELEM-1) + 3
00182         ENDDO
00183         IAD=IAD+3*NELEM
00184         DO IELEM = 1 , NELEM
00185 !         THE 3 SMALL SEGMENTS INSIDE THE ELEMENT
00186           ELTSEG(IELEM,13) = IAD + 3*(IELEM-1) + 1
00187           ELTSEG(IELEM,14) = IAD + 3*(IELEM-1) + 2
00188           ELTSEG(IELEM,15) = IAD + 3*(IELEM-1) + 3
00189         ENDDO
00190         IAD=IAD+3*NELEM
00191 !
00192         IF(IAD.NE.MAXSEG) THEN
00193           WRITE(LU,*) 'COMP_SEG: ERROR ON MAXIMUM NUMBER OF SEGMENTS'
00194           CALL PLANTE(1)
00195           STOP
00196         ENDIF
00197 !
00198         DO IELEM = 1 , NELEM
00199 !         FOR SEGMENTS 4 TO 12: FROM LINEAR POINT TO QUADRATIC POINT
00200 !         THIS IS IMPORTANT FOR RECTANGULAR MATRICES AND MVSEG
00201           GLOSEG(ELTSEG(IELEM,04),1) = IKLE(IELEM,1)
00202           GLOSEG(ELTSEG(IELEM,04),2) = IKLE(IELEM,4)
00203           GLOSEG(ELTSEG(IELEM,05),1) = IKLE(IELEM,2)
00204           GLOSEG(ELTSEG(IELEM,05),2) = IKLE(IELEM,5)
00205           GLOSEG(ELTSEG(IELEM,06),1) = IKLE(IELEM,3)
00206           GLOSEG(ELTSEG(IELEM,06),2) = IKLE(IELEM,6)
00207           GLOSEG(ELTSEG(IELEM,07),1) = IKLE(IELEM,2)
00208           GLOSEG(ELTSEG(IELEM,07),2) = IKLE(IELEM,4)
00209           GLOSEG(ELTSEG(IELEM,08),1) = IKLE(IELEM,3)
00210           GLOSEG(ELTSEG(IELEM,08),2) = IKLE(IELEM,5)
00211           GLOSEG(ELTSEG(IELEM,09),1) = IKLE(IELEM,1)
00212           GLOSEG(ELTSEG(IELEM,09),2) = IKLE(IELEM,6)
00213           GLOSEG(ELTSEG(IELEM,10),1) = IKLE(IELEM,1)
00214           GLOSEG(ELTSEG(IELEM,10),2) = IKLE(IELEM,5)
00215           GLOSEG(ELTSEG(IELEM,11),1) = IKLE(IELEM,2)
00216           GLOSEG(ELTSEG(IELEM,11),2) = IKLE(IELEM,6)
00217           GLOSEG(ELTSEG(IELEM,12),1) = IKLE(IELEM,3)
00218           GLOSEG(ELTSEG(IELEM,12),2) = IKLE(IELEM,4)
00219 !         FOR SEGMENTS 13 TO 15: NO SPECIFIC PRINCIPLE
00220           GLOSEG(ELTSEG(IELEM,13),1) = IKLE(IELEM,4)
00221           GLOSEG(ELTSEG(IELEM,13),2) = IKLE(IELEM,5)
00222           GLOSEG(ELTSEG(IELEM,14),1) = IKLE(IELEM,5)
00223           GLOSEG(ELTSEG(IELEM,14),2) = IKLE(IELEM,6)
00224           GLOSEG(ELTSEG(IELEM,15),1) = IKLE(IELEM,6)
00225           GLOSEG(ELTSEG(IELEM,15),2) = IKLE(IELEM,4)
00226 !         SHOULD NOT BE USEFUL (MEMORY TO BE REMOVED ?)
00227 !         ORIENTATION FROM LINEAR TO QUADRATIC NEEDS NO
00228 !         EXTRA INFORMATION
00229           ORISEG(IELEM,04) = 1
00230           ORISEG(IELEM,05) = 1
00231           ORISEG(IELEM,06) = 1
00232           ORISEG(IELEM,07) = 1
00233           ORISEG(IELEM,08) = 1
00234           ORISEG(IELEM,09) = 1
00235           ORISEG(IELEM,10) = 1
00236           ORISEG(IELEM,11) = 1
00237           ORISEG(IELEM,12) = 1
00238           ORISEG(IELEM,13) = 1
00239           ORISEG(IELEM,14) = 1
00240           ORISEG(IELEM,15) = 1
00241         ENDDO
00242       ELSE
00243         IF (LNG.EQ.1) WRITE(LU,500) IELM
00244         IF (LNG.EQ.2) WRITE(LU,501) IELM
00245 500     FORMAT(1X,'COMP_SEG (BIEF) : ELEMENT NON PREVU : ',1I6)
00246 501     FORMAT(1X,'COMP_SEG (BIEF): UNEXPECTED ELEMENT: ',1I6)
00247         CALL PLANTE(1)
00248         STOP
00249       ENDIF
00250 !
00251 !-----------------------------------------------------------------------
00252 !
00253       RETURN
00254       END

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