Télécharger pre22.eso

Retour à la liste

pre22
C PRE22     SOURCE    OF166741  24/12/13    21:17:02     12097          
      SUBROUTINE PRE22(ORDTEM)
C************************************************************************
C
C PROJET            :  CASTEM 2000
C
C NOM               :  PRE22
C
C DESCRIPTION       :  Voir PRE2
C
C                      Gas gaz parfait, multi-especes.
C
C                      2me ordre en espace (1er ou 2me ordre en temps)
C
C                      Creations des object MCHAML IROF, IVITF, IPF,
C                      IGAMF, IYF
C
C LANGAGE           :  FORTRAN 77 + ESOPE 2000 (avec extensions CISI)
C
C AUTEUR            :  A. BECCANTINI, DRN/DMT/SEMT/TTMF
C
C************************************************************************
C
C
C APPELES (Outils)  :  LIRTAB, ACMO, LEKTAB, QUETYP, ERREUR, LIROBJ,
C                      ACMM, ACCTAB, QUEPOI, ECROBJ
C
C
C APPELES (Calcul)  :  PRE221 (2D)
C
C
C************************************************************************
C
C HISTORIQUE (Anomalies et modifications éventuelles)
C
C HISTORIQUE :  Créée le 10.7.98.
C
C************************************************************************
C
C**** Les variables
C
      IMPLICIT INTEGER(I-N)
      INTEGER   ORDTEM, ICOND,  IRETOU, IERR0, INDIC, NBCOMP
     &          ,IDOMA, ICEN, IFACE, IFACEL, INORM
     &          ,IROC, IGRROC, IALROC
     &          ,IVITC, IGRVC, IALVC
     &          ,IPC ,IGRPC, IALPC
     &          ,IGAMC, IROF, IVITF, IPF, IGAMF
     &          ,IPGAS, ICP, ICV, NESP, I1, JG
     &          ,IYC, IGRYC, IALYC, IYF
     &          ,JGM,JGN,MMODEL, I2, ICEL
      REAL*8 VALER, VAL1, VAL2, DELTAT, CP, CV
      CHARACTER*(4)  NOMTOT(9), CELLCH
      CHARACTER*(8) MTYPR, TYPE
      CHARACTER*(40) MESERR
      CHARACTER*(4)  NOMGRA(27),NOMLIM(9)
      LOGICAL LOGAN,LOGNEG, LOGBOR,LOGTEM
C
C**** Variables en ACCTAB
C
      INTEGER IVALI, IRETI,IVALR, IRETR, INEFMD
      REAL*8 XVALI,XVALR
      LOGICAL LOGII, LOGIR
      CHARACTER*(8) CHARR,MTYPI
C
C**** Nom de composantes de gradients (HP. <= 9 composantes)
C
      DATA NOMGRA  /'P1DX','P1DY','P1DZ',
     &     'P2DX','P2DY','P2DZ',
     &     'P3DX','P3DY','P3DZ',
     &     'P4DX','P4DY','P4DZ',
     &     'P5DX','P5DY','P5DZ',
     &     'P6DX','P6DY','P6DZ',
     &     'P7DX','P7DY','P7DZ',
     &     'P8DX','P8DY','P8DZ',
     &     'P9DX','P9DY','P9DZ'/
C
      DATA NOMLIM  /'P1  ',
     &     'P2  ',
     &     'P3  ',
     &     'P4  ',
     &     'P5  ',
     &     'P6  ',
     &     'P7  ',
     &     'P8  ',
     &     'P9  '/
C
C**** Les Includes
C
 
-INC PPARAM
-INC CCOPTIO
-INC SMLMOTS
-INC SMLREEL
      POINTEUR MLRECP.MLREEL, MLRECV.MLREEL
      POINTEUR MLMVIT.MLMOTS, MLMCOM.MLMOTS
      POINTEUR MLMESP.MLMOTS
C
C**** Initialisation des parametres d'erreur
C
      LOGAN = .FALSE.
      LOGNEG  = .FALSE.
      LOGBOR  = .FALSE.
      MESERR = '                                        '
      MOTERR(1:40) = MESERR(1:40)
      VALER = 0.0D0
      VAL1 = 0.0D0
      VAL2 = 0.0D0
C
C**** Initialisation des NOMTOT
C
      NOMTOT(1) = '    '
      NOMTOT(2) = '    '
      NOMTOT(3) = '    '
      NOMTOT(4) = '    '
      NOMTOT(5) = '    '
      NOMTOT(6) = '    '
      NOMTOT(7) = '    '
      NOMTOT(8) = '    '
      NOMTOT(9) = '    '
