lecsel.f

Go to the documentation of this file.

!                       *****************
                        SUBROUTINE lecsel
!                       *****************
!
     &(xinit,yinit,ikinit,npinit,neinit,x,y,ikle,ikles,w,titre,texte,
     & nvarin,nvar2,std,fusion,ngeo,nfo1,ipobo,iparam,date,
     & time,x_orig,y_orig)
!
!***********************************************************************
! PROGICIEL : STBTEL  V5.2           11/02/93    J.M. JANIN
!***********************************************************************
!
!   FONCTION  : RECHERCHE LES NOMBRES TOTAUX DE NOEUDS ET D'ELEMENTS DU
!               MAILLAGE DANS LE FICHIER D'ENTREE SELAFIN
!
!-----------------------------------------------------------------------
!                             ARGUMENTS
! .________________.____.______________________________________________
! |      NOM       |MODE|                   ROLE
! |________________|____|______________________________________________
! | NPOIN1         |<-- | NOMBRE REEL DE POINTS DU MAILLAGE
! |                |    | (NPOIN REPRESENTE L'INDICE MAX DES NOEUDS CAR
! |                |    | SUPERTAB LAISSE DES TROUS DANS LA NUMEROTATION
! | TYPELE         |<-- | TYPE D'ELEMENTS
! |________________|____|______________________________________________
! | COMMON:        |    |
! |  GEO:          |    |
! |    MESH        |<-- | TYPE DES ELEMENTS DU MAILLAGE
! |    NDP         | -->| NOMBRE DE NOEUDS PAR ELEMENTS
! |    NPOIN       |<-- | NOMBRE TOTAL DE NOEUDS DU MAILLAGE
! |    NELEM       |<-- | NOMBRE TOTAL D'ELEMENTS DU MAILLAGE
! |    NPMAX       | -->| DIMENSION EFFECTIVE DES TABLEAUX X ET Y
! |                |    | (NPMAX = NPOIN + 0.1*NELEM)
! |    NELMAX      | -->| DIMENSION EFFECTIVE DES TABLEAUX CONCERNANT
! |                |    | LES ELEMENTS (NELMAX = NELEM + 0.2*NELEM)
! |  FICH:         |    |
! |    NRES        |--> | NUMERO DU CANAL DU FICHIER DE SERAFIN
! |    NGEO       |--> | NUMERO DU CANAL DU FICHIER MAILLEUR
! |    NLIM      |--> | NUMERO DU CANAL DU FICHIER DYNAM DE TELEMAC
! |    NFO1      |--> | NUMERO DU CANAL DU FICHIER TRIANGLE TRIGRID
! |________________|____|______________________________________________
! MODE : -->(DONNEE NON MODIFIEE), <--(RESULTAT), <-->(DONNEE MODIFIEE)
!-----------------------------------------------------------------------
! APPELE PAR : HOMERE
! APPEL DE : -
!***********************************************************************
!
      USE declarations_special
      USE declarations_stbtel, ONLY: nelem,ndp,npoin,nelmax,fformat,
     &                               typ_elem,typ_bnd_elem
      USE interface_hermes
      USE interface_stbtel, ex_lecsel => lecsel
      IMPLICIT NONE
!
      DOUBLE PRECISION, INTENT(INOUT) :: XINIT(*), YINIT(*), X(*), Y(*)
      REAL, INTENT(INOUT) :: W(*)
      INTEGER, INTENT(IN) :: NGEO , NFO1
      INTEGER, INTENT(INOUT) :: IPARAM(10),DATE(3),TIME(3)
      INTEGER, INTENT(INOUT) :: NEINIT , NPINIT
      INTEGER, INTENT(INOUT) :: NVARIN , NVAR2
      INTEGER, INTENT(INOUT) :: IKINIT(nelem,ndp)
      INTEGER, INTENT(INOUT) :: IKLE(nelmax,ndp),IKLES(ndp,nelem)
      INTEGER, INTENT(INOUT) :: IPOBO(*)
      LOGICAL, INTENT(IN) :: FUSION
      INTEGER, INTENT(INOUT) :: X_ORIG, Y_ORIG
      CHARACTER(LEN=72), INTENT(INOUT) :: TITRE
      CHARACTER(LEN=32), INTENT(INOUT) :: TEXTE(26)
      CHARACTER(LEN=3), INTENT(IN) ::  STD
!
      INTEGER NPOIN1 , NELEM1 , NPOIN2 , NELEM2
      INTEGER I , IELEM
      CHARACTER(LEN=80) FULL_TITLE

      CHARACTER(LEN=16), ALLOCATABLE :: VARUNIT(:), VARNAME(:)
      INTEGER :: IERR
      INTEGER DATETIME(6)
      INTEGER NPTFR
!
!
!=======================================================================
! LECTURE SEQUENTIELLE DU PREMIER FICHIER
!=======================================================================
!
      CALL get_mesh_title(fformat, ngeo, full_title, ierr)
      CALL check_call(ierr, 'LECSEL:GET_MESH_TITLE')
      titre = full_title(1:72)

      CALL get_data_nvar(fformat, ngeo, nvarin, ierr)
      CALL check_call(ierr, 'LECSEL:GET_DATA_NVAR')

      IF(nvarin.GT.26) THEN
        WRITE(lu,*) 'NVAR > 26 NOT HANDLED'
        CALL plante(1)
      ENDIF

      ALLOCATE(varunit(nvarin))
      ALLOCATE(varname(nvarin))
      CALL get_data_var_list(fformat,ngeo,nvarin,varname,varunit,ierr)
      CALL check_call(ierr, 'LECSEL:GET_DATA_VAR_LIST')
      DO i=1,nvarin
        texte(i)(1:16) = varname(i)
        texte(i)(17:32) = varunit(i)
      ENDDO
      DEALLOCATE(varunit)
      DEALLOCATE(varname)

      CALL get_mesh_date(fformat,ngeo,datetime,ierr)
      CALL check_call(ierr, 'LECSEL:GET_MESH_DATA')
      date = datetime(1:3)
      time = datetime(4:6)

      CALL get_mesh_nelem(fformat,ngeo,typ_elem,nelem1,ierr)
      CALL check_call(ierr, 'GET_MESH_NELEM:TRIA')

      CALL get_mesh_npoin(fformat,ngeo,typ_elem,npoin1,ierr)
      CALL check_call(ierr, 'GET_MESH_NPOIN:TRIA')

      CALL get_mesh_connectivity(fformat,ngeo,typ_elem,ikles,
     &                           nelem1,ndp,ierr)
      CALL check_call(ierr, 'GET_MESH_CONNECTIVITY:TRIA')

      CALL get_bnd_npoin(fformat,ngeo,typ_bnd_elem,nptfr,ierr)
      WRITE(lu,*) 'NPTFR FROM LECSEL ', nptfr

      CALL get_bnd_ipobo(fformat,ngeo,npoin,nptfr,
     &                   typ_bnd_elem,ipobo,ierr)

      CALL get_mesh_coord(fformat,ngeo,1,2,npoin1,x,ierr)
      CALL get_mesh_coord(fformat,ngeo,2,2,npoin1,y,ierr)
      CALL get_mesh_orig(fformat,ngeo,x_orig,y_orig,ierr)
!
!=======================================================================
! LECTURE SEQUENTIELLE DU SECOND FICHIER EN CAS DE FUSION
!=======================================================================
!
      IF (fusion) THEN
!
        CALL get_mesh_nelem(fformat,nfo1,typ_elem,nelem2,ierr)
        CALL check_call(ierr, 'GET_MESH_NELEM:TRIA')

        CALL get_mesh_npoin(fformat,nfo1,typ_elem,npoin2,ierr)
        CALL check_call(ierr, 'GET_MESH_NPOIN:TRIA')
!
        CALL get_mesh_connectivity(fformat,ngeo,typ_elem,
     &                             ikles(1,nelem1+1),
     &                             nelem2,ndp,ierr)
        CALL check_call(ierr, 'GET_MESH_CONNECTIVITY:TRIA')

        CALL get_mesh_coord(fformat,ngeo,1,2,npoin2,x(npoin1+1),ierr)
        CALL get_mesh_coord(fformat,ngeo,2,2,npoin2,y(npoin1+1),ierr)
!
      ENDIF
!
!=======================================================================
! AFFECTATION DES VALEURS LUES AUX VARIABLES CONCERNEES
!=======================================================================
!
      neinit = nelem
      npinit = npoin
!
!       INVERSION DE IKLES EN IKLE.
!
      DO i = 1,ndp
        DO ielem = 1,nelem1
          ikle(ielem,i) = ikles(i,ielem)
          ikinit(ielem,i) = ikles(i,ielem)
        ENDDO
        IF (fusion) THEN
          DO ielem = nelem1+1,nelem
            ikle(ielem,i) = ikles(i,ielem) + npoin1
            ikinit(ielem,i) = ikles(i,ielem) + npoin1
          ENDDO
        ENDIF
      ENDDO
!
      DO i = 1,npoin
        xinit(i) = x(i)
        yinit(i) = y(i)
      ENDDO
!
!=======================================================================
!
      RETURN
      END