Télécharger pre32.eso

Retour à la liste

pre32
C PRE32     SOURCE    OF166741  24/12/13    21:17:05     12097          
      SUBROUTINE PRE32(ORDTEM)
C************************************************************************
C
C PROJET            :  CASTEM 2000
C
C NOM               :  PRE32
C
C DESCRIPTION       :  Voir PRE3
C
C                      Gaz "thermally perfect" , mono/multi-especes.
C
C                      2me ordre en espace (1er ou 2me ordre en temps)
C
C                      Creations des object MCHAML IROF, IVITF, IPF,
C                      IYF, ISCAF
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, QUEPO1, ECROBJ
C
C APPELES (Calcul)  :  PRE321 (2D),  PRE322 (3D)
C
C************************************************************************
C
C HISTORIQUE (Anomalies et modifications éventuelles)
C
C HISTORIQUE :  Créée le 18.12.98.
C
C               17.02.2000: transport des scalaires passifs
C
C************************************************************************
C
C**** Les variables
C
      IMPLICIT INTEGER(I-N)
      INTEGER   ORDTEM, ICOND,  IRETOU, IERR0
     &     ,IDOMA, ICEN, IFACE, IFACEL, INORM
     &     ,IROC, IGRROC, IALROC
     &     ,IVITC, IGRVC, IALVC
     &     ,IPC ,IGRPC, IALPC
     &     ,IGAMC, IROF, IVITF, IPF
     &     ,IPGAS, NESP, NSCA
     &     ,IYC, IGRYC, IALYC, IYF
     &     ,ISCAC, IGRSC, IALSC, ISCAF
     &     , I1, I2, ICEL, ICOM, INEFMD
     &     ,MMODEL
      REAL*8 VALER, VAL1, VAL2, DELTAT
      CHARACTER*(4)  NOMGRA(27),NOMLIM(9)
      CHARACTER*(8) MTYPR, TYPE
      CHARACTER*(40) MESERR
      LOGICAL LOGAN,LOGNEG, LOGBOR,LOGTEM
     &        ,LGAMC,LSCAC,LYC
C
C**** Les Includes
C
 
-INC PPARAM
-INC CCOPTIO
      INTEGER JGM, JGN
-INC SMLMOTS
      POINTEUR MLMCOM.MLMOTS, MLMESP.MLMOTS, MLMSCA.MLMOTS
      POINTEUR MLMVIT.MLMOTS
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**** 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**** 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 (tangentes)  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
C**** Lecture de la table des proprietes du gaz
C
C     Cette table a ete deja controlle dans l'operateur PRIM;
C     donc on la controlle pas ici
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**** Les especes qui sont dans les Equations d'Euler
C
      MTYPR = '        '
      CALL ACMO(IPGAS,'ESPEULE',MTYPR,MLMESP)
      IF(MTYPR .EQ. '        ')THEN
         NESP = 0
         IYC = 0
         IGRYC = 0
         IALYC = 0
      ELSEIF(MTYPR .NE. 'LISTMOTS')THEN
C
C******* Message d'erreur standard
C        -301 0 %m1:40
C
         MOTERR(1:40) = 'TAB2 . ESPEULE = ???                    '
         WRITE(IOIMP,*) MOTERR
C
C******* Message d'erreur standard
C        21 2
C        Données incompatibles
C
         CALL ERREUR(21)
         GOTO 9999
      ELSE
         SEGACT MLMESP
         NESP = MLMESP.MOTS(/2)
         SEGDES MLMESP
      ENDIF
C
C**** Les scalaires passifs
C
      MTYPR = '        '
      CALL ACMO(IPGAS,'SCALPASS',MTYPR,MLMSCA)
      IF(MTYPR .EQ. '        ')THEN
         NSCA = 0
         ISCAC = 0
      ELSEIF(MTYPR .NE. 'LISTMOTS')THEN
C
C******* Message d'erreur standard
C        -301 0 %m1:40
C
         MOTERR(1:40) = 'TAB2 . SCALPASS = ???                   '
         WRITE(IOIMP,*) MOTERR
