1 : C MAXIM1 SOURCE CHAT 05/01/13 01:36:13 5004 2 : SUBROUTINE MAXIM1 (IPCHPO,IPLMOT,MOTCLE,IPLACE,PGRAND) 3 : ************************************************************************ 4 : * 5 : * M A X I M 1 6 : * ----------- 7 : * 8 : * FONCTION: 9 : * --------- 10 : * 11 : * RECHERCHER LA PLUS GRANDE VALEUR D'UN 'CHPOINT'. 12 : * 13 : * MODE D'APPEL: 14 : * ------------- 15 : * 15 : * CALL MAXIM1 (IPCHPO,IPLMOT,MOTCLE,IPLACE,PGRAND) 16 : * 17 : * ARGUMENTS: (E)=ENTREE (S)=SORTIE 18 : * ---------- 19 : * 20 : * CE SOUS-PROGRAMME UTILISE EVENTUELLEMENT UN SEGMENT "MTEMP2" 21 : * CREE PAR LE PROGRAMME APPELANT. 22 : * 23 : * IPCHPO ENTIER (E) POINTEUR SUR UN 'CHPOINT'. 24 : * IPLMOT ENTIER (E) POINTEUR SUR UN 'LISTMOTS', OU BIEN 25 : * NOMBRE EGAL A "0", SI L'ON PREND EN 26 : * CONSIDERATION TOUTES LES COMPOSANTES. 27 : * MOTCLE CHARACTER (E) INDIQUE PAR SON CONTENU ('AVEC' OU 'SANS') 28 : * SI LES NOMS CONTENUS DANS L'OBJET 29 : * 'LISTMOTS' SONT LES NOMS DES COMPOSANTES 30 : * A CONSIDERER ('AVEC') OU, AU CONTRAIRE, 31 : * A EXCLURE ('SANS') LORS DE LA RECHERCHE 32 : * DU MAXIMUM. 33 : * CONTENU SANS IMPORTANCE SI IPLMOT = 0 . 34 : * IPLACE ENTIER (E) POINTEUR DU SEGMENT "MTEMP2" DONNANT LA 35 : * PLACE DU MAXIMUM DANS LE CHPOINT. 36 : * = 0 SI CETTE PLACE N'EST PAS DEMANDEE. 37 : * SINON, UN SEGMENT "MTEMP2" A ETE CREE DANS 38 : * LE PROGRAMME APPELANT POUR METTRE "MAXSOU", 39 : * "MAXN" ET "MAXNC". 40 : * PGRAND REEL DP (S) PLUS GRANDE VALEUR (EN VALEUR ABSOLUE) 41 : * EXTRAITE DU 'CHPOINT'. 42 : * CETTE VALEUR EST RETOURNEE AVEC SON SIGNE. 43 : * 44 : * DICTIONNAIRE DES VARIABLES: (ORDRE ALPHABETIQUE) 45 : * --------------------------- 46 : * 47 : * AGRAND REEL DP VALEUR ABSOLUE DE "PGRAND". 48 : * DEDANS LOGIQUE INDIQUE PAR .TRUE. OU .FALSE. SI UN TYPE DE 49 : * COMPOSANTE DONNE DU 'CHPOINT' FAIT PARTIE OU 50 : * NON DES TYPES NOMMES DANS L'OBJET DE POINTEUR 51 : * "IPLMOT". 52 : * MAXN ENTIER ) VALEURS RESPECTIVES DE "N", "NC" ET "MSOUPO" 53 : * MAXNC ENTIER )) AU NIVEAU DU MAXIMUM DU CHPOINT. VOIR 54 : * MAXSOU ENTIER ) L'OBJET 'CHPOINT' POUR LA DEFINITION DES 55 : * VARIABLES SUS-NOMMEES. 56 : * NBRMOT ENTIER NOMBRE DE TYPES NOMMES DANS L'OBJET DE POINTEUR 57 : * "IPLMOT". 58 : * TRUFAL LOGIQUE CONTIENT LA VALEUR QUI DOIT ETRE DANS "DEDANS" 59 : * POUR FAIRE LA RECHERCHE DU MAXIMUM. 60 : * 61 : * SOUS-PROGRAMMES APPELES: 62 : * ------------------------ 63 : * 64 : * PARMI 65 : * 66 : * AUTEUR, DATE DE CREATION: 67 : * ------------------------- 68 : * 69 : * PASCAL MANIGOT 5 NOVEMBRE 1984 70 : * 71 : * LANGAGE: 72 : * -------- 73 : * 74 : * ESOPE + FORTRAN77 + EXTENSION: CARACTERES MIS DANS DES ENTIERS 75 : * 76 : ************************************************************************ 77 : * 78 : IMPLICIT INTEGER(I-N) 79 : -INC CCOPTIO 80 : -INC SMCHPOI 81 : -INC SMLMOTS 82 : * 83 : REAL*8 PGRAND,AGRAND 84 : CHARACTER*4 MOTCLE 85 : * 86 : LOGICAL DEDANS,TRUFAL 87 : * 88 : SEGMENT/MTEMP2/ (MAXSOU,MAXN,MAXNC) 89 : * 90 : * 91 : * 92 : IF (IPLMOT .EQ. 0) THEN 93 : * 94 : DEDANS = .TRUE. 95 : TRUFAL = DEDANS 96 : * 97 : ELSE 98 : * 99 : IF (MOTCLE .EQ. 'AVEC') THEN 100 : TRUFAL = .TRUE. 101 : ELSE IF (MOTCLE .EQ. 'SANS') THEN 102 : TRUFAL = .FALSE. 103 : ELSE 104 : * MOT-CLE NON RECONNU: 105 : MOTERR(1:4)=MOTCLE 105 : CALL ERREUR(7) 106 : RETURN 107 : END IF 108 : * 109 : MLMOTS = IPLMOT 110 : SEGACT,MLMOTS 111 : NBRMOT = MOTS(/2) 112 : SEGDES,MLMOTS 113 : * 114 : END IF 115 : * 116 : * RQ: A CE NIVEAU, "MOTCLE" EST DIFFERENT DE "MOCLE1" ET DE "MOCLE2" 117 : * SI ET SEULEMENT SI IPLMOT = 0 . 118 : * 119 : * 120 : MCHPOI = IPCHPO 121 : SEGACT,MCHPOI 122 : NSOUPO = IPCHP(/1) 123 : AGRAND = -1.D0 124 : PGRAND = 0.D0 125 : * 126 : * pour l'optimiseur 127 : mtemp2=mchpoi 128 : IF (IPLACE .NE. 0) THEN 129 : MTEMP2 = IPLACE 130 : SEGACT,MTEMP2*MOD 131 : MAXSOU = 1 132 : MAXN = 1 133 : MAXNC = 1 134 : END IF 135 : * 136 : IF (IPLMOT .NE. 0) THEN 137 : MLMOTS = IPLMOT 138 : SEGACT,MLMOTS 139 : END IF 140 : * 141 : * -- RECHERCHE DU MAXIMUM -- 142 : * 143 : DO 100 IB100=1,NSOUPO 144 : * 145 : MSOUPO = IPCHP(IB100) 146 : SEGACT,MSOUPO 147 : NC = NOCOMP(/2) 148 : MPOVAL = IPOVAL 149 : SEGACT,MPOVAL 150 : N = VPOCHA(/1) 151 : * 152 : DO 120 IB120=1,NC 153 : * 154 : IF (IPLMOT .NE. 0) THEN 154 : CALL PARMI (NOCOMP(IB120),MOTS,NBRMOT, DEDANS) 155 : END IF 156 : * 157 : * SI LA COMPOSANTE NOCOMP(IB120) FAIT PARTIE DES COMPOSANTES 158 : * RETENUES POUR LA RECHERCHE DU MAXIMUM, ALORS... 159 : ** IF (DEDANS .EQV. TRUFAL) THEN 160 : ** (LIGNE CI-DESSUS INCOMPRISE PAR ESOPE 4.1.1 (MARS 84) ) 161 : IF((DEDANS.AND.TRUFAL).OR.((.NOT.DEDANS).AND.(.NOT.TRUFAL))) 162 : & THEN 163 : DO 130 IB130=1,N 164 : * PB CFT115 COMME DANS MAXIN1 165 : MPOVA1=MPOVAL 166 : IF (ABS(MPOVA1.VPOCHA(IB130,IB120)) .GT. AGRAND) 167 : & THEN 168 : IF (IPLACE .NE. 0) THEN 169 : MAXSOU = IB100 170 : MAXN = IB130 171 : MAXNC = IB120 172 : END IF 173 : PGRAND = VPOCHA(IB130,IB120) 174 : AGRAND = ABS(PGRAND) 175 : END IF 176 : 130 CONTINUE 177 : * END DO 178 : END IF 179 : * 180 : 120 CONTINUE 181 : * END DO 182 : * 183 : SEGDES,MPOVAL 184 : SEGDES,MSOUPO 185 : * 186 : 100 CONTINUE 187 : * END DO 188 : * 189 : SEGDES,MCHPOI 190 : IF (IPLMOT .NE. 0) THEN 191 : MLMOTS = IPLMOT 192 : SEGDES,MLMOTS 193 : END IF 194 : IF (IPLACE .NE. 0) THEN 195 : MTEMP2 = IPLACE 196 : SEGDES,MTEMP2 197 : END IF 198 : * 199 : * -- A-T-ON OBTENU UN MAXIMUM ? -- 200 : * 201 : IF (AGRAND .LT. 0.) THEN 202 : * SOIT LE 'CHPOINT' EST VIDE, SOIT LE 'LISTMOTS' CONTIENT DES 203 : * NOMS DE TYPE TELS QUE, ETANT DONNE LA VALEUR DU MOT-CLE, 204 : * TOUTES LES COMPOSANTES DU 'CHPOINT' SONT EXCLUES. 204 : CALL ERREUR (156) 205 : RETURN 206 : END IF 207 : * 208 : END 209 : 210 :
© Cast3M 2003 - All rights reserved.
Disclaimer