coupeh.f

Go to the documentation of this file.

!                       *****************
                        SUBROUTINE coupeh
!                       *****************
!
     &(irec,at,z,u,v,w,href,nplref,plinf,nc2dh,npoin2,nplan,ncou,
     & fformat,var,shz,nva3,tab,textelu)
!
!***********************************************************************
! POSTEL3D VERSION 6.0   01/09/99   T. DENOT (LNH) 01 30 87 74 89
! FORTRAN90
!***********************************************************************
!
!     FONCTION  : ECRIT POUR CHAQUE COUPE HORIZONTALES LES VARIABLES
!                      D'UN PAS DE TEMPS
!
!     ATTENTION : LORSQUE LE PLAN DE COUPE SE SITUE EN DEHORS DU DOMAINE
!                 (EN DESSOUS DU FOND OU AU DESSUS DE LA SURFACE) :
!
!                 ON FIXE LES VITESSES HORIZONTALES A ZERO
!                 CE QUI EST BIEN ADAPTE POUR TRACER DES VECTEURS
!
!                 ON EXTRAPOLE LES AUTRES VARIABLES A PARTIR DE LEURS
!                 VALEURS AU PREMIER ETAGE SI EN DESSOUS DU FOND
!                         AU DERNIER ETAGE SI AU DESSUS DE LA SURFACE
!                 CE QUI EST BIEN ADAPTE POUR TRACER DES ISOCOURBES
!
!-----------------------------------------------------------------------
!                             ARGUMENTS
! .________________.____.______________________________________________.
! !      NOM       !MODE!                   ROLE                       !
! !________________!____!______________________________________________!
! !   IREC         ! -->! PAS TRAITE                                   !
! !   AT           ! -->! TEMPS CORRESPONDANT AU PAS TRAITE            !
! !   Z            ! -->! COTES DES NOEUDS                             !
! !   U,V,W        ! -->! COMPOSANTES 3D DE LA VITESSE                 !
! !   TA,TP        ! -->! CONCENTRATIONS DES TRACEURS                  !
! !   NUX,NUY,NUZ  ! -->! COEFFICIENTS DE VISCOSITE POUR LES VITESSES  !
! !   NAX,NAY,NAZ  ! -->! COEFFICIENTS DE VISCOSITE POUR LES TR.ACTIFS !
! !   NPX,NPY,NPZ  ! -->! COEFFICIENTS DE VISCOSITE POUR LES TR.PASSIFS!
! !   RI           ! -->! NOMBRE DE RICHARDSON                         !
! !   AK,EP        ! -->! VARIABLES DU MODELE K-EPSILON                !
! !   RHO          ! -->! ECARTS RELATIFS DE DENSITE                   !
! !   VAR          ! -->! TABLEAU DE TRAVAIL POUR PROJETER LES VARIABLES
! !   SHZ          ! -->! COORDONNEE BARYCENTRIQUE SUIVANT Z           !
! !   HREF         ! -->! DECALAGE PAR RAPPORT AU PLAN DE REFERENCE    !
! !   NPLREF       ! -->! PLAN DE REFERENCE                            !
! !   PLINF        ! -->! PLAN SUITE IMMEDIATEMENT SOUS LA COUPE       !
! !   NC2DH        ! -->! NOMBRE DE COUPES HORIZONTALES                !
! !   NPOIN2       ! -->! NOMBRE DE POINTS DU MAILLAGE 2D              !
! !   NCOU         ! -->! NUMERO DE CANAL - 1 DE LA PREMIERE COUPE     !
! !   NPLAN        ! -->! NOMBRE DE PLANS                              !
! !   NTRAC        ! -->! NOMBRE DE TRACEURS ACTIFS                    !
! !   NTRPA        ! -->! NOMBRE DE TRACEURS PASSIFS                   !
! !   SORG3D       ! -->! INDICATEUR DES VARIABLES ENREGISTREES        !
! !________________!____!______________________________________________!
! MODE : -->(DONNEE NON MODIFIEE), <--(RESULTAT), <-->(DONNEE MODIFIEE)
!-----------------------------------------------------------------------
!
! SOUS-PROGRAMME APPELE PAR : POSTEL3D
! SOUS-PROGRAMME APPELES : ECRI2
!
!history Y AUDOUIN (LNHE)
!+       25/05/2015
!+       V7P0
!+       Modification to comply with the hermes module
!
!**********************************************************************
!
      USE bief
      USE declarations_special
      USE declarations_postel3d, ONLY: prez => z
!
      IMPLICIT NONE
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      INTEGER, INTENT(IN) :: NC2DH,NPOIN2,NPLAN
      INTEGER, INTENT(IN) :: NCOU(nc2dh)
      INTEGER, INTENT(IN) :: IREC
      DOUBLE PRECISION, INTENT(IN) :: U(npoin2,nplan)
      DOUBLE PRECISION, INTENT(IN) :: V(npoin2,nplan)
      DOUBLE PRECISION, INTENT(IN) :: W(npoin2,nplan)
      DOUBLE PRECISION, INTENT(IN) :: Z(npoin2,nplan)
      DOUBLE PRECISION, INTENT(INOUT) :: AT
      DOUBLE PRECISION, INTENT(IN) :: HREF(9)
      INTEGER , INTENT(IN) :: NPLREF(9)
      INTEGER , INTENT(INOUT) :: PLINF(npoin2)
      type(bief_obj), INTENT(INOUT) :: tab
      INTEGER, INTENT(IN) :: NVA3
      CHARACTER(LEN=8) :: FFORMAT
      DOUBLE PRECISION,INTENT(INOUT) :: VAR(npoin2),SHZ(npoin2)
      CHARACTER(LEN=32), INTENT(IN) :: TEXTELU(100)
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      INTEGER IC,I,J,CANAL
!
      INTEGER IERR
      CHARACTER(LEN=32) :: VAR_NAME