C
C**** Lecture de l'objet MODELE
C
      ICOND = 1
      CALL QUETYP(TYPE,ICOND,IRETOU)
      CALL LIROBJ('MMODEL  ',MMODEL,ICOND,IRETOU)
      CALL ACTOBJ('MMODEL  ',MMODEL,1)
      IF(IERR.NE.0)GOTO 9999
      CALL LEKMOD(MMODEL,IDOMA,INEFMD)
      IF(IERR.NE.0)GOTO 9999
C
C**** Lecture du MELEME SPG des points CENTRE.
C
C
C     CALL LEKTAB(IDOMA,'CENTRE',IP)
C
C**** Probleme du LEKTAB: si IDOMA.'CENTRE' n'existe pas,
C     il crèe IDOMA.'CENTRE' sans recrèer 'FACEL'
C     -> la correspondance global des noeuds saut!
C
C     On peut utilizer ACCTAB ou ACMO
C
      MTYPR = 'MAILLAGE'
      CALL ACMO(IDOMA,'CENTRE',MTYPR,ICEN)
      IF(IERR.NE.0)GOTO 9999
C
C**** Lecture du MELEME 'FACE'
C
      MTYPR = 'MAILLAGE'
      CALL ACMO(IDOMA,'FACE',MTYPR,IFACE)
      IF(IERR.NE.0)GOTO 9999
C
C**** Lecture du MELEME 'FACEL'
C
      MTYPR = 'MAILLAGE'
      CALL ACMO(IDOMA,'FACEL',MTYPR,IFACEL)
      IF(IERR.NE.0)GOTO 9999
C
C**** Lecture du CHPOINT contenant les normales aux faces
C
      IF(IDIM .EQ. 2)THEN
C        Que les normales
         CALL LEKTAB(IDOMA,'XXNORMAF',INORM)
         IF(IERR .NE. 0) GOTO 9999
         JGN = 4
         JGM = 2
         SEGINI MLMVIT
         MLMVIT.MOTS(1) = 'UX  '
         MLMVIT.MOTS(2) = 'UY  '
         CALL QUEPO1(INORM, IFACE, MLMVIT)
         SEGSUP MLMVIT
         IF(IERR.NE.0)GOTO 9999
      ELSE
C      Les normales et les tangentes
         MTYPR = ' '
         CALL ACMO(IDOMA,'MATROT',MTYPR,INORM)
         IF (MTYPR .NE. 'CHPOINT ') THEN
            CALL MATRAN(IDOMA,INORM)
            IF(IERR .NE. 0) GOTO 9999
         ENDIF
         JGN = 4
         JGM = 9
         SEGINI MLMVIT
         MLMVIT.MOTS(1) = 'UX  '
         MLMVIT.MOTS(2) = 'UY  '
         MLMVIT.MOTS(3) = 'UZ  '
         MLMVIT.MOTS(4) = 'RX  '
         MLMVIT.MOTS(5) = 'RY  '
         MLMVIT.MOTS(6) = 'RZ  '
         MLMVIT.MOTS(7) = 'MX  '
         MLMVIT.MOTS(8) = 'MY  '
         MLMVIT.MOTS(9) = 'MZ  '
         CALL QUEPO1(INORM, IFACE, MLMVIT)
         SEGSUP MLMVIT
         IF(IERR.NE.0)GOTO 9999
C
      ENDIF
C
C**** N.B. On veut lire les objets sequentiellement.
C     Donc on utilise QUETYP pour controler que
C     le type de l'objet soit le bon.
C
C**** Lecture de la table des proprietes du gaz
C
      ICOND = 1
      CALL QUETYP(MTYPR,ICOND,IRETOU)
      IF(IERR .NE. 0)GOTO 9999
      IF(MTYPR .NE. 'TABLE   ')THEN
C
C******* Message d'erreur standard
C        37 2
C        On ne trouve pas d'objet de type %m1:8
C
         MOTERR(1:8) = 'TABLE   '
         CALL ERREUR(37)
         GOTO 9999
      ELSE
         ICOND = 1
         CALL LIROBJ(MTYPR,IPGAS,ICOND,IRETOU)
         CALL ACTOBJ(MTYPR,IPGAS,1)
         IF(IERR .NE. 0)GOTO 9999
      ENDIF
C
C N.B: la table des propietes des gaz a ete deja controlle en PRIMIT
C      donc on ne la controlle pas ici!!!
C
C**** Les CPs
C
      MTYPR = '        '
      CALL ACMO(IPGAS,'CP',MTYPR,ICP)
      IF(IERR .NE. 0)GOTO 9999
