Télécharger maxin1.eso

Retour à la liste

Numérotation des lignes :

  1. C MAXIN1 SOURCE CHAT 05/01/13 01:36:38 5004
  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. ELSE IF (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. END IF
  50. *
  51. MLMOTS = IPLMOT
  52. SEGACT,MLMOTS
  53. NBRMOT = MOTS(/2)
  54. SEGDES,MLMOTS
  55. *
  56. END IF
  57. *
  58. * RQ: A CE NIVEAU, "MOTCLE" EST DIFFERENT DE "MOCLE1" ET DE "MOCLE2"
  59. * SI ET SEULEMENT SI IPLMOT = 0 .
  60. *
  61. *
  62. MCHPOI = IPCHPO
  63. SEGACT,MCHPOI
  64. NSOUPO = IPCHP(/1)
  65. PGRAND = 0.D0
  66. IDEB=0
  67. *
  68. MTEMP2 = MCHPOI
  69. IF (IPLACE .NE. 0) THEN
  70. MTEMP2 = IPLACE
  71. SEGACT,MTEMP2
  72. MAXSOU = 1
  73. MAXN = 1
  74. MAXNC = 1
  75. END IF
  76. *
  77. IF (IPLMOT .NE. 0) THEN
  78. MLMOTS = IPLMOT
  79. SEGACT,MLMOTS
  80. END IF
  81. *
  82. * -- RECHERCHE DU MAXIMUM --
  83. *
  84. DO 100 IB100=1,NSOUPO
  85. *
  86. MSOUPO = IPCHP(IB100)
  87. SEGACT,MSOUPO
  88. NC = NOCOMP(/2)
  89. MPOVAL = IPOVAL
  90. SEGACT,MPOVAL
  91. N = VPOCHA(/1)
  92. *
  93. if (n.gt.0) then
  94. DO 120 IB120=1,NC
  95. *
  96. IF (IPLMOT .NE. 0) THEN
  97. CALL PARMI (NOCOMP(IB120),MOTS,NBRMOT, DEDANS)
  98. END IF
  99. *
  100. * SI LA COMPOSANTE NOCOMP(IB120) FAIT PARTIE DES COMPOSANTES
  101. * RETENUES POUR LA RECHERCHE DU MAXIMUM, ALORS...
  102. ** IF (DEDANS .EQV. TRUFAL) THEN
  103. ** (LIGNE CI-DESSUS INCOMPRISE PAR ESOPE 4.1.1 (MARS 84) )
  104. IF((DEDANS.AND.TRUFAL).OR.((.NOT.DEDANS).AND.(.NOT.TRUFAL)))
  105. & THEN
  106. *
  107. IF(IDEB.EQ.0) THEN
  108. IDEB=1
  109. IF(LABSO.EQ.0) THEN
  110. PGRAND=VPOCHA(1,IB120)
  111. ELSE
  112. PGRAND=ABS(VPOCHA(1,IB120))
  113. ENDIF
  114. ENDIF
  115. *
  116. DO 130 IB130=1,N
  117. * A CAUSE D'UNE AGACERIE DU COMPILATEUR CRAY CFT115
  118. MPOVA1=MPOVAL
  119. IF(LABSO.EQ.0) THEN
  120. XVAL = MPOVA1.VPOCHA(IB130,IB120)
  121. ELSE
  122. XVAL = ABS(MPOVA1.VPOCHA(IB130,IB120))
  123. ENDIF
  124. IF((KPLUS.EQ. 1.AND.XVAL.GT.PGRAND).
  125. $ OR.(KPLUS.EQ.-1.AND.XVAL.LT.PGRAND))
  126. $ THEN
  127. IF (IPLACE .NE. 0) THEN
  128. MAXSOU = IB100
  129. MAXN = IB130
  130. MAXNC = IB120
  131. END IF
  132. PGRAND = XVAL
  133. END IF
  134. 130 CONTINUE
  135. * END DO
  136. END IF
  137. *
  138. 120 CONTINUE
  139. * END DO
  140. endif
  141. *
  142. SEGDES,MPOVAL
  143. SEGDES,MSOUPO
  144. *
  145. 100 CONTINUE
  146. * END DO
  147. *
  148. SEGDES,MCHPOI
  149. IF (IPLMOT .NE. 0) THEN
  150. MLMOTS = IPLMOT
  151. SEGDES,MLMOTS
  152. END IF
  153. IF (IPLACE .NE. 0) THEN
  154. MTEMP2 = IPLACE
  155. SEGDES,MTEMP2
  156. END IF
  157. *
  158. * -- A-T-ON OBTENU UN MAXIMUM ? --
  159. *
  160. * IF (IDEB.EQ.0) THEN
  161. * SOIT LE 'CHPOINT' EST VIDE, SOIT LE 'LISTMOTS' CONTIENT DES
  162. * NOMS DE TYPE TELS QUE, ETANT DONNE LA VALEUR DU MOT-CLE,
  163. * TOUTES LES COMPOSANTES DU 'CHPOINT' SONT EXCLUES.
  164. * NUMERR = 156
  165. * CALL ERREUR (NUMERR)
  166. * RETURN
  167. * END IF
  168. *
  169. END
  170.  
  171.  
  172.  
  173.  

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