Esope source files

   1 : C NORMAM    SOURCE    MAGN      09/07/30    21:19:38     6458           
   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 : -INC CCOPTIO
  35 : -INC SMMATRIK
  36 :       POINTEUR AMORS.PMORS
  37 :       POINTEUR AISA.IZA
  38 :       POINTEUR NORMP.IZA
  39 :       POINTEUR NORMD.IZA
  40 :       POINTEUR NORMP2.IZA
  41 :       POINTEUR NORMD2.IZA
  42 : *     
  43 :       INTEGER IMPR,IRET
  44 : *     
  45 : * Executable statements
  46 : *     
  47 :       IF (IMPR.GT.5) WRITE(IOIMP,*) 'Entrée dans normam.eso' 
  48 : * On commence par calculer 1/sqrt(normp) qui va nous servir
  49 :       SEGACT NORMP
  50 :       NTTDDL=NORMP.A(/1)
  51 :       NBVA=NTTDDL
  52 :       SEGINI NORMP2
  53 :       DO ITTDDL=1,NTTDDL
  54 :          NORMP2.A(ITTDDL)=1.D0/(SQRT(NORMP.A(ITTDDL)))
  55 :       ENDDO
  56 :       SEGDES NORMP
  57 :       SEGACT NORMD
  58 :       NBVA=NTTDDL
  59 :       SEGINI NORMD2
  60 :       DO ITTDDL=1,NTTDDL
  61 :          NORMD2.A(ITTDDL)=1.D0/(SQRT(NORMD.A(ITTDDL)))
  62 :       ENDDO
  63 :       SEGDES NORMD
  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 :       SEGDES AISA
  83 :       SEGDES AMORS
  84 :       SEGSUP NORMP2
  85 :       SEGSUP NORMD2
  86 : *     
  87 : * Normal termination
  88 : *     
  89 :       IRET=0
  90 :       RETURN
  91 : *     
  92 : * Format handling
  93 : *     
  94 : *     
  95 : * Error handling
  96 : *     
  97 :  9999 CONTINUE
  98 :       IRET=1
  99 :       WRITE(IOIMP,*) 'An error was detected in subroutine normam'
 100 :       RETURN
 101 : *     
 102 : * End of subroutine NORMAM
 103 : *     
 104 :       END
 105 : 
 106 :  
 107 :