C INGAPR SOURCE GOUNAND 05/12/21 21:31:54 5281 SUBROUTINE INGAPR(MYPGS,IMPR,IRET) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER (I-N) C*********************************************************************** C NOM : INGAPR C PROJET : Noyau linéaire NLIN C DESCRIPTION : Remplit le segment des méthodes d'intégration C avec des méthodes d'intégration numérique de cubature C type Gauss pour le prisme à base triangulaire C (ordre 1 à 5). C C REFERENCES : cf. INGATR et INGASE car on utilise essentiellement C des méthodes produit des deux précédentes. C C LANGAGE : ESOPE C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF) C mél : gounand@semt2.smts.cea.fr C*********************************************************************** C APPELES : INIPG, FIPG, PROPG C APPELE PAR : INPGS C*********************************************************************** C ENTREES : - C ENTREES/SORTIES : MYPGS (actif en *MOD) C SORTIES : - C CODE RETOUR (IRET) : = 0 si tout s'est bien passé C*********************************************************************** C VERSION : v1, 11/05/00, version initiale C HISTORIQUE : v1, 11/05/00, création C HISTORIQUE : C HISTORIQUE : C*********************************************************************** C Prière de PRENDRE LE TEMPS de compléter les commentaires C en cas de modification de ce sous-programme afin de faciliter C la maintenance ! C*********************************************************************** -INC CCOPTIO CBEGININCLUDE SPOGAU SEGMENT POGAU CHARACTER*(LNNPG) NOMPG CHARACTER*(LNTPG) TYPMPG CHARACTER*(LNFPG) FORLPG INTEGER NORDPG REAL*8 XCOPG(NDLPG,NBPG) REAL*8 XPOPG(NBPG) ENDSEGMENT SEGMENT POGAUS POINTEUR LISPG(0).POGAU ENDSEGMENT CENDINCLUDE SPOGAU POINTEUR MYPGS.POGAUS POINTEUR PGCOUR.POGAU POINTEUR PGPRO1.POGAU POINTEUR PGPRO2.POGAU * INTEGER IMPR,IRET * * * Executable statements * IF (IMPR.GT.6) WRITE(IOIMP,*) 'Entrée dans ingapr' * * Méthode de nom : NCPR-1-6 * Sur un prisme : cubature d'ordre 1 à 6 points * espace de référence de dimension 3 * * In INIPG : SEGINI PGCOUR CALL INIPG('NCPR-1-6','NEWTON-COTES','PRISME', $ 1,6,3, $ PGCOUR, $ IMPR,IRET) IF (IRET.NE.0) GOTO 9999 CALL FIPG('NCT2-1-3',MYPGS,PGPRO1,IMPR,IRET) IF (IRET.NE.0) GOTO 9999 CALL FIPG('NCC1-1-2',MYPGS,PGPRO2,IMPR,IRET) IF (IRET.NE.0) GOTO 9999 CALL PROPG(PGPRO1,PGPRO2,PGCOUR,IMPR,IRET) IF (IRET.NE.0) GOTO 9999 SEGDES PGCOUR MYPGS.LISPG(**)=PGCOUR * * Méthode de nom : NCPR-3-21 * Sur un prisme : cubature d'ordre 3 à 21 points * espace de référence de dimension 3 * * In INIPG : SEGINI PGCOUR CALL INIPG('NCPR-3-21','NEWTON-COTES','PRISME', $ 3,21,3, $ PGCOUR, $ IMPR,IRET) IF (IRET.NE.0) GOTO 9999 CALL FIPG('NCT2-3-7',MYPGS,PGPRO1,IMPR,IRET) IF (IRET.NE.0) GOTO 9999 CALL FIPG('NCC1-3-3',MYPGS,PGPRO2,IMPR,IRET) IF (IRET.NE.0) GOTO 9999 CALL PROPG(PGPRO1,PGPRO2,PGCOUR,IMPR,IRET) IF (IRET.NE.0) GOTO 9999 SEGDES PGCOUR MYPGS.LISPG(**)=PGCOUR * * Méthode de nom : GPPR-1-1 * Sur un prisme : méthode gauss-produit d'ordre 1 à 1 point * espace de référence de dimension 3 * * In INIPG : SEGINI PGCOUR CALL INIPG('GPPR-1-1','GAUSS-PRODUIT','PRISME', $ 1,1,3, $ PGCOUR, $ IMPR,IRET) IF (IRET.NE.0) GOTO 9999 CALL FIPG('GAT2-1-1',MYPGS,PGPRO1,IMPR,IRET) IF (IRET.NE.0) GOTO 9999 CALL FIPG('GAC1-1-1',MYPGS,PGPRO2,IMPR,IRET) IF (IRET.NE.0) GOTO 9999 CALL PROPG(PGPRO1,PGPRO2,PGCOUR,IMPR,IRET) IF (IRET.NE.0) GOTO 9999 SEGDES PGCOUR MYPGS.LISPG(**)=PGCOUR * * Méthode de nom : GPPR-2-6 * Sur un prisme : méthode gauss-produit d'ordre 2 à 6 points * espace de référence de dimension 3 * * In INIPG : SEGINI PGCOUR CALL INIPG('GPPR-2-6','GAUSS-PRODUIT','PRISME', $ 2,6,3, $ PGCOUR, $ IMPR,IRET) IF (IRET.NE.0) GOTO 9999 CALL FIPG('GAT2-2-3A',MYPGS,PGPRO1,IMPR,IRET) IF (IRET.NE.0) GOTO 9999 CALL FIPG('GAC1-3-2',MYPGS,PGPRO2,IMPR,IRET) IF (IRET.NE.0) GOTO 9999 CALL PROPG(PGPRO1,PGPRO2,PGCOUR,IMPR,IRET) IF (IRET.NE.0) GOTO 9999 SEGDES PGCOUR MYPGS.LISPG(**)=PGCOUR * * Méthode de nom : GPPR-3-8 * Sur un prisme : méthode gauss-produit d'ordre 3 à 8 points * espace de référence de dimension 3 * * In INIPG : SEGINI PGCOUR CALL INIPG('GPPR-3-8','GAUSS-PRODUIT','PRISME', $ 3,8,3, $ PGCOUR, $ IMPR,IRET) IF (IRET.NE.0) GOTO 9999 CALL FIPG('GPT2-3-4',MYPGS,PGPRO1,IMPR,IRET) IF (IRET.NE.0) GOTO 9999 CALL FIPG('GAC1-3-2',MYPGS,PGPRO2,IMPR,IRET) IF (IRET.NE.0) GOTO 9999 CALL PROPG(PGPRO1,PGPRO2,PGCOUR,IMPR,IRET) IF (IRET.NE.0) GOTO 9999 SEGDES PGCOUR MYPGS.LISPG(**)=PGCOUR * * Méthode de nom : GPPR-4-18 * Sur un prisme : méthode gauss-produit d'ordre 4 à 18 points * espace de référence de dimension 3 * * In INIPG : SEGINI PGCOUR CALL INIPG('GPPR-4-18','GAUSS-PRODUIT','PRISME', $ 4,18,3, $ PGCOUR, $ IMPR,IRET) IF (IRET.NE.0) GOTO 9999 CALL FIPG('GAT2-4-6A',MYPGS,PGPRO1,IMPR,IRET) IF (IRET.NE.0) GOTO 9999 CALL FIPG('GAC1-5-3',MYPGS,PGPRO2,IMPR,IRET) IF (IRET.NE.0) GOTO 9999 CALL PROPG(PGPRO1,PGPRO2,PGCOUR,IMPR,IRET) IF (IRET.NE.0) GOTO 9999 SEGDES PGCOUR MYPGS.LISPG(**)=PGCOUR * * Méthode de nom : GPPR-5-21 * Sur un prisme : méthode gauss-produit d'ordre 5 à 21 points * espace de référence de dimension 3 * * In INIPG : SEGINI PGCOUR CALL INIPG('GPPR-5-21','GAUSS-PRODUIT','PRISME', $ 5,21,3, $ PGCOUR, $ IMPR,IRET) IF (IRET.NE.0) GOTO 9999 CALL FIPG('GAT2-5-7',MYPGS,PGPRO1,IMPR,IRET) IF (IRET.NE.0) GOTO 9999 CALL FIPG('GAC1-5-3',MYPGS,PGPRO2,IMPR,IRET) IF (IRET.NE.0) GOTO 9999 CALL PROPG(PGPRO1,PGPRO2,PGCOUR,IMPR,IRET) IF (IRET.NE.0) GOTO 9999 SEGDES PGCOUR MYPGS.LISPG(**)=PGCOUR * * Méthode de nom : GPPR-7-48 * Sur un prisme : méthode gauss-produit d'ordre 7 à 48 points * espace de référence de dimension 3 * * In INIPG : SEGINI PGCOUR CALL INIPG('GPPR-7-48','GAUSS-PRODUIT','PRISME', $ 7,48,3, $ PGCOUR, $ IMPR,IRET) IF (IRET.NE.0) GOTO 9999 CALL FIPG('GAT2-7-12',MYPGS,PGPRO1,IMPR,IRET) IF (IRET.NE.0) GOTO 9999 CALL FIPG('GAC1-7-4',MYPGS,PGPRO2,IMPR,IRET) IF (IRET.NE.0) GOTO 9999 CALL PROPG(PGPRO1,PGPRO2,PGCOUR,IMPR,IRET) IF (IRET.NE.0) GOTO 9999 SEGDES PGCOUR MYPGS.LISPG(**)=PGCOUR * * Normal termination * IRET=0 RETURN * * Format handling * * * Error handling * 9999 CONTINUE IRET=1 WRITE(IOIMP,*) 'An error was detected in subroutine ingapr' RETURN * * End of subroutine INGAPR * END