Esope source files

   1 : C PRE411    SOURCE    PV        09/03/12    21:31:08     6325           
   2 :       SUBROUTINE PRE411(ICEN,IFACE,IFACEL,MLMCOM,IROC,IROF,
   3 :      &                  LOGAN,MESERR)
   4 : C************************************************************************
   5 : C
   6 : C PROJET            :  CASTEM 2000
   7 : C
   8 : C NOM               :  PRE411
   9 : C
  10 : C DESCRIPTION       :  Voir PRE41
  11 : C
  12 : C                      Cas 2D/3D
  13 : C                      1er ordre en espace, 1re ordre en temps
  14 : C                      
  15 : C                      Creations des objets MCHAML IROF
  16 : C     
  17 : C LANGAGE           :  FORTRAN 77 + ESOPE 2000 (avec extensions CISI)
  18 : C      
  19 : C AUTEUR            :  A. BECCANTINI, DRN/DMT/SEMT/TTMF
  20 : C     
  21 : C************************************************************************
  22 : C
  23 : C
  24 : C APPELES (Outils)  :  KRIPAD, LICHT  
  25 : C
  26 : C APPELES (Calcul)  :  AUCUN 
  27 : C     
  28 : C
  29 : C************************************************************************
  30 : C
  31 : C ENTREES
  32 : C
  33 : C     1) Pointeurs de MELEMEs et de CHPOINTs de la table DOMAINE
  34 : C
  35 : C     ICEN    : MELEME de 'POI1' SPG des CENTRES
  36 : C
  37 : C     IFACE   : MELEME de 'POI1' SPG des FACES
  38 : C
  39 : C     IFACEL  : MELEME de 'SEG3' avec
  40 : C               CENTRE d'Elt "gauche"
  41 : C               CENTRE de Face
  42 : C               CENTRE d'Elt "droite"
  43 : C
  44 : C               N.B. = IFACE.NUM(i,1) = IFACEL.NUM(i,2)
  45 : C
  46 : C     2) Pointeurs des  CHPOINTs
  47 : C
  48 : C     IROC    : CHPOINT "CENTRE" contenant les scalaires
  49 : C
  50 : C SORTIES
  51 : C
  52 : C
  53 : C     IROF    : MCHAML  defini sur le MELEME de pointeur IFACEL,
  54 : C               contenant les scalaires
  55 : C
  56 : C     LOGAN   : anomalie detectee (changement de la convention dans
  57 : C               la table domaine)
  58 : C
  59 : C     MESERR  : pour les messages d'erreur
  60 : C
  61 : C************************************************************************
  62 : C
  63 : C HISTORIQUE (Anomalies et modifications éventuelles)
  64 : C
  65 : C HISTORIQUE :  Créée le 28.12.01.
  66 : C 
  67 : C************************************************************************
  68 : C
  69 : C
  70 : C**** Variables de COOPTIO
  71 : C
  72 : C      INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR
  73 : C     &        ,IOTER,   IOLEC,  IOIMP,     IOCAR,  IOACQ
  74 : C     &        ,IOPER,   IOSGB,  IOGRA,     IOSAU,  IORES
  75 : C     &        ,IECHO,   IIMPI,  IOSPI
  76 : C     &        ,IDIM
  77 : CC     &        ,MCOORD      
  78 : C     &        ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE
  79 : C     &        ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU
  80 : C     &        ,NORINC,NORVAL,NORIND,NORVAD
  81 : C     &        ,NUCROU, IPSAUV
  82 : C
  83 : C**** Les variables
  84 : C
  85 :       IMPLICIT INTEGER(I-N)
  86 :       INTEGER ICEN, IFACE, IFACEL, IROC
  87 :      &       , IROF
  88 :      &       , IGEOM, NFAC
  89 :      &       , N1PTEL, N1EL, N2PTEL, N2EL, N2, N1, N3, L1
  90 :      &       , NLCF, NGCF, NGCEG, NLCEG, NGCED, NLCED, NGCF1, I1
  91 :       REAL*8 ROG, ROD
  92 :       CHARACTER*(40) MESERR
  93 :       CHARACTER*(8) TYPE
  94 :       LOGICAL LOGAN
  95 : C
  96 : C**** Les Includes
  97 : C
  98 : -INC SMCOORD
  99 : -INC CCOPTIO
 100 : -INC SMCHPOI
 101 :       POINTEUR MPROC.MPOVAL
 102 : -INC SMCHAML
 103 : -INC SMLENTI
 104 : -INC SMELEME
 105 : -INC SMLMOTS
 106 :       POINTEUR MLMCOM.MLMOTS
 107 : C
 108 : C**** Initialisation des parametres d'erreur déjà faite, i.e.
 109 : C
 110 : C     MESERR = '                                        '
 111 : C     MOTERR(1:40) = MESERR(1:40)
 112 : C
 113 : C
 114 : C**** KRIPAD pour la correspondance global/local de centre
 115 : C
 115 :       CALL KRIPAD(ICEN,MLENT1)
 116 : C
 117 : C**** MLENTI1 a MCORD.XCOORD(/1)/(IDIM+1) elements
 118 : C
 119 : C     Si i est le numero global d'un noeud de ICEN,
 120 : C     MLENT1.LECT(i) contient sa position, i.e.
 121 : C
 122 : C     I              = numero global du noeud centre      
 123 : C     MLENT1.LECT(i) = numero local du noeud centre
 124 : C
 125 : C     MLENT1 déjà activé, i.e.
 126 : C
 127 : C     SEGACT MLENT1
 128 : C
 129 : C**** Activation de CHPOINTs
 130 : C
 130 :       CALL LICHT(IROC, MPROC, TYPE, IGEOM)
 131 : C     SEGACT MPROC
 132 : C      
 133 : C**** Le MELEME FACEL
 134 : C
 135 :       IPT1 = IFACEL
 136 :       IPT2 = IFACE
 137 :       SEGACT IPT1
 138 :       SEGACT IPT2
 139 :       NFAC = IPT1.NUM(/2)
 140 : C
 141 :       SEGACT MLMCOM
 142 : C      
 143 : C**** Creation de MCHAMLs contenant les etats gauche et droite,
 144 : C
 145 : C**** Densité
 146 : C
 147 :       N1 = 1
 148 :       N3 = 6
 149 :       L1 = 15
 150 :       SEGINI MCHEL2
 151 :       IROF = MCHEL2
 152 :       MCHEL2.IMACHE(1) = IFACEL
 153 :       MCHEL2.TITCHE = '               '
 154 :       MCHEL2.CONCHE(1) = '                '
 155 : C
 156 : C**** Valeurs independente du repére, i.e.
 157 : C      
 158 :       MCHEL2.INFCHE(1,1) = 0
 159 :       MCHEL2.INFCHE(1,3) = NIFOUR
 160 :       MCHEL2.INFCHE(1,4) = 0
 161 :       MCHEL2.INFCHE(1,5) = 0
 162 :       MCHEL2.INFCHE(1,6) = 0
 163 :       MCHEL2.IFOCHE = IFOUR
 164 :       N2 = MLMCOM.MOTS(/2)
 165 :       SEGINI MCHAM1
 166 :       MCHEL2.ICHAML(1) = MCHAM1
 167 :       SEGDES MCHEL2
 168 :       N1EL = NFAC
 169 :       N1PTEL = 3
 170 :       N2EL = 0
 171 :       N2PTEL = 0      
 172 :       DO I1=1,N2,1
 173 :          MCHAM1.NOMCHE(I1) = MLMCOM.MOTS(I1)
 174 :          MCHAM1.TYPCHE(I1) = 'REAL*8          '
 175 :          SEGINI MELVA1
 176 :          MCHAM1.IELVAL(I1) = MELVA1
 177 :       ENDDO
 178 : C
 179 : C**** Boucle sur le faces
 180 : C     
 181 :       DO NLCF = 1, NFAC
 182 : C
 183 : C******* NLCF  = numero local du centre de face
 184 : C        NGCF  = numero global du centre de face
 185 : C        NGCEG = numero global du centre ELT "gauche"
 186 : C        NLCEG = numero local du centre ELT "gauche"
 187 : C        NGCED = numero global du centre ELT "droite"
 188 : C        NLCED = numero local du centre ELT "droite"
 189 : C
 190 :          NGCEG = IPT1.NUM(1,NLCF)
 191 :          NGCF  = IPT1.NUM(2,NLCF)
 192 :          NGCED = IPT1.NUM(3,NLCF)
 193 :          NLCEG = MLENT1.LECT(NGCEG)
 194 :          NLCED = MLENT1.LECT(NGCED)
 195 : C
 196 : C******* TEST: IPT2.NUM(1,NLCF) = IPT1.NUM(2,NLCF)
 197 : C
 198 :          NGCF1 = IPT2.NUM(1,NLCF)
 199 :          IF(NGCF1 .NE. NGCF) THEN
 200 :             LOGAN = .TRUE.
 201 :             MESERR(1:40) = 'PRET, subroutine pre411.eso             ' 
 202 :             GOTO 9999
 203 :          ENDIF
 204 :          DO I1 = 1, N2, 1
 205 :             IF(NGCEG .EQ. NGCED)THEN
 206 :                ROG = MPROC.VPOCHA(NLCEG , I1)
 207 : C              
 208 : C********** Son etat droite
 209 : C
 210 :                ROD = ROG
 211 :             ELSE
 212 : C
 213 : C************* Etat gauche
 214 : C
 215 :                ROG = MPROC.VPOCHA(NLCEG, I1)
 216 : C
 217 : C********** Etat droit
 218 : C
 219 :                ROD = MPROC.VPOCHA(NLCED, I1)
 220 :             ENDIF
 221 :             MELVA1=MCHAM1.IELVAL(I1)
 222 :             MELVA1.VELCHE(1,NLCF) = ROG
 223 :             MELVA1.VELCHE(3,NLCF) = ROD
 224 :          ENDDO
 225 :       ENDDO
 226 : C
 227 : C**** Desactivation des SEGMENTs
 228 : C
 229 :       SEGDES IPT1
 230 :       SEGDES IPT2
 231 :       DO I1 = 1, N2, 1
 232 :          MELVA1=MCHAM1.IELVAL(I1)
 233 :          SEGDES MELVA1
 234 :       ENDDO
 235 :       SEGDES MCHAM1
 236 : C
 237 :       SEGDES MPROC
 238 : C
 239 :       SEGSUP MLENT1
 240 :       SEGDES MLMCOM
 241 : C
 242 :  9999 CONTINUE
 243 : C      
 244 :       RETURN                                                                    
 245 :       END
 246 : 
 247 : 
 248 : 
 249 :  
 250 :  
 251 :  
 252 :  
 253 :  
 254 :  
 255 :  
 256 :