Télécharger la plaquette Cast3M


fr en

Télécharger rigi3.eso

Retour à la liste

Numérotation des lignes : 

rigi3

  1. C RIGI3     SOURCE    CB215821  24/04/12    21:17:10     11897          
  2.       SUBROUTINE RIGI3(MATE,MELE,IPMAIL,IPMINT,IPMIN1,NBPGAU,LRE,
  3.      &      NSTRS,IVAMAT,IVACAR,CMATE,MFR,NBGMAT,NELMAT,IMAT,
  4.      &       LHOOK,NMATT,LW,NPINT,IPMATR,IIPDPG)
  5. *---------------------------------------------------------------------*
  6. *        __________________________                                   *
  7. *        |                        |                                   *
  8. *        |  CALCUL DE LA RIGIDITE |                                   *
  9. *        |________________________|                                   *
  10. *                                                                     *
  11. *      coq3,dkt,coq4,coq8,coq2,dst
  12. *                                                                     *
  13. *---------------------------------------------------------------------*
  14. *                                                                     *
  15. *   ENTREES :                                                         *
  16. *   ________                                                          *
  17. *                                                                     *
  18. *        MATE     Numero du materiau                                  *
  19. *        MELE     Numero de l'element fini                            *
  20. *        IPMAIL   Pointeur sur un segment  MELEME                     *
  21. *        IPMINT   Pointeur sur un segment MINTE aux points de Gauss   *
  22. *        IPMIN1   pointeur sur un segment MINTE aux noeuds            *
  23. *        NBPGAU   Nombre de point d'integration pour la rigidite      *
  24. *        LRE      Nombre de ddl dans la matrice de rigidite           *
  25. *        NSTRS    Nombre de composante de contraintes/deformations    *
  26. *        IVAMAT   Pointeur sur un segment MPTVAL pour le materiau ou  *
  27. *                 pour une matrice de hooke                           *
  28. *        IVACAR   Pointeur sur un segment MPTVAL pour les caracteri-  *
  29. *                 stiques                                             *
  30. *        CMATE    Nom du materiau                                     *
  31. *        MFR      Numero de la formulation element fini               *
  32. *        NBGMAT   Taille maxi des melval du materiau (pt de gauss)    *
  33. *        NELMAT   Taille maxi des melval du materiau (No d'element)   *
  34. *        IMAT     (2 il y a une matrice de HOOKE,1 non  )             *
  35. *        NMATT    Nombre de composante de materiau (IMAT=1)           *
  36. *        NPINT    Nombre de points d'integration dans l'epaisseur
  37. *                 dans le cas des elements de coque integres
  38. *
  39. *                                                                     *
  40. *   SORTIES :                                                         *
  41. *   ________                                                          *
  42. *                                                                     *
  43. *        IPMATR   pointeur sur la rigidite de la sous-zone            *
  44. *                                                                     *
  45. *---------------------------------------------------------------------*
  46.       IMPLICIT INTEGER(I-N)
  47.       IMPLICIT REAL*8(A-H,O-Z)
  48. *
  49.  
  50. -INC PPARAM
  51. -INC CCOPTIO
  52. -INC CCHAMP
  53. -INC CCREEL
  54. *-
  55. -INC SMCHAML
  56. -INC SMINTE
  57. -INC SMELEME
  58. -INC SMRIGID
  59. -INC SMMODEL
  60. -INC SMCOORD
  61. -INC SMLREEL
  62. *
  63.       SEGMENT WRK1
  64.        REAL*8 DDHOOK(LHOOK,LHOOK) ,DDHOMU(LHOOK,LHOOK)
  65.        REAL*8 REL(LRE,LRE) , XE(3,NBBB)
  66.       ENDSEGMENT
  67. *
  68.       SEGMENT WRK2
  69.        REAL*8 SHPWRK(6,NBNO) ,BGENE(LHOOK,LRE)
  70.       ENDSEGMENT
  71. *
  72.       SEGMENT WRK3
  73.        REAL*8 WORK(LW)
  74.       ENDSEGMENT
  75. *
  76.       SEGMENT WRK4
  77.        REAL*8 BPSS(3,3) ,XEL(3,NBBB)
  78.       ENDSEGMENT
  79. *
  80.       SEGMENT WRK5
  81.        REAL*8   BGENE1(LHOOK,LRE),POIG(NBPGA1)
  82.       ENDSEGMENT
  83. *
  84.       SEGMENT,MVELCH
  85.          REAL*8 VALMAT(NV1)
  86.       ENDSEGMENT
  87. *
  88.       SEGMENT MPTVAL
  89.         INTEGER IPOS(NS)    ,NSOF(NS)
  90.         INTEGER      IVAL(NCOSOU)
  91.         CHARACTER*16 TYVAL(NCOSOU)
  92.       ENDSEGMENT
  93. *
  94.       CHARACTER*8 CMATE
  95. *
  96. *      write(6,*) 'entree dans rigi3 lhook',lhook
  97. *
  98. C   INITIALISATION DU POINT AUTOUR DUQUEL SE FAIT LE MOUVEMENT
  99. C   DE LA SECTION EN DEFO PLANE GENERALISEE
  100.       IF (IIPDPG.GT.0) THEN
  101. C <- test equivalent ici a IFOUR.EQ.-3
  102. C        SEGACT MCOORD
  103.         IREF=(IIPDPG-1)*(IDIM+1)
  104.         XDPGE=XCOOR(IREF+1)
  105.         YDPGE=XCOOR(IREF+2)
  106.       ELSE
  107.         XDPGE=XZERO
  108.         YDPGE=XZERO
  109.       ENDIF
  110. *
  111.       MELEME=IPMAIL
  112.       NBNN=NUM(/1)
  113.       NBELEM=NUM(/2)
  114. *
  115.       NV1=NMATT
  116.       SEGINI,MVELCH
  117. *
  118.       XMATRI=IPMATR
  119. C*    NLIGRP=LRE
  120. C*    NLIGRD=LRE
  121. *
  122.       NHRM=NIFOUR
  123. *
  124.       MINTE=IPMINT
  125.       IRTD=1
  126. C
  127. C_______________________________________________________________________
  128. C
  129. C     NUMERO DES ETIQUETTES      :
  130. C     ETIQUETTES DE 1 A 98 POUR TRAITEMENT SPECIFIQUE A L ELEMENT
  131. C     DANS LA ZONE SPECIFIQUE A CHAQUE ELEMENT COMMENCANT PAR :
  132. C     5  CONTINUE
  133. C     ELEMENT 5   ETIQUETTES 1005 2005 3005 4005   ...
  134. C     44 CONTINUE
  135. C     ELEMENT 44  ETIQUETTES 1044 2044 3044 4044   ...
  136. C_______________________________________________________________________
  137. C
  138.       GOTO(99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,
  139.      1      99,99,99,99,99,99,27,28,99,99,99,99,99,99,99,99,99,99,99,99,
  140.      2      41,99,99,44,28,99,99,99,49,99,99,99,99,99,99,41,99,99,99,99,
  141.      3      99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,
  142.      4      99,99,99,99,99,99,99,99,99,99,99,99,93,99,99,99,99),MELE
  143.       GOTO 99
  144. C_______________________________________________________________________
  145. C
  146. C     ELEMENT COQ3
  147. C_______________________________________________________________________
  148. C
  149.   27  CONTINUE
  150.       NBBB=NBNN
  151.       SEGINI WRK1,WRK3
  152. C
  153. C     BOUCLE DE CALCUL POUR LES DIFFERENTS ELEMENTS
  154. C
  155.       DO  3027 IB=1,NBELEM
  156. C
  157. C     ON CHERCHE LES COORDONNEES DES NOEUDS DE L ELEMENT IB
  158. C
  159.       CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  160. C
  161. C     ON CHERCHE LES COEFF DES MAT DE HOOKE
  162. C
  163.       MPTVAL=IVAMAT
  164.       IF(IMAT.EQ.2) THEN
  165.         IF (IB.LE.NELMAT.OR.NBGMAT.GT.1) THEN
  166.           MELVAL=IVAL(1)
  167.           IBMN=MIN(IB  ,IELCHE(/2))
  168.           MLREEL=IELCHE(1,IBMN)
  169.           SEGACT MLREEL
  170.           CALL DOHOOO(PROG,LHOOK,DDHOOK)
  171. *          write(6,*)((ddhook(IU,io),iu=1,4),io=1,4)
  172.           SEGDES MLREEL
  173.         ENDIF
  174.       ELSE IF (IMAT.EQ.1) THEN
  175.         DO 9027 IM=1,NMATT
  176.           IF (IVAL(IM).NE.0) THEN
  177.             MELVAL=IVAL(IM)
  178.             IBMN=MIN(IB  ,VELCHE(/2))
  179.             VALMAT(IM)=VELCHE(1,IBMN)
  180.           ELSE
  181.             VALMAT(IM)=0.D0
  182.           ENDIF
  183.  9027   CONTINUE
  184.         IF (IB.LE.NELMAT.OR.NBGMAT.GT.1)
  185.      1  CALL DOHCOM(VALMAT,NMATT,CMATE,IFOUR,LHOOK,DDHOOK,IRTD)
  186. *        write(6,*)((ddhook(IU,io),iu=1,4),io=1,4)
  187.       ENDIF
  188. C
  189. C     CHERCHER LES EPAISSEUR ET EXCENTREMENT
  190. C
  191.       MPTVAL=IVACAR
  192.       MELVAL=IVAL(1)
  193.       IBMN=MIN(IB,VELCHE(/2))
  194.       EPAIST=VELCHE(1,IBMN)
  195.       IF (IVAL(2).NE.0) THEN
  196.         MELVAL=IVAL(2)
  197.         IBMN=MIN(IB,VELCHE(/2))
  198.         EXCEN =VELCHE(1,IBMN)
  199.         IF (EXCEN.NE.0.D0) THEN
  200.           CALL ERREUR(474)
  201.           GO TO 9927
  202.         ENDIF
  203.       ELSE
  204.         EXCEN=0.D0
  205.       ENDIF
  206. C
  207. C     ON CALCULE SA RAIDEUR
  208. C
  209.       CALL COQ3RI(REL,XE,EPAIST,DDHOOK,WORK)
  210. C
  211.  4027 CONTINUE
  212. C
  213. C     REMPLISSAGE DE XMATRI
  214. C
  215.       CALL REMPMT(REL,LRE,RE(1,1,ib))
  216.  3027 CONTINUE
  217.  
  218.       IF(IRTD.EQ.0) THEN
  219.         MOTERR(1:8)=CMATE
  220.         MOTERR(9:16)=NOMFR(MFR/2+1)
  221.         INTERR(1)=IFOUR
  222.         CALL ERREUR(81)
  223.       ENDIF
  224.  9927 CONTINUE
  225.       SEGSUP WRK1,WRK3
  226.       GOTO 510
  227. C_______________________________________________________________________
  228. C
  229. C     ELEMENT DKT
  230. C_______________________________________________________________________
  231. C
  232.   28  CONTINUE
  233.       NBNO=NBNN
  234.       NBBB=NBNN
  235.       SEGINI WRK1,WRK2,WRK4
  236.       IF(NPINT.NE.0)THEN
  237.         NBPGA1=NBPGAU/NPINT
  238.         IF(NBGMAT.NE.1)THEN
  239.          NBPGEP=NPINT
  240.         ELSE
  241.          NBPGEP=1
  242.         ENDIF
  243.         SEGINI WRK5
  244.         DO 1028 IG=1,NBPGA1
  245.          POIG(IG)=POIGAU(IG)
  246.  1028   CONTINUE
  247. Ccccc   CALL POIDNW(NPINT,NBPGA1,2,POIG)
  248.        CALL SIMPSN(NPINT,NBPGA1,2,POIG)
  249.       ENDIF
  250. C
  251.       DO 3028  IB=1,NBELEM
  252. C
  253. C     ON CHERCHE LES COORDONNEES DES NOEUDS DE L ELEMENT IB
  254. C
  255.       CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  256. C
  257.       CALL VPAST(XE,BPSS)
  258. C     BPSS    STOCKE LA MATRICE DE PASSAGE
  259.       CALL VCORLC (XE,XEL,BPSS)
  260.       CALL ZERO (REL,LRE,LRE)
  261. C
  262. C     ON CHERCHE LES EPAISEURS ET ON LES MOYENNE,
  263. C                LES EXCENTREMENTS ET ON LES MOYENNE.
  264. C
  265.       MPTVAL=IVACAR
  266.       MELVAL=IVAL(1)
  267.       EPAIST=0.D0
  268.       IF (MELVAL.NE.0) THEN
  269.         DO IGAU=1,NBPGAU
  270.           IGMN=MIN(IGAU,VELCHE(/1))
  271.           IBMN=MIN(IB,VELCHE(/2))
  272.           EPAIST=EPAIST+VELCHE(IGMN,IBMN)
  273.         ENDDO
  274.         EPAIST=EPAIST/NBPGAU
  275.       ENDIF
  276. *
  277.       MELVAL=IVAL(2)
  278.       EXCEN=0.D0
  279.       IF (MELVAL.NE.0) THEN
  280.         DO IGAU=1,NBPGAU
  281.           IGMN=MIN(IGAU,VELCHE(/1))
  282.           IBMN=MIN(IB,VELCHE(/2))
  283.           EXCEN=EXCEN+VELCHE(IGMN,IBMN)
  284.         ENDDO
  285.         EXCEN=EXCEN/NBPGAU
  286.       ENDIF
  287. C
  288.       IF(NPINT.EQ.0)THEN
  289. C
  290. C     COQUE GLOBAL
  291. C
  292. C     BOUCLE SUR LES POINTS DE GAUSS
  293. C
  294.       DO 1128  IGAU=1,NBPGAU
  295. *
  296.       CALL BMAT28(IGAU,NBPGAU,POIGAU,QSIGAU,ETAGAU,DZEGAU,
  297.      &            MELE,MFR,NBNO,LRE,IFOUR,NSTRS,0,1.D0,XEL,
  298.      &            SHPTOT,SHPWRK,BGENE,DJAC,XDPGE,YDPGE)
  299.       DJAC=DJAC*POIGAU(IGAU)
  300. C
  301. C  ON MODIFIE LA MATRICE B EN CAS D'EXCENTREMENT
  302. C
  303.        IF (EXCEN.NE.0.) THEN
  304.       DO 1528 IJL=1,3
  305.       DO 1528 IJC=1,LRE
  306.       BGENE(IJL,IJC)=BGENE(IJL,IJC)+EXCEN*BGENE(IJL+3,IJC)
  307.  1528 CONTINUE
  308.        ENDIF
  309. C
  310. C     ON CHERCHE LES COEFFICIENTS DE LA MATRICE DE HOOKE
  311. C
  312.       MPTVAL=IVAMAT
  313.       IF(IMAT.EQ.2) THEN
  314.         IF (IGAU.LE.NBGMAT.AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1)) THEN
  315.           MELVAL=IVAL(1)
  316.           IBMN=MIN(IB  ,IELCHE(/2))
  317.           IGMN=MIN(IGAU,IELCHE(/1))
  318.           MLREEL=IELCHE(IGMN,IBMN)
  319.           SEGACT MLREEL
  320.           CALL DOHOOO(PROG,LHOOK,DDHOOK)
  321.           SEGDES MLREEL
  322.         ENDIF
  323.       CALL BDBS1(BGENE,DJAC,DDHOOK,LRE,NSTRS,REL,MFR,IFOUR,MATE,
  324.      1     IGAU,IMAT,EXCEN)
  325.       ELSE IF (IMAT.EQ.1) THEN
  326. *
  327.           DO 9028 IM=1,NMATT
  328.             IF (IVAL(IM).NE.0) THEN
  329.               MELVAL=IVAL(IM)
  330.               IBMN=MIN(IB  ,VELCHE(/2))
  331.               IGMN=MIN(IGAU,VELCHE(/1))
  332.               VALMAT(IM)=VELCHE(IGMN,IBMN)
  333.             ELSE
  334.               VALMAT(IM)=0.D0
  335.             ENDIF
  336.  9028     CONTINUE
  337.         IF (IGAU.LE.NBGMAT.AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1))
  338.      1    CALL DOHCOM(VALMAT,NMATT,CMATE,IFOUR,LHOOK,DDHOOK,IRTD)
  339.         CALL HOOKMU(EPAIST,0.D0,LHOOK,DDHOOK,DDHOMU)
  340.         CALL BDBS1(BGENE,DJAC,DDHOMU,LRE,NSTRS,REL,MFR,IFOUR,MATE,
  341.      1     IGAU,IMAT,EXCEN)
  342.       ENDIF
  343.  1128 CONTINUE
  344. C
  345.       ELSE
  346. C
  347. C    COQUE INTEGREE
  348. C
  349. C     BOUCLE SUR LES POINTS DE GAUSS DE LA SURFACE
  350. C
  351.       DO 1101  IGAU=1,NBPGA1
  352. *
  353.       CALL BMAT28(IGAU,NBPGAU,POIGAU,QSIGAU,ETAGAU,DZEGAU,
  354.      &            MELE,MFR,NBNO,LRE,IFOUR,LHOOK,0,1.D0,XEL,
  355.      &            SHPTOT,SHPWRK,BGENE,DJAC,XDPGE,YDPGE)
  356. C
  357. C  ON MODIFIE LA MATRICE B EN CAS D'EXCENTREMENT
  358. C
  359.         IF (EXCEN.NE.0.) THEN
  360.       DO 1501 IJL=1,3
  361.       DO 1501 IJC=1,LRE
  362.       BGENE(IJL,IJC)=BGENE(IJL,IJC)+EXCEN*BGENE(IJL+3,IJC)
  363.  1501 CONTINUE
  364.         ENDIF
  365. C
  366. C   BOUCLE SUR LES NAPPES DANS L'EPAISSEUR
  367. C
  368.       DO 1102 INAP=1,NBPGEP
  369. C
  370.       IGAU1=(INAP-1)*NBPGA1+IGAU
  371. C
  372. C      CALCUL DE LA MATRICE B CORRESPONDANT AUX DEFORMATIONS 3D
  373. C
  374.       IF(NBGMAT.EQ.1.AND.NPINT.NE.1)THEN
  375.        ZZZ2 = SQRT( (EPAIST**3.D0)/12.D0 )
  376.        ZZZ1 = SQRT( EPAIST )
  377.        DO 1503 IJL=1,3
  378.        DO 1503 IJC=1,LRE
  379.          BGENE1(IJL,IJC)  =ZZZ1*BGENE(IJL,IJC)
  380.          BGENE1(IJL+3,IJC)=ZZZ2*BGENE(IJL+3,IJC)
  381.  1503  CONTINUE
  382.        DJAC1=DJAC*POIG(IGAU1)
  383.       ELSE
  384.        ZZZ=DZEGAU(IGAU1)*(EPAIST/2.D0)
  385.        DO 1502 IJL=1,3
  386.        DO 1502 IJC=1,LRE
  387.          BGENE1(IJL,IJC)=BGENE(IJL,IJC)
  388.          BGENE1(IJL+3,IJC)=ZZZ*BGENE(IJL+3,IJC)
  389.  1502  CONTINUE
  390.        DJAC1=DJAC*POIGAU(IGAU1)*(EPAIST/2.D0)
  391.       ENDIF
  392. C
  393. C     ON CHERCHE LA MATRICE DE HOOKE
  394. C
  395.       MPTVAL=IVAMAT
  396.       IF(IMAT.EQ.2) THEN
  397.         IF (IGAU1.LE.NBGMAT.AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1)) THEN
  398.           MELVAL=IVAL(1)
  399.           IBMN=MIN(IB  ,IELCHE(/2))
  400.           IGMN=MIN(IGAU1,IELCHE(/1))
  401.           MLREEL=IELCHE(IGMN,IBMN)
  402.           SEGACT MLREEL
  403.           CALL DHDKTI(PROG,LHOOK,DDHOOK)
  404.           SEGDES MLREEL
  405. *        write(6,*)((ddhook(IU,io),iu=1,6),io=1,6)
  406.         ENDIF
  407.       ELSE IF (IMAT.EQ.1) THEN
  408.           DO 9001 IM=1,NMATT
  409.             IF (IVAL(IM).NE.0) THEN
  410.               MELVAL=IVAL(IM)
  411.               IBMN=MIN(IB  ,VELCHE(/2))
  412.               IGMN=MIN(IGAU1,VELCHE(/1))
  413.               VALMAT(IM)=VELCHE(IGMN,IBMN)
  414.             ELSE
  415.               VALMAT(IM)=0.D0
  416.             ENDIF
  417.  9001     CONTINUE
  418.         IF (IGAU1.LE.NBGMAT.AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1))
  419.      1    CALL DOHCOM(VALMAT,NMATT,CMATE,IFOUR,LHOOK,DDHOOK,IRTD)
  420. *        write(6,*)((ddhook(IU,io),iu=1,6),io=1,6)
  421.       ENDIF
  422.       CALL BDBS1(BGENE1,DJAC1,DDHOOK,LRE,LHOOK,REL,MFR,IFOUR,MATE,
  423.      1     IGAU,IMAT,EXCEN)
  424.  1102 CONTINUE
  425.  1101 CONTINUE
  426.       ENDIF
  427.       REL(6,6)=REL(5,5)*1.D-7
  428.       REL(12,12)=REL(6,6)
  429.       REL(18,18)=REL(6,6)
  430.       ICOM=0
  431.       IF(ABS(EXCEN).GT.XPETIT .OR. CMATE.EQ.'COMPOSIT'
  432.      1  .OR. IMAT.EQ.2) ICOM=1
  433.       CALL TRANSK(REL,BPSS,LRE,3,ICOM)
  434. C
  435. C     REMPLISSAGE DE XMATRI
  436. C
  437.       CALL REMPMT(REL,LRE,RE(1,1,IB))
  438.  3028 CONTINUE
  439.       IF(IRTD.EQ.0) THEN
  440.         MOTERR(1:8)=CMATE
  441.         MOTERR(9:16)=NOMFR(MFR/2+1)
  442.        INTERR(1)=IFOUR
  443.        CALL ERREUR(81)
  444.       ENDIF
  445.       SEGSUP WRK1,WRK2,WRK4
  446.       IF(NPINT.NE.0)SEGSUP WRK5
  447.       GOTO 510
  448. C_______________________________________________________________________
  449. C
  450. C     ELEMENT COQ8
  451. C_______________________________________________________________________
  452. C
  453.   41  CONTINUE
  454.       NBBB=NBNN
  455.       NBNO=NBNN
  456.       SEGINI WRK1,WRK2,WRK3
  457.       MINTE1=IPMIN1
  458.       SEGACT MINTE1
  459.       NBPGA1=MINTE1.SHPTOT(/3)
  460.       NBN1  =MINTE1.SHPTOT(/2)
  461. C
  462. C     BOUCLE DE CALCUL POUR LES DIFFERENTS ELEMENTS
  463. C
  464.       DO  3041 IB=1,NBELEM
  465. C
  466. C     ON CHERCHE LES COORDONNEES DES NOEUDS DE L ELEMENT IB
  467. C
  468.       CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  469. C
  470.       CALL ZERO (REL,LRE,LRE)
  471. C
  472. C     ON CHERCHE LES EPAISSEURS ET LES EXCENTREMENTS.
  473. C
  474.       MPTVAL=IVACAR
  475.       DO 4041 IGAU=1,NBPGAU
  476.         MELVAL=IVAL(1)
  477.         IGMN=MIN(IGAU,VELCHE(/1))
  478.         IBMN=MIN(IB,VELCHE(/2))
  479.         WORK(IGAU)   =VELCHE(IGMN,IBMN)
  480.         IF (IVAL(2).NE.0) THEN
  481.           MELVAL=IVAL(2)
  482.           IGMN=MIN(IGAU,VELCHE(/1))
  483.           IBMN=MIN(IB,VELCHE(/2))
  484.           WORK(10+IGAU)=VELCHE(IGMN,IBMN)
  485.         ELSE
  486.           WORK(10+IGAU)=0.D0
  487.         ENDIF
  488.  4041 CONTINUE
  489. C
  490. C      DETERMINATION DES AXES LOCAUX AUX NOEUDS
  491. C
  492.        CALL CQ8LOC(XE,NBNN,MINTE1.SHPTOT,WORK(21),IRR)
  493. C
  494. C       BOUCLE SUR LES POINTS DE GAUSS
  495. C
  496.        DO 3042  IGAU=1,NBPGAU
  497.         E3=DZEGAU(IGAU)
  498.         CALL BCOQ8E(IGAU,XE,NBNN,WORK(1),WORK(11),BGENE,DJAC,
  499.      1             E3,SHPTOT,WORK(21),IRR)
  500. C
  501. C     GESTION D'ERREUR: IRR=0 CORRESPOND A UN VECTEUR NUL (CF. CROSS2)
  502. C                       IRR=-1 CORRESPOND A UN JACOBIEN NUL(CF. SHLJAC)
  503. C
  504.        IF(IRR.EQ.0) THEN
  505.          CALL ERREUR(241)
  506.          GOTO 9941
  507.        ELSE IF(IRR.EQ.-1)THEN
  508.          CALL ERREUR(240)
  509.          GOTO 9941
  510.        ENDIF
  511. C
  512.        DJAC=ABS(DJAC)*POIGAU(IGAU)
  513. C
  514. C     ON CHERCHE LES COEFF DES MAT DE HOOKE
  515. C
  516.        MPTVAL=IVAMAT
  517.        IF(IMAT.EQ.2) THEN
  518.          IF ((IGAU.LE.NBGMAT).AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1)) THEN
  519.            MELVAL=IVAL(1)
  520.            IBMN=MIN(IB  ,IELCHE(/2))
  521.            IGMN=MIN(IGAU,IELCHE(/1))
  522.            MLREEL=IELCHE(IGMN,IBMN)
  523.            SEGACT MLREEL
  524.            CALL DOHOOO(PROG,LHOOK,DDHOOK)
  525.            SEGDES MLREEL
  526.          ENDIF
  527.        ELSE IF (IMAT.EQ.1) THEN
  528.          DO 9041 IM=1,NMATT
  529.            IF (IVAL(IM).NE.0) THEN
  530.              MELVAL=IVAL(IM)
  531.              IBMN=MIN(IB  ,VELCHE(/2))
  532.              IGMN=MIN(IGAU,VELCHE(/1))
  533.              VALMAT(IM)=VELCHE(IGMN,IBMN)
  534.            ELSE
  535.              VALMAT(IM)=0.D0
  536.            ENDIF
  537.  9041    CONTINUE
  538.          IF((IGAU.LE.NBGMAT).AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1))
  539.      1     CALL DOHCOE (VALMAT,CMATE,IFOUR,LHOOK,DDHOOK,IRTD)
  540.        ENDIF
  541. C
  542. C     ON CALCULE SA RAIDEUR
  543. C
  544.        CALL COQ8RI(BGENE,DJAC,DDHOOK,LRE,NBPGAU,IGAU,NBNN,REL)
  545. C
  546.  3042 CONTINUE
  547. C
  548. C     REMPLISSAGE DE XMATRI
  549. C
  550.       CALL REMPMT(REL,LRE,RE(1,1,IB))
  551.  3041 CONTINUE
  552. c
  553.       IF(IRTD.EQ.0) THEN
  554.         MOTERR(1:8)=CMATE
  555.         MOTERR(9:16)=NOMFR(MFR/2+1)
  556.        INTERR(1)=IFOUR
  557.        CALL ERREUR(81)
  558.       ENDIF
  559.  9941 CONTINUE
  560.       SEGSUP WRK1,WRK2,WRK3
  561.       SEGDES MINTE1
  562.       GOTO 510
  563. C_______________________________________________________________________
  564. C
  565. C     SECTEUR DE CALCUL POUR LE COQ2
  566. C_______________________________________________________________________
  567. C
  568.   44  CONTINUE
  569.       DIM3=1.D0
  570.       NBNO=NBNN
  571.       NBBB=NBNN
  572.       SEGINI WRK1,WRK2
  573.       DO 3044  IB=1,NBELEM
  574. C
  575. C     ON CHERCHE  LES COORDONNEES DES NOEUDS DE L ELEMENT IB
  576. C
  577.       CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  578. C
  579.       CALL ZERO (REL,LRE,LRE)
  580. C
  581. C     BOUCLE SUR LES POINTS DE GAUSS
  582. C
  583.       DO 4044  IGAU=1,NBPGAU
  584.       MPTVAL=IVACAR
  585.       MELVAL=IVAL(1)
  586.       IBMN=MIN(IB,VELCHE(/2))
  587.       EPAIST=VELCHE(1,IBMN)
  588.       IF (IVAL(2).NE.0) THEN
  589.         MELVAL=IVAL(2)
  590.         IBMN=MIN(IB,VELCHE(/2))
  591.         EXCEN =VELCHE(1,IBMN)
  592.       ELSE
  593.         EXCEN=0.D0
  594.       ENDIF
  595.       IF (IFOUR.EQ.-2) THEN
  596.        IF (IVAL(3).NE.0) THEN
  597.         MELVAL=IVAL(3)
  598.         IBMN=MIN(IB,VELCHE(/2))
  599.         DIM3 =VELCHE(1,IBMN)
  600.        ELSE
  601.         DIM3=1.D0
  602.        ENDIF
  603.       ENDIF
  604. C
  605. C     APPEL A BCOQ2    ...
  606. C
  607.       CALL BCOQ2(BGENE,NSTRS,DJAC,IGAU,IFOUR,XE,NHRM,QSIGAU,POIGAU,
  608.      .           EXCEN,DIM3,IRRT,XDPGE,YDPGE)
  609. C
  610. C     GESTION D'ERREUR
  611. C        LES ERREURS PREVUES SONT LONGEUR DE L'ELEMENT =0 OU RAYON
  612. C        AU POINT D'INTEGRATION =0 OU RAPPORT R/L TROP PETIT (INFERIEUR
  613. C        A 1.E-3).
  614. C
  615.       IF(IRRT.EQ.1) THEN
  616.         INTERR(1)=IB
  617.         CALL ERREUR(255)
  618.         GOTO 9944
  619.       ELSE IF (IRRT.EQ.2) THEN
  620.         INTERR(1)=IB
  621.         CALL ERREUR(256)
  622.         GOTO 9944
  623.       ENDIF
  624. C
  625.       MPTVAL=IVAMAT
  626.       IF(IMAT.EQ.2) THEN
  627.         IF (IGAU.LE.NBGMAT.AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1)) THEN
  628.           MELVAL=IVAL(1)
  629.           IBMN=MIN(IB  ,IELCHE(/2))
  630.           IGMN=MIN(IGAU,IELCHE(/1))
  631.           MLREEL=IELCHE(IGMN,IBMN)
  632.           SEGACT MLREEL
  633.           CALL DOHOOO(PROG,LHOOK,DDHOOK)
  634.           SEGDES MLREEL
  635.         ENDIF
  636.         CALL BDBST(BGENE,DJAC,DDHOOK,LRE,NSTRS,REL)
  637.       ELSE IF (IMAT.EQ.1) THEN
  638. *
  639.           DO 9044 IM=1,NMATT
  640.             IF (IVAL(IM).NE.0) THEN
  641.               MELVAL=IVAL(IM)
  642.               IBMN=MIN(IB  ,VELCHE(/2))
  643.               IGMN=MIN(IGAU,VELCHE(/1))
  644.               VALMAT(IM)=VELCHE(IGMN,IBMN)
  645.             ELSE
  646.               VALMAT(IM)=0.D0
  647.             ENDIF
  648.  9044     CONTINUE
  649.         IF (IGAU.LE.NBGMAT.AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1))
  650.      1    CALL DOHCOM(VALMAT,NMATT,CMATE,IFOUR,LHOOK,DDHOOK,IRTD)
  651.         CALL HOOKMU(EPAIST,0.D0,LHOOK,DDHOOK,DDHOMU)
  652.         CALL BDBST(BGENE,DJAC,DDHOMU,LRE,NSTRS,REL)
  653.       ENDIF
  654.  4044 CONTINUE
  655. C
  656. C     REMPLISSAGE DE XMATRI
  657. C
  658.       CALL REMPMT(REL,LRE,RE(1,1,IB))
  659.  3044 CONTINUE
  660. C
  661. C IMPRESSION D'UN EVENTUEL MESSAGE D'ERREUR...
  662.       IF(IRTD.EQ.0) THEN
  663.         MOTERR(1:8)=CMATE
  664.         MOTERR(9:16)=NOMFR(MFR/2+1)
  665.        INTERR(1)=IFOUR
  666.        CALL ERREUR(81)
  667.       ENDIF
  668.  9944 CONTINUE
  669.       SEGSUP WRK1,WRK2
  670.       GOTO 510
  671. C_______________________________________________________________________
  672. C
  673. C     SECTEUR DE CALCUL POUR LE COQ4
  674. C_______________________________________________________________________
  675. C
  676.   49  CONTINUE
  677.       NBNO=NBNN
  678.       NBBB=NBNN
  679.       SEGINI WRK1,WRK2,WRK4
  680. c
  681. c ... Si le matériau n'est pas isotrope, dans le cas général les
  682. c     tensions et le cisaillement NE sont PAS découplées. Ce qui veut
  683. c     dire qu'on n'a pas le droit de les intégrer différemment ...
  684. c
  685.       DO 3049  IB=1,NBELEM
  686. C
  687. C     ON CHERCHE  LES COORDONNEES DES NOEUDS DE L ELEMENT IB
  688. C
  689.       CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  690. C
  691.       CALL ZERO (REL,LRE,LRE)
  692.       CALL CQ4LOC(XE,XEL,BPSS,IRRT,1)
  693. C     IRRT=1 NODI TROPPO VICINI
  694.       IF(IRRT.EQ.1) THEN
  695.          INTERR(1)=IB
  696.          CALL ERREUR(323)
  697.          GOTO 9949
  698.       ELSE IF(IRRT.EQ.3) THEN
  699.          IRRT = 0
  700.          NOPLAN = 1
  701.       ELSE
  702.          NOPLAN = 0
  703.       ENDIF
  704. C
  705. C     BOUCLE SUR LES POINTS DE GAUSS
  706. C
  707.       MPTVAL=IVACAR
  708.       MELVAL=IVAL(1)
  709.       IBMN=MIN(IB,VELCHE(/2))
  710.       EPAIST=VELCHE(1,IBMN)
  711.       IF (IVAL(2).NE.0) THEN
  712.         MELVAL=IVAL(2)
  713.         IBMN=MIN(IB,VELCHE(/2))
  714.         EXCEN =VELCHE(1,IBMN)
  715.       ELSE
  716.         EXCEN=0.D0
  717.       ENDIF
  718.       DO 4049  IGAU=1,NBPGAU
  719. C
  720. C     APPEL A BCOQ4
  721. C
  722.       if(cmate.eq.'ISOTROPE') then
  723.       CALL BCOQ4(IGAU,XEL,SHPTOT,SHPWRK,BGENE,DJAC,EXCEN,NOPLAN,IRRT,
  724.      +                                                         0)
  725.       else
  726.       CALL BCOQ4O(IGAU,XEL,SHPTOT,SHPWRK,BGENE,DJAC,EXCEN,NOPLAN,IRRT,
  727.      +                                                         0)
  728.       endif
  729.       DJAC=DJAC*POIGAU(IGAU)
  730. C     IRRT=1 JACOBIANO <= 0
  731.       IF(IRRT.EQ.1) THEN
  732.          INTERR(1)=IB
  733.          CALL ERREUR(321)
  734.          GOTO 9949
  735.       ENDIF
  736. C
  737.       MPTVAL=IVAMAT
  738.       IF(IMAT.EQ.2) THEN
  739.         IF (IGAU.LE.NBGMAT.AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1)) THEN
  740.           MELVAL=IVAL(1)
  741.           IBMN=MIN(IB  ,IELCHE(/2))
  742.           IGMN=MIN(IGAU,IELCHE(/1))
  743.           MLREEL=IELCHE(IGMN,IBMN)
  744.           SEGACT MLREEL
  745.           CALL DOHOOO(PROG,LHOOK,DDHOOK)
  746.           SEGDES MLREEL
  747.         ENDIF
  748.         CALL BDBST(BGENE,DJAC,DDHOOK,LRE,NSTRS,REL)
  749.       ELSE IF (IMAT.EQ.1) THEN
  750. *
  751.           DO 9049 IM=1,NMATT
  752.             IF (IVAL(IM).NE.0) THEN
  753.               MELVAL=IVAL(IM)
  754.               IBMN=MIN(IB  ,VELCHE(/2))
  755.               IGMN=MIN(IGAU,VELCHE(/1))
  756.               VALMAT(IM)=VELCHE(IGMN,IBMN)
  757.             ELSE
  758.               VALMAT(IM)=0.D0
  759.             ENDIF
  760.  9049     CONTINUE
  761.         IF (IGAU.LE.NBGMAT.AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1))
  762.      1    CALL DOHCIS(VALMAT,CMATE,IFOUR,LHOOK,DDHOOK,IRTD)
  763.         CALL HOOKMU(EPAIST,0.D0,LHOOK,DDHOOK,DDHOMU)
  764.         if(cmate.eq.'ISOTROPE') then
  765.            CALL COQ4RI (IGAU,BGENE,DJAC,EXCEN,NOPLAN,DDHOMU,REL)
  766.         else
  767.            CALL COQ4RJ (IGAU,BGENE,DJAC,EXCEN,NOPLAN,DDHOMU,REL)
  768.         endif
  769.       ENDIF
  770.  4049 CONTINUE
  771. C
  772.       REL(6,6)=REL(5,5)*1.D-7
  773.       REL(12,12)=REL(6,6)
  774.       REL(18,18)=REL(6,6)
  775.       REL(24,24)=REL(6,6)
  776.       ICOM=0
  777.       IF(ABS(EXCEN).GT.XPETIT .OR.CMATE.EQ.'COMPOSIT'
  778.      1   .OR. IMAT.EQ.2) ICOM=1
  779.       CALL TRANSK(REL,BPSS,LRE,4,ICOM)
  780. C
  781. C     REMPLISSAGE DE XMATRI
  782. C
  783.       CALL REMPMT(REL,LRE,RE(1,1,IB))
  784.  3049 CONTINUE
  785. C
  786. C IMPRESSION D'UN EVENTUEL MESSAGE D'ERREUR...
  787.       IF(IRTD.EQ.0) THEN
  788.         MOTERR(1:8)=CMATE
  789.         MOTERR(9:16)=NOMFR(MFR/2+1)
  790.        INTERR(1)=IFOUR
  791.        CALL ERREUR(81)
  792.       ENDIF
  793.  9949 CONTINUE
  794.       SEGSUP WRK1,WRK2,WRK4
  795.       GOTO 510
  796. C_______________________________________________________________________
  797. C
  798. C     ELEMENT DST
  799. C_______________________________________________________________________
  800. C
  801.   93  CONTINUE
  802.       NBNO=NBNN
  803.       NBBB=NBNN
  804.       SEGINI WRK1,WRK2,WRK3,WRK4
  805.       IF(CMATE.NE.'ISOTROPE')THEN
  806.          MPTVAL=IVAMAT
  807.          IF(IMAT.EQ.1.AND.CMATE.EQ.'ORTHOTRO')THEN
  808.             MELVAL=IVAL(7)
  809.          ELSE
  810.             MELVAL=IVAL(2)
  811.          ENDIF
  812.          NBGCOS=VELCHE(/1)
  813.       ENDIF
  814.       DO 3093  IB=1,NBELEM
  815. C
  816. C     ON CHERCHE LES COORDONNEES DES NOEUDS DE L ELEMENT IB
  817. C
  818.       CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  819. C
  820.       CALL VPAST(XE,BPSS)
  821. C     BPSS    STOCKE LA MATRICE DE PASSAGE
  822.       CALL VCORLC (XE,XEL,BPSS)
  823.       CALL ZERO (REL,LRE,LRE)
  824. C
  825. C     BOUCLE SUR LES POINTS DE GAUSS
  826. C
  827.       DO 1193  IGAU=1,NBPGAU
  828.       MPTVAL=IVACAR
  829.       MELVAL=IVAL(1)
  830.       IBMN =MIN(IB,VELCHE(/2))
  831.       EPAIST=VELCHE(1,IBMN)
  832.       IF (IVAL(2).NE.0) THEN
  833.         MELVAL=IVAL(2)
  834.         IBMN =MIN(IB,VELCHE(/2))
  835.         EXCEN =VELCHE(1,IBMN)
  836.       ELSE
  837.         EXCEN=0.D0
  838.       ENDIF
  839. *
  840. * Dans le cas des matériaux orthotropes, les déformations sont d'abord
  841. * calculées dans le repère d'orthotropie (les formules utilisées par les
  842. * routines RCDST et BMFDST ne sont valables que dans ce repère); elles
  843. * sont ensuite exprimées dans le repère local de l'élément.
  844. *
  845.       IF(CMATE.NE.'ISOTROPE')THEN
  846.         IF(IGAU.LE.NBGCOS)THEN
  847.           IF(IMAT.EQ.2)THEN
  848.             MPTVAL=IVAMAT
  849.             MELVAL=IVAL(2)
  850.             IBMN=MIN(IB  ,VELCHE(/2))
  851.             IGMN=MIN(IGAU,VELCHE(/1))
  852.             COSA=VELCHE(IGMN,IBMN)
  853.             MELVAL=IVAL(3)
  854.             IBMN=MIN(IB  ,VELCHE(/2))
  855.             IGMN=MIN(IGAU,VELCHE(/1))
  856.             SINA=VELCHE(IGMN,IBMN)
  857.           ENDIF
  858.         ENDIF
  859.       ENDIF
  860. C
  861. C     ON CHERCHE LES COEFFICIENTS DE LA MATRICE DE HOOKE
  862. C
  863.       MPTVAL=IVAMAT
  864.       IF(IMAT.EQ.2) THEN
  865.         IF (IGAU.LE.NBGMAT.AND.(IB.LE.NELMAT.
  866.      +                   OR.NBGMAT.GT.1)) THEN
  867.           MELVAL=IVAL(1)
  868.           IBMN=MIN(IB  ,IELCHE(/2))
  869.           IGMN=MIN(IGAU,IELCHE(/1))
  870.           MLREEL=IELCHE(IGMN,IBMN)
  871.           SEGACT MLREEL
  872.             CALL DOHOOO(PROG,LHOOK,DDHOMU)
  873.           SEGDES MLREEL
  874.             IF(CMATE.EQ.'ORTHOTRO')
  875.      +           CALL CHGREP1(COSA,SINA,DDHOMU,LHOOK)
  876.         ENDIF
  877.       ELSE IF (IMAT.EQ.1) THEN
  878. *
  879.           DO 9093 IM=1,NMATT
  880.             IF (IVAL(IM).NE.0) THEN
  881.               MELVAL=IVAL(IM)
  882.               IBMN=MIN(IB  ,VELCHE(/2))
  883.               IGMN=MIN(IGAU,VELCHE(/1))
  884.               VALMAT(IM)=VELCHE(IGMN,IBMN)
  885.             ELSE
  886.               VALMAT(IM)=0.D0
  887.             ENDIF
  888.  9093     CONTINUE
  889.         IF (IGAU.LE.NBGMAT.AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1))
  890.      1    CALL DOHDST(VALMAT,CMATE,IFOUR,NSTRS,DDHOOK,IRTD)
  891.         CALL HOOKMU(EPAIST,0.D0,NSTRS,DDHOOK,DDHOMU)
  892.       ENDIF
  893. *
  894.       CALL ZERO(BGENE,NSTRS,LRE)
  895.       IF(CMATE.NE.'ISOTROPE')THEN
  896.         IF(IGAU.LE.NBGCOS)THEN
  897.          IF(IMAT.EQ.1.AND.CMATE.EQ.'ORTHOTRO')THEN
  898.             COSA=VALMAT(7)
  899.             SINA=VALMAT(8)
  900.           ENDIF
  901.           DO 1393 INO=1,NBNN
  902.            XX=COSA*XEL(1,INO)+SINA*XEL(2,INO)
  903.            YY=(-SINA)*XEL(1,INO)+COSA*XEL(2,INO)
  904.            XE(1,INO)=XX
  905.            XE(2,INO)=YY
  906.  1393     CONTINUE
  907.          ENDIF
  908. CC
  909. C     TERMES DE LA MATRICE DE RIGIDITE RELATIFS
  910. C      AUX CISAILLEMENTS TRANSVERSES
  911. C
  912.         CALL RCDST(XE,NSTRS,LRE,DDHOMU,
  913.      1                WORK(1),WORK(10),WORK(19),REL,BGENE,1)
  914.  
  915. C     TERMES DE LA MATRICE B RELATIFS AUX EFFETS
  916. C        DE MEMBRANE ET DE FLEXION
  917. C
  918.          CALL BMFDST(IGAU,XE,NSTRS,QSIGAU,ETAGAU,SHPTOT,SHPWRK,
  919.      1            WORK(1),WORK(10),WORK(19),BGENE,DUM)
  920. *
  921.          DO 10 NPOI=1,3
  922.          SHPWRK(1,NPOI)=SHPTOT(1,NPOI,IGAU)
  923.          SHPWRK(2,NPOI)=SHPTOT(2,NPOI,IGAU)
  924.          SHPWRK(3,NPOI)=SHPTOT(3,NPOI,IGAU)
  925.   10     CONTINUE
  926.          CALL JACOBI(XEL,SHPWRK,2,3,DJAC)
  927.          CALL ROTB(BGENE,NSTRS,COSA,SINA)
  928.       ELSE
  929. C
  930. C     TERMES DE LA MATRICE DE RIGIDITE RELATIFS
  931. C      AUX CISAILLEMENTS TRANSVERSES
  932. C
  933.         CALL RCDST(XEL,NSTRS,LRE,DDHOMU,
  934.      1              WORK(1),WORK(10),WORK(19),REL,BGENE,1)
  935. C
  936. C     TERMES DE LA MATRICE B RELATIFS AUX EFFETS
  937. C        DE MEMBRANE ET DE FLEXION
  938. C
  939.         CALL BMFDST(IGAU,XEL,NSTRS,QSIGAU,ETAGAU,SHPTOT,SHPWRK,
  940.      1            WORK(1),WORK(10),WORK(19),BGENE,DJAC)
  941.       ENDIF
  942.       DJAC=DJAC*POIGAU(IGAU)
  943. C
  944. C  ON MODIFIE LA MATRICE B EN CAS D'EXCENTREMENT
  945. C
  946.         IF (EXCEN.NE.0.) THEN
  947.       DO 1593 IJL=1,3
  948.       DO 1593 IJC=1,LRE
  949.       BGENE(IJL,IJC)=BGENE(IJL,IJC)+EXCEN*BGENE(IJL+3,IJC)
  950.  1593 CONTINUE
  951.         ENDIF
  952. C
  953.       CALL BDBS1(BGENE,DJAC,DDHOMU,LRE,NSTRS,REL,MFR,IFOUR,MATE,
  954.      1     IGAU,IMAT,EXCEN)
  955.  1193 CONTINUE
  956.       REL(6,6)=REL(5,5)*1.D-7
  957.       REL(12,12)=REL(6,6)
  958.       REL(18,18)=REL(6,6)
  959.       ICOM=0
  960.       IF(ABS(EXCEN).GT.XPETIT .OR. CMATE.EQ.'COMPOSIT'
  961.      1  .OR. IMAT.EQ.2) ICOM=1
  962.       CALL TRANSK(REL,BPSS,LRE,3,ICOM)
  963. C
  964. C     REMPLISSAGE DE XMATRI
  965. C
  966.       CALL REMPMT(REL,LRE,RE(1,1,IB))
  967.  3093  CONTINUE
  968. C
  969.  9993 CONTINUE
  970.       SEGSUP WRK1,WRK2,WRK3,WRK4
  971.       GOTO 510
  972. *
  973. C=======================================================================
  974. C========= ERREUR : CAS NON PREVUS =====================================
  975. C=======================================================================
  976.    99 CONTINUE
  977.       MOTERR(1:4)=NOMTP(MELE)
  978.       MOTERR(9:12)='RIGI3'
  979.       CALL ERREUR(86)
  980. *
  981.   510 CONTINUE
  982.       SEGSUP,MVELCH
  983. *      SEGDES XMATRI
  984.  
  985.       RETURN
  986.       END
  987.  
  988.  
  989.  
  990.  

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