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    GOUNAND   25/04/30    21:15:23     12258          
  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.       SEGACT NORMD
  59.       NBVA=NTTDDL
  60.       SEGINI NORMD2
  61.       DO ITTDDL=1,NTTDDL
  62.          NORMD2.A(ITTDDL)=1.D0/(SQRT(NORMD.A(ITTDDL)))
  63.       ENDDO
  64. *     On norme
  65.       segact AMORS
  66.       segact AISA*MOD
  67.       NTTDD2=AMORS.IA(/1)-1
  68.       IF (NTTDD2.NE.NTTDDL) THEN
  69.          WRITE(IOIMP,*) 'Erreur grave'
  70.          GOTO 9999
  71.       ENDIF
  72.       DO ITTDDL=1,NTTDDL
  73.          JSTRT=AMORS.IA(ITTDDL)
  74.          JSTOP=AMORS.IA(ITTDDL+1)-1
  75.          DO J=JSTRT,JSTOP
  76.             JTTDDL=AMORS.JA(J)
  77.             VAL=AISA.A(J)
  78.             VAL=VAL*NORMP2.A(JTTDDL)*NORMD2.A(ITTDDL)
  79.             AISA.A(J)=VAL
  80.          ENDDO
  81.       ENDDO
  82.       SEGSUP NORMP2
  83.       SEGSUP NORMD2
  84. *
  85. * Normal termination
  86. *
  87.       IRET=0
  88.       RETURN
  89. *
  90. * Format handling
  91. *
  92. *
  93. * Error handling
  94. *
  95.  9999 CONTINUE
  96.       IRET=1
  97.       WRITE(IOIMP,*) 'An error was detected in subroutine normam'
  98.       RETURN
  99. *
  100. * End of subroutine NORMAM
  101. *
  102.       END
  103.  
  104.  

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