Sources Esope | Cast3M

maxin1
C MAXIN1    SOURCE    CB215821  20/11/25    13:34:10     10792          
      SUBROUTINE MAXIN1(IPCHPO,IPLMOT,MOTCLE,IPLACE,PGRAND,KPLUS,LABSO)
************************************************************************
*
*                             M A X I N 1
*                             -----------
*
* FONCTION:
* ---------
*
*     RECHERCHER LA PLUS GRANDE VALEUR D'UN 'CHPOINT'.
*
*     COMPLETEMENT INSPIRE DE MAXIM1 QUI RECHERCHE LE MAXIMUM EN
*     VALEUR ABSOLUE   ( VOIR MAXIM1 POUR COMMENTAIRES )
*
*
************************************************************************
*
      IMPLICIT INTEGER(I-N)
 
-INC PPARAM
-INC CCOPTIO
-INC SMCHPOI
-INC SMLMOTS
*
      CHARACTER*(*) MOTCLE
      REAL*8 PGRAND,XVAL
*
      LOGICAL DEDANS,TRUFAL
*
      SEGMENT/MTEMP2/ (MAXSOU,MAXN,MAXNC)
*
*
*
      IF (IPLMOT .EQ. 0) THEN
*
         DEDANS = .TRUE.
         TRUFAL = DEDANS
*
      ELSE
*
         IF     (MOTCLE .EQ. 'AVEC') THEN
            TRUFAL = .TRUE.
         ELSEIF (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 .
*
*
      MCHPOI = IPCHPO
      SEGACT,MCHPOI
      NSOUPO = IPCHP(/1)
      PGRAND = 0.D0
      IDEB=0
*
      MTEMP2 = MCHPOI
      IF (IPLACE .NE. 0) THEN
         MTEMP2 = IPLACE
         SEGACT,MTEMP2
         MAXSOU = 1
         MAXN   = 1
         MAXNC  = 1
      END IF
*
      IF (IPLMOT .NE. 0) THEN
         MLMOTS = IPLMOT
         SEGACT,MLMOTS
      END IF
*
*     -- RECHERCHE DU MAXIMUM --
*
      DO 100 IB100=1,NSOUPO
*
         MSOUPO = IPCHP(IB100)
         SEGACT,MSOUPO
         NC = NOCOMP(/2)
         MPOVAL = IPOVAL
         SEGACT,MPOVAL
         N = VPOCHA(/1)
*
         if (n.gt.0) then
         DO 120 IB120=1,NC
*
            IF (IPLMOT .NE. 0) THEN
               CALL PARMI (NOCOMP(IB120),MOTS,NBRMOT,  DEDANS)
            END IF
*
*           SI LA COMPOSANTE NOCOMP(IB120) FAIT PARTIE DES COMPOSANTES
*           RETENUES POUR LA RECHERCHE DU MAXIMUM, ALORS...
**          IF (DEDANS .EQV. TRUFAL) THEN
**          (LIGNE CI-DESSUS INCOMPRISE PAR ESOPE 4.1.1 (MARS 84) )
            IF((DEDANS.AND.TRUFAL).OR.((.NOT.DEDANS).AND.(.NOT.TRUFAL)))
     &      THEN
*
         IF(IDEB.EQ.0) THEN
         IDEB=1
            IF(LABSO.EQ.0) THEN
                PGRAND=VPOCHA(1,IB120)
            ELSE
                PGRAND=ABS(VPOCHA(1,IB120))
            ENDIF
         ENDIF
*
               DO 130 IB130=1,N
*  A CAUSE D'UNE AGACERIE DU COMPILATEUR CRAY CFT115
                MPOVA1=MPOVAL
             IF(LABSO.EQ.0) THEN
                XVAL = MPOVA1.VPOCHA(IB130,IB120)
             ELSE
                XVAL = ABS(MPOVA1.VPOCHA(IB130,IB120))
             ENDIF
        IF((KPLUS.EQ. 1.AND.XVAL.GT.PGRAND).
     $  OR.(KPLUS.EQ.-1.AND.XVAL.LT.PGRAND))
     $  THEN
                     IF (IPLACE .NE. 0) THEN
                        MAXSOU = IB100
                        MAXN   = IB130
                        MAXNC  = IB120
                     END IF
                     PGRAND = XVAL
        END IF
  130             CONTINUE
*              END DO
            END IF
*
  120       CONTINUE
*        END DO
         endif
*
*
  100    CONTINUE
*     END DO
*
*     -- A-T-ON OBTENU UN MAXIMUM ? --
*
*     IF (IDEB.EQ.0) THEN
*        SOIT LE 'CHPOINT' EST VIDE, SOIT LE 'LISTMOTS' CONTIENT DES
*        NOMS DE TYPE TELS QUE, ETANT DONNE LA VALEUR DU MOT-CLE,
*        TOUTES LES COMPOSANTES DU 'CHPOINT' SONT EXCLUES.
*        NUMERR = 156
*        CALL ERREUR (NUMERR)
*        RETURN
*     END IF
*
      END