C
C**** Les CVs
C
      MTYPR = '        '
      CALL ACMO(IPGAS,'CV',MTYPR,ICV)
      IF(IERR .NE. 0)GOTO 9999
C
C**** Les especes qui sont dans les Equations d'Euler
C
      MTYPR = '        '
      CALL ACMO(IPGAS,'ESPEULE',MTYPR,MLMESP)
      IF(IERR .NE. 0)GOTO 9999
C
C**** Nom de l'espece qui n'est pas dans les equations d'Euler
C
       MTYPI = 'MOT     '
       MTYPR = 'MOT     '
       CALL ACCTAB(IPGAS,MTYPI,IVALI,XVALI,'ESPNEULE',LOGII,IRETI,
     &                   MTYPR,IVALR,XVALR,CELLCH,LOGIR,IRETR)
       IF(IERR .NE. 0)GOTO 9999
C
C**** Control de compatibilite des donnes de la table
C     et creation des LISTREELs avec CP et CV
C
      SEGACT MLMESP
C
C**** NESP = nombre d'especes dans lesequation d'Euler
C
      NESP = MLMESP.MOTS(/2)
C
C**** List de CP et CV
C
      JG = NESP+1
      SEGINI MLRECP
      SEGINI MLRECV
      DO I1 = 1, NESP
C
C******* N.B. NOMTOT est un CHARACTER*(4)
C
         NOMTOT(1) = MLMESP.MOTS(I1)
C
C******* CALL ACMF(ICP,NOMC,CP)  ne marche pas parce que on a
C        des blanches dans nos composantes
C
         MTYPI = 'MOT     '
         MTYPR = '        '
         CALL ACCTAB(ICP,MTYPI,IVALI,XVALI,NOMTOT(1), LOGII,IRETI,
     &               MTYPR,IVALR,CP   ,CHARR,LOGIR,IRETR)
         IF(IERR .NE. 0)GOTO 9999
         MLRECP.PROG(I1) = CP
C
         MTYPI = 'MOT     '
         MTYPR = '        '
         CALL ACCTAB(ICV,MTYPI,IVALI,XVALI,NOMTOT(1), LOGII,IRETI,
     &               MTYPR,IVALR,CV   ,CHARR,LOGIR,IRETR)
         IF(IERR .NE. 0)GOTO 9999
         MLRECV.PROG(I1) = CV
      ENDDO
      MTYPI = 'MOT     '
      MTYPR = '        '
      CALL ACCTAB(ICP,MTYPI,IVALI,XVALI,CELLCH, LOGII,IRETI,
     &            MTYPR,IVALR,CP   ,CHARR,LOGIR,IRETR)
      IF(IERR .NE. 0)GOTO 9999
      MLRECP.PROG(JG) = CP
C
      MTYPI = 'MOT     '
      MTYPR = '        '
      CALL ACCTAB(ICV,MTYPI,IVALI,XVALI,CELLCH, LOGII,IRETI,
     &            MTYPR,IVALR,CV   ,CHARR,LOGIR,IRETR)
      IF(IERR .NE. 0)GOTO 9999
      MLRECV.PROG(JG) = CV
C
C**** Lecture du CHPOINT ROC
C
      ICOND = 1
      CALL QUETYP(MTYPR,ICOND,IRETOU)
      IF(IERR .NE. 0)GOTO 9999
      IF(MTYPR .NE. 'CHPOINT ')THEN
C
C******* Message d'erreur standard
C        37 2
C        On ne trouve pas d'objet de type %m1:8
C
         MOTERR(1:8) = 'CHPOINT '
         CALL ERREUR(37)
         GOTO 9999
      ELSE
         ICOND = 1
         CALL LIROBJ(MTYPR,IROC,ICOND,IRETOU)
         CALL ACTOBJ(MTYPR,IROC,1)
         IF(IERR .NE. 0)GOTO 9999
      ENDIF
C
C**** Control du CHPOINT: QUEPOI
C
C     INDIC = 1   -> on impose le pointeur du support geometrique (IM1)
C     INDIC = 0   -> on ne fait que verifier le support geometrique (IM1)
C
C     NBCOMP > 0 -> numero des composantes
C
C     NOMTOT(1) = ' ' obligatoire s'on connais pas les noms des composantes
C
      INDIC = 1
      NBCOMP = 1
      NOMTOT(1) = 'SCAL'
      CALL QUEPOI(IROC, ICEN, INDIC, NBCOMP, NOMTOT)
      IF(IERR .NE. 0)THEN
         IERR0 = IERR
 
