Sources Esope | Cast3M

maxich
C MAXICH    SOURCE    CB215821  21/06/10    21:15:34     11029          
      SUBROUTINE MAXICH(IPCHLM,IPLMOT,MOTCLE,IPLACE,PGRAND,KPLUS,LABSO)
************************************************************************
*
*                             M A X I C H
*                             -----------
*
* FONCTION:
* ---------
*
*     RECHERCHER LA PLUS GRANDE VALEUR D'UN 'MCHAML'.
*
* MODE D'APPEL:
* -------------
*
*     CALL MAXICH (IPCHLM,IPLMOT,MOTCLE,IPLACE,PGRAND)
*
* ARGUMENTS:   (E)=ENTREE   (S)=SORTIE
* ----------
*
*
*     IPCHLM  ENTIER    (E)  POINTEUR SUR UN 'MCHAML'.
*     IPLMOT  ENTIER    (E)  POINTEUR SUR UN 'LISTMOTS', OU BIEN
*                            NOMBRE EGAL A "0", SI L'ON PREND EN
*                            CONSIDERATION TOUTES LES COMPOSANTES.
*     MOTCLE  ENTIER    (E)  INDIQUE PAR SON CONTENU ('AVEC' OU 'SANS')
*                            SI LES NOMS CONTENUS DANS L'OBJET
*                            'LISTMOTS' SONT LES NOMS DES COMPOSANTES
*                            A CONSIDERER ('AVEC') OU, AU CONTRAIRE,
*                            A EXCLURE ('SANS') LORS DE LA RECHERCHE
*                            DU MAXIMUM.
*                            CONTENU SANS IMPORTANCE SI  IPLMOT = 0 .
*     IPLACE  ENTIER    (E)  POINTEUR DU SEGMENT "MTEMP2" DONNANT LA
*                            PLACE DU MAXIMUM DANS LE CHPOINT.
*                            = 0  SI CETTE PLACE N'EST PAS DEMANDEE.
*                            SINON, UN SEGMENT "MTEMP2" A ETE CREE DANS
*                            LE PROGRAMME APPELANT POUR METTRE "MAXSOU",
*                            "MAXN" ET "MAXNC".
*     PGRAND  REEL DP   (S)  PLUS GRANDE VALEUR (EN VALEUR ABSOLUE)
*                            EXTRAITE DU 'CHAMELEM'.
*                            CETTE VALEUR EST RETOURNEE AVEC SON SIGNE.
*
* DICTIONNAIRE DES VARIABLES: (ORDRE ALPHABETIQUE)
* ---------------------------
*
*     DEDANS  LOGIQUE   INDIQUE PAR .TRUE. OU .FALSE. SI UN TYPE DE
*                       COMPOSANTE DONNE DU 'CHPOINT' FAIT PARTIE OU
*                       NON DES TYPES NOMMES DANS L'OBJET DE POINTEUR
*                       "IPLMOT".
*     NBRMOT  ENTIER    NOMBRE DE TYPES NOMMES DANS L'OBJET DE POINTEUR
*                       "IPLMOT".
*     TRUFAL  LOGIQUE   CONTIENT LA VALEUR QUI DOIT ETRE DANS "DEDANS"
*                       POUR FAIRE LA RECHERCHE DU MAXIMUM.
*
* SOUS-PROGRAMMES APPELES:
* ------------------------
*
*     PARMI
*
************************************************************************
*
      IMPLICIT INTEGER(I-N)
 
-INC PPARAM
-INC CCOPTIO
-INC SMCHAML
-INC SMLMOTS
-INC CCNOYAU
*
      REAL*8 PGRAND,XVAL
      CHARACTER*(*) MOTCLE
      CHARACTER*(LONOM) CNOM
*
      LOGICAL DEDANS,TRUFAL
*
      SEGMENT/MTEMP3/ (MAXSOU,MAXNEL,MAXNBP,MAXCO)
*
*
*
      IF (IPLMOT .EQ. 0) THEN
*
         DEDANS = .TRUE.
         TRUFAL = DEDANS
*
      ELSE
