Sources Esope | Cast3M

cotra3
C COTRA3    SOURCE    OF166741  25/09/30    21:15:07     12371          
 
      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)
 
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
 
-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*(*) CMATE
*
*     QUELQUES INITIALISATIONS A 0
*
      KERRE=0
      NRLEGI = 0
      SEGINI,IPWRKGL
      INDLEG = 0
*
*     RECUPERATION DES LOIS
*
      DO 50 IJ = 1,5
 
*  RECHERCHE DES POINTEURS NON NULS DE XMAT
        IF (IJ.EQ.1) THEN
          IJOJO = 7
        ELSE IF (IJ.EQ.2) THEN
          IJOJO = 8
        ELSE IF (IJ.EQ.3) THEN
          IJOJO = 9
        ELSE IF (IJ.EQ.4) THEN
          IJOJO = 3
        ELSE IF (IJ.EQ.5) THEN
          IJOJO = 4
        END IF
 
        MEVOLL = nint(XMAT(IJOJO))
        IF (MEVOLL.EQ.0) GO TO 50
 
*  CODAGE DES TYPES DE LOIS RENTREES
        IF (IJ.EQ.1) THEN
          INDLEG = 1
        ELSE IF (IJ.EQ.2) THEN
          INDLEG = INDLEG + 10
        ELSE IF (IJ.EQ.3) THEN
          IF (INDLEG.LT.10) THEN
            INDLEG = INDLEG + 20
          ELSE
            MOTERR(5:12) = 'FLXYFLXZ'
            KERRE = 57
            GOTO 999
          END IF
        ELSE IF (IJ.EQ.4) THEN
          INDLEG = INDLEG + 100
        ELSE IF (IJ.EQ.5) THEN
          IF (INDLEG.LT.100) THEN
            INDLEG = INDLEG + 200
          ELSE
            MOTERR(5:12) = 'CISYCISZ'
            KERRE = 57
            GOTO 999
          END IF
        END IF
 
*  RECUPERATION DES EVOLUTIONS RENTREES DANS MATE
 
        SEGACT,MEVOLL
        JOJO = mevoll.IEVOLL(/1)
        IF (JOJO.NE.1) THEN
          KERRE=31
          GOTO 999
        END IF
        KEVOLL=IEVOLL(1)
        SEGACT,KEVOLL
        MLREEL = kevoll.IPROGX
        MLREE1 = kevoll.IPROGY
        SEGDES,MEVOLL,KEVOLL
 
        SEGACT,MLREEL,MLREE1
        NBPOIX = MLREEL.PROG(/1)
        NBPOIY = MLREE1.PROG(/1)
*
* TEST SUR LA TAILLE DES LOIS RENTREES
*
        IF (NBPOIX.NE.NBPOIY) THEN
          KERRE=58
        ELSE
          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
        ENDIF
        IF (KERRE.NE.0) THEN
          SEGDES MLREEL,MLREE1
          GOTO 999
        ENDIF
*
* RETRANSCRIPTION DES LOIS DE COMPORTEMENT DANS WRKGL
*
        NRLEGI = NRLEGI + 1
        NBLOI = 2 * NBPOIX
        SEGINI WRKGL
        IPOL(NRLEGI) = WRKGL
        DO I = 1, NBPOIX
          TLOICO((2*I)-1) = MLREE1.PROG(I)
          TLOICO(2*I) = MLREEL.PROG(I)
        ENDDO
        SEGDES,MLREEL,MLREE1
 
50    CONTINUE
*
      IF (NRLEGI.EQ.0) THEN
        KERRE = 59
        GOTO 999
      END IF
C
C UTILISATION DES LOIS DE COMPORTEMENT
C
      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
 999  CONTINUE
      DO I=1,NRLEGI
c*      IF (IPOL(I).NE.0) SEGSUP,IPOL(I)
        SEGSUP,IPOL(I)
      ENDDO
      SEGSUP IPWRKGL
 
      RETURN
      END