Sources Esope | Cast3M

cotra3
C COTRA3    SOURCE    BP208322  17/03/01    21:16:39     9325           
      SUBROUTINE COTRA3(KERRE,NSTRS,CMATE,WTRAV,N2EL,N2PTEL,
     1            MFR,IFOU,IB,IGAU,EPAIST,MELE,NPINT,NBGMAT,
     2        NBPGAU,NELMAT,SECT,LHOOK,CRIGI,NMATT,WRK0,WRK1)
C
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
C
 
-INC PPARAM
-INC CCOPTIO
-INC SMEVOLL
-INC SMLREEL
-INC SMCOORD
******************************************************************
*           RECUPERATION DES LOIS DE COMPORTEMENT POUR           *
*                LES ELEMENTS GLOBAUX                            *
******************************************************************
* ENTREES :
* WRK0 SEGMENT DE TRAVAIL CONTENANT LES CARACTERISTIQUES
* MATERIAUX
* WRK1 SEGMENT DE TRAVAIL CONTENANT LES EFFORTS, LES DEPLACEMENTS
* ET LA MATRICE DE HOOK
* NMATT  =NOMBRE DE COMPOSANTES DE PROPRIETES DE MATERIAU
* WTRAV SEGMENT DE TRAVAIL CONTENANT LES TABLEAUX UTILISES POUR
* LE CALCUL DE LA MATRICE DE HOOKE ELASTIQUE (SS-PROGRAMME CALSIG)
*
* N2EL  = NBRE D ELEMENTS DANS SEGMENT DE HOOKE
* N2PTEL= NBRE DE POINTS DANS SEGMENT DE HOOKE
* MFR   = NUMERO DE LA FORMULATION
* IFOU  = OPTION DE CALCUL
* IB    = NUMERO DE L ELEMENT COURANT
* IGAU  = NUMERO DU POINT COURANT
* EPAIST= EPAISSEUR
* NBPGAU= NBRE DE POINTS DE GAUSS
* MELE  = NUMERO DE L ELEMENT FINI
* NPINT = NBRE DE POINTS D INTEGRATION
* NBGMAT= NBRE DE POINTS DANS SEGMENT DE CARACTERISTIQUES
* NELMAT= NBRE D ELEMENTS DANS SEGMENT DE CARACTERISTIQUES
* SECT  = SECTION
* LHOOK = TAILLE DE LA MATRICE DE HOOKE
*
* SORTIES :
* KERRE INDICATEUR D'ERREUR
*
* VARIABLES INTERNES CREES
* INDLEG CODAGE DES LOIS CONTENUES DANS L'ELEMENT GLOBAL
* WRKGL SEGMENT CONTENANT LES LOIS DE COMPORTEMENT RETENUES
* (3 AU MAXIMUM)
* IPWRKGL SEGMENTS DE POINTEURS SUR LES LOIS DE COMPORTEMENT
*
*****************************************************************
*
      SEGMENT WRK0
       REAL*8 XMAT(NCXMAT)
      ENDSEGMENT
*
      SEGMENT WRK1
        REAL*8 DDHOOK(LHOOK,LHOOK),SIG0(NSTRS),DEPST(NSTRS)
        REAL*8 SIGF(NSTRS),VAR0(NVARI),VARF(NVARI)
        REAL*8 DEFP(NSTRS),XCAR(ICARA)
      ENDSEGMENT
*
      SEGMENT WRKGL
        REAL*8 TLOICO(NBLOI)
      ENDSEGMENT
*
      SEGMENT IPWRKGL
        POINTEUR IPOL(3).WRKGL
      ENDSEGMENT
*
      SEGMENT WTRAV
        REAL*8 DDAUX(LHOOK,LHOOK),VALMAT(NUMAT)
        REAL*8 VALCAR(NUCAR),DSIGT(NSTRS)
        REAL*8 TXR(IDIM,IDIM),DDHOMU(LHOOK,LHOOK)
        REAL*8 XLOC(3,3),XGLOB(3,3)
        REAL*8 D1HOOK(LHOOK,LHOOK),ROTHOO(LHOOK,LHOOK)
      ENDSEGMENT
*
      DIMENSION CRIGI(*)
*
      CHARACTER*8 CMATE
*
       SEGINI IPWRKGL
*
*     QUELQUES INITIALISATIONS A 0
*
       KERRE=0
       INDLEG = 0
       NRLEGI = 0
