pre32f
C PRE32F SOURCE OF166741 24/10/03 21:15:34 12022 & IALP, IUVC, IULC, IPC, ITVC, ITLC, IRVC, IRLC, & IALPF, IUVF, IULF, IPF, ITVF, ITLF, & IRVF, IRLF, & LOGAN,LOGNEG,LOGBOR,MESERR,VALER,VAL1,VAL2) C************************************************************************ C C PROJET : CASTEM 2000 C C NOM : PRE32F C C DESCRIPTION : Voir PRE12F C C Three dimensions C C Two Fluid Flow, 1st order in time and space C C Creations des objets MCHAML IALPF, IUVF, IULF, C IPF, ITVF, ITLF, IRVF, IRLF C C LANGAGE : FORTRAN 77 + ESOPE 2000 (avec extensions CISI) C C AUTEUR : A. BECCANTINI, DRN/DMT/SEMT/TTMF C Modified for two-fluid flow by C Jose R. Garcia-Cascales C C************************************************************************ C C APPELES (Outils) : KRIPAD, LICHT C C APPELES (Calcul) : AUCUN C C************************************************************************ C C ENTREES 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) Pointeurs des CHPOINTs C C IALP : CHPOINT "CENTRE" containing void fraction C C IUVC : CHPOINT "CENTRE" containing UVX, UVY & UVZ C C IULC : CHPOINT "CENTRE" containing ULX, UVY & ULZ C C IPC : CHPOINT "CENTRE" containing P C C ITV : CHPOINT "CENTRE" containing TV C C ITL : CHPOINT "CENTRE" containing TL C C IRVC : CHPOINT "CENTRE" containing RV C C IRLC : CHPOINT "CENTRE" containing RL C C SORTIES C C IALPF : MCHAML defined en la MELEME of pointers C IFACEL, it contains the void fraction C (a gauche et a droite de chaque face). C Only one component ('SCAL') C C IUVF : MCHAML "FACEL" vapour velocity and the C director cosines (n,t) in the corresponding face; C in the 2D case 6 composantes: C 'UVN' = normal velocity C 'UVT' = tangent velocity, C 'UVV' = tangent velocity C these two velocities are defined in a local C reference framework defined over the MELEME C of pointers IFACE C 'NX' = n.x C 'NY' = n.y C 'T1X' = t1.x C 'T1Y' = t1.y C 'T2X' = t2.x C 'T2Y' = t2.y C C IULF : MCHAML "FACEL" liquid velocity C in the 2D case 2 composantes: C 'ULN' = normal velocity C 'ULT' = tangent velocity C 'ULV' = tangent velocity C C IPF : MCHAML "FACEL" pressure C Only one component ('SCAL') C C ITVF : MCHAML "FACEL" vapour temperature C Only one component ('SCAL') C C ITVL : MCHAML "FACEL" liquid temperature C Only one component ('SCAL') C C IRVF : MCHAML "FACEL" vapour density C Only one component ('SCAL') C C IRLF : MCHAML "FACEL" liquid density C Only one component ('SCAL') C C LOGAN : anomalie detectee (changement de la convention dans C la table domaine) C C LOGNEG : (LOGICAL): si .TRUE. une pression ou une densité C negative a été detectée -> en interactif le C programme s'arrete en GIBIANE C (erreur stocké en MESERR et VALER) C C LOGBOR : (LOGICAL): si .TRUE. un gamma a ete detecte C dehor 1 et 3 (sa valeur stockée en MESERR et VALER; C en VAL1 et en VAL2 on stocke 1.0 et 3.0) C C MESERR C VALER C VAL1, C VAL2 : pour les messages d'erreur C C************************************************************************ C C HISTORIQUE (Anomalies et modifications éventuelles) C C HISTORIQUE : Créée le 11.6.98.(Adapted to two phase flow 26th C February 2002) C C************************************************************************ C C C ATTENTION: Cet programme marche que si le MAILLAGE est convex; C si non il faut changer l'argoritme de calcul de C l'orientation des normales aux faces. C C C************************************************************************ C IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) C C**** Les variables C INTEGER ICEN, IFACE, IFACEL, & IALP, IUVC, IULC, IPC, ITVC, ITLC, IRVC, IRLC, INORM, & IALPF, IUVF, IULF, IPF, ITVF, ITLF, IRVF, IRLF, & IGEOM, NFAC, & N1PTEL, N1EL, N2PTEL, N2EL, N2, N1, N3, L1, & NLCF, NGCF, NGCEG, NLCEG, NGCED, NLCED, NGCF1 REAL*8 VALER, VAL1, VAL2, XG, YG, ZG, XC, YC, ZC, DXG, DYG, DZG, & CNX, CNY, CNZ, CTX, CTY, CTZ, CVX, CVY, CVZ, ORIENT, & AG, UVXG, UVYG, UVZG, UVNG, UVTG, UVVG, & ULXG, ULYG, ULZG, ULNG, ULTG, ULVG, & PG, TVG, TLG, RVG, RLG, & AD, UVXD, UVYD, UVZD, UVND, UVTD, UVVD, & ULXD, ULYD, ULZD, ULND, ULTD, ULVD, & PD, TVD, TLD, RVD, RLD CHARACTER*(40) MESERR CHARACTER*(8) TYPE LOGICAL LOGAN,LOGNEG, LOGBOR C C**** Les Includes C -INC SMCOORD -INC PPARAM -INC CCOPTIO -INC SMCHPOI POINTEUR MPALP.MPOVAL, MPUVC.MPOVAL, MPULC.MPOVAL, & MPPC.MPOVAL, MPTVC.MPOVAL, MPTLC.MPOVAL, & MPRVC.MPOVAL, MPRLC.MPOVAL, MPNORM.MPOVAL -INC SMCHAML POINTEUR MLALP.MELVAL, MLP.MELVAL, & MLTV.MELVAL, MLTL.MELVAL, & MLRV.MELVAL, MLRL.MELVAL POINTEUR MLUVN.MELVAL, MLUVT.MELVAL, MLUVV.MELVAL, & MLULN.MELVAL, MLULT.MELVAL, MLULV.MELVAL, & MLVNX.MELVAL, MLVNY.MELVAL, MLVNZ.MELVAL, & MLVT1X.MELVAL, MLVT1Y.MELVAL, MLVT1Z.MELVAL, & MLVT2X.MELVAL, MLVT2Y.MELVAL, MLVT2Z.MELVAL, & MLLNX.MELVAL, MLLNY.MELVAL, MLLNZ.MELVAL, & MLLT1X.MELVAL, MLLT1Y.MELVAL, MLLT1Z.MELVAL, & MLLT2X.MELVAL, MLLT2Y.MELVAL, MLLT2Z.MELVAL -INC SMLENTI -INC SMELEME C C**** Initialisation des parametres d'erreur déjà faite, i.e. C C LOGNEG = .FALSE. C LOGBOR = .FALSE. C MESERR = ' ' C MOTERR(1:40) = MESERR(1:40) C VALER = 0.0D0 C VAL1 = 0.0D0 C VAL2 = 0.0D0 C C C**** KRIPAD pour la correspondance global/local de centre C 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 SEGINI MLENTI1 C C**** Activation de CHPOINTs C C void fraction C vapour velocities C liquid velocities C pressure C vapour temperature C liquid temperature C vapour density C liquid density C C cosinus directeurs des normales aux surface C C C SEGACT MPALP C SEGACT MPUVC C SEGACT MPULC C SEGACT MPPC C SEGACT MPTVC C SEGACT MPTLC C SEGACT MPRVC C SEGACT MPRLC C SEGACT MPNORM C C**** MPOVA1 - MPOVA5 sont déjà activés i.e.: 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 densité C pression C gamma C C**** Cosinus directors du repere local et vitesse C C Les cosinus directeurs C C VAPOUR PHASE N1 = 2 N3 = 6 L1 = 28 SEGINI MCHEL1 IUVF = MCHEL1 MCHEL1.TITCHE = 'UV ' MCHEL1.IMACHE(1) = IFACE MCHEL1.IMACHE(2) = IFACEL MCHEL1.CONCHE(1) = '(n,t,v) in (x,y)' MCHEL1.CONCHE(2) = ' UV in (n,t,v) ' 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 N2 = 9 SEGINI MCHAM1 MCHEL1.ICHAML(1) = MCHAM1 MCHAM1.NOMCHE(1) = 'NVX ' MCHAM1.NOMCHE(2) = 'NVY ' MCHAM1.NOMCHE(3) = 'NVZ ' MCHAM1.NOMCHE(4) = 'TVX ' MCHAM1.NOMCHE(5) = 'TVY ' MCHAM1.NOMCHE(6) = 'TVZ ' MCHAM1.NOMCHE(7) = 'VVX ' MCHAM1.NOMCHE(8) = 'VVY ' MCHAM1.NOMCHE(9) = 'VVZ ' 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 MLVNX SEGINI MLVNY SEGINI MLVNZ SEGINI MLVT1X SEGINI MLVT1Y SEGINI MLVT1Z SEGINI MLVT2X SEGINI MLVT2Y SEGINI MLVT2Z MCHAM1.IELVAL(1) = MLVNX MCHAM1.IELVAL(2) = MLVNY MCHAM1.IELVAL(3) = MLVNZ MCHAM1.IELVAL(4) = MLVT1X MCHAM1.IELVAL(5) = MLVT1Y MCHAM1.IELVAL(6) = MLVT1Z MCHAM1.IELVAL(7) = MLVT2X MCHAM1.IELVAL(8) = MLVT2Y MCHAM1.IELVAL(9) = MLVT2Z SEGDES MCHAM1 C C**** Vitesse C N1EL = NFAC N1PTEL = 3 N2EL = 0 N2PTEL = 0 C C**** MCHAML a N2 composantes: C C IDIM = 3 -> 3 composantes C N2 = 3 SEGINI MCHAM1 MCHEL1.ICHAML(2) = MCHAM1 SEGDES MCHEL1 MCHAM1.NOMCHE(1) = 'UVN ' MCHAM1.NOMCHE(2) = 'UVT ' MCHAM1.NOMCHE(3) = 'UVV ' MCHAM1.TYPCHE(1) = 'REAL*8 ' MCHAM1.TYPCHE(2) = 'REAL*8 ' MCHAM1.TYPCHE(3) = 'REAL*8 ' SEGINI MLUVN SEGINI MLUVT SEGINI MLUVV MCHAM1.IELVAL(1) = MLUVN MCHAM1.IELVAL(2) = MLUVT MCHAM1.IELVAL(3) = MLUVV SEGDES MCHAM1 C C**** Cosinus directors du repere local et vitesse C C Les cosinus directeurs C C LIQUID PHASE N1 = 2 N3 = 6 L1 = 28 SEGINI MCHEL1 IULF = MCHEL1 MCHEL1.TITCHE = 'UL ' MCHEL1.IMACHE(1) = IFACE MCHEL1.IMACHE(2) = IFACEL MCHEL1.CONCHE(1) = '(n,t,v) in (x,y)' MCHEL1.CONCHE(2) = ' UL in (n,t,v) ' 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 N2 = 9 SEGINI MCHAM1 MCHEL1.ICHAML(1) = MCHAM1 MCHAM1.NOMCHE(1) = 'NLX ' MCHAM1.NOMCHE(2) = 'NLY ' MCHAM1.NOMCHE(3) = 'NLZ ' MCHAM1.NOMCHE(4) = 'TLX ' MCHAM1.NOMCHE(5) = 'TLY ' MCHAM1.NOMCHE(6) = 'TLZ ' MCHAM1.NOMCHE(7) = 'VLX ' MCHAM1.NOMCHE(8) = 'VLY ' MCHAM1.NOMCHE(9) = 'VLZ ' 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 MLLNX SEGINI MLLNY SEGINI MLLNZ SEGINI MLLT1X SEGINI MLLT1Y SEGINI MLLT1Z SEGINI MLLT2X SEGINI MLLT2Y SEGINI MLLT2Z MCHAM1.IELVAL(1) = MLLNX MCHAM1.IELVAL(2) = MLLNY MCHAM1.IELVAL(3) = MLLNZ MCHAM1.IELVAL(4) = MLLT1X MCHAM1.IELVAL(5) = MLLT1Y MCHAM1.IELVAL(6) = MLLT1Z MCHAM1.IELVAL(7) = MLLT2X MCHAM1.IELVAL(8) = MLLT2Y MCHAM1.IELVAL(9) = MLLT2Z SEGDES MCHAM1 C C**** Vitesse C N1EL = NFAC N1PTEL = 3 N2EL = 0 N2PTEL = 0 C C**** MCHAML a N2 composantes: C C IDIM = 3 -> 3 composantes C N2 = 3 SEGINI MCHAM1 MCHEL1.ICHAML(2) = MCHAM1 SEGDES MCHEL1 MCHAM1.NOMCHE(1) = 'ULN ' MCHAM1.NOMCHE(2) = 'ULT ' MCHAM1.NOMCHE(3) = 'ULV ' MCHAM1.TYPCHE(1) = 'REAL*8 ' MCHAM1.TYPCHE(2) = 'REAL*8 ' MCHAM1.TYPCHE(3) = 'REAL*8 ' SEGINI MLULN SEGINI MLULT SEGINI MLULV MCHAM1.IELVAL(1) = MLULN MCHAM1.IELVAL(2) = MLULT MCHAM1.IELVAL(3) = MLULV SEGDES MCHAM1 C C**** Void fraction C N1 = 1 N3 = 6 L1 = 15 SEGINI MCHEL2 IALPF = MCHEL2 MCHEL2.IMACHE(1) = IFACEL MCHEL2.TITCHE = 'ALPHA ' MCHEL2.CONCHE(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 SEGDES MCHEL2 MCHAM1.NOMCHE(1) = 'SCAL ' MCHAM1.TYPCHE(1) = 'REAL*8 ' SEGINI MLALP MCHAM1.IELVAL(1) = MLALP SEGDES MCHAM1 C C**** Pressure C MCHEL1 = IALPF SEGINI, MCHEL2 = MCHEL1 IPF = MCHEL2 MCHEL2.TITCHE = 'P ' C C**** MCHAM1 = MCHAML de la alpha C SEGINI, MCHAM2 = MCHAM1 MCHEL2.ICHAML(1) = MCHAM2 SEGDES MCHEL2 SEGINI MLP MCHAM2.IELVAL(1) = MLP SEGDES MCHAM2 C C**** Vapour temperature C MCHEL1 = IALPF SEGINI, MCHEL2 = MCHEL1 ITVF = MCHEL2 MCHEL2.TITCHE = 'TV ' C C**** MCHAM1 = MCHAML de la alpha C SEGINI, MCHAM2 = MCHAM1 MCHEL2.ICHAML(1) = MCHAM2 SEGDES MCHEL2 SEGINI MLTV MCHAM2.IELVAL(1) = MLTV SEGDES MCHAM2 C C**** Liquid temperature C MCHEL1 = IALPF SEGINI, MCHEL2 = MCHEL1 ITLF = MCHEL2 MCHEL2.TITCHE = 'TL ' C C**** MCHAM1 = MCHAML de la alpha C SEGINI, MCHAM2 = MCHAM1 MCHEL2.ICHAML(1) = MCHAM2 SEGDES MCHEL2 SEGINI MLTL MCHAM2.IELVAL(1) = MLTL SEGDES MCHAM2 C C**** Vapour density C MCHEL1 = IALPF SEGINI, MCHEL2 = MCHEL1 IRVF = MCHEL2 MCHEL2.TITCHE = 'RV ' C C**** MCHAM1 = MCHAML de la alpha C SEGINI, MCHAM2 = MCHAM1 MCHEL2.ICHAML(1) = MCHAM2 SEGDES MCHEL2 SEGINI MLRV MCHAM2.IELVAL(1) = MLRV SEGDES MCHAM2 C C**** Liquid density C MCHEL1 = IALPF SEGINI, MCHEL2 = MCHEL1 IRLF = MCHEL2 MCHEL2.TITCHE = 'RL ' C C**** MCHAM1 = MCHAML de la alpha C SEGINI, MCHAM2 = MCHAM1 MCHEL2.ICHAML(1) = MCHAM2 SEGDES MCHEL2 SEGINI MLRL MCHAM2.IELVAL(1) = MLRL SEGDES MCHAM2 C C**** Recapitulatif: les MELVALs et les MPOVALs actives C C MLVNX, MLVNY, MLVNZ C MLVTX, MLVTY, MLVTZ C MLVVX, MLVVY, MLVVZ C C MLLNX, MLLNY, MLLNZ C MLLTX, MLLTY, MLLTZ C MLLVX, MLLVY, MLLVZ C C MLUVN, MLUVT, MLUVV -> vapour velocities C C MLULN, MLULT, MLULV -> liquid velocities C C MLALP -> void fraction C C MLP -> pressure C C MLTV -> vapour temperature C C MLTL -> liquid temperature C C MLRV -> vapour density C C MLRL -> liquid density C**** C MPALP -> void fraction C C MPUVC -> vapour velocity C C MPULC -> liquid velocity C C MPPC -> pressure C C MPTVC -> vapour temperature C C MPTLC -> liquid temperature C C MPRVC -> vapour density C C MPRLC -> liquid density C C MPNORM -> normales aux faces C C**** Boucle sur le faces C 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 LOGAN = .TRUE. MESERR(1:40) = 'PRET, subroutine pre111.eso ' GOTO 9999 ENDIF C C******* Cosinus directeurs des NORMALES aux faces C C On impose que les normales sont direct "Gauche" -> "Centre" C XG = XCOOR((NGCEG-1)*(IDIM+1)+1) YG = XCOOR((NGCEG-1)*(IDIM+1)+2) ZG = XCOOR((NGCEG-1)*(IDIM+1)+3) XC = XCOOR((NGCF-1)*(IDIM+1)+1) YC = XCOOR((NGCF-1)*(IDIM+1)+2) ZC = XCOOR((NGCF-1)*(IDIM+1)+3) DXG = XC - XG DYG = YC - YG DZG = ZC - ZG C C******* On calcule le sign du pruduit scalare C (Normales de Castem) * (vecteur "gauche" -> "centre") C CNX = MPNORM.VPOCHA(NLCF,7) CNY = MPNORM.VPOCHA(NLCF,8) CNZ = MPNORM.VPOCHA(NLCF,9) LOGAN = .TRUE. MESERR(1:30)= & 'PRET , subroutine pre121.eso. ' GOTO 9999 ENDIF C C********** Cosinus directeurs de tangente 1 C C C********** Cosinus directeurs de tangente 2 C C C C C******* Les autres MELVALs C C C******* N.B.: On suppose qu'on a déjà controlle RO, P > 0 C GAMMA \in (1,3) C Si non il faut le faire, en utlisant LOGBOR, C LOGNEG, VALER, VAL1, VAL2 C C C C******* NGCEG = NGCED -> Mur C IF( NGCEG .EQ. NGCED)THEN AG = MPALP.VPOCHA(NLCEG, 1) PG = MPPC.VPOCHA(NLCEG, 1) TVG = MPTVC.VPOCHA(NLCEG, 1) TLG = MPTLC.VPOCHA(NLCEG, 1) RVG = MPRVC.VPOCHA(NLCEG, 1) RLG = MPRLC.VPOCHA(NLCEG, 1) UVXG = MPUVC.VPOCHA(NLCEG, 1) UVYG = MPUVC.VPOCHA(NLCEG, 2) UVZG = MPUVC.VPOCHA(NLCEG, 3) ULXG = MPULC.VPOCHA(NLCEG, 1) ULYG = MPULC.VPOCHA(NLCEG, 2) ULZG = MPULC.VPOCHA(NLCEG, 3) UVNG = UVXG * CNX + UVYG * CNY + UVZG * CNZ UVTG = UVXG * CTX + UVYG * CTY + UVZG * CTZ UVVG = UVXG * CVX + UVYG * CVY + UVZG * CVZ ULNG = ULXG * CNX + ULYG * CNY + ULZG * CNZ ULTG = ULXG * CTX + ULYG * CTY + ULZG * CTZ ULVG = ULXG * CVX + ULYG * CVY + ULZG * CVZ C C********** Son etat droite C AD = AG PD = PG TVD = TVG TLD = TLG RVD = RVG RLD = RLG UVND = -1.0D0 * UVNG UVTD = UVTG UVVD = UVVG ULND = -1.0D0 * ULNG ULTD = ULTG ULVD = ULVG C C************* Fin cas mur C ELSE C C************* Etat gauche C AG = MPALP.VPOCHA(NLCEG, 1) PG = MPPC.VPOCHA(NLCEG, 1) TVG = MPTVC.VPOCHA(NLCEG, 1) TLG = MPTLC.VPOCHA(NLCEG, 1) RVG = MPRVC.VPOCHA(NLCEG, 1) RLG = MPRLC.VPOCHA(NLCEG, 1) UVXG = MPUVC.VPOCHA(NLCEG, 1) UVYG = MPUVC.VPOCHA(NLCEG, 2) UVZG = MPUVC.VPOCHA(NLCEG, 3) ULXG = MPULC.VPOCHA(NLCEG, 1) ULYG = MPULC.VPOCHA(NLCEG, 2) ULZG = MPULC.VPOCHA(NLCEG, 3) UVNG = UVXG * CNX + UVYG * CNY + UVZG * CNZ UVTG = UVXG * CTX + UVYG * CTY + UVZG * CTZ UVVG = UVXG * CVX + UVYG * CVY + UVZG * CVZ ULNG = ULXG * CNX + ULYG * CNY + ULZG * CNZ ULTG = ULXG * CTX + ULYG * CTY + ULZG * CTZ ULVG = ULXG * CVX + ULYG * CVY + ULZG * CVZ C C********** Etat gauche C AD = MPALP.VPOCHA(NLCED, 1) PD = MPPC.VPOCHA(NLCED, 1) TVD = MPTVC.VPOCHA(NLCED, 1) TLD = MPTLC.VPOCHA(NLCED, 1) RVD = MPRVC.VPOCHA(NLCED, 1) RLD = MPRLC.VPOCHA(NLCED, 1) UVXD = MPUVC.VPOCHA(NLCED, 1) UVYD = MPUVC.VPOCHA(NLCED, 2) UVZD = MPUVC.VPOCHA(NLCED, 3) ULXD = MPULC.VPOCHA(NLCED, 1) ULYD = MPULC.VPOCHA(NLCED, 2) ULZD = MPULC.VPOCHA(NLCED, 3) UVND = UVXD * CNX + UVYD * CNY + UVZD * CNZ UVTD = UVXD * CTX + UVYD * CTY + UVZD * CTZ UVVD = UVXD * CVX + UVYD * CVY + UVZD * CVZ ULND = ULXD * CNX + ULYD * CNY + ULZD * CNZ ULTD = ULXD * CTX + ULYD * CTY + ULZD * CTZ ULVD = ULXD * CVX + ULYD * CVY + ULZD * CVZ ENDIF C C************* Les MELVALs C MLALP.VELCHE(1,NLCF) = AG MLALP.VELCHE(3,NLCF) = AD MLP.VELCHE(1,NLCF) = PG MLP.VELCHE(3,NLCF) = PD MLTV.VELCHE(1,NLCF) = TVG MLTV.VELCHE(3,NLCF) = TVD MLTL.VELCHE(1,NLCF) = TLG MLTL.VELCHE(3,NLCF) = TLD MLRV.VELCHE(1,NLCF) = RVG MLRV.VELCHE(3,NLCF) = RVD MLRL.VELCHE(1,NLCF) = RLG MLRL.VELCHE(3,NLCF) = RLD MLUVN.VELCHE(1,NLCF) = UVNG MLUVN.VELCHE(3,NLCF) = UVND MLUVT.VELCHE(1,NLCF) = UVTG MLUVT.VELCHE(3,NLCF) = UVTD MLUVV.VELCHE(1,NLCF) = UVVG MLUVV.VELCHE(3,NLCF) = UVVD MLULN.VELCHE(1,NLCF) = ULNG MLULN.VELCHE(3,NLCF) = ULND MLULT.VELCHE(1,NLCF) = ULTG MLULT.VELCHE(3,NLCF) = ULTD MLULV.VELCHE(1,NLCF) = ULVG MLULV.VELCHE(3,NLCF) = ULVD MLVNX.VELCHE(1,NLCF) = CNX MLVNY.VELCHE(1,NLCF) = CNY MLVNZ.VELCHE(1,NLCF) = CNZ MLVT1X.VELCHE(1,NLCF) = CTX MLVT1Y.VELCHE(1,NLCF) = CTY MLVT1Z.VELCHE(1,NLCF) = CTZ MLVT2X.VELCHE(1,NLCF) = CVX MLVT2Y.VELCHE(1,NLCF) = CVY MLVT2Z.VELCHE(1,NLCF) = CVZ MLLNX.VELCHE(1,NLCF) = CNX MLLNY.VELCHE(1,NLCF) = CNY MLLNZ.VELCHE(1,NLCF) = CNZ MLLT1X.VELCHE(1,NLCF) = CTX MLLT1Y.VELCHE(1,NLCF) = CTY MLLT1Z.VELCHE(1,NLCF) = CTZ MLVT2X.VELCHE(1,NLCF) = CVX MLVT2Y.VELCHE(1,NLCF) = CVY MLVT2Z.VELCHE(1,NLCF) = CVZ ENDDO C C**** Desactivation des SEGMENTs C SEGDES IPT1 SEGDES IPT2 C SEGDES MPALP SEGDES MPUVC SEGDES MPULC SEGDES MPPC SEGDES MPTVC SEGDES MPTLC SEGDES MPRVC SEGDES MPRLC SEGDES MPNORM SEGDES MLALP SEGDES MLP SEGDES MLTV SEGDES MLTL SEGDES MLRV SEGDES MLRL SEGDES MLUVN SEGDES MLUVT SEGDES MLUVV SEGDES MLULN SEGDES MLULT SEGDES MLULV SEGDES MLVNX SEGDES MLVNY SEGDES MLVNZ SEGDES MLVT1X SEGDES MLVT1Y SEGDES MLVT1Z SEGDES MLVT2X SEGDES MLVT2Y SEGDES MLVT2Z SEGDES MLLNX SEGDES MLLNY SEGDES MLLNZ SEGDES MLLT1X SEGDES MLLT1Y SEGDES MLLT1Z SEGDES MLLT2X SEGDES MLLT2Y SEGDES MLLT2Z C C**** Destruction du MELNTI correspondance local/global C SEGSUP MLENT1 C 9999 CONTINUE C RETURN END
© Cast3M 2003 - Tous droits réservés.
Mentions légales