*
         IF (MOTCLE .EQ.'AVEC') THEN
            TRUFAL = .TRUE.
         ELSE IF (MOTCLE .EQ.'SANS') THEN
            TRUFAL = .FALSE.
         ELSE
*           MOT-CLE NON RECONNU:
            MOTERR = MOTCLE
            CALL ERREUR(7)
            RETURN
         ENDIF
*
         MLMOTS = IPLMOT
         SEGACT,MLMOTS
         NBRMOT = MOTS(/2)
*
      ENDIF
*
*     RQ: A CE NIVEAU, "MOTCLE" EST DIFFERENT DE "MOCLE1" ET DE "MOCLE2"
*         SI ET SEULEMENT SI  IPLMOT = 0 .
*
*
      IDEB=0
      PGRAND = 0.D0
*
*  pour l'optimiseur
      mtemp3=ipchlm
      IF (IPLACE .NE. 0) THEN
         MTEMP3 = IPLACE
         SEGACT,MTEMP3
         MAXSOU = 1
         MAXNEL = 1
         MAXCO  = 1
         MAXNBP = 1
      ENDIF
*
      IF (IPLMOT .NE. 0) THEN
         MLMOTS = IPLMOT
         SEGACT MLMOTS
      ENDIF
C
C    ON RECUPERE LE CHAMELEM
C
      MCHELM=IPCHLM
 
 
      NSOUS=ICHAML(/1)
C
C     BOUCLE SUR LES SOUS PAQUETS
C
      DO 100 IA=1,NSOUS
         MCHAML=ICHAML(IA)
         NCOELE=NOMCHE(/2)
C
C     -- RECHERCHE DU MAXIMUM / MINIMUM --
C
         DO 720 IC=1,NCOELE
 
            IF(TYPCHE(IC)(1:6) .NE. 'REAL*8')THEN
              MOTERR=TYPCHE(IC)
              IF(NCOELE .GT. 0)THEN
                MOTERR(17:20)=NOMCHE(1)
              ENDIF
              CALL quenom(CNOM)
              MOTERR = MOTERR(1:20)//CNOM
              CALL ERREUR(552)
              RETURN
            ENDIF
 
            MELVAL=IELVAL(IC)
            NBPTEL=VELCHE(/1)
            NEL   =VELCHE(/2)
 
            IF (IPLMOT .NE. 0) THEN
               CALL PARMI (NOMCHE(IC),MOTS,NBRMOT,  DEDANS)
            ENDIF
C
C           SI LA COMPOSANTE NOMCHE(IC) FAIT PARTIE DES COMPOSANTES
C           RETENUES POUR LA RECHERCHE DU MAXIMUM, ALORS...
C
            IF((DEDANS.AND.TRUFAL).OR.
     &        ((.NOT.DEDANS).AND.(.NOT.TRUFAL))) THEN
               IF(IDEB.EQ.0) THEN
                 IDEB=1
                 IF(LABSO.EQ.0) THEN
                   PGRAND=VELCHE(1,1)
                 ELSE
                   PGRAND=ABS(VELCHE(1,1))
                 ENDIF
               ENDIF
 
               DO 730 IB=1,NEL
                 DO 731 ID=1,NBPTEL
                   IF(LABSO.EQ.0) THEN
                     XVAL =VELCHE(ID,IB)
                   ELSE
                     XVAL =ABS(VELCHE(ID,IB))
                   ENDIF
                   IF((KPLUS.EQ. 1.AND.XVAL.GT.PGRAND).OR.
     $                (KPLUS.EQ.-1.AND.XVAL.LT.PGRAND)) THEN
                     IF (IPLACE .NE. 0) THEN
                        MAXSOU = IA
                        MAXNEL = IB
                        MAXNBP = ID
                        MAXCO  = IC
                     ENDIF
                     PGRAND = XVAL
                   ENDIF
  731            CONTINUE
  730          CONTINUE
C
            ENDIF
C
  720       CONTINUE
C
  100 CONTINUE
C
*
*     -- A-T-ON OBTENU UN MAXIMUM ? --
*
      IF (IDEB.EQ.0) THEN
        PGRAND=0.D0
 
C       On place un soucis avec le numero de l'erreur qu'on pourrait emettre
        CALL SOUCIS(156)
      ENDIF
C
      END