gcresy
C GCRESY SOURCE GOUNAND 21/06/02 21:16:04 11022 $ IMPR,IRET) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER (I-N) C*********************************************************************** C NOM : GCRESY C PROJET : Noyau linéaire NLIN C DESCRIPTION : Si on a un point (x1,x2,..,xn), on ajoute les points C (+-x1,+-x2,...+-xn) dans une méthode d'intégration type C Gauss (PGCOUR). C Il y en a 2^n et ils sont distincts si aucun des xi C n'est nul. C Domaine de type [ Fully symmetric region ] C i.e. segment, carré et cube pour nous. C Générateur de type [ Rectangular symmetry ]. 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 : INGAQU, INGACU C*********************************************************************** C ENTREES : DIMSRF, XCOR, POIDS C ENTREES/SORTIES : PGCOUR (actif en *MOD), NOPG C SORTIES : MYPGS C CODE RETOUR (IRET) : = 0 si tout s'est bien passé C*********************************************************************** C VERSION : v1, 20/10/99, version initiale C HISTORIQUE : v1, 20/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) REAL*8 POIDS INTEGER IMPR,IRET * INTEGER ICOOR,ITOT INTEGER ICOEFI,NTOT * * Executable statements * IF (IMPR.GT.6) WRITE(IOIMP,*) 'Entrée dans gcresy' NTOT=2**DIMSRF DO 1 ITOT=1,NTOT NOPG=NOPG+1 DO 3 ICOOR=1,DIMSRF * Formule magique ! ICOEFI=(-1)**((ITOT-1)/(2**(ICOOR-1))) PGCOUR.XCOPG(ICOOR,NOPG)=DBLE(ICOEFI)*XCOR(ICOOR) 3 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 gcresy' RETURN * * End of subroutine GCRESY * END
© Cast3M 2003 - Tous droits réservés.
Mentions légales