ecrsel.f

Go to the documentation of this file.

!                       *****************
                        SUBROUTINE ecrsel
!                       *****************
!
     &(vainit,ikinit,npinit,neinit,shp,elt,npoin,npoin1,npmax,w,
     & x,zf,nsfond,ncolor,color,var,nvarin,nvarou,nvar2,std,fusion,
     & nres,ngeo,nfo1,maille,texte)
!
!***********************************************************************
! 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 interface_stbtel, ex_ecrsel => ecrsel
      USE declarations_stbtel, ONLY: fformat, out_format
      USE interface_hermes
      IMPLICIT NONE
!
      INTEGER, INTENT(IN) :: NPINIT,NEINIT,NPOIN,NPMAX
      INTEGER, INTENT(IN) :: NPOIN1,NVAR2
      DOUBLE PRECISION, INTENT(INOUT) :: VAINIT(npinit)
      DOUBLE PRECISION, INTENT(IN) :: SHP(npmax,3)
      INTEGER, INTENT(IN) :: IKINIT(neinit,3),ELT(npoin)
      REAL, INTENT(INOUT) :: W(*)
      DOUBLE PRECISION, INTENT(INOUT) :: X(npoin)
      DOUBLE PRECISION, INTENT(IN) :: ZF(npoin)
      INTEGER, INTENT(IN) :: NSFOND
      INTEGER, INTENT(IN) :: NCOLOR(npoin)
      LOGICAL, INTENT(IN) :: COLOR,FUSION
      DOUBLE PRECISION, INTENT(INOUT) :: VAR(npoin)
      INTEGER, INTENT(IN) :: NVARIN,NVAROU
      CHARACTER(LEN=3), INTENT(IN) :: STD
      INTEGER, INTENT(IN) :: NGEO,NRES,NFO1
      CHARACTER(LEN=9), INTENT(IN) :: MAILLE
      CHARACTER(LEN=32), INTENT(IN) ::TEXTE(nvarin)
!
      INTEGER NPOIN2
      INTEGER IVAR,IPOIN,I
!
      DOUBLE PRECISION TIME
      INTEGER NTIMESTEP, IERR
      CHARACTER(LEN=32) :: VARNAME
!
!=======================================================================
!
      npoin2 = npinit - npoin1

      ntimestep = 1

      IF (maille.EQ.'SELAFIN') THEN

        CALL get_data_ntimestep(fformat, ngeo, ntimestep, ierr)
        CALL check_call(ierr, 'ECRSEL:GET_DATA_NTIMESTEP')

        DO i=0,ntimestep-1
          CALL get_data_time(fformat, ngeo, i, time, ierr)
          CALL check_call(ierr, 'ECRSEL:GET_DATA_TIME')

          DO ivar = 1, nvarin
            CALL get_data_value(fformat, ngeo, i, texte(ivar),
     &                          vainit, npoin1, ierr)
            CALL check_call(ierr,
     &                     'ECRSEL:GET_DATA_VALUE:'//texte(ivar))

            IF(fusion) THEN
              CALL get_data_value(fformat, ngeo, i, texte(ivar),
     &                            vainit(npoin1+1:npinit), npoin2, ierr)
              IF(ierr.NE.0) THEN
                vainit(npoin1+1:npinit) = 0.d0
              ENDIF
            ENDIF

            ! WRITTING DATA VALUE
            IF(ivar.EQ.nsfond) THEN
              var = zf
            ELSE
              DO ipoin = 1,npoin
                var(ipoin) = vainit(ikinit(elt(ipoin),1))*shp(ipoin,1)
     &                     + vainit(ikinit(elt(ipoin),2))*shp(ipoin,2)
     &                     + vainit(ikinit(elt(ipoin),3))*shp(ipoin,3)
              ENDDO
            ENDIF
            CALL add_data(out_format,nres,texte(ivar),time,i,
     &                    ivar==1,var,npoin,ierr)
            CALL check_call(ierr,
     &                      'ECRSEL:ADD_DATA_VALUE:'//texte(ivar))
          ENDDO ! IVAR
        ENDDO !I
      ENDIF ! MAILLE=='SELAFIN'

      IF(nsfond.EQ.nvarin+1.OR.maille.EQ.'ADCIRC') THEN
        varname = repeat(' ', 32)
        varname = 'BOTTOM          M'
        ! WRITING BOTTOM FOR ALL TIMESTEPS
        ivar=max(nsfond, 1)
        DO i=0,ntimestep-1
          CALL add_data(out_format,nres,varname,0.d0,i,
     &                  ivar==1,zf,npoin,ierr)
          CALL check_call(ierr, 'ECRSEL:ADD_DATA_VALUE:BOTTOM')
        ENDDO
      ENDIF
      IF(nvarou.EQ.0.AND.maille.NE.'ADCIRC') THEN
        varname = repeat(' ', 32)
        varname = 'MAILLAGE'
        CALL add_data(out_format,nres,varname,0.d0,0,
     &                .true.,x,npoin,ierr)
        CALL check_call(ierr, 'ECRSEL:ADD_DATA_VALUE:BOTTOM')
      ENDIF
!
!=======================================================================
!
      RETURN
      END