Télécharger maxich.eso

Retour à la liste

Numérotation des lignes :

  1. C MAXICH SOURCE PV 09/03/12 21:28:27 6325
  2. SUBROUTINE MAXICH(IPCHLM,IPLMOT,MOTCLE,IPLACE,PGRAND,KPLUS,LABSO)
  3. ************************************************************************
  4. *
  5. * M A X I C H
  6. * -----------
  7. *
  8. * FONCTION:
  9. * ---------
  10. *
  11. * RECHERCHER LA PLUS GRANDE VALEUR D'UN 'MCHAML'.
  12. *
  13. * MODE D'APPEL:
  14. * -------------
  15. *
  16. * CALL MAXICH (IPCHLM,IPLMOT,MOTCLE,IPLACE,PGRAND)
  17. *
  18. * ARGUMENTS: (E)=ENTREE (S)=SORTIE
  19. * ----------
  20. *
  21. *
  22. * IPCHLM ENTIER (E) POINTEUR SUR UN 'MCHAML'.
  23. * IPLMOT ENTIER (E) POINTEUR SUR UN 'LISTMOTS', OU BIEN
  24. * NOMBRE EGAL A "0", SI L'ON PREND EN
  25. * CONSIDERATION TOUTES LES COMPOSANTES.
  26. * MOTCLE ENTIER (E) INDIQUE PAR SON CONTENU ('AVEC' OU 'SANS')
  27. * SI LES NOMS CONTENUS DANS L'OBJET
  28. * 'LISTMOTS' SONT LES NOMS DES COMPOSANTES
  29. * A CONSIDERER ('AVEC') OU, AU CONTRAIRE,
  30. * A EXCLURE ('SANS') LORS DE LA RECHERCHE
  31. * DU MAXIMUM.
  32. * CONTENU SANS IMPORTANCE SI IPLMOT = 0 .
  33. * IPLACE ENTIER (E) POINTEUR DU SEGMENT "MTEMP2" DONNANT LA
  34. * PLACE DU MAXIMUM DANS LE CHPOINT.
  35. * = 0 SI CETTE PLACE N'EST PAS DEMANDEE.
  36. * SINON, UN SEGMENT "MTEMP2" A ETE CREE DANS
  37. * LE PROGRAMME APPELANT POUR METTRE "MAXSOU",
  38. * "MAXN" ET "MAXNC".
  39. * PGRAND REEL DP (S) PLUS GRANDE VALEUR (EN VALEUR ABSOLUE)
  40. * EXTRAITE DU 'CHAMELEM'.
  41. * CETTE VALEUR EST RETOURNEE AVEC SON SIGNE.
  42. *
  43. * DICTIONNAIRE DES VARIABLES: (ORDRE ALPHABETIQUE)
  44. * ---------------------------
  45. *
  46. * DEDANS LOGIQUE INDIQUE PAR .TRUE. OU .FALSE. SI UN TYPE DE
  47. * COMPOSANTE DONNE DU 'CHPOINT' FAIT PARTIE OU
  48. * NON DES TYPES NOMMES DANS L'OBJET DE POINTEUR
  49. * "IPLMOT".
  50. * NBRMOT ENTIER NOMBRE DE TYPES NOMMES DANS L'OBJET DE POINTEUR
  51. * "IPLMOT".
  52. * TRUFAL LOGIQUE CONTIENT LA VALEUR QUI DOIT ETRE DANS "DEDANS"
  53. * POUR FAIRE LA RECHERCHE DU MAXIMUM.
  54. *
  55. * SOUS-PROGRAMMES APPELES:
  56. * ------------------------
  57. *
  58. * PARMI
  59. *
  60. ************************************************************************
  61. *
  62. IMPLICIT INTEGER(I-N)
  63. -INC CCOPTIO
  64. -INC SMCHAML
  65. -INC SMLMOTS
  66. *
  67. REAL*8 PGRAND,XVAL
  68. CHARACTER*4 MOTCLE
  69. *
  70. LOGICAL DEDANS,TRUFAL
  71. *
  72. SEGMENT/MTEMP3/ (MAXSOU,MAXNEL,MAXNBP,MAXCO)
  73. *
  74. *
  75. *
  76. IF (IPLMOT .EQ. 0) THEN
  77. *
  78. DEDANS = .TRUE.
  79. TRUFAL = DEDANS
  80. *
  81. ELSE
  82. *
  83. IF (MOTCLE .EQ.'AVEC') THEN
  84. TRUFAL = .TRUE.
  85. ELSE IF (MOTCLE .EQ.'SANS') THEN
  86. TRUFAL = .FALSE.
  87. ELSE
  88. * MOT-CLE NON RECONNU:
  89. NUMERR = 7
  90. MOTERR(1:4) = MOTCLE
  91. CALL ERREUR (NUMERR)
  92. RETURN
  93. END IF
  94. *
  95. MLMOTS = IPLMOT
  96. SEGACT,MLMOTS
  97. NBRMOT = MOTS(/2)
  98. SEGDES,MLMOTS
  99. *
  100. END IF
  101. *
  102. * RQ: A CE NIVEAU, "MOTCLE" EST DIFFERENT DE "MOCLE1" ET DE "MOCLE2"
  103. * SI ET SEULEMENT SI IPLMOT = 0 .
  104. *
  105. *
  106. IDEB=0
  107. PGRAND = 0.D0
  108. *
  109. * pour l'optimiseur
  110. mtemp3=ipchlm
  111. IF (IPLACE .NE. 0) THEN
  112. MTEMP3 = IPLACE
  113. SEGACT,MTEMP3
  114. MAXSOU = 1
  115. MAXNEL = 1
  116. MAXCO = 1
  117. MAXNBP = 1
  118. END IF
  119. *
  120. IF (IPLMOT .NE. 0) THEN
  121. MLMOTS = IPLMOT
  122. SEGACT MLMOTS
  123. END IF
  124. C
  125. C ON RECUPERE LE CHAMELEM
  126. C
  127. MCHELM=IPCHLM
  128. SEGACT MCHELM
  129. NSOUS=ICHAML(/1)
  130. C
  131. C BOUCLE SUR LES SOUS PAQUETS
  132. C
  133. DO 100 IA=1,NSOUS
  134. MCHAML=ICHAML(IA)
  135. SEGACT MCHAML
  136. NCOELE=NOMCHE(/2)
  137. C
  138. C -- RECHERCHE DU MAXIMUM --
  139. C
  140. DO 720 IC=1,NCOELE
  141. C
  142. MELVAL=IELVAL(IC)
  143. SEGACT MELVAL
  144. NBPTEL=VELCHE(/1)
  145. NEL =VELCHE(/2)
  146. IF (IPLMOT .NE. 0) THEN
  147. CALL PARMI (NOMCHE(IC),MOTS,NBRMOT, DEDANS)
  148. END IF
  149. C
  150. C SI LA COMPOSANTE NOMCHE(IC) FAIT PARTIE DES COMPOSANTES
  151. C RETENUES POUR LA RECHERCHE DU MAXIMUM, ALORS...
  152. C
  153. IF((DEDANS.AND.TRUFAL).OR.((.NOT.DEDANS).AND.(.NOT.TRUFAL)))
  154. . THEN
  155. IF(IDEB.EQ.0) THEN
  156. IDEB=1
  157. IF(LABSO.EQ.0) THEN
  158. PGRAND=VELCHE(1,1)
  159. ELSE
  160. PGRAND=ABS(VELCHE(1,1))
  161. ENDIF
  162. ENDIF
  163. DO 730 IB=1,NEL
  164. DO 730 ID=1,NBPTEL
  165. IF(LABSO.EQ.0) THEN
  166. XVAL =VELCHE(ID,IB)
  167. ELSE
  168. XVAL =ABS(VELCHE(ID,IB))
  169. ENDIF
  170. IF((KPLUS.EQ. 1.AND.XVAL.GT.PGRAND).
  171. $ OR.(KPLUS.EQ.-1.AND.XVAL.LT.PGRAND)) THEN
  172. IF (IPLACE .NE. 0) THEN
  173. MAXSOU = IA
  174. MAXNEL= IB
  175. MAXNBP = ID
  176. MAXCO = IC
  177. END IF
  178. PGRAND = XVAL
  179. END IF
  180. 730 CONTINUE
  181. C
  182. END IF
  183. C
  184. SEGDES MELVAL
  185. 720 CONTINUE
  186. SEGDES MCHAML
  187. C
  188. 100 CONTINUE
  189. SEGDES MCHELM
  190. C
  191. IF (IPLMOT .NE. 0) THEN
  192. MLMOTS = IPLMOT
  193. SEGDES,MLMOTS
  194. END IF
  195. IF (IPLACE .NE. 0) THEN
  196. MTEMP3 = IPLACE
  197. SEGDES MTEMP3
  198. END IF
  199. *
  200. * -- A-T-ON OBTENU UN MAXIMUM ? --
  201. *
  202. IF (IDEB.EQ.0) THEN
  203. * SOIT LE 'MCHAML' EST VIDE, SOIT LE 'LISTMOTS' CONTIENT DES
  204. * NOMS DE TYPE TELS QUE, ETANT DONNE LA VALEUR DU MOT-CLE,
  205. * TOUTES LES COMPOSANTES DU 'CHPOINT' SONT EXCLUES.
  206. if (labso.eq.0) then
  207. NUMERR = 156
  208. CALL ERREUR (NUMERR)
  209. RETURN
  210. endif
  211. pgrand=0.d0
  212. END IF
  213. C
  214. END
  215.  
  216.  
  217.  
  218.  
  219.  

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