Numérotation des lignes :

C MAXIN1    SOURCE    CB215821  19/07/09    21:15:11     10252                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*4 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(1:4)=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

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