Télécharger ecoule.eso

Retour à la liste

ecoule
C ECOULE    SOURCE    JB251061  23/05/10    21:15:09     11667          
      SUBROUTINE ECOULE
*---------------------------------------------------------------------
*                    ECOULEMENT  INELASTIQUE
*---------------------------------------------------------------------
*
*    SYNTAXE  POUR LES LOIS VISCO (IND=1) :
*
*    SIGF VARF DEPIN = 'ECOU' MODL SIG0 VAR0  DEPST
*                      CARAC  ( PRECIS ) LATAB ( MOALIR )       ;
*
*    SYNTAXE POUR LES LOIS PLASTIQUES (IND=2):
*
*    SIGF VARF DEPIN = 'ECOU'  MODL SIG0 VAR0 DEPST   CARAC
*                                   ( PRECIS ) ( ISTEP )     ;
*  MMODEL     |    MODL    OBJET MODELE
*
*             |    SIG0    CONTRAINTES AU DEBUT DU PAS
*             |    VAR0    VARIABLES INTERNES AU DEBUT DU PAS
*  MCHAML     |    DEPST   INCREMENT DE DEFORMATIONS TOTALES
*             |    CARAC   CONSTANTES DU MATERIAU  ET CARACTERISTIQUES
*             |            GEOMETRIQUES ( SELON LES ELEMENTS )
*  FLOTTANT   |    PRECIS  PRECISION POUR ITERATIONS INTERNES
*  TABLE      |    LATAB   TABLE CONTENANT D'AUTRES INFOS
*  MOT        |    MOALIR  MOT A LIRE
*  ISTEP      |    INDICATEUR D'ACTION POUR CALCUL NONLOCAL
*             |    =0 DANS LE CAS D'UN CALCUL LOCAL (NORMAL)
*             |    =1 OU 2 DANS LE CAS D'UN CALCUL NONLOCAL
*             |    =1 POUR CALCUL DES FONCTIONS SEUIL UNIQUEMENT
*             |    =2 POUR CALCUL DES VARIABLES DISSIPATIVES A PARTIR
*             |       DES FONCTIONS SEUIL MOYENNEES PREALABLEMENT PAR NLOC
*
*
*
*             |    SIGF    CONTRAINTES A LA FIN DU PAS
*  MCHAML     |    VARF    VARIABLES INTERNES A LA FIN DU PAS
*             |    DEPIN   INCREMENT DE DEFORMATIONS INELASTIQUES
*
*    Passage aux nouveaux CHAMELEM par P DOWLATYARI DEC 91
*---------------------------------------------------------------------
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
-INC PPARAM
-INC CCOPTIO
-INC SMCHAML
-INC SMCHPOI
*
       CHARACTER*10 MOALIR
       CHARACTER*8  TYPOBJ
       CHARACTER*4  MOTSUC
       CHARACTER*72 CHARRE
       LOGICAL LOGIN,LOGRE,LOGSUC
       REAL*8  XVALIN,XVALRE
       IOBRE =0
       IPCHE1=0
       IPCHE2=0
       IPCHE3=0
       IPCHE4=0
       IPCHE6=0
       IPCH1 =0
       IPCH2 =0
       IPCH3 =0
c mistral :
       IPCH4 =0
       IPCH5 =0
c mistral.
       ITHHER=0
       IPOI1 =0
       IPOI2 =0
       IPOI3 =0
c mistral :
       IPOI4=0
       IPOI5=0
c mistral.
       IPCAR=0
       IPTAB=0
       TYPOBJ='        '
       LOGSUC=.TRUE.
*
*     LECTURE D'UN MODEL
*
      CALL LIROBJ('MMODEL  ',IPMODL,1,IRT1)
      CALL ACTOBJ('MMODEL  ',IPMODL,1)
      IF(IERR.NE.0)RETURN
