Télécharger la plaquette Cast3M


fr en

Télécharger georeg.eso

Retour à la liste

Numérotation des lignes : 

georeg

  1. C GEOREG    SOURCE    GOUNAND   26/01/09    21:15:30     12441          
  2.       SUBROUTINE GEOREG(ITQUAF,MYFALS,MYFPGS,
  3.      $        JMAREG,
  4.      $     IMPR,IRET)
  5.       IMPLICIT REAL*8 (A-H,O-Z)
  6.       IMPLICIT INTEGER (I-N)
  7. C***********************************************************************
  8. C NOM         : GEOREG
  9. C DESCRIPTION :
  10. *
  11. * Calcul du jacobien de la transformation :
  12. * élément volumique de référence -> élément réguliers
  13. * de côté 1
  14. * Cela sert pour l'adaptativité.
  15. C
  16. C LANGAGE     : ESOPE
  17. C AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  18. C               mél : gounand@semt2.smts.cea.fr
  19. C***********************************************************************
  20. C APPELES          :
  21. C APPELES (E/S)    :
  22. C APPELES (BLAS)   :
  23. C APPELES (CALCUL) :
  24. C APPELE PAR       :
  25. C***********************************************************************
  26. C SYNTAXE GIBIANE    :
  27. C ENTREES            :
  28. C ENTREES/SORTIES    :
  29. C SORTIES            :
  30. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  31. C***********************************************************************
  32. C VERSION    : v1, 04/10/2005, version initiale
  33. C HISTORIQUE : v1, 04/10/2005, création
  34. C HISTORIQUE :
  35. C HISTORIQUE :
  36. C***********************************************************************
  37. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  38. C en cas de modification de ce sous-programme afin de faciliter
  39. C la maintenance !
  40. C***********************************************************************
  41.  
  42. -INC PPARAM
  43. -INC CCOPTIO
  44. -INC CCGEOME
  45. -INC TNLIN
  46. *-INC SELREF
  47.       POINTEUR ELCOUR.ELREF
  48. *-INC SFALRF
  49.       POINTEUR MYFALS.FALRFS
  50. *-INC SPOGAU
  51.       POINTEUR MYPGS.POGAUS
  52.       POINTEUR PGCOUR.POGAU
  53. *-INC SFAPG
  54.       POINTEUR MYFPGS.FAPGS
  55. *-INC SMCHAEL
  56.       INTEGER NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM
  57.       POINTEUR JCOOR.MCHEVA
  58.       POINTEUR JMAREG.MCHEVA
  59.       POINTEUR JMIREG.MCHEVA
  60.       POINTEUR JDTREG.MCHEVA
  61.       POINTEUR FFPG.MCHEVA,DFFPG.MCHEVA
  62. *
  63.       SEGMENT NOEREG
  64.       REAL*8  XNOEUD(NDIM,NNLREG)
  65.       ENDSEGMENT
  66. *
  67.       CHARACTER*4 CQUAF,METGAU,MYDISC
  68.       INTEGER IMPR,IRET
  69.  
  70. *
  71. * Executable statements
  72. *
  73.       IF (IMPR.GT.2) WRITE(IOIMP,*) 'Entrée dans georeg.eso'
  74.       CQUAF=NOMS(ITQUAF)
  75. *
  76. * Here : SEGINI NOEREG
  77. *
  78.       IF (CQUAF.EQ.'SEG3') THEN
  79.          NNLREG=2
  80.          NDIM  =1
  81.          SEGINI NOEREG
  82.          XNOEUD(1,1)=0.D0
  83.          XNOEUD(1,2)=1.D0
  84. *        SEGDES NOEREG
  85.       ELSEIF (CQUAF.EQ.'TRI7') THEN
  86.          NNLREG=3
  87.          NDIM  =2
  88.          SEGINI NOEREG
  89.          XNOEUD(1,1)=0.D0
  90.          XNOEUD(2,1)=0.D0
  91.          XNOEUD(1,2)=1.D0
  92.          XNOEUD(2,2)=0.D0
  93.          XNOEUD(1,3)=0.5D0
  94.          XNOEUD(2,3)=SQRT(3.D0)/2.D0
  95. *        SEGDES NOEREG
  96.       ELSEIF (CQUAF.EQ.'QUA9') THEN
  97.          NNLREG=4
  98.          NDIM  =2
  99.          SEGINI NOEREG
  100.          XNOEUD(1,1)=0.D0
  101.          XNOEUD(2,1)=0.D0
  102.          XNOEUD(1,2)=1.D0
  103.          XNOEUD(2,2)=0.D0
  104.          XNOEUD(1,3)=1.D0
  105.          XNOEUD(2,3)=1.D0
  106.          XNOEUD(1,4)=0.D0
  107.          XNOEUD(2,4)=1.D0
  108. *        SEGDES NOEREG
  109.       ELSEIF (CQUAF.EQ.'TE15') THEN
  110.          NNLREG=4
  111.          NDIM  =3
  112.          SEGINI NOEREG
  113.          XNOEUD(1,1)=0.D0
  114.          XNOEUD(2,1)=0.D0
  115.          XNOEUD(3,1)=0.D0
  116.          XNOEUD(1,2)=1.D0
  117.          XNOEUD(2,2)=0.D0
  118.          XNOEUD(3,2)=0.D0
  119.          XNOEUD(1,3)=0.5D0
  120.          XNOEUD(2,3)=SQRT(3.D0)/2.D0
  121.          XNOEUD(3,3)=0.D0
  122.          XNOEUD(1,4)=0.5D0
  123.          XNOEUD(2,4)=SQRT(3.D0)/6.D0
  124.          XNOEUD(3,4)=SQRT(6.D0)/3.D0
  125. *        SEGDES NOEREG
  126.       ELSEIF (CQUAF.EQ.'PY19') THEN
  127.          NNLREG=5
  128.          NDIM  =3
  129.          SEGINI NOEREG
  130.          XNOEUD(1,1)=0.D0
  131.          XNOEUD(2,1)=0.D0
  132.          XNOEUD(3,1)=0.D0
  133.          XNOEUD(1,2)=1.D0
  134.          XNOEUD(2,2)=0.D0
  135.          XNOEUD(3,2)=0.D0
  136.          XNOEUD(1,3)=1.D0
  137.          XNOEUD(2,3)=1.D0
  138.          XNOEUD(3,3)=0.D0
  139.          XNOEUD(1,4)=0.D0
  140.          XNOEUD(2,4)=1.D0
  141.          XNOEUD(3,4)=0.D0
  142.          XNOEUD(1,5)=0.5D0
  143.          XNOEUD(2,5)=0.5D0
  144.          XNOEUD(3,5)=SQRT(2.D0)/2.D0
  145. *         XNOEUD(3,5)=1.D0
  146. *        SEGDES NOEREG
  147.       ELSEIF (CQUAF.EQ.'PR21') THEN
  148.          NNLREG=6
  149.          NDIM  =3
  150.          SEGINI NOEREG
  151.          XNOEUD(1,1)=0.D0
  152.          XNOEUD(2,1)=0.D0
  153.          XNOEUD(3,1)=0.D0
  154.          XNOEUD(1,2)=1.D0
  155.          XNOEUD(2,2)=0.D0
  156.          XNOEUD(3,2)=0.D0
  157.          XNOEUD(1,3)=0.5D0
  158.          XNOEUD(2,3)=SQRT(3.D0)/2.D0
  159.          XNOEUD(3,3)=0.D0
  160. *
  161.          XNOEUD(1,4)=0.D0
  162.          XNOEUD(2,4)=0.D0
  163.          XNOEUD(3,4)=1.D0
  164.          XNOEUD(1,5)=1.D0
  165.          XNOEUD(2,5)=0.D0
  166.          XNOEUD(3,5)=1.D0
  167.          XNOEUD(1,6)=0.5D0
  168.          XNOEUD(2,6)=SQRT(3.D0)/2.D0
  169.          XNOEUD(3,6)=1.D0
  170.  
  171. *        SEGDES NOEREG
  172.       ELSEIF (CQUAF.EQ.'CU27') THEN
  173.          NNLREG=8
  174.          NDIM  =3
  175.          SEGINI NOEREG
  176.          XNOEUD(1,1)=0.D0
  177.          XNOEUD(2,1)=0.D0
  178.          XNOEUD(3,1)=0.D0
  179.          XNOEUD(1,2)=1.D0
  180.          XNOEUD(2,2)=0.D0
  181.          XNOEUD(3,2)=0.D0
  182.          XNOEUD(1,3)=1.D0
  183.          XNOEUD(2,3)=1.D0
  184.          XNOEUD(3,3)=0.D0
  185.          XNOEUD(1,4)=0.D0
  186.          XNOEUD(2,4)=1.D0
  187.          XNOEUD(3,4)=0.D0
  188. *
  189.          XNOEUD(1,5)=0.D0
  190.          XNOEUD(2,5)=0.D0
  191.          XNOEUD(3,5)=1.D0
  192.          XNOEUD(1,6)=1.D0
  193.          XNOEUD(2,6)=0.D0
  194.          XNOEUD(3,6)=1.D0
  195.          XNOEUD(1,7)=1.D0
  196.          XNOEUD(2,7)=1.D0
  197.          XNOEUD(3,7)=1.D0
  198.          XNOEUD(1,8)=0.D0
  199.          XNOEUD(2,8)=1.D0
  200.          XNOEUD(3,8)=1.D0
  201. *        SEGDES NOEREG
  202.       ELSE
  203.          WRITE(IOIMP,*) CQUAF,' regulier non implemente'
  204.          GOTO 9999
  205.       ENDIF
  206. *
  207.       NBLIG=1
  208.       NBCOL=XNOEUD(/2)
  209.       N2LIG=1
  210.       N2COL=XNOEUD(/1)
  211.       NBPOI=1
  212.       NBELM=1
  213.       SEGINI JCOOR
  214.       DO I=1,N2COL
  215.          DO J=1,NBCOL
  216.             JCOOR.WELCHE(1,J,1,I,1,1)=XNOEUD(I,J)
  217.          ENDDO
  218.       ENDDO
  219. *
  220. * On suppose la transformation linéaire entre élément de
  221. * référence et élément régulier => 1 point de Gauss
  222. *
  223.       METGAU='GAU1'
  224.       CALL KEPG(ITQUAF,METGAU,
  225.      $     MYFPGS,
  226.      $     PGCOUR,
  227.      $     IMPR,IRET)
  228.       IF (IRET.NE.0) GOTO 9999
  229.       MYDISC='LINE'
  230.       CALL KEEF(ITQUAF,MYDISC,
  231.      $     MYFALS,
  232.      $     ELCOUR,
  233.      $     IMPR,IRET)
  234.       IF (IRET.NE.0) GOTO 9999
  235. * In KFNREF : SEGINI FFPG
  236. * In KFNREF : SEGINI DFFPG
  237.       CALL KFNREF(ELCOUR,PGCOUR,
  238.      $     FFPG,DFFPG,
  239.      $     IMPR,IRET)
  240.       IF (IRET.NE.0) GOTO 9999
  241. * Création des matrices jacobiennes et déterminants
  242. * On ne garde que la matrice jacobienne.
  243. * In GEOLIN : SEGINI JMAREG
  244. * In GEOLIN : SEGINI JMIREG
  245. * In GEOLIN : SEGINI JDTREG
  246.       NBELEM=1
  247. *
  248.       CALL GEOLIN(DFFPG,JCOOR,NBELEM,
  249.      $     JMAREG,JMIREG,JDTREG,
  250.      $     IMPR,IRET)
  251.       IF (IRET.NE.0) THEN
  252.          Write(ioimp,*) 'Jacobien des elements reguliers non inversible'
  253.          GOTO 9999
  254.       ENDIF
  255.       SEGSUP JDTREG
  256.       SEGSUP JMIREG
  257. *      SEGDES JMAREG
  258.       SEGSUP DFFPG
  259.       SEGSUP FFPG
  260.       SEGSUP JCOOR
  261.       SEGSUP NOEREG
  262. *      SEGPRT,JMAREG
  263. *
  264. * Normal termination
  265. *
  266.       IRET=0
  267.       RETURN
  268. *
  269. * Format handling
  270. *
  271. *
  272. * Error handling
  273. *
  274.  9999 CONTINUE
  275.       IRET=1
  276.       WRITE(IOIMP,*) 'An error was detected in subroutine georeg'
  277.       RETURN
  278. *
  279. * End of subroutine GEOREG
  280. *
  281.       END
  282.  
  283.  

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