Télécharger ccotr3.eso

Retour à la liste

ccotr3
C CCOTR3    SOURCE    OF166741  25/11/04    21:15:12     12349          
 
      SUBROUTINE CCOTR3(WRK52,WRK53,WRK54,IFOUL,IB,IGAU,iecou)
 
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
 
-INC PPARAM
-INC CCOPTIO
 
-INC SMEVOLL
-INC SMLREEL
-INC SMCOORD
 
-INC DECHE
-INC TECOU
******************************************************************
* IFOUL = 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)
* IPWKGL SEGMENTS DE POINTEURS SUR LES LOIS DE COMPORTEMENT
*****************************************************************
 
      SEGMENT WRKGL
        REAL*8 TLOICO(NBLOI)
      ENDSEGMENT
 
      SEGMENT IPWKGL
        POINTEUR IPOL(3).WRKGL
      ENDSEGMENT
*
*     QUELQUES INITIALISATIONS A 0
*
      kerl   = 0
      INDLEG = 0
      NRLEGI = 0
 
      SEGINI IPWKGL
*
*     RECUPERATION DES LOIS
*
      IDECAL = 1
 
      DO 50 IJ = 1, 5
*
*  RECHERCHE DES POINTEURS NON NULS DE XMAT
*
        IF      (IJ.EQ.1) THEN
          IJO = 7+IDECAL
        ELSE IF (IJ.EQ.2) THEN
          IJO = 8+IDECAL
        ELSE IF (IJ.EQ.3) THEN
          IJO = 9+IDECAL
        ELSE IF (IJ.EQ.4) THEN
          IJO = 3
        ELSE IF (IJ.EQ.5) THEN
          IJO = 4
        END IF
 
        MEVOLL=nint(XMAT(IJO))
        IF (MEVOLL.EQ.0) GOTO 50
*
*  RECUPERATION DES EVOLUTIONS RENTREES DANS MATE
*
        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'
            kerl = 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'
            kerl = 57
            GOTO 999
          END IF
        END IF
 
        SEGACT MEVOLL
        JOJO = IEVOLL(/1)
        IF (JOJO.NE.1) THEN
          kerl = 31
          WRITE(ioimp,*) ' KERRE=31'
          GOTO 999
        END IF
 
        KEVOLL=IEVOLL(1)
        SEGACT KEVOLL
        MLREEL=IPROGX
        MLREE1=IPROGY
        SEGDES KEVOLL
        SEGACT MLREEL,MLREE1
        NBPOIX=mlreel.PROG(/1)
        NBPOIY=MLREE1.PROG(/1)
*
* TEST SUR LA TAILLE DES LOIS RENTREES
*
        IF (NBPOIX.NE.NBPOIY) THEN
          kerl = 58
        ELSE
          IF (IJ.EQ.1) THEN
            IF ((NBPOIX.NE.4).and.(nbpoix.ne.6)) kerl = 58
          ELSE
            IF ((NBPOIX.NE.5).and.(nbpoix.ne.7)) kerl = 58
          ENDIF
        ENDIF
 
        IF (kerl.NE.0) THEN
          SEGDES,MLREEL,MLREE1
          GOTO 999
        END IF
*
* RETRANSCRIPTION DES LOIS DE COMPORTEMENT DANS WRKGL
*
        NRLEGI = NRLEGI + 1
        NBLOI = 2 * NBPOIX
        SEGINI WRKGL
        IPWKGL.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
        kerl = 59
        GOTO 999
      END IF
C
C UTILISATION DES LOIS DE COMPORTEMENT
C
      nbgmab = iecou.nbgmat
      nlmatb = iecou.nelmat
      mfr1bi = iecou.mfr1
      nstrbi = iecou.nstrss
      nbpgau = wrk53.nbgs
c*??      nbpgau = nbgmab
      CALL CDDIS(WRK52,WRK53,WRK54,NSTRbi,MFR1bi,IFOUL,IB,
     &           IGAU,NBPGAU,NBGMAb,NLMATb,INDLEG,IPWKGL)
C
C SUPPRESSION DES SEGMENTS TEMPORAIRES WRKGL ET IPWKGL
C
 999  CONTINUE
      wrk53.KERRE = kerl
      DO I = 1, NRLEGI
        SEGSUP,IPWKGL.IPOL(I)
      ENDDO
      SEGSUP,IPWKGL
 
c*//      SEGDES,MEVOLL
 
      RETURN
      END
 
 
 

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