Télécharger la plaquette Cast3M


fr en

Télécharger infpgs.eso

Retour à la liste

Numérotation des lignes : 

infpgs

  1. C INFPGS    SOURCE    GOUNAND   21/06/02    21:16:35     11022          
  2.       SUBROUTINE INFPGS(MYFPGS,MYPGS,IMPR,IRET)
  3.       IMPLICIT REAL*8 (A-H,O-Z)
  4.       IMPLICIT INTEGER (I-N)
  5. C***********************************************************************
  6. C NOM         : INFPGS
  7. C PROJET      : Noyau linéaire NLIN
  8. C DESCRIPTION : Initialise le segment contenant les informations sur
  9. C               l'ensemble des familles de méthodes d'intégration
  10. C
  11. C LANGAGE     : ESOPE
  12. C AUTEUR      : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  13. C               mél : gounand@semt2.smts.cea.fr
  14. C***********************************************************************
  15. C APPELES          : INIFPG, FILFPG, PRFPG (initialisations, impression)
  16. C APPELE PAR       : PRNLI2
  17. C***********************************************************************
  18. C ENTREES            : * MYPGS  (type POGAUS) : segment de description
  19. C                        des méthodes d'intégration.
  20. C ENTREES/SORTIES    : -
  21. C SORTIES            : * MYFPGS (type FAPGS) : segment de description
  22. C                        des familles de méthodes d'intégration.
  23. C TRAVAIL            : * FACOUR (type FAPG) : famille courante.
  24. C                      * NBDFA  (type ENTIER) : nombre total de familles
  25. C                        de méthodes d'intégration.
  26. C                      * INBDFA (type ENTIER) : indice de boucle sur les
  27. C                        familles de méthodes d'intégration.
  28. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  29. C***********************************************************************
  30. C VERSION    : v1, 16/07/02, version initiale
  31. C HISTORIQUE : v1, 16/07/02, création
  32. C HISTORIQUE :
  33. C HISTORIQUE :
  34. C***********************************************************************
  35. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  36. C en cas de modification de ce sous-programme afin de faciliter
  37. C la maintenance !
  38. C***********************************************************************
  39. -INC PPARAM
  40. -INC CCOPTIO
  41. -INC TNLIN      
  42. *-INC SPOGAU
  43.       POINTEUR MYPGS.POGAUS
  44. *-INC SFAPG
  45.       POINTEUR MYFPGS.FAPGS
  46.       POINTEUR FACOUR.FAPG
  47. *
  48.       INTEGER IMPR,IRET
  49. *
  50.       INTEGER NBDFA,INBDFA
  51.       LOGICAL LAXI
  52. *
  53. * Executable statements
  54. *
  55.       IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans infpgs'
  56.       SEGINI MYFPGS
  57.       LAXI=(IFOUR.EQ.0)
  58. *
  59. * Famille de nom : GAM1 Gauss pour la masse (éléments linéaires)
  60. *
  61. * In INIFPG : SEGINI FACOUR
  62.       CALL INIFPG('GAM1',
  63.      $     FACOUR,
  64.      $     IMPR,IRET)
  65.       IF (IRET.NE.0) GOTO 9999
  66.       CALL FILFPG(FACOUR,MYPGS,'SEG3','GAC1-3-2',IMPR,IRET)
  67.       IF (IRET.NE.0) GOTO 9999
  68.       IF (LAXI) THEN
  69.          CALL FILFPG(FACOUR,MYPGS,'TRI7','GAT2-5-7',IMPR,IRET)
  70.          IF (IRET.NE.0) GOTO 9999
  71.       ELSE
  72.          CALL FILFPG(FACOUR,MYPGS,'TRI7','GPT2-3-4',IMPR,IRET)
  73.          IF (IRET.NE.0) GOTO 9999
  74.       ENDIF
  75.       IF (LAXI) THEN
  76.          CALL FILFPG(FACOUR,MYPGS,'QUA9','GPC2-5-9',IMPR,IRET)
  77.          IF (IRET.NE.0) GOTO 9999
  78.       ELSE
  79.          CALL FILFPG(FACOUR,MYPGS,'QUA9','GPC2-3-4',IMPR,IRET)
  80.          IF (IRET.NE.0) GOTO 9999
  81.       ENDIF
  82.       CALL FILFPG(FACOUR,MYPGS,'TE15','GAT3-2-4B',IMPR,IRET)
  83.       IF (IRET.NE.0) GOTO 9999
  84.       CALL FILFPG(FACOUR,MYPGS,'PY19','GAPY-2-5',IMPR,IRET)
  85.       IF (IRET.NE.0) GOTO 9999
  86.       CALL FILFPG(FACOUR,MYPGS,'PR21','GPPR-2-6',IMPR,IRET)
  87.       IF (IRET.NE.0) GOTO 9999
  88.       CALL FILFPG(FACOUR,MYPGS,'CU27','GPC3-3-8',IMPR,IRET)
  89.       IF (IRET.NE.0) GOTO 9999
  90.       SEGDES FACOUR
  91.       MYFPGS.LISFPG(**)=FACOUR
  92. *
  93. * Famille de nom : GAM2 Gauss pour la masse (éléments quadratiques)
  94. *
  95. * In INIFPG : SEGINI FACOUR
  96.       CALL INIFPG('GAM2',
  97.      $     FACOUR,
  98.      $     IMPR,IRET)
  99.       IF (IRET.NE.0) GOTO 9999
  100.       IF (LAXI) THEN
  101.          CALL FILFPG(FACOUR,MYPGS,'SEG3','GAC1-7-4',IMPR,IRET)
  102.       ELSE
  103.          CALL FILFPG(FACOUR,MYPGS,'SEG3','GAC1-5-3',IMPR,IRET)
  104.       ENDIF
  105.       IF (IRET.NE.0) GOTO 9999
  106.       CALL FILFPG(FACOUR,MYPGS,'TRI7','GAT2-5-7',IMPR,IRET)
  107.       IF (IRET.NE.0) GOTO 9999
  108.       IF (LAXI) THEN
  109.          CALL FILFPG(FACOUR,MYPGS,'QUA9','GPC2-7-16',IMPR,IRET)
  110.          IF (IRET.NE.0) GOTO 9999
  111.       ELSE
  112.          CALL FILFPG(FACOUR,MYPGS,'QUA9','GPC2-5-9',IMPR,IRET)
  113.          IF (IRET.NE.0) GOTO 9999
  114.       ENDIF
  115.       CALL FILFPG(FACOUR,MYPGS,'TE15','GAT3-3-8B',IMPR,IRET)
  116.       IF (IRET.NE.0) GOTO 9999
  117.       CALL FILFPG(FACOUR,MYPGS,'PY19','GAPY-5-27',IMPR,IRET)
  118.       IF (IRET.NE.0) GOTO 9999
  119.       CALL FILFPG(FACOUR,MYPGS,'PR21','GPPR-5-21',IMPR,IRET)
  120.       IF (IRET.NE.0) GOTO 9999
  121.       CALL FILFPG(FACOUR,MYPGS,'CU27','GPC3-5-27',IMPR,IRET)
  122.       IF (IRET.NE.0) GOTO 9999
  123.       SEGDES FACOUR
  124.       MYFPGS.LISFPG(**)=FACOUR
  125. *
  126. * Famille de nom : GAR1 Gauss pour la rigidité (éléments linéaires)
  127. *
  128. * In INIFPG : SEGINI FACOUR
  129.       CALL INIFPG('GAR1',
  130.      $     FACOUR,
  131.      $     IMPR,IRET)
  132.       IF (IRET.NE.0) GOTO 9999
  133.       CALL FILFPG(FACOUR,MYPGS,'SEG3','GAC1-3-2',IMPR,IRET)
  134.       IF (IRET.NE.0) GOTO 9999
  135.       CALL FILFPG(FACOUR,MYPGS,'TRI7','GAT2-1-1',IMPR,IRET)
  136.       IF (IRET.NE.0) GOTO 9999
  137.       CALL FILFPG(FACOUR,MYPGS,'QUA9','GPC2-3-4',IMPR,IRET)
  138.       IF (IRET.NE.0) GOTO 9999
  139.       CALL FILFPG(FACOUR,MYPGS,'TE15','GAT3-1-1',IMPR,IRET)
  140.       IF (IRET.NE.0) GOTO 9999
  141.       CALL FILFPG(FACOUR,MYPGS,'PY19','GAPY-2-5',IMPR,IRET)
  142.       IF (IRET.NE.0) GOTO 9999
  143.       CALL FILFPG(FACOUR,MYPGS,'PR21','GPPR-2-6',IMPR,IRET)
  144.       IF (IRET.NE.0) GOTO 9999
  145.       CALL FILFPG(FACOUR,MYPGS,'CU27','GPC3-3-8',IMPR,IRET)
  146.       IF (IRET.NE.0) GOTO 9999
  147.       SEGDES FACOUR
  148.       MYFPGS.LISFPG(**)=FACOUR
  149. *
  150. * Famille de nom : GAR2 Gauss pour la rigidité (éléments quadratiques)
  151. *
  152. * In INIFPG : SEGINI FACOUR
  153.       CALL INIFPG('GAR2',
  154.      $     FACOUR,
  155.      $     IMPR,IRET)
  156.       IF (IRET.NE.0) GOTO 9999
  157.       IF (LAXI) THEN
  158.          CALL FILFPG(FACOUR,MYPGS,'SEG3','GAC1-7-4',IMPR,IRET)
  159.       ELSE
  160.          CALL FILFPG(FACOUR,MYPGS,'SEG3','GAC1-5-3',IMPR,IRET)
  161.       ENDIF
  162.       IF (IRET.NE.0) GOTO 9999
  163.       IF (LAXI) THEN
  164.          CALL FILFPG(FACOUR,MYPGS,'TRI7','GAT2-5-7',IMPR,IRET)
  165.          IF (IRET.NE.0) GOTO 9999
  166.       ELSE
  167.          CALL FILFPG(FACOUR,MYPGS,'TRI7','GPT2-3-4',IMPR,IRET)
  168.          IF (IRET.NE.0) GOTO 9999
  169.       ENDIF
  170.       CALL FILFPG(FACOUR,MYPGS,'QUA9','GPC2-5-9',IMPR,IRET)
  171.       IF (IRET.NE.0) GOTO 9999
  172.       CALL FILFPG(FACOUR,MYPGS,'TE15','GAT3-3-8B',IMPR,IRET)
  173.       IF (IRET.NE.0) GOTO 9999
  174.       CALL FILFPG(FACOUR,MYPGS,'PY19','GAPY-5-27',IMPR,IRET)
  175.       IF (IRET.NE.0) GOTO 9999
  176.       CALL FILFPG(FACOUR,MYPGS,'PR21','GPPR-5-21',IMPR,IRET)
  177.       IF (IRET.NE.0) GOTO 9999
  178.       CALL FILFPG(FACOUR,MYPGS,'CU27','GPC3-5-27',IMPR,IRET)
  179.       IF (IRET.NE.0) GOTO 9999
  180.       SEGDES FACOUR
  181.       MYFPGS.LISFPG(**)=FACOUR
  182. *
  183. * Famille de nom : NC1 Newton-Cotes
  184. * Méthodes d'intégration d'ordre au moins 1
  185. * 6 éléments : segment, triangle, carré, tétraèdre, prisme, cube
  186. *
  187. * In INIFPG : SEGINI FACOUR
  188.       CALL INIFPG('NC1 ',
  189.      $     FACOUR,
  190.      $     IMPR,IRET)
  191.       IF (IRET.NE.0) GOTO 9999
  192.       CALL FILFPG(FACOUR,MYPGS,'SEG3','NCC1-1-2',IMPR,IRET)
  193.       IF (IRET.NE.0) GOTO 9999
  194.       CALL FILFPG(FACOUR,MYPGS,'TRI7','NCT2-1-3',IMPR,IRET)
  195.       IF (IRET.NE.0) GOTO 9999
  196.       CALL FILFPG(FACOUR,MYPGS,'QUA9','NCC2-1-4',IMPR,IRET)
  197.       IF (IRET.NE.0) GOTO 9999
  198.       CALL FILFPG(FACOUR,MYPGS,'TE15','NCT3-1-4',IMPR,IRET)
  199.       IF (IRET.NE.0) GOTO 9999
  200.       CALL FILFPG(FACOUR,MYPGS,'PY19','NCPY-0-5',IMPR,IRET)
  201.       IF (IRET.NE.0) GOTO 9999
  202.       CALL FILFPG(FACOUR,MYPGS,'PR21','NCPR-1-6',IMPR,IRET)
  203.       IF (IRET.NE.0) GOTO 9999
  204.       CALL FILFPG(FACOUR,MYPGS,'CU27','NCC3-1-8',IMPR,IRET)
  205.       IF (IRET.NE.0) GOTO 9999
  206.       SEGDES FACOUR
  207.       MYFPGS.LISFPG(**)=FACOUR
  208. *
  209. * Famille de nom : NC3 Newton-Cotes
  210. * Méthodes d'intégration d'ordre au moins 3
  211. * 6 éléments : segment, triangle, carré, tétraèdre, prisme, cube
  212. * In INIFPG : SEGINI FACOUR
  213.       CALL INIFPG('NC3 ',
  214.      $     FACOUR,
  215.      $     IMPR,IRET)
  216.       IF (IRET.NE.0) GOTO 9999
  217.       CALL FILFPG(FACOUR,MYPGS,'SEG3','NCC1-3-3',IMPR,IRET)
  218.       IF (IRET.NE.0) GOTO 9999
  219.       CALL FILFPG(FACOUR,MYPGS,'TRI7','NCT2-3-7',IMPR,IRET)
  220.       IF (IRET.NE.0) GOTO 9999
  221.       CALL FILFPG(FACOUR,MYPGS,'QUA9','NCC2-3-9',IMPR,IRET)
  222.       IF (IRET.NE.0) GOTO 9999
  223. * Pas vraiment du Newton-Cotes, mais je ne sais pas quoi mettre
  224.       CALL FILFPG(FACOUR,MYPGS,'TE15','GAT3-3-8B',IMPR,IRET)
  225.       IF (IRET.NE.0) GOTO 9999
  226.       CALL FILFPG(FACOUR,MYPGS,'PR21','NCPR-3-21',IMPR,IRET)
  227.       IF (IRET.NE.0) GOTO 9999
  228.       CALL FILFPG(FACOUR,MYPGS,'CU27','NCC3-3-27',IMPR,IRET)
  229.       IF (IRET.NE.0) GOTO 9999
  230.       SEGDES FACOUR
  231.       MYFPGS.LISFPG(**)=FACOUR
  232. *
  233. * Famille de nom : GAU1
  234. * Méthodes d'intégration d'ordre au moins 1
  235. * 6 éléments : segment, triangle, carré, tétraèdre, prisme, cube
  236. *
  237. * In INIFPG : SEGINI FACOUR
  238.       CALL INIFPG('GAU1',
  239.      $     FACOUR,
  240.      $     IMPR,IRET)
  241.       IF (IRET.NE.0) GOTO 9999
  242.       CALL FILFPG(FACOUR,MYPGS,'SEG3','GAC1-1-1',IMPR,IRET)
  243.       IF (IRET.NE.0) GOTO 9999
  244.       CALL FILFPG(FACOUR,MYPGS,'TRI7','GAT2-1-1',IMPR,IRET)
  245.       IF (IRET.NE.0) GOTO 9999
  246.       CALL FILFPG(FACOUR,MYPGS,'QUA9','GAC2-1-1',IMPR,IRET)
  247.       IF (IRET.NE.0) GOTO 9999
  248.       CALL FILFPG(FACOUR,MYPGS,'TE15','GAT3-1-1',IMPR,IRET)
  249.       IF (IRET.NE.0) GOTO 9999
  250.       CALL FILFPG(FACOUR,MYPGS,'PY19','GAPY-1-1',IMPR,IRET)
  251.       IF (IRET.NE.0) GOTO 9999
  252.       CALL FILFPG(FACOUR,MYPGS,'PR21','GPPR-1-1',IMPR,IRET)
  253.       IF (IRET.NE.0) GOTO 9999
  254.       CALL FILFPG(FACOUR,MYPGS,'CU27','GAC3-1-1',IMPR,IRET)
  255.       IF (IRET.NE.0) GOTO 9999
  256.       SEGDES FACOUR
  257.       MYFPGS.LISFPG(**)=FACOUR
  258. *
  259. * Famille de nom : GAU2
  260. * Méthodes d'intégration d'ordre au moins 2
  261. * 6 éléments : segment, triangle, carré, tétraèdre, prisme, cube
  262. *
  263. * In INIFPG : SEGINI FACOUR
  264.       CALL INIFPG('GAU2',
  265.      $     FACOUR,
  266.      $     IMPR,IRET)
  267.       IF (IRET.NE.0) GOTO 9999
  268.       CALL FILFPG(FACOUR,MYPGS,'SEG3','GAC1-3-2',IMPR,IRET)
  269.       IF (IRET.NE.0) GOTO 9999
  270.       CALL FILFPG(FACOUR,MYPGS,'TRI7','GAT2-2-3A',IMPR,IRET)
  271.       IF (IRET.NE.0) GOTO 9999
  272.       CALL FILFPG(FACOUR,MYPGS,'QUA9','GAC2-2-3',IMPR,IRET)
  273.       IF (IRET.NE.0) GOTO 9999
  274.       CALL FILFPG(FACOUR,MYPGS,'TE15','GAT3-2-4B',IMPR,IRET)
  275.       IF (IRET.NE.0) GOTO 9999
  276.       CALL FILFPG(FACOUR,MYPGS,'PY19','GAPY-2-5',IMPR,IRET)
  277.       IF (IRET.NE.0) GOTO 9999
  278.       CALL FILFPG(FACOUR,MYPGS,'PR21','GPPR-2-6',IMPR,IRET)
  279.       IF (IRET.NE.0) GOTO 9999
  280.       CALL FILFPG(FACOUR,MYPGS,'CU27','GAC3-3-6A',IMPR,IRET)
  281.       IF (IRET.NE.0) GOTO 9999
  282.       SEGDES FACOUR
  283.       MYFPGS.LISFPG(**)=FACOUR
  284. *
  285. * Famille de nom : GAU3
  286. * Méthodes d'intégration d'ordre au moins 3
  287. * 6 éléments : segment, triangle, carré, tétraèdre, prisme, cube
  288. *
  289. * In INIFPG : SEGINI FACOUR
  290.       CALL INIFPG('GAU3',
  291.      $     FACOUR,
  292.      $     IMPR,IRET)
  293.       IF (IRET.NE.0) GOTO 9999
  294.       CALL FILFPG(FACOUR,MYPGS,'SEG3','GAC1-3-2',IMPR,IRET)
  295.       IF (IRET.NE.0) GOTO 9999
  296.       CALL FILFPG(FACOUR,MYPGS,'TRI7','GPT2-3-4',IMPR,IRET)
  297.       IF (IRET.NE.0) GOTO 9999
  298.       CALL FILFPG(FACOUR,MYPGS,'QUA9','GAC2-3-4A',IMPR,IRET)
  299.       IF (IRET.NE.0) GOTO 9999
  300.       CALL FILFPG(FACOUR,MYPGS,'TE15','GAT3-3-8B',IMPR,IRET)
  301.       IF (IRET.NE.0) GOTO 9999
  302.       CALL FILFPG(FACOUR,MYPGS,'PY19','GAPY-5-27',IMPR,IRET)
  303.       IF (IRET.NE.0) GOTO 9999
  304.       CALL FILFPG(FACOUR,MYPGS,'PR21','GPPR-3-8',IMPR,IRET)
  305.       IF (IRET.NE.0) GOTO 9999
  306.       CALL FILFPG(FACOUR,MYPGS,'CU27','GAC3-3-6A',IMPR,IRET)
  307.       IF (IRET.NE.0) GOTO 9999
  308.       SEGDES FACOUR
  309.       MYFPGS.LISFPG(**)=FACOUR
  310. *
  311. * Famille de nom : GAU4
  312. * Méthodes d'intégration d'ordre au moins 4
  313. * 6 éléments : segment, triangle, carré, tétraèdre, prisme, cube
  314. *
  315. * In INIFPG : SEGINI FACOUR
  316.       CALL INIFPG('GAU4',
  317.      $     FACOUR,
  318.      $     IMPR,IRET)
  319.       IF (IRET.NE.0) GOTO 9999
  320.       CALL FILFPG(FACOUR,MYPGS,'SEG3','GAC1-5-3',IMPR,IRET)
  321.       IF (IRET.NE.0) GOTO 9999
  322.       CALL FILFPG(FACOUR,MYPGS,'TRI7','GAT2-4-6A',IMPR,IRET)
  323.       IF (IRET.NE.0) GOTO 9999
  324.       CALL FILFPG(FACOUR,MYPGS,'QUA9','GAC2-4-6C',IMPR,IRET)
  325.       IF (IRET.NE.0) GOTO 9999
  326.       CALL FILFPG(FACOUR,MYPGS,'TE15','GAT3-5-14',IMPR,IRET)
  327.       IF (IRET.NE.0) GOTO 9999
  328.       CALL FILFPG(FACOUR,MYPGS,'PY19','GAPY-5-27',IMPR,IRET)
  329.       IF (IRET.NE.0) GOTO 9999
  330.       CALL FILFPG(FACOUR,MYPGS,'PR21','GPPR-4-18',IMPR,IRET)
  331.       IF (IRET.NE.0) GOTO 9999
  332.       CALL FILFPG(FACOUR,MYPGS,'CU27','GAC3-5-14',IMPR,IRET)
  333.       IF (IRET.NE.0) GOTO 9999
  334.       SEGDES FACOUR
  335.       MYFPGS.LISFPG(**)=FACOUR
  336. *
  337. * Famille de nom : GAU5
  338. * Méthodes d'intégration d'ordre au moins 5
  339. * 6 éléments : segment, triangle, carré, tétraèdre, prisme, cube
  340. *
  341. * In INIFPG : SEGINI FACOUR
  342.       CALL INIFPG('GAU5',
  343.      $     FACOUR,
  344.      $     IMPR,IRET)
  345.       IF (IRET.NE.0) GOTO 9999
  346.       CALL FILFPG(FACOUR,MYPGS,'SEG3','GAC1-5-3',IMPR,IRET)
  347.       IF (IRET.NE.0) GOTO 9999
  348.       CALL FILFPG(FACOUR,MYPGS,'TRI7','GAT2-5-7',IMPR,IRET)
  349.       IF (IRET.NE.0) GOTO 9999
  350.       CALL FILFPG(FACOUR,MYPGS,'QUA9','GAC2-5-7A',IMPR,IRET)
  351.       IF (IRET.NE.0) GOTO 9999
  352.       CALL FILFPG(FACOUR,MYPGS,'TE15','GAT3-5-14',IMPR,IRET)
  353.       IF (IRET.NE.0) GOTO 9999
  354.       CALL FILFPG(FACOUR,MYPGS,'PY19','GAPY-5-27',IMPR,IRET)
  355.       IF (IRET.NE.0) GOTO 9999
  356.       CALL FILFPG(FACOUR,MYPGS,'PR21','GPPR-5-21',IMPR,IRET)
  357.       IF (IRET.NE.0) GOTO 9999
  358.       CALL FILFPG(FACOUR,MYPGS,'CU27','GAC3-5-14',IMPR,IRET)
  359.       IF (IRET.NE.0) GOTO 9999
  360.       SEGDES FACOUR
  361.       MYFPGS.LISFPG(**)=FACOUR
  362. *
  363. * Famille de nom : GAU6
  364. * Méthodes d'intégration d'ordre au moins 6
  365. * 6 éléments : segment, triangle, carré, tétraèdre, prisme, cube
  366. *
  367. * In INIFPG : SEGINI FACOUR
  368.       CALL INIFPG('GAU6',
  369.      $     FACOUR,
  370.      $     IMPR,IRET)
  371.       IF (IRET.NE.0) GOTO 9999
  372.       CALL FILFPG(FACOUR,MYPGS,'SEG3','GAC1-7-4',IMPR,IRET)
  373.       IF (IRET.NE.0) GOTO 9999
  374.       CALL FILFPG(FACOUR,MYPGS,'TRI7','GAT2-7-12',IMPR,IRET)
  375.       IF (IRET.NE.0) GOTO 9999
  376.       CALL FILFPG(FACOUR,MYPGS,'QUA9','GAC2-6-10C',IMPR,IRET)
  377.       IF (IRET.NE.0) GOTO 9999
  378.       CALL FILFPG(FACOUR,MYPGS,'TE15','GAT3-6-24',IMPR,IRET)
  379.       IF (IRET.NE.0) GOTO 9999
  380.       CALL FILFPG(FACOUR,MYPGS,'PR21','GPPR-7-48',IMPR,IRET)
  381.       IF (IRET.NE.0) GOTO 9999
  382.       CALL FILFPG(FACOUR,MYPGS,'CU27','GPC3-7-64',IMPR,IRET)
  383.       IF (IRET.NE.0) GOTO 9999
  384.       SEGDES FACOUR
  385.       MYFPGS.LISFPG(**)=FACOUR
  386. *
  387. * Famille de nom : GAU7
  388. * Méthodes d'intégration d'ordre au moins 7
  389. * 6 éléments : segment, triangle, carré, tétraèdre, prisme, cube
  390. *
  391. * In INIFPG : SEGINI FACOUR
  392.       CALL INIFPG('GAU7',
  393.      $     FACOUR,
  394.      $     IMPR,IRET)
  395.       IF (IRET.NE.0) GOTO 9999
  396.       CALL FILFPG(FACOUR,MYPGS,'SEG3','GAC1-7-4',IMPR,IRET)
  397.       IF (IRET.NE.0) GOTO 9999
  398.       CALL FILFPG(FACOUR,MYPGS,'TRI7','GAT2-7-12',IMPR,IRET)
  399.       IF (IRET.NE.0) GOTO 9999
  400.       CALL FILFPG(FACOUR,MYPGS,'QUA9','GAC2-7-12A',IMPR,IRET)
  401.       IF (IRET.NE.0) GOTO 9999
  402.       CALL FILFPG(FACOUR,MYPGS,'TE15','GPT3-7-64',IMPR,IRET)
  403.       IF (IRET.NE.0) GOTO 9999
  404.       CALL FILFPG(FACOUR,MYPGS,'PR21','GPPR-7-48',IMPR,IRET)
  405.       IF (IRET.NE.0) GOTO 9999
  406.       CALL FILFPG(FACOUR,MYPGS,'CU27','GPC3-7-64',IMPR,IRET)
  407.       IF (IRET.NE.0) GOTO 9999
  408.       SEGDES FACOUR
  409.       MYFPGS.LISFPG(**)=FACOUR
  410. *
  411. * Famille de nom : GAP3
  412. * Méthodes d'intégration produit d'ordre au moins 3
  413. * 3 éléments : segment, triangle, carré
  414. *
  415. * In INIFPG : SEGINI FACOUR
  416.       CALL INIFPG('GAP3',
  417.      $     FACOUR,
  418.      $     IMPR,IRET)
  419.       IF (IRET.NE.0) GOTO 9999
  420.       CALL FILFPG(FACOUR,MYPGS,'SEG3','GAC1-3-2',IMPR,IRET)
  421.       IF (IRET.NE.0) GOTO 9999
  422.       CALL FILFPG(FACOUR,MYPGS,'TRI7','GPT2-3-4',IMPR,IRET)
  423.       IF (IRET.NE.0) GOTO 9999
  424.       CALL FILFPG(FACOUR,MYPGS,'QUA9','GPC2-3-4',IMPR,IRET)
  425.       IF (IRET.NE.0) GOTO 9999
  426.       CALL FILFPG(FACOUR,MYPGS,'TE15','GAT3-3-8B',IMPR,IRET)
  427.       IF (IRET.NE.0) GOTO 9999
  428.       CALL FILFPG(FACOUR,MYPGS,'PY19','GAPY-5-27',IMPR,IRET)
  429.       IF (IRET.NE.0) GOTO 9999
  430.       CALL FILFPG(FACOUR,MYPGS,'PR21','GPPR-3-8',IMPR,IRET)
  431.       IF (IRET.NE.0) GOTO 9999
  432.       CALL FILFPG(FACOUR,MYPGS,'CU27','GPC3-3-8',IMPR,IRET)
  433.       IF (IRET.NE.0) GOTO 9999
  434.       SEGDES FACOUR
  435.       MYFPGS.LISFPG(**)=FACOUR
  436. *
  437. * Famille de nom : GAP5
  438. * Méthodes d'intégration produit d'ordre au moins 5
  439. * 3 éléments : segment, triangle, carré
  440. *
  441. * In INIFPG : SEGINI FACOUR
  442.       CALL INIFPG('GAP5',
  443.      $     FACOUR,
  444.      $     IMPR,IRET)
  445.       IF (IRET.NE.0) GOTO 9999
  446.       CALL FILFPG(FACOUR,MYPGS,'SEG3','GAC1-5-3',IMPR,IRET)
  447.       IF (IRET.NE.0) GOTO 9999
  448.       CALL FILFPG(FACOUR,MYPGS,'TRI7','GPT2-5-9',IMPR,IRET)
  449.       IF (IRET.NE.0) GOTO 9999
  450.       CALL FILFPG(FACOUR,MYPGS,'QUA9','GPC2-5-9',IMPR,IRET)
  451.       IF (IRET.NE.0) GOTO 9999
  452.       CALL FILFPG(FACOUR,MYPGS,'TE15','GPT3-5-27',IMPR,IRET)
  453.       IF (IRET.NE.0) GOTO 9999
  454.       CALL FILFPG(FACOUR,MYPGS,'PY19','GAPY-5-27',IMPR,IRET)
  455.       IF (IRET.NE.0) GOTO 9999
  456.       CALL FILFPG(FACOUR,MYPGS,'PR21','GPPR-5-21',IMPR,IRET)
  457.       IF (IRET.NE.0) GOTO 9999
  458.       CALL FILFPG(FACOUR,MYPGS,'CU27','GPC3-5-27',IMPR,IRET)
  459.       IF (IRET.NE.0) GOTO 9999
  460.       SEGDES FACOUR
  461.       MYFPGS.LISFPG(**)=FACOUR
  462. *
  463. * Famille de nom : GAP7
  464. * Méthodes d'intégration produit d'ordre au moins 7
  465. * 4 éléments : segment, triangle, carré, tétraèdre
  466. *
  467. * In INIFPG : SEGINI FACOUR
  468.       CALL INIFPG('GAP7',
  469.      $     FACOUR,
  470.      $     IMPR,IRET)
  471.       IF (IRET.NE.0) GOTO 9999
  472.       CALL FILFPG(FACOUR,MYPGS,'SEG3','GAC1-7-4',IMPR,IRET)
  473.       IF (IRET.NE.0) GOTO 9999
  474.       CALL FILFPG(FACOUR,MYPGS,'TRI7','GPT2-7-16',IMPR,IRET)
  475.       IF (IRET.NE.0) GOTO 9999
  476.       CALL FILFPG(FACOUR,MYPGS,'QUA9','GPC2-7-16',IMPR,IRET)
  477.       IF (IRET.NE.0) GOTO 9999
  478.       CALL FILFPG(FACOUR,MYPGS,'TE15','GPT3-7-64',IMPR,IRET)
  479.       IF (IRET.NE.0) GOTO 9999
  480.       CALL FILFPG(FACOUR,MYPGS,'PR21','GPPR-7-48',IMPR,IRET)
  481.       IF (IRET.NE.0) GOTO 9999
  482.       CALL FILFPG(FACOUR,MYPGS,'CU27','GPC3-7-64',IMPR,IRET)
  483.       IF (IRET.NE.0) GOTO 9999
  484.       SEGDES FACOUR
  485.       MYFPGS.LISFPG(**)=FACOUR
  486. *
  487. * Impression finale
  488. *
  489.       NBDFA=MYFPGS.LISFPG(/1)
  490.       IF (IMPR.GT.1) THEN
  491. *!      WRITE(IOIMP,*) 'Nom, QUAF, Meth. integ'
  492.          DO 3 INBDFA=1,NBDFA
  493.             WRITE(IOIMP,*) 'Famille de méthodes d''intégration ',INBDFA
  494.             FACOUR=MYFPGS.LISFPG(INBDFA)
  495.             CALL PRFPG(FACOUR,IMPR,IRET)
  496.             IF (IRET.NE.0) GOTO 9999
  497.  3       CONTINUE
  498.       ENDIF
  499.       SEGDES MYFPGS
  500. *
  501. * Normal termination
  502. *
  503.       IRET=0
  504.       RETURN
  505. *
  506. * Format handling
  507. *
  508. *
  509. * Error handling
  510. *
  511.  9999 CONTINUE
  512.       IRET=1
  513.       WRITE(IOIMP,*) 'An error was detected in subroutine infpgs'
  514.       RETURN
  515. *
  516. * End of subroutine INFPGS
  517. *
  518.       END
  519.  
  520.  
  521.  
  522.  
  523.  

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