C
C******* Message d'erreur standard
C        -301 0 %m1:40
C
         MOTERR(1:40)  = 'CHPO1 = ???                             '
         CALL ERREUR(-301)
 
         GOTO 9999
      ENDIF
C
C**** Lecture du CHPOINT GRADROC
C
      ICOND = 1
      CALL QUETYP(MTYPR,ICOND,IRETOU)
      IF(IERR .NE. 0)GOTO 9999
      IF(MTYPR .NE. 'CHPOINT ')THEN
C
C******* Message d'erreur standard
C        37 2
C        On ne trouve pas d'objet de type %m1:8
C
         MOTERR(1:8) = 'CHPOINT '
         CALL ERREUR(37)
         GOTO 9999
      ELSE
         ICOND = 1
         CALL LIROBJ(MTYPR,IGRROC,ICOND,IRETOU)
         CALL ACTOBJ(MTYPR,IGRROC,1)
         IF (IERR.NE.0) GOTO 9999
      ENDIF
C
C**** Control du CHPOINT: QUEPOI
C
C     INDIC = 1   -> on impose le pointeur du support geometrique (IM1)
C     INDIC = 0   -> on ne fait que verifier le support geometrique (IM1)
C
C     NBCOMP = 2 -> on teste le noms des composantes
C
C     NOMTOT(1) = ' ' obligatoire s'on connais pas les noms des composantes
C
      JGN=4
      JGM=IDIM
      SEGINI MLMCOM
      MLMCOM.MOTS(1)='P1DX'
      MLMCOM.MOTS(2)='P1DY'
      IF(IDIM .EQ. 3) MLMCOM.MOTS(3) = 'P1DZ'
      CALL QUEPO1(IGRROC, ICEN, MLMCOM)
      SEGSUP MLMCOM
      IF(IERR .NE. 0)THEN
         IERR0 = IERR
 
C
C******* Message d'erreur standard
C        -301 0 %m1:40
C
         MOTERR(1:40)  = 'CHPO2 = ???                             '
         CALL ERREUR(-301)
 
         GOTO 9999
      ENDIF
C
C**** Lecture du CHPOINT IALROC
C
      ICOND = 1
      CALL QUETYP(MTYPR,ICOND,IRETOU)
      IF(IERR .NE. 0)GOTO 9999
      IF(MTYPR .NE. 'CHPOINT ')THEN
C
C******* Message d'erreur standard
C        37 2
C        On ne trouve pas d'objet de type %m1:8
C
         MOTERR(1:8) = 'CHPOINT '
         CALL ERREUR(37)
         GOTO 9999
      ELSE
         ICOND = 1
         CALL LIROBJ(MTYPR,IALROC,ICOND,IRETOU)
         CALL ACTOBJ(MTYPR,IALROC,1)
         IF (IERR.NE.0) GOTO 9999
      ENDIF
C
C**** Control du CHPOINT: QUEPOI
C
      INDIC = 1
      NBCOMP = 1
      NOMTOT(1) = 'P1'
      CALL QUEPOI(IALROC, ICEN, INDIC, NBCOMP, NOMTOT)
      IF(IERR .NE. 0)THEN
         IERR0 = IERR
 
C
C******* Message d'erreur standard
C        -301 0 %m1:40
C
         MOTERR(1:40)  = 'CHPO3 = ???                             '
         CALL ERREUR(-301)
 
         GOTO 9999
      ENDIF
C
C
C**** Lecture du CHPOINT VITC
C
      ICOND = 1
      CALL QUETYP(MTYPR,ICOND,IRETOU)
      IF(IERR .NE. 0)GOTO 9999
      IF(MTYPR .NE. 'CHPOINT ')THEN
C
C******* Message d'erreur standard
C        37 2
C        On ne trouve pas d'objet de type %m1:8
C
         MOTERR(1:8) = 'CHPOINT '
         CALL ERREUR(37)
         GOTO 9999
      ELSE
         ICOND = 1
         CALL LIROBJ(MTYPR,IVITC,ICOND,IRETOU)
         CALL ACTOBJ(MTYPR,IVITC,1)
         IF (IERR.NE.0) GOTO 9999
      ENDIF
C
C**** Control du CHPOINT
C
      JGN=4
      JGM=IDIM
      SEGINI MLMCOM
      MLMCOM.MOTS(1) = 'UX  '
      MLMCOM.MOTS(2) = 'UY  '
      IF(IDIM .EQ. 3) MLMCOM.MOTS(3) = 'UZ  '
      CALL QUEPO1(IVITC, ICEN, MLMCOM)
      SEGSUP MLMCOM
      IF(IERR .NE. 0)THEN
         IERR0 = IERR
 
