lecfas.f

Go to the documentation of this file.

!                       *****************
                        SUBROUTINE lecfas
!                       *****************
!
     & (x, y, ikle, ncolor, tfast1, tfast2, addfas,
     &  ngeo , nfo1)
!
!***********************************************************************
! PROGICIEL : STBTEL V5.2          09/07/96   P. CHAILLET  (LHF)
!
!***********************************************************************
!
!     FONCTION  : LECTURE DES INFOS DE GEOMETRIE DANS LES FICHIERS
!                 ISSUS DU MAILLEUR FASTTABS
!
!-----------------------------------------------------------------------
!                             ARGUMENTS
! .________________.____.______________________________________________
! !      NOM       !MODE!                   ROLE
! !________________!____!______________________________________________
! ! X,Y            !<-- ! COORDONNEES DES POINTS DU MAILLAGE
! ! IKLE           !<-- ! NUMEROS GLOBAUX DES NOEUDS DE CHAQUE ELEMENT
! ! NCOLOR         !<-- ! TABLEAU DES COULEURS DES NOEUDS(POUR LES CL)
! ! NCOLOR         !<-- ! TABLEAU DES COULEURS DES NOEUDS(POUR LES CL)
! | TFAST1,2       | -->| TABLEAUX DE TRAVAIL (FASTTABS)
! | ADDFAS         | -->| INDICATEUR UTILISATION DES C.L. (FASTTABS)
! ! NGEO           !--> ! NUMERO DU CANAL DU FICHIER MAILLEUR
! ! NFO1           !--> ! NUMERO DU CANAL DU FICHIER TRIANGLE TRIGRID
! !________________!____!______________________________________________
! MODE : -->(DONNEE NON MODIFIEE), <--(RESULTAT), <-->(DONNEE MODIFIEE)
!-----------------------------------------------------------------------
! APPELE PAR :
! APPEL DE :
!***********************************************************************
!
      USE declarations_special
      USE declarations_stbtel, ONLY: nelem,npoin,nelmax
      IMPLICIT NONE
!
      INTEGER, INTENT(IN) :: NGEO, NFO1
      INTEGER, INTENT(INOUT) :: IKLE(nelmax,4)
      INTEGER, INTENT(INOUT) :: NCOLOR(*)
      INTEGER, INTENT(INOUT) :: TFAST1(*),TFAST2(*)
      LOGICAL, INTENT(IN) :: ADDFAS
      DOUBLE PRECISION, INTENT(INOUT) :: X(*), Y(*)
!
! VARIABLES LOCALES
      INTEGER ITYPND,IPOIN,IELEM,IP,IE, IGC,I,J
      INTEGER ELMLOC(8)
      REAL    U,V
      CHARACTER(LEN=80) LIGNE
!
      ipoin=0
      ielem=0
      DO i=1,npoin
        tfast1(i)=  -1
      ENDDO
!
! TRAITEMENT DE LA GEOMETRIE
! PREMIERE PASSE, ON S'OCCUPE DES ELEMENTS
!
      rewind(ngeo)
 10   READ (ngeo, '(A)',err=8000, end=1000) ligne
      IF (ligne(1:2).EQ.'GE') THEN
        ielem=ielem+1
        READ(ligne(4:80),*,err=8000,end=9000) ie, (elmloc(j),j=1,8)
!
! TRAITEMENT EN FONCTION DU TYPE D'ELEMENT
!
!
        IF (elmloc(8).NE.0) THEN
!
! QUADRANGLE QUADRATIQUE
!- Il faut splitter les elements
!- on elimine des points
!
!
! - 1er element
!
          ikle(ielem,1)=elmloc(1)
          ikle(ielem,2)=elmloc(3)
          ikle(ielem,3)=elmloc(5)
!
! - 2eme element
!
          ielem=ielem+1
          ikle(ielem,1)=elmloc(5)
          ikle(ielem,2)=elmloc(7)
          ikle(ielem,3)=elmloc(1)
        ELSEIF (elmloc(6).NE.0) THEN
!
! TRIANGLE QUADRATIQUE
!- on elimine des points
!
          ikle(ielem,1)=elmloc(1)
          ikle(ielem,2)=elmloc(3)
          ikle(ielem,3)=elmloc(5)
        ELSEIF (elmloc(4).NE.0) THEN
!
! QUADRANGLE LINEAIRE
!- Il faut splitter les elements
!
!
! - 1er element
!
          ikle(ielem,1)=elmloc(1)
          ikle(ielem,2)=elmloc(2)
          ikle(ielem,3)=elmloc(3)
!
! - 2eme element
!
          ielem=ielem+1
          ikle(ielem,1)=elmloc(3)
          ikle(ielem,2)=elmloc(4)
          ikle(ielem,3)=elmloc(1)
        ELSE
