Télécharger la plaquette Cast3M


fr en

Télécharger reshpx.eso

Retour à la liste

Numérotation des lignes : 

reshpx

  1. C RESHPX    SOURCE    CB215821  26/06/25    21:15:20     12581          
  2. C 20.04.2005
  3. C
  4.       SUBROUTINE RESHPX(NBG,NBSH,IELE,MELE,NPINT,IPT,IRT)
  5. C
  6. C=====================================================================
  7. C     MET LES VALEURS DES FONCTIONS DE FORMES DANS SHPTOT
  8. C      ET LES COORDOONEES REDUITES+LES POIDS D INTEGRATION
  9. C      DANS QSIGAU ETAGAU DZEGAU POIGAU  ; LE TOUT EST
  10. C      MIS DANS LE POINTEUR MINTE SON POINTEUR EST IPT
  11. C     NNN   =NOMBRE DE POINTS DE GAUSS
  12. C     NBSH  =NOMBRE DE FONCTIONS D'INTERPOLATION
  13. C     IELE  =NUMERO DE L ELEMENT DANS NOMS (VOIR CCGEOME )
  14. C     MELE  =NUMERO DE L ELEMENT DANS NOMTP
  15. C    NPINT=NOMBRE DE POINTS D'INTEGRATION DONS LE CAS DES
  16. C          ELEMENTS COQUES INTEGRES
  17. C     IPT   = POINTEUR  SUR MINTE
  18. C     IRET=1  OU  0  SUIVANT QUE MINTE A ETE CREEE OU PAS
  19. C
  20. C     CETTE ROUTINE GERE LES MESSAGES D ERREURS
  21. C     PROVENANT DE L INCOMPATIBILTE ENTRE NOMS
  22. C     D ELEMENTS,NOMBRE DE POINTS DE GAUSS,ET FONCTIONS DE FORME
  23. C=====================================================================
  24. C
  25.       IMPLICIT REAL*8(A-H,O-Z)
  26. C
  27. -INC CCREEL
  28. -INC CCGEOME
  29. -INC SMINTE
  30.  
  31. -INC PPARAM
  32. -INC CCOPTIO
  33. c
  34. c
  35.       INTEGER     NBG,NBSH,IELE,MELE,NPINT,IRET
  36.       INTEGER     NBNN,NBPGAU,NBNO,II,JJ,KK,KGAU,IENR,NBENR,INI
  37. c      REAL*8      DELTAQSI,QSI0,ETA0
  38. C
  39.       PARAMETER   (XZER=0.D0,UNDEMI=.5D0,UN=1.D0,DEUX=2.D0)
  40.       PARAMETER   (TROIS=3.D0,QUATRE=4.D0,HUIT=8.D0)
  41. C
  42.       PARAMETER   (NGAUMAX=8)
  43. C
  44.       REAL*8 QSIREF(NGAUMAX),ETAREF(NGAUMAX),POIREF(NGAUMAX)
  45.       REAL*8 DZEREF(NGAUMAX)
  46.       REAL*8 QSI,ETA,DELTAQSI,QSI0,ETA0
  47.       REAL*8 DZE,DZE0
  48.       REAL*8 SHP1,SHP2,SHP3,SHP4,SHP1Q,SHP2Q,SHP3Q,SHP4Q
  49.       REAL*8 SHP5,SHP6,SHP7,SHP8,SHP5Q,SHP6Q,SHP7Q,SHP8Q
  50.       REAL*8 SHP1E,SHP2E,SHP3E,SHP4E
  51.       REAL*8 SHP5E,SHP6E,SHP7E,SHP8E
  52.       REAL*8 SHP1D,SHP2D,SHP3D,SHP4D
  53.       REAL*8 SHP5D,SHP6D,SHP7D,SHP8D
  54. C
  55. C
  56.  
  57.       DATA X577/.577350269189626D0/
  58.  
  59. C
  60.       IF (IDIM.EQ.2) THEN
  61. c
  62.         if (MELE.eq.263) then
  63. C++++++++ QUADRANGLE  A 4 NOEUDS
  64.           NBNN = 4
  65.           NGAU = 4
  66.           QSIREF(1)=-X577
  67.           QSIREF(2)= X577
  68.           QSIREF(3)= X577
  69.           QSIREF(4)=-X577
  70.           ETAREF(1)=-X577
  71.           ETAREF(2)=-X577
  72.           ETAREF(3)= X577
  73.           ETAREF(4)= X577
  74.           POIREF(1)= UN
  75.           POIREF(2)= UN
  76.           POIREF(3)= UN
  77.           POIREF(4)= UN
  78.          endif
  79. c
  80.       ENDIF
  81. c
  82. C
  83.       IF (IDIM.EQ.3) THEN
  84. c
  85.         if (MELE.eq.264) then
  86. C++++++++ CUBE  A 8 NOEUDS
  87.           NBNN = 8
  88.           NGAU = 8
  89.           QSIREF(1)=-X577
  90.           QSIREF(2)= X577
  91.           QSIREF(3)= X577
  92.           QSIREF(4)=-X577
  93.           QSIREF(5)=-X577
  94.           QSIREF(6)= X577
  95.           QSIREF(7)= X577
  96.           QSIREF(8)=-X577
  97.           ETAREF(1)=-X577
  98.           ETAREF(2)=-X577
  99.           ETAREF(3)= X577
  100.           ETAREF(4)= X577
  101.           ETAREF(5)=-X577
  102.           ETAREF(6)=-X577
  103.           ETAREF(7)= X577
  104.           ETAREF(8)= X577
  105.           DZEREF(1)=-X577
  106.           DZEREF(2)=-X577
  107.           DZEREF(3)=-X577
  108.           DZEREF(4)=-X577
  109.           DZEREF(5)= X577
  110.           DZEREF(6)= X577
  111.           DZEREF(7)= X577
  112.           DZEREF(8)= X577
  113.           POIREF(1)= UN
  114.           POIREF(2)= UN
  115.           POIREF(3)= UN
  116.           POIREF(4)= UN
  117.           POIREF(5)= UN
  118.           POIREF(6)= UN
  119.           POIREF(7)= UN
  120.           POIREF(8)= UN
  121. c
  122.         endif
  123. c
  124.       ENDIF
  125.  
  126. C
  127. C=====================================================================
  128. C     INITIALISATIONS
  129. C
  130.       NBPGAU= NBG
  131.       NBNO  = NBSH
  132.       SEGINI,MINTE
  133.       IPT  = MINTE
  134.       IRET=1
  135. C
  136.       NBENR = NBSH/NBNN
  137. C
  138. C=====================================================================
  139. C     EN 2D SOUS DECOUPAGE  EN  NBSSEF Q4  A 4 POINT DE GAUSS
  140. C     EN 3D SOUS DECOUPAGE  EN  NBSSEF CUB8  A 8 POINT DE GAUSS
  141.       IF(MOD(NBG,NBNN).NE.0)
  142.      $ WRITE(*,*) 'NOMBRE DE PT DE GAUSS INDIVISIBLE PAR 4(2D) ou 8(3D)'
  143.       XDIM = 1.D0/IDIM
  144.       NBSSEF = NINT( REAL(NBG / NBNN)** XDIM )
  145. C     WRITE(*,*) 'TY',IDIM,XDIM,NBG,NBNN,NBSSEF
  146.       IF((NBNN*(NBSSEF**IDIM)).NE.NBG)
  147.      $      WRITE(*,*) 'NOMBRE DE PT DE GAUSS INCORRECT'
  148. C
  149.         KGAU = 0
  150. C        write(*,*) '--->boucle sur',NBSSEF,'^2 elements *',
  151. C    $        NGAU,' pt de G'
  152. C
  153.           DELTAQSI = DEUX/(FLOAT(NBSSEF))
  154. C         write(*,*) 'deltaqsi',deltaqsi
  155. C
  156. C=====================================================================
  157. C     EN 2D SOUS DECOUPAGE  EN  NBSSEF Q4  A 4 POINT DE GAUSS
  158.        IF (IDIM.EQ.2) THEN
  159.  
  160. C*********  boucle sur les lignes  *********
  161.         DO JJ=1,NBSSEF
  162. C********* boucle sur les colonnes *********
  163.         DO II=1,NBSSEF
  164. C
  165. C         coordonnees au centre du sous element
  166.           QSI0 = DELTAQSI*(FLOAT(II)-UNDEMI) - UN
  167.           ETA0 = DELTAQSI*(FLOAT(JJ)-UNDEMI) - UN
  168. C
  169. C***** boucle sur les pts de gauss du Pseudo-sous element *****
  170.         DO KK=1,NGAU
  171.           KGAU = KGAU + 1
  172. C         calcul des coordonnees + poids
  173.           QSIGAU(KGAU) = (UNDEMI*DELTAQSI*QSIREF(KK)) + QSI0
  174.           ETAGAU(KGAU) = (UNDEMI*DELTAQSI*ETAREF(KK)) + ETA0
  175.           POIGAU(KGAU) = POIREF(KK) / (FLOAT(NBSSEF**IDIM))
  176. c          WRITE(*,*) KGAU,QSIGAU(KGAU),ETAGAU(KGAU),POIGAU(KGAU)
  177.         ENDDO
  178. C** fin de boucle sur les points de gauss du sous element **
  179.         ENDDO
  180. C***** fin de boucle sur les colonnes ******
  181.         ENDDO
  182. C*******fin de boucle sur les lignes  ******
  183.  
  184. C=====================================================================
  185. C     EN 3D SOUS DECOUPAGE  EN  NBSSEF CUB8  A 8 POINT DE GAUSS
  186.        ELSE
  187. c        (IDIM.EQ.3)
  188.  
  189.          JZMAX= NBSSEF
  190. C********* boucle sur la 3eme direction *********
  191.         DO JZ=1,JZMAX
  192. C*********  boucle sur les lignes  *********
  193.         DO JJ=1,NBSSEF
  194. C********* boucle sur les colonnes *********
  195.         DO II=1,NBSSEF
  196. C
  197. C         coordonnees au centre du sous element
  198.           QSI0 = DELTAQSI*(FLOAT(II)-UNDEMI) - UN
  199.           ETA0 = DELTAQSI*(FLOAT(JJ)-UNDEMI) - UN
  200.           DZE0 = DELTAQSI*(FLOAT(JZ)-UNDEMI) - UN
  201. C
  202. C***** boucle sur les pts de gauss du Pseudo-sous element *****
  203.         DO KK=1,NGAU
  204.           KGAU = KGAU + 1
  205. C         calcul des coordonnees + poids
  206.           QSIGAU(KGAU) = (UNDEMI*DELTAQSI*QSIREF(KK)) + QSI0
  207.           ETAGAU(KGAU) = (UNDEMI*DELTAQSI*ETAREF(KK)) + ETA0
  208.           DZEGAU(KGAU) = (UNDEMI*DELTAQSI*DZEREF(KK)) + DZE0
  209.           POIGAU(KGAU) = POIREF(KK) / (FLOAT(NBSSEF**IDIM))
  210. c          WRITE(*,*) KGAU,QSIGAU(KGAU),ETAGAU(KGAU),POIGAU(KGAU)
  211.         ENDDO
  212. C** fin de boucle sur les points de gauss du sous element **
  213.         ENDDO
  214. C***** fin de boucle sur les colonnes ******
  215.         ENDDO
  216. C*******fin de boucle sur les lignes  ******
  217.         ENDDO
  218. C*******fin de boucle sur la  3eme direction  ******
  219.  
  220.        ENDIF
  221. C
  222. C=====================================================================
  223.  
  224. C
  225. C=======================================================
  226. C     ON MET LES Ni STD PARTOUT
  227. C
  228. C***** boucle sur les points de gauss *****
  229.       DO 2001 KGAU=1,NBPGAU
  230.  
  231.       QSI = QSIGAU(KGAU)
  232.       ETA = ETAGAU(KGAU)
  233.  
  234.       IF (IDIM.EQ.2) THEN
  235.  
  236. C     fonctions standards : Ni
  237.       SHP1 = (UN-QSI)*(UN-ETA)/QUATRE
  238.       SHP2 = (UN+QSI)*(UN-ETA)/QUATRE
  239.       SHP3 = (UN+QSI)*(UN+ETA)/QUATRE
  240.       SHP4 = (UN-QSI)*(UN+ETA)/QUATRE
  241. C     dérivée des fonctions standards : Ni,qsi
  242.       SHP1Q = (ETA-UN)/QUATRE
  243.       SHP2Q = -SHP1Q
  244.       SHP3Q = (ETA+UN)/QUATRE
  245.       SHP4Q = -SHP3Q
  246. C     dérivée des fonctions standards : Ni,eta
  247.       SHP1E = (QSI-UN)/QUATRE
  248.       SHP2E = -(UN+QSI)/QUATRE
  249.       SHP3E = -SHP2E
  250.       SHP4E = -SHP1E
  251. C
  252.       ELSE
  253.  
  254.       DZE = DZEGAU(KGAU)
  255. C     fonctions standards : Ni
  256.       SHP1 = (UN-QSI)*(UN-ETA)*(UN-DZE)/HUIT
  257.       SHP2 = (UN+QSI)*(UN-ETA)*(UN-DZE)/HUIT
  258.       SHP3 = (UN+QSI)*(UN+ETA)*(UN-DZE)/HUIT
  259.       SHP4 = (UN-QSI)*(UN+ETA)*(UN-DZE)/HUIT
  260.       SHP5 = (UN-QSI)*(UN-ETA)*(UN+DZE)/HUIT
  261.       SHP6 = (UN+QSI)*(UN-ETA)*(UN+DZE)/HUIT
  262.       SHP7 = (UN+QSI)*(UN+ETA)*(UN+DZE)/HUIT
  263.       SHP8 = (UN-QSI)*(UN+ETA)*(UN+DZE)/HUIT
  264. C     dérivée des fonctions standards : Ni,qsi
  265.       SHP1Q = (ETA-UN)*(UN-DZE)/HUIT
  266.       SHP2Q = -SHP1Q
  267.       SHP3Q = (ETA+UN)*(UN-DZE)/HUIT
  268.       SHP4Q = -SHP3Q
  269.       SHP5Q = (ETA-UN)*(UN+DZE)/HUIT
  270.       SHP6Q = -SHP5Q
  271.       SHP7Q = (ETA+UN)*(UN+DZE)/HUIT
  272.       SHP8Q = -SHP7Q
  273. C     dérivée des fonctions standards : Ni,eta
  274.       SHP1E = (QSI-UN)*(UN-DZE)/HUIT
  275.       SHP2E = -(UN+QSI)*(UN-DZE)/HUIT
  276.       SHP3E = -SHP2E
  277.       SHP4E = -SHP1E
  278.       SHP5E = (QSI-UN)*(UN+DZE)/HUIT
  279.       SHP6E = -(UN+QSI)*(UN+DZE)/HUIT
  280.       SHP7E = -SHP6E
  281.       SHP8E = -SHP5E
  282. C     dérivée des fonctions standards : Ni,dze
  283.       SHP1D = (UN-QSI)*(ETA-UN)/HUIT
  284.       SHP2D = (UN+QSI)*(ETA-UN)/HUIT
  285.       SHP3D = -(UN+QSI)*(UN+ETA)/HUIT
  286.       SHP4D = (QSI-UN)*(UN+ETA)/HUIT
  287.       SHP5D = -SHP1D
  288.       SHP6D = -SHP2D
  289.       SHP7D = -SHP3D
  290.       SHP8D = -SHP4D
  291.       ENDIF
  292.  
  293.  
  294. C***** boucle sur les enrichissements *****
  295.       DO 2002 IENR=1,NBENR
  296.  
  297.       II = (IENR-1)*NBNN + 1
  298. C     fonctions standards : Ni
  299.       SHPTOT(1,II,KGAU) = SHP1
  300.       SHPTOT(1,II+1,KGAU) = SHP2
  301.       SHPTOT(1,II+2,KGAU) = SHP3
  302.       SHPTOT(1,II+3,KGAU) = SHP4
  303. C     dérivée des fonctions standards : Ni,qsi
  304.       SHPTOT(2,II,KGAU) = SHP1Q
  305.       SHPTOT(2,II+1,KGAU) = SHP2Q
  306.       SHPTOT(2,II+2,KGAU) = SHP3Q
  307.       SHPTOT(2,II+3,KGAU) = SHP4Q
  308. C     dérivée des fonctions standards : Ni,eta
  309.       SHPTOT(3,II,KGAU) = SHP1E
  310.       SHPTOT(3,II+1,KGAU) = SHP2E
  311.       SHPTOT(3,II+2,KGAU) = SHP3E
  312.       SHPTOT(3,II+3,KGAU) = SHP4E
  313. C
  314.       IF (IDIM.EQ.3) THEN
  315. C     fonctions standards : Ni
  316.       SHPTOT(1,II+4,KGAU) = SHP5
  317.       SHPTOT(1,II+5,KGAU) = SHP6
  318.       SHPTOT(1,II+6,KGAU) = SHP7
  319.       SHPTOT(1,II+7,KGAU) = SHP8
  320. C     dérivée des fonctions standards : Ni,qsi
  321.       SHPTOT(2,II+4,KGAU) = SHP5Q
  322.       SHPTOT(2,II+5,KGAU) = SHP6Q
  323.       SHPTOT(2,II+6,KGAU) = SHP7Q
  324.       SHPTOT(2,II+7,KGAU) = SHP8Q
  325. C     dérivée des fonctions standards : Ni,eta
  326.       SHPTOT(3,II+4,KGAU) = SHP5E
  327.       SHPTOT(3,II+5,KGAU) = SHP6E
  328.       SHPTOT(3,II+6,KGAU) = SHP7E
  329.       SHPTOT(3,II+7,KGAU) = SHP8E
  330. C     dérivée des fonctions standards : Ni,dze
  331.       SHPTOT(4,II,KGAU) = SHP1D
  332.       SHPTOT(4,II+1,KGAU) = SHP2D
  333.       SHPTOT(4,II+2,KGAU) = SHP3D
  334.       SHPTOT(4,II+3,KGAU) = SHP4D
  335.       SHPTOT(4,II+4,KGAU) = SHP5D
  336.       SHPTOT(4,II+5,KGAU) = SHP6D
  337.       SHPTOT(4,II+6,KGAU) = SHP7D
  338.       SHPTOT(4,II+7,KGAU) = SHP8D
  339.       ENDIF
  340. C
  341. C
  342.  2002 CONTINUE
  343.  2001 CONTINUE
  344. C
  345.  
  346. C=======================================================
  347. C     ON CALCULE LES FONCTIONS D EXTRAPOLATIONS
  348. C
  349. C      CALL EXTRAP(SHPTOT,NNN,NBBB,NBNO)
  350. C
  351. C
  352.  
  353. C=======================================================
  354. C     ON DESACTIVE LES SEGMENTS
  355.       SEGDES MINTE
  356. C
  357.       RETURN
  358.       END
  359.  
  360.  
  361.  

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