gtro3i
C GTRO3I SOURCE GOUNAND 21/06/02 21:16:21 11022 $ IMPR,IRET) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER (I-N) C*********************************************************************** C NOM : GTRO3I C PROJET : Noyau linéaire NLIN C DESCRIPTION : Rajoute un point (x1, x2, ..., xn) et ses n-1 images C par permutation cyclique (x2, ... , xn, x1), etc. C dans une méthode d'intégration type Gauss (PGCOUR). C Domaine de type [ Simplex ] C i.e. triangle et tétrahèdre pour nous C Générateur de type [ Ro3 invariant ]. C C XCOR=xi sont les coordonnées barycentriques... 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 : - C APPELE PAR : INGATR, INGATE C*********************************************************************** C ENTREES : DIMSRF, XCOR, POIDS C ENTREES/SORTIES : PGCOUR (actif en *MOD), NOPG C SORTIES : - C CODE RETOUR (IRET) : = 0 si tout s'est bien passé C*********************************************************************** C VERSION : v1, 21/10/99, version initiale C HISTORIQUE : v1, 21/10/99, 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 PPARAM -INC CCOPTIO -INC TNLIN *-INC SPOGAU POINTEUR PGCOUR.POGAU * INTEGER NOPG,DIMSRF REAL*8 XCOR(DIMSRF+1) REAL*8 POIDS INTEGER IMPR,IRET * INTEGER ICOOR ,ITOT INTEGER NOCOOR,NTOT * * Executable statements * IF (IMPR.GT.6) WRITE(IOIMP,*) 'Entrée dans gtro3i' * * On ajoute le point NTOT=DIMSRF+1 DO 1 ITOT=1,NTOT NOPG=NOPG+1 DO 12 ICOOR=1,DIMSRF NOCOOR=MOD((ICOOR+ITOT-1),NTOT)+1 PGCOUR.XCOPG(ICOOR,NOPG)=XCOR(NOCOOR) 12 CONTINUE PGCOUR.XPOPG(NOPG)=POIDS 1 CONTINUE * * Normal termination * IRET=0 RETURN * * Format handling * * * Error handling * 9999 CONTINUE IRET=1 WRITE(IOIMP,*) 'An error was detected in subroutine gtro3i' RETURN * * End of subroutine GTRO3I * END
© Cast3M 2003 - Tous droits réservés.
Mentions légales