Télécharger la plaquette Cast3M


fr en

Télécharger hook2d.eso

Retour à la liste

Numérotation des lignes : 

hook2d

  1. C HOOK2D    SOURCE    OF166741  25/02/21    21:17:29     12166          
  2.       SUBROUTINE HOOK2D(IPMODE,CMATE,INAT,MFR,IVAMAT,NMATT,IVACAR,
  3.      1                 NCARR,NPINT,IVARI,NVART,IVAHOO,KCAS,NBPGAU,
  4.      2                           LHOOK,LW,LASURF,IPORE,IRET)
  5. C_______________________________________________________________________
  6. C
  7. C     Calcul de la matrice de HOOKE
  8. C
  9. C    Entr{es:
  10. C    ________
  11. C
  12. C     IPMODE   Pointeur sur un segment imodel
  13. C     CMATE   Type du mat{riau (isotrope, orthotrope .....)
  14. C     INAT    Numero de plasticite
  15. C     MFR     Numero de formulation
  16. C     IVAMAT  Pointeur sur un tableau de MELVAL de MATERIAU
  17. C     NMATT   Nombre de composantes de materiau
  18. C     IVACAR  Pointeur sur un tableau de MELVAL de CARACTERISTIQUES
  19. C     NCARR   Nombre de composantes de caracteristiques
  20. C     NPINT   Nombre de points d integration
  21. C     IVARI   Pointeur sur un tableau de MELVAL de VARIABLES INTERNES
  22. C     NVART   Nombre de composantes de variables internes
  23. C     IVAHOO  Pointeur sur le MELVAL de HOOKE
  24. C     NBPGAU  Nombre de points d integration
  25. C     LHOOK   Taille de la matrice de HOOKE
  26. C     LW      Taille du tableau de travail WORK
  27. C     LASURF  1 si on veut la matrice en surface de ref, 0 sinon
  28. C     IPORE   dimension pour milieux poreux
  29. C
  30. C    Sorties:
  31. C    ________
  32. C
  33. C     IRET=1 OU 0 suivant succes ou pas
  34. C
  35. C
  36. C     CODE L EBERSOLT MAI 84
  37. C
  38. C     Passage aux nouveaux CHAMELEMs par I.Monnier le 18.06.90
  39. C     ADDITION DES MATERIAUX ORTHOTROPE ET ANISOTROPE
  40. C     PAR P.DOWLATYARI DEC. 90
  41. C_______________________________________________________________________
  42. C
  43.       IMPLICIT INTEGER(I-N)
  44.       IMPLICIT REAL*8(A-H,O-Z)
  45.  
  46. -INC PPARAM
  47. -INC CCOPTIO
  48. -INC CCHAMP
  49.  
  50. -INC SMMODEL
  51. -INC SMELEME
  52. -INC SMCOORD
  53. -INC SMINTE
  54. -INC SMCHAML
  55. -INC SMLREEL
  56.  
  57. -INC TMPTVAL
  58.  
  59.       SEGMENT WRK2
  60.         REAL*8 XE(3,NBNN),TXR(IDIM,IDIM)
  61.         REAL*8 XLOC(3,3),XGLOB(3,3)
  62.         REAL*8 D1HOOK(LHOOK,LHOOK),ROTHOO(LHOOK,LHOOK)
  63.       ENDSEGMENT
  64. *
  65.       SEGMENT WRK4
  66.        REAL*8 SHPWRK(6,NBNN), BGENE(NSTRS,LRE)
  67.        REAL*8 BPSS(3,3), XEL(3,NBNN)
  68.       ENDSEGMENT
  69. *
  70.       SEGMENT TRAV
  71.         REAL*8 VALCAR(LW),VALMAT(NMATT),VAR(NVART)
  72.         REAL*8 DDHOOK(LHOOK,LHOOK),DDHOMU(LHOOK,LHOOK)
  73.         REAL*8 COBMA(LHOOK)
  74.       ENDSEGMENT
  75. C
  76.       DIMENSION CRIGI(12),CMASS(12),S(20)
  77.       CHARACTER*8 CMATE
  78.       PARAMETER(XZER=0.D0,X774=.774596669241483D0)
  79. C
  80.       IRET=1
  81.       IGAU=0
  82.       IB  =0
  83.       IMODEL=IPMODE
  84.       MELE=NEFMOD
  85. C
  86. C     RECUPERATION DES TAILLES DE TABLEAUX
  87. C
  88.       MELVAL=IVAHOO
  89.       NBPTEL=IELCHE(/1)
  90.       NEL   =IELCHE(/2)
  91.       MPTVAL=IVAMAT
  92.       NBGMAT = 0
  93.       NELMAT = 0
  94.       DO 1000 IM=1,NMATT
  95.        IF(IVAL(IM).NE.0)THEN
  96.          MELVAL=IVAL(IM)
  97.            IF(CMATE.EQ.'SECTION ')THEN
  98.              NBGMAT=MAX(NBGMAT,IELCHE(/1))
  99.              NELMAT=MAX(NELMAT,IELCHE(/2))
  100.            ELSE
  101.              NBGMAT=MAX(NBGMAT,VELCHE(/1))
  102.              NELMAT=MAX(NELMAT,VELCHE(/2))
  103.            ENDIF
  104.        ENDIF
  105.  1000 CONTINUE
  106.       MPTVAL=IVACAR
  107.       DO 1001 IO=1,NCARR
  108.           IF(IVAL(IO).NE.0)THEN
  109.            MELVAL=IVAL(IO)
  110.             IF (CMATE.EQ.'SECTION ') THEN
  111.               NBGMAT=MAX(NBGMAT,IELCHE(/1))
  112.               NELMAT=MAX(NELMAT  ,IELCHE(/2))
  113.             ELSE
  114.               NBGMAT=MAX(NBGMAT,VELCHE(/1))
  115.               NELMAT=MAX(NELMAT  ,VELCHE(/2))
  116.             ENDIF
  117.           ENDIF
  118.  1001      CONTINUE
  119.          IF (IVARI.NE.0) THEN
  120.            MPTVAL=IVARI
  121.            DO 1002 IO=1,NVART
  122.             MELVAL=IVAL(IO)
  123.             IF(MELVAL.NE.0)THEN
  124.               IF (CMATE.EQ.'SECTION ') THEN
  125.                 NBGMAT=MAX(NBGMAT,IELCHE(/1))
  126.                 NELMAT=MAX(NELMAT  ,IELCHE(/2))
  127.               ELSE
  128.                 NBGMAT=MAX(NBGMAT,VELCHE(/1))
  129.                 NELMAT=MAX(NELMAT  ,VELCHE(/2))
  130.               ENDIF
  131.             ENDIF
  132.  1002        CONTINUE
  133.          ENDIF
  134. C
  135. C     INITIALISATION DES TABLEAUX DE TRAVAIL
  136. C
  137.       IF(MFR.EQ.15.AND.NBPGAU.EQ.1) THEN
  138.         DO 10 I=1,NBPGAU
  139.           S(I)= XZER
  140.  10     CONTINUE
  141.       ELSE IF(MFR.EQ.15.AND.NBPGAU.EQ.3) THEN
  142.         DO 11 I=1,NBPGAU
  143.            S(1)=-X774
  144.            S(2)= XZER
  145.            S(3)= X774
  146.  11     CONTINUE
  147.       ENDIF
  148. *
  149.       NMAT1=NMATT
  150. * cette sequence est presente car la troisieme composante
  151. * (eventuellement) obligatoire est la septieme composante du materiau
  152.       IF(INAT.EQ.26) NMATT=NMATT+4
  153.       SEGINI TRAV
  154. *
  155.         IF ((CMATE.EQ.'ORTHOTRO'.OR.CMATE.EQ.'ANISOTRO'.OR.
  156.      1     CMATE.EQ.'UNIDIREC').OR.(MFR.EQ.55)) THEN
  157. C                RENSEIGNEMENTS SUR LE MAILLAGE
  158.            MELEME=IMAMOD
  159. C           SEGACT MELEME
  160.            NBNN=NUM(/1)
  161.            SEGINI WRK2
  162. *
  163.            IF(MFR.EQ.55)THEN
  164.              LRE=NBNN*IDIM
  165.              NSTRS=LHOOK
  166.              SEGINI,WRK4
  167.            ENDIF
  168. *
  169.         ENDIF
  170. C
  171. C
  172. C
  173.        IF (((CMATE.EQ.'ORTHOTRO'.OR.CMATE.EQ.'ANISOTRO'.OR.
  174.      1     CMATE.EQ.'UNIDIREC').AND.(MFR.EQ.1.OR.MFR.EQ.33))
  175.      1     .OR.(MFR.EQ.55)) THEN
  176. C
  177. C     RENSEIGNEMENTS SUR LE MAILLAGE
  178. C
  179.         NBNO=NBNN
  180.         IF(MFR.EQ.33) NBNO=IPORE
  181. *
  182. *  RECUPERATION DES FONCTIONS DE FORME ET LEURS DERIVEES AU CENTRE DE
  183. *  L'ELEMENT POUR LE CALCUL DES AXES LOCAUX
  184.         IELE=NUMGEO(MELE)
  185.         CALL RESHPT(1,NBNO,IELE,MELE,NPINT,IPT1,IRT1)
  186.         MINTE2=IPT1
  187.         SEGACT MINTE2
  188.       ENDIF
  189. C
  190. C  Boucle sur les elements
  191. C
  192.       DO 1100 IB=1,NEL
  193. C
  194.       IF ((CMATE.EQ.'ORTHOTRO'.OR.CMATE.EQ.'ANISOTRO'.OR.
  195.      1     CMATE.EQ.'UNIDIREC').AND.(MFR.EQ.1.OR.MFR.EQ.33)) THEN
  196. C
  197. C     ON CHERCHE  LES COORDONNEES DES NOEUDS DE L ELEMENT IB
  198. C
  199.           CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  200. C
  201. C     CALCUL DES AXES LOCAUX
  202. C
  203.           NBSH=MINTE2.SHPTOT(/2)
  204.           CALL RLOCAL(XE,MINTE2.SHPTOT,NBSH,NBNN,TXR)
  205.         if (nbsh.eq.-1) then
  206.          call erreur(525)
  207.          return
  208.         endif
  209.         ENDIF
  210. C
  211. C  Boucle sur les points
  212. C
  213.        DO 1101 IGAU=1,NBPTEL
  214. C
  215.         MPTVAL=IVAMAT
  216.         DO 1005 IM=1,NMAT1
  217.           IF (IVAL(IM).NE.0) THEN
  218.             MELVAL=IVAL(IM)
  219.             IBMN=MIN(IB  ,VELCHE(/2))
  220.             IGMN=MIN(IGAU,VELCHE(/1))
  221.             VALMAT(IM)=VELCHE(IGMN,IBMN)
  222.           ELSE
  223.             VALMAT(IM)=0.D0
  224.           ENDIF
  225.  1005   CONTINUE
  226. *
  227. * cette sequence est presente car la troisieme composante
  228. * (eventuellement) obligatoire est la septieme composante du materiau
  229.        IF(INAT.EQ.26) THEN
  230.          VALMAT(7)=VALMAT(3)
  231.          DO 1006 ICOMP=3,6
  232.                VALMAT(ICOMP)=0.D0
  233.  1006    CONTINUE
  234.        ENDIF
  235. C
  236.        IF(INAT.EQ.26.OR.INAT.EQ.29.OR.INAT.EQ.30.OR.
  237.      .    INAT.EQ.62.OR.INAT.EQ.64.OR.INAT.EQ.65.OR.INAT.EQ.118) THEN
  238.          MPTVAL=IVARI
  239.          DO 1007 IM=1,NVART
  240.            IF (IVAL(IM).NE.0) THEN
  241.              MELVAL=IVAL(IM)
  242.              IBMN=MIN(IB  ,VELCHE(/2))
  243.              IGMN=MIN(IGAU,VELCHE(/1))
  244.              VAR(IM)=VELCHE(IGMN,IBMN)
  245.            ELSE
  246.              VAR(IM)=0.D0
  247.            ENDIF
  248.  1007    CONTINUE
  249.        ENDIF
  250. C
  251.  
  252.        IF(MFR.EQ.61)THEN
  253.          DO ICOMP=1,NCARR
  254.            MPTVAL=IVACAR
  255.            MELVAL=IVAL(ICOMP)
  256.            IF (MELVAL.NE.0) THEN
  257.              IBMN=MIN(IB  ,VELCHE(/2))
  258.              IGMN=MIN(IGAU,VELCHE(/1))
  259.              VALCAR(ICOMP)=VELCHE(IGMN,IBMN)
  260.            ELSE
  261.              VALCAR(ICOMP)=0.D0
  262.            ENDIF
  263.          ENDDO
  264.        ENDIF
  265.  
  266. C
  267.        IF(MFR.EQ.7.OR.MFR.EQ.13.OR.MFR.EQ.15.
  268.      1                     OR.MFR.EQ.17) THEN
  269. C
  270. C  ON CHERCHE LES CARACTERISTIQUES DE L ELEMENT IB
  271. C
  272.         IF(CMATE.EQ.'SECTION ') THEN
  273. C
  274.            MPTVAL=IVAMAT
  275.            MELVAL=IVAL(1)
  276.            IBMN=MIN(IB  ,IELCHE(/2))
  277.            IGMN=MIN(IGAU,IELCHE(/1))
  278.            IPMODL=IELCHE(IGMN,IBMN)
  279.            MELVAL=IVAL(2)
  280.            IBMN=MIN(IB  ,IELCHE(/2))
  281.            IGMN=MIN(IGAU,IELCHE(/1))
  282.            IPCAR=IELCHE(IGMN,IBMN)
  283.            CALL FRIGIE(IPMODL,IPCAR,CRIGI,CMASS)
  284. C
  285.         ELSEIF (MFR.EQ.15) THEN
  286. C
  287.            IE=1
  288.            DO      IC=1,3,2
  289.              MPTVAL=IVACAR
  290.              DO      ICOMP=1,NCARR
  291.                MELVAL=IVAL(ICOMP)
  292.                IF (MELVAL.NE.0) THEN
  293.                  IGMN=MIN(IC,VELCHE(/1))
  294.                  IBMN=MIN(IB,VELCHE(/2))
  295.                  VALCAR(IE)=VELCHE(IGMN,IBMN)
  296.                ELSE
  297.                  VALCAR(IE)=0.D0
  298.               ENDIF
  299.               IE=IE+1
  300.              ENDDO
  301.            ENDDO
  302. C
  303.         ELSE
  304. C
  305.            DO 1010 ICOMP=1,NCARR
  306.              MPTVAL=IVACAR
  307.              MELVAL=IVAL(ICOMP)
  308.              IF (MELVAL.NE.0) THEN
  309.                IBMN=MIN(IB  ,VELCHE(/2))
  310.                IGMN=MIN(IGAU,VELCHE(/1))
  311.                VALCAR(ICOMP)=VELCHE(IGMN,IBMN)
  312.              ELSE
  313.                VALCAR(ICOMP)=0.D0
  314.              ENDIF
  315.  1010      CONTINUE
  316.         ENDIF
  317.        ENDIF
  318. C
  319.        IF(MFR.EQ.27.OR.MFR.EQ.49) THEN
  320. C
  321. C  ON CHERCHE LA SECTION DE L'ELEMENT IB
  322. C
  323.           MPTVAL=IVACAR
  324.           MELVAL=IVAL(1)
  325.           IF (MELVAL.NE.0) THEN
  326.            IBMN=MIN(IB  ,VELCHE(/2))
  327.            IGMN=MIN(IGAU,VELCHE(/1))
  328.            SECT=VELCHE(IGMN,IBMN)
  329.           ELSE
  330.            SECT=0.D0
  331.           ENDIF
  332.        ENDIF
  333. C
  334. C  ON CHERCHE L'EPAISSEUR DU JOINT GENERALISE IB
  335. C
  336.        IF(MFR.EQ.55) THEN
  337.          MPTVAL=IVACAR
  338.          MELVAL=IVAL(1)
  339.          IF (MELVAL.NE.0) THEN
  340.            IBMN=MIN(IB  ,VELCHE(/2))
  341.            IGMN=MIN(IGAU,VELCHE(/1))
  342.            EPAIST=VELCHE(IGMN,IBMN)
  343.          ELSE
  344.            EPAIST=0.D0
  345.          ENDIF
  346. C
  347.          IF(EPAIST.EQ.0.D0) THEN
  348.            CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  349.            IF(MELE.EQ.170)THEN
  350.              CALL JO2LOC(XE,MINTE2.SHPTOT,NBNN,XEL,BPSS,NOQUAL)
  351.              CALL BJO2GN(IGAU,MFR,IFOUR,NIFOUR,XE,XEL,BPSS,
  352.      .       MINTE2.SHPTOT,SHPWRK,EPAIST,BGENE,DJAC,XDPGE,YDPGE,IERT)
  353.            ELSEIF(MELE.EQ.171)THEN
  354.              CALL JT3LOC(XE,MINTE2.SHPTOT,NBNN,XEL,BPSS,NOQUAL)
  355.              CALL BJT3G(IGAU,MFR,IFOUR,NIFOUR,XE,XEL,BPSS,
  356.      .       MINTE2.SHPTOT,SHPWRK,EPAIST,BGENE,DJAC,IERT)
  357.            ELSEIF(MELE.EQ.172)THEN
  358.              CALL JO4LOC(XE,MINTE2.SHPTOT,NBNN,XEL,BPSS,NOQUAL)
  359.              CALL BJO4G(IGAU,XE,XEL,BPSS,MINTE2.SHPTOT,SHPWRK,EPAIST,
  360.      .       BGENE,DJAC,IERT)
  361.            ENDIF
  362.          ENDIF
  363.        ENDIF
  364.  
  365. C
  366. C  Prise en compte de l'epaisseur et de l'excentrement
  367. C  dans le cas des coques minces avec ou sans cisaillement
  368. C  transverse
  369. C
  370.         IF ((CMATE.EQ.'ISOTROPE'.OR.CMATE.EQ.'ORTHOTRO'.OR.
  371.      1       CMATE.EQ.'UNIDIREC').AND.
  372.      2                       (MFR.EQ.3.OR.MFR.EQ.9)) THEN
  373.          MPTVAL=IVACAR
  374.          MELVAL=IVAL(1)
  375.          IF (MELVAL.NE.0) THEN
  376.            IBMN=MIN(IB  ,VELCHE(/2))
  377.            IGMN=MIN(IGAU,VELCHE(/1))
  378.            EPAIST=VELCHE(IGMN,IBMN)
  379.          ELSE
  380.            CALL ERREUR(527)
  381.            IRET=0
  382.            GOTO 9000
  383.          ENDIF
  384. C
  385.          IF(LASURF.EQ.0) THEN
  386.            EXCEN = 0.D0
  387.          ELSE
  388.            MELVAL=IVAL(2)
  389.            IF (MELVAL.NE.0) THEN
  390.               IBMN=MIN(IB  ,VELCHE(/2))
  391.               IGMN=MIN(IGAU,VELCHE(/1))
  392.               EXCEN=VELCHE(IGMN,IBMN)
  393.            ELSE
  394.             EXCEN=0.D0
  395.            ENDIF
  396.          ENDIF
  397.         ENDIF
  398.  
  399. C_______________________________________________________________________
  400. C
  401. C                  TRAITEMENT SUIVANT TYPE DE MATERIAU
  402. C_______________________________________________________________________
  403. C
  404.       IF (CMATE.EQ.'ISOTROPE'.OR.CMATE.EQ.'ZONE_COH') THEN
  405.         CALL HOOKIS(VALMAT,VALCAR,VAR,MFR,IB,IGAU,EXCEN,EPAIST,
  406.      +       INAT,MELE,NPINT,IFOUR,KCAS,NBGMAT,NELMAT,
  407.      +       S,SECT,LHOOK,DDHOMU,DDHOOK,
  408.      +       COBMA,XMOB,IRET)
  409. C
  410.       ELSE IF (CMATE.EQ.'ORTHOTRO') THEN
  411.         CALL HOOKOR(VALMAT,IB,IGAU,MFR,EXCEN,EPAIST,
  412.      +   MELE,NPINT,IFOUR,KCAS,NBGMAT,NELMAT,SECT,LHOOK,
  413.      +   TXR,XLOC,XGLOB,D1HOOK,ROTHOO,DDHOMU,DDHOOK,
  414.      +   COBMA,XMOB,IRET)
  415. C
  416.       ELSE IF (CMATE.EQ.'ANISOTRO') THEN
  417.         CALL HOOKAN(VALMAT,IB,IGAU,MFR,IFOUR,KCAS,NBGMAT,NELMAT,
  418.      +      SECT,LHOOK,TXR,XLOC,XGLOB,D1HOOK,ROTHOO,DDHOOK,
  419.      +      MELE,COBMA,XMOB,IRET)
  420. C
  421.       ELSE IF (CMATE.EQ.'UNIDIREC') THEN
  422.         CALL HOOKUN(VALMAT,IB,IGAU,MFR,EXCEN,EPAIST,
  423.      +   MELE,NPINT,IFOUR,KCAS,NBGMAT,NELMAT,SECT,LHOOK,
  424.      +   TXR,XLOC,XGLOB,D1HOOK,ROTHOO,DDHOMU,DDHOOK,
  425.      +   COBMA,XMOB,IRET)
  426. C
  427.       ELSE IF (CMATE.EQ.'HOMOGENE') THEN
  428.         CALL HOOKHO(VALMAT,IB,IGAU,MFR,NBGMAT,NELMAT,SECT,
  429.      +                                       LHOOK,DDHOOK,IRET)
  430. C
  431.       ELSE IF (CMATE.EQ.'SECTION ') THEN
  432.         CALL HOOKSE(VALMAT,IB,IGAU,MFR,CRIGI,IFOUR,
  433.      +            NBGMAT,NELMAT,SECT,LHOOK,DDHOOK,IRET)
  434. C
  435.       ENDIF
  436. C
  437.       IF (IRET.EQ.0) THEN
  438.         IF (MFR.EQ.3.AND.NPINT.NE.0) THEN
  439.           CALL ERREUR(251)
  440.         ELSE
  441.           MOTERR(1:8)=NOMFR(MFR/2+1)
  442.           CALL ERREUR(193)
  443.         ENDIF
  444.         GOTO 1200
  445.       ENDIF
  446. C
  447.  
  448. C
  449. C   REMPLISSAGE DU SEGMENT IVAHOO
  450. C
  451.         MELVAL=IVAHOO
  452.         MLREEL=IELCHE(IGAU,IB)
  453.         KO=0
  454.         DO JO=1,LHOOK
  455.           DO IO=1,LHOOK
  456.             KO=(JO-1)*LHOOK + IO
  457.             PROG(KO)=DDHOOK(IO,JO)
  458.           ENDDO
  459.         ENDDO
  460.  1101  CONTINUE
  461.  1100  CONTINUE
  462. * section non // pour les activations en nomod
  463.       call oooprl(1)
  464.       DO 1102 IB=1,NEL
  465.        DO 1103 IGAU=1,NBPTEL
  466.         MLREEL=IELCHE(IGAU,IB)
  467.         SEGACT,MLREEL*NOMOD
  468.  1103 continue
  469.  1102 continue
  470.       call oooprl(0)
  471. C
  472.  1200  CONTINUE
  473.        IF ((CMATE.EQ.'ORTHOTRO'.OR.CMATE.EQ.'ANISOTRO'.OR.
  474.      1      CMATE.EQ.'UNIDIREC').AND.(MFR.EQ.1.OR.MFR.EQ.33)) THEN
  475. **        SEGDES MINTE2
  476.         ENDIF
  477. *
  478.  9000 CONTINUE
  479.       IF ((CMATE.EQ.'ORTHOTRO'.OR.CMATE.EQ.'ANISOTRO'.OR.
  480.      1     CMATE.EQ.'UNIDIREC')) THEN
  481. **        SEGDES MELEME
  482.           SEGSUP WRK2
  483.       ENDIF
  484.       IF (MFR.EQ.55) SEGSUP WRK4
  485.       SEGSUP TRAV
  486.  
  487.       RETURN
  488.       END
  489.  
  490.  
  491.  

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