Télécharger norma1.eso

Retour à la liste

Numérotation des lignes :

  1. C NORMA1 SOURCE CB215821 19/07/09 21:15:16 10252
  2. SUBROUTINE NORMA1 (IPCHP1,IPLMOT,MOTCLE,IPCHP2)
  3. ************************************************************************
  4. *
  5. * N O R M A 1
  6. * -----------
  7. *
  8. * FONCTION:
  9. * ---------
  10. *
  11. * NORMER UN 'CHPOINT' EN RAMENANT SA PLUS GRANDE VALEUR A 1.
  12. *
  13. * MODE D'APPEL:
  14. * -------------
  15. *
  16. * CALL NORMA1 (IPCHP1,IPLMOT,MOTCLE,IPCHP2)
  17. *
  18. * ARGUMENTS: (E)=ENTREE (S)=SORTIE
  19. * ----------
  20. *
  21. * IPCHP1 ENTIER (E) POINTEUR SUR L'OBJET 'CHPOINT' A NORMER.
  22. * IPLMOT ENTIER (E) VOIR LE S.P. "MAXIM1".
  23. * MOTCLE CHARACTER (E) VOIR LE S.P. "MAXIM1".
  24. * IPCHP2 ENTIER (S) POINTEUR SUR L'OBJET 'CHPOINT' NORME ISSU
  25. * DE L'OBJET DE POINTEUR "IPCHP1".
  26. *
  27. * SOUS-PROGRAMMES APPELES:
  28. * ------------------------
  29. *
  30. * MAXIM1, ERREUR.
  31. *
  32. * AUTEUR, DATE DE CREATION:
  33. * -------------------------
  34. *
  35. * PASCAL MANIGOT 16 OCTOBRE 1984
  36. *
  37. * LANGAGE:
  38. * --------
  39. *
  40. * ESOPE + FORTRAN77
  41. *
  42. ************************************************************************
  43. *
  44. IMPLICIT INTEGER(I-N)
  45.  
  46. -INC PPARAM
  47. -INC CCOPTIO
  48. -INC SMCHPOI
  49. *
  50. SEGMENT/MTEMP2/ (MAXSOU,MAXN,MAXNC)
  51. * (REMPLI DANS LE S.P. "MAXIM1")
  52. *
  53. REAL*8 PGRAND
  54. CHARACTER*(*) MOTCLE
  55. *
  56. * -- RECHERCHE DU MAXIMUM --
  57. *
  58. SEGINI,MTEMP2
  59. IPLACE = MTEMP2
  60. CALL MAXIM1 (IPCHP1,IPLMOT,MOTCLE,IPLACE, PGRAND)
  61. IF (IERR .NE. 0) RETURN
  62. IF (PGRAND .EQ. 0.D0) THEN
  63. NUMERR = 150
  64. CALL ERREUR (NUMERR)
  65. RETURN
  66. END IF
  67. *
  68. * -- NORMALISATION --
  69. *
  70. MTEMP2 = IPLACE
  71. SEGACT,MTEMP2
  72. *
  73. MCHPO1 = IPCHP1
  74. SEGINI,MCHPOI=MCHPO1
  75. IPCHP2 = MCHPOI
  76. NSOUPO = IPCHP(/1)
  77. *
  78. DO 100 IB100=1,NSOUPO
  79. *
  80. MSOUP1 = IPCHP(IB100)
  81. SEGINI,MSOUPO=MSOUP1
  82. IPCHP(IB100) = MSOUPO
  83. MPOVA1 = IPOVAL
  84. SEGACT MPOVA1
  85. N=MPOVA1.VPOCHA(/1)
  86. NC=MPOVA1.VPOCHA(/2)
  87. SEGINI,MPOVAL
  88. IPOVAL = MPOVAL
  89. *
  90. DO 120 IB120=1,NC
  91. DO 130 IB130=1,N
  92. VPOCHA(IB130,IB120) = MPOVA1.VPOCHA(IB130,IB120) / PGRAND
  93. 130 CONTINUE
  94. * END DO
  95. 120 CONTINUE
  96. * END DO
  97. IF (IB100.EQ.MAXSOU)
  98. > VPOCHA(MAXN,MAXNC) = 1.D0
  99. *
  100. SEGACT,MPOVAL*NOMOD,MSOUPO*NOMOD
  101. *
  102. 100 CONTINUE
  103. * END DO
  104. *
  105. SEGACT,MCHPOI*NOMOD
  106. SEGSUP,MTEMP2
  107. *
  108. END
  109.  
  110.  
  111.  
  112.  
  113.  

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