fm3sel.f

Go to the documentation of this file.

!                       *****************
                        SUBROUTINE fm3sel
!                       *****************
!
     &(x,y,npoin,nbor,nfic,std,nvar,texte,textlu,varcla,nvarcl,
     & titre,sorleo,nsor,w,ikle,
     & ikles,itrav,nelem,nptfr,ndp,mxptvs,mxelvs,date,time,
     & debu,suit,ecri,listin,iparam,ipobo,x_orig,y_orig)
!
!***********************************************************************
! PROGICIEL STBTEL V5.2       02/01/96    J-M HERVOUET (LNH) 30 71 80 18
!
!***********************************************************************
!
!     COMME FMTSEL, MAIS LA DIMENSION DE SORLEO  EST
!     PARAMETREE.
!
!     FONCTIONS :  LECTURE DU FICHIER GEOMETRIQUE AU STANDARD SELAFIN
!                  ECRITURE DU FICHIER GEOMETRIQUE AU STANDARD SELAFIN
!
!     LES FONCTIONS DE CE SOUS-PROGRAMME PEUVENT ETRE PILOTEES AVEC
!     LES ARGUMENTS DEBU, SUIT, ET ECRI
!
!     ATTENTION : 1) SI DEBU, SUIT ET ECRIT SONT A .FALSE.
!                    FM3SEL LIT LA GEOMETRIE.
!
!                 2) SI DEBU ITRAV DOIT ETRE LE TABLEAU IA DES ENTIERS
!                    ET ON NE DOIT PAS SE SERVIR DE IKLE ET IKLES
!                    CAR LE SOUS-PROGRAMME DE POINTEURS N'A PAS ENCORE
!                    ETE APPELE.
!-----------------------------------------------------------------------
!                             ARGUMENTS
! .________________.____.______________________________________________
! |      NOM       |MODE|                   ROLE
! |________________|____|______________________________________________
! |   X,Y          |<-->| COORDONNEES DU MAILLAGE.
! |   NPOIN        |<-->| NOMBRE DE POINTS DU MAILLAGE.
! |   NBOR         | -->| NUMEROTAION GLOBALE DES POINTS DE BORD.
! |   NFIC         | -->| NUMERO DE CANAL DU FICHIER A LIRE OU ECRIRE.
! |   STAND        | -->| NON UTILISE
! |   STD          | -->| BINAIRE DU FICHIER (STD, IBM, I3E)
! |   NVAR         |<-->| NOMBRE DE VARIABLES DANS LE FICHIER
! |   TEXTE        |<-->| NOMS ET UNITES DES VARIABLES.
! |   TEXTLU       |<-->| NOMS ET UNITES DES VARIABLES QU'ON VA LIRE.
! |   VARCLA       | -->| TABLEAU CONTENANT LES VARIABLES CLANDESTI-NES.
! |   NVARCL       | -->| NOMBRE DE VARIABLES CLANDESTI-NES.
! |   TITRE        |<-->| TITRE DU FICHIER.
! |   SORLEO       | -->| VARIABLES QUE L'ON SOUHAITE ECRIRE DANS LE
! |                |    | FICHIER (TABLEAU DE 26 LOGIQUES)
! |   NSOR         | -->| DIMENSION DE SOLRLEO
! |   W            | -->| TABLEAU DE TRAVAIL CONSIDERE ICI COMME REEL
! |                |    | DE TAILLE NPOIN.
! |   IKLE         |<-->| TABLE DE CONNECTIVITE (I.E. PASSAGE DE LA
! |                |    | NUMEROTATION LOCALE DES POINTS D'UN ELEMENT
! |                |    | A LA NUMEROTATION GLOBALE
! |   IKLES        | -->| TABLEAU DE TRAVAIL SERVANT A MODIFIER IKLE
! |                |    | DIMENSION NELEM * NDP
! |   ITRAV        | -->| TABLEAU DE TRAVAIL ENTIER DE DIMENSION NPOIN
! |   NELEM        |<-->| NOMBRE D'ELEMENTS DU MAILLAGE.
! |   NPTFR        |<-->| NOMBRE DE POINTS FRONTIERE DU DOMAINE.
! |   NDP          |<-->| NOMBRE DE SOMMETS PAR ELEMENT.
! |   DEBU         | -->| ON LIT UNIQUEMENT LE DEBUT DU FICHIER POUR
! |                |    | CONNAITRE LES NOMBRES DE POINTS AVEC LESQUELS
! |                |    | ON POURRA CONSTRUIRE LES POINTEURS.
! |   SUIT         | -->| ON LIT TOUTE LA PARTIE GEOMETRIE DU FICHIER
! |                |    | POUR SE PLACER SUR LES ENREGISTREMENTS DES
! |                |    | RESULTATS.
! |   ECRI         | -->| ON ECRIT LA PARTIE GEOMETRIE DU FICHIER
! |   LISTIN       | -->| ECRITURE D'INFORMATIONS SUR LISTING (OU NON)
! |________________|____|______________________________________________
! MODE : -->(DONNEE NON MODIFIEE), <--(RESULTAT), <-->(DONNEE MODIFIEE)
!-----------------------------------------------------------------------
!
! PROGRAMMES APPELES : LIT , ECRIT
!
!***********************************************************************
!
!    LISTE DES ENREGISTREMENTS DU FICHIER GEOMETRIQUE:
!
!      1    : TITRE DE L'ETUDE
!      2    : NOMBRE DE FONCTIONS LUES SUR LA GRILLE 1 ET LA GRILLE 2.
!      3    : NOM ET UNITE DES VARIABLES
!      4    : 1,0,0,0,0,0,0,0,0,0
!      5    : NELEM,NPOIN,NDP,1
!      6    : IKLE
!      7    : IPOBO TABLEAU DE DIMENSION NPOIN, 0 POUR LES POINTS
!             INTERIEURS, UN NUMERO SINON.
!      8    : X
!      9    : Y
!
!    CE QUI SUIT N'EST PAS FAIT DANS FM3SEL.
!
!     10    : TEMPS
!     11    : VARIABLES DECLAREES EN 3 (DANS L'ORDRE DES DECLARATIONS)
!
!***********************************************************************
!
      USE declarations_special
      USE declarations_stbtel, ONLY : typ_bnd_elem, typ_elem,
     &                                nptir, out_format
      USE interface_stbtel, ex_fm3sel => fm3sel
      USE interface_hermes
      IMPLICIT NONE
!
      DOUBLE PRECISION, INTENT(IN) :: X(*),Y(*)
      REAL, INTENT(INOUT) :: W(*)
!                     IKLE(NELEM,NDP) IKLES(NDP,NELEM)
      INTEGER, INTENT(IN) :: NBOR(*)
      INTEGER, INTENT(INOUT) :: IKLE(*),IKLES(*),ITRAV(*)
      INTEGER, INTENT(INOUT) :: NPOIN,NVAR,MXPTVS,MXELVS,TIME(3),DATE(3)
      INTEGER, INTENT(IN) :: NFIC,NVARCL,NSOR
      INTEGER, INTENT(INOUT) :: NELEM,NPTFR,NDP
      INTEGER, INTENT(IN) :: IPARAM(10),IPOBO(*)
      LOGICAL, INTENT(IN) :: DEBU,SUIT,ECRI,LISTIN,SORLEO(*)
      CHARACTER(LEN=3), INTENT(IN) :: STD
      CHARACTER(LEN=72), INTENT(IN) :: TITRE
!                        NSOR      NSOR+NVARCL
      CHARACTER(LEN=32), INTENT(IN) :: TEXTE(*),VARCLA(nvarcl)
      CHARACTER(LEN=32), INTENT(INOUT) :: TEXTLU(*)
      INTEGER, INTENT(IN) :: X_ORIG, Y_ORIG
!
      INTEGER IELEM,I,IB(10)

      CHARACTER(LEN=32), ALLOCATABLE :: VAR_INFO(:)
      INTEGER DATETIME(6), IVAR, IERR
      CHARACTER(LEN=80) :: TITSEL
!
!-----------------------------------------------------------------------
!
      IF(ecri) THEN
        ! COMPUTE NVAR
        nvar=0
        DO i=1,nsor
          IF(sorleo(i)) nvar = nvar + 1
        ENDDO
        nvar = nvar + nvarcl

        ALLOCATE(var_info(nvar))
        ivar = 1
        DO i=1,nsor
          IF(sorleo(i)) THEN
            var_info(ivar) = texte(i)(1:32)
            ivar = ivar + 1
          ENDIF
        ENDDO
        IF(nvarcl.NE.0) THEN
          DO i=1,nvarcl
            var_info(ivar) = varcla(i)(1:32)
            ivar = ivar + 1
          ENDDO
        ENDIF


        titsel = repeat(' ', 80)
        titsel(1:72) = titre

        CALL set_header(out_format,nfic,titsel,nvar,var_info,ierr)

        IF(nptir.EQ.0) THEN
          DO i=1,npoin
            itrav(i) = 0
          ENDDO
          DO i =1,nptfr
            itrav(nbor(i)) = i
          ENDDO
        ELSE
          itrav(1:nptfr) = 0
        ENDIF

        CALL set_mesh(out_format,nfic,2,typ_elem,ndp,nptfr,nptir,
     &                nelem,npoin,ikle,itrav(1:npoin),itrav(1:npoin),
     &                x,y,0,date,time,x_orig,y_orig,ierr)

      ELSE IF (debu) THEN
        CALL get_mesh_connectivity(out_format,nfic,typ_elem,
     &          itrav(1+npoin:nelem*ndp+npoin+1),nelem,ndp,ierr)

        CALL get_bnd_ipobo(out_format,nfic,npoin,nptfr,
     &                     typ_bnd_elem,itrav(1:npoin),ierr)
        nptfr = 0
        IF(npoin.GE.1) THEN
          DO i = 1 , npoin
            IF(itrav(i).NE.0) nptfr = nptfr + 1
          ENDDO
        ENDIF
!       ITRAV(1) : IPOBO  ITRAV(1+NPOIN) : IKLES
!       ITRAV(1+NPOIN+NDP*NELEM) : TABLEAU DE TRAVAIL.
        CALL mxptel(mxptvs,mxelvs,itrav(1+npoin),
     &              itrav(1+npoin+ndp*nelem),
     &              npoin,nelem,ndp,itrav,listin)
!       IPOBO EST MODIFIE PAR MXPTEL

      ELSE
        ! LIT ACTION
        CALL get_mesh_date(out_format,nfic,datetime,ierr)
        CALL check_call(ierr, 'FM3SEL:GET_MESH_DATA')
        date = datetime(1:3)
        time = datetime(4:6)

        CALL get_mesh_nelem(out_format,nfic,typ_elem,nelem,ierr)
        CALL check_call(ierr, 'GET_MESH_NELEM:TRIA')

        CALL get_mesh_npoin(out_format,nfic,typ_elem,npoin,ierr)
        CALL check_call(ierr, 'GET_MESH_NPOIN:TRIA')

        CALL get_mesh_connectivity(out_format,nfic,typ_elem,ikles,
     &                             nelem,ndp,ierr)
        CALL check_call(ierr, 'GET_MESH_CONNECTIVITY:TRIA')

        CALL get_mesh_npoin_per_element(out_format,nfic,typ_elem,
     &                                  ib(3),ierr)

        DO i      = 1,ndp
          DO ielem  = 1,nelem
            ikle((i-1)*nelem+ielem) = ikles((ielem-1)*ndp+i)
          ENDDO
        ENDDO
      ENDIF
!
      IF(debu.AND.listin) THEN
        WRITE(lu,301) titre
        WRITE(lu,501) nptfr,nelem,npoin
        IF(npoin.LT.3.OR.nptfr.LT.3.OR.nptfr.GE.npoin) THEN
          WRITE(lu,24) npoin,nptfr
          CALL plante(1)
          stop
        ENDIF
      ENDIF
!
!-----------------------------------------------------------------------
!
!  FORMATS D'IMPRESSION :
!
24    FORMAT(1x,'FM3SEL : NUMBER OF POINTS IN THE MESH: ',1i9,/,1x,
     &          '         NUMBER OF BOUNDARY POINTS: ',1i9,/,1x,
     &          '         WRONG DATA, PROGRAMME STOPPED')
301   FORMAT(1x,//,1x,'TITLE: ',a72,/)
501   FORMAT(1x,'NUMBER OF BOUNDARY POINTS: ',1i9,/,1x,
     &'NUMBER OF ELEMENTS:',1i9,/,1x,'NUMBER OF POINTS:',1i9)
!
!-----------------------------------------------------------------------
!
      RETURN
      END