C
C******* Message d'erreur standard
C        -301 0 %m1:40
C
         MOTERR(1:40)  = 'CHPO4 = ???                             '
         CALL ERREUR(-301)
 
         GOTO 9999
      ENDIF
C
C**** Lecture du CHPOINT GRADVITC
C
      ICOND = 1
      CALL QUETYP(MTYPR,ICOND,IRETOU)
      IF(IERR .NE. 0)GOTO 9999
      IF(MTYPR .NE. 'CHPOINT ')THEN
C
C******* Message d'erreur standard
C        37 2
C        On ne trouve pas d'objet de type %m1:8
C
         MOTERR(1:8) = 'CHPOINT '
         CALL ERREUR(37)
         GOTO 9999
      ELSE
         ICOND = 1
         CALL LIROBJ(MTYPR,IGRVC,ICOND,IRETOU)
         CALL ACTOBJ(MTYPR,IGRVC,1)
         IF (IERR.NE.0) GOTO 9999
      ENDIF
C
C**** Control du CHPOINT: QUEPOI
C
      JGN=4
      IF(IDIM .EQ. 2)THEN
         JGM=4
         SEGINI MLMCOM
         MLMCOM.MOTS(1) = 'P1DX'
         MLMCOM.MOTS(2) = 'P1DY'
         MLMCOM.MOTS(3) = 'P2DX'
         MLMCOM.MOTS(4) = 'P2DY'
      ELSE
         JGM=9
         SEGINI MLMCOM
         MLMCOM.MOTS(1) = 'P1DX'
         MLMCOM.MOTS(2) = 'P1DY'
         MLMCOM.MOTS(3) = 'P1DZ'
         MLMCOM.MOTS(4) = 'P2DX'
         MLMCOM.MOTS(5) = 'P2DY'
         MLMCOM.MOTS(6) = 'P2DZ'
         MLMCOM.MOTS(7) = 'P3DX'
         MLMCOM.MOTS(8) = 'P3DY'
         MLMCOM.MOTS(9) = 'P3DZ'
      ENDIF
      CALL QUEPO1(IGRVC, ICEN, MLMCOM)
      SEGSUP MLMCOM
      IF(IERR .NE. 0)THEN
         IERR0 = IERR
 
C
C******* Message d'erreur standard
C        -301 0 %m1:40
C
         MOTERR(1:40)  = 'CHPO5 = ???                             '
         CALL ERREUR(-301)
 
         GOTO 9999
      ENDIF
C
C**** Lecture du CHPOINT IALVC
C
      ICOND = 1
      CALL QUETYP(MTYPR,ICOND,IRETOU)
      IF(IERR .NE. 0)GOTO 9999
      IF(MTYPR .NE. 'CHPOINT ')THEN
C
C******* Message d'erreur standard
C        37 2
C        On ne trouve pas d'objet de type %m1:8
C
         MOTERR(1:8) = 'CHPOINT '
         CALL ERREUR(37)
         GOTO 9999
      ELSE
         ICOND = 1
         CALL LIROBJ(MTYPR,IALVC,ICOND,IRETOU)
         CALL ACTOBJ(MTYPR,IALVC,1)
         IF (IERR.NE.0) GOTO 9999
      ENDIF
C
C**** Control du CHPOINT: QUEPOI
C
      JGN=4
      JGM=IDIM
      SEGINI MLMCOM
      MLMCOM.MOTS(1) = 'P1  '
      MLMCOM.MOTS(2) = 'P2  '
      IF(IDIM .EQ. 3) MLMCOM.MOTS(3) = 'P3  '
      CALL QUEPO1(IALVC, ICEN, MLMCOM)
      SEGSUP MLMCOM
      IF(IERR .NE. 0)THEN
         IERR0 = IERR
 
C
C******* Message d'erreur standard
C        -301 0 %m1:40
C
         MOTERR(1:40)  = 'CHPO6 = ???                             '
         CALL ERREUR(-301)
 
         GOTO 9999
      ENDIF
C
C**** Lecture du CHPOINT PC
C
      ICOND = 1
      CALL QUETYP(MTYPR,ICOND,IRETOU)
      IF(IERR .NE. 0)GOTO 9999
      IF(MTYPR .NE. 'CHPOINT ')THEN
