coupev.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\postel3d\coupev.f
00002 !
00033                         SUBROUTINE COUPEV
00034 !                       *****************
00035 !
00036      &(AT,Z,U,V,W,
00037      & SHP,IMSEG,X2DV,Y2DV,DISTOR,IKLES,INDIC,
00038      & ELEM,NC2DV,NPOIN2,NELEM2,NCOU,BINCOU,IM,JM,NVAR,
00039      & TITCAS,NVA3,TAB,TEXTLU,N)
00040 !
00041 !***********************************************************************
00042 ! POSTEL3D VERSION 6.2   01/09/99   T. DENOT (LNH) 01 30 87 74 89
00043 ! FORTRAN90
00044 !***********************************************************************
00045 !
00046 !     FONCTION  : ECRIT POUR CHAQUE COUPE VERTICALES LES VARIABLES
00047 !                      D'UN PAS DE TEMPS
00048 !
00049 !-----------------------------------------------------------------------
00050 !                             ARGUMENTS
00051 ! .________________.____.______________________________________________.
00052 ! !      NOM       !MODE!                   ROLE                       !
00053 ! !________________!____!______________________________________________!
00054 ! !   AT           ! -->! TEMPS CORRESPONDANT AU PAS TRAITE            !
00055 ! !   Z            ! -->! COTES DES NOEUDS                             !
00056 ! !   U,V,W        ! -->! COMPOSANTES 3D DE LA VITESSE                 !
00057 ! !   TA,TP        ! -->! CONCENTRATIONS DES TRACEURS                  !
00058 ! !   NUX,NUY,NUZ  ! -->! COEFFICIENTS DE VISCOSITE POUR LES VITESSES  !
00059 ! !   NAX,NAY,NAZ  ! -->! COEFFICIENTS DE VISCOSITE POUR LES TR.ACTIFS !
00060 ! !   NPX,NPY,NPZ  ! -->! COEFFICIENTS DE VISCOSITE POUR LES TR.PASSIFS!
00061 ! !   RI           ! -->! NOMBRE DE RICHARDSON                         !
00062 ! !   AK,EP        ! -->! VARIABLES DU MODELE K-EPSILON                !
00063 ! !   RHO          ! -->! ECARTS RELATIFS DE DENSITE                   !
00064 ! !   SHP          ! -->! COORDONNEES BARYCENTRIQUES DES PTS DE COUPE  !
00065 ! !   TAB1,2,3     !<-- ! TABLEAU DE TRAVAIL POUR PROJETER LES VAR.    !
00066 ! !   NSEG         ! -->! NOMBRE DE SEGMENTS CONSTITUANT CHAQUE COUPE  !
00067 ! !   IMSEG        ! -->! NOMBRE DE POINTS PAR SEGMENTS                !
00068 ! !   X2DV         ! -->! ABSCISSES DES SOMMETS DES COUPES VERTICALES  !
00069 ! !   Y2DV         ! -->! ORDONNEES DES SOMMETS DES COUPES VERTICALES  !
00070 ! !   DISTOR       ! -->! DISTORSION SUIVANT Z DE CHAQUE COUPE VERTICALE
00071 ! !   IKLES        ! -->! TABLE DE CONNECTIVITE                        !
00072 ! !   INDIC        ! -->! INDICATEUR DE LA NATURE DES POINTS           !
00073 ! !   ELEM         ! -->! NUMERO DES ELEMENTS CONTENANT LES PTS DE COUPE
00074 ! !   NC2DV        ! -->! NOMBRE DE COUPES VERTICALES                  !
00075 ! !   NPOIN2       ! -->! NOMBRE DE POINTS DU MAILLAGE 2D              !
00076 ! !   NELEM2       ! -->! NOMBRE D'ELEMENTS DU MAILLAGE 2D             !
00077 ! !   NCOU         ! -->! NUMERO DE CANAL - 1 DE LA PREMIERE COUPE     !
00078 ! !   BINCOU       ! -->! STANDARD DE BINAIRE POUR LES COUPES          !
00079 ! !   IM (LU)      ! -->! NOMBRE DE PTS DE COUPE SUIVANT L'HORIZONTALE !
00080 ! !   JM (=NPLAN)  ! -->! NOMBRE DE PTS DE COUPE SUIVANT LA VERTICALE  !
00081 ! !   NVAR         ! -->! NOMBRE DE VARIABLES ENREGISTREES             !
00082 ! !   NTRAC        ! -->! NOMBRE DE TRACEURS ACTIFS                    !
00083 ! !   NTRPA        ! -->! NOMBRE DE TRACEURS PASSIFS                   !
00084 ! !   SORG3D       ! -->! INDICATEUR DES VARIABLES ENREGISTREES        !
00085 ! !   TITCAS       ! -->! TITRE A PORTER SUR CHAQUE COUPE              !
00086 ! !________________!____!______________________________________________!
00087 ! MODE : -->(DONNEE NON MODIFIEE), <--(RESULTAT), <-->(DONNEE MODIFIEE)
00088 !-----------------------------------------------------------------------
00089 !
00090 ! SOUS-PROGRAMME APPELE PAR : POSTEL3D
00091 ! SOUS-PROGRAMME APPELES : ECRDEB , ECRI2
00092 !
00093 
00094 ! JUNE 2012 - P.LANG / INGEROP : SERAFIN OUTPUT FORMAT
00095 !**********************************************************************
00096 !
00097       USE BIEF
00098       IMPLICIT NONE
00099       INTEGER LNG,LU
00100       COMMON/INFO/LNG,LU
00101 !
00102       INTEGER NPOIN2,NELEM2,NCOU,IM,JM,NC2DV,NVAR(1),NTRAC,NTRPA
00103       INTEGER , INTENT(IN) :: N
00104 !
00105       DOUBLE PRECISION U(NPOIN2,JM),V(NPOIN2,JM),W(NPOIN2,JM)
00106       DOUBLE PRECISION Z(NPOIN2,JM)
00107 
00108       DOUBLE PRECISION TAB1(IM,JM),TAB2(IM,JM),TAB3(IM,JM)
00109       DOUBLE PRECISION X2DV(50,NC2DV),Y2DV(50,NC2DV),DISTOR(NC2DV)
00110       DOUBLE PRECISION LGDEB,LGSEG,ALFA,COST,SINT,A1,A2,A3,U1,V1
00111 !      DOUBLE PRECISION , INTENT(INOUT) :: AT
00112       DOUBLE PRECISION ,INTENT(IN) ::AT
00113       DOUBLE PRECISION , INTENT(INOUT) :: SHP(IM,3,NC2DV)
00114       TYPE (BIEF_OBJ), INTENT(INOUT) :: TAB
00115 !
00116       INTEGER IKLES(3,NELEM2),INDIC(IM,JM,NC2DV),ELEM(IM,NC2DV)
00117       INTEGER IMSEG(49,NC2DV)
00118       INTEGER NBV(2),IG(5),IB(10),IC,N1,N2,N3,I,J,K,CANAL,IBID(1),ISTAT
00119       INTEGER ISEG,IDSEG,IFSEG
00120       INTEGER NVA3
00121 !
00122 !     NEW VARIABLES FOR SERAFIN FORMAT
00123 !
00124       INTEGER IKLE(3,((IM-1)*(JM-1))*2),IPOBO(IM*JM),NUMELEM
00125 !
00126 !     END OF NEW VARIABLES
00127 !
00128       LOGICAL FLAG
00129 !
00130       CHARACTER*32 TEXTLU(100)
00131       CHARACTER*72 TITCAS
00132       CHARACTER*3  BINCOU
00133 !
00134       CHARACTER(LEN=2) CB
00135       DOUBLE PRECISION XB(2)
00136 !
00137 !***********************************************************************
00138 !
00139 !  NOMBRE DE VARIABLES EN SORTIE :
00140 !  (ON NE SORT PAS LES VITESSES SI ON N'A PAS LES 3 COMPOSANTES
00141 !   ET ON NE SORT PAS LES VARIABLES QUI SERVENT A SUBIEF-3D)
00142 !
00143 !     plus de z
00144 !
00145       NBV(1) = NVA3-1
00146       NBV(2) = 0
00147 !
00148 !  DIMENSIONS DES GRILLES
00149 !
00150 !   IG(1), IG(2) : DIMENSIONS GRILLE 1.
00151       IG(1)=IM
00152       IG(2)=JM
00153 !   IG(3), IG(4) : DIMENSIONS GRILLE 2.
00154       IG(3)=IM
00155       IG(4)=JM
00156 !   IG(5) : DECALAGE DE LA GRILLE 2 PAR RAPPORT A LA GRILLE 1.
00157       IG(5)=1
00158 !
00159 !  LISTE DE FUTURS PARAMETRES DEJA PREVUS.(SEUL LES PREMIERS SERVENT)
00160 !
00161       DO I=1,10
00162         IB(I)=0
00163       ENDDO
00164 !   ECRITURE ECLATEE DES RESULTATS (CONVENTION LEONARD)
00165       IB(2)=1
00166 !
00167 !-----------------------------------------------------------------------
00168 !
00169 !  POUR CHAQUE COUPE VERTICALE FAIRE :
00170 !
00171 !     CANCELLING WHAT HAS DONE OPEN_FILES
00172       CLOSE(NCOU)
00173 !
00174       DO IC = 1,NC2DV
00175 !
00176         CANAL = NCOU + IC -1
00177 !
00178 !    OUVERTURE DU FICHIER + ENREGISTREMENT DES PREMIERS PARAMETRES
00179 !    -------------------------------------------------------------
00180 !
00181         CALL ECRDEB(CANAL,BINCOU,TITCAS,NBV,NTRAC,NTRPA,.FALSE.,TEXTLU,
00182      &               IC,N)
00183 !
00184 !    CALCUL DES AUTRES PARAMETRES DE L'ENTETE
00185 !    ----------------------------------------
00186 !
00187 !    MAILLAGE LEONARD ASSOCIE A LA COUPE IC ET AU PAS DE TEMPS IT
00188 !
00189         ISEG = 0
00190         IFSEG = 1
00191         LGDEB = 0.D0
00192         LGSEG = 0.D0
00193 !
00194         DO I = 1,IM
00195 !
00196 !    COORDONNEE HORIZONTALE SUIVANT LE PLAN DE COUPE (X)
00197 !
00198           IF (I.GT.IFSEG.OR.I.EQ.1) THEN
00199             ISEG = ISEG + 1
00200             IDSEG = IFSEG
00201             IFSEG = IFSEG + IMSEG(ISEG,IC)
00202             LGDEB = LGDEB + LGSEG
00203             LGSEG = SQRT((X2DV(ISEG+1,IC)-X2DV(ISEG,IC))**2
00204      &                  +(Y2DV(ISEG+1,IC)-Y2DV(ISEG,IC))**2)
00205           ENDIF
00206 !
00207           TAB1(I,1) = LGDEB + FLOAT(I-IDSEG)*LGSEG/FLOAT(IFSEG-IDSEG)
00208 !
00209 !    COORDONNEE VERTICALE (Y)
00210 !
00211           DO J = 1,JM
00212 !
00213             TAB1(I,J) = TAB1(I,1)
00214             TAB2(I,J) = ( SHP(I,1,IC)*Z(IKLES(1,ELEM(I,IC)),J)
00215      &                  + SHP(I,2,IC)*Z(IKLES(2,ELEM(I,IC)),J)
00216      &                  + SHP(I,3,IC)*Z(IKLES(3,ELEM(I,IC)),J) )
00217      &                  * DISTOR(IC)
00218 !
00219           ENDDO
00220         ENDDO !I
00221 !
00222 !    ENREGISTREMENT DES AUTRES PARAMETRES DE L'ENTETE
00223 !    ------------------------------------------------
00224 !
00225 ! BUILD OF IKLE ARRAY. EACH QUADRANGLE IS DIVIDED INTO 2 TRIANGLES
00226 ! NUMELEM VARIABLE MANAGES THE NUMBER OF ELEMENT
00227         NUMELEM = 1
00228         DO J = 1,JM-1
00229           DO I = 1,IM-1
00230             IKLE(1,NUMELEM) = ((J-1)*IM)+I
00231             IKLE(2,NUMELEM) = ((J-1)*IM)+I+1
00232             IKLE(3,NUMELEM) = ((J)*IM)+I+1
00233             NUMELEM = NUMELEM+1
00234             IKLE(1,NUMELEM) = ((J-1)*IM)+I
00235             IKLE(2,NUMELEM) = ((J)*IM)+I+1
00236             IKLE(3,NUMELEM) = ((J)*IM)+I
00237             NUMELEM = NUMELEM+1
00238           ENDDO
00239         ENDDO
00240         NUMELEM = NUMELEM-1
00241 !C PLG         CALL ECRI2(XB,IG,CB, 5,'I',CANAL,BINCOU,ISTAT)
00242 ! IPARAM ARRAY SET TO ZERO EXCEPT FIRST SET TO 1
00243         DO I=1,10
00244           IB(I) = 0
00245         ENDDO
00246         IB(1) = 1
00247         CALL ECRI2(XB,IB,CB,10,'I ',CANAL,BINCOU,ISTAT)
00248 ! RECORD NELEM,NPOIN,NDP,1
00249         IB(1) = ((IM-1)*(JM-1)) * 2
00250         IB(2) = IM*JM
00251         IB(3) = 3
00252         IB(4) = 1
00253         CALL ECRI2(XB,IB,CB,4, 'I ',CANAL,BINCOU,ISTAT)
00254 ! IKLE STORAGE
00255         CALL ECRI2(XB,IKLE,CB,NUMELEM*3, 'I ',CANAL,BINCOU,ISTAT)
00256 ! IPOBO ARRAY (WITH DUMMY VALUE)
00257         DO I=1,IB(2)
00258           IPOBO(I) = 0
00259         ENDDO
00260         CALL ECRI2(XB,IPOBO,CB,IB(2), 'I ',CANAL,BINCOU,ISTAT)
00261 ! X AND Y COORDINATES
00262         CALL ECRI2(TAB1,IBID,CB,IM*JM,'R4',CANAL,BINCOU,ISTAT)
00263         CALL ECRI2(TAB2,IBID,CB,IM*JM,'R4',CANAL,BINCOU,ISTAT)
00264 ! PLG        CALL ECRI2(XB,INDIC(1,1,IC),CB,IM*JM,'I',CANAL,BINCOU,ISTAT)
00265 !
00266 !-----------------------------------------------------------------------
00267 !
00268 !    SORTIE DES VARIABLES
00269 !
00270         XB(1)=AT
00271         CALL ECRI2(XB,IBID,CB,1,'R4',CANAL,BINCOU,ISTAT)
00272 !
00273 !    3 COMPOSANTES DE LA VITESSE
00274 !    ---------------------------
00275 !
00276 !
00277         ISEG = 1
00278         IFSEG = 1 + IMSEG(1,IC)
00279         ALFA = ATAN2(Y2DV(2,IC)-Y2DV(1,IC),X2DV(2,IC)-X2DV(1,IC))
00280         FLAG = .TRUE.
00281 !
00282         DO I = 1,IM
00283 !
00284           IF (FLAG) COST = COS(ALFA)
00285           IF (FLAG) SINT = SIN(ALFA)
00286           FLAG = .FALSE.
00287 !
00288           IF (I.EQ.IFSEG.AND.I.NE.IM) THEN
00289              FLAG = .TRUE.
00290              ISEG = ISEG + 1
00291              IFSEG = IFSEG + IMSEG(ISEG,IC)
00292              A1 = ALFA
00293              ALFA = ATAN2(Y2DV(ISEG+1,IC)-Y2DV(ISEG,IC),
00294      &                    X2DV(ISEG+1,IC)-X2DV(ISEG,IC))
00295              COST = COS(0.5D0*(ALFA+A1))
00296              SINT = SIN(0.5D0*(ALFA+A1))
00297           ENDIF
00298 !
00299           N1 = IKLES(1,ELEM(I,IC))
00300           N2 = IKLES(2,ELEM(I,IC))
00301           N3 = IKLES(3,ELEM(I,IC))
00302           A1 = SHP(I,1,IC)
00303           A2 = SHP(I,2,IC)
00304           A3 = SHP(I,3,IC)
00305 !
00306           DO J = 1,JM
00307 !
00308             U1 = A1*U(N1,J) + A2*U(N2,J) + A3*U(N3,J)
00309             V1 = A1*V(N1,J) + A2*V(N2,J) + A3*V(N3,J)
00310 !
00311 !       COMPOSANTE TANGENTIELLE ET HORIZONTALE DE LA VITESSE (UT)
00312 !
00313             TAB1(I,J) = COST*U1 + SINT*V1
00314 !
00315 !       COMPOSANTE VERTICALE DE LA VITESSE (W)
00316 !
00317             TAB2(I,J) = (A1*W(N1,J)+A2*W(N2,J)+A3*W(N3,J))*DISTOR(IC)
00318 !
00319 !       COMPOSANTE NORMALE ET HORIZONTALE DE LA VITESSE (UN)
00320 !
00321             TAB3(I,J) = -SINT*U1 + COST*V1
00322 !
00323           ENDDO
00324         ENDDO !I
00325 !
00326         CALL ECRI2(TAB1,IBID,CB,IM*JM,'R4',CANAL,BINCOU,ISTAT)
00327         CALL ECRI2(TAB2,IBID,CB,IM*JM,'R4',CANAL,BINCOU,ISTAT)
00328         CALL ECRI2(TAB3,IBID,CB,IM*JM,'R4',CANAL,BINCOU,ISTAT)
00329 !
00330 ! autres variables
00331 !
00332         IF (NBV(1).GT.3) THEN
00333           DO K = 1,NBV(1)-3
00334             DO J = 1,JM
00335               DO I = 1,IM
00336                 TAB1(I,J) = SHP(I,1,IC)
00337      &          *TAB%ADR(K)%P%R(IKLES(1,ELEM(I,IC))+(J-1)*NPOIN2)
00338      &                    + SHP(I,2,IC)
00339      &          *TAB%ADR(K)%P%R(IKLES(2,ELEM(I,IC))+(J-1)*NPOIN2)
00340      &                    + SHP(I,3,IC)
00341      &          *TAB%ADR(K)%P%R(IKLES(3,ELEM(I,IC))+(J-1)*NPOIN2)
00342               ENDDO !I
00343             ENDDO !J
00344             CALL ECRI2(TAB1,IBID,CB,IM*JM,'R4',CANAL,BINCOU,ISTAT)
00345           ENDDO !K
00346 !
00347         ENDIF
00348 !
00349         CLOSE(CANAL)
00350       ENDDO !IC
00351 !
00352 !-----------------------------------------------------------------------
00353 !
00354       RETURN
00355       END SUBROUTINE

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