fropro.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\utils\bief\fropro.f
00002 !
00065                      SUBROUTINE FROPRO
00066 !                    *****************
00067 !
00068      &(NBOR,IKLE,NELEM,NELMAX,NPOIN,NPMAX,NPTFR,IELM,
00069      & IKLEM1,LIMVOI,OPTASS,PRODUC,MXPTVS,T1,
00070      & GLOSEG,SIZGLO,NSEG)
00071 !
00072 !***********************************************************************
00073 ! BIEF   V6P3                                  21/08/2010
00074 !***********************************************************************
00075 !
00076 !
00077 !
00078 !
00079 !
00080 !
00081 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00082 !| GLOSEG         |-->| FIRST AND SECOND POINT OF SEGMENTS
00083 !| IELM           |-->| TYPE OF ELEMENT.
00084 !|                |   | 11 : TRIANGLES.
00085 !|                |   | 21 : QUADRANGLES.
00086 !| IKLE           |-->| CONNECTIVITY TABLE.
00087 !| IKLEM1         |<--| VARIOUS ADDRESSES IN OFF-DIAGONAL PART
00088 !|                |   | OF A MATRIX
00089 !| LIMVOI         |<--| LIMVOI(K,1) : BEGINNING OF SERIES WITH K NEIGHBOURS
00090 !|                |   | LIMVOI(K,2) : END       OF SERIES WITH K NEIGHBOURS
00091 !| MXPTVS         |-->| MAXIMUM NUMBER OF NEIGHBOURS OF A POINT
00092 !| NBOR           |-->| GLOBAL NUMBER OF BOUNDARY POINTS
00093 !| NELEM          |-->| NUMBER OF ELEMENTS
00094 !| NELMAX         |-->| MAXIMUM NUMBER OF ELEMENTS
00095 !| NPMAX          |-->| MAXIMUM NUMBER OF POINTS
00096 !| NPOIN          |-->| NUMBER OF POINTS
00097 !| NPTFR          |-->| NUMBER OF BOUNDARY POINTS
00098 !| NSEG           |-->| NUMBER OF SEGMENTS
00099 !| OPTASS         |-->| OPTION OF MATRIX STORAGE
00100 !|                |   | 1: ELEMENT PER ELEMENT 3: EDGE-BASED
00101 !| PRODUC         |-->| CHOICE OF MATRIX-VECTOR PRODUCT
00102 !|                |   | 1: NORMAL 2: FRONTAL
00103 !| SIZGLO         |-->| FIRST DIMENSION OF GLOSEG
00104 !| T1             |-->| INTEGER WORK ARRAY
00105 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00106 !
00107       USE BIEF, EX_FROPRO => FROPRO
00108 !
00109       IMPLICIT NONE
00110       INTEGER LNG,LU
00111       COMMON/INFO/LNG,LU
00112 !
00113 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00114 !
00115       INTEGER, INTENT(IN)    :: NELMAX,NPMAX,MXPTVS,NELEM
00116       INTEGER, INTENT(IN)    :: NPOIN,NPTFR,IELM,OPTASS,PRODUC
00117       INTEGER, INTENT(IN)    :: NSEG,SIZGLO,NBOR(*)
00118       INTEGER, INTENT(IN)    :: IKLE(NELMAX,*),GLOSEG(SIZGLO,2)
00119       INTEGER, INTENT(OUT)   :: IKLEM1(NPMAX,MXPTVS,4,2)
00120 !                                      11: SEE ALMESH AND OPASS
00121       INTEGER, INTENT(OUT)   :: LIMVOI(11,2)
00122       INTEGER, INTENT(OUT)   :: T1(NPOIN)
00123 !
00124 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00125 !
00126       INTEGER IELEM,IPTFR,IPOIN,ISG,K,I,I1,I2,NBVOIS
00127 !
00128 !-----------------------------------------------------------------------
00129 !
00130       IF(IELM.NE.11) THEN
00131         IF(LNG.EQ.1) WRITE(LU,900) IELM
00132         IF(LNG.EQ.2) WRITE(LU,901) IELM
00133 900     FORMAT(1X,'FROPRO : IELM=',1I6,' TYPE D''ELEMENT INCONNU')
00134 901     FORMAT(1X,'FROPRO: IELM=',1I6,' UNKNOWN TYPE OF ELEMENT')
00135         CALL PLANTE(1)
00136         STOP
00137       ENDIF
00138 !
00139       IF(PRODUC.EQ.2) THEN
00140 !
00141 !=======================================================================
00142 ! COMPUTES THE NUMBER OF NEIGHBOURING POINTS AND ELEMENTS
00143 !=======================================================================
00144 !
00145         DO IPOIN = 1,NPOIN
00146           T1(IPOIN) = 0
00147         ENDDO
00148 !
00149 !       NUMBER OF ELEMENTS NEIGHBOURING A POINT
00150 !
00151         DO IELEM = 1,NELEM
00152           T1(IKLE(IELEM,1)) = T1(IKLE(IELEM,1)) + 1
00153           T1(IKLE(IELEM,2)) = T1(IKLE(IELEM,2)) + 1
00154           T1(IKLE(IELEM,3)) = T1(IKLE(IELEM,3)) + 1
00155         ENDDO
00156 !
00157 !       NUMBER OF POINTS NEIGHBOURING A POINT
00158 !     = NUMBER OF ELEMENTS NEIGHBOURING A POINT
00159 !     + 1 ON BOUNDARIES
00160 !
00161         DO IPTFR = 1,NPTFR
00162           T1(NBOR(IPTFR)) = T1(NBOR(IPTFR)) + 1
00163         ENDDO
00164 !
00165 !=======================================================================
00166 ! CHECKS THAT THE RENUMBERING WAS MADE CORRECTLY IN STBTEL
00167 ! FILLS IN LIMVOI AND IKLEM1
00168 !=======================================================================
00169 !
00170         IF(T1(1).EQ.0) THEN
00171           IF(LNG.EQ.1) WRITE(LU,96)
00172           IF(LNG.EQ.2) WRITE(LU,97)
00173 96        FORMAT(1X,'FROPRO : LE POINT 1 N''A PAS DE VOISIN')
00174 97        FORMAT(1X,'FROPRO: POINT NUMBER 1 HAS NO NEIGHBOUR')
00175           CALL PLANTE(1)
00176           STOP
00177         ENDIF
00178 !
00179         DO IPOIN = 2,NPOIN
00180           IF(T1(IPOIN).LT.T1(IPOIN-1)) THEN
00181             IF(LNG.EQ.1) WRITE(LU,98)
00182             IF(LNG.EQ.2) WRITE(LU,99)
00183 98          FORMAT(1X,'FROPRO : PRODUIT FRONTAL, IL FAUT UNE',/,1X,
00184      &                'RENUMEROTATION DES POINTS AVEC STBTEL')
00185 99          FORMAT(1X,'FROPRO: FRONTAL PRODUCT REQUIRES A',/,1X,
00186      &                'RENUMBERING OF POINTS WITH STBTEL')
00187             CALL PLANTE(1)
00188             STOP
00189           ELSEIF(T1(IPOIN).GT.MXPTVS) THEN
00190             IF(LNG.EQ.1) WRITE(LU,94) IPOIN
00191             IF(LNG.EQ.2) WRITE(LU,95) IPOIN
00192 94          FORMAT(1X,'FROPRO : LE POINT ',1I6,' A TROP DE VOISINS')
00193 95          FORMAT(1X,'FROPRO: POINT ',1I6,' HAS TOO MANY NEIGHBOURS')
00194             CALL PLANTE(1)
00195             STOP
00196           ENDIF
00197         ENDDO
00198 !
00199 !  BUILDS ARRAY LIMVOI
00200 !  LIMVOI(K,1) : BEGINNING OF SERIES WITH K NEIGHBOURS
00201 !  LIMVOI(K,2) : END       OF SERIES WITH K NEIGHBOURS
00202 !
00203         DO K=1,MXPTVS
00204           LIMVOI(K,1) = 0
00205           LIMVOI(K,2) = 0
00206         ENDDO
00207 !       POINT 1 IS THE BEGINNING OF SERIES WITH T1(1) NEIGHBOURS
00208         NBVOIS = T1(1)
00209         LIMVOI(NBVOIS,1) = 1
00210         DO I=2,NPOIN
00211           IF(T1(I).NE.NBVOIS) THEN
00212 !         PREVIOUS POINT WAS AN END OF A SERIES
00213           LIMVOI(NBVOIS,2) = I-1
00214 !         CURRENT POINT IS THE BEGINNING OF A SERIES
00215           NBVOIS = T1(I)
00216           LIMVOI(NBVOIS,1) = I
00217           ENDIF
00218         ENDDO
00219 !       POINT NPOIN IS THE END OF ITS SERIES
00220         LIMVOI(NBVOIS,2) = NPOIN
00221 !
00222 !   ARRAYS FOR FRONTAL MATRIX-VECTOR PRODUCT :
00223 !
00224         DO IPOIN = 1,NPOIN
00225           T1(IPOIN) = 1
00226         ENDDO
00227 !
00228         IF(OPTASS.EQ.3) THEN
00229 !
00230 !       IY DOES NOT DEPEND HERE ON THE DIRECT OR TRANSPOSE CHARACTER
00231         DO ISG = 1,NSEG
00232           I1 = GLOSEG(ISG,1)
00233           I2 = GLOSEG(ISG,2)
00234 !
00235 !         ANY MATRIX
00236 !         IXM IN DIRECT PRODUCT
00237           IKLEM1(I1,T1(I1),1,1) = ISG
00238           IKLEM1(I2,T1(I2),1,1) = ISG + NSEG
00239 !         IY IN DIRECT PRODUCT
00240           IKLEM1(I1,T1(I1),2,1) = I2
00241           IKLEM1(I2,T1(I2),2,1) = I1
00242 !         IXM IN TRANSPOSE PRODUCT
00243           IKLEM1(I1,T1(I1),3,1) = ISG + NSEG
00244           IKLEM1(I2,T1(I2),3,1) = ISG
00245 !         IY IN TRANSPOSE PRODUCT
00246           IKLEM1(I1,T1(I1),4,1) = I2
00247           IKLEM1(I2,T1(I2),4,1) = I1
00248 !
00249 !         SYMMETRICAL MATRIX
00250 !         IXM IN DIRECT PRODUCT
00251           IKLEM1(I1,T1(I1),1,2) = ISG
00252           IKLEM1(I2,T1(I2),1,2) = ISG
00253 !         IY IN DIRECT PRODUCT
00254           IKLEM1(I1,T1(I1),2,2) = I2
00255           IKLEM1(I2,T1(I2),2,2) = I1
00256 !         IXM IN TRANSPOSE PRODUCT
00257           IKLEM1(I1,T1(I1),3,2) = ISG
00258           IKLEM1(I2,T1(I2),3,2) = ISG
00259 !         IY IN TRANSPOSE PRODUCT
00260           IKLEM1(I1,T1(I1),4,2) = I2
00261           IKLEM1(I2,T1(I2),4,2) = I1
00262 !
00263 !         UPDATES THE NUMBER OF NEIGHBOURS
00264           T1(I1) = T1(I1) + 1
00265           T1(I2) = T1(I2) + 1
00266         ENDDO
00267 !
00268         ELSE
00269           IF(LNG.EQ.1) THEN
00270             WRITE(LU,*) 'STOCKAGE INCONNU DANS FROPRO :',OPTASS
00271           ENDIF
00272           IF(LNG.EQ.2) THEN
00273             WRITE(LU,*) 'UNKNOWN STORAGE IN FROPRO :',OPTASS
00274           ENDIF
00275           CALL PLANTE(1)
00276           STOP
00277         ENDIF
00278 !
00279       ENDIF
00280 !
00281 !-----------------------------------------------------------------------
00282 !
00283       RETURN
00284       END

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