C PRE11 SOURCE CB215821 19/07/31 21:16:16 10277 SUBROUTINE PRE11() C************************************************************************ C C PROJET : CASTEM 2000 C C NOM : PRE11 C C DESCRIPTION : Voir PRE1 C C Cas gaz parfait monoespece C C 1er ordre en espace, 1er ordre en temps C C Creations des object MCHAML IROF, IVITF, IPF, C IGAMF 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 QUEPOI, ECROBJ C C APPELES (Calcul) : PRE111 (2D) C C C************************************************************************ C C HISTORIQUE (Anomalies et modifications éventuelles) C C HISTORIQUE : Créée le 11.6.98. C C************************************************************************ C C C**** Variables de COOPTIO C C INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR C & ,IOTER, IOLEC, IOIMP, IOCAR, IOACQ C & ,IOPER, IOSGB, IOGRA, IOSAU, IORES C & ,IECHO, IIMPI, IOSPI C & ,IDIM C & ,MCOORD C & ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE C & ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU C & ,NORINC,NORVAL,NORIND,NORVAD C & ,NUCROU, IPSAUV, IFICLE, IPREFI C C**** Les variables C IMPLICIT INTEGER(I-N) INTEGER ICOND, IRETOU, IERR0, INDIC, NBCOMP & ,IDOMA, ICEN, IFACE, IFACEL, INORM, IROC, IVITC, IPC & ,IGAMC, IROF, IVITF, IPF, IGAMF, JGN, JGM, INEFMD & ,MMODEL REAL*8 VALER, VAL1, VAL2 CHARACTER*(4) NOMTOT(3) CHARACTER*(8) MTYPR, TYPE CHARACTER*(40) MESERR LOGICAL LOGAN,LOGNEG, LOGBOR C C**** Les Includes C -INC PPARAM -INC CCOPTIO -INC SMLMOTS POINTEUR MLMVIT.MLMOTS 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 l'objet MODELE C ICOND = 1 CALL QUETYP(TYPE,ICOND,IRETOU) IF(IRETOU.EQ.0.AND.TYPE.NE.'MMODEL')THEN WRITE(6,*)' On attend un objet MMODEL' RETURN ENDIF 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 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 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) IF(IRETOU .EQ. 1) CALL ACTOBJ(MTYPR,IROC,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(IROC, 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 = ??? ' WRITE(IOIMP,*) MOTERR GOTO 9999 ENDIF 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('CHPOINT ',IVITC,ICOND,IRETOU) CALL ACTOBJ('CHPOINT ',IVITC,1) IF (IERR.NE.0) GOTO 9999 ENDIF C C**** Control du CHPOINT C JGN = 4 JGM = IDIM SEGINI MLMVIT MLMVIT.MOTS(1) = 'UX ' MLMVIT.MOTS(2) = 'UY ' IF(IDIM .EQ. 3) MLMVIT.MOTS(3) = 'UZ ' CALL QUEPO1(IVITC, ICEN, MLMVIT) SEGSUP MLMVIT 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 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('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) = 'CHPO3 = ??? ' WRITE(IOIMP,*) MOTERR GOTO 9999 ENDIF C C**** Lecture du CHPOINT GAMC 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',IGAMC,ICOND,IRETOU) CALL ACTOBJ('CHPOINT',IGAMC,1) IF (IERR.NE.0) GOTO 9999 ENDIF C C**** Control du CHPOINT C INDIC = 1 NBCOMP = 1 NOMTOT(1) = 'SCAL' CALL QUEPOI(IGAMC, 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 = ??? ' WRITE(IOIMP,*) MOTERR GOTO 9999 ENDIF C C**** Centre -> Face C IF(IDIM .EQ. 2)THEN C C******* Deux Dimensions, Une Espece, 1er ordre en espace, 1er ordre en C temps C CALL PRE111(ICEN,IFACE,IFACEL,INORM,IROC,IVITC,IPC,IGAMC, & IROF,IVITF,IPF,IGAMF, & LOGAN,LOGNEG,LOGBOR,MESERR,VALER,VAL1,VAL2) ELSE C C******* Trois Dimensions, Une Espece, 1er ordre en espace, 1er ordre en C temps C C CALL PRE112(ICEN,IFACE,IFACEL,INORM,IROC,IVITC,IPC,IGAMC, & IROF,IVITF,IPF,IGAMF, & 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 C MTYPR = 'MCHAML' CALL ECROBJ(MTYPR,IGAMF) CALL ECROBJ(MTYPR,IPF) CALL ECROBJ(MTYPR,IVITF) CALL ECROBJ(MTYPR,IROF) ENDIF C 9999 CONTINUE C RETURN END