Télécharger norma1.eso

Retour à la liste

Numérotation des lignes :

  1. C NORMA1 SOURCE PV 18/06/18 21:15:19 9860
  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*(*) 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. MPOVA1 = IPOVAL
  82. SEGACT MPOVA1
  83. N=MPOVA1.VPOCHA(/1)
  84. NC=MPOVA1.VPOCHA(/2)
  85. SEGINI,MPOVAL
  86. IPOVAL = MPOVAL
  87. *
  88. DO 120 IB120=1,NC
  89. DO 130 IB130=1,N
  90. VPOCHA(IB130,IB120) = MPOVA1.VPOCHA(IB130,IB120) / PGRAND
  91. 130 CONTINUE
  92. * END DO
  93. 120 CONTINUE
  94. * END DO
  95. IF (IB100.EQ.MAXSOU)
  96. > VPOCHA(MAXN,MAXNC) = 1.D0
  97. *
  98. SEGDES,MPOVAL,MSOUPO
  99. *
  100. 100 CONTINUE
  101. * END DO
  102. *
  103. SEGDES,MCHPOI
  104. SEGSUP,MTEMP2
  105. *
  106. END
  107.  
  108.  
  109.  
  110.  

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