Télécharger la plaquette Cast3M


fr en

Télécharger propg.eso

Retour à la liste

Numérotation des lignes : 

propg

  1. C PROPG     SOURCE    GOUNAND   21/06/02    21:17:33     11022          
  2.       SUBROUTINE PROPG(PGPRO1,PGPRO2,
  3.      $     PGCOUR,
  4.      $     IMPR,IRET)
  5.       IMPLICIT REAL*8 (A-H,O-Z)
  6.       IMPLICIT INTEGER (I-N)
  7. C***********************************************************************
  8. C NOM         : PROPG
  9. C PROJET      : Noyau linéaire NLIN
  10. C DESCRIPTION : Construit les coordonnées et poids pour des règles
  11. C               d'intégration "produit".
  12. C
  13. C
  14. C LANGAGE     : ESOPE
  15. C AUTEUR      : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  16. C               mél : gounand@semt2.smts.cea.fr
  17. C***********************************************************************
  18. C APPELES          : -
  19. C APPELE PAR       : INGAPR
  20. C***********************************************************************
  21. C ENTREES            : PGPRO1, PGPRO2
  22. C ENTREES/SORTIES    : PGCOUR (supposé actif en *MOD)
  23. C SORTIES            : -
  24. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  25. C***********************************************************************
  26. C VERSION    : v1, 12/05/2000, version initiale
  27. C HISTORIQUE : v1, 12/05/2000, création
  28. C HISTORIQUE :
  29. C HISTORIQUE :
  30. C***********************************************************************
  31. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  32. C en cas de modification de ce sous-programme afin de faciliter
  33. C la maintenance !
  34. C***********************************************************************
  35.  
  36. -INC PPARAM
  37. -INC CCOPTIO
  38. -INC TNLIN      
  39. *-INC SPOGAU
  40.       POINTEUR PGCOUR.POGAU
  41.       POINTEUR PGPRO1.POGAU
  42.       POINTEUR PGPRO2.POGAU
  43. *
  44.       INTEGER IMPR,IRET
  45. *
  46.       INTEGER NBPG1,NBPG2,NBPGC
  47.       INTEGER IBPG1,IBPG2,IBPGC
  48.       INTEGER NDIML1,NDIML2,NDIMLC
  49.       INTEGER IDIML1,IDIML2,IDIMLC
  50. *
  51. * Executable statements
  52. *
  53.       IF (IMPR.GT.2) WRITE(IOIMP,*) 'Entrée dans propg.eso'
  54.       SEGACT PGPRO1
  55.       SEGACT PGPRO2
  56.       NDIML1=PGPRO1.XCOPG(/1)
  57.       NBPG1 =PGPRO1.XCOPG(/2)
  58.       NDIML2=PGPRO2.XCOPG(/1)
  59.       NBPG2 =PGPRO2.XCOPG(/2)
  60.       NDIMLC=PGCOUR.XCOPG(/1)
  61.       NBPGC =PGCOUR.XCOPG(/2)
  62.       IF ((NDIML1+NDIML2).NE.NDIMLC) THEN
  63.          WRITE(IOIMP,*) 'Err. dim. esp.'
  64.          GOTO 9999
  65.       ENDIF
  66.       IF ((NBPG1*NBPG2).NE.NBPGC) THEN
  67.          WRITE(IOIMP,*) 'Err. nb. noeud.'
  68.          GOTO 9999
  69.       ENDIF
  70.       IBPGC=0
  71.       DO 1 IBPG2=1,NBPG2
  72.          DO 12 IBPG1=1,NBPG1
  73.             IBPGC=IBPGC+1
  74.             IDIMLC=0
  75.             DO 122 IDIML1=1,NDIML1
  76.                IDIMLC=IDIMLC+1
  77.                PGCOUR.XCOPG(IDIMLC,IBPGC)=
  78.      $              PGPRO1.XCOPG(IDIML1,IBPG1)
  79.  122        CONTINUE
  80.             DO 124 IDIML2=1,NDIML2
  81.                IDIMLC=IDIMLC+1
  82.                PGCOUR.XCOPG(IDIMLC,IBPGC)=
  83.      $              PGPRO2.XCOPG(IDIML2,IBPG2)
  84.  124        CONTINUE
  85.             PGCOUR.XPOPG(IBPGC)=PGPRO1.XPOPG(IBPG1)
  86.      $           *PGPRO2.XPOPG(IBPG2)
  87.  12      CONTINUE
  88.  1    CONTINUE
  89.       SEGDES PGPRO2
  90.       SEGDES PGPRO1
  91. *
  92. * Normal termination
  93. *
  94.       IRET=0
  95.       RETURN
  96. *
  97. * Format handling
  98. *
  99. *
  100. * Error handling
  101. *
  102.  9999 CONTINUE
  103.       IRET=1
  104.       WRITE(IOIMP,*) 'An error was detected in subroutine propg'
  105.       RETURN
  106. *
  107. * End of subroutine PROPG
  108. *
  109.       END
  110.  
  111.  
  112.  
  113.  
  114.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales