Télécharger la plaquette Cast3M


fr en

Télécharger maxim1.eso

Retour à la liste

Numérotation des lignes : 

maxim1

  1. C MAXIM1    SOURCE    CB215821  23/07/12    21:15:08     11704          
  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*(*) 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=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.  
  216.  
  217.  

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