1 : C MAXIMU SOURCE CHAT 11/11/09 21:15:01 7187 2 : SUBROUTINE MAXIMU(KPLUS) 3 : ************************************************************************ 4 : * 5 : * M A X I M U 6 : * ----------- 7 : * 8 : * SOUS-PROGRAMME ASSOCIE AUX OPERATEURS : 9 : * MAXI ( KPLUS = 1 ) 10 : * MINI ( KPLUS =-1 ) 11 : * 12 : * FONCTION: 13 : * --------- 14 : * 15 : * DETERMINER LA PLUS GRANDE VALEUR D'UN OBJET (QUAND CELA A UN 16 : * SENS). 17 : * 18 : * PHRASE D'APPEL (EN GIBIANE): 19 : * ---------------------------- 20 : * 21 : * |(AVEC)| 22 : * GRANDVAL = MAXIMUM OBJ (| | COMPOS ) ; 23 : * | SANS | 24 : * 25 : * LES PARENTHESES INDIQUANT DES ARGUMENTS FACULTATIFS. 26 : * 27 : * OPERANDES ET RESULTATS: 28 : * ----------------------- 29 : * 30 : * OBJ TYPE_1 OBJET DONT ON CHERCHE LA PLUS GRANDE VALEUR. 31 : * GRANDVAL TYPE_2 PLUS GRANDE VALEUR EXTRAITE DE "OBJ". 32 : * CETTE "PLUS GRANDE VALEUR" EST LA PLUS 33 : * GRANDE EN VALEUR ABSOLUE, MAIS ELLE EST 34 : * RETOURNEE AVEC SON SIGNE. 35 : * AVEC 'MOT ' MOT-CLE INDIQUANT QUE L'ON REGARDE 36 : * UNIQUEMENT,DANS LA RECHERCHE DU MAXIMUM, 37 : * LES VALEURS ASSOCIEES AUX COMPOSANTES CITEES 38 : * DANS "COMPOS". 39 : * C'EST L'OPTION PAR DEFAUT. 40 : * SANS 'MOT ' MOT-CLE INDIQUANT QUE L'ON EXCLUT, DANS LA 41 : * RECHERCHE DU MAXIMUM, LES VALEURS ASSOCIEES 42 : * AUX COMPOSANTES CITEES DANS "COMPOS". 43 : * COMPOS 'LISTMOTS' LISTE DES NOMS DES COMPOSANTES COMPRISES 44 : * OU EXCLUES. 45 : * 46 : * SI TYPE_1 = 'CHPOINT', ALORS 47 : * . TYPE_2 = 'FLOTTANT', 48 : * . LES COMPOSANTES SONT UX,UY,UZ,RX,RY,RZ,LX,... 49 : * SI TYPE_1 = 'LISTENTI', ALORS 50 : * . TYPE_2 = 'ENTIER', 51 : * . ON PRENDS TOUJOURS TOUTES LES COMPOSANTES EN CONSIDERATION. 52 : * SI TYPE_1 = 'LISTREEL', ALORS 53 : * . TYPE_2 = 'FLOTTANT', 54 : * . ON PRENDS TOUJOURS TOUTES LES COMPOSANTES EN CONSIDERATION. 55 : * 56 : * LEXIQUE: (ORDRE ALPHABETIQUE) 57 : * -------- 58 : * 59 : * IGRAND ENTIER PLUS GRANDE VALEUR EXTRAITE (CAS DE VALEURS 60 : * ENTIERES). 61 : * IPLMOT ENTIER POINTEUR DE L'OBJET "COMPOS". 62 : * IPOINT ENTIER POINTEUR DE L'OBJET "OBJ". 63 : * IPOS ENTIER NUMERO D'ORDRE DU TYPE DE L'OBJET "OBJ" DANS LA 64 : * LISTE CONTENUE DANS "LISTYP". 65 : * LISTYP ENTIER CONTIENT LES NOMS DES DIFFERENTS TYPES D'OBJET 66 : * DONT ON PEUT RECHERCHER LA PLUS GRANDE VALEUR. 67 : * MOTCLE ENTIER CONTIENT LA CHAINE DE CARACTERES 'AVEC' OU 68 : * 'SANS'. 69 : * NBTYPE ENTIER NOMBRE DE NOMS DANS "LISTYP". 70 : * PGRAND REEL DP PLUS GRANDE VALEUR EXTRAITE (CAS DE VALEURS 71 : * REELLES). 72 : * 73 : * MODE DE FONCTIONNEMENT: 74 : * ----------------------- 75 : * 76 : * APPEL D'UN SOUS-PROGRAMME DISTINCT SELON LE TYPE DE L'OBJET "OBJ". 77 : * 78 : * SOUS-PROGRAMMES APPELES: 79 : * ------------------------ 80 : * 81 : * LIRE, LIRTYP, ECRIRE, MAXIN1, MAXIN2, MAXIN3,MAXICH 82 : * 83 : * AUTEUR, DATE DE CREATION: 84 : * ------------------------- 85 : * 86 : * PASCAL MANIGOT 5 NOVEMBRE 1984 87 : * 88 : * "MAXIMUM D'UN LISTENTI" AJOUTE LE 19 FEVRIER 1985 (P. MANIGOT) 89 : * "MAXIMUM D'UN LISTREEL" AJOUTE LE 16 AVRIL 1985 (P. MANIGOT) 90 : * 91 : * LANGAGE: 92 : * -------- 93 : * 94 : * FORTRAN77 + EXTENSION: CARACTERES MIS DANS DES ENTIERS 95 : * 96 : ************************************************************************ 97 : * 98 : IMPLICIT INTEGER(I-N) 99 : IMPLICIT REAL*8(A-H,O-Z) 100 : * 101 : -INC CCOPTIO 102 : * 103 : PARAMETER (NBTYPE = 5, NBMOT = 3, NBMO2 = NBMOT-1) 104 : * 105 : CHARACTER*8 LISTYP(NBTYPE),MONTYP 106 : CHARACTER*4 LISMO(NBMOT) 107 : * 108 : CHARACTER*4 MOTCLE 109 : * 110 : DATA LISTYP / 'CHPOINT ','LISTENTI','LISTREEL','MCHAML ', 111 : & 'EVOLUTIO' / 112 : DATA LISMO/'AVEC','SANS','ABS '/ 113 : * 114 : * -- LECTURE DU MOT-CLE -- 115 : * 116 : LABSO=0 116 : CALL LIRMOT (LISMO,NBMOT,IPLAC,0) 117 : IF(IPLAC.EQ.3) THEN 118 : LABSO=1 118 : CALL LIRMOT (LISMO,NBMO2,IPLAC,0) 119 : ENDIF 120 : ICODE = 0 120 : CALL LIROBJ ('LISTMOTS',IPLMOT,ICODE,IRETOU) 121 : IF (IPLAC.EQ. 0) THEN 122 : MOTCLE = ' ' 123 : ELSE 124 : MOTCLE=LISMO(IPLAC) 125 : END IF 126 : * 127 : * -- LECTURE DE LA LISTE DE TYPES DE COMPOSANTE -- 128 : * 129 : IF (IRETOU .EQ. 0) THEN 130 : IPLMOT = 0 131 : ELSE IF (MOTCLE .EQ. ' ') THEN 132 : * PAR DEFAUT, LES COMPOSANTES NOMMEES SONT LES COMPOSANTES 133 : * PRISES EN COMPTE (ET NON PAS LES COMPOSANTES EXCLUES): 134 : MOTCLE = 'AVEC' 135 : END IF 136 : * 137 : * -- LECTURE DE L'OBJET -- 138 : * 139 : NBTYP = NBTYPE 140 : ICODE = 1 140 : CALL QUETYP(MONTYP,0,IRETOU) 141 : IF (IRETOU.EQ.0) THEN 141 : CALL ERREUR(533) 142 : RETURN 143 : ENDIF 144 : DO 5 IPOS=1,NBTYP 145 : IF (MONTYP.EQ.LISTYP(IPOS)) GOTO 6 146 : 5 CONTINUE 147 : MOTERR(1:8)=MONTYP 147 : CALL ERREUR(39) 148 : RETURN 149 : 6 CONTINUE 149 : CALL LIROBJ(MONTYP,IPOINT,1,IRETOU) 150 : if( ipos.eq.2.or.ipos.eq.3) then 150 : CALL LIROBJ(MONTYP,IPOINT2,0,IRETOU) 151 : if( iretou.ne.0) then 151 : call maxin6(ipoint,ipoint2,ipoint3,montyp,kplus) 151 : if(ierr.eq.0)call ecrobj(montyp,ipoint3) 152 : return 153 : endif 154 : endif 155 : IF (IERR .NE. 0) RETURN 156 : * 157 : * -- RECHERCHE DU MAXIMUM -- 158 : * 159 : IF (IPOS .EQ. 1) THEN 160 : * 161 : * RECHERCHE DU MAXIMUM D'UN "CHPOINT": 162 : IPLACE = 0 162 : CALL MAXIN1 (IPOINT,IPLMOT,MOTCLE,IPLACE,PGRAND,KPLUS,LABSO) 163 : IF (IERR .NE. 0) RETURN 163 : CALL ECRREE (PGRAND) 164 : * 165 : ELSE IF (IPOS .EQ. 2) THEN 166 : * 167 : * RECHERCHE DU MAXIMUM D'UN 'LISTENTI': 167 : CALL MAXIN2 (IPOINT, IPLACE,IGRAND,KPLUS,LABSO) 168 : IF (IERR .NE. 0) RETURN 168 : CALL ECRENT (IGRAND) 169 : * 170 : ELSE IF (IPOS .EQ. 3) THEN 171 : * 172 : * RECHERCHE DU MAXIMUM D'UN 'LISTREEL': 172 : CALL MAXIN3 (IPOINT, IPLACE,PGRAND,KPLUS,LABSO) 173 : IF (IERR .NE. 0) RETURN 173 : CALL ECRREE (PGRAND) 174 : * 175 : ELSE IF (IPOS .EQ. 4) THEN 176 : * 177 : * RECHERCHE DU MAXIMUM D'UN "MCHAML": 178 : IPLACE = 0 178 : CALL MAXICH (IPOINT,IPLMOT,MOTCLE,IPLACE,PGRAND,KPLUS,LABSO) 179 : IF (IERR .NE. 0) RETURN 179 : CALL ECRREE (PGRAND) 180 : * 181 : ELSE IF (IPOS .EQ. 5) THEN 182 : * 183 : * RECHERCHE DU MAXIMUM D'UNE "EVOLUTIO": 184 : IPLACE = 0 184 : CALL MAXIN4 (IPOINT,IPLACE,AGRAND,OGRAND,KPLUS,LABSO,IGRAND, 185 : &JGRAND) 186 : IF (IERR .NE. 0) RETURN 187 : if(igrand.eq.0.and.jgrand.eq.0) then 187 : CALL ECRREE (OGRAND) 187 : CALL ECRREE (AGRAND) 187 : CALL ECRENT(IPLACE) 188 : else 188 : CALL ECROBJ('LISTREEL',JGRAND) 188 : CALL ECROBJ('LISTREEL',IGRAND) 188 : CALL ECROBJ('LISTENTI',IPLACE) 189 : endif 190 : END IF 191 : * 192 : RETURN 193 : END 194 : 195 : 196 :
© Cast3M 2003 - All rights reserved.
Disclaimer