C
C******* Message d'erreur standard
C        21 2
C        Données incompatibles
C
         CALL ERREUR(21)
         GOTO 9999
      ELSE
         SEGACT MLMSCA
         NSCA = MLMSCA.MOTS(/2)
         SEGDES MLMSCA
      ENDIF
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: QUEPO1
C
      JGN=4
      JGM=1
      SEGINI MLMCOM
      MLMCOM.MOTS(1)='SCAL'
      CALL QUEPO1(IROC, 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)  = 'CHPO1 = ???                             '
         WRITE(IOIMP,*) MOTERR
 
         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: QUEPO1
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 = ???                             '
         WRITE(IOIMP,*) MOTERR
 
         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: QUEPO1
C
      JGN=4
      JGM=1
      SEGINI MLMCOM
      MLMCOM.MOTS(1)= 'P1  '
      CALL QUEPO1(IALROC, 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)  = 'CHPO3 = ???                             '
         WRITE(IOIMP,*) MOTERR
 
         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 = ???                             '
         WRITE(IOIMP,*) MOTERR
 
         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: QUEPO1
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 = ???                             '
         WRITE(IOIMP,*) MOTERR
 
         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: QUEPO1
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 = ???                             '
         WRITE(IOIMP,*) MOTERR
 
         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
      JGN=4
      JGM=1
      SEGINI MLMCOM
      MLMCOM.MOTS(1)='SCAL'
      CALL QUEPO1(IPC, 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)  = 'CHPO7 = ???                             '
         WRITE(IOIMP,*) MOTERR
 
         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: QUEPO1
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 = ???                             '
         WRITE(IOIMP,*) MOTERR
 
         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: QUEPO1
C
      JGN=4
      JGM=1
      SEGINI MLMCOM
      MLMCOM.MOTS(1)= 'P1  '
      CALL QUEPO1(IALPC, 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)  = 'CHPO9 = ???                             '
         WRITE(IOIMP,*) MOTERR
 
         GOTO 9999
      ENDIF
C
C**** Lecture du CHPOINT YC
C
      IF(NESP .EQ. 0)THEN
         LYC = .FALSE.
      ELSEIF(NESP .GT. 0)THEN
         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
            LYC=.TRUE.
         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 = ???                            '
            WRITE(IOIMP,*) MOTERR
 
            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: QUEPO1
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 = ???                            '
            WRITE(IOIMP,*) MOTERR
 
            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: QUEPO1
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 = ???                            '
            WRITE(IOIMP,*) MOTERR
 
            GOTO 9999
         ENDIF
      ENDIF
C
C**** Lecture du CHPOINT ISCAC
C
      IF(NSCA .EQ. 0)THEN
         LSCAC=.FALSE.
      ELSEIF(NSCA .GT. 0)THEN
         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,ISCAC,ICOND,IRETOU)
            CALL ACTOBJ(MTYPR,ISCAC,1)
            IF (IERR.NE.0) GOTO 9999
            LSCAC=.TRUE.
         ENDIF
C
C**** Control du CHPOINT
C
         CALL QUEPO1(ISCAC, ICEN, MLMSCA)
         IF(IERR .NE. 0)THEN
            IERR0 = IERR
 
C
C******* Message d'erreur standard
C        -301 0 %m1:40
C
            MOTERR(1:40)  = 'CHPO13 = ???                            '
            WRITE(IOIMP,*) MOTERR
 
            GOTO 9999
         ENDIF
C
C**** Lecture du CHPOINT GRADSC
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,IGRSC,ICOND,IRETOU)
            CALL ACTOBJ(MTYPR,IGRSC,1)
            IF (IERR.NE.0) GOTO 9999
         ENDIF
C
C**** Control du CHPOINT: QUEPO1
C
         JGN=4
         JGM=IDIM*NSCA
         SEGINI MLMCOM
C        NSCA < 10
         IF(NSCA .GE. 10)THEN
            WRITE(IOIMP,*) 'NSCA >= 10!'
C
C******* Message d'erreur standard
C        21 2
C        Données incompatibles
C
            CALL ERREUR(21)
            GOTO 9999
         ENDIF
         ICEL = 0
         DO I1 =  1, NSCA, 1
            DO I2 = 1, IDIM
               ICEL = ICEL + 1
               ICOM = 3 * (I1 -1) + I2
               MLMCOM.MOTS(ICEL) = NOMGRA(ICOM)
            ENDDO
         ENDDO
         CALL QUEPO1(IGRSC, 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)  = 'CHPO14 = ???                            '
            WRITE(IOIMP,*) MOTERR
 
            GOTO 9999
         ENDIF
