Esope source files

   1 : C GRADI2    SOURCE    CHAT      05/01/13    00:20:35     5004           
   2 :       SUBROUTINE GRADI2(ICEN,ISOMM,IFACL0,IFACEP,ISGLI1,ISGLI2,
   3 :      &     INORM,ICHELM)
   4 : C************************************************************************
   5 : C     
   6 : C PROJET            :  CASTEM 2000
   7 : C     
   8 : C NOM               :  GRADI2
   9 : C     
  10 : C DESCRIPTION       :  Appelle par PENDI2
  11 : C     
  12 : C LANGAGE           :  FORTRAN 77 + ESOPE 2000 (avec extensions CISI)
  13 : C     
  14 : C AUTEUR            :  A. BECCANTINI
  15 : C     
  16 : C************************************************************************
  17 : C     
  18 : C Inputs:
  19 : C
  20 : C ICEN   : MELEME CENTRE
  21 : C
  22 : C ISOMM  : MELEME SOMMET
  23 : C
  24 : C IFACL0 : MELEME FACEL (centre G + F + CENTRE D)
  25 : C
  26 : C IFACEP : MELEME FACEP (SOMMET belonging to a face + F)
  27 : C
  28 : C ISGLI1 : SPG of Dirichlet BC
  29 : C
  30 : C ISGLI2 : SPG of von Neumann BC
  31 : C
  32 : C INORM  : interfaces normales
  33 : C
  34 : C Output :
  35 : C
  36 : C ICHELM : MCHAML which contains coeff. to compute gradients
  37 : C
  38 : C
  39 : C
  40 : C**** Variables de COOPTIO
  41 : C
  42 : C      INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR
  43 : C     &        ,IOTER,   IOLEC,  IOIMP,     IOCAR,  IOACQ
  44 : C     &        ,IOPER,   IOSGB,  IOGRA,     IOSAU,  IORES
  45 : C     &        ,IECHO,   IIMPI,  IOSPI
  46 : C     &        ,IDIM
  47 : C     &        ,MCOORD      
  48 : C     &        ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE
  49 : C     &        ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU
  50 : C     &        ,NORINC,NORVAL,NORIND,NORVAD
  51 : C     &        ,NUCROU, IPSAUV, IFICLE, IPREFI
  52 : C
  53 :       IMPLICIT INTEGER(I-N)
  54 : -INC CCOPTIO
  55 : -INC SMLENTI
  56 : -INC SMELEME
  57 : C
  58 :       POINTEUR MLEPOI.MLENTI, MLECOE.MLENTI, MLECOF.MLENTI
  59 :      &     ,MLEPOF.MLENTI 
  60 : C
  61 :       INTEGER ICEN,ISOMM,IFACL0,IFACEP,IFACE,IFACEL
  62 :      &       ,ICHELM,ISGLI1,ISGLI2,INORM
  63 : C     &       ,I1,I2,IELEM,JG,NBE,NBN,NBSOUS,NGF,NGF1 
  64 : C
  65 : C
  66 : C**** FACE, FACEL, FACEP must have the same order, i.e. 
  67 : C     the i-th point of FACE belongs also to the i-th element of 
  68 : C     FACEP and to the i-th element of FACEL 
  69 : C
  69 :       CALL RLEORD(IFACL0,IFACEP,IFACE,IFACEL)
  70 :       IF(IERR .NE. 0)GOTO 9999
  71 : C
  72 : C**** test RLEORD
  73 : C
  74 : C      MELEME= IFACEP
  75 : C      IPT1 = IFACEL
  76 : C      SEGACT MELEME
  77 : C      SEGACT IPT1
  78 : C      NBSOUS=MELEME.LISOUS(/1)
  79 : C      JG=MAX(1,NBSOUS)
  80 : C      SEGINI MLENTI
  81 : C      IF(NBSOUS.EQ.0)THEN
  82 : C         MLENTI.LECT(1)=IFACEP
  83 : C      ELSE
  84 : C         DO I1 = 1, NBSOUS, 1
  85 : C            MLENTI.LECT(I1)=MELEME.LISOUS(I1)
  86 : C         ENDDO
  87 : C      ENDIF
  88 : C      NBSOUS=JG
  89 : C      IELEM=0
  90 : C      DO I1 = 1, NBSOUS, 1
  91 : C         IPT2=MLENTI.LECT(I1)
  92 : C         SEGACT IPT2
  93 : C         NBN=IPT2.NUM(/1)
  94 : C         NBE=IPT2.NUM(/2)
  95 : C         DO I2 = 1, NBE, 1
  96 : C            IELEM=IELEM+1
  97 : C            NGF=IPT2.NUM(NBN,I2)
  98 : C            NGF1=IPT1.NUM(2,IELEM)
  99 : C            write(ioimp,*) ngf, ngf1
 100 : C         ENDDO
 101 : C      ENDDO
 102 : C
 103 : C**** Fin test
 104 : C
 105 : C
 106 : C**** N.B: IFACEL has the same order of face as IFACEP. At the end 
 107 : C     we have to destroy IFACEL
 108 : C
 109 : C**** The neighbors of each points 'SOMMET'
 110 : C     Two cases:
 111 : C     - If the 'sommet' point is on the border, the 'FACE'
 112 : C       and the 'CENTRE' points are both neighbors
 113 : C     - If the 'sommet' point does not belongs to the border, the 
 114 : C       'CENTRE' points are both neighbors
 115 : C
 115 :       CALL RLENSO(IFACEL,IFACEP,ISOMM,MLEPOI)
 116 :       IF(IERR.NE.0) GOTO 9999
 117 : C
 118 : C     RLENSO creates MLEPOI
 119 : C     MLEPOI : list of integers.
 120 : C     MLEPOI.LECT(I) is the pointer of the list of integers 
 121 : C     MLENTI which contains the neighbors of the i-th sommet
 122 : C     point.
 123 : C
 123 :       CALL RLENCO(ISOMM,ICEN,ISGLI1,ISGLI2,INORM,MLEPOI,MLECOE)
 124 :       IF(IERR.NE.0) GOTO 9999
 125 : C
 126 : C     RLENCO creates MRECOE
 127 : C     MLECOE : list of integers.
 128 : C     MLECOE.LECT(I) is the pointer of the list of real
 129 : C     MLREEL which contains the coefficient of the i-th sommet
 130 : C     to compute its value as function of the values on
 131 : C     its neighbors. 
 132 : C     Note that ISGLI1 is the support of the Dirichlet boundary
 133 : C     conditions; ISGLI2 is the support of the von Neumann boundary
 134 : C     conditions. Their intersection is 0 and their union is
 135 : C     the total boundary. This is checked in the subroutine
 136 : C     RLENCO
 137 : C
 137 :       CALL RLENCF(IFACEL,IFACEP,MLEPOF,MLECOF)
 138 :       IF(IERR.NE.0) GOTO 9999
 139 : C
 140 : C     RLENCF creates MLEPOF,MLECOF
 141 : C
 142 : C     MLEPOF : list of integers.
 143 : C     MLEPOF.LECT(I) is the pointer of the list of the neighbors 
 144 : C     of the I-th FACE. Neighbors are 'CENTRE' points and 
 145 : C     'VERTEX' points.
 146 : C
 147 : C     MLECOF : list of integers.
 148 : C     MLECOF.LECT(I) is the pointer of the matrix of real
 149 : C     which contains the coefficient of the i-th face
 150 : C     to compute its gradient as function of the values on
 151 : C     its neighbors. 
 152 : C
 152 :       CALL RLENCT(IFACEL,ISOMM,MLEPOI,MLECOE,MLEPOF,MLECOF)
 153 :       IF(IERR.NE.0) GOTO 9999
 154 : C
 155 : C     RLENCT adjusts MLEPOF,MLECOF such that
 156 : C
 157 : C     MLEPOF : list of integers.
 158 : C     MLEPOF.LECT(I) is the pointer of the list of the neighbors 
 159 : C     of the I-th FACE. Neighbors are just 'CENTRE' points and 
 160 : C     'boundary conditions' points.
 161 : C
 162 : C     MLECOF : list of integers.
 163 : C     MLECOF.LECT(I) is the pointer of the matrix of real
 164 : C     which contains the coefficient of the i-th face
 165 : C     to compute its gradient as function of the values on
 166 : C     its neighbors. 
 167 : C
 168 : C     N.B.: segments MLEPOI,MLECOE are destroyed into RLENCT
 169 : C
 170 : C
 171 : C**** Creation de MCHAML 
 172 : C     MLECOE, MLEPOF -> MCHAML
 173 : C
 173 :       CALL RLEXC1(MLEPOF,MLECOF,ICHELM)
 174 :       IF(IERR.NE.0)GOTO 9999
 175 : C
 176 : C**** On detrui le IFACEL et IFAC ici crée
 177 : C
 178 :       MELEME=IFACEL
 179 :       SEGSUP MELEME
 180 :       MELEME=IFACE
 181 :       SEGSUP MELEME
 182 : C     
 183 :  9999 CONTINUE
 184 :       RETURN
 185 :       END
 186 : 
 187 : 
 188 : 
 189 : 
 190 : 
 191 :  
 192 :  
 193 :  
 194 :