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

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