1 : C FILFPG SOURCE CHAT 07/10/29 21:19:46 5940 2 : SUBROUTINE FILFPG(FAL,MYPGS,CQUAF,CPG,IMPR,IRET) 3 : IMPLICIT REAL*8 (A-H,O-Z) 4 : IMPLICIT INTEGER (I-N) 5 : C*********************************************************************** 6 : C NOM : FILFPG 7 : C PROJET : Noyau linéaire NLIN 8 : C DESCRIPTION : Remplit l'indice d'un segment décrivant une famille 9 : C 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 : FICH4, FIPG (recherche dans une liste) 16 : C APPELE PAR : INFPGS 17 : C*********************************************************************** 18 : C ENTREES : * MYPGS (type POGAUS) : segment de description 19 : C des éléments de références. 20 : C * CQUAF (type CH*(*)) :nom d'un élément QUAF. 21 : C * CPG (type CH*(*)) :nom d'une méthode 22 : C d'intégration 23 : C (cf. NOMPG dans SPOGAU.INC) 24 : C ENTREES/SORTIES : * FAL (type FALRF) : famille courante. 25 : C SORTIES : - 26 : C TRAVAIL : * MYPG (type ELREF) : élément fini courant. 27 : C * NUMER (type ENTIER) : numéro correspondant à 28 : C CQUAF dans le tableau NOMS (cf. include 29 : C CCOPTIO) 30 : C CODE RETOUR (IRET) : = 0 si tout s'est bien passé 31 : C*********************************************************************** 32 : C VERSION : v1, 16/07/02, version initiale 33 : C HISTORIQUE : v1, 16/07/02, 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 : -INC CCOPTIO 42 : -INC CCGEOME 43 : CBEGININCLUDE SPOGAU 44 : SEGMENT POGAU 45 : CHARACTER*(LNNPG) NOMPG 46 : CHARACTER*(LNTPG) TYPMPG 47 : CHARACTER*(LNFPG) FORLPG 48 : INTEGER NORDPG 49 : REAL*8 XCOPG(NDLPG,NBPG) 50 : REAL*8 XPOPG(NBPG) 51 : ENDSEGMENT 52 : SEGMENT POGAUS 53 : POINTEUR LISPG(0).POGAU 54 : ENDSEGMENT 55 : CENDINCLUDE SPOGAU 56 : POINTEUR MYPGS.POGAUS 57 : POINTEUR MYPG.POGAU 58 : CBEGININCLUDE SFAPG 59 : SEGMENT FAPG 60 : CHARACTER*(LNNFAP) NOMFAP 61 : INTEGER NBQUAF(NBMPG) 62 : POINTEUR MPOGAU(NBMPG).POGAU 63 : ENDSEGMENT 64 : SEGMENT FAPGS 65 : POINTEUR LISFPG(0).FAPG 66 : ENDSEGMENT 67 : CENDINCLUDE SFAPG 68 : INTEGER LNNFAP,NBMPG 69 : POINTEUR FAL.FAPG 70 : * 71 : CHARACTER*(*) CQUAF,CPG 72 : * 73 : INTEGER IMPR,IRET 74 : * 75 : INTEGER NUMER 76 : * 77 : * Executable statements 78 : * 79 : IF (IMPR.GT.6) WRITE(IOIMP,*) 'Entrée dans filfpg' 80 : * On ajuste la dimension du segment pour rajouter une paire 81 : * d'éléments 82 : LNNFAP=FAL.NOMFAP(/1) 83 : NBMPG=FAL.NBQUAF(/1)+1 84 : SEGADJ,FAL 85 : * Numéro de l'élément géométrique dans NOMS 86 : * NOMS(1:NOMBR) sont les noms des types d'éléments géométriques, 87 : * cf. include CCGEOME 87 : CALL FICH4(CQUAF,NOMS,NOMBR, 88 : $ NUMER, 89 : $ IMPR,IRET) 90 : IF (IRET.NE.0) GOTO 9999 91 : FAL.NBQUAF(NBMPG)=NUMER 92 : * Numéro de l'élément fini dans le segment POGAUS 92 : CALL FIPG(CPG,MYPGS, 93 : $ MYPG, 94 : $ IMPR,IRET) 95 : IF (IRET.NE.0) GOTO 9999 96 : FAL.MPOGAU(NBMPG)=MYPG 97 : * 98 : * Normal termination 99 : * 100 : IRET=0 101 : RETURN 102 : * 103 : * Format handling 104 : * 105 : * 106 : * Error handling 107 : * 108 : 9999 CONTINUE 109 : IRET=1 110 : WRITE(IOIMP,*) 'An error was detected in subroutine filfpg' 111 : RETURN 112 : * 113 : * End of subroutine filfpg 114 : * 115 : END 116 : 117 : 118 :
© Cast3M 2003 - All rights reserved.
Disclaimer