Download pr1eca.eso

Back to the list

   1 : C PR1ECA    SOURCE    CHAT      05/01/13    02:21:08     5004           
   2 :       SUBROUTINE PR1ECA(
   3 :      &            IM1,ICH1,ICH2,ICH3,ICH4,
   4 :      &            IVIT,IPRES,
   5 :      &            LOGNEG,LOGBOR,MESERR,
   6 :      &            VALER,VAL1,VAL2)
   7 : C************************************************************************
   8 : C
   9 : C PROJET            :  CASTEM 2000
  10 : C
  11 : C NOM               :  PR1ECA
  12 : C
  13 : C DESCRIPTION       :  VOIR PRIM1E
  14 : C
  15 : C                      Gaz ideal mono-espece: 
  16 : C                      Calcul de vitesse, pression.
  17 : C
  18 : C LANGAGE           :  FORTRAN 77 + ESOPE 2000 (avec extensions CISI)
  19 : C      
  20 : C AUTEUR            :  A. BECCANTINI, DRN/DMT/SEMT/TTMF                        
  21 : C
  22 : C************************************************************************
  23 : C
  24 : C APPELES (E/S)     :  LICHT 
  25 : C
  26 : C************************************************************************
  27 : C
  28 : C ENTREES  :
  29 : C
  30 : C            IM1     : MELEME contenant les centres des ELTs
  31 : C
  32 : C            ICH1    : CHPOINT  contenant la masse volumique.
  33 : C
  34 : C            ICH2    : CHPOINT contenant les dèbits
  35 : C                     ( NDIM  composantes);
  36 : C     
  37 : C            ICH3    : CHPOINT  contenat l'énergie totale per
  38 : C                      unité de volume (RHO Et);
  39 : C
  40 : C            ICH4    : CHPOINT  contenant "gamma" du gaz.
  41 : C
  42 : C      
  43 : C SORTIES  : IVIT    : CHPOINT  contenant les "gamma" du gaz;
  44 : C
  45 : C            IPRES   : CHPOINT  contenant la pression du gaz;
  46 : C      
  47 : C            LOGNEG  : (LOGICAL): si .TRUE. une pression ou une densité
  48 : C                      negative a été detectée -> le programme s'arrete
  49 : C                      (sa valeur stockée en MESERR(1) et VALER(1))
  50 : C
  51 : C            LOGBOR  : (LOGICAL)
  52 : C                      gamma a été detecté dehor GAMMIN et GAMMAX
  53 : C                      (sa valeur stockée en MESERR(2) et  VALER(2),VAL1,VAL2)
  54 : C      
  55 : C            MESERR,
  56 : C            VALER,
  57 : C            VAL1,
  58 : C            VAL2    : pour message d'erreur
  59 : C
  60 : C     
  61 : C************************************************************************
  62 : C
  63 : C HISTORIQUE (Anomalies et modifications éventuelles)
  64 : C
  65 : C HISTORIQUE :  Créée le 12.1.98.
  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 : C     &        ,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 
  87 :      &        IM1,ICH1,ICH2,ICH3,ICH4
  88 :      &       ,IVIT,IPRES
  89 :      &       ,NLCE, N1, IGEOMC
  90 :       REAL*8  VALER(2),VAL1,VAL2
  91 :      &        ,RO,UX,UY,UZ,P
  92 :      &        ,ROET, ROETH, CELL
  93 :      &        ,GAMMIN,GAMMAX,GAMMA
  94 :       PARAMETER(GAMMIN=1.0D0,GAMMAX=3.0D0)
  95 : C      
  96 :       CHARACTER*(8) TYPE
  97 :       CHARACTER*(40) MESERR(2)
  98 :       LOGICAL LOGNEG, LOGBOR
  99 : C      
 100 : C
 101 : C**** Les includes
 102 : C
 103 : -INC CCOPTIO
 104 : -INC SMCHPOI
 105 : -INC SMELEME
 106 : C     
 107 : C
 108 : C**** Initialisation des variables pour la gestion des erreurs pas ici,
 109 : C     mais avant, i.e.
 110 : C
 111 : C      LOGNEG  = .FALSE.
 112 : C      LOGBOR  = .FALSE.
 113 : C      MESERR(1)  = '                                        '      
 114 : C      MESERR(2)  = '                                        '      
 115 : C     
 116 : C**** Activation du MELEME "CENTRE"
 117 : C
 118 :       IPT1 = IM1
 119 :       SEGACT IPT1
 120 :       N1 = IPT1.NUM(/2)
 121 :       SEGDES IPT1
 122 : C
 123 : C**** Creation des CHPOINTs IVIT, IPRES
 124 : C    
 125 : C     ITEMP CHPOINT simile aux ICH1
 126 : C     Donc on lit ICH1
 127 : C     
 128 :       MCHPO1 = ICH1
 129 :       SEGACT MCHPO1
 130 :       MSOUP1 = MCHPO1.IPCHP(1)
 131 :       SEGDES MCHPO1
 132 :       SEGACT MSOUP1
 133 :       MPOVA1 = MSOUP1.IPOVAL
 134 :       SEGDES MSOUP1
 135 :       SEGACT MPOVA1
 136 : C
 137 : C***  MPOVA6 = IPOVAL de IPRES 
 138 : C
 139 :       SEGINI, MPOVA6 = MPOVA1
 140 :       SEGINI, MSOUP2 = MSOUP1
 141 :       MSOUP2.IPOVAL = MPOVA6
 142 :       SEGINI, MCHPO2 = MCHPO1
 143 :       MCHPO2.IPCHP(1)= MSOUP2
 144 :       SEGDES MSOUP2
 145 :       SEGDES MCHPO2
 146 :       IPRES = MCHPO2
 147 : C
 148 : C***  IVIT simil au CHPOINT ICH2 (DEBITs).
 149 : C
 150 :       MCHPO1 = ICH2
 151 :       SEGACT MCHPO1
 152 :       MSOUP1 = MCHPO1.IPCHP(1)
 153 :       SEGDES MCHPO1
 154 :       SEGACT MSOUP1
 155 :       MPOVA2 = MSOUP1.IPOVAL
 156 :       SEGDES MSOUP1
 157 :       SEGACT MPOVA2
 158 : C
 159 : C**** IVIT
 160 : C
 161 :       SEGINI, MPOVA5 = MPOVA2
 162 :       SEGINI, MSOUP2 = MSOUP1
 163 :       MSOUP2.IPOVAL = MPOVA5
 164 :       SEGINI, MCHPO2 = MCHPO1
 165 :       MCHPO2.IPCHP(1)= MSOUP2
 166 :       SEGDES MSOUP2
 167 :       SEGDES MCHPO2
 168 :       IVIT = MCHPO2
 169 : C
 170 : C**** Lecture de MPOVALs  des autres MCHPOIs
 171 : C
 171 :       CALL LICHT(ICH3,MPOVA3,TYPE,IGEOMC)
 171 :       CALL LICHT(ICH4,MPOVA4,TYPE,IGEOMC)
 172 : C
 173 : C**** LICHT active les MPOVALs en *MOD
 174 : C
 175 : C     i.e.
 176 : C
 177 : C     SEGACT MPOVA3*MOD
 178 : C     SEGACT MPOVA4*MOD
 179 : C
 180 : C
 181 : C**** RICAPITOLATIF
 182 : C
 183 : C     On a activé que les MPOVA1 - MPOVA7
 184 : C
 185 : C     MPOVA1 = RO
 186 : C     MPOVA2 = DEBIT
 187 : C     MPOVA3 = ROET
 188 : C     MPOVA4 = GAMMA
 189 : C     MPOVA5 = VITESSE
 190 : C     MPOVA6 = PRES
 191 : C
 192 : C**** BOUCLE SUR LES CENTRES pour le calcul du FLUX.
 193 : C
 194 :       DO NLCE = 1, N1
 195 : C
 196 : C******* Les differents variables a chaque centre
 197 : C        
 198 :          RO   = MPOVA1.VPOCHA(NLCE,1)
 199 :          IF(RO .LE. 0.0D0)THEN
 200 :             VALER(1) = RO
 201 :             MESERR(1) = 'RO                                      '
 202 :             LOGNEG = .TRUE.
 203 : C
 204 : C********** RO < 0: le programme s'arrete mais apres le calcul des
 205 : C                   CHPOINTs            
 206 : C            
 207 :          ENDIF
 208 :          UX = MPOVA2.VPOCHA(NLCE,1)/RO
 209 :          UY = MPOVA2.VPOCHA(NLCE,2)/RO
 210 :          MPOVA5.VPOCHA(NLCE,1)=UX
 211 :          MPOVA5.VPOCHA(NLCE,2)=UY
 212 :          IF(IDIM .EQ. 3) THEN
 213 :             UZ = MPOVA2.VPOCHA(NLCE,3)/RO
 214 :             MPOVA5.VPOCHA(NLCE,3)=UZ
 215 :          ENDIF
 216 :          ROET = MPOVA3.VPOCHA(NLCE,1)
 217 :          CELL = UX*UX + UY*UY
 218 :          IF(IDIM .EQ. 3) CELL = CELL +UZ*UZ
 219 :          CELL = 0.5D0 * CELL *RO
 220 :          ROETH = ROET - CELL
 221 :          GAMMA = MPOVA4.VPOCHA(NLCE,1)
 222 :          IF((GAMMA .LT. GAMMIN) .OR. (GAMMA .GT. GAMMAX))THEN
 223 :             MESERR(2) = 'GAMMA                                   '
 224 :             VALER(2)  = GAMMA
 225 :             VAL1 = GAMMIN
 226 :             VAL2 = GAMMAX
 227 :             LOGBOR = .TRUE.
 228 : C
 229 : C********** GAMMA !\in (GAMMIN,GAMMAX) : le programme s'arrete
 230 : C           mais apres le calcul des  CHPOINTs            
 231 : C            
 232 :          ENDIF
 233 :          P = (GAMMA - 1.0D0) * ROETH
 234 :          IF(P .LE. 0.0D0)THEN
 235 :             VALER(1) = P
 236 :             MESERR(1) = 'P                                       '
 237 :             LOGNEG = .TRUE.
 238 : C
 239 : C********** P < 0: le programme s'arrete mais apres le calcul des
 240 : C                   CHPOINTs            
 241 : C            
 242 :          ENDIF
 243 :          MPOVA6.VPOCHA(NLCE,1) = P
 244 :       ENDDO
 245 : C
 246 :       SEGDES MPOVA1
 247 :       SEGDES MPOVA2
 248 :       SEGDES MPOVA3
 249 :       SEGDES MPOVA4
 250 :       SEGDES MPOVA5
 251 :       SEGDES MPOVA6
 252 : C         
 253 :       RETURN
 254 :       END
 255 : 
 256 : 
 257 : 
 258 : 
 259 : 
 260 : 
 261 : 
 262 : 
 263 : 
 264 : 
 265 : 
 266 : 
 267 : 
 268 : 
 269 : 
 270 : 
 271 : 
 272 : 
 273 : 
 274 : 
 275 : 
 276 : 
 277 : 
 278 : 
 279 : 
 280 : 
 281 : 
 282 : 
 283 : 
 284 : 
 285 : 
 286 : 
 287 : 
 288 :  
 289 :  
 290 :  

© Cast3M 2003 - All rights reserved.
Disclaimer