Esope source files

   1 : C RLXCE1    SOURCE    PV        09/03/12    21:33:55     6325           
   2 :       SUBROUTINE RLXCE1(MELEME,MLECOE,MCHELM)
   3 : C************************************************************************
   4 : C     
   5 : C PROJET            :  CASTEM 2000
   6 : C     
   7 : C NOM               :  RLXCE1 
   8 : C     
   9 : C DESCRIPTION       :  Appelle par GRADGE
  10 : C     
  11 : C LANGAGE           :  FORTRAN 77 + ESOPE 2000 (avec extensions CISI)
  12 : C     
  13 : C AUTEUR            :  A. BECCANTINI
  14 : C     
  15 : C************************************************************************
  16 : C     
  17 : C Input
  18 : C
  19 : C MELEME : SPG of MCHELM (CNETRE + neighbors)
  20 : C
  21 : C MLECOE : pointers of the list of coeff
  22 : C
  23 : C Output
  24 : C
  25 : C MCHELM : MCHAML which contains the coeff. to compute gradients
  26 : C
  27 : C     
  28 : C     
  29 : C**** Variables de COOPTIO
  30 : C
  31 :       IMPLICIT INTEGER(I-N)
  32 :       INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR
  33 :      &        ,IOTER,   IOLEC,  IOIMP,     IOCAR,  IOACQ
  34 :      &        ,IOPER,   IOSGB,  IOGRA,     IOSAU,  IORES
  35 :      &        ,IECHO,   IIMPI,  IOSPI
  36 :      &        ,IDIM
  37 :      &        ,MCOORD
  38 :      &        ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE
  39 :      &        ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU
  40 :      &        ,NORINC,NORVAL,NORIND,NORVAD
  41 :      &        ,NUCROU, IPSAUV, IPREFI, IFICLE, ISAFOR, IREFOR
  42 : C
  43 :       INTEGER NSOU, JG, N3, L1, NBNN, NBELEM, ICEN, ISOUS
  44 :      &     , N1PTEL, N1EL, N2PTEL, N2EL, IELEM, IVOI
  45 : C
  46 :       INTEGER N1,N2
  47 :       SEGMENT MATRIX
  48 :       REAL*8 MAT(N1,N2)
  49 :       ENDSEGMENT
  50 : C
  51 : -INC CCOPTIO
  52 : -INC SMCHAML
  53 : -INC SMLENTI
  54 : -INC SMELEME
  55 :       POINTEUR MLESOU.MLENTI, MLECOE.MLENTI
  56 : C
  57 : C**** We recover the elemenary mesh of MELEME
  58 : C     
  59 :       SEGACT MELEME
  60 :       SEGACT MLECOE
  61 :       NSOU=MAX(MELEME.LISOUS(/1),1)
  62 :       JG=NSOU
  63 :       SEGINI MLESOU
  64 :       IF (NSOU.EQ.1)THEN
  65 :          MLESOU.LECT(1)=MELEME
  66 :       ELSE
  67 :          DO ISOUS=1,NSOU,1
  68 :             IPT1=MELEME.LISOUS(ISOUS)
  69 :             MLESOU.LECT(ISOUS)=IPT1
  70 :          ENDDO
  71 :       ENDIF
  72 : C
  73 : C**** Initialisation du MCHELM
  74 : C
  75 :       N1=NSOU
  76 :       N2=IDIM
  77 :       N3=6
  78 :       L1=8
  79 :       SEGINI MCHELM
  80 :       MCHELM.TITCHE='Gradient'
  81 :       MCHELM.IFOCHE=IFOUR
  82 : C
  83 :       ICEN=0
  84 :       DO ISOUS = 1, NSOU, 1
  85 :          IPT1=MLESOU.LECT(ISOUS)
  86 :          MCHELM.IMACHE(ISOUS)=IPT1
  87 :          SEGINI MCHAML
  88 :          MCHELM.ICHAML(ISOUS)=MCHAML
  89 :          MCHAML.NOMCHE(1)='alphax  '
  90 :          MCHAML.NOMCHE(2)='alphay  '
  91 :          MCHAML.TYPCHE(1)='REAL*8          '
  92 :          MCHAML.TYPCHE(2)='REAL*8          '
  93 :          SEGACT IPT1
  94 :          NBNN=IPT1.NUM(/1)
  95 :          NBELEM=IPT1.NUM(/2)
  96 :          SEGDES IPT1
  97 :          N1PTEL=NBNN
  98 :          N1EL=NBELEM
  99 :          N2PTEL=0
 100 :          N2EL=0
 101 :          SEGINI MELVA1
 102 :          SEGINI MELVA2
 103 :          MCHAML.IELVAL(1)=MELVA1
 104 :          MCHAML.IELVAL(2)=MELVA2
 105 :          IF(IDIM.EQ.3)THEN
 106 :             MCHAML.NOMCHE(3)='alphaz  '
 107 :             MCHAML.TYPCHE(3)='REAL*8          '
 108 :             SEGINI MELVA3
 109 :             MCHAML.IELVAL(3)=MELVA3
 110 :          ENDIF
 111 :          DO IELEM=1,NBELEM,1
 112 :             ICEN=ICEN+1
 113 :             MATRIX=MLECOE.LECT(ICEN)
 114 :             SEGACT MATRIX
 115 :             DO IVOI=1,NBNN,1
 116 :                MELVA1.VELCHE(IVOI,IELEM)=MATRIX.MAT(2,IVOI)
 117 :                MELVA2.VELCHE(IVOI,IELEM)=MATRIX.MAT(3,IVOI)
 118 :                IF(IDIM.EQ.3) MELVA3.VELCHE(IVOI,IELEM)=
 119 :      $              MATRIX.MAT(4,IVOI)
 120 :             ENDDO
 121 :             SEGSUP MATRIX
 122 :          ENDDO
 123 :          SEGDES MCHAML
 124 :          SEGDES MELEME
 125 :          SEGDES MELVA1
 126 :          SEGDES MELVA2
 127 :          IF(IDIM.EQ.3) SEGDES MELVA3
 128 :       ENDDO
 129 : C
 130 :       SEGDES MCHELM
 131 : C
 132 :       SEGSUP MLECOE
 133 :       SEGSUP MLESOU
 134 :       IF(NSOU .GT. 1) SEGSUP MELEME
 135 : C
 136 :       RETURN
 137 :       END
 138 :                
 139 :             
 140 :             
 141 :          
 142 : C                                          
 143 :  
 144 :  
 145 :  
 146 :  
 147 :  
 148 :