C
C******* Message d'erreur standard
C        37 2
C        On ne trouve pas d'objet de type %m1:8
C
         MOTERR(1:8) = 'CHPOINT '
         CALL ERREUR(37)
         GOTO 9999
      ELSE
         ICOND = 1
         CALL LIROBJ(MTYPR,IPC,ICOND,IRETOU)
         CALL ACTOBJ(MTYPR,IPC,1)
         IF (IERR.NE.0) GOTO 9999
      ENDIF
C
C**** Control du CHPOINT
C
      INDIC = 1
      NBCOMP = 1
      NOMTOT(1) = 'SCAL'
      CALL QUEPOI(IPC, ICEN, INDIC, NBCOMP, NOMTOT)
      IF(IERR .NE. 0)THEN
         IERR0 = IERR
 
C
C******* Message d'erreur standard
C        -301 0 %m1:40
C
         MOTERR(1:40)  = 'CHPO7 = ???                             '
         CALL ERREUR(-301)
 
         GOTO 9999
      ENDIF
C
C**** Lecture du CHPOINT GRADPC
C
      ICOND = 1
      CALL QUETYP(MTYPR,ICOND,IRETOU)
      IF(IERR .NE. 0)GOTO 9999
      IF(MTYPR .NE. 'CHPOINT ')THEN
C
C******* Message d'erreur standard
C        37 2
C        On ne trouve pas d'objet de type %m1:8
C
         MOTERR(1:8) = 'CHPOINT '
         CALL ERREUR(37)
         GOTO 9999
      ELSE
         ICOND = 1
         CALL LIROBJ(MTYPR,IGRPC,ICOND,IRETOU)
         CALL ACTOBJ(MTYPR,IGRPC,1)
         IF (IERR.NE.0) GOTO 9999
      ENDIF
C
C**** Control du CHPOINT: QUEPOI
C
C
      JGN=4
      JGM=IDIM
      SEGINI MLMCOM
      MLMCOM.MOTS(1)='P1DX'
      MLMCOM.MOTS(2)='P1DY'
      IF(IDIM .EQ. 3) MLMCOM.MOTS(3) = 'P1DZ'
      CALL QUEPO1(IGRPC, ICEN, MLMCOM)
      IF(IERR .NE. 0)THEN
         IERR0 = IERR
 
C
C******* Message d'erreur standard
C        -301 0 %m1:40
C
         MOTERR(1:40)  = 'CHPO8 = ???                             '
         CALL ERREUR(-301)
 
         GOTO 9999
      ENDIF
C
C**** Lecture du CHPOINT IALPC
C
      ICOND = 1
      CALL QUETYP(MTYPR,ICOND,IRETOU)
      IF(IERR .NE. 0)GOTO 9999
      IF(MTYPR .NE. 'CHPOINT ')THEN
C
C******* Message d'erreur standard
C        37 2
C        On ne trouve pas d'objet de type %m1:8
C
         MOTERR(1:8) = 'CHPOINT '
         CALL ERREUR(37)
         GOTO 9999
      ELSE
         ICOND = 1
         CALL LIROBJ(MTYPR,IALPC,ICOND,IRETOU)
         CALL ACTOBJ(MTYPR,IALPC,1)
         IF (IERR.NE.0) GOTO 9999
      ENDIF
C
C**** Control du CHPOINT: QUEPOI
C
      INDIC = 1
      NBCOMP = 1
      NOMTOT(1) = 'P1'
      CALL QUEPOI(IALPC, ICEN, INDIC, NBCOMP, NOMTOT)
      IF(IERR .NE. 0)THEN
         IERR0 = IERR
 
C
C******* Message d'erreur standard
C        -301 0 %m1:40
C
         MOTERR(1:40)  = 'CHPO9 = ???                             '
         CALL ERREUR(-301)
 
         GOTO 9999
      ENDIF
C
C**** Lecture du CHPOINT YC
C
      ICOND = 1
      CALL QUETYP(MTYPR,ICOND,IRETOU)
      IF(IERR .NE. 0)GOTO 9999
      IF(MTYPR .NE. 'CHPOINT ')THEN
C
C******* Message d'erreur standard
C        37 2
C        On ne trouve pas d'objet de type %m1:8
C
         MOTERR(1:8) = 'CHPOINT '
         CALL ERREUR(37)
         GOTO 9999
      ELSE
         ICOND = 1
         CALL LIROBJ(MTYPR,IYC,ICOND,IRETOU)
         CALL ACTOBJ(MTYPR,IYC,1)
         IF (IERR.NE.0) GOTO 9999
      ENDIF
