Télécharger maxich.eso

Retour à la liste

Numérotation des lignes :

maxich
  1. C MAXICH SOURCE CB215821 21/06/10 21:15:34 11029
  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.  
  64. -INC PPARAM
  65. -INC CCOPTIO
  66. -INC SMCHAML
  67. -INC SMLMOTS
  68. -INC CCNOYAU
  69. *
  70. REAL*8 PGRAND,XVAL
  71. CHARACTER*(*) MOTCLE
  72. CHARACTER*(LONOM) CNOM
  73. *
  74. LOGICAL DEDANS,TRUFAL
  75. *
  76. SEGMENT/MTEMP3/ (MAXSOU,MAXNEL,MAXNBP,MAXCO)
  77. *
  78. *
  79. *
  80. IF (IPLMOT .EQ. 0) THEN
  81. *
  82. DEDANS = .TRUE.
  83. TRUFAL = DEDANS
  84. *
  85. ELSE
  86. *
  87. IF (MOTCLE .EQ.'AVEC') THEN
  88. TRUFAL = .TRUE.
  89. ELSE IF (MOTCLE .EQ.'SANS') THEN
  90. TRUFAL = .FALSE.
  91. ELSE
  92. * MOT-CLE NON RECONNU:
  93. MOTERR = MOTCLE
  94. CALL ERREUR(7)
  95. RETURN
  96. ENDIF
  97. *
  98. MLMOTS = IPLMOT
  99. SEGACT,MLMOTS
  100. NBRMOT = MOTS(/2)
  101. *
  102. ENDIF
  103. *
  104. * RQ: A CE NIVEAU, "MOTCLE" EST DIFFERENT DE "MOCLE1" ET DE "MOCLE2"
  105. * SI ET SEULEMENT SI IPLMOT = 0 .
  106. *
  107. *
  108. IDEB=0
  109. PGRAND = 0.D0
  110. *
  111. * pour l'optimiseur
  112. mtemp3=ipchlm
  113. IF (IPLACE .NE. 0) THEN
  114. MTEMP3 = IPLACE
  115. SEGACT,MTEMP3
  116. MAXSOU = 1
  117. MAXNEL = 1
  118. MAXCO = 1
  119. MAXNBP = 1
  120. ENDIF
  121. *
  122. IF (IPLMOT .NE. 0) THEN
  123. MLMOTS = IPLMOT
  124. SEGACT MLMOTS
  125. ENDIF
  126. C
  127. C ON RECUPERE LE CHAMELEM
  128. C
  129. MCHELM=IPCHLM
  130.  
  131.  
  132. NSOUS=ICHAML(/1)
  133. C
  134. C BOUCLE SUR LES SOUS PAQUETS
  135. C
  136. DO 100 IA=1,NSOUS
  137. MCHAML=ICHAML(IA)
  138. NCOELE=NOMCHE(/2)
  139. C
  140. C -- RECHERCHE DU MAXIMUM / MINIMUM --
  141. C
  142. DO 720 IC=1,NCOELE
  143.  
  144. IF(TYPCHE(IC)(1:6) .NE. 'REAL*8')THEN
  145. MOTERR=TYPCHE(IC)
  146. IF(NCOELE .GT. 0)THEN
  147. MOTERR(17:20)=NOMCHE(1)
  148. ENDIF
  149. CALL quenom(CNOM)
  150. MOTERR = MOTERR(1:20)//CNOM
  151. CALL ERREUR(552)
  152. RETURN
  153. ENDIF
  154.  
  155. MELVAL=IELVAL(IC)
  156. NBPTEL=VELCHE(/1)
  157. NEL =VELCHE(/2)
  158.  
  159. IF (IPLMOT .NE. 0) THEN
  160. CALL PARMI (NOMCHE(IC),MOTS,NBRMOT, DEDANS)
  161. ENDIF
  162. C
  163. C SI LA COMPOSANTE NOMCHE(IC) FAIT PARTIE DES COMPOSANTES
  164. C RETENUES POUR LA RECHERCHE DU MAXIMUM, ALORS...
  165. C
  166. IF((DEDANS.AND.TRUFAL).OR.
  167. & ((.NOT.DEDANS).AND.(.NOT.TRUFAL))) THEN
  168. IF(IDEB.EQ.0) THEN
  169. IDEB=1
  170. IF(LABSO.EQ.0) THEN
  171. PGRAND=VELCHE(1,1)
  172. ELSE
  173. PGRAND=ABS(VELCHE(1,1))
  174. ENDIF
  175. ENDIF
  176.  
  177. DO 730 IB=1,NEL
  178. DO 731 ID=1,NBPTEL
  179. IF(LABSO.EQ.0) THEN
  180. XVAL =VELCHE(ID,IB)
  181. ELSE
  182. XVAL =ABS(VELCHE(ID,IB))
  183. ENDIF
  184. IF((KPLUS.EQ. 1.AND.XVAL.GT.PGRAND).OR.
  185. $ (KPLUS.EQ.-1.AND.XVAL.LT.PGRAND)) THEN
  186. IF (IPLACE .NE. 0) THEN
  187. MAXSOU = IA
  188. MAXNEL = IB
  189. MAXNBP = ID
  190. MAXCO = IC
  191. ENDIF
  192. PGRAND = XVAL
  193. ENDIF
  194. 731 CONTINUE
  195. 730 CONTINUE
  196. C
  197. ENDIF
  198. C
  199. 720 CONTINUE
  200. C
  201. 100 CONTINUE
  202. C
  203. *
  204. * -- A-T-ON OBTENU UN MAXIMUM ? --
  205. *
  206. IF (IDEB.EQ.0) THEN
  207. PGRAND=0.D0
  208.  
  209. C On place un soucis avec le numero de l'erreur qu'on pourrait emettre
  210. CALL SOUCIS(156)
  211. ENDIF
  212. C
  213. END
  214.  
  215.  
  216.  
  217.  

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