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