pre611
C PRE611 SOURCE OF166741 24/10/03 21:15:36 12022 & IAL1, IGRAL1, ILIAL1, & IAL2, IGRAL2, ILIAL2, & IRN1, IGRRN1, ILIRN1, & IRN2, IGRRN2, ILIRN2, & IVN1, IGRVN1, ILIVN1, & IVN2, IGRVN2, ILIVN2, & IPN1, IGRPN1, ILIPN1, & IPN2, IGRPN2, ILIPN2, & IAL1F, IAL2F, IRN1F, IRN2F, IVN1F, IVN2F, IPN1F, IPN2F) C************************************************************************ C C PROJET : CASTEM 2000 C C NOM : PRE611 C C DESCRIPTION : Voir PRE61 C C LANGAGE : FORTRAN 77 + ESOPE 2000 (avec extensions CISI) C C AUTEUR : A. BECCANTINI, DEN/DM2S/SFME/LTMF C C************************************************************************ C C ENTREES C C C 1) Pointeurs de MELEMEs et de CHPOINTs de la table DOMAINE C C ICEN : MELEME de 'POI1' SPG des CENTRES C C IFACE : MELEME de 'POI1' SPG des FACES C C IFACEL : MELEME de 'SEG3' avec C CENTRE d'Elt "gauche" C CENTRE de Face C CENTRE d'Elt "droite" C C N.B. = IFACE.NUM(i,1) = IFACEL.NUM(i,2) C C INORM : CHPOINT des cosinus directeurs de normales aux faces C C 2) Autres pointeurs C C IAL1, IGRAL1, ILIAL1, C IAL2, IGRAL2, ILIAL2. C CHPOINT "CENTRE" de fractions volumiques, gradients et limiteurs C C IRN1, IGRRN1, ILIRN1, C IRN2, IGRRN2, ILIRN2. C CHPOINT "CENTRE" de densités, gradients et limiteurs C C IVN1, IGRVN1, ILIVN1, C IVN2, IGRVN2, ILIVN2. C CHPOINT "CENTRE" de vitesses, gradients et limiteurs C C IPN1, IGRPN1, ILIPN1, C IPN2, IGRPN2, ILIPN2. C CHPOINT "CENTRE" de pression, gradients et limiteurs C C C SORTIES C C IAL1F, IAL2F, IRN1F, IRN2F, IVN1F, IVN2F, IPN1F, IPN2F. C MCHAMLs definis sur le MELEME de pointeur IFACEL C C************************************************************************ C C HISTORIQUE (Anomalies et modifications éventuelles) C C HISTORIQUE : Crée le 03.12.09. C Estension au 3D le 21.12.2010 C C************************************************************************ C C C ATTENTION: Cet programme marche si le MAILLAGE est convex; C si non il faut changer l'algoritme de calcul de C l'orientation des normales aux faces. C C La positivité n'est pas controlle parce que c'est déjà fait C dans l'operateur PRIM C C C************************************************************************ C IMPLICIT INTEGER(I-N) C C**** Les variables C INTEGER IAL1, IGRAL1, ILIAL1 & , IAL2, IGRAL2, ILIAL2 & , IRN1, IGRRN1, ILIRN1 & , IRN2, IGRRN2, ILIRN2 & , IVN1, IGRVN1, ILIVN1 & , IVN2, IGRVN2, ILIVN2 & , IPN1, IGRPN1, ILIPN1 & , IPN2, IGRPN2, ILIPN2 & , IAL1F, IAL2F, IRN1F, IRN2F & , IVN1F, IVN2F, IPN1F, IPN2F & , IGEOM, NFAC, NCEN & , N1PTEL, N1EL, N2PTEL, N2EL, N2, N1, N3, L1 & , NLCF, NGCF, NGCEG, NLCEG, NGCED, NLCED, NGCF1 & , IDIMP1, INDCEL REAL*8 XG, YG, ZG, XC, YC, ZC, XD, YD, ZD & ,DXG, DYG, DZG, DXD, DYD, DZD & , CNX, CNY, CNZ, CTX, CTY, CTZ, ORIENT & , CVX, CVY, CVZ & , AL1G, AL2G, RN1G, RN2G, PN1G, PN2G & , UX1G, UX2G, UY1G, UY2G, UZ1G, UZ2G & , UN1G, UN2G, UT1G, UT2G, UV1G, UV2G & , AL1D, AL2D, RN1D, RN2D, PN1D, PN2D & , UX1D, UX2D, UY1D, UY2D, UZ1D, UZ2D & , UN1D, UN2D, UT1D, UT2D, UV1D, UV2D & , VALCEL, DCEL, LIMCEL CHARACTER*(40) MESERR CHARACTER*(8) TYPE LOGICAL LOGI1 C C**** Les Includes C -INC SMCOORD -INC PPARAM -INC CCOPTIO -INC SMCHPOI POINTEUR MPAL1.MPOVAL, MPGAL1.MPOVAL, MPLAL1.MPOVAL POINTEUR MPAL2.MPOVAL, MPGAL2.MPOVAL, MPLAL2.MPOVAL POINTEUR MPRN1.MPOVAL, MPGRN1.MPOVAL, MPLRN1.MPOVAL POINTEUR MPRN2.MPOVAL, MPGRN2.MPOVAL, MPLRN2.MPOVAL POINTEUR MPVN1.MPOVAL, MPGVN1.MPOVAL, MPLVN1.MPOVAL POINTEUR MPVN2.MPOVAL, MPGVN2.MPOVAL, MPLVN2.MPOVAL POINTEUR MPPN1.MPOVAL, MPGPN1.MPOVAL, MPLPN1.MPOVAL POINTEUR MPPN2.MPOVAL, MPGPN2.MPOVAL, MPLPN2.MPOVAL POINTEUR MPNORM.MPOVAL -INC SMCHAML C Melval des cosinus directeurs POINTEUR MELVNX.MELVAL, MELVNY.MELVAL, MELVNZ.MELVAL, & MELT1X.MELVAL, MELT1Y.MELVAL, MELT1Z.MELVAL, & MELT2X.MELVAL, MELT2Y.MELVAL, MELT2Z.MELVAL C Melval des vitesses POINTEUR MEVUN1.MELVAL, MEVUT1.MELVAL, MEVUV1.MELVAL, & MEVUN2.MELVAL, MEVUT2.MELVAL, MEVUV2.MELVAL C Melval des densités, pressions, alphas POINTEUR MELRN1.MELVAL, MELRN2.MELVAL POINTEUR MELPN1.MELVAL, MELPN2.MELVAL POINTEUR MELAL1.MELVAL, MELAL2.MELVAL -INC SMLENTI -INC SMELEME C mcham1 = 0 C C**** KRIPAD pour la correspondance global/local de centre C C C**** MLENTI1 a MCORD.XCOORD(/1)/(IDIM+1) elements C C Si i est le numero global d'un noeud de ICEN, C MLENT1.LECT(i) contient sa position, i.e. C C I = numero global du noeud centre C MLENT1.LECT(i) = numero local du noeud centre C C MLENT1 déjà activé, i.e. C C SEGACT MLENT1 C C**** Activation de CHPOINTs C C alpha + grad + limiteur C densité + grad + limiteur C vitesse + grad + limiteur C pression + grad + limiteur C cosinus directeurs des normales aux surface C C SEGACT MPAL1 C SEGACT MPGAL1 C SEGACT MPLAL1 C SEGACT MPAL2 C SEGACT MPGAL2 C SEGACT MPLAL2 C SEGACT MPRN1 C SEGACT MPGRN1 C SEGACT MPLRN1 C SEGACT MPRN2 C SEGACT MPGRN2 C SEGACT MPLRN2 C SEGACT MPVN1 C SEGACT MPGVN1 C SEGACT MPLVN1 C SEGACT MPVN2 C SEGACT MPGVN2 C SEGACT MPLVN2 C SEGACT MPPN1 C SEGACT MPGPN1 C SEGACT MPLPN1 C SEGACT MPPN2 C SEGACT MPGPN2 C SEGACT MPLPN2 C C**** Le cosinus directeurs C C SEGACT MPNORM C C**** Les MPOVAL sont déjà activés i.e.: C C C**** Le MELEME FACEL C IPT1 = IFACEL IPT2 = IFACE SEGACT IPT1 SEGACT IPT2 NFAC = IPT1.NUM(/2) C C**** Creation de MCHAMLs contenant les etats gauche et droite, C C i.e.: C C vitesse + cosinus directors du repere local C alpha C densité C pression C C********************************************************** C**** Cosinus directors du repere local et vitesse ******** C********************************************************** C C Les cosinus directeurs C N1 = 2 N3 = 6 L1 = 28 SEGINI MCHEL1 IVN1F = MCHEL1 MCHEL1.TITCHE = 'U ' MCHEL1.IMACHE(1) = IFACE MCHEL1.IMACHE(2) = IFACEL IF (IDIM .EQ. 2) THEN MCHEL1.CONCHE(1) = '(n,t) in (x,y) ' MCHEL1.CONCHE(2) = ' U in (n,t) ' ELSE MCHEL1.CONCHE(1) = '(n,t,v)in(x,y,z)' MCHEL1.CONCHE(2) = ' U in (n,t,v) ' ENDIF * MCHEL1.NOPHAS(1) = ' ' * MCHEL1.NOPHAS(2) = ' ' C C**** Valeurs des cosinus definies par respect au repair global, i.e. C MCHEL1.INFCHE(1,1) = 2 MCHEL1.INFCHE(1,3) = NIFOUR MCHEL1.INFCHE(1,4) = 0 MCHEL1.INFCHE(1,5) = 0 MCHEL1.INFCHE(1,6) = 1 MCHEL1.IFOCHE = IFOUR C C**** Valeurs de vitesse definies par respect au repair local, i.e. C MCHEL1.INFCHE(2,1) = 1 MCHEL1.INFCHE(2,3) = NIFOUR MCHEL1.INFCHE(2,4) = 0 MCHEL1.INFCHE(2,5) = 0 MCHEL1.INFCHE(2,6) = 1 C C**** Le cosinus directeurs C N1PTEL = 1 N1EL = NFAC N2PTEL = 0 N2EL = 0 C C**** MCHAML a N2 composantes: C C cosinus directeurs du repere local (n,t1) C C IDIM = 3 -> 9 composantes C IDIM = 2 -> 4 composantes C IF (IDIM .EQ. 2)THEN N2 = 4 SEGINI MCHAM1 MCHEL1.ICHAML(1) = MCHAM1 MCHAM1.NOMCHE(1) = 'NX ' MCHAM1.NOMCHE(2) = 'NY ' MCHAM1.NOMCHE(3) = 'TX ' MCHAM1.NOMCHE(4) = 'TY ' MCHAM1.TYPCHE(1) = 'REAL*8 ' MCHAM1.TYPCHE(2) = 'REAL*8 ' MCHAM1.TYPCHE(3) = 'REAL*8 ' MCHAM1.TYPCHE(4) = 'REAL*8 ' SEGINI MELVNX SEGINI MELVNY SEGINI MELT1X SEGINI MELT1Y MCHAM1.IELVAL(1) = MELVNX MCHAM1.IELVAL(2) = MELVNY MCHAM1.IELVAL(3) = MELT1X MCHAM1.IELVAL(4) = MELT1Y ELSEIF (IDIM .EQ. 3) THEN N2 = 9 SEGINI MCHAM1 MCHEL1.ICHAML(1) = MCHAM1 MCHAM1.NOMCHE(1) = 'NX ' MCHAM1.NOMCHE(2) = 'NY ' MCHAM1.NOMCHE(3) = 'NZ ' MCHAM1.NOMCHE(4) = 'TX ' MCHAM1.NOMCHE(5) = 'TY ' MCHAM1.NOMCHE(6) = 'TZ ' MCHAM1.NOMCHE(7) = 'VX ' MCHAM1.NOMCHE(8) = 'VY ' MCHAM1.NOMCHE(9) = 'VZ ' MCHAM1.TYPCHE(1) = 'REAL*8 ' MCHAM1.TYPCHE(2) = 'REAL*8 ' MCHAM1.TYPCHE(3) = 'REAL*8 ' MCHAM1.TYPCHE(4) = 'REAL*8 ' MCHAM1.TYPCHE(5) = 'REAL*8 ' MCHAM1.TYPCHE(6) = 'REAL*8 ' MCHAM1.TYPCHE(7) = 'REAL*8 ' MCHAM1.TYPCHE(8) = 'REAL*8 ' MCHAM1.TYPCHE(9) = 'REAL*8 ' SEGINI MELVNX SEGINI MELVNY SEGINI MELVNZ SEGINI MELT1X SEGINI MELT1Y SEGINI MELT1Z SEGINI MELT2X SEGINI MELT2Y SEGINI MELT2Z MCHAM1.IELVAL(1) = MELVNX MCHAM1.IELVAL(2) = MELVNY MCHAM1.IELVAL(3) = MELVNZ MCHAM1.IELVAL(4) = MELT1X MCHAM1.IELVAL(5) = MELT1Y MCHAM1.IELVAL(6) = MELT1Z MCHAM1.IELVAL(7) = MELT2X MCHAM1.IELVAL(8) = MELT2Y MCHAM1.IELVAL(9) = MELT2Z ENDIF C C**** Vitesse C N1EL = NFAC N1PTEL = 3 N2EL = 0 N2PTEL = 0 C C**** MCHAML a N2 composantes: C C IDIM = 2 -> 2 composantes C IDIM = 3 -> 3 composantes C N2 = IDIM SEGINI MCHAM1 MCHEL1.ICHAML(2) = MCHAM1 MCHAM1.NOMCHE(1) = 'UN ' MCHAM1.NOMCHE(2) = 'UT ' MCHAM1.TYPCHE(1) = 'REAL*8 ' MCHAM1.TYPCHE(2) = 'REAL*8 ' SEGINI MEVUN1 SEGINI MEVUT1 MCHAM1.IELVAL(1) = MEVUN1 MCHAM1.IELVAL(2) = MEVUT1 IF (IDIM .EQ. 3) THEN MCHAM1.NOMCHE(3) = 'UV ' MCHAM1.TYPCHE(3) = 'REAL*8 ' SEGINI MEVUV1 MCHAM1.IELVAL(3) = MEVUV1 ENDIF C C**** Vitesse 2 C MCHEL1 = IVN1F SEGINI, MCHEL2 = MCHEL1 IVN2F = MCHEL2 C The MCHEL2.ICHAML(1) contiens le cosinus directeurs C => MCHEL2.ICHAML(1) = MCHEL1.ICHAML(1) MCHAM1 = MCHEL1.ICHAML(2) SEGDES MCHEL1 SEGINI, MCHAM2 = MCHAM1 MCHEL2.ICHAML(2) = MCHAM2 SEGDES MCHEL2 SEGINI, MEVUN2 = MEVUN1 SEGINI, MEVUT2 = MEVUT1 MCHAM2.IELVAL(1) = MEVUN2 MCHAM2.IELVAL(2) = MEVUT2 IF (IDIM .EQ. 3)THEN SEGINI, MEVUV2 = MEVUV1 MCHAM2.IELVAL(3) = MEVUV2 ENDIF SEGDES MCHAM2 C C********************************************************** C**** Alpha1 and alpha2 ******** C********************************************************** C C**** Alpha1 C N1 = 1 N3 = 6 L1 = 15 SEGINI MCHEL2 IAL1F = MCHEL2 MCHEL2.IMACHE(1) = IFACEL MCHEL2.TITCHE = 'ALPHA1 ' MCHEL2.CONCHE(1) = ' ' * MCHEL2.NOPHAS(1) = ' ' C C**** Valeurs independente du repére, i.e. C MCHEL2.INFCHE(1,1) = 0 MCHEL2.INFCHE(1,3) = NIFOUR MCHEL2.INFCHE(1,4) = 0 MCHEL2.INFCHE(1,5) = 0 MCHEL2.INFCHE(1,6) = 1 MCHEL2.IFOCHE = IFOUR N2 = 1 SEGINI MCHAM1 MCHEL2.ICHAML(1) = MCHAM1 C SEGDES MCHEL2 MCHAM1.NOMCHE(1) = 'SCAL ' MCHAM1.TYPCHE(1) = 'REAL*8 ' SEGINI MELAL1 MCHAM1.IELVAL(1) = MELAL1 SEGDES MCHAM1 C C**** Alpha2 C MCHEL1 = IAL1F SEGINI, MCHEL2 = MCHEL1 IAL2F = MCHEL2 MCHEL2.TITCHE = 'ALPHA2 ' MCHAM1 = MCHEL1.ICHAML(1) SEGINI, MCHAM2 = MCHAM1 MCHEL2.ICHAML(1) = MCHAM2 SEGDES MCHEL2 SEGINI MELAL2 MCHAM2.IELVAL(1) = MELAL2 SEGDES MCHAM2 C C********************************************************** C**** IRN1F and IRN2F ******** C********************************************************** C MCHEL1 = IAL1F SEGINI, MCHEL2 = MCHEL1 IRN1F = MCHEL2 MCHEL2.TITCHE = 'RHO1 ' MCHAM1 = MCHEL1.ICHAML(1) SEGINI, MCHAM2 = MCHAM1 MCHEL2.ICHAML(1) = MCHAM2 SEGDES MCHEL2 SEGINI MELRN1 MCHAM2.IELVAL(1) = MELRN1 SEGDES MCHAM2 C C MCHEL1 = IAL1F SEGINI, MCHEL2 = MCHEL1 IRN2F = MCHEL2 MCHEL2.TITCHE = 'RHO2 ' MCHAM1 = MCHEL1.ICHAML(1) SEGINI, MCHAM2 = MCHAM1 MCHEL2.ICHAML(1) = MCHAM2 SEGDES MCHEL2 SEGINI MELRN2 MCHAM2.IELVAL(1) = MELRN2 SEGDES MCHAM2 C C C********************************************************** C**** IRN1F and IRN2F ******** C********************************************************** C MCHEL1 = IAL1F SEGINI, MCHEL2 = MCHEL1 IPN1F = MCHEL2 MCHEL2.TITCHE = 'P1 ' MCHAM1 = MCHEL1.ICHAML(1) SEGINI, MCHAM2 = MCHAM1 MCHEL2.ICHAML(1) = MCHAM2 SEGDES MCHEL2 SEGINI MELPN1 MCHAM2.IELVAL(1) = MELPN1 SEGDES MCHAM2 C C MCHEL1 = IAL1F SEGINI, MCHEL2 = MCHEL1 IPN2F = MCHEL2 MCHEL2.TITCHE = 'P2 ' MCHAM1 = MCHEL1.ICHAML(1) SEGINI, MCHAM2 = MCHAM1 MCHEL2.ICHAML(1) = MCHAM2 SEGDES MCHEL2 SEGINI MELPN2 MCHAM2.IELVAL(1) = MELPN2 SEGDES MCHAM2 SEGDES MCHEL1 C C********************************************************** C**** Boucle sur le faces ********* C********************************************************** C CNZ = 0.0D0 CTZ = 0.0D0 DZG = 0.0D0 DZD = 0.0D0 CVX = 0.0D0 CVY = 0.0D0 CVZ = 0.0D0 UZ1G = 0.0D0 UZ1D = 0.0D0 UZ2G = 0.0D0 UZ2D = 0.0D0 C IDIMP1 = IDIM + 1 DO NLCF = 1, NFAC C C******* NLCF = numero local du centre de face C NGCF = numero global du centre de face C NGCEG = numero global du centre ELT "gauche" C NLCEG = numero local du centre ELT "gauche" C NGCED = numero global du centre ELT "droite" C NLCED = numero local du centre ELT "droite" C NGCEG = IPT1.NUM(1,NLCF) NGCF = IPT1.NUM(2,NLCF) NGCED = IPT1.NUM(3,NLCF) NLCEG = MLENT1.LECT(NGCEG) NLCED = MLENT1.LECT(NGCED) C C******* TEST: IPT2.NUM(1,NLCF) = IPT1.NUM(2,NLCF) C NGCF1 = IPT2.NUM(1,NLCF) IF( NGCF1 .NE. NGCF) THEN MESERR(1:40) = 'PRET, subroutine pre611.eso ' WRITE(IOIMP,*) MESERR GOTO 9999 ENDIF C C******* Cosinus directeurs des NORMALES aux faces C C On impose que les normales sont direct "Gauche" -> "Centre" C INDCEL = (NGCEG-1)*IDIMP1 XG = XCOOR(INDCEL+1) YG = XCOOR(INDCEL+2) INDCEL = (NGCF-1)*IDIMP1 XC = XCOOR(INDCEL + 1) YC = XCOOR(INDCEL + 2) INDCEL = (NGCED-1)*IDIMP1 XD = XCOOR(INDCEL+1) YD = XCOOR(INDCEL+2) DXG = XC - XG DYG = YC - YG DXD = XC - XD DYD = YC - YD C C******* On calcule le sign du pruduit scalare C (Normales de Castem) * (vecteur "gauche" -> "centre") C CNX = MPNORM.VPOCHA(NLCF,1) CNY = MPNORM.VPOCHA(NLCF,2) IF (IDIM .EQ. 3) THEN INDCEL = (NGCEG-1)*IDIMP1 ZG = XCOOR(INDCEL+3) INDCEL = (NGCF-1)*IDIMP1 ZC = XCOOR(INDCEL + 3) INDCEL = (NGCED-1)*IDIMP1 ZD = XCOOR(INDCEL+3) DZG = ZC - ZG DZD = ZC - ZD C CNX = MPNORM.VPOCHA(NLCF,7) CNY = MPNORM.VPOCHA(NLCF,8) CNZ = MPNORM.VPOCHA(NLCF,9) ENDIF MESERR(1:30)= & 'PRET , subroutine pre612.eso. ' GOTO 9999 ENDIF C C******* Cosinus directeurs de tangent 2D C CTX = -1.0D0 * CNY CTY = CNX IF (IDIM .EQ. 3) THEN C C********** Cosinus directeurs de tangente 1 C C C********** Cosinus directeurs de tangente 2 C C ENDIF C C******* Les autres MELVALs C C C******* N.B.: On suppose qu'on a déjà controlle RO, P > 0... C C C******* Etat gauche C C ALPHA C VALCEL = MPAL1.VPOCHA(NLCEG, 1) LIMCEL = MPLAL1.VPOCHA(NLCEG, 1) DCEL = (MPGAL1.VPOCHA(NLCEG, 1) * DXG) + & (MPGAL1.VPOCHA(NLCEG, 2) * DYG) IF (IDIM .EQ. 3) DCEL = DCEL + & (MPGAL1.VPOCHA(NLCEG, 3) * DZG) AL1G = VALCEL + (LIMCEL * DCEL) C write(*,*) valcel, limcel, dcel C VALCEL = MPAL2.VPOCHA(NLCEG, 1) LIMCEL = MPLAL2.VPOCHA(NLCEG, 1) DCEL = (MPGAL2.VPOCHA(NLCEG, 1) * DXG) + & (MPGAL2.VPOCHA(NLCEG, 2) * DYG) IF (IDIM .EQ. 3) DCEL = DCEL + & (MPGAL2.VPOCHA(NLCEG, 3) * DZG) AL2G = VALCEL + (LIMCEL * DCEL) C C RN C VALCEL = MPRN1.VPOCHA(NLCEG, 1) LIMCEL = MPLRN1.VPOCHA(NLCEG, 1) DCEL = (MPGRN1.VPOCHA(NLCEG, 1) * DXG) + & (MPGRN1.VPOCHA(NLCEG, 2) * DYG) IF (IDIM .EQ. 3) DCEL = DCEL + & (MPGRN1.VPOCHA(NLCEG, 3) * DZG) RN1G = VALCEL + (LIMCEL * DCEL) C VALCEL = MPRN2.VPOCHA(NLCEG, 1) LIMCEL = MPLRN2.VPOCHA(NLCEG, 1) DCEL = (MPGRN2.VPOCHA(NLCEG, 1) * DXG) + & (MPGRN2.VPOCHA(NLCEG, 2) * DYG) IF (IDIM .EQ. 3) DCEL = DCEL + & (MPGRN2.VPOCHA(NLCEG, 3) * DZG) RN2G = VALCEL + (LIMCEL * DCEL) C C PN C VALCEL = MPPN1.VPOCHA(NLCEG, 1) LIMCEL = MPLPN1.VPOCHA(NLCEG, 1) DCEL = (MPGPN1.VPOCHA(NLCEG, 1) * DXG) + & (MPGPN1.VPOCHA(NLCEG, 2) * DYG) IF (IDIM .EQ. 3) DCEL = DCEL + & (MPGPN1.VPOCHA(NLCEG, 3) * DZG) PN1G = VALCEL + (LIMCEL * DCEL) C VALCEL = MPPN2.VPOCHA(NLCEG, 1) LIMCEL = MPLPN2.VPOCHA(NLCEG, 1) DCEL = (MPGPN2.VPOCHA(NLCEG, 1) * DXG) + & (MPGPN2.VPOCHA(NLCEG, 2) * DYG) IF (IDIM .EQ. 3) DCEL = DCEL + & (MPGPN2.VPOCHA(NLCEG, 3) * DZG) PN2G = VALCEL + (LIMCEL * DCEL) C C VN C IF (IDIM .EQ. 2) THEN VALCEL = MPVN1.VPOCHA(NLCEG, 1) LIMCEL = MPLVN1.VPOCHA(NLCEG, 1) DCEL = MPGVN1.VPOCHA(NLCEG, 1)*DXG + & MPGVN1.VPOCHA(NLCEG, 2)*DYG UX1G = VALCEL + LIMCEL * DCEL C VALCEL = MPVN1.VPOCHA(NLCEG, 2) LIMCEL = MPLVN1.VPOCHA(NLCEG, 2) DCEL = MPGVN1.VPOCHA(NLCEG, 3)*DXG + & MPGVN1.VPOCHA(NLCEG, 4)*DYG UY1G = VALCEL + LIMCEL * DCEL C VALCEL = MPVN2.VPOCHA(NLCEG, 1) LIMCEL = MPLVN2.VPOCHA(NLCEG, 1) DCEL = MPGVN2.VPOCHA(NLCEG, 1)*DXG + & MPGVN2.VPOCHA(NLCEG, 2)*DYG UX2G = VALCEL + LIMCEL * DCEL C VALCEL = MPVN2.VPOCHA(NLCEG, 2) LIMCEL = MPLVN2.VPOCHA(NLCEG, 2) DCEL = MPGVN2.VPOCHA(NLCEG, 3)*DXG + & MPGVN2.VPOCHA(NLCEG, 4)*DYG UY2G = VALCEL + LIMCEL * DCEL ELSE VALCEL = MPVN1.VPOCHA(NLCEG, 1) LIMCEL = MPLVN1.VPOCHA(NLCEG, 1) DCEL = MPGVN1.VPOCHA(NLCEG, 1)*DXG + & MPGVN1.VPOCHA(NLCEG, 2)*DYG + & MPGVN1.VPOCHA(NLCEG, 3)*DZG UX1G = VALCEL + LIMCEL * DCEL C VALCEL = MPVN1.VPOCHA(NLCEG, 2) LIMCEL = MPLVN1.VPOCHA(NLCEG, 2) DCEL = MPGVN1.VPOCHA(NLCEG, 4)*DXG + & MPGVN1.VPOCHA(NLCEG, 5)*DYG + & MPGVN1.VPOCHA(NLCEG, 6)*DZG UY1G = VALCEL + LIMCEL * DCEL C VALCEL = MPVN1.VPOCHA(NLCEG, 3) LIMCEL = MPLVN1.VPOCHA(NLCEG, 3) DCEL = MPGVN1.VPOCHA(NLCEG, 7)*DXG + & MPGVN1.VPOCHA(NLCEG, 8)*DYG + & MPGVN1.VPOCHA(NLCEG, 9)*DZG UZ1G = VALCEL + LIMCEL * DCEL C VALCEL = MPVN2.VPOCHA(NLCEG, 1) LIMCEL = MPLVN2.VPOCHA(NLCEG, 1) DCEL = MPGVN2.VPOCHA(NLCEG, 1)*DXG + & MPGVN2.VPOCHA(NLCEG, 2)*DYG + & MPGVN2.VPOCHA(NLCEG, 3)*DZG UX2G = VALCEL + LIMCEL * DCEL C VALCEL = MPVN2.VPOCHA(NLCEG, 2) LIMCEL = MPLVN2.VPOCHA(NLCEG, 2) DCEL = MPGVN2.VPOCHA(NLCEG, 4)*DXG + & MPGVN2.VPOCHA(NLCEG, 5)*DYG + & MPGVN2.VPOCHA(NLCEG, 6)*DZG UY2G = VALCEL + LIMCEL * DCEL C VALCEL = MPVN2.VPOCHA(NLCEG, 3) LIMCEL = MPLVN2.VPOCHA(NLCEG, 3) DCEL = MPGVN2.VPOCHA(NLCEG, 7)*DXG + & MPGVN2.VPOCHA(NLCEG, 8)*DYG + & MPGVN2.VPOCHA(NLCEG, 9)*DZG UZ2G = VALCEL + LIMCEL * DCEL ENDIF C C******* Si l'on fait pas de prediction, ce n'est pas necessaire de C controller la positivite' de la pression et de la densité; elle C est déjà garantie par la proprieté LED de limiteur; mais, vu C que le limiteur n'est pas calculé ici, mais dans un autre C operateur, on le fait C LOGI1 = (RN1G .LT. 0.0D0) .OR. (RN2G .LT. 0.0D0) .OR. & (PN1G .LT. 0.0D0) .OR. (PN2G .LT. 0.0D0) .OR. & (AL1G .LT. 0.0D0) .OR. (AL2G .LT. 0.0D0) .OR. & (AL1G .GT. 1.0D0) .OR. (AL2G .GT. 1.0D0) C IF ( NGCEG .EQ. NGCED) THEN C C********** Cas mur C IF(LOGI1)THEN C C********** Premier ordre en espace local C AL1G = MPAL1.VPOCHA(NLCEG,1) AL2G = MPAL2.VPOCHA(NLCEG,1) RN1G = MPRN1.VPOCHA(NLCEG,1) RN2G = MPRN2.VPOCHA(NLCEG,1) PN1G = MPPN1.VPOCHA(NLCEG,1) PN2G = MPPN2.VPOCHA(NLCEG,1) UX1G = MPVN1.VPOCHA(NLCEG,1) UY1G = MPVN1.VPOCHA(NLCEG,2) UX2G = MPVN2.VPOCHA(NLCEG,1) UY2G = MPVN2.VPOCHA(NLCEG,2) IF (IDIM .EQ. 3) THEN UZ1G = MPVN1.VPOCHA(NLCEG,3) UZ2G = MPVN2.VPOCHA(NLCEG,3) ENDIF ENDIF C UN1G = UX1G * CNX + UY1G * CNY + UZ1G * CNZ UT1G = UX1G * CTX + UY1G * CTY + UZ1G * CTZ UN2G = UX2G * CNX + UY2G * CNY + UZ2G * CNZ UT2G = UX2G * CTX + UY2G * CTY + UZ2G * CTZ UV1G = UX1G * CVX + UY1G * CVY + UZ1G * CVZ UV2G = UX2G * CVX + UY2G * CVY + UZ2G * CVZ C C********** Son etat droite C AL1D = AL1G AL2D = AL2G RN1D = RN1G RN2D = RN2G PN1D = PN1G PN2D = PN2G UN1D = -1.0D0 * UN1G UN2D = -1.0D0 * UN2G UT1D = UT1G UT2D = UT2G UV1D = UV1G UV2D = UV2G C C********** Fin cas mur C ELSE VALCEL = MPAL1.VPOCHA(NLCED, 1) LIMCEL = MPLAL1.VPOCHA(NLCED, 1) DCEL = (MPGAL1.VPOCHA(NLCED, 1) * DXD) + & (MPGAL1.VPOCHA(NLCED, 2) * DYD) IF (IDIM .EQ. 3) DCEL = DCEL + & (MPGAL1.VPOCHA(NLCED, 3) * DZD) AL1D = VALCEL + (LIMCEL * DCEL) C VALCEL = MPAL2.VPOCHA(NLCED, 1) LIMCEL = MPLAL2.VPOCHA(NLCED, 1) DCEL = (MPGAL2.VPOCHA(NLCED, 1) * DXD) + & (MPGAL2.VPOCHA(NLCED, 2) * DYD) IF (IDIM .EQ. 3) DCEL = DCEL + & (MPGAL2.VPOCHA(NLCED, 3) * DZD) AL2D = VALCEL + (LIMCEL * DCEL) C C RN C VALCEL = MPRN1.VPOCHA(NLCED, 1) LIMCEL = MPLRN1.VPOCHA(NLCED, 1) DCEL = (MPGRN1.VPOCHA(NLCED, 1) * DXD) + & (MPGRN1.VPOCHA(NLCED, 2) * DYD) IF (IDIM .EQ. 3) DCEL = DCEL + & (MPGRN1.VPOCHA(NLCED, 3) * DZD) RN1D = VALCEL + (LIMCEL * DCEL) C VALCEL = MPRN2.VPOCHA(NLCED, 1) LIMCEL = MPLRN2.VPOCHA(NLCED, 1) DCEL = (MPGRN2.VPOCHA(NLCED, 1) * DXD) + & (MPGRN2.VPOCHA(NLCED, 2) * DYD) IF (IDIM .EQ. 3) DCEL = DCEL + & (MPGRN2.VPOCHA(NLCED, 3) * DZD) RN2D = VALCEL + (LIMCEL * DCEL) C C PN C VALCEL = MPPN1.VPOCHA(NLCED, 1) LIMCEL = MPLPN1.VPOCHA(NLCED, 1) DCEL = (MPGPN1.VPOCHA(NLCED, 1) * DXD) + & (MPGPN1.VPOCHA(NLCED, 2) * DYD) IF (IDIM .EQ. 3) DCEL = DCEL + & (MPGPN1.VPOCHA(NLCED, 3) * DZD) PN1D = VALCEL + (LIMCEL * DCEL) C VALCEL = MPPN2.VPOCHA(NLCED, 1) LIMCEL = MPLPN2.VPOCHA(NLCED, 1) DCEL = (MPGPN2.VPOCHA(NLCED, 1) * DXD) + & (MPGPN2.VPOCHA(NLCED, 2) * DYD) IF (IDIM .EQ. 3) DCEL = DCEL + & (MPGPN2.VPOCHA(NLCED, 3) * DZD) PN2D = VALCEL + (LIMCEL * DCEL) C C VN C IF (IDIM .EQ. 2) THEN VALCEL = MPVN1.VPOCHA(NLCED, 1) LIMCEL = MPLVN1.VPOCHA(NLCED, 1) DCEL = MPGVN1.VPOCHA(NLCED, 1)*DXD + & MPGVN1.VPOCHA(NLCED, 2)*DYD UX1D = VALCEL + LIMCEL * DCEL C VALCEL = MPVN1.VPOCHA(NLCED, 2) LIMCEL = MPLVN1.VPOCHA(NLCED, 2) DCEL = MPGVN1.VPOCHA(NLCED, 3)*DXD + & MPGVN1.VPOCHA(NLCED, 4)*DYD UY1D = VALCEL + LIMCEL * DCEL C VALCEL = MPVN2.VPOCHA(NLCED, 1) LIMCEL = MPLVN2.VPOCHA(NLCED, 1) DCEL = MPGVN2.VPOCHA(NLCED, 1)*DXD + & MPGVN2.VPOCHA(NLCED, 2)*DYD UX2D = VALCEL + LIMCEL * DCEL C VALCEL = MPVN2.VPOCHA(NLCED, 2) LIMCEL = MPLVN2.VPOCHA(NLCED, 2) DCEL = MPGVN2.VPOCHA(NLCED, 3)*DXD + & MPGVN2.VPOCHA(NLCED, 4)*DYD UY2D = VALCEL + LIMCEL * DCEL ELSE VALCEL = MPVN1.VPOCHA(NLCED, 1) LIMCEL = MPLVN1.VPOCHA(NLCED, 1) DCEL = MPGVN1.VPOCHA(NLCED, 1)*DXD + & MPGVN1.VPOCHA(NLCED, 2)*DYD + & MPGVN1.VPOCHA(NLCED, 3)*DZD UX1D = VALCEL + LIMCEL * DCEL C VALCEL = MPVN1.VPOCHA(NLCED, 2) LIMCEL = MPLVN1.VPOCHA(NLCED, 2) DCEL = MPGVN1.VPOCHA(NLCED, 4)*DXD + & MPGVN1.VPOCHA(NLCED, 5)*DYD + & MPGVN1.VPOCHA(NLCED, 6)*DZD UY1D = VALCEL + LIMCEL * DCEL C VALCEL = MPVN1.VPOCHA(NLCED, 3) LIMCEL = MPLVN1.VPOCHA(NLCED, 3) DCEL = MPGVN1.VPOCHA(NLCED, 7)*DXD + & MPGVN1.VPOCHA(NLCED, 8)*DYD + & MPGVN1.VPOCHA(NLCED, 9)*DZD UZ1D = VALCEL + LIMCEL * DCEL C VALCEL = MPVN2.VPOCHA(NLCED, 1) LIMCEL = MPLVN2.VPOCHA(NLCED, 1) DCEL = MPGVN2.VPOCHA(NLCED, 1)*DXD + & MPGVN2.VPOCHA(NLCED, 2)*DYD + & MPGVN2.VPOCHA(NLCED, 3)*DZD UX2D = VALCEL + LIMCEL * DCEL C VALCEL = MPVN2.VPOCHA(NLCED, 2) LIMCEL = MPLVN2.VPOCHA(NLCED, 2) DCEL = MPGVN2.VPOCHA(NLCED, 4)*DXD + & MPGVN2.VPOCHA(NLCED, 5)*DYD + & MPGVN2.VPOCHA(NLCED, 6)*DZD UY2D = VALCEL + LIMCEL * DCEL C VALCEL = MPVN2.VPOCHA(NLCED, 3) LIMCEL = MPLVN2.VPOCHA(NLCED, 3) DCEL = MPGVN2.VPOCHA(NLCED, 7)*DXD + & MPGVN2.VPOCHA(NLCED, 8)*DYD + & MPGVN2.VPOCHA(NLCED, 9)*DZD UZ2D = VALCEL + LIMCEL * DCEL C ENDIF C C********** Si l'on fait pas de prediction, ce n'est pas necessaire de C controller la positivite' de la pression et de la densité; elle C est déjà garantie par la proprieté LED de limiteur; mais, vu C que le limiteur n'est pas calculé ici, mais dans un autre C operateur, on le fait C LOGI1 = LOGI1 .OR. (RN1D .LT. 0.0D0) .OR. (RN2D .LT. 0.0D0) $ .OR.(PN1D .LT. 0.0D0) .OR. (PN2D .LT. 0.0D0) .OR. $ (AL1D .LT. 0.0D0) .OR. (AL2D .LT. 0.0D0) .OR. $ (AL1D .GT. 1.0D0) .OR. (AL2D .GT. 1.0D0) C IF(LOGI1)THEN C C************* Premier ordre en espace local C AL1G = MPAL1.VPOCHA(NLCEG,1) AL2G = MPAL2.VPOCHA(NLCEG,1) RN1G = MPRN1.VPOCHA(NLCEG,1) RN2G = MPRN2.VPOCHA(NLCEG,1) PN1G = MPPN1.VPOCHA(NLCEG,1) PN2G = MPPN2.VPOCHA(NLCEG,1) UX1G = MPVN1.VPOCHA(NLCEG,1) UY1G = MPVN1.VPOCHA(NLCEG,2) UX2G = MPVN2.VPOCHA(NLCEG,1) UY2G = MPVN2.VPOCHA(NLCEG,2) C AL1D = MPAL1.VPOCHA(NLCED,1) AL2D = MPAL2.VPOCHA(NLCED,1) RN1D = MPRN1.VPOCHA(NLCED,1) RN2D = MPRN2.VPOCHA(NLCED,1) PN1D = MPPN1.VPOCHA(NLCED,1) PN2D = MPPN2.VPOCHA(NLCED,1) UX1D = MPVN1.VPOCHA(NLCED,1) UY1D = MPVN1.VPOCHA(NLCED,2) UX2D = MPVN2.VPOCHA(NLCED,1) UY2D = MPVN2.VPOCHA(NLCED,2) C IF (IDIM .EQ. 3) THEN UZ1G = MPVN1.VPOCHA(NLCEG,3) UZ2G = MPVN2.VPOCHA(NLCEG,3) UZ1D = MPVN1.VPOCHA(NLCED,3) UZ2D = MPVN2.VPOCHA(NLCED,3) ENDIF ENDIF C UN1G = UX1G * CNX + UY1G * CNY + UZ1G * CNZ UT1G = UX1G * CTX + UY1G * CTY + UZ1G * CTZ UV1G = UX1G * CVX + UY1G * CVY + UZ1G * CVZ UN2G = UX2G * CNX + UY2G * CNY + UZ2G * CNZ UT2G = UX2G * CTX + UY2G * CTY + UZ2G * CTZ UV2G = UX2G * CVX + UY2G * CVY + UZ2G * CVZ C UN1D = UX1D * CNX + UY1D * CNY + UZ1D * CNZ UT1D = UX1D * CTX + UY1D * CTY + UZ1D * CTZ UV1D = UX1D * CVX + UY1D * CVY + UZ1D * CVZ UN2D = UX2D * CNX + UY2D * CNY + UZ2D * CNZ UT2D = UX2D * CTX + UY2D * CTY + UZ2D * CTZ UV2D = UX2D * CVX + UY2D * CVY + UZ2D * CVZ C ENDIF C C C******** Les MELVALs C MELAL1.VELCHE(1,NLCF) = AL1G MELAL1.VELCHE(3,NLCF) = AL1D MELAL2.VELCHE(1,NLCF) = AL2G MELAL2.VELCHE(3,NLCF) = AL2D C MELRN1.VELCHE(1,NLCF) = RN1G MELRN1.VELCHE(3,NLCF) = RN1D MELRN2.VELCHE(1,NLCF) = RN2G MELRN2.VELCHE(3,NLCF) = RN2D C MELPN1.VELCHE(1,NLCF) = PN1G MELPN1.VELCHE(3,NLCF) = PN1D MELPN2.VELCHE(1,NLCF) = PN2G MELPN2.VELCHE(3,NLCF) = PN2D C MEVUN1.VELCHE(1,NLCF) = UN1G MEVUN1.VELCHE(3,NLCF) = UN1D MEVUT1.VELCHE(1,NLCF) = UT1G MEVUT1.VELCHE(3,NLCF) = UT1D MEVUN2.VELCHE(1,NLCF) = UN2G MEVUN2.VELCHE(3,NLCF) = UN2D MEVUT2.VELCHE(1,NLCF) = UT2G MEVUT2.VELCHE(3,NLCF) = UT2D MELVNX.VELCHE(1,NLCF) = CNX MELVNY.VELCHE(1,NLCF) = CNY MELT1X.VELCHE(1,NLCF) = CTX MELT1Y.VELCHE(1,NLCF) = CTY IF (IDIM .EQ. 3) THEN MELVNZ.VELCHE(1,NLCF) = CNZ MELT1Z.VELCHE(1,NLCF) = CTZ MELT2X.VELCHE(1,NLCF) = CVX MELT2Y.VELCHE(1,NLCF) = CVY MELT2Z.VELCHE(1,NLCF) = CVZ C MEVUV1.VELCHE(1,NLCF) = UV1G MEVUV1.VELCHE(3,NLCF) = UV1D MEVUV2.VELCHE(1,NLCF) = UV2G MEVUV2.VELCHE(3,NLCF) = UV2D ENDIF ENDDO C C**** Desactivation des SEGMENTs C SEGDES IPT1 SEGDES IPT2 C C MPOVALs C SEGDES MPNORM C SEGDES MPAL1 SEGDES MPGAL1 SEGDES MPLAL1 SEGDES MPAL2 SEGDES MPGAL2 SEGDES MPLAL2 C SEGDES MPRN1 SEGDES MPGRN1 SEGDES MPLRN1 SEGDES MPRN2 SEGDES MPGRN2 SEGDES MPLRN2 C SEGDES MPPN1 SEGDES MPGPN1 SEGDES MPLPN1 SEGDES MPPN2 SEGDES MPGPN2 SEGDES MPLPN2 C SEGDES MPVN1 SEGDES MPGVN1 SEGDES MPLVN1 SEGDES MPVN2 SEGDES MPGVN2 SEGDES MPLVN2 C C MELVALs C SEGDES MELVNX SEGDES MELVNY SEGDES MELT1X SEGDES MELT1Y SEGDES MEVUN1 SEGDES MEVUT1 SEGDES MEVUN2 SEGDES MEVUT2 IF (IDIM .EQ. 3) THEN SEGDES MELVNZ SEGDES MELT1Z SEGDES MELT2X SEGDES MELT2Y SEGDES MELT2Z SEGDES MEVUV1 SEGDES MEVUV2 ENDIF C SEGDES MELAL1 SEGDES MELAL2 C SEGDES MELRN1 SEGDES MELRN2 C SEGDES MELPN1 SEGDES MELPN2 C C C**** Destruction du MELNTI correspondance local/global C SEGSUP MLENT1 C 9999 CONTINUE if (mcham1.ne.0) segdes mcham1 C RETURN END
© Cast3M 2003 - Tous droits réservés.
Mentions légales