C PRIM2F    SOURCE    CHAT      06/03/29    21:30:16     5360           
       SUBROUTINE PRIM2F()
C************************************************************************
C
C PROJET            :  CASTEM 2000
C
C NOM               :  PRIM 
C    
C LANGAGE           :  FORTRAN 77 + ESOPE 2000 (avec extensions CISI)
C      
C AUTEUR            :  Jose R. Garcia-Cascales, 
C                      Universidad Politecnica de Cartagena,
C                      jr.garcia@upct.es 
C
C************************************************************************
C
C
C APPELES (E/S)     : 
C     
C APPELES (Calcul)  : 
C
C************************************************************************
C
C PHRASE D'APPEL (GIBIANE) :
C
C**** Variables de COOPTIO
C
      INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR
     &        ,IOTER,   IOLEC,  IOIMP,     IOCAR,  IOACQ
     &        ,IOPER,   IOSGB,  IOGRA,     IOSAU,  IORES
     &        ,IECHO,   IIMPI,  IOSPI
     &        ,IDIM,    IFICLE, IPREFI 
     &        ,MCOORD      
     &        ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE
     &        ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU
     &        ,NORINC,NORVAL,NORIND,NORVAD
     &        ,NUCROU, IPSAUV
C
C**** Les variables
C
      INTEGER ICOND, IRETOU, INDIC, NBCOMP, IERR0,
     &       ICEN, ICH1, ICH2, ICH3,
     &       ICH4, ICH5, ICH6, ICH7,
     &       ICH8, ICH9,
     &       OCH1, OCH2, OCH3,
     &       OCH4, OCH5, OCH6,
     &       OCH7, OCH8, OCH9,
     &       JGN, JGM
      REAL*8 VALER(2),VAL1,VAL2, Cp, Cvm
      CHARACTER*(40) MESERR(2),MESCEL
      CHARACTER*(6) NOMTRI
      LOGICAL LOGNEG, LOGBOR, LOGTRI
C     
C**** Les Includes
C
-INC CCOPTIO
-INC SMCHPOI
-INC SMLMOTS
C
C**** Initialisation des parametres d'erreur
C
      LOGNEG  = .FALSE.
      LOGBOR  = .FALSE.
      LOGTRI = .FALSE.
      MESCEL = '                                        '
      MESERR(1) = MESCEL
      MESERR(2) = MESCEL
      MOTERR(1:40) = MESCEL
      VALER(1) = 0.0D0
      VALER(2) = 0.0D0
      VAL1 = 0.0D0
      VAL2 = 0.0D0
C      
C**** Lecture du CHPOINT ICH1
C
      ICOND = 1
      CALL LIROBJ('CHPOINT',ICH1,ICOND,IRETOU)
      IF (IERR.NE.0) GOTO 9999
C
C**** On cherche le pointeur de son maillage et on l'impose sur les
C     autres CHPOINT
C
      MCHPOI = ICH1
      SEGACT MCHPOI
      MSOUPO = MCHPOI.IPCHP(1)
      SEGACT MSOUPO
      ICEN = MSOUPO.IGEOC
      SEGDES MSOUPO
      SEGDES MCHPOI
C
C**** On recupere en QUEPO1 MLMOTS
C
      JGN = 4
      JGM = 1
      SEGINI MLMOTS
      MLMOTS.MOTS(1) = 'SCAL'
      CALL QUEPO1(ICH1, ICEN, MLMOTS)
C
      IF(IERR .NE. 0)THEN
         IERR0 = IERR

C
C******** Message d'erreur standard
C        -301 0 %m1:40
C
         MOTERR = 'CHPO1 = ???                             '
         WRITE(IOIMP,*) MOTERR(1:40)         

         GOTO 9999
      ENDIF  
      SEGSUP MLMOTS
C      
C**** Lecture du CHPOINT ICH2
C
      ICOND = 1
      CALL LIROBJ('CHPOINT',ICH2,ICOND,IRETOU)
      IF (IERR.NE.0) GOTO 9999
C
C**** Control du CHPOINT ICH2
C
      JGN = 4
      JGM = 1
      SEGINI MLMOTS
      MLMOTS.MOTS(1) = 'SCAL'
      CALL QUEPO1(ICH2, ICEN, MLMOTS)
      IF(IERR .NE. 0)THEN
         IERR0 = IERR

C
C******** Message d'erreur standard
C        -301 0 %m1:40
C
         MOTERR  = 'CHPO2 = ???                             '
         WRITE(IOIMP,*) MOTERR(1:40)         

         GOTO 9999
      ENDIF  
      SEGSUP MLMOTS
C      
C**** Lecture du CHPOINT ICH3
C
      ICOND = 1
      CALL LIROBJ('CHPOINT',ICH3,ICOND,IRETOU)
      IF (IERR.NE.0) GOTO 9999
