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   21/06/02    21:16:15     11022          
  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.       LOGICAL LBID
  69.       INTEGER IMPR,IRET
  70.  
  71. *
  72. * Executable statements
  73. *
  74.       IF (IMPR.GT.2) WRITE(IOIMP,*) 'Entrée dans georeg.eso'
  75.       CQUAF=NOMS(ITQUAF)
  76. *
  77. * Here : SEGINI NOEREG
  78. *
  79.       IF (CQUAF.EQ.'SEG3') THEN
  80.          NNLREG=2
  81.          NDIM  =1
  82.          SEGINI NOEREG
  83.          XNOEUD(1,1)=0.D0
  84.          XNOEUD(1,2)=1.D0
  85. *        SEGDES NOEREG
  86.       ELSEIF (CQUAF.EQ.'TRI7') THEN
  87.          NNLREG=3
  88.          NDIM  =2
  89.          SEGINI NOEREG
  90.          XNOEUD(1,1)=0.D0
  91.          XNOEUD(2,1)=0.D0
  92.          XNOEUD(1,2)=1.D0
  93.          XNOEUD(2,2)=0.D0
  94.          XNOEUD(1,3)=0.5D0
  95.          XNOEUD(2,3)=SQRT(3.D0)/2.D0
  96. *        SEGDES NOEREG
  97.       ELSEIF (CQUAF.EQ.'QUA9') THEN
  98.          NNLREG=4
  99.          NDIM  =2
  100.          SEGINI NOEREG
  101.          XNOEUD(1,1)=0.D0
  102.          XNOEUD(2,1)=0.D0
  103.          XNOEUD(1,2)=1.D0
  104.          XNOEUD(2,2)=0.D0
  105.          XNOEUD(1,3)=1.D0
  106.          XNOEUD(2,3)=1.D0
  107.          XNOEUD(1,4)=0.D0
  108.          XNOEUD(2,4)=1.D0
  109. *        SEGDES NOEREG
  110.       ELSEIF (CQUAF.EQ.'TE15') THEN
  111.          NNLREG=4
  112.          NDIM  =3
  113.          SEGINI NOEREG
  114.          XNOEUD(1,1)=0.D0
  115.          XNOEUD(2,1)=0.D0
  116.          XNOEUD(3,1)=0.D0
  117.          XNOEUD(1,2)=1.D0
  118.          XNOEUD(2,2)=0.D0
  119.          XNOEUD(3,2)=0.D0
  120.          XNOEUD(1,3)=0.5D0
  121.          XNOEUD(2,3)=SQRT(3.D0)/2.D0
  122.          XNOEUD(3,3)=0.D0
  123.          XNOEUD(1,4)=0.5D0
  124.          XNOEUD(2,4)=SQRT(3.D0)/6.D0
  125.          XNOEUD(3,4)=SQRT(6.D0)/3.D0
  126. *        SEGDES NOEREG
  127.       ELSEIF (CQUAF.EQ.'PY19') THEN
  128.          NNLREG=5
  129.          NDIM  =3
  130.          SEGINI NOEREG
  131.          XNOEUD(1,1)=0.D0
  132.          XNOEUD(2,1)=0.D0
  133.          XNOEUD(3,1)=0.D0
  134.          XNOEUD(1,2)=1.D0
  135.          XNOEUD(2,2)=0.D0
  136.          XNOEUD(3,2)=0.D0
  137.          XNOEUD(1,3)=1.D0
  138.          XNOEUD(2,3)=1.D0
  139.          XNOEUD(3,3)=0.D0
  140.          XNOEUD(1,4)=0.D0
  141.          XNOEUD(2,4)=1.D0
  142.          XNOEUD(3,4)=0.D0
  143.          XNOEUD(1,5)=0.5D0
  144.          XNOEUD(2,5)=0.5D0
  145.          XNOEUD(3,5)=SQRT(2.D0)/2.D0
  146. *         XNOEUD(3,5)=1.D0
  147. *        SEGDES NOEREG
  148.       ELSEIF (CQUAF.EQ.'PR21') THEN
  149.          NNLREG=6
  150.          NDIM  =3
  151.          SEGINI NOEREG
  152.          XNOEUD(1,1)=0.D0
  153.          XNOEUD(2,1)=0.D0
  154.          XNOEUD(3,1)=0.D0
  155.          XNOEUD(1,2)=1.D0
  156.          XNOEUD(2,2)=0.D0
  157.          XNOEUD(3,2)=0.D0
  158.          XNOEUD(1,3)=0.5D0
  159.          XNOEUD(2,3)=SQRT(3.D0)/2.D0
  160.          XNOEUD(3,3)=0.D0
  161. *
  162.          XNOEUD(1,4)=0.D0
  163.          XNOEUD(2,4)=0.D0
  164.          XNOEUD(3,4)=1.D0
  165.          XNOEUD(1,5)=1.D0
  166.          XNOEUD(2,5)=0.D0
  167.          XNOEUD(3,5)=1.D0
  168.          XNOEUD(1,6)=0.5D0
  169.          XNOEUD(2,6)=SQRT(3.D0)/2.D0
  170.          XNOEUD(3,6)=1.D0
  171.  
  172. *        SEGDES NOEREG
  173.       ELSEIF (CQUAF.EQ.'CU27') THEN
  174.          NNLREG=8
  175.          NDIM  =3
  176.          SEGINI NOEREG
  177.          XNOEUD(1,1)=0.D0
  178.          XNOEUD(2,1)=0.D0
  179.          XNOEUD(3,1)=0.D0
  180.          XNOEUD(1,2)=1.D0
  181.          XNOEUD(2,2)=0.D0
  182.          XNOEUD(3,2)=0.D0
  183.          XNOEUD(1,3)=1.D0
  184.          XNOEUD(2,3)=1.D0
  185.          XNOEUD(3,3)=0.D0
  186.          XNOEUD(1,4)=0.D0
  187.          XNOEUD(2,4)=1.D0
  188.          XNOEUD(3,4)=0.D0
  189. *
  190.          XNOEUD(1,5)=0.D0
  191.          XNOEUD(2,5)=0.D0
  192.          XNOEUD(3,5)=1.D0
  193.          XNOEUD(1,6)=1.D0
  194.          XNOEUD(2,6)=0.D0
  195.          XNOEUD(3,6)=1.D0
  196.          XNOEUD(1,7)=1.D0
  197.          XNOEUD(2,7)=1.D0
  198.          XNOEUD(3,7)=1.D0
  199.          XNOEUD(1,8)=0.D0
  200.          XNOEUD(2,8)=1.D0
  201.          XNOEUD(3,8)=1.D0
  202. *        SEGDES NOEREG
  203.       ELSE
  204.          WRITE(IOIMP,*) CQUAF,' regulier non implemente'
  205.          GOTO 9999
  206.       ENDIF
  207. *
  208.       NBLIG=1
  209.       NBCOL=XNOEUD(/2)
  210.       N2LIG=1
  211.       N2COL=XNOEUD(/1)
  212.       NBPOI=1
  213.       NBELM=1
  214.       SEGINI JCOOR
  215.       DO I=1,N2COL
  216.          DO J=1,NBCOL
  217.             JCOOR.WELCHE(1,J,1,I,1,1)=XNOEUD(I,J)
  218.          ENDDO
  219.       ENDDO
  220. *
  221. * On suppose la transformation linéaire entre élément de
  222. * référence et élément régulier => 1 point de Gauss
  223. *
  224.       METGAU='GAU1'
  225.       CALL KEPG(ITQUAF,METGAU,
  226.      $     MYFPGS,
  227.      $     PGCOUR,
  228.      $     IMPR,IRET)
  229.       IF (IRET.NE.0) GOTO 9999
  230.       MYDISC='LINE'
  231.       CALL KEEF(ITQUAF,MYDISC,
  232.      $     MYFALS,
  233.      $     ELCOUR,
  234.      $     IMPR,IRET)
  235.       IF (IRET.NE.0) GOTO 9999
  236. * In KFNREF : SEGINI FFPG
  237. * In KFNREF : SEGINI DFFPG
  238.       CALL KFNREF(ELCOUR,PGCOUR,
  239.      $     FFPG,DFFPG,
  240.      $     IMPR,IRET)
  241.       IF (IRET.NE.0) GOTO 9999
  242. * Création des matrices jacobiennes et déterminants
  243. * On ne garde que la matrice jacobienne.
  244. * In GEOLIN : SEGINI JMAREG
  245. * In GEOLIN : SEGINI JMIREG
  246. * In GEOLIN : SEGINI JDTREG
  247.       NBELEM=1
  248.       LBID=.FALSE.
  249. *
  250.       CALL GEOLIN(DFFPG,JCOOR,NBELEM,
  251.      $     JMAREG,JMIREG,JDTREG,LBID,
  252.      $     IMPR,IRET)
  253.       IF (IRET.NE.0) THEN
  254.          IF (LBID) GOTO 9666
  255.          GOTO 9999
  256.       ENDIF
  257.       SEGSUP JDTREG
  258.       SEGSUP JMIREG
  259.       SEGDES JMAREG
  260.       SEGSUP DFFPG
  261.       SEGSUP FFPG
  262.       SEGSUP JCOOR
  263.       SEGSUP NOEREG
  264. *      SEGPRT,JMAREG
  265. *
  266. * Normal termination
  267. *
  268.       IRET=0
  269.       RETURN
  270. *
  271. * Format handling
  272. *
  273. *
  274. * Error handling
  275. *
  276.  9666 CONTINUE
  277.       IRET=666
  278.       RETURN
  279.  9999 CONTINUE
  280.       IRET=1
  281.       WRITE(IOIMP,*) 'An error was detected in subroutine georeg'
  282.       RETURN
  283. *
  284. * End of subroutine GEOREG
  285. *
  286.       END
  287.  
  288.  
  289.  
  290.  
  291.  
  292.  
  293.  

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