Télécharger la plaquette Cast3M


fr en

Télécharger ingapr.eso

Retour à la liste

Numérotation des lignes : 

ingapr

  1. C INGAPR    SOURCE    GOUNAND   21/06/02    21:16:38     11022          
  2.       SUBROUTINE INGAPR(MYPGS,IMPR,IRET)
  3.       IMPLICIT REAL*8 (A-H,O-Z)
  4.       IMPLICIT INTEGER (I-N)
  5. C***********************************************************************
  6. C NOM         : INGAPR
  7. C PROJET      : Noyau linéaire NLIN
  8. C DESCRIPTION : Remplit le segment des méthodes d'intégration
  9. C               avec des méthodes d'intégration numérique de cubature
  10. C               type Gauss pour le prisme à base triangulaire
  11. C               (ordre 1 à 5).
  12. C
  13. C REFERENCES  : cf. INGATR et INGASE car on utilise essentiellement
  14. C               des méthodes produit des deux précédentes.
  15. C
  16. C LANGAGE     : ESOPE
  17. C AUTEUR      : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  18. C               mél : gounand@semt2.smts.cea.fr
  19. C***********************************************************************
  20. C APPELES          : INIPG, FIPG, PROPG
  21. C APPELE PAR       : INPGS
  22. C***********************************************************************
  23. C ENTREES            : -
  24. C ENTREES/SORTIES    : MYPGS (actif en *MOD)
  25. C SORTIES            : -
  26. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  27. C***********************************************************************
  28. C VERSION    : v1, 11/05/00, version initiale
  29. C HISTORIQUE : v1, 11/05/00, création
  30. C HISTORIQUE :
  31. C HISTORIQUE :
  32. C***********************************************************************
  33. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  34. C en cas de modification de ce sous-programme afin de faciliter
  35. C la maintenance !
  36. C***********************************************************************
  37.  
  38. -INC PPARAM
  39. -INC CCOPTIO
  40. -INC TNLIN      
  41. *-INC SPOGAU
  42.       POINTEUR MYPGS.POGAUS
  43.       POINTEUR PGCOUR.POGAU
  44.       POINTEUR PGPRO1.POGAU
  45.       POINTEUR PGPRO2.POGAU
  46. *
  47.       INTEGER IMPR,IRET
  48. *
  49. *
  50. * Executable statements
  51. *
  52.       IF (IMPR.GT.6) WRITE(IOIMP,*) 'Entrée dans ingapr'
  53. *
  54. * Méthode de nom : NCPR-1-6
  55. * Sur un prisme : cubature d'ordre 1 à 6 points
  56. *                 espace de référence de dimension 3
  57. *
  58. * In INIPG : SEGINI PGCOUR
  59.       CALL INIPG('NCPR-1-6','NEWTON-COTES','PRISME',
  60.      $     1,6,3,
  61.      $     PGCOUR,
  62.      $     IMPR,IRET)
  63.       IF (IRET.NE.0) GOTO 9999
  64.       CALL FIPG('NCT2-1-3',MYPGS,PGPRO1,IMPR,IRET)
  65.       IF (IRET.NE.0) GOTO 9999
  66.       CALL FIPG('NCC1-1-2',MYPGS,PGPRO2,IMPR,IRET)
  67.       IF (IRET.NE.0) GOTO 9999
  68.       CALL PROPG(PGPRO1,PGPRO2,PGCOUR,IMPR,IRET)
  69.       IF (IRET.NE.0) GOTO 9999
  70.       SEGDES PGCOUR
  71.       MYPGS.LISPG(**)=PGCOUR
  72. *
  73. * Méthode de nom : NCPR-3-21
  74. * Sur un prisme : cubature d'ordre 3 à 21 points
  75. *                 espace de référence de dimension 3
  76. *
  77. * In INIPG : SEGINI PGCOUR
  78.       CALL INIPG('NCPR-3-21','NEWTON-COTES','PRISME',
  79.      $     3,21,3,
  80.      $     PGCOUR,
  81.      $     IMPR,IRET)
  82.       IF (IRET.NE.0) GOTO 9999
  83.       CALL FIPG('NCT2-3-7',MYPGS,PGPRO1,IMPR,IRET)
  84.       IF (IRET.NE.0) GOTO 9999
  85.       CALL FIPG('NCC1-3-3',MYPGS,PGPRO2,IMPR,IRET)
  86.       IF (IRET.NE.0) GOTO 9999
  87.       CALL PROPG(PGPRO1,PGPRO2,PGCOUR,IMPR,IRET)
  88.       IF (IRET.NE.0) GOTO 9999
  89.       SEGDES PGCOUR
  90.       MYPGS.LISPG(**)=PGCOUR
  91. *
  92. * Méthode de nom : GPPR-1-1
  93. * Sur un prisme : méthode gauss-produit d'ordre 1 à 1 point
  94. *                 espace de référence de dimension 3
  95. *
  96. * In INIPG : SEGINI PGCOUR
  97.       CALL INIPG('GPPR-1-1','GAUSS-PRODUIT','PRISME',
  98.      $     1,1,3,
  99.      $     PGCOUR,
  100.      $     IMPR,IRET)
  101.       IF (IRET.NE.0) GOTO 9999
  102.       CALL FIPG('GAT2-1-1',MYPGS,PGPRO1,IMPR,IRET)
  103.       IF (IRET.NE.0) GOTO 9999
  104.       CALL FIPG('GAC1-1-1',MYPGS,PGPRO2,IMPR,IRET)
  105.       IF (IRET.NE.0) GOTO 9999
  106.       CALL PROPG(PGPRO1,PGPRO2,PGCOUR,IMPR,IRET)
  107.       IF (IRET.NE.0) GOTO 9999
  108.       SEGDES PGCOUR
  109.       MYPGS.LISPG(**)=PGCOUR
  110. *
  111. * Méthode de nom : GPPR-2-6
  112. * Sur un prisme : méthode gauss-produit d'ordre 2 à 6 points
  113. *                 espace de référence de dimension 3
  114. *
  115. * In INIPG : SEGINI PGCOUR
  116.       CALL INIPG('GPPR-2-6','GAUSS-PRODUIT','PRISME',
  117.      $     2,6,3,
  118.      $     PGCOUR,
  119.      $     IMPR,IRET)
  120.       IF (IRET.NE.0) GOTO 9999
  121.       CALL FIPG('GAT2-2-3A',MYPGS,PGPRO1,IMPR,IRET)
  122.       IF (IRET.NE.0) GOTO 9999
  123.       CALL FIPG('GAC1-3-2',MYPGS,PGPRO2,IMPR,IRET)
  124.       IF (IRET.NE.0) GOTO 9999
  125.       CALL PROPG(PGPRO1,PGPRO2,PGCOUR,IMPR,IRET)
  126.       IF (IRET.NE.0) GOTO 9999
  127.       SEGDES PGCOUR
  128.       MYPGS.LISPG(**)=PGCOUR
  129. *
  130. * Méthode de nom : GPPR-3-8
  131. * Sur un prisme : méthode gauss-produit d'ordre 3 à 8 points
  132. *                 espace de référence de dimension 3
  133. *
  134. * In INIPG : SEGINI PGCOUR
  135.       CALL INIPG('GPPR-3-8','GAUSS-PRODUIT','PRISME',
  136.      $     3,8,3,
  137.      $     PGCOUR,
  138.      $     IMPR,IRET)
  139.       IF (IRET.NE.0) GOTO 9999
  140.       CALL FIPG('GPT2-3-4',MYPGS,PGPRO1,IMPR,IRET)
  141.       IF (IRET.NE.0) GOTO 9999
  142.       CALL FIPG('GAC1-3-2',MYPGS,PGPRO2,IMPR,IRET)
  143.       IF (IRET.NE.0) GOTO 9999
  144.       CALL PROPG(PGPRO1,PGPRO2,PGCOUR,IMPR,IRET)
  145.       IF (IRET.NE.0) GOTO 9999
  146.       SEGDES PGCOUR
  147.       MYPGS.LISPG(**)=PGCOUR
  148. *
  149. * Méthode de nom : GPPR-4-18
  150. * Sur un prisme : méthode gauss-produit d'ordre 4 à 18 points
  151. *                 espace de référence de dimension 3
  152. *
  153. * In INIPG : SEGINI PGCOUR
  154.       CALL INIPG('GPPR-4-18','GAUSS-PRODUIT','PRISME',
  155.      $     4,18,3,
  156.      $     PGCOUR,
  157.      $     IMPR,IRET)
  158.       IF (IRET.NE.0) GOTO 9999
  159.       CALL FIPG('GAT2-4-6A',MYPGS,PGPRO1,IMPR,IRET)
  160.       IF (IRET.NE.0) GOTO 9999
  161.       CALL FIPG('GAC1-5-3',MYPGS,PGPRO2,IMPR,IRET)
  162.       IF (IRET.NE.0) GOTO 9999
  163.       CALL PROPG(PGPRO1,PGPRO2,PGCOUR,IMPR,IRET)
  164.       IF (IRET.NE.0) GOTO 9999
  165.       SEGDES PGCOUR
  166.       MYPGS.LISPG(**)=PGCOUR
  167. *
  168. * Méthode de nom : GPPR-5-21
  169. * Sur un prisme : méthode gauss-produit d'ordre 5 à 21 points
  170. *                 espace de référence de dimension 3
  171. *
  172. * In INIPG : SEGINI PGCOUR
  173.       CALL INIPG('GPPR-5-21','GAUSS-PRODUIT','PRISME',
  174.      $     5,21,3,
  175.      $     PGCOUR,
  176.      $     IMPR,IRET)
  177.       IF (IRET.NE.0) GOTO 9999
  178.       CALL FIPG('GAT2-5-7',MYPGS,PGPRO1,IMPR,IRET)
  179.       IF (IRET.NE.0) GOTO 9999
  180.       CALL FIPG('GAC1-5-3',MYPGS,PGPRO2,IMPR,IRET)
  181.       IF (IRET.NE.0) GOTO 9999
  182.       CALL PROPG(PGPRO1,PGPRO2,PGCOUR,IMPR,IRET)
  183.       IF (IRET.NE.0) GOTO 9999
  184.       SEGDES PGCOUR
  185.       MYPGS.LISPG(**)=PGCOUR
  186. *
  187. * Méthode de nom : GPPR-7-48
  188. * Sur un prisme : méthode gauss-produit d'ordre 7 à 48 points
  189. *                 espace de référence de dimension 3
  190. *
  191. * In INIPG : SEGINI PGCOUR
  192.       CALL INIPG('GPPR-7-48','GAUSS-PRODUIT','PRISME',
  193.      $     7,48,3,
  194.      $     PGCOUR,
  195.      $     IMPR,IRET)
  196.       IF (IRET.NE.0) GOTO 9999
  197.       CALL FIPG('GAT2-7-12',MYPGS,PGPRO1,IMPR,IRET)
  198.       IF (IRET.NE.0) GOTO 9999
  199.       CALL FIPG('GAC1-7-4',MYPGS,PGPRO2,IMPR,IRET)
  200.       IF (IRET.NE.0) GOTO 9999
  201.       CALL PROPG(PGPRO1,PGPRO2,PGCOUR,IMPR,IRET)
  202.       IF (IRET.NE.0) GOTO 9999
  203.       SEGDES PGCOUR
  204.       MYPGS.LISPG(**)=PGCOUR
  205. *
  206. * Normal termination
  207. *
  208.       IRET=0
  209.       RETURN
  210. *
  211. * Format handling
  212. *
  213. *
  214. * Error handling
  215. *
  216.  9999 CONTINUE
  217.       IRET=1
  218.       WRITE(IOIMP,*) 'An error was detected in subroutine ingapr'
  219.       RETURN
  220. *
  221. * End of subroutine INGAPR
  222. *
  223.       END
  224.  
  225.  
  226.  
  227.  
  228.  

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