Télécharger norv1.eso

Retour à la liste

norv1
C NORV1     SOURCE    FANDEUR   22/01/03    21:15:33     11136          
 
      SUBROUTINE NORV1(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**** Variables de COOPTIO
C
C      INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR
C     &        ,IOTER,   IOLEC,  IOIMP,     IOCAR,  IOACQ
C     &        ,IOPER,   IOSGB,  IOGRA,     IOSAU,  IORES
C     &        ,IECHO,   IIMPI,  IOSPI
C     &        ,IDIM
C     &        ,MCOORD
C     &        ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE
C     &        ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU
C     &        ,NORINC,NORVAL,NORIND,NORVAD
C     &        ,NUCROU, IPSAUV
 
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)
C      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)
C      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)
C      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
C         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
C         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
C         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
C      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
C         SEGDES MSOUPO
 
c ASSEMBLAGES DES MATRICES LOCALES POUR CHAQUE NOEUD
       CALL NORV2(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 NORV4(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
C         SEGDES MSOUPO
 
         CALL NORV5(NFAC,MPOGRA,ICOEFF,MELVA1,MELEFL,MLECEN,
     &              MLEFA,MPOCHP,
     &              MLENCL,MPOVCL,MLENNE,MPOVNE,MLENMI,MPOVMI,
     &              LOGBOR,LOGCCL,LOGCOE)
         ENDIF
C         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
C      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
C         SEGDES MSOUPO
 
c ASSEMBLAGES DES MATRICES LOCALES POUR CHAQUE NOEUD
       CALL NOR2D3(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 NOR4D3(
     &            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
C         SEGDES MSOUPO
         CALL NORV5(NFAC,MPOGRA,ICOEFF,MELVA1,MELEFL,MLECEN,MLEFA,
     &              MPOCHP,MLENCL,MPOVCL,MLENNE,MPOVNE,MLENMI,
     &              MPOVMI,LOGBOR,LOGCCL,LOGCOE)
 
        ENDIF
C         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
      END
 
 
 
 
 
 

© Cast3M 2003 - Tous droits réservés.
Mentions légales