C
C**** Control du CHPOINT ICH3
C     
      JGN = 4
      JGM = IDIM
      SEGINI MLMOTS
      MLMOTS.MOTS(1) = 'UVX'
      MLMOTS.MOTS(2) = 'UVY'
      IF(IDIM .EQ. 3) MLMOTS.MOTS(3) = 'UVZ'
      CALL QUEPO1(ICH3, ICEN, MLMOTS)
      IF(IERR .NE. 0)THEN
         IERR0 = IERR

C
C******** Message d'erreur standard
C        -301 0 %m1:40
C
         MOTERR  = 'CHPO3 = ???                             '

         GOTO 9999
      ENDIF  
      SEGSUP MLMOTS
C      
C**** Lecture du CHPOINT ICH4
C
      ICOND = 1
      CALL LIROBJ('CHPOINT',ICH4,ICOND,IRETOU)
      IF (IERR.NE.0) GOTO 9999
C
C**** Control du CHPOINT ICH4
C     
      JGN = 4
      JGM = IDIM
      SEGINI MLMOTS
      MLMOTS.MOTS(1) = 'ULX'
      MLMOTS.MOTS(2) = 'ULY'
      IF(IDIM .EQ. 3) MLMOTS.MOTS(3) = 'ULZ'
      CALL QUEPO1(ICH4, ICEN, MLMOTS)
      IF(IERR .NE. 0)THEN
         IERR0 = IERR

C
C******** Message d'erreur standard
C        -301 0 %m1:40
C
         MOTERR  = 'CHPO4 = ???                             '
         WRITE(IOIMP,*) MOTERR(1:40)         

         GOTO 9999
      ENDIF  
      SEGSUP MLMOTS
C      
C**** Lecture du CHPOINT ICH5
C
      ICOND = 1
      CALL LIROBJ('CHPOINT',ICH5,ICOND,IRETOU)
      IF (IERR.NE.0) GOTO 9999
C
C**** Control du CHPOINT ICH5
C     
      JGN = 4
      JGM = 1
      SEGINI MLMOTS
      MLMOTS.MOTS(1) = 'SCAL'
      CALL QUEPO1(ICH5, ICEN, MLMOTS)
      IF(IERR .NE. 0)THEN
         IERR0 = IERR

C
C******** Message d'erreur standard
C        -301 0 %m1:40
C
         MOTERR  = 'CHPO5 = ???                             '
         WRITE(IOIMP,*) MOTERR(1:40)         

         GOTO 9999
      ENDIF  
      SEGSUP MLMOTS
C      
C**** Lecture du CHPOINT ICH6
C
      ICOND = 1
      CALL LIROBJ('CHPOINT',ICH6,ICOND,IRETOU)
      IF (IERR.NE.0) GOTO 9999
C
C**** Control du CHPOINT ICH6
C     
      JGN = 4
      JGM = 1
      SEGINI MLMOTS
      MLMOTS.MOTS(1) = 'SCAL'
      CALL QUEPO1(ICH6, ICEN, MLMOTS)
      IF(IERR .NE. 0)THEN
         IERR0 = IERR

C
C******** Message d'erreur standard
C        -301 0 %m1:40
C
         MOTERR  = 'CHPO6 = ???                             '
         WRITE(IOIMP,*) MOTERR(1:40)         

         GOTO 9999
      ENDIF  
      SEGSUP MLMOTS
C      
C**** Lecture du CHPOINT ICH7
C
      ICOND = 1
      CALL LIROBJ('CHPOINT',ICH7,ICOND,IRETOU)
      IF (IERR.NE.0) GOTO 9999
C
C**** Control du CHPOINT ICH7
C
      JGN = 4
      JGM = 1
      SEGINI MLMOTS
      MLMOTS.MOTS(1) = 'SCAL'
      CALL QUEPO1(ICH7, ICEN, MLMOTS)
      IF(IERR .NE. 0)THEN
         IERR0 = IERR

C
C******** Message d'erreur standard
C        -301 0 %m1:40
C
         MOTERR  = 'CHPO7 = ???                             '
         WRITE(IOIMP,*) MOTERR(1:40)         

         GOTO 9999
      ENDIF  
      SEGSUP MLMOTS
C      
C**** Lecture du CHPOINT ICH8
C
      ICOND = 1
      CALL LIROBJ('CHPOINT',ICH8,ICOND,IRETOU)
      IF (IERR.NE.0) GOTO 9999
C
C**** Control du CHPOINT ICH8
C
      JGN = 4
      JGM = 1
      SEGINI MLMOTS
      MLMOTS.MOTS(1) = 'SCAL'
      CALL QUEPO1(ICH8, ICEN, MLMOTS)
      IF(IERR .NE. 0)THEN
         IERR0 = IERR

