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

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