*
*  CHAMPS DE CONTRAINTES
*
          CALL LIROBJ('MCHAML  ',IPIN,1,IRT)
          CALL ACTOBJ('MCHAML  ',IPIN,1)
          IF(IERR.NE.0)RETURN
          CALL REDUAF(IPIN,IPMODL,IPCHE1,0,IR,KER)
          IF(IR   .NE. 1) CALL ERREUR(KER)
          IF(IERR .NE. 0) RETURN
 
          MCHELM=IPCHE1
          SEGACT MCHELM
          IF(TITCHE.NE.'CONTRAINTES')THEN
            MOTERR(1:32)='CONTRAIN'
            CALL ERREUR(565)
            RETURN
          ENDIF
*
*  CHAMPS DE VARIABLES INTERNES
*
          CALL LIROBJ('MCHAML  ',IPIN,1,IRT)
          CALL ACTOBJ('MCHAML  ',IPIN,1)
          IF(IERR.NE.0)RETURN
          CALL REDUAF(IPIN,IPMODL,IPCHE2,0,IR,KER)
          IF(IR   .NE. 1) CALL ERREUR(KER)
          IF(IERR .NE. 0) RETURN
 
          MCHELM=IPCHE2
          SEGACT MCHELM
          IF(TITCHE.NE.'VARIABLES INTERNES')THEN
            MOTERR(1:32)='VARINTER'
            CALL ERREUR(565)
            RETURN
          ENDIF
*
*  CHAMPS D'INCREMENTS DE DEFORMATIONS
*
          CALL LIROBJ('MCHAML  ',IPIN,1,IRT)
          CALL ACTOBJ('MCHAML  ',IPIN,1)
          IF(IERR.NE.0)RETURN
          CALL REDUAF(IPIN,IPMODL,IPCHE4,0,IR,KER)
          IF(IR   .NE. 1) CALL ERREUR(KER)
          IF(IERR .NE. 0) RETURN
 
          MCHELM=IPCHE4
          SEGACT MCHELM
          IF(TITCHE.NE.'DEFORMATIONS')THEN
            MOTERR(1:32)='DEFORMAT'
            CALL ERREUR(565)
            RETURN
          ENDIF
*
*  CHAMPS DE CARACTERISTIQUES (MATERIELLES ET GEOMETRIQUES)
*
          CALL LIROBJ('MCHAML  ',IPIN,1,IRT)
          CALL ACTOBJ('MCHAML  ',IPIN,1)
          IF(IERR.NE.0)RETURN
          CALL REDUAF(IPIN,IPMODL,IPCAR,0,IR,KER)
          IF(IR   .NE. 1) CALL ERREUR(KER)
          IF(IERR .NE. 0) RETURN
 
          MCHELM=IPCAR
          SEGACT MCHELM
          IF(TITCHE.NE.'CARACTERISTIQUES')THEN
             MOTERR(1:32)='CARACTER'
             CALL ERREUR(565)
             RETURN
          ENDIF
*
*         LECTURE D'UNE TABLE DE DONNEES SUPPLEMENTAIRE
*
          CALL LIROBJ('TABLE   ',IPTAB,0,IRETOU)
          IF(IERR.NE.0) RETURN
          IF(IRETOU.EQ.1)THEN
*
*     RECHERCHE DU CHAMPS DE DEFORMATIONS INELASTIQUES INITIALES
*
           CALL ACCTAB(IPTAB,'MOT     ',IVALIN,XVALIN,'DEFI',
     .     LOGIN,IOBIN,TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,
     .     IPCHE3)
           IF(TYPOBJ.EQ.'MCHAML  ') THEN
             MCHELM=IPCHE3
             SEGACT MCHELM
             IF(TITCHE.NE.'DEFORMATIONS INELASTIQUES')THEN
                MOTERR(1:32)='DEFINELA'
                CALL ERREUR(565)
                RETURN
             ENDIF
           ENDIF
 
*
*     RECHERCHE DU CHAMPS DE DEFORMATIONS TOTALES INITIALES
*
           CALL ACCTAB(IPTAB,'MOT     ',IVALIN,XVALIN,'DEFT',
     .     LOGIN,IOBIN,TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,
     .     IPCHE6)
           IF(TYPOBJ.EQ.'MCHAML  ') THEN
             MCHELM=IPCHE6
             SEGACT MCHELM
             IF(TITCHE.NE.'DEFORMATIONS')THEN
                MOTERR(1:32)='DEFORMAT'
                CALL ERREUR(565)
                RETURN
             ENDIF
           ENDIF
 
          ENDIF