!
!  TRIANGLE LINEAIRE
!- on conserve les elements tels quels
!
          DO i=1,3
            ikle(ielem,i)=elmloc(i)
          ENDDO
        ENDIF
!
      ENDIF
      GO TO 10
!
! TRAITEMENT DE LA GEOMETRIE
! DEUXIEME PASSE, ON S'OCCUPE DES POINTS
!
 1000 CONTINUE
      rewind(ngeo)
 20   READ (ngeo, '(A)',err=8000, end=1010) ligne
      IF (ligne(1:3).EQ.'GNN') THEN
        ipoin=ipoin+1
        READ(ligne(4:70),*,err=8000,end=9000)ip,x(ipoin),y(ipoin)
        tfast1(ip)=ipoin
      ENDIF
      GO TO 20
 1010 CONTINUE
!
! - CONVERTION DES NUMEROS DE POINTS DES ELEMENTS
!
      DO i=1,nelem
        DO j=1,3
          ikle(i,j)=tfast1(ikle(i,j))
        ENDDO
      ENDDO
!
! TRAITEMENT DES CONDITION CONDITIONS LIMITES
! SI DEMANDE
!
      IF (.NOT.addfas) THEN
        RETURN
!       ------
      ENDIF
! -------------------
      DO i=1,npoin
        tfast1(i)=  0
      ENDDO
      rewind(nfo1)
 30   READ (nfo1, '(A)',err=8010, end=2000) ligne
      IF (ligne(1:3).EQ.'BCN') THEN
!
! CARTE BCN : NODAL BOUNDARY CONDITION
!
        READ(ligne(4:70),*,err=8010,end=9010)itypnd
        IF (itypnd.EQ.200) THEN
!
! FASTTABS BOUNDARY CONDITION = EXIT HEAD
!
          ncolor(ip)=1
        ELSEIF (itypnd.EQ.1200) THEN
!
! FASTTABS BOUNDARY CONDITION = SLIP EXIT HEAD
!
          ncolor(ip)=11
        ELSEIF (itypnd.EQ.1100) THEN
!
! FASTTABS BOUNDARY CONDITION = VELOCITY
!
          ncolor(ip)=9
        ENDIF
      ELSEIF (ligne(1:3).EQ.'BQL') THEN
!
! CARTE BQL : NODAL BOUNDARY CONDITION
!
        READ(ligne(4:70),*,err=8010,end=9010) igc, u, v
        tfast1(igc)=8
      ELSEIF (ligne(1:3).EQ.'BHL') THEN
!
! CARTE BHL : NODAL BOUNDARY CONDITION
!
        READ(ligne(4:70),*,err=8010,end=9010) igc, u
        tfast2(igc)=1
      ENDIF
      GO TO 30
 2000 CONTINUE
!
! ON VA RELIRE LE FICHIER NFO1 (BC)
! POUR LIRE LES CARTES GC
!
      igc=0
      rewind(nfo1)
 40   READ (nfo1, '(A)',err=8010, end=3000) ligne
      IF (ligne(1:3).EQ.'GC') THEN
        igc=igc+1
        READ(ligne(4:70),*,err=8010,end=9010)ie,
     &                (tfast2(i),i=1,ie)
        DO i=1,ie
          ncolor(tfast2(i))=tfast1(igc)
        ENDDO
      ENDIF
      GO TO 40
 3000 RETURN
 8000 CONTINUE
      WRITE (lu,4001)
 4001 FORMAT (//,1x,'****************************'
     &        ,/,1x,'SUBROUTINE LECFAS :'
     &        ,/,1x,'ERROR READING FASTTABS FILE.'
     &        ,/,1x,'****************************')
      CALL plante(1)
      stop
 9000 CONTINUE
      WRITE (lu,4011)
 4011 FORMAT (//,1x,'***************************************'
     &        ,/,1x,'SUBROUTINE LECFAS : UNEXPECTED END OF'
     &        ,/,1x,'FASTTABS FILE ENCOUNTERED'
     &        ,/,1x,'***************************************')
      CALL plante(1)
      stop
 8010 CONTINUE
      WRITE (lu,4021)
 4021 FORMAT (//,1x,'***************************************'
     &        ,/,1x,'SUBROUTINE LECFAS : ERROR READING'
     &        ,/,1x,'FASTTABS BOUNDARY CONDITION FILE'
     &        ,/,1x,'***************************************')
      CALL plante(1)
      stop
 9010 CONTINUE
      WRITE (lu,4031)
 4031 FORMAT (//,1x,'***************************************'
     &        ,/,1x,'SUBROUTINE LECFAS : END OF'
     &        ,/,1x,'FASTTABS BOUNDARY CONDITION FILE ENCOUNTERED'
     &        ,/,1x,'***************************************')
      CALL plante(1)
      stop
      END