Télécharger norma1.eso

Retour à la liste

Numérotation des lignes :

  1. C NORMA1 SOURCE CHAT 05/01/13 01:59:56 5004
  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. -INC CCOPTIO
  46. -INC SMCHPOI
  47. *
  48. SEGMENT/MTEMP2/ (MAXSOU,MAXN,MAXNC)
  49. * (REMPLI DANS LE S.P. "MAXIM1")
  50. *
  51. REAL*8 PGRAND
  52. CHARACTER*4 MOTCLE
  53. *
  54. * -- RECHERCHE DU MAXIMUM --
  55. *
  56. SEGINI,MTEMP2
  57. IPLACE = MTEMP2
  58. CALL MAXIM1 (IPCHP1,IPLMOT,MOTCLE,IPLACE, PGRAND)
  59. IF (IERR .NE. 0) RETURN
  60. IF (PGRAND .EQ. 0.D0) THEN
  61. NUMERR = 150
  62. CALL ERREUR (NUMERR)
  63. RETURN
  64. END IF
  65. *
  66. * -- NORMALISATION --
  67. *
  68. MTEMP2 = IPLACE
  69. SEGACT,MTEMP2
  70. *
  71. MCHPO1 = IPCHP1
  72. SEGINI,MCHPOI=MCHPO1
  73. IPCHP2 = MCHPOI
  74. NSOUPO = IPCHP(/1)
  75. *
  76. DO 100 IB100=1,NSOUPO
  77. *
  78. MSOUP1 = IPCHP(IB100)
  79. SEGINI,MSOUPO=MSOUP1
  80. IPCHP(IB100) = MSOUPO
  81. NC = NOCOMP(/2)
  82. MPOVA1 = IPOVAL
  83. SEGINI,MPOVAL=MPOVA1
  84. IPOVAL = MPOVAL
  85. N = VPOCHA(/1)
  86. *
  87. DO 120 IB120=1,NC
  88. DO 130 IB130=1,N
  89. IF (IB100 .EQ. MAXSOU .AND. IB120 .EQ. MAXNC
  90. & .AND. IB130 .EQ. MAXN) THEN
  91. VPOCHA(IB130,IB120) = 1.D0
  92. ELSE
  93. VPOCHA(IB130,IB120) = VPOCHA(IB130,IB120) / PGRAND
  94. END IF
  95. 130 CONTINUE
  96. * END DO
  97. 120 CONTINUE
  98. * END DO
  99. *
  100. SEGDES,MPOVAL,MSOUPO
  101. *
  102. 100 CONTINUE
  103. * END DO
  104. *
  105. SEGDES,MCHPOI
  106. SEGSUP,MTEMP2
  107. *
  108. END
  109.  
  110.  

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