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    OF166741  25/02/21    21:17:36     12166          
  2.  
  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.       SUBROUTINE JACONO(IPMODL,INORM,IPCHE,IRET)
  25.  
  26.       IMPLICIT INTEGER(I-N)
  27.       IMPLICIT REAL*8(A-H,O-Z)
  28.  
  29. -INC PPARAM
  30. -INC CCOPTIO
  31. -INC CCHAMP
  32.  
  33. -INC SMCHAML
  34. -INC SMMODEL
  35. -INC SMELEME
  36. -INC SMCOORD
  37. -INC SMINTE
  38.  
  39. -INC TMPTVAL
  40.  
  41.       SEGMENT TRA
  42.          REAL*8 XEL(3,NBNN) ,SHP(6,NBNN) ,XE(3,NBNN)
  43.       ENDSEGMENT
  44. C
  45.       SEGMENT TR1
  46.          REAL*8 TH(NBN1) ,TXR(3,3,NBN1) ,XJ(3,3)
  47.       ENDSEGMENT
  48. C
  49.       SEGMENT INFO
  50.          INTEGER INFELL(JG)
  51.       ENDSEGMENT
  52.  
  53.       PARAMETER(UN=1.D0,XZER=0.D0)
  54.       DIMENSION BPSS(3,3)
  55.  
  56.       DIMENSION XU(3), XV(3), XW(3)
  57.  
  58.       IDIMP1 = IDIM+1
  59.       NHRM=NIFOUR
  60.       IRET=1
  61. C
  62. C     ACTIVATION DU MODELE
  63. C
  64.       MMODEL= IPMODL
  65.       SEGACT MMODEL
  66.       NSOUS=KMODEL(/1)
  67. C
  68. C     CREATION DU MCHELM
  69. C
  70.       N1=NSOUS
  71.       N3=6
  72.       IF (INORM .EQ. 1) THEN
  73.         L1=8
  74.       ELSE
  75.         L1=16
  76.       ENDIF
  77.       SEGINI MCHELM
  78.       IF (INORM .EQ. 1) THEN
  79.          TITCHE='NORMALES'
  80.       ELSE
  81.          TITCHE='VECTEURS SURFACE'
  82.       ENDIF
  83.       IFOCHE=IFOUR
  84.       IPCHE=MCHELM
  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.          N2PTEL=0
  162.          N2EL  =0
  163. C
  164. C     CREATION DU MCHAML DE LA SOUS ZONE
  165. C
  166.          NJAC=IDIM
  167.          N2 = NJAC
  168.          SEGINI MCHAML
  169.          ICHAML(ISOUS)=MCHAML
  170.          NSR   =1
  171.          NCOSOR=NJAC
  172.          SEGINI MPTVAL
  173.          IVAJAC=MPTVAL
  174. C
  175. C     2 OU 3 COMPOSANTES
  176. C
  177.          ICOMP=1
  178.          IF (IFOUR.EQ.0.OR.IFOUR.EQ.1) THEN
  179.             NOMCHE(ICOMP)='VR  '
  180.          ELSE
  181.             NOMCHE(ICOMP)='VX  '
  182.          ENDIF
  183.          TYPCHE(ICOMP)='REAL*8'
  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.          SEGINI MELVA2
  196.          IELVAL(ICOMP)=MELVA2
  197.          IVAL(ICOMP)=MELVA2
  198. C
  199.          MELVA3 = 0
  200.          IF (IDIM .EQ. 3) THEN
  201.             ICOMP=3
  202.             NOMCHE(ICOMP)='VZ  '
  203.             TYPCHE(ICOMP)='REAL*8'
  204.             SEGINI MELVA3
  205.             IELVAL(ICOMP)=MELVA3
  206.             IVAL(ICOMP)=MELVA3
  207.          ENDIF
  208. C
  209.          SEGINI TRA
  210. C
  211. C ================ FORMULATION MASSIVE =======================
  212. C
  213.          IF(MFR.EQ.1.OR.MFR.EQ.33) THEN
  214.             GOTO 520
  215. C
  216. C ================ FORMULATION COQUE  MINCE =====================
  217. C
  218. C
  219.          ELSE IF(MFR.EQ.3.OR.MFR.EQ.9 .OR. MFR.EQ.77) THEN
  220.           IDI2=IDIM-1
  221.           DO 3000 IB=1,NBELEM
  222. *--------------Calcul de la normale a l'élément
  223.             IREF1 = IDIMP1*(MELEME.NUM(1, IB) - 1)
  224.             IREF2 = IDIMP1*(MELEME.NUM(2, IB) - 1)
  225.             XNORU = 0.D0
  226.             DO IC = 1, IDIM
  227.                r_z = XCOOR(IREF2+IC)-XCOOR(IREF1+IC)
  228.                XU(IC) = r_z
  229.                XNORU = XNORU + (r_z * r_z)
  230.             ENDDO
  231.             XNORU = SQRT(XNORU)
  232.             DO IC = 1, IDIM
  233.                XU(IC) = XU(IC)/XNORU
  234.             ENDDO
  235.             IF (IDIM .EQ. 2) THEN
  236.                XW(1) = -XU(2)
  237.                XW(2) = XU(1)
  238.             ELSE
  239.                IN = 3
  240.    33          IREF3 = IDIMP1*(MELEME.NUM(IN, IB) - 1)
  241.                XNORV = 0.D0
  242.                DO IC = 1, IDIM
  243.                   r_z = XCOOR(IREF3+IC)-XCOOR(IREF1+IC)
  244.                   XV(IC) = r_z
  245.                   XNORV = XNORV + (r_z * r_z)
  246.                ENDDO
  247.                XNORV = SQRT(XNORV)
  248.                DO IC = 1, IDIM
  249.                  XV(IC) = XV(IC)/XNORV
  250.                ENDDO
  251.                XW(1) = XU(2)*XV(3) - XU(3)*XV(2)
  252.                XW(2) = XU(3)*XV(1) - XU(1)*XV(3)
  253.                XW(3) = XU(1)*XV(2) - XU(2)*XV(1)
  254.                XNORW = 0.
  255.                DO IC = 1, IDIM
  256.                  XNORW = XNORW + XW(IC)*XW(IC)
  257.                ENDDO
  258.                IF (XNORW .LT. 1.E-4) THEN
  259.                   IN = IN + 1
  260.                   if(IN.le.NBNN) GOTO 33
  261.                ENDIF
  262.                XNORW = SQRT(XNORW)
  263.                IF(XNORW .LT.1.E-4) call erreur(345)
  264.                DO IC = 1, IDIM
  265.                   XW(IC) = XW(IC)/XNORW
  266.                ENDDO
  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.             MPTVAL=IVAJAC
  278.             DO 3002 IC=1,NBPGAU
  279.                IF (INORM .EQ. 1) THEN
  280.                   DJAC = 1.D0
  281.                ELSE
  282.                   DO IE=1,NBNN
  283.                      DO ID=1,6
  284.                         SHP(ID,IE)=SHPTOT(ID,IE,IC)
  285.                      ENDDO
  286.                   ENDDO
  287.                   CALL JACOBI(XEL,SHP,IDI2,NBNN,DJAC)
  288.                ENDIF
  289.                MELVAL = IVAL(1)
  290.                IBMN=MIN(IB, MELVAL.VELCHE(/2))
  291.                IGMN=MIN(IC,MELVAL.VELCHE(/1))
  292.                MELVAL.VELCHE(IGMN,IBMN)=DJAC*XW(1)
  293.                MELVAL = IVAL(2)
  294.                IBMN=MIN(IB, MELVAL.VELCHE(/2))
  295.                IGMN=MIN(IC,MELVAL.VELCHE(/1))
  296.                MELVAL.VELCHE(IGMN,IBMN)=DJAC*XW(2)
  297.                IF (IDIM .EQ. 3) THEN
  298.                   MELVAL = IVAL(3)
  299.                   IBMN=MIN(IB, MELVAL.VELCHE(/2))
  300.                   IGMN=MIN(IC,MELVAL.VELCHE(/1))
  301.                   MELVAL.VELCHE(IGMN,IBMN)=DJAC*XW(3)
  302.                ENDIF
  303.  3002       CONTINUE
  304.  3000    CONTINUE
  305.          GOTO 520
  306. C
  307. C ================ FORMULATION POUTRE ET TUYAU ====================
  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 = IDIMP1*(MELEME.NUM(1, IB) - 1)
  314.             IREF2 = IDIMP1*(MELEME.NUM(2, IB) - 1)
  315.             XNORU = 0.D0
  316.             DO IC = 1, IDIM
  317.                r_z = XCOOR(IREF2+IC)-XCOOR(IREF1+IC)
  318.                XU(IC) = r_z
  319.                XNORU = XNORU + (r_z * r_z)
  320.             ENDDO
  321.             XNORU = SQRT(XNORU)
  322.             DO IC = 1, IDIM
  323.                XU(IC) = XU(IC)/XNORU
  324.             ENDDO
  325. *-----------Fin du calcul de la tangente a l'élément
  326. *-----------Calcul de la tangente a l'élément en chaque point de Gauss
  327. c  BP : On suppose le jacobien constant dans l'element (idem POUJAC.eso)
  328. C  => on sort le calcul du jacobien de la boucle sur les points de Gauss.
  329. C  Cela implique que la POUTre de Bernoulli n'est pas isoparamétrique...
  330.             IF (INORM .EQ. 1) THEN
  331.                DJAC = 1.D0
  332.             ELSE
  333.                DJAC = 1.D0/DBLE(NBPGAU)
  334.             ENDIF
  335.             MPTVAL=IVAJAC
  336.             DO 4002 IC=1,NBPGAU
  337.                MELVAL = IVAL(1)
  338.                IBMN=MIN(IB, MELVAL.VELCHE(/2))
  339.                IGMN=MIN(IC,MELVAL.VELCHE(/1))
  340.                MELVAL.VELCHE(IGMN,IBMN)=DJAC*XU(1)
  341.                MELVAL = IVAL(2)
  342.                IBMN=MIN(IB, MELVAL.VELCHE(/2))
  343.                IGMN=MIN(IC,MELVAL.VELCHE(/1))
  344.                MELVAL.VELCHE(IGMN,IBMN)=DJAC*XU(2)
  345.                IF (IDIM .EQ. 3) THEN
  346.                   MELVAL = IVAL(3)
  347.                   IBMN=MIN(IB, MELVAL.VELCHE(/2))
  348.                   IGMN=MIN(IC,MELVAL.VELCHE(/1))
  349.                   MELVAL.VELCHE(IGMN,IBMN)=DJAC*XU(3)
  350.                ENDIF
  351.  4002       CONTINUE
  352.  4000    CONTINUE
  353.  
  354.          GOTO 520
  355. C
  356. C ================ FORMULATION COQUE  EPAISSE ====================
  357. C
  358.          ELSE IF(MFR.EQ.5) THEN
  359.             SEGACT MINTE1
  360.             NBPGA1=MINTE1.POIGAU(/1)
  361.             NBN1  =MINTE1.SHPTOT(/2)
  362.             SEGINI TR1
  363. C
  364. C     UNE PETITE HORREUR ON CONSIDERE LES EPAISSEURS CONSTANTES
  365. C
  366.             DO 5010 IC=1,NBNN
  367.                TH(IC)=UN
  368.  5010       CONTINUE
  369.             DO 5000 IB=1,NBELEM
  370. *--------------Calcul de la normale a l'élément
  371.                IREF1 = IDIMP1*(MELEME.NUM(1, IB) - 1)
  372. *               IREF2 = IDIMP1*(MELEME.NUM(2, IB) - 1)
  373. * bp : les EF de coque epaisse etant quadratiques (coq6 et coq8), on
  374. * prend les noeuds "coins" pour eviter pb avec les noeuds 1,2,3 si courbures
  375.                IREF2 = IDIMP1*(MELEME.NUM(3, IB) - 1)
  376.                XNORU = 0.
  377.                DO IC = 1, IDIM
  378.                   r_z = XCOOR(IREF2+IC)-XCOOR(IREF1+IC)
  379.                   XU(IC) = r_z
  380.                   XNORU = XNORU + (r_z * r_z)
  381.                ENDDO
  382.                XNORU = SQRT(XNORU)
  383.                DO IC = 1, IDIM
  384.                   XU(IC) = XU(IC)/XNORU
  385.                ENDDO
  386.                IF (IDIM .EQ. 2) THEN
  387.                   XW(1) = -XU(2)
  388.                   XW(2) = XU(1)
  389.                ELSE
  390. *                  IN = 3
  391.                   IN = 5
  392.    13             IREF3 = IDIMP1*(MELEME.NUM(IN, IB) - 1)
  393.                   XNORV = 0.D0
  394.                   DO IC = 1, IDIM
  395.                     r_z = XCOOR(IREF3 + IC) - XCOOR(IREF1 + IC)
  396.                     XV(IC) = r_z
  397.                     XNORV = XNORV + (r_z * r_z)
  398.                   ENDDO
  399.                   XNORV = SQRT(XNORV)
  400.                   DO IC = 1, IDIM
  401.                     XV(IC) = XV(IC)/XNORV
  402.                   ENDDO
  403.                   XW(1) = XU(2)*XV(3) - XU(3)*XV(2)
  404.                   XW(2) = XU(3)*XV(1) - XU(1)*XV(3)
  405.                   XW(3) = XU(1)*XV(2) - XU(2)*XV(1)
  406.                   XNORW = 0.
  407.                   DO IC = 1, IDIM
  408.                      XNORW = XNORW + XW(IC)*XW(IC)
  409.                   ENDDO
  410.                   XNORW = SQRT(XNORW)
  411.                   IF (XNORW .LT. 1.E-4) THEN
  412.                    if(IN.LT.NBNN) then
  413.                      IN = IN + 1
  414.                      GOTO 13
  415.                    else
  416.                     write(6,*) 'Difficultes pour etablir la normale de'
  417.                     write(6,*) 'l element',IB
  418.                     write(6,*) 'Verifiez votre maillage'
  419.                     GOTO 9990
  420.                    endif
  421.                   ENDIF
  422.                   DO IC = 1, IDIM
  423.                      XW(IC) = XW(IC)/XNORW
  424.                   ENDDO
  425.                ENDIF
  426. *--------------Fin du calcul de la normale a l'élément
  427.                IF (INORM .EQ. 0) THEN
  428.                   CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  429. C
  430.                   CALL CQ8LOC(XE,NBN1,MINTE1.SHPTOT,TXR,IRR)
  431.                ENDIF
  432. C
  433.                MPTVAL=IVAJAC
  434.                DO 5002 IC=1,NBPGAU
  435.                   IF (INORM .EQ. 1) THEN
  436.                      DJAC = 1.D0
  437.                   ELSE
  438.                      E=DZEGAU(IC)
  439.          CALL COQ8JC(IC,NBN1,E,XE,TH,TXR,SHPTOT,XJ,DJAC,IRR)
  440.                   ENDIF
  441.                   MELVAL = IVAL(1)
  442.                   IBMN=MIN(IB, MELVAL.VELCHE(/2))
  443.                   IGMN=MIN(IC, MELVAL.VELCHE(/1))
  444.                   MELVAL.VELCHE(IGMN,IBMN)=DJAC*XW(1)
  445.                   MELVAL = IVAL(2)
  446.                   IBMN=MIN(IB, MELVAL.VELCHE(/2))
  447.                   IGMN=MIN(IC, MELVAL.VELCHE(/1))
  448.                   MELVAL.VELCHE(IGMN,IBMN)=DJAC*XW(2)
  449.                   IF (IDIM .EQ. 3) THEN
  450.                      MELVAL = IVAL(3)
  451.                      IBMN=MIN(IB, MELVAL.VELCHE(/2))
  452.                      IGMN=MIN(IC, MELVAL.VELCHE(/1))
  453.                      MELVAL.VELCHE(IGMN,IBMN)=DJAC*XW(3)
  454.                   ENDIF
  455.  5002          CONTINUE
  456.  5000       CONTINUE
  457.             SEGSUP TR1
  458.             GOTO 520
  459.          ENDIF
  460. C---------------------------------------------------------------------
  461. C  DESACTIVATION DES SEGMENTS PROPRES A LA ZONE GEOMETRIQUE ISOUS
  462. C---------------------------------------------------------------------
  463.  520     CONTINUE
  464.          MPTVAL=IVAJAC
  465.          SEGSUP MPTVAL
  466.          SEGSUP TRA
  467.  
  468.   500 CONTINUE
  469.       RETURN
  470. C
  471. C-------------------------------------------------------------------
  472. C         ERREUR DANS UNE ZONE , DESACTIVATION ET RETOUR
  473. C-------------------------------------------------------------------
  474.  9990 CONTINUE
  475.       IRET = 0
  476.       MPTVAL=IVAJAC
  477.       SEGSUP MPTVAL
  478.  
  479. *      RETURN
  480.       END
  481.  
  482.  
  483.  

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