C
C**** Control du CHPOINT
C
      CALL QUEPO1(IYC, ICEN, MLMESP)
      IF(IERR .NE. 0)THEN
         IERR0 = IERR
 
C
C******* Message d'erreur standard
C        -301 0 %m1:40
C
         MOTERR(1:40)  = 'CHPO10 = ???                            '
         CALL ERREUR(-301)
 
         GOTO 9999
      ENDIF
C
C**** Lecture du CHPOINT GRADYC
C
      ICOND = 1
      CALL QUETYP(MTYPR,ICOND,IRETOU)
      IF(IERR .NE. 0)GOTO 9999
      IF(MTYPR .NE. 'CHPOINT ')THEN
C
C******* Message d'erreur standard
C        37 2
C        On ne trouve pas d'objet de type %m1:8
C
         MOTERR(1:8) = 'CHPOINT '
         CALL ERREUR(37)
         GOTO 9999
      ELSE
         ICOND = 1
         CALL LIROBJ(MTYPR,IGRYC,ICOND,IRETOU)
         CALL ACTOBJ(MTYPR,IGRYC,1)
         IF (IERR.NE.0) GOTO 9999
      ENDIF
C
C**** Control du CHPOINT: QUEPOI
C
      JGN=4
      JGM=IDIM*NESP
      SEGINI MLMCOM
C        NESP < 10
      IF(NESP .GE. 10)THEN
         WRITE(IOIMP,*) 'NESP >= 10!'
C
C******* Message d'erreur standard
C        21 2
C        Données incompatibles
C
         CALL ERREUR(21)
         GOTO 9999
      ENDIF
C
      ICEL = 0
      DO I1 =  1, NESP, 1
         DO I2 = 1, IDIM
            ICEL = ICEL + 1
            ICOM = 3 * (I1 -1) + I2
            MLMCOM.MOTS(ICEL) = NOMGRA(ICOM)
         ENDDO
      ENDDO
      CALL QUEPO1(IGRYC, ICEN, MLMCOM)
      SEGSUP MLMCOM
      IF(IERR .NE. 0)THEN
         IERR0 = IERR
 
C
C******* Message d'erreur standard
C        -301 0 %m1:40
C
         MOTERR(1:40)  = 'CHPO11 = ???                            '
         CALL ERREUR(-301)
 
         GOTO 9999
      ENDIF
C
C**** Lecture du CHPOINT IALYC
C
      ICOND = 1
      CALL QUETYP(MTYPR,ICOND,IRETOU)
      IF(IERR .NE. 0)GOTO 9999
      IF(MTYPR .NE. 'CHPOINT ')THEN
C
C******* Message d'erreur standard
C        37 2
C        On ne trouve pas d'objet de type %m1:8
C
         MOTERR(1:8) = 'CHPOINT '
         CALL ERREUR(37)
         GOTO 9999
      ELSE
         ICOND = 1
         CALL LIROBJ(MTYPR,IALYC,ICOND,IRETOU)
         CALL ACTOBJ(MTYPR,IALYC,1)
         IF (IERR.NE.0) GOTO 9999
      ENDIF
C
C**** Control du CHPOINT: QUEPOI
C
      JGN = 4
      JGM = NESP
      SEGINI MLMCOM
      DO I1 = 1, NESP, 1
         MLMCOM.MOTS(I1)=NOMLIM(I1)
      ENDDO
      CALL QUEPO1(IALYC, ICEN, MLMCOM)
      SEGSUP MLMCOM
      IF(IERR .NE. 0)THEN
         IERR0 = IERR
 
C
C******* Message d'erreur standard
C        -301 0 %m1:40
C
         MOTERR(1:40)  = 'CHPO12 = ???                            '
         CALL ERREUR(-301)
 
         GOTO 9999
      ENDIF
C
C**** Lecture du CHPOINT GAMC
C
      ICOND = 1
      CALL QUETYP(MTYPR,ICOND,IRETOU)
      IF(IERR .NE. 0)GOTO 9999
      IF(MTYPR .NE. 'CHPOINT ')THEN
C
C******* Message d'erreur standard
C        37 2
C        On ne trouve pas d'objet de type %m1:8
C
         MOTERR(1:8) = 'CHPOINT '
         CALL ERREUR(37)
         GOTO 9999
      ELSE
         ICOND = 1
         CALL LIROBJ(MTYPR,IGAMC,ICOND,IRETOU)
         CALL ACTOBJ(MTYPR,IGAMC,1)
         IF (IERR.NE.0) GOTO 9999
      ENDIF
