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 PPARAM
  81. -INC CCOPTIO
  82. -INC SMCHPOI
  83. -INC SMLMOTS
  84. -INC CCREEL
  85. *
  86. REAL*8 PGRAND,AGRAND
  87. CHARACTER*4 MOTCLE
  88. *
  89. LOGICAL DEDANS,TRUFAL
  90. *
  91. SEGMENT/MTEMP2/ (MAXSOU,MAXN,MAXNC)
  92. *
  93. *
  94. *
  95. IF (IPLMOT .EQ. 0) THEN
  96. *
  97. DEDANS = .TRUE.
  98. TRUFAL = DEDANS
  99. *
  100. ELSE
  101. *
  102. IF (MOTCLE .EQ. 'AVEC') THEN
  103. TRUFAL = .TRUE.
  104. ELSE IF (MOTCLE .EQ. 'SANS') THEN
  105. TRUFAL = .FALSE.
  106. ELSE
  107. * MOT-CLE NON RECONNU:
  108. MOTERR(1:4)=MOTCLE
  109. CALL ERREUR(7)
  110. RETURN
  111. END IF
  112. *
  113. MLMOTS = IPLMOT
  114. SEGACT,MLMOTS
  115. NBRMOT = MOTS(/2)
  116. *
  117. END IF
  118. *
  119. * RQ: A CE NIVEAU, "MOTCLE" EST DIFFERENT DE "MOCLE1" ET DE "MOCLE2"
  120. * SI ET SEULEMENT SI IPLMOT = 0 .
  121. *
  122. *
  123. MCHPOI = IPCHPO
  124. SEGACT,MCHPOI
  125. NSOUPO = IPCHP(/1)
  126. AGRAND = -1.D0
  127. PGRAND = 0.D0
  128. *
  129. * pour l'optimiseur
  130. mtemp2=mchpoi
  131. IF (IPLACE .NE. 0) THEN
  132. MTEMP2 = IPLACE
  133. SEGACT,MTEMP2*MOD
  134. MAXSOU = 1
  135. MAXN = 1
  136. MAXNC = 1
  137. END IF
  138. *
  139. IF (IPLMOT .NE. 0) THEN
  140. MLMOTS = IPLMOT
  141. SEGACT,MLMOTS
  142. END IF
  143. *
  144. * -- RECHERCHE DU MAXIMUM --
  145. *
  146. DO 100 IB100=1,NSOUPO
  147. *
  148. MSOUPO = IPCHP(IB100)
  149. SEGACT,MSOUPO
  150. NC = NOCOMP(/2)
  151. MPOVAL = IPOVAL
  152. SEGACT,MPOVAL
  153. N = VPOCHA(/1)
  154. *
  155. DO 120 IB120=1,NC
  156. *
  157. IF (IPLMOT .NE. 0) THEN
  158. CALL PARMI (NOCOMP(IB120),MOTS,NBRMOT, DEDANS)
  159. END IF
  160. *
  161. * SI LA COMPOSANTE NOCOMP(IB120) FAIT PARTIE DES COMPOSANTES
  162. * RETENUES POUR LA RECHERCHE DU MAXIMUM, ALORS...
  163. ** IF (DEDANS .EQV. TRUFAL) THEN
  164. ** (LIGNE CI-DESSUS INCOMPRISE PAR ESOPE 4.1.1 (MARS 84) )
  165. IF((DEDANS.AND.TRUFAL).OR.((.NOT.DEDANS).AND.(.NOT.TRUFAL)))
  166. & THEN
  167. DO 130 IB130=1,N
  168. * PB CFT115 COMME DANS MAXIN1
  169. MPOVA1=MPOVAL
  170. IF (ABS(MPOVA1.VPOCHA(IB130,IB120)) .GT. AGRAND*
  171. > (1.D0-XZPREC))
  172. & THEN
  173. IF (IPLACE .NE. 0) THEN
  174. MAXSOU = IB100
  175. MAXN = IB130
  176. MAXNC = IB120
  177. END IF
  178. PGRAND = VPOCHA(IB130,IB120)
  179. AGRAND = ABS(PGRAND)
  180. END IF
  181. 130 CONTINUE
  182. * END DO
  183. END IF
  184. *
  185. 120 CONTINUE
  186. * END DO
  187. *
  188. *
  189. 100 CONTINUE
  190. * END DO
  191. *
  192. IF (IPLMOT .NE. 0) THEN
  193. MLMOTS = IPLMOT
  194. END IF
  195. IF (IPLACE .NE. 0) THEN
  196. MTEMP2 = IPLACE
  197. SEGDES,MTEMP2
  198. END IF
  199. *
  200. * -- A-T-ON OBTENU UN MAXIMUM ? --
  201. *
  202. IF (AGRAND .LT. 0.) THEN
  203. * SOIT LE 'CHPOINT' 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. CALL ERREUR (156)
  207. RETURN
  208. END IF
  209. *
  210. END
  211.  
  212.  
  213.  
  214.  
  215.  

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