C VFSYM1 SOURCE OF166741 24/12/13 21:17:35 12097 SUBROUTINE VFSYM1(IOP1,ICEN,ISOMM,IFAC,IFACEL,IFACEP,IELTFA, & IMAIL,INORM,ISURF,ICHPO,ICHTE,ICHCL,ICHNE,ICHMI, & ICHCO,IOP,ICHGRA,MPOGRA,ICOEFF,LOGBOR,LOGCOE,LOGCCL) C C************************************************************************ C C PROJET : CASTEM 2000 C C NOM : NORV1 C C DESCRIPTION : Appelle par NORV C C LANGAGE : FORTRAN 77 + ESOPE 2000 (avec extensions CISI) C C AUTEUR : C. LE POTIER, DM2S/SFME/MTMS C C************************************************************************ C IMPLICIT INTEGER(I-N) IMPLICIT real*8 (a-h,o-z) -INC SMLENTI -INC SMELEME -INC SMCHPOI -INC PPARAM -INC CCOPTIO -INC SMCOORD -INC SMLREEL POINTEUR MELEFL.MELEME, MELEFP.MELEME, MELEFA.MELEME, & MELTFA.MELEME POINTEUR MPOSUR.MPOVAL, MPONOR.MPOVAL, & MPOCHP.MPOVAL, MPOVCL.MPOVAL, MPGSOM.MPOVAL, MPVOSO.MPOVAL, & MPOGRA.MPOVAL,MPOTEN.MPOVAL,MPOVNE.MPOVAL,MPOVMI.MPOVAL, & MPOVCO.MPOVAL POINTEUR MLENCL.MLENTI, MLECEN.MLENTI, MLESOM.MLENTI, & MLEFA.MLENTI,MLENNE.MLENTI,MLENMI.MLENTI, & MLEFA2.MLENTI,MLENCO.MLENTI -INC SMCHAML INTEGER NBNN,NBREF,NBMAX C**** Variable de SMLENTI, SMCHPOI C INTEGER JG, N, NC, NSOUPO, NAT, NBSOUS, NBNO,NBELEM C C**** Les includes C INTEGER I1,ICOMP,ICOMGR,IGEOM & ,IOP1,ICEN,ISOMM,IFAC,IFACEL,IFACEP,INORM & ,ISURF,IMAIL,ICHPO,ICHCL,ICHNE,ICHGRA,ICOEFF & ,NTOT,NSOMM,NCOMP,NFAC,NCEN & ,NLCF,NGCF,NGCF1,NGCF2,NGCG,NGCD,NLCG,NLCD,NGS1,NGS2 & ,NLS1,NLS2,NLFCL & ,ISOUS,IELEM,INOEUD,ICELL INTEGER ICEN2 REAL*8 SCNX,SCNY,SCNZ,SURF,VOL,VAL,VALX,VALY,XG,XD,XF,XS1,XS2 & ,YG,YD,YF,YS1,YS2,PSCA,XNORM,VECX,VECY,PSCAGX,PSCAGY, & PSCADX,PSCADY,K11G,K22G,K21G,K11D,K22D,K21D,VXG1,VXG2, & VXAU,VYAU,VXD1,VXD2,VYG1,VYG2,TRG1,TRG2, & TRD1,TRD2,TRG,TRD REAL*8 XLONG,AG1,AG2,AD1,AD2,PSCAG1,PSCAG2,PSCAD1,PSCAD2, & COEF1,COEF2,COEF3,COEF4,SCN1X,SCN1Y,SCN1Z,VX,VY,COEF1X,COEF2X, & COEF1Y,COEF2Y,CX,CY,ANCX,ANCY,DIFFX,DIFFY,XLONGG,XLONGD & VALD,VALG,COEF,GX,GY,XMINK11,XMAXK11,XMINK22,XMAXK22 & QIMPX,QIMPY,QIMPZ REAL*8 VECXG1(2),VECYG1(2) REAL*8 VECXG2(2),VECYG2(2) REAL*8 VECXD1(2),VECYD1(2) REAL*8 VECXD2(2),VECYD2(2) REAL*8 EPS INTEGER ICRIT CHARACTER*(4) NOMCOM(18),NOMCOM3(9) CHARACTER*8 TYPE INTEGER LOGBOR,LOGCOE,LOGCCL C DATA NOMCOM /'P1DX','P1DY', & 'P2DX','P2DY', & 'P3DX','P3DY', & 'P4DX','P4DY', & 'P5DX','P5DY', & 'P6DX','P6DY', & 'P7DX','P7DY', & 'P8DX','P8DY', & 'P9DX','P9DY'/ DATA NOMCOM3 /'P1DX','P1DY','P1DZ', & 'P2DX','P2DY','P2DZ', & 'P3DX','P3DY','P3DZ'/ INTEGER NDIM SEGMENT MMAT1 REAL*8 PM(NDIM,NDIM),PM1(NDIM,NDIM),XSOL(NDIM) INTEGER IC(NDIM) ENDSEGMENT INTEGER K1,K2 SEGMENT INDICE INTEGER NUME(K1,K2) ENDSEGMENT POINTEUR IND.INDICE,IND2.INDICE,IND22.INDICE SEGMENT MATRICE REAL*8 MAT(K1,K2) ENDSEGMENT POINTEUR VAL1.MATRICE,VAL2.MATRICE,SCMB.MATRICE SEGMENT POINT2 INTEGER POINT(K3) ENDSEGMENT POINTEUR IPO2.POINT2 SEGMENT MATRICE2 REAL*8 MAT2(K1,K2) ENDSEGMENT SEGMENT POINT3 INTEGER POINT33(K3) ENDSEGMENT POINTEUR IPO3.POINT3 SEGMENT INDICE3 INTEGER NU(K1,K2) ENDSEGMENT POINTEUR INDIC.INDICE3 SEGMENT REP INTEGER ID(K3) ENDSEGMENT POINTEUR TAB.REP,INDLI.REP INTEGER K5 SEGMENT NBFAC INTEGER NBFACEL(K5) INTEGER IMELEM(K5) ENDSEGMENT INTEGER K6 SEGMENT NBCOT INTEGER NBCOTE(K6) INTEGER IMECOTE(K6) ENDSEGMENT C C C**** Nombre total de points (HP IDIM .EQ. 2) C c SEGACT MCOORD *MOD IOP1 = 3 NTOT = nbpts C C**** Le MELEME CENTRE (SPG du CHPOINT dont on veux calculer le gradient) C CALL KRIPAD(ICEN,MLECEN) C SEGMENT INTERVENANT POUR PRENDRE EN COMPTE PLUSIEURS SOUS DOMAINES MELEME = ICEN NCEN=MELEME.NUM(/2) SEGDES MELEME K5 = NCEN SEGINI NBFAC C C**** Le MELEME FACE (SPG du CHPOINT dont on veux calculer le gradient) C CALL KRIPAD(IFAC,MLEFA) MELEME = IFAC K6=MELEME.NUM(/2) SEGDES MELEME c SEGINI NBCOT C C C C**** Le MELEME SOMMET C CALL KRIPAD(ISOMM,MLESOM) C C**** En KRIPAD C SEGACT ISOMM C SEGINI MLESOM C MELEME = ISOMM NSOMM = MELEME.NUM(/2) SEGDES MELEME C C**** Le MPOVAL des SURFACES des FACES C CALL LICHT(ISURF,MPOSUR,TYPE,IGEOM) C C**** Le MPOVAL des NORMALES aux FACES C CALL LICHT(INORM,MPONOR,TYPE,IGEOM) C C**** Le MPOVAL du CHPOINT C CALL LICHT(ICHPO,MPOCHP,TYPE,IGEOM) C**** Le MPOVAL du CHPOINT DU TENSEURS DE DIFFUSIONS C IF (ICHTE.GT.0) THEN CALL LICHT(ICHTE,MPOTEN,TYPE,IGEOM) ENDIF C C**** En LICHT C SEGACT*MOD MPOCHP C NCOMP = MPOCHP.VPOCHA(/2) IF (ICHTE.GT.0) THEN c CALL ECCHPO(ICHTE) ENDIF C C**** Conditions limites (DIRICHLET) C IF (ICHCL .GT. 0) THEN TYPE=' ' CALL LICHT(ICHCL,MPOVCL,TYPE,IGEOM) C C******* En LICHT C SEGACT*MOD MPOVCL C CALL KRIPAD(IGEOM,MLENCL) C C******* En KRIPAD C SEGACT IGEOM, MLENCL C MELEME = IGEOM SEGDES MELEME ELSE JG = NTOT SEGINI MLENCL DO I1 = 1 , JG, 1 MLENCL.LECT(I1)=0 ENDDO MPOVCL = -1 ENDIF c CONDITIONS DE FLUX IF (ICHNE .GT. 0) THEN TYPE=' ' CALL LICHT(ICHNE,MPOVNE,TYPE,IGEOM) C C******* En LICHT C SEGACT*MOD MPOVNE C CALL KRIPAD(IGEOM,MLENNE) C C******* En KRIPAD C SEGACT IGEOM, MLENCL C MELEME = IGEOM SEGDES MELEME ELSE JG = NTOT SEGINI MLENNE DO I1 = 1 , JG, 1 MLENNE.LECT(I1)=0 ENDDO MPOVNE = -1 ENDIF c CONDITIONS MIXTES IF (ICHMI .GT. 0) THEN TYPE=' ' CALL LICHT(ICHMI,MPOVMI,TYPE,IGEOM) C C******* En LICHT C SEGACT*MOD MPOVNE C CALL KRIPAD(IGEOM,MLENMI) C C******* En KRIPAD C SEGACT IGEOM, MLENCL C MELEME = IGEOM SEGDES MELEME ELSE JG = NTOT SEGINI MLENMI DO I1 = 1 , JG, 1 MLENMI.LECT(I1)=0 ENDDO MPOVMI = -1 ENDIF C c OPTION FLUX CONVECTIFS IF (ICHCO .GT. 0) THEN TYPE=' ' CALL LICHT(ICHCO,MPOVCO,TYPE,IGEOM) C C******* En LICHT C SEGACT*MOD MPOVNE C CALL KRIPAD(IGEOM,MLENCO) C C******* En KRIPAD C SEGACT IGEOM, MLENCL C MELEME = IGEOM SEGDES MELEME ELSE JG = NTOT SEGINI MLENCO DO I1 = 1 , JG, 1 MLENCO.LECT(I1)=0 ENDDO MPOVCO = -1 ENDIF C C C**** Boucle sur le FACEL C MELEFL=IFACEL MELEFP=IFACEP MELEFA=IFAC MELTFA = IELTFA SEGACT MELEFL SEGACT MELEFP SEGACT MELEFA SEGACT MELTFA C FACEL = MAILLAGE NON PARTITIONE NFAC=MELEFL.NUM(/2) IF (IDIM.EQ.2) THEN c INITIALISATION DU CHAMPOINT POUR LE GRADIENT AUX FACES NAT=1 NSOUPO=1 SEGINI MCHPOI ICHGRA=MCHPOI MCHPOI.MOCHDE= &'Gradient VF ' MCHPOI.JATTRI=2 MCHPOI.IFOPOI=IFOUR NC=1 SEGINI MSOUPO MCHPOI.IPCHP(1)=MSOUPO SEGDES MCHPOI DO I1=1,NC,1 MSOUPO.NOCOMP(I1)='FLUX' ENDDO C C******* Gradient aux faces N=NFAC NC=1 C C C**** Division par les volumes C C CAS OU ON CALCULE LES COEFFICIENTS DE LA MATRICE C ON EST ICI IF ((LOGCOE.EQ.1).AND.(LOGCCL.EQ.1).AND.(LOGBOR.EQ.1)) THEN C PARAMETRES POUR LE GRADIENT AUX FACES SEGINI MPOGRA MSOUPO.IGEOC=IFAC MSOUPO.IPOVAL=MPOGRA SEGDES MSOUPO c ASSEMBLAGES DES MATRICES LOCALES POUR CHAQUE NOEUD CALL VFSYM2(MELEFA,MELEFL,MLECEN,MELEFP,MLESOM,MPONOR, & MPOSUR,MELTFA,MLEFA,MPOTEN,MPOCHP,MLENCL,MLENNE, & MLENMI,MPOVCL,MPOVNE,MPOVMI,ICHTE,ICHCL,ICHNE, & IPO2,SCMB,INDLI,TAB,VAL1,VAL2,IND22,IND2,IND, & NBFAC,NSOMM,NBMAX) c INVERSION DE CHAQUE MATRICE LOCALE CALL NORV3(NSOMM,NBMAX,IPO2,SCMB,INDLI, & VAL1,VAL2,IND22,IND2,IND,IPO3,VAUX,TAB) c RECONSTITUTION DU GRADIENT ET DES COEFFICIENTS PERMETTANT DE CALCULER CES c GRADIENTS CALL VFSYM4(MELEFA,MELEFL,MLECEN,MELEFP,MLESOM,MPONOR, & MPOSUR,MELTFA,MLEFA,MPOTEN,MPOCHP,MLENCL, & MPOVCL,ICHTE,ICHCL,ICHCO,MPOVCO,IOP, & IPO2,SCMB,INDLI,VAL1,VAL2,IND22,IND2,IND, & IPO3,VAUX,TAB,MELEME,MPOGRA,MELVA1,MELVA2, & NBNN,NBFAC,MCHELM,MCHAML) ICOEFF = MCHELM ELSE C ON CONNAIT LES COEFFICIENTS : ON EN DEDUIT LE GRADIENT SEGINI MPOGRA MSOUPO.IGEOC=IFAC MSOUPO.IPOVAL=MPOGRA SEGDES MSOUPO CALL NORV5(NFAC,MPOGRA,ICOEFF,MELVA1,MELEFL,MLECEN, & MLEFA,MPOCHP, & MLENCL,MPOVCL,MLENNE,MPOVNE,MLENMI,MPOVMI, & LOGBOR,LOGCCL,LOGCOE) ENDIF SEGDES MPOGRA C CAS 3 DIMENSIONS ELSE c INITIALISATION DU CHAMPOINT POUR LE GRADIENT AUX FACES NAT=1 NSOUPO=1 SEGINI MCHPOI ICHGRA=MCHPOI MCHPOI.MOCHDE= &'Gradient VF ' MCHPOI.JATTRI=2 MCHPOI.IFOPOI=IFOUR NC=1 SEGINI MSOUPO MCHPOI.IPCHP(1)=MSOUPO SEGDES MCHPOI DO I1=1,NC,1 MSOUPO.NOCOMP(I1)='FLUX' ENDDO C C******* Gradient aux faces N=NFAC NC=1 C C C**** Division par les volumes C C CAS OU ON CALCULE LES COEFFICIENTS DE LA MATRICE IF ((LOGCOE.EQ.1).AND.(LOGCCL.EQ.1).AND.(LOGBOR.EQ.1)) THEN C PARAMETRES POUR LE GRADIENT AUX FACES SEGINI MPOGRA MSOUPO.IGEOC=IFAC MSOUPO.IPOVAL=MPOGRA SEGDES MSOUPO c ASSEMBLAGES DES MATRICES LOCALES POUR CHAQUE NOEUD CALL SYM2D3(MELEFA,MELEFL,MLECEN,MELEFP,MLESOM,MPONOR, & MPOSUR,MELTFA,MLEFA,MLEFA2,MPOTEN,MPOCHP,MLENCL, & MLENNE, & MLENMI,MPOVCL,MPOVNE,MPOVMI,ICHTE,ICHCL,ICHNE, & IPO2,SCMB,INDLI,TAB,VAL1,VAL2,IND22,IND2,IND, & NBFAC,NBCOT,NSOMM,NBMAX) c INVERSION DE CHAQUE MATRICE LOCALE CALL NORV3(NSOMM,NBMAX,IPO2,SCMB,INDLI, & VAL1,VAL2,IND22,IND2,IND,IPO3,VAUX,TAB) c RECONSTITUTION DU GRADIENT ET DES COEFFICIENTS PERMETTANT DE CALCULER CES c GRADIENTS CALL SYM4D3( & MELEFA,MELEFL,MLECEN,MELEFP,MLESOM,MPONOR, & MPOSUR,MELTFA,MLEFA,MLEFA2,MPOTEN,MPOCHP,MLENCL, & MPOVCL,ICHTE,ICHCL,ICHCO,MPOVCO,IOP, & IPO2,SCMB,INDLI,VAL1,VAL2,IND22,IND2,IND, & IPO3,TAB,MPOGRA,MELVA1,MELVA2, & NSOMM,NBMAX,NBFAC,NBCOT,MCHELM,MCHAML) ICOEFF = MCHELM ELSE C ON CONNAIT LES COEFFICIENTS : ON EN DEDUIT LE GRADIENT SEGINI MPOGRA MSOUPO.IGEOC=IFAC MSOUPO.IPOVAL=MPOGRA SEGDES MSOUPO CALL NORV5(NFAC,MPOGRA,ICOEFF,MELVA1,MELEFL,MLECEN,MLEFA, & MPOCHP,MLENCL,MPOVCL,MLENNE,MPOVNE,MLENMI, & MPOVMI,LOGBOR,LOGCCL,LOGCOE) ENDIF SEGDES MPOGRA ENDIF SEGSUP MLECEN SEGDES MPOSUR SEGDES MPONOR SEGDES MPOCHP IF(MPOVCL .GT. 0)THEN SEGDES MPOVCL ENDIF IF(MPOVNE .GT. 0)THEN SEGDES MPOVNE ENDIF IF(MPOVMI .GT. 0)THEN SEGDES MPOVMI ENDIF IF(MPOVCO .GT. 0)THEN SEGDES MPOVCO ENDIF SEGSUP MLENCL SEGSUP MLENNE SEGSUP MLENMI SEGSUP MLENCO SEGSUP MLESOM SEGSUP NBFAC SEGDES MELEFL SEGDES MELEFP SEGDES MELEFA SEGDES MELTFA C 9999 CONTINUE RETURN END