Télécharger pre12f.eso

Retour à la liste

pre12f
C PRE12F    SOURCE    CB215821  19/07/31    21:16:18     10277          
      SUBROUTINE PRE12F()
C************************************************************************
C
C PROJET            :  CASTEM 2000
C
C NOM               :  PRE12F
C
C DESCRIPTION       :  Voir PRE2F
C
C                      1st order in space and time
C
C                      Creation of the objects MCHAML IALPHF, IUVF, IULF,
C                      IPF, ITVF, ITLF, IRVF, IRLF
C
C LANGAGE           :  FORTRAN 77 + ESOPE 2000 (avec extensions CISI)
C
C AUTEUR            :  A. BECCANTINI, DRN/DMT/SEMT/TTMF
C                      Modified for two-fluid flow by
C                      Jose R. Garcia Cascales
C
C************************************************************************
C
C
C APPELES (Outils)  :  LIRTAB, ACMO, LEKTAB, QUETYP, ERREUR, LIROBJ,
C                      QUEPOI, ECROBJ
C
C APPELES (Calcul)  :  PRE22F (2D), PRE32F (3D)
C
C
C************************************************************************
C
C HISTORIQUE (Anomalies et modifications éventuelles)
C
C HISTORIQUE :  Créée le 21/02/2002.
C
C************************************************************************
C
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
 
C
C**** Les variables
C
      INTEGER   ICOND,  IRETOU, IERR0, INDIC, NBCOMP,
     &          IDOMA, ICEN, IFACE, IFACEL, INORM,
     &          IALPH, IUVC, IULC, IPC, ITVC, ITLC, IRVC, IRLC,
     &          IALPHF, IUVF, IULF, IPF, ITVF, ITLF, IRVF, IRLF
      REAL*8 VALER, VAL1, VAL2
      CHARACTER*(4)  NOMTOT(3)
      CHARACTER*(8) MTYPR
      CHARACTER*(40) MESERR
      LOGICAL LOGAN,LOGNEG, LOGBOR
C
C**** Les Includes
C
 
-INC PPARAM
-INC CCOPTIO
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) = '    '
C
C**** Lecture de la TABLE domaine (IDOMA)
C
      ICOND = 1
      CALL LIRTAB('DOMAINE',IDOMA,ICOND,IRETOU)
      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
      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
 
C
      ENDIF