C
C**** Control du CHPOINT
C
      INDIC = 1
      NBCOMP = 1
      NOMTOT(1) = 'SCAL'
      CALL QUEPOI(IGAMC, ICEN, INDIC, NBCOMP, NOMTOT)
      IF(IERR .NE. 0)THEN
         IERR0 = IERR
 
C
C******* Message d'erreur standard
C        -301 0 %m1:40
C
         MOTERR(1:40)  = 'CHPO10 = ???                            '
         CALL ERREUR(-301)
 
         GOTO 9999
      ENDIF
      IF(ORDTEM .EQ. 1)THEN
C
C******* Deux Dimensions, Une Espece, 2er ordre en espace, 1er ordre en
C        temps
C
         LOGTEM = .FALSE.
         DELTAT = 0.0D0
      ELSE
         LOGTEM = .TRUE.
         ICOND = 1
         CALL LIRREE(DELTAT,ICOND,IRETOU)
         IF(IERR .NE. 0)GOTO 9999
      ENDIF
      IF(IDIM .EQ. 2)THEN
C
C******* Deux Dimensions, Une Espece, 1er ordre en espace, 1er ordre en
C        temps
C
      CALL PRE221(LOGTEM,
     &     ICEN,IFACE,IFACEL,INORM,
     &     IROC, IGRROC, IALROC,
     &     IVITC, IGRVC, IALVC,
     &     IPC ,IGRPC, IALPC,
     &     MLRECV, MLRECP, MLMESP,
     &     IYC ,IGRYC, IALYC,
     &     IGAMC,
     &     DELTAT,
     &     IROF,IVITF,IPF,IGAMF,IYF,
     &     LOGAN,LOGNEG,LOGBOR,MESERR,VALER,VAL1,VAL2)
      ELSE
C
C******* Trois Dimensions, Une Espece, 1er ordre en espace, 1er ordre en
C        temps
C
      CALL PRE222(LOGTEM,
     &     ICEN,IFACE,IFACEL,INORM,
     &     IROC, IGRROC, IALROC,
     &     IVITC, IGRVC, IALVC,
     &     IPC ,IGRPC, IALPC,
     &     MLRECV, MLRECP, MLMESP,
     &     IYC ,IGRYC, IALYC,
     &     IGAMC,
     &     DELTAT,
     &     IROF,IVITF,IPF,IGAMF,IYF,
     &     LOGAN,LOGNEG,LOGBOR,MESERR,VALER,VAL1,VAL2)
      ENDIF
C
C**** Messages d'erreur
C
      IF(LOGAN)THEN
C
C******* Anomalie detectée
C
C
C******* Message d'erreur standard
C        -301 0
C        %m1:40
C
         MOTERR(1:40) =  MESERR(1:40)
         CALL ERREUR(-301)
C
C******* Message d'erreur standard
C        5 3
C        Erreur anormale.contactez votre support
C
         CALL ERREUR(5)
         GOTO 9999
C
      ELSEIF(LOGNEG)THEN
C
C******* Message d'erreur standard
C        41 2
C        %m1:8 = %r1 inférieur à %r2
C
         MOTERR(1:8) = MESERR(1:8)
         REAERR(1) = REAL(VALER)
         REAERR(2) = 0.0
         CALL ERREUR(41)
         GOTO 9999
      ELSEIF(LOGBOR)THEN
C
C******* Message d'erreur standard
C        42 2
C        %m1:8 = %r1 non compris entre %r2 et %r3
C
         MOTERR(1:8) = MESERR(1:8)
         REAERR(1) = REAL(VALER)
         REAERR(2) = REAL(VAL1)
         REAERR(3) = REAL(VAL2)
         CALL ERREUR(42)
         GOTO 9999
      ELSE
C
C******* Ecriture de ROF, VITF, PF, YF, GAMMAF
C
         MTYPR = 'MCHAML  '
         CALL ACTOBJ(MTYPR,IGAMF,1)
         CALL ACTOBJ(MTYPR,IYF,1)
         CALL ACTOBJ(MTYPR,IPF,1)
         CALL ACTOBJ(MTYPR,IVITF,1)
         CALL ACTOBJ(MTYPR,IROF,1)
 
         CALL ECROBJ(MTYPR,IGAMF)
         CALL ECROBJ(MTYPR,IYF)
         CALL ECROBJ(MTYPR,IPF)
         CALL ECROBJ(MTYPR,IVITF)
         CALL ECROBJ(MTYPR,IROF)
      ENDIF
C
 9999 CONTINUE
      END
 
 
 
 

© Cast3M 2003 - Tous droits réservés.
Mentions légales