C PRE12 SOURCE CHAT 06/08/24 21:58:46 5529 SUBROUTINE PRE12(ORDTEM) C************************************************************************ C C PROJET : CASTEM 2000 C C NOM : PRE12 C C DESCRIPTION : Voir PRE1 C C Gas gaz ideal, mono espece. C C 2me ordre en espace (1er ou 2me 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 C APPELES (Calcul) : PRE121 (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 ORDTEM, ICOND, IRETOU, IERR0, INDIC, NBCOMP & ,IDOMA, ICEN, IFACE, IFACEL, INORM & ,IROC, IGRROC, IALROC & ,IVITC, IGRVC, IALVC & ,IPC ,IGRPC, IALPC & ,IGAMC, IROF, IVITF, IPF, IGAMF, INEFMD, JGN, JGM & ,MMODEL REAL*8 VALER, VAL1, VAL2, DELTAT CHARACTER*(4) NOMTOT(9) CHARACTER*(8) MTYPR, TYPE CHARACTER*(40) MESERR LOGICAL LOGAN,LOGNEG, LOGBOR,LOGTEM C C**** Les Includes C -INC CCOPTIO -INC SMLMOTS POINTEUR MLMVIT.MLMOTS C 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) = ' ' NOMTOT(4) = ' ' NOMTOT(5) = ' ' NOMTOT(6) = ' ' NOMTOT(7) = ' ' NOMTOT(8) = ' ' NOMTOT(9) = ' ' 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) 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 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**** N.B. On veut lire les objets sequentiellement. C Donc on utilise QUETYP pour controler que C le type de l'objet soit le bon. 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(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 = ??? ' CALL ERREUR(-301) GOTO 9999 ENDIF C C**** Lecture du CHPOINT GRADROC 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,IGRROC,ICOND,IRETOU) 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 = 2 -> on teste le noms des composantes C C NOMTOT(1) = ' ' obligatoire s'on connais pas les noms des composantes C INDIC = 1 NBCOMP = IDIM NOMTOT(1) = 'P1DX' NOMTOT(2) = 'P1DY' IF(IDIM .EQ. 3) NOMTOT(3) = 'P1DZ' CALL QUEPOI(IGRROC, 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 IALROC 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,IALROC,ICOND,IRETOU) IF (IERR.NE.0) GOTO 9999 ENDIF C C**** Control du CHPOINT: QUEPOI C INDIC = 1 NBCOMP = 1 NOMTOT(1) = 'P1' CALL QUEPOI(IALROC, 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 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(MTYPR,IVITC,ICOND,IRETOU) IF (IERR.NE.0) GOTO 9999 ENDIF C C**** Control du CHPOINT C INDIC = 1 NBCOMP = IDIM NOMTOT(1) = 'UX ' NOMTOT(2) = 'UY ' IF(IDIM .EQ. 3) NOMTOT(3) = 'UZ ' CALL QUEPOI(IVITC, 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 GRADVITC 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,IGRVC,ICOND,IRETOU) IF (IERR.NE.0) GOTO 9999 ENDIF C C**** Control du CHPOINT: QUEPOI C INDIC = 1 IF(IDIM .EQ.2)THEN NBCOMP = 4 NOMTOT(1) = 'P1DX' NOMTOT(2) = 'P1DY' NOMTOT(3) = 'P2DX' NOMTOT(4) = 'P2DY' ELSE NBCOMP = 9 NOMTOT(1) = 'P1DX' NOMTOT(2) = 'P1DY' NOMTOT(3) = 'P1DZ' NOMTOT(4) = 'P2DX' NOMTOT(5) = 'P2DY' NOMTOT(6) = 'P2DZ' NOMTOT(7) = 'P3DX' NOMTOT(8) = 'P3DY' NOMTOT(9) = 'P3DZ' ENDIF CALL QUEPOI(IGRVC, 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 IALVC 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,IALVC,ICOND,IRETOU) IF (IERR.NE.0) GOTO 9999 ENDIF C C**** Control du CHPOINT: QUEPOI C INDIC = 1 NBCOMP = IDIM NOMTOT(1) = 'P1' NOMTOT(2) = 'P2' IF(IDIM .EQ. 3) NOMTOT(3) = 'P3 ' CALL QUEPOI(IALVC, 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 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(MTYPR,IPC,ICOND,IRETOU) 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) = 'CHPO7 = ??? ' CALL ERREUR(-301) GOTO 9999 ENDIF C C**** Lecture du CHPOINT GRADPC 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,IGRPC,ICOND,IRETOU) IF (IERR.NE.0) GOTO 9999 ENDIF C C**** Control du CHPOINT: QUEPOI C C INDIC = 1 NBCOMP = IDIM NOMTOT(1) = 'P1DX' NOMTOT(2) = 'P1DY' IF( IDIM .EQ. 3) NOMTOT(3) = 'P1DZ' CALL QUEPOI(IGRPC, 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) GOTO 9999 ENDIF C C**** Lecture du CHPOINT IALPC 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,IALPC,ICOND,IRETOU) IF (IERR.NE.0) GOTO 9999 ENDIF C C**** Control du CHPOINT: QUEPOI C INDIC = 1 NBCOMP = 1 NOMTOT(1) = 'P1' CALL QUEPOI(IALPC, 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) = 'CHPO9 = ??? ' CALL ERREUR(-301) 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(MTYPR,IGAMC,ICOND,IRETOU) 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) = 'CHPO10 = ??? ' CALL ERREUR(-301) GOTO 9999 ENDIF IF(ORDTEM .EQ. 1)THEN C C******* Deux Dimensions, Une Espece, 2er ordre en espace, 1er ordre en C temps C LOGTEM = .FALSE. DELTAT = 0.0D0 ELSE LOGTEM = .TRUE. ICOND = 1 CALL LIRREE(DELTAT,ICOND,IRETOU) IF(IERR .NE. 0)GOTO 9999 ENDIF IF(IDIM .EQ. 2)THEN C C******* Deux Dimensions, Une Espece, 1er ordre en espace, 1er ordre en C temps C CALL PRE121(LOGTEM, & ICEN,IFACE,IFACEL,INORM, & IROC, IGRROC, IALROC, & IVITC, IGRVC, IALVC, & IPC ,IGRPC, IALPC, & IGAMC, & DELTAT, & 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 CALL PRE122(LOGTEM, & ICEN,IFACE,IFACEL,INORM, & IROC, IGRROC, IALROC, & IVITC, IGRVC, IALVC, & IPC ,IGRPC, IALPC, & IGAMC, & DELTAT, & IROF,IVITF,IPF,IGAMF, & LOGAN,LOGNEG,LOGBOR,MESERR,VALER,VAL1,VAL2) ENDIF C 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 ECROBJ(MTYPR,IGAMF) CALL ECROBJ(MTYPR,IPF) CALL ECROBJ(MTYPR,IVITF) CALL ECROBJ(MTYPR,IROF) ENDIF C 9999 CONTINUE C RETURN END