*
*     RECUPERATION DES LOIS
*
       DO 50 IJ = 1,5
          IF(IJ.EQ.1)IJOJO = 7
          IF(IJ.EQ.2)IJOJO = 8
          IF(IJ.EQ.3)IJOJO = 9
          IF(IJ.EQ.4)IJOJO = 3
          IF(IJ.EQ.5)IJOJO = 4
*
*  RECHERCHE DES POINTEURS NON NULS DE XMAT
*
          IBOU = XMAT(IJOJO)
          IF(IBOU.EQ.0) GO TO 50
*
*  CODAGE DES TYPES DE LOIS RENTREES
*
          IF(IJ.EQ.1) INDLEG = 1
*
          IF(IJ.EQ.2) INDLEG = INDLEG + 10
*
          IF(IJ.EQ.3)THEN
             IF(INDLEG.LT.10)THEN
                INDLEG = INDLEG + 20
             ELSE
                MOTERR(5:12) = 'FLXYFLXZ'
                KERRE = 57
             END IF
          END IF
*
          IF(IJ.EQ.4) INDLEG = INDLEG + 100
*
          IF(IJ.EQ.5)THEN
             IF(INDLEG.LT.100)THEN
                INDLEG = INDLEG + 200
             ELSE
                MOTERR(5:12) = 'CISYCISZ'
                KERRE = 57
             END IF
          END IF
*
*RECUPERATION DES EVOLUTIONS RENTREES DANS MATE
*
          MEVOLL=nint(XMAT(IJOJO))
          IF(MEVOLL.NE.0) THEN
             SEGACT MEVOLL
             JOJO = IEVOLL(/1)
*
             IF(JOJO.NE.1)THEN
                KERRE=31
                SEGDES MEVOLL
                SEGSUP IPWRKGL
                RETURN
             END IF
*
             KEVOLL=IEVOLL(1)
             SEGACT KEVOLL
             MLREEL=IPROGX
             MLREE1=IPROGY
             SEGDES KEVOLL
             SEGACT MLREEL,MLREE1
             NBPOIX=PROG(/1)
             NBPOIY=MLREE1.PROG(/1)
*
* TEST SUR LA TAILLE DES LOIS RENTREES
*
             IF(NBPOIX.NE.NBPOIY) KERRE=58
             IF (IJ.EQ.1)THEN
               IF((NBPOIX.NE.4).and.(nbpoix.ne.6))KERRE=58
             ELSE
               IF((NBPOIX.NE.5).and.(nbpoix.ne.7))KERRE=58
             ENDIF
*
* RETRANSCRIPTION DES LOIS DE COMPORTEMENT DANS WRKGL
*
             IF(KERRE.NE.0) THEN
                SEGDES MLREEL,MLREE1
                SEGDES MEVOLL
                GO TO 777
             END IF
*
             NRLEGI = NRLEGI + 1
             NBLOI = 2 * NBPOIX
             SEGINI WRKGL
             IPOL(NRLEGI) = WRKGL
                DO 10 I=1,NBPOIX
                   PEPS=PROG(I)
                   PSIG=MLREE1.PROG(I)
                   TLOICO((2*I)-1) = PSIG
                   TLOICO(2*I) = PEPS
10              CONTINUE
              SEGDES  MLREEL, MLREE1
         END IF
50     CONTINUE
*
       IF(NRLEGI.EQ.0)THEN
          KERRE = 59
          RETURN
       END IF
*
       SEGDES MEVOLL
C
777    CONTINUE
C
C UTILISATION DES LOIS DE COMPORTEMENT
C
           IF(KERRE.EQ.0) THEN
           CALL DDIS(NSTRS,CMATE,N2EL,N2PTEL,WTRAV,MFR,IFOU,IB,
     1   IGAU,EPAIST,MELE,NPINT,NBPGAU,NBGMAT,NELMAT,SECT,LHOOK,
     2         CRIGI,NMATT,INDLEG,IPWRKGL,WRKGL,WRK0,WRK1,KERRE)
C
C DESACTIVATION DES SEGMENTS TEMPORAIRES WRKGL ET IPWRKGL
C
                    DO 800 I=1,NRLEGI
                      SEGSUP IPOL(I)
800                 CONTINUE
           ENDIF
C
       SEGSUP IPWRKGL
C
       RETURN
 
       END