C
C  LECTURE EVENTUELLE DE LA PRECISION DES ITERATION INTERNES
C
      CALL LIRREE(PRECIS,0,IRETPR)
      IF(IRETPR.EQ.0) PRECIS=REAL(1.D-3)
*
*  LECTURE EVENTUELLE D'UN MOT SOIT  POUR ACTION DANS ECOULE
*                              SOIT  POUR NE PAS AVOIR DE
*                                    MESSAGE D'ERREUR (NOID)
*
      JECHER=0
      JNOID=0
      CALL LIRCHA(MOALIR,0,IRETOU)
      IF(IRETOU.NE.0) THEN
         IF(MOALIR.EQ.'AVANCER') THEN
           JECHER = 0
      ELSE IF (MOALIR.EQ.'RECHERCHER') THEN
           JECHER=1
      ELSE IF (MOALIR(1:4).EQ.'NOID') THEN
           JNOID=1
      ELSE
           CALL REFUS
      ENDIF
      ENDIF
C
C     LECTURE EVENTUELLE DU STEP D'EXCUTION POUR LE NON LOCAL
C
      CALL LIRENT(ISTEP,0,IRETOU)
      IF (IRETOU .EQ. 0) THEN
         ISTEP=0
      END IF
C
C  LECTURE EVENTUELLE D'UN MOT QUI INDIQUE QUE LE MATERIAU VA DEPENDRE
C  DE LA TEMPERATURE POUR LES MODELES ENDOMMAGES DE LEMAITRE
C  ON LIT DANS LA TABLE LES CHAMPS (MCHAML OU CHPOINT) DE TEMPERATURE
C  AU DEBUT ET A LA FIN DU PAS ET DE REFERENCE. ILS SONT CONVERTIS EN
C  MCHAML AUX POINTS DE GAUSS POUR LES CONTRAINTES
C
      IFI=0
      CALL LIRCHA(MOALIR,0,IRETOU)
      IF(IRETOU.NE.0) THEN
         IF (MOALIR.EQ.'CELSIUS') THEN
                                           ITHHER = 2
         ELSE IF (MOALIR.EQ.'KELVIN') THEN
                                           ITHHER = 1
         ELSE IF (MOALIR.EQ.'SUCCION') THEN
                                           ITHHER = 3
c mistral :
         ELSE IF (MOALIR.EQ.'MISTRAL') THEN
                                           ITHHER = 2
                                           IFI = 1
c mistral.
         ELSE
                                           CALL REFUS
         ENDIF
*
         IF(ITHHER.NE.0) THEN
*
           TYPOBJ='        '
           MOTSUC='TET1'
           IF(ITHHER.EQ.3) THEN
             TYPOBJ='CHPOINT '
             MOTSUC='SUC1'
           ENDIF
           CALL ACCTAB(IPTAB,'MOT     ',IVALIN,XVALIN,MOTSUC,
     .     LOGIN,IOBIN,TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,
     .     IPOI1)
           IF(TYPOBJ.EQ.'CHPOINT ') THEN
                         CALL CHAME1(0,IPMODL,IPOI1,' ',IPCH1,5)
                         IF (IERR.NE.0) RETURN
           ELSE
                         CALL CHASUP(IPMODL,IPOI1,IPCH1,IRT2,5)
                         IF(IRT2.NE.0) THEN
                                           CALL ERREUR(IRT2)
                                           RETURN
                         ENDIF
           ENDIF
C
           TYPOBJ='        '
           MOTSUC='TET2'
           IF(ITHHER.EQ.3) THEN
             TYPOBJ='CHPOINT '
             MOTSUC='SUC2'
           ENDIF
           CALL ACCTAB(IPTAB,'MOT     ',IVALIN,XVALIN,MOTSUC,
     .     LOGIN,IOBIN,TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,
     .     IPOI2)
           IF(TYPOBJ.EQ.'CHPOINT ') THEN
                         CALL CHAME1(0,IPMODL,IPOI2,' ',IPCH2,5)
                         IF (IERR.NE.0) RETURN
           ELSE
                         CALL CHASUP(IPMODL,IPOI2,IPCH2,IRT2,5)
                         IF(IRT2.NE.0) THEN
                                           CALL ERREUR(IRT2)
                                           RETURN
                         ENDIF
           ENDIF
