C MAXIMU SOURCE CHAT 11/11/09 21:15:01 7187 SUBROUTINE MAXIMU(KPLUS) ************************************************************************ * * M A X I M U * ----------- * * SOUS-PROGRAMME ASSOCIE AUX OPERATEURS : * MAXI ( KPLUS = 1 ) * MINI ( KPLUS =-1 ) * * FONCTION: * --------- * * DETERMINER LA PLUS GRANDE VALEUR D'UN OBJET (QUAND CELA A UN * SENS). * * PHRASE D'APPEL (EN GIBIANE): * ---------------------------- * * |(AVEC)| * GRANDVAL = MAXIMUM OBJ (| | COMPOS ) ; * | SANS | * * LES PARENTHESES INDIQUANT DES ARGUMENTS FACULTATIFS. * * OPERANDES ET RESULTATS: * ----------------------- * * OBJ TYPE_1 OBJET DONT ON CHERCHE LA PLUS GRANDE VALEUR. * GRANDVAL TYPE_2 PLUS GRANDE VALEUR EXTRAITE DE "OBJ". * CETTE "PLUS GRANDE VALEUR" EST LA PLUS * GRANDE EN VALEUR ABSOLUE, MAIS ELLE EST * RETOURNEE AVEC SON SIGNE. * AVEC 'MOT ' MOT-CLE INDIQUANT QUE L'ON REGARDE * UNIQUEMENT,DANS LA RECHERCHE DU MAXIMUM, * LES VALEURS ASSOCIEES AUX COMPOSANTES CITEES * DANS "COMPOS". * C'EST L'OPTION PAR DEFAUT. * SANS 'MOT ' MOT-CLE INDIQUANT QUE L'ON EXCLUT, DANS LA * RECHERCHE DU MAXIMUM, LES VALEURS ASSOCIEES * AUX COMPOSANTES CITEES DANS "COMPOS". * COMPOS 'LISTMOTS' LISTE DES NOMS DES COMPOSANTES COMPRISES * OU EXCLUES. * * SI TYPE_1 = 'CHPOINT', ALORS * . TYPE_2 = 'FLOTTANT', * . LES COMPOSANTES SONT UX,UY,UZ,RX,RY,RZ,LX,... * SI TYPE_1 = 'LISTENTI', ALORS * . TYPE_2 = 'ENTIER', * . ON PRENDS TOUJOURS TOUTES LES COMPOSANTES EN CONSIDERATION. * SI TYPE_1 = 'LISTREEL', ALORS * . TYPE_2 = 'FLOTTANT', * . ON PRENDS TOUJOURS TOUTES LES COMPOSANTES EN CONSIDERATION. * * LEXIQUE: (ORDRE ALPHABETIQUE) * -------- * * IGRAND ENTIER PLUS GRANDE VALEUR EXTRAITE (CAS DE VALEURS * ENTIERES). * IPLMOT ENTIER POINTEUR DE L'OBJET "COMPOS". * IPOINT ENTIER POINTEUR DE L'OBJET "OBJ". * IPOS ENTIER NUMERO D'ORDRE DU TYPE DE L'OBJET "OBJ" DANS LA * LISTE CONTENUE DANS "LISTYP". * LISTYP ENTIER CONTIENT LES NOMS DES DIFFERENTS TYPES D'OBJET * DONT ON PEUT RECHERCHER LA PLUS GRANDE VALEUR. * MOTCLE ENTIER CONTIENT LA CHAINE DE CARACTERES 'AVEC' OU * 'SANS'. * NBTYPE ENTIER NOMBRE DE NOMS DANS "LISTYP". * PGRAND REEL DP PLUS GRANDE VALEUR EXTRAITE (CAS DE VALEURS * REELLES). * * MODE DE FONCTIONNEMENT: * ----------------------- * * APPEL D'UN SOUS-PROGRAMME DISTINCT SELON LE TYPE DE L'OBJET "OBJ". * * SOUS-PROGRAMMES APPELES: * ------------------------ * * LIRE, LIRTYP, ECRIRE, MAXIN1, MAXIN2, MAXIN3,MAXICH * * AUTEUR, DATE DE CREATION: * ------------------------- * * PASCAL MANIGOT 5 NOVEMBRE 1984 * * "MAXIMUM D'UN LISTENTI" AJOUTE LE 19 FEVRIER 1985 (P. MANIGOT) * "MAXIMUM D'UN LISTREEL" AJOUTE LE 16 AVRIL 1985 (P. MANIGOT) * * LANGAGE: * -------- * * FORTRAN77 + EXTENSION: CARACTERES MIS DANS DES ENTIERS * ************************************************************************ * IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) * -INC CCOPTIO * PARAMETER (NBTYPE = 5, NBMOT = 3, NBMO2 = NBMOT-1) * CHARACTER*8 LISTYP(NBTYPE),MONTYP CHARACTER*4 LISMO(NBMOT) * CHARACTER*4 MOTCLE * DATA LISTYP / 'CHPOINT ','LISTENTI','LISTREEL','MCHAML ', & 'EVOLUTIO' / DATA LISMO/'AVEC','SANS','ABS '/ * * -- LECTURE DU MOT-CLE -- * LABSO=0 CALL LIRMOT (LISMO,NBMOT,IPLAC,0) IF(IPLAC.EQ.3) THEN LABSO=1 CALL LIRMOT (LISMO,NBMO2,IPLAC,0) ENDIF ICODE = 0 CALL LIROBJ ('LISTMOTS',IPLMOT,ICODE,IRETOU) IF (IPLAC.EQ. 0) THEN MOTCLE = ' ' ELSE MOTCLE=LISMO(IPLAC) END IF * * -- LECTURE DE LA LISTE DE TYPES DE COMPOSANTE -- * IF (IRETOU .EQ. 0) THEN IPLMOT = 0 ELSE IF (MOTCLE .EQ. ' ') THEN * PAR DEFAUT, LES COMPOSANTES NOMMEES SONT LES COMPOSANTES * PRISES EN COMPTE (ET NON PAS LES COMPOSANTES EXCLUES): MOTCLE = 'AVEC' END IF * * -- LECTURE DE L'OBJET -- * NBTYP = NBTYPE ICODE = 1 CALL QUETYP(MONTYP,0,IRETOU) IF (IRETOU.EQ.0) THEN CALL ERREUR(533) RETURN ENDIF DO 5 IPOS=1,NBTYP IF (MONTYP.EQ.LISTYP(IPOS)) GOTO 6 5 CONTINUE MOTERR(1:8)=MONTYP CALL ERREUR(39) RETURN 6 CONTINUE CALL LIROBJ(MONTYP,IPOINT,1,IRETOU) if( ipos.eq.2.or.ipos.eq.3) then CALL LIROBJ(MONTYP,IPOINT2,0,IRETOU) if( iretou.ne.0) then call maxin6(ipoint,ipoint2,ipoint3,montyp,kplus) if(ierr.eq.0)call ecrobj(montyp,ipoint3) return endif endif IF (IERR .NE. 0) RETURN * * -- RECHERCHE DU MAXIMUM -- * IF (IPOS .EQ. 1) THEN * * RECHERCHE DU MAXIMUM D'UN "CHPOINT": IPLACE = 0 CALL MAXIN1 (IPOINT,IPLMOT,MOTCLE,IPLACE,PGRAND,KPLUS,LABSO) IF (IERR .NE. 0) RETURN CALL ECRREE (PGRAND) * ELSE IF (IPOS .EQ. 2) THEN * * RECHERCHE DU MAXIMUM D'UN 'LISTENTI': CALL MAXIN2 (IPOINT, IPLACE,IGRAND,KPLUS,LABSO) IF (IERR .NE. 0) RETURN CALL ECRENT (IGRAND) * ELSE IF (IPOS .EQ. 3) THEN * * RECHERCHE DU MAXIMUM D'UN 'LISTREEL': CALL MAXIN3 (IPOINT, IPLACE,PGRAND,KPLUS,LABSO) IF (IERR .NE. 0) RETURN CALL ECRREE (PGRAND) * ELSE IF (IPOS .EQ. 4) THEN * * RECHERCHE DU MAXIMUM D'UN "MCHAML": IPLACE = 0 CALL MAXICH (IPOINT,IPLMOT,MOTCLE,IPLACE,PGRAND,KPLUS,LABSO) IF (IERR .NE. 0) RETURN CALL ECRREE (PGRAND) * ELSE IF (IPOS .EQ. 5) THEN * * RECHERCHE DU MAXIMUM D'UNE "EVOLUTIO": IPLACE = 0 CALL MAXIN4 (IPOINT,IPLACE,AGRAND,OGRAND,KPLUS,LABSO,IGRAND, &JGRAND) IF (IERR .NE. 0) RETURN if(igrand.eq.0.and.jgrand.eq.0) then CALL ECRREE (OGRAND) CALL ECRREE (AGRAND) CALL ECRENT(IPLACE) else CALL ECROBJ('LISTREEL',JGRAND) CALL ECROBJ('LISTREEL',IGRAND) CALL ECROBJ('LISTENTI',IPLACE) endif END IF * RETURN END