pre12
C PRE12 SOURCE CB215821 19/07/31 21:16:17 10277 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) & ,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 PPARAM -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 IF(IRETOU.EQ.0.AND.TYPE.NE.'MMODEL')THEN WRITE(6,*)' On attend un objet MMODEL' RETURN ENDIF IF(IERR.NE.0)GOTO 9999 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' IF(IERR.NE.0)GOTO 9999 C C**** Lecture du MELEME 'FACE' C MTYPR = 'MAILLAGE' IF(IERR.NE.0)GOTO 9999 C C**** Lecture du MELEME 'FACEL' C MTYPR = 'MAILLAGE' 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 IF(IERR .NE. 0) GOTO 9999 JGN = 4 JGM = 2 SEGINI MLMVIT SEGSUP MLMVIT ELSE C Les normales et les tangentes MTYPR = ' ' IF (MTYPR .NE. 'CHPOINT ') THEN IF(IERR .NE. 0) GOTO 9999 ENDIF JGN = 4 JGM = 9 SEGINI 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 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 ' GOTO 9999 ELSE ICOND = 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 NOMTOT(1) = 'SCAL' IF(IERR .NE. 0)THEN IERR0 = IERR C C******* Message d'erreur standard C -301 0 %m1:40 C MOTERR(1:40) = 'CHPO1 = ??? ' GOTO 9999 ENDIF C C**** Lecture du CHPOINT GRADROC C ICOND = 1 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 ' GOTO 9999 ELSE ICOND = 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 = 2 -> on teste le noms des composantes C C NOMTOT(1) = ' ' obligatoire s'on connais pas les noms des composantes C NBCOMP = IDIM NOMTOT(1) = 'P1DX' NOMTOT(2) = 'P1DY' IF(IDIM .EQ. 3) NOMTOT(3) = 'P1DZ' IF(IERR .NE. 0)THEN IERR0 = IERR C C******* Message d'erreur standard C -301 0 %m1:40 C MOTERR(1:40) = 'CHPO2 = ??? ' GOTO 9999 ENDIF C C**** Lecture du CHPOINT IALROC C ICOND = 1 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 ' GOTO 9999 ELSE ICOND = 1 IF (IERR.NE.0) GOTO 9999 ENDIF C C**** Control du CHPOINT: QUEPOI C NOMTOT(1) = 'P1' IF(IERR .NE. 0)THEN IERR0 = IERR C C******* Message d'erreur standard C -301 0 %m1:40 C MOTERR(1:40) = 'CHPO3 = ??? ' GOTO 9999 ENDIF C C C**** Lecture du CHPOINT VITC C ICOND = 1 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 ' GOTO 9999 ELSE ICOND = 1 IF (IERR.NE.0) GOTO 9999 ENDIF C C**** Control du CHPOINT C NBCOMP = IDIM NOMTOT(1) = 'UX ' NOMTOT(2) = 'UY ' IF(IDIM .EQ. 3) NOMTOT(3) = 'UZ ' IF(IERR .NE. 0)THEN IERR0 = IERR C C******* Message d'erreur standard C -301 0 %m1:40 C MOTERR(1:40) = 'CHPO4 = ??? ' GOTO 9999 ENDIF C C**** Lecture du CHPOINT GRADVITC C ICOND = 1 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 ' GOTO 9999 ELSE ICOND = 1 IF (IERR.NE.0) GOTO 9999 ENDIF C C**** Control du CHPOINT: QUEPOI C IF(IDIM .EQ.2)THEN NOMTOT(1) = 'P1DX' NOMTOT(2) = 'P1DY' NOMTOT(3) = 'P2DX' NOMTOT(4) = 'P2DY' ELSE 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 IF(IERR .NE. 0)THEN IERR0 = IERR C C******* Message d'erreur standard C -301 0 %m1:40 C MOTERR(1:40) = 'CHPO5 = ??? ' GOTO 9999 ENDIF C C**** Lecture du CHPOINT IALVC C ICOND = 1 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 ' GOTO 9999 ELSE ICOND = 1 IF (IERR.NE.0) GOTO 9999 ENDIF C C**** Control du CHPOINT: QUEPOI C NBCOMP = IDIM NOMTOT(1) = 'P1' NOMTOT(2) = 'P2' IF(IDIM .EQ. 3) NOMTOT(3) = 'P3 ' IF(IERR .NE. 0)THEN IERR0 = IERR C C******* Message d'erreur standard C -301 0 %m1:40 C MOTERR(1:40) = 'CHPO6 = ??? ' GOTO 9999 ENDIF C C**** Lecture du CHPOINT PC C ICOND = 1 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 ' GOTO 9999 ELSE ICOND = 1 IF (IERR.NE.0) GOTO 9999 ENDIF C C**** Control du CHPOINT C NOMTOT(1) = 'SCAL' IF(IERR .NE. 0)THEN IERR0 = IERR C C******* Message d'erreur standard C -301 0 %m1:40 C MOTERR(1:40) = 'CHPO7 = ??? ' GOTO 9999 ENDIF C C**** Lecture du CHPOINT GRADPC C ICOND = 1 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 ' GOTO 9999 ELSE ICOND = 1 IF (IERR.NE.0) GOTO 9999 ENDIF C C**** Control du CHPOINT: QUEPOI C C NBCOMP = IDIM NOMTOT(1) = 'P1DX' NOMTOT(2) = 'P1DY' IF( IDIM .EQ. 3) NOMTOT(3) = 'P1DZ' IF(IERR .NE. 0)THEN IERR0 = IERR C C******* Message d'erreur standard C -301 0 %m1:40 C MOTERR(1:40) = 'CHPO8 = ??? ' GOTO 9999 ENDIF C C**** Lecture du CHPOINT IALPC C ICOND = 1 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 ' GOTO 9999 ELSE ICOND = 1 IF (IERR.NE.0) GOTO 9999 ENDIF C C**** Control du CHPOINT: QUEPOI C NOMTOT(1) = 'P1' IF(IERR .NE. 0)THEN IERR0 = IERR C C******* Message d'erreur standard C -301 0 %m1:40 C MOTERR(1:40) = 'CHPO9 = ??? ' GOTO 9999 ENDIF C C**** Lecture du CHPOINT GAMC C ICOND = 1 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 ' GOTO 9999 ELSE ICOND = 1 IF (IERR.NE.0) GOTO 9999 ENDIF C C**** Control du CHPOINT C NOMTOT(1) = 'SCAL' IF(IERR .NE. 0)THEN IERR0 = IERR C C******* Message d'erreur standard C -301 0 %m1:40 C MOTERR(1:40) = 'CHPO10 = ??? ' 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 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 & 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 & 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) C C******* Message d'erreur standard C 5 3 C Erreur anormale.contactez votre support C 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 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) GOTO 9999 ELSE C C******* Ecriture de ROF, VITF, PF C MTYPR = 'MCHAML ' ENDIF C 9999 CONTINUE END
© Cast3M 2003 - Tous droits réservés.
Mentions légales