Télécharger la plaquette Cast3M


fr en

Télécharger normam.eso

Retour à la liste

Numérotation des lignes : 

normam

  1. C NORMAM    SOURCE    PV        20/09/26    21:19:00     10724          
  2.       SUBROUTINE NORMAM(AMORS,AISA,NORMP,NORMD,
  3.      $     IMPR,IRET)
  4.       IMPLICIT REAL*8 (A-H,O-Z)
  5.       IMPLICIT INTEGER (I-N)
  6. C***********************************************************************
  7. C NOM         : NORMAM
  8. C DESCRIPTION : Equilibrage de la matrice avec normp
  9. C               et normd
  10. C
  11. C
  12. C
  13. C
  14. C LANGAGE     : ESOPE
  15. C AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  16. C               mél : gounand@semt2.smts.cea.fr
  17. C********************************************************
  18. C***********************************************************************
  19. C SYNTAXE GIBIANE    :
  20. C ENTREES            :
  21. C ENTREES/SORTIES    :
  22. C SORTIES            :
  23. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  24. C***********************************************************************
  25. C VERSION    : v1, 29/04/2003, version initiale
  26. C HISTORIQUE : v1, 29/04/2003, création
  27. C HISTORIQUE :
  28. C HISTORIQUE :
  29. C***********************************************************************
  30. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  31. C en cas de modification de ce sous-programme afin de faciliter
  32. C la maintenance !
  33. C***********************************************************************
  34.  
  35. -INC PPARAM
  36. -INC CCOPTIO
  38.       POINTEUR AMORS.PMORS
  39.       POINTEUR AISA.IZA
  40.       POINTEUR NORMP.IZA
  41.       POINTEUR NORMD.IZA
  42.       POINTEUR NORMP2.IZA
  43.       POINTEUR NORMD2.IZA
  44. *
  45.       INTEGER IMPR,IRET
  46. *
  47. * Executable statements
  48. *
  49.       IF (IMPR.GT.5) WRITE(IOIMP,*) 'Entrée dans normam.eso'
  50. * On commence par calculer 1/sqrt(normp) qui va nous servir
  51.       SEGACT NORMP
  52.       NTTDDL=NORMP.A(/1)
  53.       NBVA=NTTDDL
  54.       SEGINI NORMP2
  55.       DO ITTDDL=1,NTTDDL
  56.          NORMP2.A(ITTDDL)=1.D0/(SQRT(NORMP.A(ITTDDL)))
  57.       ENDDO
  58.       SEGDES NORMP
  59.       SEGACT NORMD
  60.       NBVA=NTTDDL
  61.       SEGINI NORMD2
  62.       DO ITTDDL=1,NTTDDL
  63.          NORMD2.A(ITTDDL)=1.D0/(SQRT(NORMD.A(ITTDDL)))
  64.       ENDDO
  65.       SEGDES NORMD
  66. * On norme
  67.       SEGACT AMORS
  68.       SEGACT AISA*MOD
  69.       NTTDD2=AMORS.IA(/1)-1
  70.       IF (NTTDD2.NE.NTTDDL) THEN
  71.          WRITE(IOIMP,*) 'Erreur grave'
  72.          GOTO 9999
  73.       ENDIF
  74.       DO ITTDDL=1,NTTDDL
  75.          JSTRT=AMORS.IA(ITTDDL)
  76.          JSTOP=AMORS.IA(ITTDDL+1)-1
  77.          DO J=JSTRT,JSTOP
  78.             JTTDDL=AMORS.JA(J)
  79.             VAL=AISA.A(J)
  80.             VAL=VAL*NORMP2.A(JTTDDL)*NORMD2.A(ITTDDL)
  81.             AISA.A(J)=VAL
  82.          ENDDO
  83.       ENDDO
  84.       SEGDES AISA
  85.       SEGDES AMORS
  86.       SEGSUP NORMP2
  87.       SEGSUP NORMD2
  88. *
  89. * Normal termination
  90. *
  91.       IRET=0
  92.       RETURN
  93. *
  94. * Format handling
  95. *
  96. *
  97. * Error handling
  98. *
  99.  9999 CONTINUE
  100.       IRET=1
  101.       WRITE(IOIMP,*) 'An error was detected in subroutine normam'
  102.       RETURN
  103. *
  104. * End of subroutine NORMAM
  105. *
  106.       END
  107.  
  108.  
  109.  
  110.  
  111.  
  112.  
  113.  

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