Esope source files

   1 : C PRIM1E    SOURCE    CHAT      06/03/29    21:30:12     5360           
   2 :       SUBROUTINE PRIM1E()
   3 : C************************************************************************
   4 : C
   5 : C PROJET            :  CASTEM 2000
   6 : C
   7 : C NOM               :  PRIM1E (OPERATEUR GIBIANE)
   8 : C
   9 : C DESCRIPTION       :  Voir PRIMIT
  10 : C                            
  11 : C                      Calcul des variables primitives (et du "gamma") 
  11 : C                      pour les gas "calorically perfect" monoespeces
  12 : C    
  13 : C LANGAGE           :  FORTRAN 77 + ESOPE 2000 (avec extensions CISI)
  14 : C      
  15 : C AUTEUR            :  A. BECCANTINI, DRN/DMT/SEMT/TTMF                        
  16 : C
  17 : C************************************************************************
  18 : C
  19 : C
  20 : C APPELES (E/S)     : LIROBJ, QUEPOI, QUEPO1, ERREUR, ECROBJ, LIRCHA, 
  21 : C                     ECRCHA
  22 : C     
  23 : C APPELES (Calcul)  : PR1ECA
  24 : C
  25 : C
  26 : C************************************************************************
  27 : C
  28 : C PHRASE D'APPEL (GIBIANE) :
  29 : C
  30 : C 1) gaz ideal mono-espece 
  31 : C
  32 : C  RCHPO1 RCHPO2 =  'PRIM' MCLE1  CHPO1 CHPO2 CHPO3 CHPO4 (MCLE2) ;
  33 : C
  34 : C
  35 : C ENTREES  : 
  36 : C
  37 : C            MCLE1   : mot clé, 'PERFMONO'
  38 : C                    
  39 : C            CHPO1   : CHPOINT  contenant la masse volumique
  40 : C                      (une composante, 'SCAL').
  41 : C
  42 : C            CHPO2   : CHPOINT  contenant les dèbits
  43 : C                     (2 composantes en 2D, 'UX  ','UY  ');
  44 : C     
  45 : C            CHPO3   : CHPOINT  contenat l'énergie totale per
  46 : C                      unité de volume (RHO Et),
  47 : C                      (une composante, 'SCAL').
  48 : C
  49 : C            i.e.    CHPO1, CHPO2, CHPO3  sont les variables
  50 : C                          conservatives des Equations d'Euler.      
  51 : C
  52 : C            CHPO4   : CHPOINT  contenat les "gamma" du gaz
  53 : C                      (une composante, 'SCAL').
  54 : C     
  55 : C            MCLE2   : Option personelle: pas dans la notice
  56 : C                      officielle!!! 
  57 : C                      Mot clé, 'TRICHE' (s'il y a un erreur,
  58 : C                      les objects RCHPO1 et RCHPO2 ne sont pas
  59 : C                      des type ANNULLE et le programme
  60 : C                      ne s'arrete pas!!!)
  61 : C 
  62 : C SORTIES  : 
  63 : C
  64 : C            RCHPO1  : CHPOINT  contenant la vitesse
  65 : C
  66 : C            RCHPO2  : CHPOINT  contenant la pression du gaz;
  67 : C      
  68 : C************************************************************************
  69 : C
  70 : C HISTORIQUE (Anomalies et modifications éventuelles)
  71 : C
  72 : C HISTORIQUE :  Créée le 12.1.98.
  73 : C
  74 : C               Modifie le 30.7.98 pour ajouter le mot clee personelle
  75 : C               'TRICHE'
  76 : C
  77 : C               Modifie le 28.09.00 pour control sur le noms de composantes
  78 : C               (subroutine  QUEPO1)
  79 : C               Variables de CCOPTIO en commentaire
  80 : C               Elimination de ERREUR(-301)
  81 : C 
  82 : C************************************************************************
  83 : C
  84 : C
  85 : C**** Variables de COOPTIO
  86 : C
  87 : C      INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR
  88 : C     &        ,IOTER,   IOLEC,  IOIMP,     IOCAR,  IOACQ
  89 : C     &        ,IOPER,   IOSGB,  IOGRA,     IOSAU,  IORES
  90 : C     &        ,IECHO,   IIMPI,  IOSPI
  91 : C     &        ,IDIM
  92 : C     &        ,MCOORD      
  93 : C     &        ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE
  94 : C     &        ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU
  95 : C     &        ,NORINC,NORVAL,NORIND,NORVAD
  96 : C     &        ,NUCROU, IPSAUV
  97 : C
  98 : C**** Les variables
  99 : C
 100 :       IMPLICIT INTEGER(I-N)
 101 :       INTEGER ICOND, IRETOU, INDIC, NBCOMP, IERR0
 102 :      &       , ICEN, IRO, IROVIT, IROET, IGAMMA
 103 :      &       , IPRES, IVIT, JGN, JGM
 104 :       REAL*8 VALER(2),VAL1,VAL2
 105 :       CHARACTER*(40) MESERR(2),MESCEL
 106 :       CHARACTER*(4)  MOT(1)
 107 :       CHARACTER*(6) NOMTRI
 108 :       LOGICAL LOGNEG, LOGBOR, LOGTRI
 109 : C     
 110 : C**** Les Includes
 111 : C
 112 : -INC CCOPTIO
 113 : -INC SMCHPOI
 114 : -INC SMLMOTS
 115 : C
 116 : C**** Initialisation des parametres d'erreur
 117 : C
 118 :       LOGNEG  = .FALSE.
 119 :       LOGBOR  = .FALSE.
 120 :       MESCEL = '                                        '
 121 :       MESERR(1) = MESCEL
 122 :       MESERR(2) = MESCEL
 123 :       MOTERR(1:40) = MESCEL
 124 :       VALER(1) = 0.0D0
 125 :       VALER(2) = 0.0D0
 126 :       VAL1 = 0.0D0
 127 :       VAL2 = 0.0D0
 128 : C
 129 : C**** Initialisation des MOT(1)
 130 : C
 131 :       MOT(1) = '    '
 132 : C      
 133 : C**** Lecture du CHPOINT RO
 134 : C
 135 :       ICOND = 1
 135 :       CALL LIROBJ('CHPOINT',IRO,ICOND,IRETOU)
 136 :       IF (IERR.NE.0) GOTO 9999
 137 : C
 138 : C**** On cherche le pointeur de son maillage et on l'impose sur les
 139 : C     autres CHPOINT
 140 : C
 141 :       MCHPOI = IRO
 142 :       SEGACT MCHPOI
 143 :       MSOUPO = MCHPOI.IPCHP(1)
 144 :       SEGACT MSOUPO
 145 :       ICEN = MSOUPO.IGEOC
 146 :       SEGDES MSOUPO
 147 :       SEGDES MCHPOI
 148 : C
 149 : C**** Control du CHPOINT: QUEPOI
 150 : C
 151 : C     On controlle que le chpoint est non-partitione
 152 : C
 153 : C     INDIC = 1   -> on impose le pointeur du support geometrique (ICEN)
 154 : C     INDIC = 0   -> on ne fait que verifier le support geometrique (ICEN)      
 155 : C
 156 : C     NBCOMP > 0 -> numero des composantes      
 157 : C
 158 : C     MOT(1) = ' ' obligatoire s'on connais pas les noms des composantes
 159 : C
 160 :       INDIC = 1
 161 :       NBCOMP = 1
 162 :       MOT(1) = 'SCAL'
 162 :       CALL QUEPOI(IRO, ICEN, INDIC, NBCOMP, MOT)
 163 :       IF(IERR .NE. 0)THEN
 164 :          IERR0 = IERR
 165 : 
 166 : C
 167 : C******** Message d'erreur standard
 168 : C        -301 0 %m1:40
 169 : C
 170 :          MOTERR = 'CHPO1 = ???                             '
 171 :          WRITE(IOIMP,*) MOTERR(1:40)         
 172 : 
 173 :          GOTO 9999
 174 :       ENDIF  
 175 : C      
 176 : C**** Lecture du CHPOINT DEBIT.
 177 : C
 178 :       ICOND = 1
 178 :       CALL LIROBJ('CHPOINT',IROVIT,ICOND,IRETOU)
 179 :       IF (IERR.NE.0) GOTO 9999
 180 : C
 181 : C**** Control du CHPOINT
 182 : C     
 183 :       INDIC = 1
 184 :       NBCOMP = IDIM
 185 :       JGN = 4
 186 :       JGM = IDIM
 187 :       SEGINI MLMOTS
 188 :       MLMOTS.MOTS(1) = 'UX  '
 189 :       MLMOTS.MOTS(2) = 'UY  '
 190 :       IF(IDIM .EQ. 3) MLMOTS.MOTS(3) = 'UZ  '
 190 :       CALL QUEPO1(IROVIT, ICEN, MLMOTS)
 191 :       IF(IERR .NE. 0)THEN
 192 :          IERR0 = IERR
 193 : 
 194 : C
 195 : C******** Message d'erreur standard
 196 : C        -301 0 %m1:40
 197 : C
 198 :          MOTERR  = 'CHPO2 = ???                             '
 199 :          WRITE(IOIMP,*) MOTERR(1:40)         
 200 : 
 201 :          GOTO 9999
 202 :       ENDIF  
 203 :       SEGSUP MLMOTS
 204 : C      
 205 : C**** Lecture du CHPOINT ROET
 206 : C
 207 :       ICOND = 1
 207 :       CALL LIROBJ('CHPOINT',IROET,ICOND,IRETOU)
 208 :       IF (IERR.NE.0) GOTO 9999
 209 : C
 210 : C**** Control du CHPOINT
 211 : C     
 212 :       INDIC = 1
 213 :       NBCOMP = 1
 214 :       MOT(1) = 'SCAL'
 214 :       CALL QUEPOI(IROET, ICEN, INDIC, NBCOMP, MOT)
 215 :       IF(IERR .NE. 0)THEN
 216 :          IERR0 = IERR
 217 : 
 218 : C
 219 : C******** Message d'erreur standard
 220 : C        -301 0 %m1:40
 221 : C
 222 :          MOTERR  = 'CHPO3 = ???                             '
 223 :          WRITE(IOIMP,*) MOTERR(1:40)
 224 :  
 225 :          GOTO 9999
 226 :       ENDIF 
 227 : C
 228 : C**** Lecture du CHPOINT GAMMA
 229 : C
 230 :       ICOND = 1
 230 :       CALL LIROBJ('CHPOINT',IGAMMA,ICOND,IRETOU)
 231 :       IF(IERR .NE. 0)GOTO 9999
 232 : C
 233 : C**** Control du CHPOINT
 234 : C     
 235 :       INDIC = 1
 236 :       NBCOMP = 1
 237 :       MOT(1) = 'SCAL'
 237 :       CALL QUEPOI(IGAMMA, ICEN, INDIC, NBCOMP, MOT)
 238 :       IF(IERR .NE. 0)THEN
 239 :          IERR0 = IERR
 240 : 
 241 : C
 242 : C******* Message d'erreur standard
 243 : C        -301 0 %m1:40
 244 : C
 245 :          MOTERR  = 'CHPO4 = ???                             '         
 246 :          WRITE(IOIMP,*) MOTERR(1:40)
 247 : 
 248 :          GOTO 9999
 249 :       ENDIF  
 250 : C
 251 : C******* Option TRICHE
 252 : C
 253 :       ICOND = 0
 253 :       CALL LIRCHA(NOMTRI,ICOND,IRETOU)
 254 :       IF(IERR .NE. 0)GOTO 9999
 255 :       IF(IRETOU .EQ. 0)THEN
 256 :          LOGTRI = .FALSE.
 257 :       ELSEIF(NOMTRI .EQ. 'TRICHE')THEN
 258 :          LOGTRI  = .TRUE.
 259 :       ELSE
 260 :          LOGTRI = .FALSE.
 260 :          CALL ECRCHA(NOMTRI)
 261 :       ENDIF
 262 : C
 263 : C**** Calcul des sorties.
 264 : C
 264 :       CALL PR1ECA(
 265 :      &            ICEN,IRO,IROVIT,IROET,IGAMMA,
 266 :      &            IVIT,IPRES,
 267 :      &            LOGNEG,LOGBOR,MESERR,
 268 :      &            VALER,VAL1,VAL2)
 269 : C
 270 :       IERR0 = 0
 271 :       IF(LOGNEG)THEN
 272 : C
 273 : C******* Pression (energie thermique)  ou densité negative
 274 : C
 275 : C
 276 : C******* Message d'erreur standard
 277 : C        41 2
 278 : C        %m1:8 = %r1 inférieur à %r2
 279 : C
 280 :          MESCEL = MESERR(1)
 281 :          MOTERR(1:8) = MESCEL(1:8)
 282 :          REAERR(1) = REAL(VALER(1))
 283 :          REAERR(2) = 0.0
 283 :          CALL ERREUR(41)
 284 :          IF(LOGTRI)THEN
 285 : *            IERR = 0
 286 :          ELSE
 287 :             GOTO 9999
 288 :          ENDIF
 289 :       ENDIF
 290 :       IF(LOGBOR)THEN
 291 : C      
 292 : C******* GAMMA dehor GAMMIN, GAMMAX      
 293 : C
 294 : C******* Message d'erreur standard
 295 : C        42 2
 296 : C        %m1:8 = %r1 non compris entre %r2 et %r3
 297 : C
 298 :          MESCEL = MESERR(2)
 299 :          MOTERR(1:8) = MESCEL(1:8)
 300 :          REAERR(1) = REAL(VALER(2))
 301 :          REAERR(2) = REAL(VAL1)
 302 :          REAERR(3) = REAL(VAL2)
 302 :          CALL ERREUR(42)
 303 :          IF(LOGTRI)THEN
 304 : *            IERR = 0
 305 :          ELSE
 306 :             GOTO 9999
 307 :          ENDIF
 308 :       ENDIF
 309 : C
 310 : C**** Ecriture du CHPOINT contenant la pression.
 311 : C
 311 :       CALL ECROBJ('CHPOINT',IPRES)
 312 : C
 313 : C**** Ecriture du CHPOINT contenant la vitesse.
 314 : C
 314 :       CALL ECROBJ('CHPOINT',IVIT)
 315 : C      
 316 : C
 317 :  9999 CONTINUE
 318 : C      
 319 :       RETURN                                                                    
 320 :       END
 321 : 
 322 : 
 323 : 
 324 :  
 325 :  
 326 :  
 327 :  
 328 :