Télécharger la plaquette Cast3M


fr en

Télécharger jacono.eso

Retour à la liste

Numérotation des lignes : 

jacono

  1. C JACONO    SOURCE    CB215821  24/04/12    21:16:26     11897          
  2.       SUBROUTINE JACONO(IPMODL,INORM,IPCHE,IRET)
  3. C=======================================================================
  4. C    ENTREES :
  5. C    ---------
  6. C      IPMODL= pointeur sur un MMODEL
  7. C      INORM = 1 si les vecteurs doivent etre normes 0 sinon
  8. C
  9. C    SORTIES :
  10. C    --------
  11. C
  12. C      IPCHE = CHAMELEM contenant les JACOBIENS
  13. C          ( = normale aux faces des elements dans le cas des coques)
  14. C          ( = tangente a la fibre neutre dans le cas des poutres)
  15. C      IRET  = 1 si succes 0 sinon
  16. C
  17. C    Passage au nouveau Chamelem PAR S.RAMAHANDRY le 11/09/90
  18. C
  19. C    2013-01-02 (BP) : ajout zones cohesives (ZCO2,3 et 4 => coque mince)
  20. C                      + calcul de la tangente pour les poutres
  21. C
  22. C
  23. C=====================================================================
  24.       IMPLICIT INTEGER(I-N)
  25.       IMPLICIT REAL*8(A-H,O-Z)
  26.       PARAMETER(UN=1.D0,XZER=0.D0)
  27.  
  28. -INC PPARAM
  29. -INC CCOPTIO
  30. -INC CCHAMP
  31. -INC SMCHAML
  32. -INC SMMODEL
  33. -INC SMELEME
  34. -INC SMCOORD
  35. -INC SMINTE
  36. C
  37.       SEGMENT TRA
  38.          REAL*8 XEL(3,NBNN) ,SHP(6,NBNN) ,XE(3,NBNN)
  39.       ENDSEGMENT
  40. C
  41.       SEGMENT TR1
  42.          REAL*8 TH(NBN1) ,TXR(3,3,NBN1) ,XJ(3,3)
  43.       ENDSEGMENT
  44. C
  45.       SEGMENT INFO
  46.          INTEGER INFELL(JG)
  47.       ENDSEGMENT
  48. C
  49.       SEGMENT MPTVAL
  50.          INTEGER IPOS(NS) , NSOF(NS)
  51.          INTEGER IVAL(NCOSOU)
  52.          CHARACTER*16 TYVAL(NCOSOU)
  53.       ENDSEGMENT
  54. C
  55.       DIMENSION BPSS(3,3)
  56.       CHARACTER*8 CMATE
  57. C
  58.       REAL*8 XU(3)
  59.       REAL*8 XV(3)
  60.       REAL*8 XW(3)
  61. C
  62.       NHRM=NIFOUR
  63.       IRET=1
  64. C
  65. C     ACTIVATION DU MODELE
  66. C
  67.       MMODEL= IPMODL
  68.       SEGACT MMODEL
  69.       NSOUS=KMODEL(/1)
  70. C
  71. C     CREATION DU MCHELM
  72. C
  73.       N1=NSOUS
  74.       L1=8
  75.       N3=6
  76.       SEGINI MCHELM
  77.       IPCHE=MCHELM
  78.       IF (INORM .EQ. 1) THEN
  79.          TITCHE='NORMALES'
  80.       ELSE
  81.          TITCHE='VECTEURS SURFACE'
  82.       ENDIF
  83.       IFOCHE=IFOUR
  84.       IRT8=1
  85. C____________________________________________________________________
  86. C
  87. C     DEBUT DE LA BOUCLE SUR LES DIFFERENTES ZONES
  88. C____________________________________________________________________
  89. C
  90.       DO 500 ISOUS=1,NSOUS
  91. C
  92. C     ON RECUPERE L INFORMATION GENERALE
  93. C
  94.          IMODEL=KMODEL(ISOUS)
  95.          SEGACT IMODEL
  96.          IPMAIL=IMAMOD
  97.          IMACHE(ISOUS)=IPMAIL
  98.          CONCHE(ISOUS)=CONMOD
  99. C
  100. C     TRAITEMENT DU MODELE
  101. C
  102.          MELE=NEFMOD
  103.          MELEME=IMAMOD
  104.          NFOR=FORMOD(/2)
  105.          NMAT=MATMOD(/2)
  106. C____________________________________________________________________
  107. C
  108. C     INFORMATION SUR L'ELEMENT FINI
  109. C____________________________________________________________________
  110. C
  111.          if(infmod(/1).lt.7) then
  112.          CALL ELQUOI(MELE,0,5,IPINF,IMODEL)
  113.          IF (IERR.NE.0) THEN
  114.             SEGSUP MCHELM
  115.             IRET=0
  116.             RETURN
  117.          ENDIF
  118.          INFO=IPINF
  119.          MELE =INFELL(1)
  120.          MFR  =INFELL(13)
  121.          MINTE=INFELL(11)
  122.          MINTE1=INFELL(12)
  123.          segsup info
  124.          else
  125.          MELE =INFELE(1)
  126.          MFR  =INFELE(13)
  127.          MINTE=INFMOD(7)
  128.          MINTE1=INFMOD(8)
  129.          endif
  130. C
  131.          INFCHE(ISOUS,1)=0
  132.          INFCHE(ISOUS,2)=0
  133.          INFCHE(ISOUS,3)=NHRM
  134.          INFCHE(ISOUS,4)=MINTE
  135.          INFCHE(ISOUS,5)=0
  136.          INFCHE(ISOUS,6)=5
  137. C
  138. C     INITIALISATION DE MINTE
  139. C
  140.          SEGACT MINTE
  141.          NBPGAU=POIGAU(/1)
  142. C
  143. C     ACTIVATION DU MELEME
  144. C
  145.          SEGACT MELEME
  146.          NBNN  =NUM(/1)
  147.          NBELEM=NUM(/2)
  148. C
  149. C     RECHERCHE DE LA TAILLE DES MELVAL A ALLOUER
  150. C
  151.          IF (MFR.EQ.3.OR.MFR.EQ.5.OR.MFR.EQ.9 .OR. MFR.EQ.77) THEN
  152.             N1PTEL=NBPGAU
  153.             N1EL=NBELEM
  154.          ELSEIF(MFR.EQ.7 .OR. MFR.EQ.13) THEN
  155.             N1PTEL=NBPGAU
  156.             N1EL=NBELEM
  157.          ELSE
  158.             N1PTEL = 0
  159.             N1EL = 0
  160.          ENDIF
  161. C
  162. C     CREATION DU MCHAML DE LA SOUS ZONE
  163. C
  164.          NJAC=IDIM
  165.          N2 = IDIM
  166.          SEGINI MCHAML
  167.          ICHAML(ISOUS)=MCHAML
  168.          NS=1
  169.          NCOSOU=NJAC
  170.          SEGINI MPTVAL
  171.          IVAJAC=MPTVAL
  172. C
  173. C     2 OU 3 COMPOSANTES
  174. C
  175.          ICOMP=1
  176.          IF (IFOUR.EQ.0.OR.IFOUR.EQ.1) THEN
  177.             NOMCHE(ICOMP)='VR  '
  178.          ELSE
  179.             NOMCHE(ICOMP)='VX  '
  180.          ENDIF
  181.          TYPCHE(ICOMP)='REAL*8'
  182.          N2PTEL=0
  183.          N2EL=0
  184.          SEGINI MELVA1
  185.          IELVAL(ICOMP)=MELVA1
  186.          IVAL(ICOMP)=MELVA1
  187. C
  188.          ICOMP=2
  189.          IF (IFOUR.EQ.0.OR.IFOUR.EQ.1) THEN
  190.             NOMCHE(ICOMP)='VZ  '
  191.          ELSE
  192.             NOMCHE(ICOMP)='VY  '
  193.          ENDIF
  194.          TYPCHE(ICOMP)='REAL*8'
  195.          N2PTEL=0
  196.          N2EL=0
  197.          SEGINI MELVA2
  198.          IELVAL(ICOMP)=MELVA2
  199.          IVAL(ICOMP)=MELVA2
  200. C
  201.          IF (IDIM .EQ. 3) THEN
  202.             ICOMP=3
  203.             NOMCHE(ICOMP)='VZ  '
  204.             TYPCHE(ICOMP)='REAL*8'
  205.             N2PTEL=0
  206.             N2EL=0
  207.             SEGINI MELVA3
  208.             IELVAL(ICOMP)=MELVA3
  209.             IVAL(ICOMP)=MELVA3
  210.          ENDIF
  211. C
  212.   44     CONTINUE
  213. C
  214.          SEGINI TRA
  215. C
  216. C ================ FORMULATION MASSIVE =======================
  217. C
  218. C
  219.          IF(MFR.EQ.1.OR.MFR.EQ.33) THEN
  220.             GOTO 520
  221. C
  222. C ================ FORMULATION COQUE  MINCE =====================
  223. C
  224. C
  225.       ELSE IF(MFR.EQ.3.OR.MFR.EQ.9 .OR. MFR.EQ.77) THEN
  226.          IDI2=IDIM-1
  227.          DO 3000 IB=1,NBELEM
  228. *--------------Calcul de la normale a l'élément
  229.             IREF1 = (IDIM + 1)*(MELEME.NUM(1, IB) - 1)
  230.             IREF2 = (IDIM + 1)*(MELEME.NUM(2, IB) - 1)
  231.             DO 28 IC = 1, IDIM
  232.    28          XU(IC) = XCOOR(IREF2+IC)-XCOOR(IREF1+IC)
  233.             XNORU = 0.
  234.             DO 31 IC = 1, IDIM
  235.    31          XNORU = XNORU + XU(IC)*XU(IC)
  236.             XNORU = SQRT(XNORU)
  237.             DO 32 IC = 1, IDIM
  238.    32          XU(IC) = XU(IC)/XNORU
  239.             IF (IDIM .EQ. 2) THEN
  240.                XW(1) = -XU(2)
  241.                XW(2) = XU(1)
  242.             ELSE
  243.                IN = 3
  244.    33          IREF3 = (IDIM + 1)*(MELEME.NUM(IN, IB) - 1)
  245.                DO 34 IC = 1, IDIM
  246.    34             XV(IC) = XCOOR(IREF3+IC)-XCOOR(IREF1+IC)
  247.                XNORV = 0.
  248.                DO 35 IC = 1, IDIM
  249.    35             XNORV = XNORV + XV(IC)*XV(IC)
  250.                XNORV = SQRT(XNORV)
  251.                DO 36 IC = 1, IDIM
  252.    36             XV(IC) = XV(IC)/XNORV
  253.                XW(1) = XU(2)*XV(3) - XU(3)*XV(2)
  254.                XW(2) = XU(3)*XV(1) - XU(1)*XV(3)
  255.                XW(3) = XU(1)*XV(2) - XU(2)*XV(1)
  256.                XNORW = 0.
  257.                DO 37 IC = 1, IDIM
  258.    37             XNORW = XNORW + XW(IC)*XW(IC)
  259.                IF (XNORW .LT. 1.E-4) THEN
  260.                   IN = IN + 1
  261.                   if(IN.le.NBNN) GOTO 33
  262.                ENDIF
  263.                XNORW = SQRT(XNORW)
  264.                IF(XNORW .LT.1.E-4) call erreur(345)
  265.                DO 38 IC = 1, IDIM
  266.    38             XW(IC) = XW(IC)/XNORW
  267.             ENDIF
  268. *--------------Fin du calcul de la normale a l'élément
  269.             CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  270. C
  271.             IF(IDIM.EQ.2)THEN
  272.                CALL VPAST2(XE,BPSS)
  273.             ELSE IF(IDIM.EQ.3) THEN
  274.                CALL VPAST(XE,BPSS)
  275.             ENDIF
  276.             CALL VCORL1(XE,XEL,BPSS,NBNN)
  277.             DO 3002 IC=1,NBPGAU
  278.                IF (INORM .EQ. 1) THEN
  279.                   DJAC = 1.
  280.                ELSE
  281.                   DO 3003 ID=1,6
  282.                      DO 3003 IE=1,NBNN
  283.                         SHP(ID,IE)=SHPTOT(ID,IE,IC)
  284.  3003             CONTINUE
  285.                   CALL JACOBI(XEL,SHP,IDI2,NBNN,DJAC)
  286.                ENDIF
  287.                MPTVAL=IVAJAC
  288.                MELVAL = IVAL(1)
  289.                IBMN=MIN(IB, MELVAL.VELCHE(/2))
  290.                IGMN=MIN(IC,MELVAL.VELCHE(/1))
  291.                MELVAL.VELCHE(IGMN,IBMN)=DJAC*XW(1)
  292.                MELVAL = IVAL(2)
  293.                IBMN=MIN(IB, MELVAL.VELCHE(/2))
  294.                IGMN=MIN(IC,MELVAL.VELCHE(/1))
  295.                MELVAL.VELCHE(IGMN,IBMN)=DJAC*XW(2)
  296.                IF (IDIM .EQ. 3) THEN
  297.                   MELVAL = IVAL(3)
  298.                   IBMN=MIN(IB, MELVAL.VELCHE(/2))
  299.                   IGMN=MIN(IC,MELVAL.VELCHE(/1))
  300.                   MELVAL.VELCHE(IGMN,IBMN)=DJAC*XW(3)
  301.                ENDIF
  302.  3002       CONTINUE
  303.  3000    CONTINUE
  304.          GOTO 520
  305. C
  306. C ================ FORMULATION POUTRE ET TUYAU ====================
  307. C
  308. C
  309.       ELSE IF(MFR.EQ.7.OR.MFR.EQ.13) THEN
  310.          IDI2=IDIM-1
  311.          DO 4000 IB=1,NBELEM
  312. *-----------Calcul de la tangente a l'élément
  313.             IREF1 = (IDIM + 1)*(MELEME.NUM(1, IB) - 1)
  314.             IREF2 = (IDIM + 1)*(MELEME.NUM(2, IB) - 1)
  315.             DO 41 IC = 1, IDIM
  316.    41          XU(IC) = XCOOR(IREF2+IC)-XCOOR(IREF1+IC)
  317.             XNORU = 0.D0
  318.             DO 42 IC = 1, IDIM
  319.    42          XNORU = XNORU + XU(IC)*XU(IC)
  320.             XNORU = SQRT(XNORU)
  321.             DO 43 IC = 1, IDIM
  322.    43          XU(IC) = XU(IC)/XNORU
  323. *-----------Fin du calcul de la tangente a l'élément
  324. *-----------Calcul de la tangente a l'élément en chaque point de Gauss
  325. c  BP : On suppose le jacobien constant dans l'element (idem POUJAC.eso)
  326. C  => on sort le calcul du jacobien de la boucle sur les points de Gauss.
  327. C  Cela implique que la POUTre de Bernoulli n'est pas isoparamétrique...
  328.             IF (INORM .EQ. 1) THEN
  329.                DJAC = 1.D0
  330.             ELSE
  331.                DJAC = 1.D0/DBLE(NBPGAU)
  332.             ENDIF
  333.             DO 4002 IC=1,NBPGAU
  334.                MPTVAL=IVAJAC
  335.                MELVAL = IVAL(1)
  336.                IBMN=MIN(IB, MELVAL.VELCHE(/2))
  337.                IGMN=MIN(IC,MELVAL.VELCHE(/1))
  338.                MELVAL.VELCHE(IGMN,IBMN)=DJAC*XU(1)
  339.                MELVAL = IVAL(2)
  340.                IBMN=MIN(IB, MELVAL.VELCHE(/2))
  341.                IGMN=MIN(IC,MELVAL.VELCHE(/1))
  342.                MELVAL.VELCHE(IGMN,IBMN)=DJAC*XU(2)
  343.                IF (IDIM .EQ. 3) THEN
  344.                   MELVAL = IVAL(3)
  345.                   IBMN=MIN(IB, MELVAL.VELCHE(/2))
  346.                   IGMN=MIN(IC,MELVAL.VELCHE(/1))
  347.                   MELVAL.VELCHE(IGMN,IBMN)=DJAC*XU(3)
  348.                ENDIF
  349.  4002       CONTINUE
  350.  4000    CONTINUE
  351.  
  352.          GOTO 520
  353. C
  354. C ================ FORMULATION COQUE  EPAISSE ====================
  355. C
  356. C
  357.          ELSE IF(MFR.EQ.5) THEN
  358.             SEGACT MINTE1
  359.             NBPGA1=MINTE1.POIGAU(/1)
  360.             NBN1  =MINTE1.SHPTOT(/2)
  361.             SEGINI TR1
  362. C
  363. C     UNE PETITE HORREUR ON CONSIDERE LES EPAISSEURS CONSTANTES
  364. C
  365.             DO 5010 IC=1,NBNN
  366.                TH(IC)=UN
  367.  5010       CONTINUE
  368.             DO 5000 IB=1,NBELEM
  369. *--------------Calcul de la normale a l'élément
  370.                IREF1 = (IDIM + 1)*(MELEME.NUM(1, IB) - 1)
  371. *               IREF2 = (IDIM + 1)*(MELEME.NUM(2, IB) - 1)
  372. * bp : les EF de coque epaisse etant quadratiques (coq6 et coq8), on
  373. * prend les noeuds "coins" pour eviter pb avec les noeuds 1,2,3 si courbures
  374.                IREF2 = (IDIM + 1)*(MELEME.NUM(3, IB) - 1)
  375.                DO 8 IC = 1, IDIM
  376.    8              XU(IC) = XCOOR(IREF2+IC)-XCOOR(IREF1+IC)
  377.                XNORU = 0.
  378.                DO 11 IC = 1, IDIM
  379.    11             XNORU = XNORU + XU(IC)*XU(IC)
  380.                XNORU = SQRT(XNORU)
  381.                DO 12 IC = 1, IDIM
  382.    12             XU(IC) = XU(IC)/XNORU
  383.                IF (IDIM .EQ. 2) THEN
  384.                   XW(1) = -XU(2)
  385.                   XW(2) = XU(1)
  386.                ELSE
  387. *                  IN = 3
  388.                   IN = 5
  389.    13             IREF3 = (IDIM + 1)*(MELEME.NUM(IN, IB) - 1)
  390.                   DO 14 IC = 1, IDIM
  391.    14             XV(IC) = XCOOR(IREF3 + IC) - XCOOR(IREF1 + IC)
  392.                   XNORV = 0.
  393.                   DO 15 IC = 1, IDIM
  394.    15               XNORV = XNORV + XV(IC)*XV(IC)
  395.                   XNORV = SQRT(XNORV)
  396.                   DO 16 IC = 1, IDIM
  397.    16                XV(IC) = XV(IC)/XNORV
  398.                   XW(1) = XU(2)*XV(3) - XU(3)*XV(2)
  399.                   XW(2) = XU(3)*XV(1) - XU(1)*XV(3)
  400.                   XW(3) = XU(1)*XV(2) - XU(2)*XV(1)
  401.                   XNORW = 0.
  402.                   DO 17 IC = 1, IDIM
  403.    17                XNORW = XNORW + XW(IC)*XW(IC)
  404.                   XNORW = SQRT(XNORW)
  405.                   IF (XNORW .LT. 1.E-4) THEN
  406.                    if(IN.LT.NBNN) then
  407.                      IN = IN + 1
  408.                      GOTO 13
  409.                    else
  410.                     write(6,*) 'Difficultes pour etablir la normale de'
  411.                     write(6,*) 'l element',IB
  412.                     write(6,*) 'Verifiez votre maillage'
  413.                     GOTO 9990
  414.                    endif
  415.                   ENDIF
  416.                   DO 18 IC = 1, IDIM
  417.    18                XW(IC) = XW(IC)/XNORW
  418.                ENDIF
  419. *--------------Fin du calcul de la normale a l'élément
  420.                IF (INORM .EQ. 0) THEN
  421.                   CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  422. C
  423.                   CALL CQ8LOC(XE,NBN1,MINTE1.SHPTOT,TXR,IRR)
  424.                ENDIF
  425. C
  426.                DO 5002 IC=1,NBPGAU
  427.                   IF (INORM .EQ. 1) THEN
  428.                      DJAC = 1.
  429.                   ELSE
  430.                      E=DZEGAU(IC)
  431.          CALL COQ8JC(IC,NBN1,E,XE,TH,TXR,SHPTOT,XJ,DJAC,IRR)
  432.                   ENDIF
  433.                   MPTVAL=IVAJAC
  434.                   MELVAL = IVAL(1)
  435.                   IBMN=MIN(IB, MELVAL.VELCHE(/2))
  436.                   IGMN=MIN(IC, MELVAL.VELCHE(/1))
  437.                   MELVAL.VELCHE(IGMN,IBMN)=DJAC*XW(1)
  438.                   MELVAL = IVAL(2)
  439.                   IBMN=MIN(IB, MELVAL.VELCHE(/2))
  440.                   IGMN=MIN(IC, MELVAL.VELCHE(/1))
  441.                   MELVAL.VELCHE(IGMN,IBMN)=DJAC*XW(2)
  442.                   IF (IDIM .EQ. 3) THEN
  443.                      MELVAL = IVAL(3)
  444.                      IBMN=MIN(IB, MELVAL.VELCHE(/2))
  445.                      IGMN=MIN(IC, MELVAL.VELCHE(/1))
  446.                      MELVAL.VELCHE(IGMN,IBMN)=DJAC*XW(3)
  447.                   ENDIF
  448.  5002          CONTINUE
  449.  5000       CONTINUE
  450.             GOTO 520
  451.          ENDIF
  452. C---------------------------------------------------------------------
  453. C  DESACTIVATION DES SEGMENTS PROPRES A LA ZONE GEOMETRIQUE ISOUS
  454. C---------------------------------------------------------------------
  455. C
  456.  520     CONTINUE
  457.          MPTVAL=IVAJAC
  458.          SEGSUP MPTVAL
  459. *         SEGSUP INFO
  460. C
  461.          SEGSUP TRA
  462. C
  463.   500 CONTINUE
  464.       RETURN
  465. C
  466. C
  467.  9990 CONTINUE
  468. *
  469. C-------------------------------------------------------------------
  470. C         ERREUR DANS UNE ZONE , DESACTIVATION ET RETOUR
  471. C-------------------------------------------------------------------
  472. *
  473. *
  474. *
  475.        MPTVAL=IVAJAC
  476.        SEGSUP MPTVAL
  477. *
  478. *
  479. *
  480. *      SEGSUP INFO
  481.       END
  482.  
  483.  
  484.  
  485.  
  486.  

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