coupeh.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\postel3d\coupeh.f
00002 !
00032                         SUBROUTINE COUPEH
00033 !                       *****************
00034 !
00035      &(AT,Z,U,V,W,HREF,NPLREF,PLINF,NC2DH,NPOIN2,NPLAN,NCOU,BINCOU,
00036      & VAR,SHZ,NVA3,TAB)
00037 !
00038 !***********************************************************************
00039 ! POSTEL3D VERSION 6.0   01/09/99   T. DENOT (LNH) 01 30 87 74 89
00040 ! FORTRAN90
00041 !***********************************************************************
00042 !
00043 !     FONCTION  : ECRIT POUR CHAQUE COUPE HORIZONTALES LES VARIABLES
00044 !                      D'UN PAS DE TEMPS
00045 !
00046 !     ATTENTION : LORSQUE LE PLAN DE COUPE SE SITUE EN DEHORS DU DOMAINE
00047 !                 (EN DESSOUS DU FOND OU AU DESSUS DE LA SURFACE) :
00048 !
00049 !                 ON FIXE LES VITESSES HORIZONTALES A ZERO
00050 !                 CE QUI EST BIEN ADAPTE POUR TRACER DES VECTEURS
00051 !
00052 !                 ON EXTRAPOLE LES AUTRES VARIABLES A PARTIR DE LEURS
00053 !                 VALEURS AU PREMIER ETAGE SI EN DESSOUS DU FOND
00054 !                         AU DERNIER ETAGE SI AU DESSUS DE LA SURFACE
00055 !                 CE QUI EST BIEN ADAPTE POUR TRACER DES ISOCOURBES
00056 !
00057 !-----------------------------------------------------------------------
00058 !                             ARGUMENTS
00059 ! .________________.____.______________________________________________.
00060 ! !      NOM       !MODE!                   ROLE                       !
00061 ! !________________!____!______________________________________________!
00062 ! !   AT           ! -->! TEMPS CORRESPONDANT AU PAS TRAITE            !
00063 ! !   Z            ! -->! COTES DES NOEUDS                             !
00064 ! !   U,V,W        ! -->! COMPOSANTES 3D DE LA VITESSE                 !
00065 ! !   TA,TP        ! -->! CONCENTRATIONS DES TRACEURS                  !
00066 ! !   NUX,NUY,NUZ  ! -->! COEFFICIENTS DE VISCOSITE POUR LES VITESSES  !
00067 ! !   NAX,NAY,NAZ  ! -->! COEFFICIENTS DE VISCOSITE POUR LES TR.ACTIFS !
00068 ! !   NPX,NPY,NPZ  ! -->! COEFFICIENTS DE VISCOSITE POUR LES TR.PASSIFS!
00069 ! !   RI           ! -->! NOMBRE DE RICHARDSON                         !
00070 ! !   AK,EP        ! -->! VARIABLES DU MODELE K-EPSILON                !
00071 ! !   RHO          ! -->! ECARTS RELATIFS DE DENSITE                   !
00072 ! !   VAR          ! -->! TABLEAU DE TRAVAIL POUR PROJETER LES VARIABLES
00073 ! !   SHZ          ! -->! COORDONNEE BARYCENTRIQUE SUIVANT Z           !
00074 ! !   HREF         ! -->! DECALAGE PAR RAPPORT AU PLAN DE REFERENCE    !
00075 ! !   NPLREF       ! -->! PLAN DE REFERENCE                            !
00076 ! !   PLINF        ! -->! PLAN SUITE IMMEDIATEMENT SOUS LA COUPE       !
00077 ! !   NC2DH        ! -->! NOMBRE DE COUPES HORIZONTALES                !
00078 ! !   NPOIN2       ! -->! NOMBRE DE POINTS DU MAILLAGE 2D              !
00079 ! !   NCOU         ! -->! NUMERO DE CANAL - 1 DE LA PREMIERE COUPE     !
00080 ! !   BINCOU       ! -->! STANDARD DE BINAIRE POUR LES COUPES          !
00081 ! !   NPLAN        ! -->! NOMBRE DE PLANS                              !
00082 ! !   NTRAC        ! -->! NOMBRE DE TRACEURS ACTIFS                    !
00083 ! !   NTRPA        ! -->! NOMBRE DE TRACEURS PASSIFS                   !
00084 ! !   SORG3D       ! -->! INDICATEUR DES VARIABLES ENREGISTREES        !
00085 ! !________________!____!______________________________________________!
00086 ! MODE : -->(DONNEE NON MODIFIEE), <--(RESULTAT), <-->(DONNEE MODIFIEE)
00087 !-----------------------------------------------------------------------
00088 !
00089 ! SOUS-PROGRAMME APPELE PAR : POSTEL3D
00090 ! SOUS-PROGRAMME APPELES : ECRI2
00091 !
00092 !**********************************************************************
00093 !
00094       USE BIEF
00095       IMPLICIT NONE
00096       INTEGER LNG,LU
00097       COMMON/INFO/LNG,LU
00098 !
00099       INTEGER NC2DH,NPOIN2,NCOU,NPLAN,IC,I,J,CANAL
00100 !
00101       DOUBLE PRECISION, INTENT(INOUT) :: U(NPOIN2,NPLAN)
00102       DOUBLE PRECISION, INTENT(INOUT) :: V(NPOIN2,NPLAN)
00103       DOUBLE PRECISION, INTENT(INOUT) :: W(NPOIN2,NPLAN)
00104       DOUBLE PRECISION, INTENT(INOUT) :: Z(NPOIN2,NPLAN)
00105 !
00106       DOUBLE PRECISION, INTENT(INOUT) :: AT
00107       DOUBLE PRECISION, INTENT(INOUT) :: HREF(9)
00108       INTEGER , INTENT(INOUT) :: NPLREF(9)
00109       INTEGER , INTENT(INOUT) :: PLINF(NPOIN2)
00110 !
00111       TYPE (BIEF_OBJ), INTENT(INOUT) :: TAB
00112 !
00113       DOUBLE PRECISION VAR(NPOIN2),SHZ(NPOIN2)
00114       INTEGER ISTAT
00115       INTEGER NVA3
00116       CHARACTER*3 BINCOU
00117 !
00118       CHARACTER(LEN=2) CB
00119       DOUBLE PRECISION XB(2)
00120       INTEGER IB(2)
00121 !
00122 !***********************************************************************
00123 !
00124 !    POUR CHAQUE COUPE HORIZONTALE FAIRE :
00125 !
00126       DO IC = 1,NC2DH
00127 !
00128         CANAL = NCOU + IC -1
00129         XB(1)=AT
00130         CALL ECRI2(XB,IB,CB,1,'R4',CANAL,BINCOU,ISTAT)
00131 !
00132         DO I = 1,NPOIN2
00133           VAR(I) = HREF(IC)
00134 !          IF (NPLREF(IC).GE.1) VAR(I) = VAR(I) + Z(I,NPLREF(IC))
00135           IF (NPLREF(IC).GE.1) THEN
00136             VAR(I) = VAR(I) + Z(I,NPLREF(IC))
00137           ENDIF
00138           PLINF(I) = 1
00139         ENDDO
00140 !
00141         IF (NPLAN.GE.3) THEN
00142           DO J = 2,NPLAN-1
00143             DO I = 1,NPOIN2
00144               IF (Z(I,J).LE.VAR(I)) PLINF(I) = J
00145             ENDDO
00146           ENDDO
00147         ENDIF
00148 !
00149 !
00150         DO I = 1,NPOIN2
00151 !..01/2004
00152 !  ATTENTION : CAS DES BANCS DECOUVRANTS (PLANS CONFONDUS)
00153           SHZ(I) = (          VAR(I)   -Z(I,PLINF(I)))
00154      &            / MAX((Z(I,PLINF(I)+1)-Z(I,PLINF(I))),1.D-6)
00155 !..01/2004
00156         ENDDO
00157 !
00158 !-----------------------------------------------------------------------
00159 !
00160 !    INDICATEUR DU DOMAINE
00161 !    ---------------------
00162         DO I = 1,NPOIN2
00163           VAR(I) = MIN(SHZ(I),1.D0-SHZ(I)) + 1.D-6
00164         ENDDO
00165         CALL ECRI2(VAR,IB,CB,NPOIN2,'R4',CANAL,BINCOU,ISTAT)
00166 !
00167 !
00168 !    COMPOSANTE U DE LA VITESSE
00169 !    --------------------------
00170         DO I = 1,NPOIN2
00171           VAR(I) = 0.D0
00172           IF (SHZ(I).GT.-1.D-6.AND.SHZ(I).LT.1.000001D0)
00173      &    VAR(I) = U(I,PLINF(I))*(1.-SHZ(I))+U(I,PLINF(I)+1)*SHZ(I)
00174         ENDDO
00175         CALL ECRI2(VAR,IB,CB,NPOIN2,'R4',CANAL,BINCOU,ISTAT)
00176 !
00177 !
00178 !    COMPOSANTE V DE LA VITESSE
00179 !    --------------------------
00180         DO I = 1,NPOIN2
00181           VAR(I) = 0.D0
00182           IF (SHZ(I).GT.-1.D-6.AND.SHZ(I).LT.1.000001D0)
00183      &    VAR(I) = V(I,PLINF(I))*(1.-SHZ(I))+V(I,PLINF(I)+1)*SHZ(I)
00184         ENDDO
00185         CALL ECRI2(VAR,IB,CB,NPOIN2,'R4',CANAL,BINCOU,ISTAT)
00186 !
00187 !    COMPOSANTE W DE LA VITESSE
00188 !    --------------------------
00189         DO I = 1,NPOIN2
00190           VAR(I) = W(I,PLINF(I))*(1.-SHZ(I))+W(I,PLINF(I)+1)*SHZ(I)
00191         ENDDO
00192         CALL ECRI2(VAR,IB,CB,NPOIN2,'R4',CANAL,BINCOU,ISTAT)
00193 !
00194 !
00195         IF (NVA3.GT.4) THEN
00196         DO J=1,NVA3-4
00197           DO I = 1,NPOIN2
00198             VAR(I) = 0.D0
00199             IF (SHZ(I).GT.-1.D-6.AND.SHZ(I).LT.1.000001D0)
00200      &         VAR(I) =
00201      &       TAB%ADR(J)%P%R((PLINF(I)-1)*NPOIN2+I)*(1.-SHZ(I))
00202      &       + TAB%ADR(J)%P%R( PLINF(I)   *NPOIN2+I)*    SHZ(I)
00203           ENDDO
00204           CALL ECRI2(VAR,IB,CB,NPOIN2,'R4',CANAL,BINCOU,ISTAT)
00205         ENDDO
00206         ENDIF
00207 !
00208 !
00209       ENDDO !IC
00210 !
00211 !-----------------------------------------------------------------------
00212 !
00213       RETURN
00214       END SUBROUTINE

Generated on Fri Aug 31 2013 18:12:58 by S.E.Bourban (HRW) using doxygen 1.7.0