Télécharger la plaquette Cast3M


fr en

Télécharger calsig.eso

Retour à la liste

Numérotation des lignes : 

calsig

  1. C CALSIG    SOURCE    OF166741  24/10/21    21:15:04     12042          
  2.       SUBROUTINE CALSIG(DEPST,DDAUX,NSTRS,CMATE,VALMAT,
  3.      1     VALCAR,N2EL,N2PTEL,MFR,IFOU,IB,IGAU,EPAIST,
  4.      2     NBPGAU,MELE,NPINT,NBGMAT,NELMAT,SECT,LHOOK,TXR,
  5.      3     XLOC,XGLOB,D1HOOK,ROTHOO,DDHOMU,CRIGI,DSIGT,IRTD)
  6. *_______________________________________________________________________
  7. *
  8. *    ENTREES :
  9. *    ---------
  10. *
  11. * DEPST = INCREMENT DE DEFORMATIONS TOTALES
  12. * DDAUX = MATRICE DE HOOKE ELASTIQUE
  13. * NSTRS = NBRE DE COMPOSANTES DES DEFORMATIONS
  14. * CMATE = NOM DU MATERIAU
  15. * VALMAT= TABLEAU DE CARACTERISTIQUES DU MATERIAU
  16. * VALCAR= TABLEAU DE CARACTERISTIQUES GEOMETRIQUES
  17. * N2EL  = NBRE D ELEMENTS DANS SEGMENT DE HOOKE
  18. * N2PTEL= NBRE DE POINTS DANS SEGMENT DE HOOKE
  19. * MFR   = NUMERO DE LA FORMULATION
  20. * IFOU  = OPTION DE CALCUL
  21. * IB    = NUMERO DE L ELEMENT COURANT
  22. * IGAU  = NUMERO DU POINT COURANT
  23. * EPAIST= EPAISSEUR
  24. * NBPGAU= NBRE DE POINTS DE GAUSS
  25. * MELE  = NUMERO DE L ELEMENT FINI
  26. * NPINT = NBRE DE POINTS D INTEGRATION
  27. * NBGMAT= NBRE DE POINTS DANS SEGMENT DE CARACTERISTIQUES
  28. * NELMAT= NBRE D ELEMENTS DANS SEGMENT DE CARACTERISTIQUES
  29. * SECT  = SECTION
  30. * LHOOK = TAILLE DE LA MATRICE DE HOOKE
  31. * TXR,XLOC,XGLOB,D1HOOK,ROTHOO,DDHOMU,CRIGI = TABLEAUX UTILISES
  32. * POUR LE CALCUL DE LA MATRICE DE HOOKE
  33. *
  34. *    SORTIE :
  35. *    --------
  36. *
  37. * DSIGT = INCREMENT DE CONTRAINTES TOTALES
  38. *_______________________________________________________________________
  39.  
  40.       IMPLICIT INTEGER(I-N)
  41.       IMPLICIT REAL*8(A-H,O-Z)
  42.  
  43. -INC PPARAM
  44. -INC CCOPTIO
  45. -INC CCREEL
  46.  
  47. *_______________________________________________________________________
  48.  
  49.       DIMENSION DEPST(*),DSIGT(*)
  50.       DIMENSION VALMAT(*),VALCAR(*)
  51.       DIMENSION DDAUX(LHOOK,*),DDHOMU(LHOOK,LHOOK)
  52.       DIMENSION TXR(IDIM,*),CRIGI(*)
  53.       DIMENSION D1HOOK(LHOOK,*),ROTHOO(LHOOK,*)
  54.       DIMENSION XLOC(3,*),XGLOB(3,*)
  55.       DIMENSION COBMA(20)
  56.       DIMENSION VAR(1),S(3)
  57.  
  58.       PARAMETER(DEUX=2.D0,UNDEMI=.5D0)
  59.       PARAMETER(X774=.774596669241483D0)
  60.       PARAMETER(SIX=6.D0)
  61.  
  62.       CHARACTER*8 CMATE
  63.  
  64.       IRTD=1
  65.       CALL ZERO(COBMA,LHOOK,1)
  66.       CALL ZERO(DSIGT,NSTRS,1)
  67. *
  68. *   CAS DES LISP ET LISM
  69. *
  70.       IF (MFR.EQ.15) THEN
  71.         IF (NBPGAU.EQ.1) THEN
  72.           S(1)= XZERO
  73.         ELSE IF (NBPGAU.EQ.3) THEN
  74.           S(1)=-X774
  75.           S(2)= XZERO
  76.           S(3)= X774
  77.         ENDIF
  78.       ENDIF
  79.  
  80.       IF (IB.EQ.1.AND.IGAU.EQ.1) THEN
  81.          GOTO 1000
  82. *
  83.       ELSEIF (N2PTEL.EQ.1.AND.N2EL.EQ.1) THEN
  84.          GOTO 2000
  85. *
  86.       ELSEIF (N2PTEL.EQ.1.AND.N2EL.NE.1)  THEN
  87.          IF (IGAU.EQ.1) THEN
  88.             GOTO 1000
  89.          ELSE
  90.             GOTO 2000
  91.          ENDIF
  92. *
  93.       ELSE
  94.          GOTO 1000
  95. *
  96.       ENDIF
  97. C
  98.  1000 CONTINUE
  99. *
  100. *      write(6,*) 'calsig' ,nstrs,mfr, nbgmat,nelmat, mele ,lhook,cmate
  101. *      write(6,*) n2ptel,n2el,(depst(i),i=1,nstrs)
  102.       IRET=1
  103.       CALL ZERO(DDAUX,LHOOK,LHOOK)
  104. *
  105.       IF (CMATE.EQ.'ISOTROPE'.or.CMATE.EQ.'IMPELAST') THEN
  106. *  Les modeles de comportement necessaitant l'appel a CALSIG ne
  107. *  correspondent pas aux modeles de comportement dont la valeur
  108. *  de INAT est referencee dans HOOKIS. Par consequent, nous
  109. *  CHOISISSONS de fixer ARBITRAIREMENT INAT a 0 dans le present
  110. *  sous-programme !
  111.          INAT = 0
  112.          CALL HOOKIS(VALMAT,VALCAR,VAR,MFR,IB,IGAU,0.D0,EPAIST,
  113.      +        INAT,MELE,NPINT,IFOU,1,NBGMAT,NELMAT,
  114.      +        S,SECT,LHOOK,DDHOMU,DDAUX,
  115.      +        COBMA,XMOB,IRET)
  116. C
  117.       ELSE IF (CMATE.EQ.'ORTHOTRO') THEN
  118.          CALL HOOKOR(VALMAT,IB,IGAU,MFR,0.D0,EPAIST,
  119.      +        MELE,NPINT,IFOU,1,NBGMAT,NELMAT,SECT,LHOOK,
  120.      +        TXR,XLOC,XGLOB,D1HOOK,ROTHOO,DDHOMU,DDAUX,
  121.      +        COBMA,XMOB,IRET)
  122. C
  123.       ELSE IF (CMATE.EQ.'ANISOTRO') THEN
  124.          CALL HOOKAN(VALMAT,IB,IGAU,MFR,IFOU,1,NBGMAT,NELMAT,
  125.      +        SECT,LHOOK,TXR,XLOC,XGLOB,D1HOOK,ROTHOO,DDAUX,
  126.      +        MELE,COBMA,XMOB,IRET)
  127. C
  128.       ELSE IF (CMATE.EQ.'UNIDIREC') THEN
  129.          CALL HOOKUN(VALMAT,IB,IGAU,MFR,0.D0,EPAIST,
  130.      +        MELE,NPINT,IFOU,1,NBGMAT,NELMAT,SECT,LHOOK,
  131.      +        TXR,XLOC,XGLOB,D1HOOK,ROTHOO,DDHOMU,DDAUX,
  132.      +        COBMA,XMOB,IRET)
  133. C
  134.       ELSE IF (CMATE.EQ.'HOMOGENE') THEN
  135.          CALL HOOKHO(VALMAT,IB,IGAU,MFR,NBGMAT,NELMAT,SECT,
  136.      +        LHOOK,DDAUX,IRET)
  137. C
  138.       ELSE IF (CMATE.EQ.'SECTION') THEN
  139.          CALL HOOKSE(VALMAT,IB,IGAU,MFR,CRIGI,IFOU,
  140.      +        NBGMAT,NELMAT,SECT,LHOOK,DDAUX,IRET)
  141. C
  142.       ENDIF
  143. *
  144.       IF (IRET.LE.0 ) GOTO 9990
  145. *
  146. *  cas des champs uniformes -> on ne recalcule pas DDAUX
  147. *
  148.  2000 CONTINUE
  149. *
  150. *  cas des milieux poreux : 2 cas selon la valeur de NSTRS
  151. *
  152.       IF(MFR.EQ.33.AND.LHOOK.LT.NSTRS) THEN
  153. *
  154. *        cas sigeff
  155. *
  156.          DO 4500 I=1,LHOOK
  157.             r_z = -COBMA(I)*DEPST(NSTRS)
  158.             DO 45001 J=1,LHOOK
  159.                r_z = r_z + DDAUX(I,J)*DEPST(J)
  160. 45001       CONTINUE
  161.             DSIGT(I) = r_z
  162.  4500    CONTINUE
  163.          IF(XMOB.EQ.0.D0) THEN
  164.            UNSURM=0.D0
  165.          ELSE
  166.            UNSURM=1.D0/XMOB
  167.          ENDIF
  168.          r_z = DEPST(NSTRS)*UNSURM
  169.          DO 4502 I=1,LHOOK
  170.             r_z = r_z + COBMA(I)*DEPST(I)
  171. 4502     CONTINUE
  172.          DSIGT(NSTRS) = r_z
  173. *
  174. *  autres cas
  175. *
  176.       ELSE
  177.          DO 5500 I=1,min(LHOOK,NSTRS)
  178.             r_z = 0.D0
  179.             DO 55001 J=1,min(LHOOK,NSTRS)
  180.                r_z = r_z + DDAUX(I,J)*DEPST(J)
  181. 55001       CONTINUE
  182.             DSIGT(I) = r_z
  183.  5500    CONTINUE
  184.       ENDIF
  185. *
  186. *   CAS DES TUYAUX FISSURES
  187. *
  188.       IF (MFR.EQ.17) THEN
  189.          YOU=VALMAT(1)
  190.          RAYO=VALCAR(1)
  191.          EPAI=VALCAR(2)
  192.          TETA1=VALCAR(9)*UNDEMI
  193. C     CONVERSION DE TETA1 EN RADIAN
  194.          TETA = (TETA1 * XPI)/180.D0
  195.          TESPI = TETA/XPI
  196. C     ON MET DANS 'RAYMO' LE RAYON MOYEN DU TUYAU.
  197.          RAYMO =RAYO  - (EPAI/DEUX)
  198. C     CALCUL DE A   COEFIICIENT ZAHOR
  199.          RSURT=RAYMO / EPAI
  200.          IF(RSURT.LE.10.D0.AND.RSURT.GE.4.9D0) THEN
  201.             AXX = ( .125D0*RSURT - .25D0 ) **.25D0
  202.          ELSE IF(RSURT.GT.10.D0.AND.RSURT.LE.35.D0) THEN
  203.             AXX = ( .4D0*RSURT - 3.D0 ) **.25D0
  204.          ELSE
  205.             KERRE=3
  206.          ENDIF
  207.          CALL TUFIFP(TESPI,AXX,FP,FM,FMP,FOP,FOM)
  208. C
  209. C     FACTEUR D INTENSITE DES CONTRAINTES
  210. C
  211.          IF(TETA1.LE.(0.5D0))THEN
  212.             DSIGT(7)=XZERO
  213.             DSIGT(8)=XZERO
  214.             GOTO 9992
  215.          ENDIF
  216.          SQQ= XPI * RAYMO * TETA
  217.          SQQ= SQRT(SQQ)
  218.          XEX= SQQ * FOP/(DEUX * XPI * RAYMO *EPAI)
  219.          XFL= SQQ * FOM/(XPI * RAYMO * RAYMO *EPAI)
  220.          DSIGT(7)=XEX * DSIGT(1) - XFL * DSIGT(6)
  221. C
  222. C     CALCUL DES AIRES DE BRECHE NOTE TECHNIQUE DRE/STRE/LMA 85/695
  223. C
  224.          SIGM=DSIGT(1)/( DEUX * XPI * RAYMO * EPAI )
  225.          SIGF=DSIGT(6)/( XPI * RAYMO * RAYMO * EPAI )
  226.          XIM= DEUX * XPI * RAYMO * RAYMO * TETA * TETA * FP /YOU
  227.          XIF= XIM * ( .75D0 +(.25D0 * COS ( TETA )))
  228.          DSIGT(8)=XIM * SIGM  - XIF * SIGF
  229.       ENDIF
  230. *
  231. *   CAS DES LISP ET LISM
  232. *
  233.       IF (MFR.EQ.15) THEN
  234.          EPA1=VALCAR(1)
  235.          EPA2=VALCAR(6)
  236.          W=(EPA1+EPA2)*UNDEMI
  237.          FISS1=VALCAR(2)
  238.          FISS2=VALCAR(7)
  239.          FISS1 = (FISS1*(UNDEMI +UNDEMI/X774))+
  240.      +        (FISS2*(UNDEMI-UNDEMI/X774))
  241.          FISS2 = (FISS1*(UNDEMI -UNDEMI/X774))+
  242.      +        (FISS2*(UNDEMI+UNDEMI/X774))
  243.          H1=UNDEMI-UNDEMI*S(IGAU)
  244.          H2=UNDEMI+UNDEMI*S(IGAU)
  245.          A= H1*FISS1+H2*FISS2
  246.          ASURW= A / W
  247.          CALL LISPFI(ASURW,FM,FF)
  248.          X1=DSIGT(1)/W
  249.          X4=DSIGT(4)*SIX/(W*W)
  250.          XXX=SQRT(XPI*A)
  251.          XKIE=(X1*FM+X4*FF)*XXX
  252.          DSIGT(6)= XKIE
  253.       ENDIF
  254. *      write(6,*)'Fin calsig',nstrs,(dsigt(i),i=1,nstrs)
  255.  
  256.       GOTO 9992
  257. *
  258. *     ERREUR , RETOUR
  259. *
  260.  9990 CONTINUE
  261.       IRTD=0
  262.  
  263.  9992 RETURN
  264.       END
  265.  
  266.  
  267.  

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