Télécharger la plaquette Cast3M


fr en

Télécharger sore2.eso

Retour à la liste

Numérotation des lignes : 

sore2

  1. C SORE2     SOURCE    OF166741  25/02/21    21:18:39     12166          
  2.  
  3. ************************************************************************
  4. *
  5. *                             SORE2
  6. *                             ------
  7. *         CREATION DE LA MATRICE DE CONDUCTIVITE   N DIV(GRAD T)
  8. *                        ( EFFET SORET)
  9. *
  10. * FONCTION:
  11. * ---------
  12. *     TRAITEMENT DU CAS DES ELEMENTS-FINIS MASSIFS A INTEGRATION
  13. *     NUMERIQUE,POUR UN MAILLAGE ELEMENTAIRE
  14. *
  15.  
  16. *
  17. * PARAMETRES:   (E)=ENTREE   (S)=SORTIE   (+ = CONTENU DANS UN COMMUN)
  18. * -----------
  19. *
  20. *     NEF     (E)  NUMERO DE L'ELEMENT-FINI DANS NOMTP (VOIR CCHAMP)
  21. *     IMAIL   (E)  NUMERO DU MAILLAGE ELEMENTAIRE CONSIDERE,DANS
  22. *                  L'OBJET MODELE
  23. *     IPMODE  (E)  POINTEUR SUR UN SEGMENT IMODEL
  24. *     IPCHEM  (E)  POINTEUR SUR UN CHAMELEM (GRAD T aux PTS de GAUSS)
  25. *     IPCHE1  (E)  POINTEUR SUR UN CHAMELEM MATERIAU
  26. *     IPCHE4  (E)  POINTEUR SUR UN CHAMELEM  FACTEUR DE GRAD T
  27. *
  28. *     IPRIGI (E/S) POINTEUR SUR L'OBJET RESULTAT,DE TYPE RIGIDITE
  29. *
  30. * VARIABLES:
  31. * ----------
  32. *
  33. *     NBNN     NOMBRE DE NOEUDS DANS L'ELEMENT CONSIDERE
  34. *     NEF      NUMERO DE L'ELEMENT FINI DANS NOMTP (VOIR CCHAMP)
  35. *     NBELEM   NOMBRE D'ELEMENTS DANS LE MAILLAGE ELEMENTAIRE
  36. *     NBPGAU   NOMBRE DE POINTS DE GAUSS DANS L'ELEMENT-FINI
  37. *     NDIM     NOMBRE DE LIGNES DE LA MATRICE GRADIENT
  38. *     CEL(NBNN,NBNN)  MATRICE DE CONDUCTIVITE ELEMENTAIRE NON SYMETRIQUE
  39. *     XE(3,NBNN)      COORDONNEES DE L'ELEMENT DANS LE REPERE GLOBAL
  40. *     SHP(6,NBNN)     TABLEAU DE TRAVAIL
  41. *     GRAD(NDIM,NBNN) MATRICE GRADIENT DES FONCTIONS DE FORME
  42. *
  43. *
  44. * AUTEUR, DATE DE CREATION:
  45. * -------------------------
  46. *
  47. *     J.M.BAZE   AVRIL 97
  48. *
  49. * LANGAGE:
  50. * --------
  51. *
  52. *     ESOPE + FORTRAN77
  53. *
  54. ************************************************************************  *
  55.       SUBROUTINE SORE2(NEF,IMAIL,IPMODE,IPCHE1,IPCHEM,IPCHE4,IPRIGI)
  56.  
  57.       IMPLICIT INTEGER(I-N)
  58.       IMPLICIT REAL*8(A-H,O-Z)
  59.  
  60. -INC PPARAM
  61. -INC CCOPTIO
  62. -INC CCREEL
  63. C-INC CCHAMP
  64.  
  65. -INC SMCOORD
  66. -INC SMINTE
  67. -INC SMMODEL
  68. -INC SMRIGID
  69. -INC SMELEME
  70. -INC SMCHAML
  71.  
  72. -INC TMPTVAL
  73.  
  74.       SEGMENT,MAXE
  75.         REAL*8 XLOC(3,3),XGLOB(3,3),TXR(IDIM,IDIM)
  76.       ENDSEGMENT
  77. *
  78.       SEGMENT,MMAT1
  79.         REAL*8 CEL(NBNN,NBNN),XE(3,NBNN)
  80.         REAL*8 SHP(6,NBNN),GRAD(NDIM,NBNN)
  81.         REAL*8 CMAT(NDIM,NDIM),CMAT1(IDIM,IDIM)
  82.       ENDSEGMENT
  83. *
  84.       SEGMENT NOTYPE
  85.         CHARACTER*16 TYPE(NBTYPE)
  86.       ENDSEGMENT
  87. *
  88.       SEGMENT,MVELCH
  89.         REAL*8 GDT(IDIM),VALMAT(NV1), GDTL(IDIM)
  90.       ENDSEGMENT
  91. *
  92. *NU      CHARACTER*8 CNM
  93.       CHARACTER*(NCONCH) CONM
  94.       PARAMETER(NINF=3)
  95.       INTEGER INFOS(NINF)
  96.       LOGICAL lsupma
  97. *
  98. *     RECUPERATION DES CARACTERISTIQUES GEOMETRIQUES DU MAILLAGE
  99. *     ELEMENTAIRE
  100. *
  101.       IMODEL=IPMODE
  102. c*      SEGACT,IMODEL
  103.       CONM   =  imodel.CONMOD
  104.       IPMAIL = imodel.IMAMOD
  105.  
  106. *NU      CNM = imodel.CMATEE
  107.       INM = imodel.IMATEE
  108. *NU      INT = imodel.INATUU
  109.  
  110.       MELEME = imodel.IMAMOD
  111. c*      SEGACT,MELEME
  112.       NBNN   = meleme.NUM(/1)
  113.       NBELEM = meleme.NUM(/2)
  114.  
  115.       MRIGID = IPRIGI
  116. c*      SEGACT,MRIGID
  117.       xMATRI = IRIGEL(4,IMAIL)
  118. c*      SEGACT,xMATRI*MOD
  119.  
  120. *--------------------------
  121. *     RECHERCHE  POINTEUR DU SEGMENTS MELVAL  CONTENANT
  122. *              LA DIFFUSIVITE
  123. *
  124. *     REMLIR LE TABLEAU INFOS (INFORMATIONS SUR ELEMENT)
  125.       INFOS(1)=0
  126.       INFOS(1)=0
  127.       INFOS(2)=0
  128.       INFOS(3)=NIFOUR
  129. *
  130.       if (lnomid(6).ne.0) then
  131.         lsupma = .false.
  132.         nomid = imodel.lnomid(6)
  133.         SEGACT,nomid
  134.         MOMATR = nomid
  135.         NMATR = lesobl(/2)
  136.         NMATF = lesfac(/2)
  137.       else
  138.         MFR = 1
  139.         lsupma = .true.
  140.         CALL IDMATR(MFR,IMODEL,MOMATR,NMATR,NMATF)
  141.       endif
  142.       NMATT = NMATR
  143.       NV1   = NMATT
  144. *
  145.       NBTYPE = 1
  146.       SEGINI,notype
  147.       notype.TYPE(1) = 'REAL*8'
  148.       MOTYPE=notype
  149. *
  150.       CALL KOMCHA(IPCHE1,IPMAIL,CONM,MOMATR,MOTYPE,1,INFOS,3,IVAMAT)
  151.  
  152.       nomid = MOMATR
  153.       SEGDES,nomid
  154.       IF (lsupma) SEGSUP,nomid
  155.       SEGSUP,NOTYPE
  156.  
  157.       IF (IERR.NE.0)THEN
  158.         IPRIGI = 0
  159.         RETURN
  160.       ENDIF
  161. *
  162. *     RECUPERATION DES CARACTERISTIQUES D'INTEGRATION DE L'ELEMENT
  163. *     FINI LIE A NOTRE MAILLAGE
  164.       CALL TSHAPE(NEF,'GAUSS',IPINTE)
  165.       IF (IERR.NE.0) THEN
  166.         IPRIGI = 0
  167.         RETURN
  168.       ENDIF
  169.       MINTE = IPINTE
  170.       SEGACT,MINTE
  171.       NBPGAU = minte.POIGAU(/1)
  172.  
  173. *     RECUPERATION DES FONCTIONS DE FORME ET LEURS DERIVEES AU CENTRE
  174. *     DE L'ELEMENT POUR LE CALCUL  DES AXES LOCAUX
  175. *
  176.       NLG=NUMGEO(NEF)
  177.       CALL RESHPT(1,NBNN,NLG,NEF,0,IPT1,IRT1)
  178.       MINTE1 = IPT1
  179.       SEGACT,MINTE1
  180. *
  181. *----------------------------
  182.  
  183. *  recuperation des MELVAL composantes du gradient aux pts de Gauss
  184. *           et   de leurs multiplicateurs
  185.       MCHEL1=IPCHEM
  186.       MCHEL2=IPCHE4
  187.       SEGACT,MCHEL1,MCHEL2
  188.  
  189.       MCHAM1 = MCHEL1.ICHAML(1)
  190.       MCHAM2 = MCHEL2.ICHAML(1)
  191.       SEGACT,MCHAM1,MCHAM2
  192.       SEGDES,MCHEL1,MCHEL2
  193. *
  194.       MELVA1=MCHAM1.IELVAL(1)
  195.       MELVA2=MCHAM1.IELVAL(2)
  196.       SEGACT,MELVA1,MELVA2
  197.       IF(IDIM.EQ.3) THEN
  198.         MELVA3=MCHAM1.IELVAL(3)
  199.         SEGACT,MELVA3
  200.       ENDIF
  201.       MELVA4 =MCHAM2.IELVAL(1)
  202.       SEGACT,MELVA4
  203. *
  204.       NDIM=IDIM
  205.       SEGINI,MMAT1,MVELCH,MAXE
  206. *
  207. *     BOUCLE SUR LES ELEMENTS DU MAILLAGE ELEMENTAIRE IMAIL
  208. *
  209.       DO 10 IEL=1,NBELEM
  210. *
  211. *        MISE A ZERO DU TABLEAU CEL
  212. *
  213.         CALL ZERO(CEL,NBNN,NBNN)
  214.  
  215. *        ON CHERCHE LES COORDONNEES DES NOEUDS DE L'ELEMENT IEL,
  216. *        DANS LE REPERE GLOBAL
  217. *
  218.         CALL DOXE(XCOOR,IDIM,NBNN,NUM,IEL,XE)
  219. *
  220. *         CALCUL DES AXES LOCAUX DANS LE CAS ORTHO
  221. *
  222.         IF (INM.EQ.2)THEN
  223.           NBSH = MINTE1.SHPTOT(/2)
  224.           CALL RLOCAL(XE,MINTE1.SHPTOT,NBSH,NBNN,TXR)
  225.           if (nbsh.eq.-1) then
  226.             call erreur(525)
  227.             IPRIGI = 0
  228.             GOTO 99
  229.           endif
  230.         ENDIF
  231.  
  232. *        BOUCLE SUR LES POINTS DE GAUSS
  233. *
  234.         IFOIS=0
  235.         IFOI2=0
  236.  
  237.         DO 20 IGAU=1,NBPGAU
  238. *
  239. *           CALCUL DE LA MATRICE GRADIENT DES FONCTIONS DE FORME ET
  240. *           DU JACOBIEN,EN UN POINT DE GAUSS
  241.  
  242.           CALL TCOND5(IGAU,NBNN,NDIM,XE,SHPTOT,SHP,GRAD,DJAC)
  243. *  SI IFOMOD = 0  axi DJAC CONTITNT DEJA LE MULTIPLICATEUR 2*XPI*R
  244.  
  245.           IF (IERR.NE.0) THEN
  246.             IPRIGI = 0
  247.             GOTO 99
  248.           ENDIF
  249.             IF (DJAC.LT.XZERO) THEN
  250.                IFOIS=IFOIS+1
  251.             ENDIF
  252.             IF (ABS(DJAC).LT.XPETIT) THEN
  253.                IFOI2=IFOI2+1
  254.             ENDIF
  255. *
  256. *           ON MULTIPLIE LE JACOBIEN PAR LE POIDS D'INTEGRATION,
  257. *           POUR LE POINT DE GAUSS CONSIDERE
  258. *
  259.           DJAC=ABS(DJAC)*POIGAU(IGAU)
  260.  
  261. *    VALEURS DES COMPOSANTES DES GRADIENTS
  262.           DO  29 IM=1,IDIM
  263.              MELVAL=MCHAM1.IELVAL(IM)
  264.              IBMN=MIN(IEL,VELCHE(/2))
  265.              IGMN=MIN(IGAU,VELCHE(/1))
  266.              GDT(IM)=VELCHE(IGMN,IBMN)
  267.  29       CONTINUE
  268. *           FACTEUR DE GRAD T
  269.           IBMN=MIN(IEL,MELVA4.VELCHE(/2))
  270.           IGMN=MIN(IGAU,MELVA4.VELCHE(/1))
  271.           RMUL = MELVA4.VELCHE(IGMN,IBMN)
  272. *
  273. *     DIFFUSIVITE  DANS LE REPERE LOCAL
  274. *
  275.           MPTVAL=IVAMAT
  276.           DO  30 IM=1,NMATT
  277.             IF(IVAL(IM).NE.0)THEN
  278.               MELVAL=IVAL(IM)
  279.               IBMN=MIN(IEL,VELCHE(/2))
  280.               IGMN=MIN(IGAU,VELCHE(/1))
  281.               VALMAT(IM)=VELCHE(IGMN,IBMN)
  282.             ELSE
  283.               VALMAT(IM)=0.D0
  284.             ENDIF
  285.  30       CONTINUE
  286. *
  287.             IF (INM.EQ.1) THEN
  288. *------------------------ MATERIAU ISOTROPE ----------------------------
  289. *
  290. *     INTEGRATION DES TERMES  N VI B
  291. *
  292.                RK = VALMAT(1)*DJAC*RMUL
  293.                DO 700 K=1,IDIM
  294.                   XK = GDT(K)*RK
  295.                   DO 300 I=1,NBNN
  296.                      R_Z = SHP(1,I) * XK
  297.                      DO 400 J = 1, NBNN
  298.                         CEL(J,I) = CEL(J,I) + R_Z * GRAD(K,J)
  299.  400                 CONTINUE
  300.  300              CONTINUE
  301.  700           CONTINUE
  302. *
  303.             ELSE
  304. *-------------------  MATERIAU ORTHOTROPE -----------------
  305.                CALL ZERO(CMAT,NDIM,NDIM)
  306.                CALL ZERO(CMAT1,IDIM,IDIM)
  307.                CALL ZERO(XGLOB,IDIM,IDIM)
  308.                IF(IDIM.EQ.2) THEN
  309. *----------BIDIM
  310.  
  311. *             MATERIAU ORTHOTROPE
  312.  
  313.                   XLOC(1,1)=VALMAT(3)
  314.                   XLOC(2,1)=VALMAT(4)
  315.                   XLOC(1,2)=-VALMAT(4)
  316.                   XLOC(2,2)=VALMAT(3)
  317.  
  318. *           CALCUL DES COS.DIRECTEURS DES AXES ORTH. /REPERE GLOBAL
  319. *           XGLOB=TXR*XLOC
  320. *
  321.                   DO 40 K=1,IDIM
  322.                      DO 409 J=1,IDIM
  323.                         DO 4099 I=1,IDIM
  324.                            XGLOB(K,J)=TXR(J,I)*XLOC(I,K)+XGLOB(K,J)
  325.  4099                   CONTINUE
  326.  409                 CONTINUE
  327.  40               CONTINUE
  328. *
  329.                   DO 51 I = 1,IDIM
  330.                      CMAT1(I,I) = VALMAT(I)
  331.  51               CONTINUE
  332. *
  333. *              RETOUR DANS LE REPERE GLOBAL
  334.                   CALL PRODT(CMAT,CMAT1,XGLOB,IDIM,IDIM)
  335.                   DO 41 I= 1, IDIM
  336.                      GDTL(I) = 0.D0
  337.                      DO 411 J= 1, IDIM
  338.                         GDTL(I) = GDTL(I) + CMAT(I,J)*GDT(J)
  339.  411                 CONTINUE
  340.  41               CONTINUE
  341. *
  342.                ELSE
  343. *----------TRIDIM   MATERIAU ORTHOTROPE -------------------
  344.  
  345.                   XLOC(1,1)=VALMAT(4)
  346.                   XLOC(2,1)=VALMAT(5)
  347.                   XLOC(3,1)=VALMAT(6)
  348.                   XLOC(1,2)=VALMAT(7)
  349.                   XLOC(2,2)=VALMAT(8)
  350.                   XLOC(3,2)=VALMAT(9)
  351.                   CALL  CROSS2 (XLOC(1,1),XLOC(1,2),XLOC(1,3),IRR)
  352.                   DO 45 K=1,IDIM
  353.                      DO 451 J=1,IDIM
  354.                         DO 452 I=1,IDIM
  355.                            XGLOB(K,J)=TXR(J,I)*XLOC(I,K)+XGLOB(K,J)
  356.  452                    CONTINUE
  357.  451                 CONTINUE
  358.  45               CONTINUE
  359. *
  360.                   DO 52 I = 1,IDIM
  361.                      CMAT1(I,I) = VALMAT(I)
  362.  52               CONTINUE
  363. *
  364. *             RETOUR DANS  LE REPERE GLOBAL
  365.                   CALL PRODT(CMAT,CMAT1,XGLOB,IDIM,IDIM)
  366.  
  367.                   DO 53 I= 1, IDIM
  368.                      GDTL(I) = 0.D0
  369.                      DO 531 J= 1, IDIM
  370.                         GDTL(I) = GDTL(I) + CMAT(I,J)*GDT(J)
  371.  531                 CONTINUE
  372.  53               CONTINUE
  373. *
  374.                ENDIF
  375.  
  376. *     INTEGRATION DES TERMES  N VI B
  377. *
  378.                DO   701 K=1,IDIM
  379.                   XK = GDTL(K)*DJAC*RMUL
  380.                   DO   301 I=1,NBNN
  381.                      DO   401 J=1,NBNN
  382.                         CEL(J,I) = CEL(J,I) + SHP(1,I)*GRAD(K,J)*XK
  383.  401                 CONTINUE
  384.  301              CONTINUE
  385.  701           CONTINUE
  386.             ENDIF
  387. *
  388. *  FIN DE LA BOUCLE SUR LES POINTS DE GAUSS
  389. *
  390.  20      CONTINUE
  391. *        END DO
  392.          IF (IFOIS.NE.0.AND.IFOIS.NE.NBPGAU) THEN
  393. *
  394. *           LE JACOBIEN EST NEGATIF,MAILLAGE INCORRECT
  395. *
  396.             INTERR(1)=IEL
  397.             CALL ERREUR(195)
  398.             IPRIGI = 0
  399.             GOTO 99
  400.          ENDIF
  401.          IF (IFOI2.EQ.NBPGAU) THEN
  402. *
  403. *           CAS OU LE JACOBIEN EST TRES PETIT
  404. *
  405.             INTERR(1)=IEL
  406.             CALL ERREUR(259)
  407.             IPRIGI = 0
  408.             GOTO 99
  409.          ENDIF
  410.  
  411. *        REMPLISSAGE DE XMATRI
  412. *
  413.          DO 100 IA=1,NBNN
  414.             DO 1001 IB=1,NBNN
  415.                xmatri.RE(IA,IB,iel) = CEL(IA,IB)
  416.  1001       CONTINUE
  417.  100     CONTINUE
  418.  
  419. *         SEGDES,XMATRI
  420.  10   CONTINUE
  421. *     END DO
  422. *
  423. *     DESACTIVATION DES SEGMENTS
  424. *
  425.  99   CONTINUE
  426.       SEGSUP,MMAT1,MVELCH
  427.       SEGDES,MINTE,MINTE1
  428.       SEGDES,MELVA4
  429.       DO 550 I=1,IDIM
  430.         MELVAL=MCHAM1.IELVAL(I)
  431.         SEGDES,MELVAL
  432.  550  CONTINUE
  433.       SEGDES,MCHAM1
  434.  
  435.       CALL DTMVAL(IVAMAT,1)
  436.  
  437.       RETURN
  438.       END
  439.  
  440.  
  441.  

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