C
C******** Message d'erreur standard
C        -301 0 %m1:40
C
         MOTERR  = 'CHPO8 = ???                             '
         WRITE(IOIMP,*) MOTERR(1:40)         

         GOTO 9999
      ENDIF  
      SEGSUP MLMOTS
C      
C**** Lecture du CHPOINT ICH9
C
      ICOND = 1
      CALL LIROBJ('CHPOINT',ICH9,ICOND,IRETOU)
      IF (IERR.NE.0) GOTO 9999
C
C**** Control du CHPOINT ICH9
C
      JGN = 4
      JGM = 1
      SEGINI MLMOTS
      MLMOTS.MOTS(1) = 'SCAL'
      CALL QUEPO1(ICH9, ICEN, MLMOTS)
      IF(IERR .NE. 0)THEN
         IERR0 = IERR

C
C******** Message d'erreur standard
C        -301 0 %m1:40
C
         MOTERR  = 'CHPO9 = ???                             '
         WRITE(IOIMP,*) MOTERR(1:40)         

         GOTO 9999
      ENDIF  
      SEGSUP MLMOTS
C 
C     Lecture of the CATHARE pressure correction term 
C     parameters
C
      ICOND = 1
      CALL LIRREE(Cp,ICOND,IRETOU)
      IF(IERR .NE. 0) GOTO 9999
      IF((Cp .LT. 0) .OR. (Cp .GT. 7.d0))THEN
C
C******* Message d'erreur standard
C        -301 0 %m1:40
C
         MOTERR(1:40) = 'Cp = ???                           '
         CALL ERREUR(-301)
C
C******* Message d'erreur standard
C        Entier valant: %i1
C        -2 0
C
C         INTERR(1) = Cp
      ENDIF

      ICOND = 1
      CALL LIRREE(Cvm,ICOND,IRETOU)
      IF(IERR .NE. 0) GOTO 9999
      IF((Cvm .LT. 0) .OR. (Cvm .GT. 7.d0))THEN
C
C******* Message d'erreur standard
C        -301 0 %m1:40
C
         MOTERR(1:40) = 'Cvm = ???                          '
         CALL ERREUR(-301)
C
C******* Message d'erreur standard
C        Entier valant: %i1
C        -2 0
C
C         INTERR(1) = Cvm
      ENDIF
C
C
C**** Calcul des sorties.
C
      CALL PR12f(ICEN, ICH1, ICH2, ICH3,
     &           ICH4, ICH5, ICH6, ICH7,
     &           ICH8, ICH9,
     &           Cp, Cvm,
     &           OCH1, OCH2, OCH3,
     &           OCH4, OCH5, OCH6,
     &           OCH7, OCH8, OCH9,
     &           LOGNEG, LOGBOR, MESERR,
     &           VALER, VAL1, VAL2)
C
      IERR0 = 0
      IF(LOGNEG)THEN
C
C******* Pression (energie thermique)  ou densité negative
C
C******* Message d'erreur standard
C        41 2
C        %m1:8 = %r1 inférieur à %r2
C
         MESCEL = MESERR(1)
         MOTERR(1:8) = MESCEL(1:8)
         REAERR(1) = REAL(VALER(1))
         REAERR(2) = 0.0
         CALL ERREUR(41)
         IF(LOGTRI)THEN
*            IERR = 0
         ELSE
            GOTO 9999
         ENDIF
      ENDIF
      IF(LOGBOR)THEN
C      
C******* Message d'erreur standard
C        42 2
C        %m1:8 = %r1 non compris entre %r2 et %r3
C
         MESCEL = MESERR(2)
         MOTERR(1:8) = MESCEL(1:8)
         REAERR(1) = REAL(VALER(2))
         REAERR(2) = REAL(VAL1)
         REAERR(3) = REAL(VAL2)
         CALL ERREUR(42)
         IF(LOGTRI)THEN
*            IERR = 0
         ELSE
            GOTO 9999
         ENDIF
      ENDIF
C
C**** Ecriture du CHPOINT contenant la SUMA
C
      CALL ECROBJ('CHPOINT', OCH1)
      CALL ECROBJ('CHPOINT', OCH2)
      CALL ECROBJ('CHPOINT', OCH3)
      CALL ECROBJ('CHPOINT', OCH4)
      CALL ECROBJ('CHPOINT', OCH5)
      CALL ECROBJ('CHPOINT', OCH6)
      CALL ECROBJ('CHPOINT', OCH7)
      CALL ECROBJ('CHPOINT', OCH8)
      CALL ECROBJ('CHPOINT', OCH9)
C    
C
 9999 CONTINUE
C      
      RETURN                                                                    
      END