Télécharger maxich.eso

Retour à la liste

Numérotation des lignes :

  1. C MAXICH SOURCE CB215821 19/08/20 21:19:39 10287
  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. *
  99. END IF
  100. *
  101. * RQ: A CE NIVEAU, "MOTCLE" EST DIFFERENT DE "MOCLE1" ET DE "MOCLE2"
  102. * SI ET SEULEMENT SI IPLMOT = 0 .
  103. *
  104. *
  105. IDEB=0
  106. PGRAND = 0.D0
  107. *
  108. * pour l'optimiseur
  109. mtemp3=ipchlm
  110. IF (IPLACE .NE. 0) THEN
  111. MTEMP3 = IPLACE
  112. SEGACT,MTEMP3
  113. MAXSOU = 1
  114. MAXNEL = 1
  115. MAXCO = 1
  116. MAXNBP = 1
  117. END IF
  118. *
  119. IF (IPLMOT .NE. 0) THEN
  120. MLMOTS = IPLMOT
  121. SEGACT MLMOTS
  122. END IF
  123. C
  124. C ON RECUPERE LE CHAMELEM
  125. C
  126. MCHELM=IPCHLM
  127. SEGACT MCHELM
  128. NSOUS=ICHAML(/1)
  129. C
  130. C BOUCLE SUR LES SOUS PAQUETS
  131. C
  132. DO 100 IA=1,NSOUS
  133. MCHAML=ICHAML(IA)
  134. SEGACT MCHAML
  135. NCOELE=NOMCHE(/2)
  136. C
  137. C -- RECHERCHE DU MAXIMUM --
  138. C
  139. DO 720 IC=1,NCOELE
  140. C
  141. MELVAL=IELVAL(IC)
  142. SEGACT MELVAL
  143. NBPTEL=VELCHE(/1)
  144. NEL =VELCHE(/2)
  145. IF (IPLMOT .NE. 0) THEN
  146. CALL PARMI (NOMCHE(IC),MOTS,NBRMOT, DEDANS)
  147. END IF
  148. C
  149. C SI LA COMPOSANTE NOMCHE(IC) FAIT PARTIE DES COMPOSANTES
  150. C RETENUES POUR LA RECHERCHE DU MAXIMUM, ALORS...
  151. C
  152. IF((DEDANS.AND.TRUFAL).OR.((.NOT.DEDANS).AND.(.NOT.TRUFAL)))
  153. . THEN
  154. IF(IDEB.EQ.0) THEN
  155. IDEB=1
  156. IF(LABSO.EQ.0) THEN
  157. PGRAND=VELCHE(1,1)
  158. ELSE
  159. PGRAND=ABS(VELCHE(1,1))
  160. ENDIF
  161. ENDIF
  162. DO 730 IB=1,NEL
  163. DO 730 ID=1,NBPTEL
  164. IF(LABSO.EQ.0) THEN
  165. XVAL =VELCHE(ID,IB)
  166. ELSE
  167. XVAL =ABS(VELCHE(ID,IB))
  168. ENDIF
  169. IF((KPLUS.EQ. 1.AND.XVAL.GT.PGRAND).
  170. $ OR.(KPLUS.EQ.-1.AND.XVAL.LT.PGRAND)) THEN
  171. IF (IPLACE .NE. 0) THEN
  172. MAXSOU = IA
  173. MAXNEL= IB
  174. MAXNBP = ID
  175. MAXCO = IC
  176. END IF
  177. PGRAND = XVAL
  178. END IF
  179. 730 CONTINUE
  180. C
  181. END IF
  182. C
  183. 720 CONTINUE
  184. C
  185. 100 CONTINUE
  186. C
  187. *
  188. * -- A-T-ON OBTENU UN MAXIMUM ? --
  189. *
  190. IF (IDEB.EQ.0) THEN
  191. * SOIT LE 'MCHAML' EST VIDE, SOIT LE 'LISTMOTS' CONTIENT DES
  192. * NOMS DE TYPE TELS QUE, ETANT DONNE LA VALEUR DU MOT-CLE,
  193. * TOUTES LES COMPOSANTES DU 'CHPOINT' SONT EXCLUES.
  194. if (labso.eq.0) then
  195. NUMERR = 156
  196. CALL ERREUR (NUMERR)
  197. RETURN
  198. endif
  199. pgrand=0.d0
  200. END IF
  201. C
  202. END
  203.  
  204.  
  205.  

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