Télécharger maxin1.eso

Retour à la liste

Numérotation des lignes :

  1. C MAXIN1 SOURCE CB215821 19/07/09 21:15:11 10252
  2. SUBROUTINE MAXIN1(IPCHPO,IPLMOT,MOTCLE,IPLACE,PGRAND,KPLUS,LABSO)
  3. ************************************************************************
  4. *
  5. * M A X I N 1
  6. * -----------
  7. *
  8. * FONCTION:
  9. * ---------
  10. *
  11. * RECHERCHER LA PLUS GRANDE VALEUR D'UN 'CHPOINT'.
  12. *
  13. * COMPLETEMENT INSPIRE DE MAXIM1 QUI RECHERCHE LE MAXIMUM EN
  14. * VALEUR ABSOLUE ( VOIR MAXIM1 POUR COMMENTAIRES )
  15. *
  16. *
  17. ************************************************************************
  18. *
  19. IMPLICIT INTEGER(I-N)
  20. -INC CCOPTIO
  21. -INC SMCHPOI
  22. -INC SMLMOTS
  23. *
  24. CHARACTER*4 MOTCLE
  25. REAL*8 PGRAND,XVAL
  26. *
  27. LOGICAL DEDANS,TRUFAL
  28. *
  29. SEGMENT/MTEMP2/ (MAXSOU,MAXN,MAXNC)
  30. *
  31. *
  32. *
  33. IF (IPLMOT .EQ. 0) THEN
  34. *
  35. DEDANS = .TRUE.
  36. TRUFAL = DEDANS
  37. *
  38. ELSE
  39. *
  40. IF (MOTCLE .EQ. 'AVEC') THEN
  41. TRUFAL = .TRUE.
  42. ELSEIF (MOTCLE .EQ. 'SANS') THEN
  43. TRUFAL = .FALSE.
  44. ELSE
  45. * MOT-CLE NON RECONNU:
  46. MOTERR(1:4)=MOTCLE
  47. CALL ERREUR (7)
  48. RETURN
  49. ENDIF
  50. *
  51. MLMOTS = IPLMOT
  52. SEGACT,MLMOTS
  53. NBRMOT = MOTS(/2)
  54. *
  55. ENDIF
  56. *
  57. * RQ: A CE NIVEAU, "MOTCLE" EST DIFFERENT DE "MOCLE1" ET DE "MOCLE2"
  58. * SI ET SEULEMENT SI IPLMOT = 0 .
  59. *
  60. *
  61. MCHPOI = IPCHPO
  62. SEGACT,MCHPOI
  63. NSOUPO = IPCHP(/1)
  64. PGRAND = 0.D0
  65. IDEB=0
  66. *
  67. MTEMP2 = MCHPOI
  68. IF (IPLACE .NE. 0) THEN
  69. MTEMP2 = IPLACE
  70. SEGACT,MTEMP2
  71. MAXSOU = 1
  72. MAXN = 1
  73. MAXNC = 1
  74. END IF
  75. *
  76. IF (IPLMOT .NE. 0) THEN
  77. MLMOTS = IPLMOT
  78. SEGACT,MLMOTS
  79. END IF
  80. *
  81. * -- RECHERCHE DU MAXIMUM --
  82. *
  83. DO 100 IB100=1,NSOUPO
  84. *
  85. MSOUPO = IPCHP(IB100)
  86. SEGACT,MSOUPO
  87. NC = NOCOMP(/2)
  88. MPOVAL = IPOVAL
  89. SEGACT,MPOVAL
  90. N = VPOCHA(/1)
  91. *
  92. if (n.gt.0) then
  93. DO 120 IB120=1,NC
  94. *
  95. IF (IPLMOT .NE. 0) THEN
  96. CALL PARMI (NOCOMP(IB120),MOTS,NBRMOT, DEDANS)
  97. END IF
  98. *
  99. * SI LA COMPOSANTE NOCOMP(IB120) FAIT PARTIE DES COMPOSANTES
  100. * RETENUES POUR LA RECHERCHE DU MAXIMUM, ALORS...
  101. ** IF (DEDANS .EQV. TRUFAL) THEN
  102. ** (LIGNE CI-DESSUS INCOMPRISE PAR ESOPE 4.1.1 (MARS 84) )
  103. IF((DEDANS.AND.TRUFAL).OR.((.NOT.DEDANS).AND.(.NOT.TRUFAL)))
  104. & THEN
  105. *
  106. IF(IDEB.EQ.0) THEN
  107. IDEB=1
  108. IF(LABSO.EQ.0) THEN
  109. PGRAND=VPOCHA(1,IB120)
  110. ELSE
  111. PGRAND=ABS(VPOCHA(1,IB120))
  112. ENDIF
  113. ENDIF
  114. *
  115. DO 130 IB130=1,N
  116. * A CAUSE D'UNE AGACERIE DU COMPILATEUR CRAY CFT115
  117. MPOVA1=MPOVAL
  118. IF(LABSO.EQ.0) THEN
  119. XVAL = MPOVA1.VPOCHA(IB130,IB120)
  120. ELSE
  121. XVAL = ABS(MPOVA1.VPOCHA(IB130,IB120))
  122. ENDIF
  123. IF((KPLUS.EQ. 1.AND.XVAL.GT.PGRAND).
  124. $ OR.(KPLUS.EQ.-1.AND.XVAL.LT.PGRAND))
  125. $ THEN
  126. IF (IPLACE .NE. 0) THEN
  127. MAXSOU = IB100
  128. MAXN = IB130
  129. MAXNC = IB120
  130. END IF
  131. PGRAND = XVAL
  132. END IF
  133. 130 CONTINUE
  134. * END DO
  135. END IF
  136. *
  137. 120 CONTINUE
  138. * END DO
  139. endif
  140. *
  141. *
  142. 100 CONTINUE
  143. * END DO
  144. *
  145. * -- A-T-ON OBTENU UN MAXIMUM ? --
  146. *
  147. * IF (IDEB.EQ.0) THEN
  148. * SOIT LE 'CHPOINT' EST VIDE, SOIT LE 'LISTMOTS' CONTIENT DES
  149. * NOMS DE TYPE TELS QUE, ETANT DONNE LA VALEUR DU MOT-CLE,
  150. * TOUTES LES COMPOSANTES DU 'CHPOINT' SONT EXCLUES.
  151. * NUMERR = 156
  152. * CALL ERREUR (NUMERR)
  153. * RETURN
  154. * END IF
  155. *
  156. END
  157.  
  158.  
  159.  

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