Télécharger maxim1.eso

Retour à la liste

Numérotation des lignes :

  1. C MAXIM1 SOURCE CB215821 19/07/09 21:15:10 10252
  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. -INC CCREEL
  84. *
  85. REAL*8 PGRAND,AGRAND
  86. CHARACTER*4 MOTCLE
  87. *
  88. LOGICAL DEDANS,TRUFAL
  89. *
  90. SEGMENT/MTEMP2/ (MAXSOU,MAXN,MAXNC)
  91. *
  92. *
  93. *
  94. IF (IPLMOT .EQ. 0) THEN
  95. *
  96. DEDANS = .TRUE.
  97. TRUFAL = DEDANS
  98. *
  99. ELSE
  100. *
  101. IF (MOTCLE .EQ. 'AVEC') THEN
  102. TRUFAL = .TRUE.
  103. ELSE IF (MOTCLE .EQ. 'SANS') THEN
  104. TRUFAL = .FALSE.
  105. ELSE
  106. * MOT-CLE NON RECONNU:
  107. MOTERR(1:4)=MOTCLE
  108. CALL ERREUR(7)
  109. RETURN
  110. END IF
  111. *
  112. MLMOTS = IPLMOT
  113. SEGACT,MLMOTS
  114. NBRMOT = MOTS(/2)
  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. > (1.D0-XZPREC))
  171. & THEN
  172. IF (IPLACE .NE. 0) THEN
  173. MAXSOU = IB100
  174. MAXN = IB130
  175. MAXNC = IB120
  176. END IF
  177. PGRAND = VPOCHA(IB130,IB120)
  178. AGRAND = ABS(PGRAND)
  179. END IF
  180. 130 CONTINUE
  181. * END DO
  182. END IF
  183. *
  184. 120 CONTINUE
  185. * END DO
  186. *
  187. *
  188. 100 CONTINUE
  189. * END DO
  190. *
  191. IF (IPLMOT .NE. 0) THEN
  192. MLMOTS = IPLMOT
  193. END IF
  194. IF (IPLACE .NE. 0) THEN
  195. MTEMP2 = IPLACE
  196. SEGDES,MTEMP2
  197. END IF
  198. *
  199. * -- A-T-ON OBTENU UN MAXIMUM ? --
  200. *
  201. IF (AGRAND .LT. 0.) THEN
  202. * SOIT LE 'CHPOINT' EST VIDE, SOIT LE 'LISTMOTS' CONTIENT DES
  203. * NOMS DE TYPE TELS QUE, ETANT DONNE LA VALEUR DU MOT-CLE,
  204. * TOUTES LES COMPOSANTES DU 'CHPOINT' SONT EXCLUES.
  205. CALL ERREUR (156)
  206. RETURN
  207. END IF
  208. *
  209. END
  210.  
  211.  
  212.  
  213.  
  214.  

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