C
           IF(ITHHER.LT.3) THEN
             TYPOBJ='        '
             CALL ACCTAB(IPTAB,'MOT     ',IVALIN,XVALIN,
     .       'TEMPERATURE_REFERENCE',LOGIN,IOBIN,TYPOBJ,IVALRE,
     .       XVALRE,CHARRE,LOGRE,IPOI3)
             IF(TYPOBJ.EQ.'CHPOINT ') THEN
                         CALL CHAME1(0,IPMODL,IPOI3,' ',IPCH3,5)
                         IF (IERR.NE.0) RETURN
             ELSE
                         CALL CHASUP(IPMODL,IPOI3,IPCH3,IRT2,5)
                         IF(IRT2.NE.0) THEN
                                           CALL ERREUR(IRT2)
                                           RETURN
                         ENDIF
             ENDIF
           ENDIF
         ENDIF
      ENDIF
*
c mistral :
      IF(IFI.EQ.1) THEN
*     -----------------
           TYPOBJ='        '
           MOTSUC='PHI1'
           CALL ACCTAB(IPTAB,'MOT     ',IVALIN,XVALIN,MOTSUC,
     .     LOGIN,IOBIN,TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,
     .     IPOI4)
           IF(TYPOBJ.EQ.'CHPOINT ') THEN
                         CALL CHAME1(0,IPMODL,IPOI4,' ',IPCH4,5)
                         IF (IERR.NE.0) RETURN
           ELSE
                         CALL CHASUP(IPMODL,IPOI4,IPCH4,IRT2,5)
                         IF(IRT2.NE.0) THEN
                                           CALL ERREUR(IRT2)
                                           RETURN
                         ENDIF
           ENDIF
*
           TYPOBJ='        '
           MOTSUC='PHI2'
           CALL ACCTAB(IPTAB,'MOT     ',IVALIN,XVALIN,MOTSUC,
     .     LOGIN,IOBIN,TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,
     .     IPOI5)
           IF(TYPOBJ.EQ.'CHPOINT ') THEN
                         CALL CHAME1(0,IPMODL,IPOI5,' ',IPCH5,5)
                         IF (IERR.NE.0) RETURN
           ELSE
                         CALL CHASUP(IPMODL,IPOI5,IPCH5,IRT2,5)
                         IF(IRT2.NE.0) THEN
                                           CALL ERREUR(IRT2)
                                           RETURN
                         ENDIF
           ENDIF
      ENDIF
*     -----
c mistral.
*
*
      CALL ECOUL1(IPMODL,IPCHE1,IPCHE2,IPCHE3,IPCHE4,IPCHE6,IPCAR,
     &      IPCH1,IPCH2,IPCH3,IPCH4,IPCH5,ITHHER,IFI,PRECIS,IPTAB,
     &      JECHER,ISTEP,JNOID,LOGSUC,IPCHE7,IPCHE8,IPCHE9)
*
      IF(IERR.EQ.0)THEN
          CALL ACTOBJ('MCHAML  ',IPCHE9,1)
          CALL ACTOBJ('MCHAML  ',IPCHE8,1)
          CALL ACTOBJ('MCHAML  ',IPCHE7,1)
          CALL ECROBJ('MCHAML  ',IPCHE9)
          CALL ECROBJ('MCHAML  ',IPCHE8)
          CALL ECROBJ('MCHAML  ',IPCHE7)
*
*   SI JNOID = 1 : ON RENSEIGNE L'INDICE 'SUCCES' DANS LA TABLE
*
          IF(JNOID.EQ.1.AND.IPTAB.NE.0) THEN
            CALL ECCTAB(IPTAB,'MOT     ',IVALIN,XVALIN,'SUCCES',
     .             LOGIN,IOBIN,'LOGIQUE ',IVALRE,XVALRE,CHARRE,
     .             LOGSUC,IOBRE)
          ENDIF
      ENDIF
 
      END
 
 
 
 
 
 
 

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