Télécharger la plaquette Cast3M


fr en

Télécharger ccotr3.eso

Retour à la liste

Numérotation des lignes : 

ccotr3

  1. C CCOTR3    SOURCE    PV        17/12/08    21:15:27     9660           
  2.       SUBROUTINE CCOTR3(WRK52,WRK53,WRK54,
  3.      1            IFOU,IB,IGAU,NBGMAT,iecou)
  4. C COTRA3    SOURCE    AM1       95/03/16    21:18:49     1567
  5. c      SUBROUTINE COTRA3(KERRE,NSTRS,CMATE,WTRAV,N2EL,N2PTEL,
  6. c     1            MFR,IFOU,IB,IGAU,EPAIST,MELE,NPINT,NBGMAT,
  7. c     2        NBPGAU,NELMAT,SECT,LHOOK,CRIGI,NMATT,WRK0,WRK1)
  8. C
  9.       IMPLICIT INTEGER(I-N)
  10.       IMPLICIT REAL*8(A-H,O-Z)
  11. C
  12.  
  13. -INC PPARAM
  14. -INC CCOPTIO
  15. -INC SMEVOLL
  16. -INC SMLREEL
  17. -INC SMCOORD
  18. -INC DECHE
  19. ******************************************************************
  20. *           RECUPERATION DES LOIS DE COMPORTEMENT POUR           *
  21. *                LES ELEMENTS GLOBAUX                            *
  22. ******************************************************************
  23. * ENTREES :
  24. * WRK0 SEGMENT DE TRAVAIL CONTENANT LES CARACTERISTIQUES
  25. * MATERIAUX
  26. * WRK1 SEGMENT DE TRAVAIL CONTENANT LES EFFORTS, LES DEPLACEMENTS
  27. * ET LA MATRICE DE HOOK
  28. * NMATT  =NOMBRE DE COMPOSANTES DE PROPRIETES DE MATERIAU
  29. * WTRAV SEGMENT DE TRAVAIL CONTENANT LES TABLEAUX UTILISES POUR
  30. * LE CALCUL DE LA MATRICE DE HOOKE ELASTIQUE (SS-PROGRAMME CALSIG)
  31. *
  32. * N2EL  = NBRE D ELEMENTS DANS SEGMENT DE HOOKE
  33. * N2PTEL= NBRE DE POINTS DANS SEGMENT DE HOOKE
  34. * MFR1   = NUMERO DE LA FORMULATION
  35. * IFOU  = OPTION DE CALCUL
  36. * IB    = NUMERO DE L ELEMENT COURANT
  37. * IGAU  = NUMERO DU POINT COURANT
  38. * EPAIST= EPAISSEUR
  39. * NBPGAU= NBRE DE POINTS DE GAUSS
  40. * MELE  = NUMERO DE L ELEMENT FINI
  41. * NPINT = NBRE DE POINTS D INTEGRATION
  42. * NBGMAT= NBRE DE POINTS DANS SEGMENT DE CARACTERISTIQUES
  43. * NELMAT= NBRE D ELEMENTS DANS SEGMENT DE CARACTERISTIQUES
  44. * SECT  = SECTION
  45. * LHOOK = TAILLE DE LA MATRICE DE HOOKE
  46. *
  47. * SORTIES :
  48. * KERRE INDICATEUR D'ERREUR
  49. *
  50. * VARIABLES INTERNES CREES
  51. * INDLEG CODAGE DES LOIS CONTENUES DANS L'ELEMENT GLOBAL
  52. * WRKGL SEGMENT CONTENANT LES LOIS DE COMPORTEMENT RETENUES
  53. * (3 AU MAXIMUM)
  54. * IPWRKGL SEGMENTS DE POINTEURS SUR LES LOIS DE COMPORTEMENT
  55. *
  56. *****************************************************************
  57. *
  58. *
  59.        SEGMENT IECOU
  60. *      COMMON/IECOU/NYOG,NYNU,NYALFA,NYSMAX,NYN,NYM,NYKK,
  61.        INTEGER icow1,icow2,icow3,icow4,icow5,icow6,icow7,
  62. C      INTEGER NYOG, NYNU, NYALFA,NYSMAX,NYN, NYM,  NYKK,
  63.      1  icow8,icow9,icow10,icow11,icow12,icow13,icow14,icow15,icow16,
  64. C    .  NYALF1,NYBET1,NYR,  NYA,   NYRHO,NSIGY,  NNKX,  NYKX,  IND,
  65.      2 icow17,icow18,icow19,icow20,icow21,icow22,icow23,icow24,
  66. C    .  NSOM,  NINV, NINCMA,NCOMP, JELEM, LEGAUS,INAT,  NCXMAT,
  67.      3 icow25,icow26,icow27,icow28,icow29,icow30,icow31,
  68. C    .  LTRAC, MFR,  IELE,  NHRM,   NBNN, NBELEM,ICARA,
  69.      4  icow32,icow33,NSTRS1,MFR1  ,NBGMAT,NELMAT,icow38,
  70. C    .  LW2,   NDEF,  NSTRSS,MFR1,  NBGMAT,NELMAT,MSOUPA,
  71.      5  icow39,icow40,icow41,icow42,icow43,icow44
  72. C    .  NUMAT1,LENDO, NBBB,  NNVARI,KERR1, MELEME
  73.         INTEGER icow45,icow46,icow47,icow48,icow49,icow50,
  74.      .          icow51,icow52,icow53,icow54,icow55,icow56
  75.      .          icow57,icow58
  76.       ENDSEGMENT
  77.  
  78.       SEGMENT WRKGL
  79.         REAL*8 TLOICO(NBLOI)
  80.       ENDSEGMENT
  81. *
  82.       SEGMENT IPWRKGL
  83.         POINTEUR IPOL(3).WRKGL
  84.       ENDSEGMENT
  85. *
  86. *
  87.        SEGINI IPWRKGL
  88. *
  89. *     QUELQUES INITIALISATIONS A 0
  90. *
  91.        KERRE=0
  92.        INDLEG = 0
  93.        NRLEGI = 0
  94. *
  95. *     RECUPERATION DES LOIS
  96. *
  97. *+DC
  98.        IDECAL = 1
  99. *
  100.        DO 50 IJ = 1,5
  101.           IF(IJ.EQ.1)IJOJO = 7+IDECAL
  102.           IF(IJ.EQ.2)IJOJO = 8+IDECAL
  103.           IF(IJ.EQ.3)IJOJO = 9+IDECAL
  104.           IF(IJ.EQ.4)IJOJO = 3
  105.           IF(IJ.EQ.5)IJOJO = 4
  106. *
  107. *  RECHERCHE DES POINTEURS NON NULS DE XMAT
  108. *
  109.           IBOU = nint(XMAT(IJOJO))
  110.           IF(IBOU.EQ.0) GO TO 50
  111. *
  112. *  CODAGE DES TYPES DE LOIS RENTREES
  113. *
  114.           IF(IJ.EQ.1) INDLEG = 1
  115. *
  116.           IF(IJ.EQ.2) INDLEG = INDLEG + 10
  117. *
  118.           IF(IJ.EQ.3)THEN
  119.              IF(INDLEG.LT.10)THEN
  120.                 INDLEG = INDLEG + 20
  121.              ELSE
  122.                 MOTERR(5:12) = 'FLXYFLXZ'
  123.                 KERRE = 57
  124.              END IF
  125.           END IF
  126. *
  127.           IF(IJ.EQ.4) INDLEG = INDLEG + 100
  128. *
  129.           IF(IJ.EQ.5)THEN
  130.              IF(INDLEG.LT.100)THEN
  131.                 INDLEG = INDLEG + 200
  132.              ELSE
  133.                 MOTERR(5:12) = 'CISYCISZ'
  134.                 KERRE = 57
  135.              END IF
  136.           END IF
  137. *
  138. *RECUPERATION DES EVOLUTIONS RENTREES DANS MATE
  139. *
  140.           MEVOLL=nint(XMAT(IJOJO))
  141.           IF(MEVOLL.NE.0) THEN
  142.              SEGACT MEVOLL
  143.              JOJO = IEVOLL(/1)
  144. *
  145.              IF(JOJO.NE.1)THEN
  146.                 KERRE=31
  147.                 WRITE(*,*) ' KERRE=31'
  148.                 SEGDES MEVOLL
  149.                 SEGSUP IPWRKGL
  150.                 RETURN
  151.              END IF
  152. *
  153.              KEVOLL=IEVOLL(1)
  154.              SEGACT KEVOLL
  155.              MLREEL=IPROGX
  156.              MLREE1=IPROGY
  157.              SEGDES KEVOLL
  158.              SEGACT MLREEL,MLREE1
  159.              NBPOIX=PROG(/1)
  160.              NBPOIY=MLREE1.PROG(/1)
  161. *
  162. * TEST SUR LA TAILLE DES LOIS RENTREES
  163. *
  164.              IF(NBPOIX.NE.NBPOIY) KERRE=58
  165.              IF (IJ.EQ.1)THEN
  166.                IF((NBPOIX.NE.4).and.(nbpoix.ne.6))KERRE=58
  167.              ELSE
  168.                IF((NBPOIX.NE.5).and.(nbpoix.ne.7))KERRE=58
  169.              ENDIF
  170. *
  171. * RETRANSCRIPTION DES LOIS DE COMPORTEMENT DANS WRKGL
  172. *
  173.              IF(KERRE.NE.0) THEN
  174.                 SEGDES MLREEL,MLREE1
  175.                 SEGDES MEVOLL
  176.                 GO TO 777
  177.              END IF
  178. *
  179.              NRLEGI = NRLEGI + 1
  180.              NBLOI = 2 * NBPOIX
  181.              SEGINI WRKGL
  182.              IPOL(NRLEGI) = WRKGL
  183.                 DO 10 I=1,NBPOIX
  184.                    PEPS=PROG(I)
  185.                    PSIG=MLREE1.PROG(I)
  186.                    TLOICO((2*I)-1) = PSIG
  187.                    TLOICO(2*I) = PEPS
  188. 10              CONTINUE
  189.               SEGDES  MLREEL, MLREE1
  190.          END IF
  191. 50     CONTINUE
  192. *
  193.        IF(NRLEGI.EQ.0)THEN
  194.           KERRE = 59
  195.           RETURN
  196.        END IF
  197. *
  198.        SEGDES MEVOLL
  199. C
  200. 777    CONTINUE
  201. C
  202. C UTILISATION DES LOIS DE COMPORTEMENT
  203. C
  204.            IF(KERRE.EQ.0) THEN
  205.            nbgmab=nbgmat
  206.            nlmatb=nelmat
  207.            mfr1bi=mfr1
  208.            nstrbi=nstrs1
  209.            CALL CDDIS(WRK52,WRK53,WRK54,NSTRbi,MFR1bi,IFOU,IB,
  210.      1   IGAU,NBPGAU,NBGMAb,NLMATb,INDLEG,IPWRKGL,WRKGL)
  211. C
  212. C DESACTIVATION DES SEGMENTS TEMPORAIRES WRKGL ET IPWRKGL
  213. C
  214.                     DO 800 I=1,NRLEGI
  215.                       SEGSUP IPOL(I)
  216. 800                 CONTINUE
  217.            ENDIF
  218. C
  219.        SEGSUP IPWRKGL
  220. C
  221.        RETURN
  222.  
  223.        END
  224.  
  225.  
  226.  
  227.  
  228.  
  229.  
  230.  
  231.  
  232.  
  233.  
  234.  
  235.  
  236.  
  237.  
  238.  
  239.  

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