1 : C KEPG SOURCE CHAT 07/10/29 21:21:43 5940 2 : SUBROUTINE KEPG(ITYPL,NMFAP, 3 : $ MYFPGS, 4 : $ MYPG, 5 : $ IMPR,IRET) 6 : IMPLICIT REAL*8 (A-H,O-Z) 7 : IMPLICIT INTEGER (I-N) 8 : C*********************************************************************** 9 : C NOM : KEPG 10 : C PROJET : Noyau linéaire NLIN 11 : C DESCRIPTION : On donne un numéro de type d'élément géométrique (un 12 : C QUAF, donc), un nom de famille de méthodes d'intégration 13 : C En sortie, on a le pointeur sur la méthode d'intégration 14 : C (type POGAU) 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 : FIFPG, FIENTI (recherche dans une liste) 21 : C APPELE PAR : VERFPG 22 : C*********************************************************************** 23 : C ENTREES : * ITYPL (type entier) : numéro d'élément 24 : C géométrique (cf. tableau NOMS dans l'include 25 : C CCOPTIO). 26 : C * NMFAP (type CH*(*)) : nom de famille de 27 : C méthodes d'intégration (cf. NOMFAP dans 28 : C l'include SFAPG). 29 : C * MYFPGS (type FALPGS) : segment de description 30 : C des familles de méthodes d'intégration. 31 : C SORTIES : * MYPG (type POGAU) : pointeur sur l'élément 32 : C fini correspondant à l'élément géométrique de 33 : C numéro ITYPL dans la famille de nom NMFAP 34 : C CODE RETOUR (IRET) : = 0 si tout s'est bien passé 35 : C*********************************************************************** 36 : C VERSION : v1, 18/07/02, version initiale 37 : C HISTORIQUE : v1, 18/07/02, création 38 : C HISTORIQUE : 39 : C HISTORIQUE : 40 : C*********************************************************************** 41 : C Prière de PRENDRE LE TEMPS de compléter les commentaires 42 : C en cas de modification de ce sous-programme afin de faciliter 43 : C la maintenance ! 44 : C*********************************************************************** 45 : -INC CCOPTIO 46 : -INC CCGEOME 47 : * 48 : * Includes perso 49 : * 50 : CBEGININCLUDE SFAPG 51 : SEGMENT FAPG 52 : CHARACTER*(LNNFAP) NOMFAP 53 : INTEGER NBQUAF(NBMPG) 54 : POINTEUR MPOGAU(NBMPG).POGAU 55 : ENDSEGMENT 56 : SEGMENT FAPGS 57 : POINTEUR LISFPG(0).FAPG 58 : ENDSEGMENT 59 : CENDINCLUDE SFAPG 60 : POINTEUR MYFPGS.FAPGS 61 : POINTEUR MYFAL.FAPG 62 : CBEGININCLUDE SPOGAU 63 : SEGMENT POGAU 64 : CHARACTER*(LNNPG) NOMPG 65 : CHARACTER*(LNTPG) TYPMPG 66 : CHARACTER*(LNFPG) FORLPG 67 : INTEGER NORDPG 68 : REAL*8 XCOPG(NDLPG,NBPG) 69 : REAL*8 XPOPG(NBPG) 70 : ENDSEGMENT 71 : SEGMENT POGAUS 72 : POINTEUR LISPG(0).POGAU 73 : ENDSEGMENT 74 : CENDINCLUDE SPOGAU 75 : POINTEUR MYPG.POGAU 76 : * 77 : INTEGER ITYPL 78 : CHARACTER*(*) NMFAP 79 : INTEGER IBLRF,NBLRF 80 : INTEGER IMPR,IRET 81 : * 82 : * Executable statements 83 : * 84 : IF (IMPR.GT.6) WRITE(IOIMP,*) 'Entrée dans kepg' 84 : CALL FIFAL(NMFAP,MYFPGS, 85 : $ MYFAL, 86 : $ IMPR,IRET) 87 : IF (IRET.NE.0) GOTO 9999 88 : SEGACT MYFAL 89 : NBLRF=MYFAL.NBQUAF(/1) 89 : CALL FIENTI(ITYPL,MYFAL.NBQUAF,NBLRF, 90 : $ IBLRF, 91 : $ IMPR,IRET) 92 : IF (IRET.NE.0) THEN 93 : WRITE(IOIMP,*) 'On n''a pas trouvé ',NOMS(ITYPL), 94 : $ ' dans la famille de méthode d''intégration ',MYFAL.NOMFAP 95 : GOTO 9999 96 : ENDIF 97 : MYPG=MYFAL.MPOGAU(IBLRF) 98 : SEGDES MYFAL 99 : * 100 : * Normal termination 101 : * 102 : IRET=0 103 : RETURN 104 : * 105 : * Format handling 106 : * 107 : * 108 : * Error handling 109 : * 110 : 9999 CONTINUE 111 : IRET=1 112 : WRITE(IOIMP,*) 'An error was detected in subroutine kepg' 113 : RETURN 114 : * 115 : * End of subroutine KEPG 116 : * 117 : END 118 : 119 : 120 :
© Cast3M 2003 - All rights reserved.
Disclaimer