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    MB234859  26/01/19    21:15:19     12454          
  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.OR.
  238.      &    INAT.EQ.193.OR.INAT.EQ.194.OR.INAT.EQ.195.OR.INAT.EQ.196) THEN
  239.          MPTVAL=IVARI
  240.          DO 1007 IM=1,NVART
  241.            IF (IVAL(IM).NE.0) THEN
  242.              MELVAL=IVAL(IM)
  243.              IBMN=MIN(IB  ,VELCHE(/2))
  244.              IGMN=MIN(IGAU,VELCHE(/1))
  245.              VAR(IM)=VELCHE(IGMN,IBMN)
  246.            ELSE
  247.              VAR(IM)=0.D0
  248.            ENDIF
  249.  1007    CONTINUE
  250.        ENDIF
  251. C
  252.  
  253.        IF(MFR.EQ.61)THEN
  254.          DO ICOMP=1,NCARR
  255.            MPTVAL=IVACAR
  256.            MELVAL=IVAL(ICOMP)
  257.            IF (MELVAL.NE.0) THEN
  258.              IBMN=MIN(IB  ,VELCHE(/2))
  259.              IGMN=MIN(IGAU,VELCHE(/1))
  260.              VALCAR(ICOMP)=VELCHE(IGMN,IBMN)
  261.            ELSE
  262.              VALCAR(ICOMP)=0.D0
  263.            ENDIF
  264.          ENDDO
  265.        ENDIF
  266.  
  267. C
  268.        IF(MFR.EQ.7.OR.MFR.EQ.13.OR.MFR.EQ.15.
  269.      1                     OR.MFR.EQ.17) THEN
  270. C
  271. C  ON CHERCHE LES CARACTERISTIQUES DE L ELEMENT IB
  272. C
  273.         IF(CMATE.EQ.'SECTION ') THEN
  274. C
  275.            MPTVAL=IVAMAT
  276.            MELVAL=IVAL(1)
  277.            IBMN=MIN(IB  ,IELCHE(/2))
  278.            IGMN=MIN(IGAU,IELCHE(/1))
  279.            IPMODL=IELCHE(IGMN,IBMN)
  280.            MELVAL=IVAL(2)
  281.            IBMN=MIN(IB  ,IELCHE(/2))
  282.            IGMN=MIN(IGAU,IELCHE(/1))
  283.            IPCAR=IELCHE(IGMN,IBMN)
  284.            CALL FRIGIE(IPMODL,IPCAR,CRIGI,CMASS)
  285. C
  286.         ELSEIF (MFR.EQ.15) THEN
  287. C
  288.            IE=1
  289.            DO      IC=1,3,2
  290.              MPTVAL=IVACAR
  291.              DO      ICOMP=1,NCARR
  292.                MELVAL=IVAL(ICOMP)
  293.                IF (MELVAL.NE.0) THEN
  294.                  IGMN=MIN(IC,VELCHE(/1))
  295.                  IBMN=MIN(IB,VELCHE(/2))
  296.                  VALCAR(IE)=VELCHE(IGMN,IBMN)
  297.                ELSE
  298.                  VALCAR(IE)=0.D0
  299.               ENDIF
  300.               IE=IE+1
  301.              ENDDO
  302.            ENDDO
  303. C
  304.         ELSE
  305. C
  306.            DO 1010 ICOMP=1,NCARR
  307.              MPTVAL=IVACAR
  308.              MELVAL=IVAL(ICOMP)
  309.              IF (MELVAL.NE.0) THEN
  310.                IBMN=MIN(IB  ,VELCHE(/2))
  311.                IGMN=MIN(IGAU,VELCHE(/1))
  312.                VALCAR(ICOMP)=VELCHE(IGMN,IBMN)
  313.              ELSE
  314.                VALCAR(ICOMP)=0.D0
  315.              ENDIF
  316.  1010      CONTINUE
  317.         ENDIF
  318.        ENDIF
  319. C
  320.        IF(MFR.EQ.27.OR.MFR.EQ.49) THEN
  321. C
  322. C  ON CHERCHE LA SECTION DE L'ELEMENT IB
  323. C
  324.           MPTVAL=IVACAR
  325.           MELVAL=IVAL(1)
  326.           IF (MELVAL.NE.0) THEN
  327.            IBMN=MIN(IB  ,VELCHE(/2))
  328.            IGMN=MIN(IGAU,VELCHE(/1))
  329.            SECT=VELCHE(IGMN,IBMN)
  330.           ELSE
  331.            SECT=0.D0
  332.           ENDIF
  333.        ENDIF
  334. C
  335. C  ON CHERCHE L'EPAISSEUR DU JOINT GENERALISE IB
  336. C
  337.        IF(MFR.EQ.55) THEN
  338.          MPTVAL=IVACAR
  339.          MELVAL=IVAL(1)
  340.          IF (MELVAL.NE.0) THEN
  341.            IBMN=MIN(IB  ,VELCHE(/2))
  342.            IGMN=MIN(IGAU,VELCHE(/1))
  343.            EPAIST=VELCHE(IGMN,IBMN)
  344.          ELSE
  345.            EPAIST=0.D0
  346.          ENDIF
  347. C
  348.          IF(EPAIST.EQ.0.D0) THEN
  349.            CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  350.            IF(MELE.EQ.170)THEN
  351.              CALL JO2LOC(XE,MINTE2.SHPTOT,NBNN,XEL,BPSS,NOQUAL)
  352.              CALL BJO2GN(IGAU,MFR,IFOUR,NIFOUR,XE,XEL,BPSS,
  353.      .       MINTE2.SHPTOT,SHPWRK,EPAIST,BGENE,DJAC,XDPGE,YDPGE,IERT)
  354.            ELSEIF(MELE.EQ.171)THEN
  355.              CALL JT3LOC(XE,MINTE2.SHPTOT,NBNN,XEL,BPSS,NOQUAL)
  356.              CALL BJT3G(IGAU,MFR,IFOUR,NIFOUR,XE,XEL,BPSS,
  357.      .       MINTE2.SHPTOT,SHPWRK,EPAIST,BGENE,DJAC,IERT)
  358.            ELSEIF(MELE.EQ.172)THEN
  359.              CALL JO4LOC(XE,MINTE2.SHPTOT,NBNN,XEL,BPSS,NOQUAL)
  360.              CALL BJO4G(IGAU,XE,XEL,BPSS,MINTE2.SHPTOT,SHPWRK,EPAIST,
  361.      .       BGENE,DJAC,IERT)
  362.            ENDIF
  363.          ENDIF
  364.        ENDIF
  365.  
  366. C
  367. C  Prise en compte de l'epaisseur et de l'excentrement
  368. C  dans le cas des coques minces avec ou sans cisaillement
  369. C  transverse
  370. C
  371.         IF ((CMATE.EQ.'ISOTROPE'.OR.CMATE.EQ.'ORTHOTRO'.OR.
  372.      1       CMATE.EQ.'UNIDIREC').AND.
  373.      2                       (MFR.EQ.3.OR.MFR.EQ.9)) THEN
  374.          MPTVAL=IVACAR
  375.          MELVAL=IVAL(1)
  376.          IF (MELVAL.NE.0) THEN
  377.            IBMN=MIN(IB  ,VELCHE(/2))
  378.            IGMN=MIN(IGAU,VELCHE(/1))
  379.            EPAIST=VELCHE(IGMN,IBMN)
  380.          ELSE
  381.            CALL ERREUR(527)
  382.            IRET=0
  383.            GOTO 9000
  384.          ENDIF
  385. C
  386.          IF(LASURF.EQ.0) THEN
  387.            EXCEN = 0.D0
  388.          ELSE
  389.            MELVAL=IVAL(2)
  390.            IF (MELVAL.NE.0) THEN
  391.               IBMN=MIN(IB  ,VELCHE(/2))
  392.               IGMN=MIN(IGAU,VELCHE(/1))
  393.               EXCEN=VELCHE(IGMN,IBMN)
  394.            ELSE
  395.             EXCEN=0.D0
  396.            ENDIF
  397.          ENDIF
  398.         ENDIF
  399.  
  400. C_______________________________________________________________________
  401. C
  402. C                  TRAITEMENT SUIVANT TYPE DE MATERIAU
  403. C_______________________________________________________________________
  404. C
  405.       IF (CMATE.EQ.'ISOTROPE'.OR.CMATE.EQ.'ZONE_COH') THEN
  406.         CALL HOOKIS(VALMAT,VALCAR,VAR,MFR,IB,IGAU,EXCEN,EPAIST,
  407.      +       INAT,MELE,NPINT,IFOUR,KCAS,NBGMAT,NELMAT,
  408.      +       S,SECT,LHOOK,DDHOMU,DDHOOK,
  409.      +       COBMA,XMOB,IRET)
  410. C
  411.       ELSE IF (CMATE.EQ.'ORTHOTRO') THEN
  412.         CALL HOOKOR(VALMAT,IB,IGAU,MFR,EXCEN,EPAIST,
  413.      +   MELE,NPINT,IFOUR,KCAS,NBGMAT,NELMAT,SECT,LHOOK,
  414.      +   TXR,XLOC,XGLOB,D1HOOK,ROTHOO,DDHOMU,DDHOOK,
  415.      +   COBMA,XMOB,IRET)
  416. C
  417.       ELSE IF (CMATE.EQ.'ANISOTRO') THEN
  418.         CALL HOOKAN(VALMAT,IB,IGAU,MFR,IFOUR,KCAS,NBGMAT,NELMAT,
  419.      +      SECT,LHOOK,TXR,XLOC,XGLOB,D1HOOK,ROTHOO,DDHOOK,
  420.      +      MELE,COBMA,XMOB,IRET)
  421. C
  422.       ELSE IF (CMATE.EQ.'UNIDIREC') THEN
  423.         CALL HOOKUN(VALMAT,IB,IGAU,MFR,EXCEN,EPAIST,
  424.      +   MELE,NPINT,IFOUR,KCAS,NBGMAT,NELMAT,SECT,LHOOK,
  425.      +   TXR,XLOC,XGLOB,D1HOOK,ROTHOO,DDHOMU,DDHOOK,
  426.      +   COBMA,XMOB,IRET)
  427. C
  428.       ELSE IF (CMATE.EQ.'HOMOGENE') THEN
  429.         CALL HOOKHO(VALMAT,IB,IGAU,MFR,NBGMAT,NELMAT,SECT,
  430.      +                                       LHOOK,DDHOOK,IRET)
  431. C
  432.       ELSE IF (CMATE.EQ.'SECTION ') THEN
  433.         CALL HOOKSE(VALMAT,IB,IGAU,MFR,CRIGI,IFOUR,
  434.      +            NBGMAT,NELMAT,SECT,LHOOK,DDHOOK,IRET)
  435. C
  436.       ENDIF
  437. C
  438.       IF (IRET.EQ.0) THEN
  439.         IF (MFR.EQ.3.AND.NPINT.NE.0) THEN
  440.           CALL ERREUR(251)
  441.         ELSE
  442.           MOTERR(1:8)=NOMFR(MFR/2+1)
  443.           CALL ERREUR(193)
  444.         ENDIF
  445.         GOTO 1200
  446.       ENDIF
  447. C
  448.  
  449. C
  450. C   REMPLISSAGE DU SEGMENT IVAHOO
  451. C
  452.         MELVAL=IVAHOO
  453.         MLREEL=IELCHE(IGAU,IB)
  454.         KO=0
  455.         DO JO=1,LHOOK
  456.           DO IO=1,LHOOK
  457.             KO=(JO-1)*LHOOK + IO
  458.             PROG(KO)=DDHOOK(IO,JO)
  459.           ENDDO
  460.         ENDDO
  461.  1101  CONTINUE
  462.  1100  CONTINUE
  463. * section non // pour les activations en nomod
  464.       call oooprl(1)
  465.       DO 1102 IB=1,NEL
  466.        DO 1103 IGAU=1,NBPTEL
  467.         MLREEL=IELCHE(IGAU,IB)
  468.         SEGACT,MLREEL*NOMOD
  469.  1103 continue
  470.  1102 continue
  471.       call oooprl(0)
  472. C
  473.  1200  CONTINUE
  474.        IF ((CMATE.EQ.'ORTHOTRO'.OR.CMATE.EQ.'ANISOTRO'.OR.
  475.      1      CMATE.EQ.'UNIDIREC').AND.(MFR.EQ.1.OR.MFR.EQ.33)) THEN
  476. **        SEGDES MINTE2
  477.         ENDIF
  478. *
  479.  9000 CONTINUE
  480.       IF ((CMATE.EQ.'ORTHOTRO'.OR.CMATE.EQ.'ANISOTRO'.OR.
  481.      1     CMATE.EQ.'UNIDIREC')) THEN
  482. **        SEGDES MELEME
  483.           SEGSUP WRK2
  484.       ENDIF
  485.       IF (MFR.EQ.55) SEGSUP WRK4
  486.       SEGSUP TRAV
  487.  
  488.       RETURN
  489.       END
  490.  
  491.  
  492.  
  493.  

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