C
C
C**** Lecture du CHPOINT IALPH, VOID FRACTION
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,IALPH,ICOND,IRETOU)
         CALL ACTOBJ(MTYPR,IALPH,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(IALPH, 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 IUVC, VAPOUR VELOCITY
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('CHPOINT ',IUVC,ICOND,IRETOU)
         CALL ACTOBJ('CHPOINT ',IUVC,1)
         IF (IERR.NE.0) GOTO 9999
      ENDIF
C
C**** Control du CHPOINT
C
      INDIC = 1
      NBCOMP = IDIM
      NOMTOT(1) = 'UVX'
      NOMTOT(2) = 'UVY'
      IF(IDIM .EQ. 3) NOMTOT(3) = 'UVZ'
      CALL QUEPOI(IUVC, 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) = 'CHPO2 = ???    '
         CALL ERREUR(-301)
 
         GOTO 9999
      ENDIF
C
C**** Lecture du CHPOINT IULC, LIQUID VELOCITY
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('CHPOINT ',IULC,ICOND,IRETOU)
         CALL ACTOBJ('CHPOINT ',IULC,1)
         IF (IERR.NE.0) GOTO 9999
      ENDIF
C
C**** Control du CHPOINT
C
      INDIC = 1
      NBCOMP = IDIM
      NOMTOT(1) = 'ULX'
      NOMTOT(2) = 'ULY'
      IF(IDIM .EQ. 3) NOMTOT(3) = 'ULZ'
      CALL QUEPOI(IULC, 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**** Lecture du CHPOINT IPC, PRESSURE
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('CHPOINT',IPC,ICOND,IRETOU)
         CALL ACTOBJ('CHPOINT',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) = 'CHPO4 = ???    '
         CALL ERREUR(-301)
 
         GOTO 9999
      ENDIF
C
C**** Lecture du CHPOINT ITVC, VAPOUR TEMPERATURE
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('CHPOINT ',ITVC,ICOND,IRETOU)
         CALL ACTOBJ('CHPOINT ',ITVC,1)
         IF (IERR.NE.0) GOTO 9999
      ENDIF
C
C**** Control du CHPOINT
C
      INDIC = 1
      NBCOMP = 1
      NOMTOT(1) = 'SCAL'
      CALL QUEPOI(ITVC, 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) = 'CHPO5 = ???   '
         CALL ERREUR(-301)
 
         GOTO 9999
      ENDIF
C
C**** Lecture du CHPOINT ITLC, LIQUID TEMPERATURE
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('CHPOINT ',ITLC,ICOND,IRETOU)
         CALL ACTOBJ('CHPOINT ',ITLC,1)
         IF (IERR.NE.0) GOTO 9999
      ENDIF
C
C**** Control du CHPOINT
C
      INDIC = 1
      NBCOMP = 1
      NOMTOT(1) = 'SCAL'
      CALL QUEPOI(ITLC, 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) = 'CHPO6 = ???  '
         CALL ERREUR(-301)
 
         GOTO 9999
      ENDIF
C
C**** Lecture du CHPOINT IRVC, VAPOUR DENSITY
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,IRVC,ICOND,IRETOU)
         CALL ACTOBJ(MTYPR,IRVC,1)
         IF (IERR.NE.0) GOTO 9999
      ENDIF
 
      INDIC = 1
      NBCOMP = 1
      NOMTOT(1) = 'SCAL'
      CALL QUEPOI(IRVC, 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 IRLC, LIQUID DENSITY
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,IRLC,ICOND,IRETOU)
         CALL ACTOBJ(MTYPR,IRLC,1)
         IF (IERR.NE.0) GOTO 9999
      ENDIF
 
      INDIC = 1
      NBCOMP = 1
      NOMTOT(1) = 'SCAL'
      CALL QUEPOI(IRLC, 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) = 'CHPO8 = ???   '
         CALL ERREUR(-301)
         IERR = IERR0
         GOTO 9999
      ENDIF
C
C**** Centre -> Face
C
      IF(IDIM .EQ. 2)THEN
C
C******* Two Dimensions, 1st order in time and space
C
         CALL PRE22F(ICEN,IFACE,IFACEL,INORM,
     &               IALPH, IUVC, IULC, IPC, ITVC, ITLC, IRVC, IRLC,
     &               IALPHF, IUVF, IULF, IPF, ITVF, ITLF,
     &               IRVF, IRLF,
     &               LOGAN,LOGNEG,LOGBOR,MESERR,VALER,VAL1,VAL2)
      ELSE
C
C******* Three dimensions, 1st order in time and space
C
         CALL PRE32F(ICEN,IFACE,IFACEL,INORM,
     &               IALPH, IUVC, IULC, IPC, ITVC, ITLC, IRVC, IRLC,
     &               IALPHF, IUVF, IULF, IPF, ITVF, ITLF,
     &               IRVF, IRLF,
     &               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
C
         MTYPR = 'MCHAML  '
         CALL ACTOBJ(MTYPR, IALPHF,1)
         CALL ACTOBJ(MTYPR, IUVF,1)
         CALL ACTOBJ(MTYPR, IULF,1)
         CALL ACTOBJ(MTYPR, IPF,1)
         CALL ACTOBJ(MTYPR, ITVF,1)
         CALL ACTOBJ(MTYPR, ITLF,1)
         CALL ACTOBJ(MTYPR, IRVF,1)
         CALL ACTOBJ(MTYPR, IRLF,1)
 
         CALL ECROBJ(MTYPR, IALPHF)
         CALL ECROBJ(MTYPR, IUVF)
         CALL ECROBJ(MTYPR, IULF)
         CALL ECROBJ(MTYPR, IPF)
         CALL ECROBJ(MTYPR, ITVF)
         CALL ECROBJ(MTYPR, ITLF)
         CALL ECROBJ(MTYPR, IRVF)
         CALL ECROBJ(MTYPR, IRLF)
      ENDIF
C
 9999 CONTINUE
      END
 
 
 

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