!
!***********************************************************************
!
!    POUR CHAQUE COUPE HORIZONTALE FAIRE :
!
      DO ic = 1,nc2dh
!
        canal = ncou(ic)
!
        DO i = 1,npoin2
          var(i) = href(ic)
!          IF (NPLREF(IC).GE.1) VAR(I) = VAR(I) + Z(I,NPLREF(IC))
          IF (nplref(ic).GE.1) THEN
            var(i) = var(i) + z(i,nplref(ic))
          ENDIF
          plinf(i) = 1
        ENDDO
!
        IF (nplan.GE.3) THEN
          DO j = 2,nplan-1
            DO i = 1,npoin2
              IF (z(i,j).LE.var(i)) plinf(i) = j
            ENDDO
          ENDDO
        ENDIF
!
!
        DO i = 1,npoin2
!..01/2004
!  ATTENTION : Cas des bancs decouvrants (plans confondus)
          shz(i) = (          var(i)   -z(i,plinf(i)))
     &           / max((z(i,plinf(i)+1)-z(i,plinf(i))),1.d-6)
!..01/2004
        ENDDO
!
!-----------------------------------------------------------------------
!
!    INDICATEUR DU DOMAINE
!    ---------------------
        DO i = 1,npoin2
          var(i) = min(shz(i),1.d0-shz(i)) + 1.d-6
        ENDDO
        IF (lng.EQ.lng_fr) var_name = 'INDICATEUR DOM.                 '
        IF (lng.EQ.lng_en) var_name = 'DOMAIN INDICATOR                '
        CALL add_data(fformat,canal,var_name,at,irec,.true.,var,
     &                npoin2,ierr)
        CALL check_call(ierr,'COUPEH:ADD_DATA:DOM')
!
!       Adding z
!
        DO i = 1,npoin2
          var(i) = 0.d0
          IF (shz(i).GT.-1.d-6.AND.shz(i).LT.1.000001d0)
     &       var(i) =
     &     prez((plinf(i)-1)*npoin2+i)*(1.-shz(i))
     &   + prez( plinf(i)   *npoin2+i)*    shz(i)
        ENDDO
        CALL add_data(fformat,canal,textelu(1),at,irec,.false.,var,
     &                npoin2,ierr)
        CALL check_call(ierr,'COUPEH:ADD_DATA:J')
!
!
!    COMPOSANTE U DE LA VITESSE
!    --------------------------
        DO i = 1,npoin2
          var(i) = 0.d0
          IF (shz(i).GT.-1.d-6.AND.shz(i).LT.1.000001d0)
     &    var(i) = u(i,plinf(i))*(1.-shz(i))+u(i,plinf(i)+1)*shz(i)
        ENDDO
        var_name = textelu(2)
        CALL add_data(fformat,canal,var_name,at,irec,.false.,var,
     &                npoin2,ierr)
        CALL check_call(ierr,'COUPEH:ADD_DATA:U')
!
!
!    COMPOSANTE V DE LA VITESSE
!    --------------------------
        DO i = 1,npoin2
          var(i) = 0.d0
          IF (shz(i).GT.-1.d-6.AND.shz(i).LT.1.000001d0)
     &    var(i) = v(i,plinf(i))*(1.-shz(i))+v(i,plinf(i)+1)*shz(i)
        ENDDO
        var_name = textelu(3)
        CALL add_data(fformat,canal,var_name,at,irec,.false.,var,
     &                npoin2,ierr)
        CALL check_call(ierr,'COUPEH:ADD_DATA:V')
!
!    COMPOSANTE W DE LA VITESSE
!    --------------------------
        DO i = 1,npoin2
          var(i) = w(i,plinf(i))*(1.-shz(i))+w(i,plinf(i)+1)*shz(i)
        ENDDO
        var_name = textelu(4)
        CALL add_data(fformat,canal,var_name,at,irec,.false.,var,
     &                npoin2,ierr)
        CALL check_call(ierr,'COUPEH:ADD_DATA:W')
!
!       Other variables
!
        IF (nva3.GT.4) THEN
          DO j=5,nva3
            DO i = 1,npoin2
              var(i) = 0.d0
              IF (shz(i).GT.-1.d-6.AND.shz(i).LT.1.000001d0)
     &           var(i) =
     &         tab%ADR(j-4)%P%R((plinf(i)-1)*npoin2+i)*(1.-shz(i))
     &       + tab%ADR(j-4)%P%R( plinf(i)   *npoin2+i)*    shz(i)
            ENDDO
            CALL add_data(fformat,canal,textelu(j),at,irec,.false.,var,
     &                    npoin2,ierr)
            CALL check_call(ierr,'COUPEH:ADD_DATA:J')
          ENDDO
        ENDIF
!
!
      ENDDO !IC
!
!-----------------------------------------------------------------------
!
      RETURN
      END SUBROUTINE