1 : C MAXICH SOURCE PV 09/03/12 21:28:27 6325 2 : SUBROUTINE MAXICH(IPCHLM,IPLMOT,MOTCLE,IPLACE,PGRAND,KPLUS,LABSO) 3 : ************************************************************************ 4 : * 5 : * M A X I C H 6 : * ----------- 7 : * 8 : * FONCTION: 9 : * --------- 10 : * 11 : * RECHERCHER LA PLUS GRANDE VALEUR D'UN 'MCHAML'. 12 : * 13 : * MODE D'APPEL: 14 : * ------------- 15 : * 15 : * CALL MAXICH (IPCHLM,IPLMOT,MOTCLE,IPLACE,PGRAND) 16 : * 17 : * ARGUMENTS: (E)=ENTREE (S)=SORTIE 18 : * ---------- 19 : * 20 : * 21 : * IPCHLM ENTIER (E) POINTEUR SUR UN 'MCHAML'. 22 : * IPLMOT ENTIER (E) POINTEUR SUR UN 'LISTMOTS', OU BIEN 23 : * NOMBRE EGAL A "0", SI L'ON PREND EN 24 : * CONSIDERATION TOUTES LES COMPOSANTES. 25 : * MOTCLE ENTIER (E) INDIQUE PAR SON CONTENU ('AVEC' OU 'SANS') 26 : * SI LES NOMS CONTENUS DANS L'OBJET 27 : * 'LISTMOTS' SONT LES NOMS DES COMPOSANTES 28 : * A CONSIDERER ('AVEC') OU, AU CONTRAIRE, 29 : * A EXCLURE ('SANS') LORS DE LA RECHERCHE 30 : * DU MAXIMUM. 31 : * CONTENU SANS IMPORTANCE SI IPLMOT = 0 . 32 : * IPLACE ENTIER (E) POINTEUR DU SEGMENT "MTEMP2" DONNANT LA 33 : * PLACE DU MAXIMUM DANS LE CHPOINT. 34 : * = 0 SI CETTE PLACE N'EST PAS DEMANDEE. 35 : * SINON, UN SEGMENT "MTEMP2" A ETE CREE DANS 36 : * LE PROGRAMME APPELANT POUR METTRE "MAXSOU", 37 : * "MAXN" ET "MAXNC". 38 : * PGRAND REEL DP (S) PLUS GRANDE VALEUR (EN VALEUR ABSOLUE) 39 : * EXTRAITE DU 'CHAMELEM'. 40 : * CETTE VALEUR EST RETOURNEE AVEC SON SIGNE. 41 : * 42 : * DICTIONNAIRE DES VARIABLES: (ORDRE ALPHABETIQUE) 43 : * --------------------------- 44 : * 45 : * DEDANS LOGIQUE INDIQUE PAR .TRUE. OU .FALSE. SI UN TYPE DE 46 : * COMPOSANTE DONNE DU 'CHPOINT' FAIT PARTIE OU 47 : * NON DES TYPES NOMMES DANS L'OBJET DE POINTEUR 48 : * "IPLMOT". 49 : * NBRMOT ENTIER NOMBRE DE TYPES NOMMES DANS L'OBJET DE POINTEUR 50 : * "IPLMOT". 51 : * TRUFAL LOGIQUE CONTIENT LA VALEUR QUI DOIT ETRE DANS "DEDANS" 52 : * POUR FAIRE LA RECHERCHE DU MAXIMUM. 53 : * 54 : * SOUS-PROGRAMMES APPELES: 55 : * ------------------------ 56 : * 57 : * PARMI 58 : * 59 : ************************************************************************ 60 : * 61 : IMPLICIT INTEGER(I-N) 62 : -INC CCOPTIO 63 : -INC SMCHAML 64 : -INC SMLMOTS 65 : * 66 : REAL*8 PGRAND,XVAL 67 : CHARACTER*4 MOTCLE 68 : * 69 : LOGICAL DEDANS,TRUFAL 70 : * 71 : SEGMENT/MTEMP3/ (MAXSOU,MAXNEL,MAXNBP,MAXCO) 72 : * 73 : * 74 : * 75 : IF (IPLMOT .EQ. 0) THEN 76 : * 77 : DEDANS = .TRUE. 78 : TRUFAL = DEDANS 79 : * 80 : ELSE 81 : * 82 : IF (MOTCLE .EQ.'AVEC') THEN 83 : TRUFAL = .TRUE. 84 : ELSE IF (MOTCLE .EQ.'SANS') THEN 85 : TRUFAL = .FALSE. 86 : ELSE 87 : * MOT-CLE NON RECONNU: 88 : NUMERR = 7 89 : MOTERR(1:4) = MOTCLE 89 : CALL ERREUR (NUMERR) 90 : RETURN 91 : END IF 92 : * 93 : MLMOTS = IPLMOT 94 : SEGACT,MLMOTS 95 : NBRMOT = MOTS(/2) 96 : SEGDES,MLMOTS 97 : * 98 : END IF 99 : * 100 : * RQ: A CE NIVEAU, "MOTCLE" EST DIFFERENT DE "MOCLE1" ET DE "MOCLE2" 101 : * SI ET SEULEMENT SI IPLMOT = 0 . 102 : * 103 : * 104 : IDEB=0 105 : PGRAND = 0.D0 106 : * 107 : * pour l'optimiseur 108 : mtemp3=ipchlm 109 : IF (IPLACE .NE. 0) THEN 110 : MTEMP3 = IPLACE 111 : SEGACT,MTEMP3 112 : MAXSOU = 1 113 : MAXNEL = 1 114 : MAXCO = 1 115 : MAXNBP = 1 116 : END IF 117 : * 118 : IF (IPLMOT .NE. 0) THEN 119 : MLMOTS = IPLMOT 120 : SEGACT MLMOTS 121 : END IF 122 : C 123 : C ON RECUPERE LE CHAMELEM 124 : C 125 : MCHELM=IPCHLM 126 : SEGACT MCHELM 127 : NSOUS=ICHAML(/1) 128 : C 129 : C BOUCLE SUR LES SOUS PAQUETS 130 : C 131 : DO 100 IA=1,NSOUS 132 : MCHAML=ICHAML(IA) 133 : SEGACT MCHAML 134 : NCOELE=NOMCHE(/2) 135 : C 136 : C -- RECHERCHE DU MAXIMUM -- 137 : C 138 : DO 720 IC=1,NCOELE 139 : C 140 : MELVAL=IELVAL(IC) 141 : SEGACT MELVAL 142 : NBPTEL=VELCHE(/1) 143 : NEL =VELCHE(/2) 144 : IF (IPLMOT .NE. 0) THEN 144 : CALL PARMI (NOMCHE(IC),MOTS,NBRMOT, DEDANS) 145 : END IF 146 : C 147 : C SI LA COMPOSANTE NOMCHE(IC) FAIT PARTIE DES COMPOSANTES 148 : C RETENUES POUR LA RECHERCHE DU MAXIMUM, ALORS... 149 : C 150 : IF((DEDANS.AND.TRUFAL).OR.((.NOT.DEDANS).AND.(.NOT.TRUFAL))) 151 : . THEN 152 : IF(IDEB.EQ.0) THEN 153 : IDEB=1 154 : IF(LABSO.EQ.0) THEN 155 : PGRAND=VELCHE(1,1) 156 : ELSE 157 : PGRAND=ABS(VELCHE(1,1)) 158 : ENDIF 159 : ENDIF 160 : DO 730 IB=1,NEL 161 : DO 730 ID=1,NBPTEL 162 : IF(LABSO.EQ.0) THEN 163 : XVAL =VELCHE(ID,IB) 164 : ELSE 165 : XVAL =ABS(VELCHE(ID,IB)) 166 : ENDIF 167 : IF((KPLUS.EQ. 1.AND.XVAL.GT.PGRAND). 168 : $ OR.(KPLUS.EQ.-1.AND.XVAL.LT.PGRAND)) THEN 169 : IF (IPLACE .NE. 0) THEN 170 : MAXSOU = IA 171 : MAXNEL= IB 172 : MAXNBP = ID 173 : MAXCO = IC 174 : END IF 175 : PGRAND = XVAL 176 : END IF 177 : 730 CONTINUE 178 : C 179 : END IF 180 : C 181 : SEGDES MELVAL 182 : 720 CONTINUE 183 : SEGDES MCHAML 184 : C 185 : 100 CONTINUE 186 : SEGDES MCHELM 187 : C 188 : IF (IPLMOT .NE. 0) THEN 189 : MLMOTS = IPLMOT 190 : SEGDES,MLMOTS 191 : END IF 192 : IF (IPLACE .NE. 0) THEN 193 : MTEMP3 = IPLACE 194 : SEGDES MTEMP3 195 : END IF 196 : * 197 : * -- A-T-ON OBTENU UN MAXIMUM ? -- 198 : * 199 : IF (IDEB.EQ.0) THEN 200 : * SOIT LE 'MCHAML' EST VIDE, SOIT LE 'LISTMOTS' CONTIENT DES 201 : * NOMS DE TYPE TELS QUE, ETANT DONNE LA VALEUR DU MOT-CLE, 202 : * TOUTES LES COMPOSANTES DU 'CHPOINT' SONT EXCLUES. 203 : if (labso.eq.0) then 204 : NUMERR = 156 204 : CALL ERREUR (NUMERR) 205 : RETURN 206 : endif 207 : pgrand=0.d0 208 : END IF 209 : C 210 : END 211 : 212 : 213 : 214 :
© Cast3M 2003 - All rights reserved.
Disclaimer