C
C**** Lecture du CHPOINT IALSC
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,IALSC,ICOND,IRETOU)
            CALL ACTOBJ(MTYPR,IALSC,1)
            IF (IERR.NE.0) GOTO 9999
         ENDIF
C
C**** Control du CHPOINT: QUEPO1
C
         JGN = 4
         JGM = NSCA
         SEGINI MLMCOM
         DO I1 = 1, NSCA, 1
            MLMCOM.MOTS(I1)=NOMLIM(I1)
         ENDDO
         CALL QUEPO1(IALSC, 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)  = 'CHPO15 = ???                            '
            WRITE(IOIMP,*) MOTERR
 
            GOTO 9999
         ENDIF
      ENDIF
      IF(ORDTEM .EQ. 1)THEN
         LOGTEM = .FALSE.
         DELTAT = 0.0D0
         IGAMC = 0
         LGAMC=.FALSE.
      ELSE
C
C**** Lecture du CHPOINT GAMC (dans le cas 2-eme ordre en temps)
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
            LGAMC=.TRUE.
         ENDIF
C
C**** Control du CHPOINT
C
         JGN=4
         JGM=1
         SEGINI MLMCOM
         MLMCOM.MOTS(1)= 'SCAL'
         CALL QUEPO1(IGAMC, 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)  = 'CHPO16 = ???                            '
            WRITE(IOIMP,*) MOTERR
 
            GOTO 9999
         ENDIF
         LOGTEM = .TRUE.
         ICOND = 1
         CALL LIRREE(DELTAT,ICOND,IRETOU)
         IF(IERR .NE. 0)GOTO 9999
      ENDIF
C
C**** Centre -> Face
C
      IF(IDIM .EQ. 2)THEN
C
C******* Deux Dimensions, Mono/Multi Especes, 2-eme ordre en espace, 1er/2-eme ordre en
C        temps
C
         CALL PRE321(LOGTEM,LGAMC,LYC,LSCAC,
     &        ICEN,IFACE,IFACEL,INORM,
     &        IROC, IGRROC, IALROC,
     &        IVITC, IGRVC, IALVC,
     &        IPC ,IGRPC, IALPC,
     &        IYC ,IGRYC, IALYC,
     &        ISCAC ,IGRSC, IALSC,
     &        IGAMC,
     &        DELTAT,
     &        IROF,IVITF,IPF,IYF,ISCAF,
     &        LOGAN,LOGNEG,LOGBOR,MESERR,VALER,VAL1,VAL2)
      ELSE
C
C******* Trois Dimensions, Mono/Multi Especes, 1er ordre en espace, 1er ordre en
C        temps
C
         CALL PRE322(LOGTEM,LGAMC,LYC,LSCAC,
     &        ICEN,IFACE,IFACEL,INORM,
     &        IROC, IGRROC, IALROC,
     &        IVITC, IGRVC, IALVC,
     &        IPC ,IGRPC, IALPC,
     &        IYC ,IGRYC, IALYC,
     &        ISCAC ,IGRSC, IALSC,
     &        IGAMC,
     &        DELTAT,
     &        IROF,IVITF,IPF,IYF,ISCAF,
     &        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)
         WRITE(IOIMP,*) MOTERR
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 (si existe)
C
         MTYPR = 'MCHAML  '
         IF(ISCAF .NE. 0) THEN
           CALL ACTOBJ(MTYPR,ISCAF,1)
           CALL ECROBJ(MTYPR,ISCAF)
         ENDIF
         IF(IYF   .NE. 0) THEN
           CALL ACTOBJ(MTYPR,IYF,1)
           CALL ECROBJ(MTYPR,IYF)
         ENDIF
         CALL ACTOBJ(MTYPR,IPF,1)
         CALL ACTOBJ(MTYPR,IVITF,1)
         CALL ACTOBJ(MTYPR,IROF,1)
 
         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