Esope source files

   1 : C RLENCE    SOURCE    CHAT      05/01/13    03:01:10     5004           
   2 :       SUBROUTINE RLENCE(MELCEN,MELTFA,MELFAC,MFACEL,MELEME)
   3 : C     
   4 : C************************************************************************
   5 : C     
   6 : C PROJET            :  CASTEM 2000
   7 : C     
   8 : C NOM               :  RLENCE
   9 : C     
  10 : C DESCRIPTION       :  Cette subroutine est appellée par la subroutine
  11 : C                      GRADGE (calcul des coefficient pour le gradient
  12 : C                      d'un CHPOINT 'CENTRE')
  13 : C     
  14 : C LANGAGE           :  FORTRAN 77 + ESOPE 2000 (avec extensions CISI)
  15 : C     
  16 : C AUTEUR            :  A. Beccantini, SFME/LTMF
  17 : C     
  18 : C************************************************************************
  19 : C     
  20 : C     
  21 : C APPELES (Outils)  : 
  22 : C     
  23 : C APPELES (Calcul)  :
  24 : C     
  25 : C     
  26 : C************************************************************************
  27 : C     
  28 : C INPUT    :     ICEN   : 'CENTRE' points
  29 : C
  30 : C                IELTFA : Element-faces
  31 : C
  32 : C                IFAC   : 'FACE' points
  33 : C
  34 : C                IFACEL : Left center - face center -right center
  35 : C
  36 : C     
  37 : C OUTPUT   :     MELEME  : stencil to compute gradient
  38 : C     
  39 : C************************************************************************
  40 : C     
  41 : C HISTORIQUE (Anomalies et modifications éventuelles)
  42 : C     
  43 : C HISTORIQUE : 04.07.2003
  44 : C     
  45 : C************************************************************************
  46 : C     
  47 : C     
  48 : C     
  49 : C**** Variables de COOPTIO
  50 : C     
  51 :       IMPLICIT INTEGER(I-N)
  52 :       INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR
  53 :      &     ,IOTER,   IOLEC,  IOIMP,   IOCAR,  IOACQ
  54 :      &     ,IOPER,   IOSGB,  IOGRA,   IOSAU,  IORES
  55 :      &     ,IECHO,   IIMPI,  IOSPI
  56 :      &     ,IDIM
  57 :      &     ,MCOORD      
  58 :      &     ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE
  59 :      &     ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU
  60 :      &     ,NORINC,NORVAL,NORIND,NORVAD
  61 :      &     ,NUCROU, IPSAUV, IFICLE, IPREFI
  62 :      &     ,IREFOR, ISAFOR
  63 : C
  64 : C     
  65 :       INTEGER NBSOUS, NSOU, JG, NBNN, NBELEM, NBREF
  66 :      &     ,NGVOI,NLVOI,NCENG,NCEND, NCEN
  67 :      &     ,ISOUS, ICEN, IELEM, IVOI
  68 : C
  69 : -INC CCOPTIO
  70 : -INC SMLENTI
  71 : -INC SMELEME
  72 :       POINTEUR MELCEN.MELEME,MELTFA.MELEME,MELFAC.MELEME,MFACEL.MELEME
  73 :       POINTEUR MLELTF.MLENTI, MLEFAC.MLENTI
  74 : 
  75 : C
  76 :       SEGACT MELCEN
  77 :       SEGACT MELTFA
  78 :       SEGACT MFACEL
  79 : C
  79 :       CALL KRIPAD(MELFAC,MLEFAC)
  80 : C     SEGINI MLEFAC
  81 :       SEGACT MELFAC
  82 : C
  83 : C     MELEME has the same structure than 'ELTFA'
  84 : C     Each element of MELEME has one point more than each element of
  85 : C     'ELTFA'
  86 : C
  87 :       NBSOUS=MELTFA.LISOUS(/1)
  88 :       NSOU=MAX(NBSOUS,1)
  89 :       JG=NSOU
  90 :       SEGINI MLENTI
  91 :       SEGINI MLELTF
  92 : C
  93 : C**** MLENTI contains the pointers of the elementary meshes
  94 : C     of ELTFA
  95 : C
  96 :       IF (NSOU.EQ.1)THEN
  97 :          MLENTI.LECT(1)=MELTFA
  98 :       ELSE
  99 :          DO ISOUS=1,NSOU,1
 100 :             IPT1=MELTFA.LISOUS(ISOUS)
 101 :             MLENTI.LECT(ISOUS)=IPT1
 102 :          ENDDO
 103 :       ENDIF
 104 : C
 105 :       ICEN=0
 106 :       DO ISOUS=1,NSOU,1
 107 :          IPT1=MLENTI.LECT(ISOUS)
 108 :          SEGACT IPT1
 109 :          NBNN=IPT1.NUM(/1)+1
 110 :          NBELEM=IPT1.NUM(/2)
 111 :          NBREF=0
 112 :          NBSOUS=0
 113 :          SEGINI IPT2
 114 :          MLELTF.LECT(ISOUS)=IPT2
 115 : C        POLY elts
 116 :          IPT2.ITYPEL=32
 117 :          DO IELEM=1,NBELEM,1
 118 :             ICEN=ICEN+1
 119 :             NCEN=MELCEN.NUM(1,ICEN)
 120 :             IPT2.NUM(NBNN,IELEM)=NCEN
 121 :             DO IVOI=1,NBNN-1,1
 122 :                NGVOI=IPT1.NUM(IVOI,IELEM)
 123 :                NLVOI=MLEFAC.LECT(NGVOI)
 124 :                NCENG=MFACEL.NUM(1,NLVOI)
 125 :                NCEND=MFACEL.NUM(3,NLVOI)
 126 :                IF(NCENG .EQ. NCEND)THEN
 127 : C
 128 : C**************** We are on the BC
 129 : C
 130 :                   IF(NCEND .NE. NCEN)THEN
 131 :                      WRITE(IOIMP,*) 'subroutine rlence.eso. 1'
 131 :                      CALL ERREUR(5)
 132 :                      GOTO 9999
 133 :                   ENDIF
 134 :                   IPT2.NUM(IVOI,IELEM)=NGVOI
 135 :                ELSEIF(NCENG .EQ. NCEN)THEN
 136 :                   IPT2.NUM(IVOI,IELEM)=NCEND
 137 :                ELSEIF(NCEND .EQ. NCEN)THEN
 138 :                   IPT2.NUM(IVOI,IELEM)=NCENG
 139 :                ELSE
 140 :                   WRITE(IOIMP,*) 'subroutine rlence.eso. 2'
 140 :                   CALL ERREUR(5)
 141 :                   GOTO 9999
 142 :                ENDIF
 143 :             ENDDO
 144 :          ENDDO
 145 :          SEGDES IPT1
 146 :          SEGDES IPT2
 147 :       ENDDO
 148 : C
 149 :       SEGDES MELCEN
 150 :       SEGDES MELTFA
 151 :       SEGDES MELFAC
 152 :       SEGDES MFACEL
 153 :       SEGSUP MLENTI
 154 :       SEGSUP MLEFAC
 155 : C
 156 :       IF(NSOU .EQ. 1)THEN
 157 :          MELEME=MLELTF.LECT(1)
 158 :       ELSE
 159 :          NBNN=0
 160 :          NBELEM=0
 161 :          NBSOUS=NSOU
 162 :          NBREF=0
 163 :          SEGINI MELEME
 164 :          DO ISOUS=1,NSOU,1
 165 :             MELEME.LISOUS(ISOUS)=MLELTF.LECT(ISOUS)
 166 :          ENDDO
 167 :          SEGDES MELEME
 168 :       ENDIF
 169 : C
 170 :       SEGSUP MLELTF
 171 : C
 172 :  9999 RETURN
 173 :       END
 174 :  
 175 :