Télécharger maxim1.eso

Retour à la liste

Numérotation des lignes :

  1. C MAXIM1 SOURCE PV 17/12/20 21:15:25 9674
  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. SEGDES,MLMOTS
  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. SEGDES,MPOVAL
  189. SEGDES,MSOUPO
  190. *
  191. 100 CONTINUE
  192. * END DO
  193. *
  194. SEGDES,MCHPOI
  195. IF (IPLMOT .NE. 0) THEN
  196. MLMOTS = IPLMOT
  197. SEGDES,MLMOTS
  198. END IF
  199. IF (IPLACE .NE. 0) THEN
  200. MTEMP2 = IPLACE
  201. SEGDES,MTEMP2
  202. END IF
  203. *
  204. * -- A-T-ON OBTENU UN MAXIMUM ? --
  205. *
  206. IF (AGRAND .LT. 0.) THEN
  207. * SOIT LE 'CHPOINT' EST VIDE, SOIT LE 'LISTMOTS' CONTIENT DES
  208. * NOMS DE TYPE TELS QUE, ETANT DONNE LA VALEUR DU MOT-CLE,
  209. * TOUTES LES COMPOSANTES DU 'CHPOINT' SONT EXCLUES.
  210. CALL ERREUR (156)
  211. RETURN
  212. END IF
  213. *
  214. END
  215.  
  216.  
  217.  
  218.  

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