C PRIM2F SOURCE CB215821 20/11/25 13:36:54 10792 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 IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) C C**** Les variables C INTEGER ICOND, IRETOU, INDIC, NBCOMP, & 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 PPARAM -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) CALL ACTOBJ('CHPOINT ',ICH1,1) 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 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) CALL ACTOBJ('CHPOINT ',ICH2,1) 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 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) CALL ACTOBJ('CHPOINT',ICH3,1) 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 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) CALL ACTOBJ('CHPOINT',ICH4,1) 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 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) CALL ACTOBJ('CHPOINT',ICH5,1) 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 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) CALL ACTOBJ('CHPOINT',ICH6,1) 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 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) CALL ACTOBJ('CHPOINT',ICH7,1) 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 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) CALL ACTOBJ('CHPOINT',ICH8,1) 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 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) CALL ACTOBJ('CHPOINT',ICH9,1) 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 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 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 ACTOBJ('CHPOINT ', OCH1,1) CALL ACTOBJ('CHPOINT ', OCH2,1) CALL ACTOBJ('CHPOINT ', OCH3,1) CALL ACTOBJ('CHPOINT ', OCH4,1) CALL ACTOBJ('CHPOINT ', OCH5,1) CALL ACTOBJ('CHPOINT ', OCH6,1) CALL ACTOBJ('CHPOINT ', OCH7,1) CALL ACTOBJ('CHPOINT ', OCH8,1) CALL ACTOBJ('CHPOINT ', OCH9,1) 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 9999 CONTINUE END