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    BP208322  16/11/18    21:20:58     9177           
  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./IDIM
  144.       NBSSEF =  NINT( (NBG / NBNN)**(XDIM) )
  145. C     NBSSEF =  NINT( (NBG / NBNN)**(1/IDIM) )
  146. C     WRITE(*,*) 'TY',IDIM,XDIM,NBG,NBNN,NBSSEF
  147.       IF((NBNN*(NBSSEF**IDIM)).NE.NBG)
  148.      $      WRITE(*,*) 'NOMBRE DE PT DE GAUSS INCORRECT'
  149. C
  150.         KGAU = 0
  151. C        write(*,*) '--->boucle sur',NBSSEF,'^2 elements *',
  152. C    $        NGAU,' pt de G'
  153. C
  154.           DELTAQSI = DEUX/(FLOAT(NBSSEF))
  155. C         write(*,*) 'deltaqsi',deltaqsi
  156. C
  157. C=====================================================================
  158. C     EN 2D SOUS DECOUPAGE  EN  NBSSEF Q4  A 4 POINT DE GAUSS
  159.        IF (IDIM.EQ.2) THEN
  160.  
  161. C*********  boucle sur les lignes  *********
  162.         DO JJ=1,NBSSEF
  163. C********* boucle sur les colonnes *********
  164.         DO II=1,NBSSEF
  165. C
  166. C         coordonnees au centre du sous element
  167.           QSI0 = DELTAQSI*(FLOAT(II)-UNDEMI) - UN
  168.           ETA0 = DELTAQSI*(FLOAT(JJ)-UNDEMI) - UN
  169. C
  170. C***** boucle sur les pts de gauss du Pseudo-sous element *****
  171.         DO KK=1,NGAU
  172.           KGAU = KGAU + 1
  173. C         calcul des coordonnees + poids
  174.           QSIGAU(KGAU) = (UNDEMI*DELTAQSI*QSIREF(KK)) + QSI0
  175.           ETAGAU(KGAU) = (UNDEMI*DELTAQSI*ETAREF(KK)) + ETA0
  176.           POIGAU(KGAU) = POIREF(KK) / (FLOAT(NBSSEF**IDIM))
  177. c          WRITE(*,*) KGAU,QSIGAU(KGAU),ETAGAU(KGAU),POIGAU(KGAU)
  178.         ENDDO
  179. C** fin de boucle sur les points de gauss du sous element **
  180.         ENDDO
  181. C***** fin de boucle sur les colonnes ******
  182.         ENDDO
  183. C*******fin de boucle sur les lignes  ******
  184.  
  185. C=====================================================================
  186. C     EN 3D SOUS DECOUPAGE  EN  NBSSEF CUB8  A 8 POINT DE GAUSS
  187.        ELSE
  188. c        (IDIM.EQ.3)
  189.  
  190.          JZMAX= NBSSEF
  191. C********* boucle sur la 3eme direction *********
  192.         DO JZ=1,JZMAX
  193. C*********  boucle sur les lignes  *********
  194.         DO JJ=1,NBSSEF
  195. C********* boucle sur les colonnes *********
  196.         DO II=1,NBSSEF
  197. C
  198. C         coordonnees au centre du sous element
  199.           QSI0 = DELTAQSI*(FLOAT(II)-UNDEMI) - UN
  200.           ETA0 = DELTAQSI*(FLOAT(JJ)-UNDEMI) - UN
  201.           DZE0 = DELTAQSI*(FLOAT(JZ)-UNDEMI) - UN
  202. C
  203. C***** boucle sur les pts de gauss du Pseudo-sous element *****
  204.         DO KK=1,NGAU
  205.           KGAU = KGAU + 1
  206. C         calcul des coordonnees + poids
  207.           QSIGAU(KGAU) = (UNDEMI*DELTAQSI*QSIREF(KK)) + QSI0
  208.           ETAGAU(KGAU) = (UNDEMI*DELTAQSI*ETAREF(KK)) + ETA0
  209.           DZEGAU(KGAU) = (UNDEMI*DELTAQSI*DZEREF(KK)) + DZE0
  210.           POIGAU(KGAU) = POIREF(KK) / (FLOAT(NBSSEF**IDIM))
  211. c          WRITE(*,*) KGAU,QSIGAU(KGAU),ETAGAU(KGAU),POIGAU(KGAU)
  212.         ENDDO
  213. C** fin de boucle sur les points de gauss du sous element **
  214.         ENDDO
  215. C***** fin de boucle sur les colonnes ******
  216.         ENDDO
  217. C*******fin de boucle sur les lignes  ******
  218.         ENDDO
  219. C*******fin de boucle sur la  3eme direction  ******
  220.  
  221.        ENDIF
  222. C
  223. C=====================================================================
  224.  
  225. C
  226. C=======================================================
  227. C     ON MET LES Ni STD PARTOUT
  228. C
  229. C***** boucle sur les points de gauss *****
  230.       DO 2001 KGAU=1,NBPGAU
  231.  
  232.       QSI = QSIGAU(KGAU)
  233.       ETA = ETAGAU(KGAU)
  234.  
  235.       IF (IDIM.EQ.2) THEN
  236.  
  237. C     fonctions standards : Ni
  238.       SHP1 = (UN-QSI)*(UN-ETA)/QUATRE
  239.       SHP2 = (UN+QSI)*(UN-ETA)/QUATRE
  240.       SHP3 = (UN+QSI)*(UN+ETA)/QUATRE
  241.       SHP4 = (UN-QSI)*(UN+ETA)/QUATRE
  242. C     dérivée des fonctions standards : Ni,qsi
  243.       SHP1Q = (ETA-UN)/QUATRE
  244.       SHP2Q = -SHP1Q
  245.       SHP3Q = (ETA+UN)/QUATRE
  246.       SHP4Q = -SHP3Q
  247. C     dérivée des fonctions standards : Ni,eta
  248.       SHP1E = (QSI-UN)/QUATRE
  249.       SHP2E = -(UN+QSI)/QUATRE
  250.       SHP3E = -SHP2E
  251.       SHP4E = -SHP1E
  252. C
  253.       ELSE
  254.  
  255.       DZE = DZEGAU(KGAU)
  256. C     fonctions standards : Ni
  257.       SHP1 = (UN-QSI)*(UN-ETA)*(UN-DZE)/HUIT
  258.       SHP2 = (UN+QSI)*(UN-ETA)*(UN-DZE)/HUIT
  259.       SHP3 = (UN+QSI)*(UN+ETA)*(UN-DZE)/HUIT
  260.       SHP4 = (UN-QSI)*(UN+ETA)*(UN-DZE)/HUIT
  261.       SHP5 = (UN-QSI)*(UN-ETA)*(UN+DZE)/HUIT
  262.       SHP6 = (UN+QSI)*(UN-ETA)*(UN+DZE)/HUIT
  263.       SHP7 = (UN+QSI)*(UN+ETA)*(UN+DZE)/HUIT
  264.       SHP8 = (UN-QSI)*(UN+ETA)*(UN+DZE)/HUIT
  265. C     dérivée des fonctions standards : Ni,qsi
  266.       SHP1Q = (ETA-UN)*(UN-DZE)/HUIT
  267.       SHP2Q = -SHP1Q
  268.       SHP3Q = (ETA+UN)*(UN-DZE)/HUIT
  269.       SHP4Q = -SHP3Q
  270.       SHP5Q = (ETA-UN)*(UN+DZE)/HUIT
  271.       SHP6Q = -SHP5Q
  272.       SHP7Q = (ETA+UN)*(UN+DZE)/HUIT
  273.       SHP8Q = -SHP7Q
  274. C     dérivée des fonctions standards : Ni,eta
  275.       SHP1E = (QSI-UN)*(UN-DZE)/HUIT
  276.       SHP2E = -(UN+QSI)*(UN-DZE)/HUIT
  277.       SHP3E = -SHP2E
  278.       SHP4E = -SHP1E
  279.       SHP5E = (QSI-UN)*(UN+DZE)/HUIT
  280.       SHP6E = -(UN+QSI)*(UN+DZE)/HUIT
  281.       SHP7E = -SHP6E
  282.       SHP8E = -SHP5E
  283. C     dérivée des fonctions standards : Ni,dze
  284.       SHP1D = (UN-QSI)*(ETA-UN)/HUIT
  285.       SHP2D = (UN+QSI)*(ETA-UN)/HUIT
  286.       SHP3D = -(UN+QSI)*(UN+ETA)/HUIT
  287.       SHP4D = (QSI-UN)*(UN+ETA)/HUIT
  288.       SHP5D = -SHP1D
  289.       SHP6D = -SHP2D
  290.       SHP7D = -SHP3D
  291.       SHP8D = -SHP4D
  292.       ENDIF
  293.  
  294.  
  295. C***** boucle sur les enrichissements *****
  296.       DO 2002 IENR=1,NBENR
  297.  
  298.       II = (IENR-1)*NBNN + 1
  299. C     fonctions standards : Ni
  300.       SHPTOT(1,II,KGAU) = SHP1
  301.       SHPTOT(1,II+1,KGAU) = SHP2
  302.       SHPTOT(1,II+2,KGAU) = SHP3
  303.       SHPTOT(1,II+3,KGAU) = SHP4
  304. C     dérivée des fonctions standards : Ni,qsi
  305.       SHPTOT(2,II,KGAU) = SHP1Q
  306.       SHPTOT(2,II+1,KGAU) = SHP2Q
  307.       SHPTOT(2,II+2,KGAU) = SHP3Q
  308.       SHPTOT(2,II+3,KGAU) = SHP4Q
  309. C     dérivée des fonctions standards : Ni,eta
  310.       SHPTOT(3,II,KGAU) = SHP1E
  311.       SHPTOT(3,II+1,KGAU) = SHP2E
  312.       SHPTOT(3,II+2,KGAU) = SHP3E
  313.       SHPTOT(3,II+3,KGAU) = SHP4E
  314. C
  315.       IF (IDIM.EQ.3) THEN
  316. C     fonctions standards : Ni
  317.       SHPTOT(1,II+4,KGAU) = SHP5
  318.       SHPTOT(1,II+5,KGAU) = SHP6
  319.       SHPTOT(1,II+6,KGAU) = SHP7
  320.       SHPTOT(1,II+7,KGAU) = SHP8
  321. C     dérivée des fonctions standards : Ni,qsi
  322.       SHPTOT(2,II+4,KGAU) = SHP5Q
  323.       SHPTOT(2,II+5,KGAU) = SHP6Q
  324.       SHPTOT(2,II+6,KGAU) = SHP7Q
  325.       SHPTOT(2,II+7,KGAU) = SHP8Q
  326. C     dérivée des fonctions standards : Ni,eta
  327.       SHPTOT(3,II+4,KGAU) = SHP5E
  328.       SHPTOT(3,II+5,KGAU) = SHP6E
  329.       SHPTOT(3,II+6,KGAU) = SHP7E
  330.       SHPTOT(3,II+7,KGAU) = SHP8E
  331. C     dérivée des fonctions standards : Ni,dze
  332.       SHPTOT(4,II,KGAU) = SHP1D
  333.       SHPTOT(4,II+1,KGAU) = SHP2D
  334.       SHPTOT(4,II+2,KGAU) = SHP3D
  335.       SHPTOT(4,II+3,KGAU) = SHP4D
  336.       SHPTOT(4,II+4,KGAU) = SHP5D
  337.       SHPTOT(4,II+5,KGAU) = SHP6D
  338.       SHPTOT(4,II+6,KGAU) = SHP7D
  339.       SHPTOT(4,II+7,KGAU) = SHP8D
  340.       ENDIF
  341. C
  342. C
  343.  2002 CONTINUE
  344.  2001 CONTINUE
  345. C
  346.  
  347. C=======================================================
  348. C     ON CALCULE LES FONCTIONS D EXTRAPOLATIONS
  349. C
  350. C      CALL EXTRAP(SHPTOT,NNN,NBBB,NBNO)
  351. C
  352. C
  353.  
  354. C=======================================================
  355. C     ON DESACTIVE LES SEGMENTS
  356.       SEGDES MINTE
  357. C
  358.       RETURN
  359.       END
  360.  
  361.  
  362.  
  363.  
  364.  
  365.  
  366.  
  367.  
  368.  
  369.  
  370.  
  371.  
  372.  
  373.  

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