Télécharger maxim1.eso

Retour à la liste

Numérotation des lignes :

  1. C MAXIM1 SOURCE CHAT 05/01/13 01:36:13 5004
  2. SUBROUTINE MAXIM1 (IPCHPO,IPLMOT,MOTCLE,IPLACE,PGRAND)
  3. ************************************************************************
  4. *
  5. * M A X I M 1
  6. * -----------
  7. *
  8. * FONCTION:
  9. * ---------
  10. *
  11. * RECHERCHER LA PLUS GRANDE VALEUR D'UN 'CHPOINT'.
  12. *
  13. * MODE D'APPEL:
  14. * -------------
  15. *
  16. * CALL MAXIM1 (IPCHPO,IPLMOT,MOTCLE,IPLACE,PGRAND)
  17. *
  18. * ARGUMENTS: (E)=ENTREE (S)=SORTIE
  19. * ----------
  20. *
  21. * CE SOUS-PROGRAMME UTILISE EVENTUELLEMENT UN SEGMENT "MTEMP2"
  22. * CREE PAR LE PROGRAMME APPELANT.
  23. *
  24. * IPCHPO ENTIER (E) POINTEUR SUR UN 'CHPOINT'.
  25. * IPLMOT ENTIER (E) POINTEUR SUR UN 'LISTMOTS', OU BIEN
  26. * NOMBRE EGAL A "0", SI L'ON PREND EN
  27. * CONSIDERATION TOUTES LES COMPOSANTES.
  28. * MOTCLE CHARACTER (E) INDIQUE PAR SON CONTENU ('AVEC' OU 'SANS')
  29. * SI LES NOMS CONTENUS DANS L'OBJET
  30. * 'LISTMOTS' SONT LES NOMS DES COMPOSANTES
  31. * A CONSIDERER ('AVEC') OU, AU CONTRAIRE,
  32. * A EXCLURE ('SANS') LORS DE LA RECHERCHE
  33. * DU MAXIMUM.
  34. * CONTENU SANS IMPORTANCE SI IPLMOT = 0 .
  35. * IPLACE ENTIER (E) POINTEUR DU SEGMENT "MTEMP2" DONNANT LA
  36. * PLACE DU MAXIMUM DANS LE CHPOINT.
  37. * = 0 SI CETTE PLACE N'EST PAS DEMANDEE.
  38. * SINON, UN SEGMENT "MTEMP2" A ETE CREE DANS
  39. * LE PROGRAMME APPELANT POUR METTRE "MAXSOU",
  40. * "MAXN" ET "MAXNC".
  41. * PGRAND REEL DP (S) PLUS GRANDE VALEUR (EN VALEUR ABSOLUE)
  42. * EXTRAITE DU 'CHPOINT'.
  43. * CETTE VALEUR EST RETOURNEE AVEC SON SIGNE.
  44. *
  45. * DICTIONNAIRE DES VARIABLES: (ORDRE ALPHABETIQUE)
  46. * ---------------------------
  47. *
  48. * AGRAND REEL DP VALEUR ABSOLUE DE "PGRAND".
  49. * DEDANS LOGIQUE INDIQUE PAR .TRUE. OU .FALSE. SI UN TYPE DE
  50. * COMPOSANTE DONNE DU 'CHPOINT' FAIT PARTIE OU
  51. * NON DES TYPES NOMMES DANS L'OBJET DE POINTEUR
  52. * "IPLMOT".
  53. * MAXN ENTIER ) VALEURS RESPECTIVES DE "N", "NC" ET "MSOUPO"
  54. * MAXNC ENTIER )) AU NIVEAU DU MAXIMUM DU CHPOINT. VOIR
  55. * MAXSOU ENTIER ) L'OBJET 'CHPOINT' POUR LA DEFINITION DES
  56. * VARIABLES SUS-NOMMEES.
  57. * NBRMOT ENTIER NOMBRE DE TYPES NOMMES DANS L'OBJET DE POINTEUR
  58. * "IPLMOT".
  59. * TRUFAL LOGIQUE CONTIENT LA VALEUR QUI DOIT ETRE DANS "DEDANS"
  60. * POUR FAIRE LA RECHERCHE DU MAXIMUM.
  61. *
  62. * SOUS-PROGRAMMES APPELES:
  63. * ------------------------
  64. *
  65. * PARMI
  66. *
  67. * AUTEUR, DATE DE CREATION:
  68. * -------------------------
  69. *
  70. * PASCAL MANIGOT 5 NOVEMBRE 1984
  71. *
  72. * LANGAGE:
  73. * --------
  74. *
  75. * ESOPE + FORTRAN77 + EXTENSION: CARACTERES MIS DANS DES ENTIERS
  76. *
  77. ************************************************************************
  78. *
  79. IMPLICIT INTEGER(I-N)
  80. -INC CCOPTIO
  81. -INC SMCHPOI
  82. -INC SMLMOTS
  83. *
  84. REAL*8 PGRAND,AGRAND
  85. CHARACTER*4 MOTCLE
  86. *
  87. LOGICAL DEDANS,TRUFAL
  88. *
  89. SEGMENT/MTEMP2/ (MAXSOU,MAXN,MAXNC)
  90. *
  91. *
  92. *
  93. IF (IPLMOT .EQ. 0) THEN
  94. *
  95. DEDANS = .TRUE.
  96. TRUFAL = DEDANS
  97. *
  98. ELSE
  99. *
  100. IF (MOTCLE .EQ. 'AVEC') THEN
  101. TRUFAL = .TRUE.
  102. ELSE IF (MOTCLE .EQ. 'SANS') THEN
  103. TRUFAL = .FALSE.
  104. ELSE
  105. * MOT-CLE NON RECONNU:
  106. MOTERR(1:4)=MOTCLE
  107. CALL ERREUR(7)
  108. RETURN
  109. END IF
  110. *
  111. MLMOTS = IPLMOT
  112. SEGACT,MLMOTS
  113. NBRMOT = MOTS(/2)
  114. SEGDES,MLMOTS
  115. *
  116. END IF
  117. *
  118. * RQ: A CE NIVEAU, "MOTCLE" EST DIFFERENT DE "MOCLE1" ET DE "MOCLE2"
  119. * SI ET SEULEMENT SI IPLMOT = 0 .
  120. *
  121. *
  122. MCHPOI = IPCHPO
  123. SEGACT,MCHPOI
  124. NSOUPO = IPCHP(/1)
  125. AGRAND = -1.D0
  126. PGRAND = 0.D0
  127. *
  128. * pour l'optimiseur
  129. mtemp2=mchpoi
  130. IF (IPLACE .NE. 0) THEN
  131. MTEMP2 = IPLACE
  132. SEGACT,MTEMP2*MOD
  133. MAXSOU = 1
  134. MAXN = 1
  135. MAXNC = 1
  136. END IF
  137. *
  138. IF (IPLMOT .NE. 0) THEN
  139. MLMOTS = IPLMOT
  140. SEGACT,MLMOTS
  141. END IF
  142. *
  143. * -- RECHERCHE DU MAXIMUM --
  144. *
  145. DO 100 IB100=1,NSOUPO
  146. *
  147. MSOUPO = IPCHP(IB100)
  148. SEGACT,MSOUPO
  149. NC = NOCOMP(/2)
  150. MPOVAL = IPOVAL
  151. SEGACT,MPOVAL
  152. N = VPOCHA(/1)
  153. *
  154. DO 120 IB120=1,NC
  155. *
  156. IF (IPLMOT .NE. 0) THEN
  157. CALL PARMI (NOCOMP(IB120),MOTS,NBRMOT, DEDANS)
  158. END IF
  159. *
  160. * SI LA COMPOSANTE NOCOMP(IB120) FAIT PARTIE DES COMPOSANTES
  161. * RETENUES POUR LA RECHERCHE DU MAXIMUM, ALORS...
  162. ** IF (DEDANS .EQV. TRUFAL) THEN
  163. ** (LIGNE CI-DESSUS INCOMPRISE PAR ESOPE 4.1.1 (MARS 84) )
  164. IF((DEDANS.AND.TRUFAL).OR.((.NOT.DEDANS).AND.(.NOT.TRUFAL)))
  165. & THEN
  166. DO 130 IB130=1,N
  167. * PB CFT115 COMME DANS MAXIN1
  168. MPOVA1=MPOVAL
  169. IF (ABS(MPOVA1.VPOCHA(IB130,IB120)) .GT. AGRAND)
  170. & THEN
  171. IF (IPLACE .NE. 0) THEN
  172. MAXSOU = IB100
  173. MAXN = IB130
  174. MAXNC = IB120
  175. END IF
  176. PGRAND = VPOCHA(IB130,IB120)
  177. AGRAND = ABS(PGRAND)
  178. END IF
  179. 130 CONTINUE
  180. * END DO
  181. END IF
  182. *
  183. 120 CONTINUE
  184. * END DO
  185. *
  186. SEGDES,MPOVAL
  187. SEGDES,MSOUPO
  188. *
  189. 100 CONTINUE
  190. * END DO
  191. *
  192. SEGDES,MCHPOI
  193. IF (IPLMOT .NE. 0) THEN
  194. MLMOTS = IPLMOT
  195. SEGDES,MLMOTS
  196. END IF
  197. IF (IPLACE .NE. 0) THEN
  198. MTEMP2 = IPLACE
  199. SEGDES,MTEMP2
  200. END IF
  201. *
  202. * -- A-T-ON OBTENU UN MAXIMUM ? --
  203. *
  204. IF (AGRAND .LT. 0.) THEN
  205. * SOIT LE 'CHPOINT' EST VIDE, SOIT LE 'LISTMOTS' CONTIENT DES
  206. * NOMS DE TYPE TELS QUE, ETANT DONNE LA VALEUR DU MOT-CLE,
  207. * TOUTES LES COMPOSANTES DU 'CHPOINT' SONT EXCLUES.
  208. CALL ERREUR (156)
  209. RETURN
  210. END IF
  211. *
  212. END
  213.  
  214.  
  215.  

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