1 : C NNOR SOURCE CHAT 05/01/13 01:57:53 5004 2 : SUBROUTINE NNOR 3 : ************************************************************************ 4 : * 5 : * N N O R 6 : * ------- 7 : * 8 : * SOUS-PROGRAMME ASSOCIE A L'OPERATEUR "NNOR" 9 : * 10 : * FONCTION: 11 : * --------- 12 : * 13 : * RAMENER EVENTUELLEMENT LES COMP. P ET PI D'UN OBJET A LEUR 14 : * VALEURS REELLES PUIS 15 : * NORMER CET OBJET EN LE DIVISANT PAR SA PLUS GRANDE VALEUR (DE 16 : * TELLE SORTE QUE SON PLUS GRAND TERME DEVIENNE 1). 17 : * 18 : * PHRASE D'APPEL (EN GIBIANE): 19 : * ---------------------------- 20 : * 21 : * |(AVEC)| 22 : * NNOR OBJET1 (| | COMPOS ) (RORF X1 CREF X2 LCAR X3 ); 23 : * | SANS | 24 : * 25 : * 26 : * LES PARENTHESES INDIQUANT DES ARGUMENTS FACULTATIFS. 27 : * 28 : * ARGUMENTS (EN GIBIANE): 29 : * ----------------------- 30 : * 31 : * OBJET1 TYPE_1 OBJET QUE L'ON NORME. 32 : * AVEC 'MOT ' MOT-CLE INDIQUANT QUE L'ON REGARDE 33 : * UNIQUEMENT,DANS LA RECHERCHE DU MAXIMUM, 34 : * LES VALEURS ASSOCIEES AUX COMPOSANTES CITEES 35 : * DANS "COMPOS". 36 : * C'EST L'OPTION PAR DEFAUT. 37 : * SANS 'MOT ' MOT-CLE INDIQUANT QUE L'ON EXCLUT, DANS LA 38 : * RECHERCHE DU MAXIMUM, LES VALEURS ASSOCIEES 39 : * AUX COMPOSANTES CITEES DANS "COMPOS". 40 : * COMPOS 'LISTMOTS' LISTE DES NOMS DES COMPOSANTES COMPRISES 41 : * OU EXCLUES. 42 : * 43 : * LES VALEURS POSSIBLES DE "TYPE_1" SONT: 44 : * - 'CHPOINT' (LES COMPOSANTES SONT ALORS UX, UY, UZ, LX, ...), 45 : * - ... (A COMPLETER AU FUR ET A MESURE) 46 : * 47 : * DICTIONNAIRE DES VARIABLES: (ORDRE ALPHABETIQUE) 48 : * --------------------------- 49 : * 50 : * IPLMOT ENTIER POINTEUR DE L'OBJET "COMPOS". 51 : * IPOINT ENTIER POINTEUR DE L'OBJET "OBJET1". 52 : * IPOS ENTIER NUMERO D'ORDRE DU TYPE DE L'OBJET "OBJET1" DANS 53 : * LA LISTE CONTENUE DANS "LISTYP". 54 : * LISTYP ENTIER CONTIENT LES NOMS DES DIFFERENTS TYPES D'OBJET 55 : * DONT ON PEUT RECHERCHER LA PLUS GRANDE VALEUR. 56 : * MOTCLE CHARACTER CONTIENT LA CHAINE DE CARACTERES 'AVEC' OU 57 : * 'SANS'. 58 : * NBTYPE ENTIER NOMBRE DE NOMS DANS "LISTYP". 59 : * 60 : * MODE DE FONCTIONNEMENT: 61 : * ----------------------- 62 : * 63 : * APPEL D'UN SOUS-PROGRAMME DISTINCT SELON LE TYPE DE L'OBJET 64 : * "OBJET1". 65 : * 66 : * SOUS-PROGRAMMES APPELES: 67 : * ------------------------ 68 : * 69 : * LIRE, LIRTYP, LIRMOT, NORMA3,NORMA4 70 : * 71 : * AUTEUR, DATE DE CREATION: 72 : * ------------------------- 73 : * 74 : * FARVACQUE JUIN 86 75 : * 76 : * LANGAGE: 77 : * -------- 78 : * 79 : * FORTRAN77 + EXTENSION: CARACTERES MIS DANS DES ENTIERS 80 : * 81 : ************************************************************************ 82 : * 83 : IMPLICIT INTEGER(I-N) 84 : -INC CCOPTIO 85 : * 86 : REAL*8 PGRAND,FLUI(3),COEFP,COEFPI,RET 87 : * 88 : PARAMETER (NBTYPE = 3) 89 : PARAMETER (LCLEF = 5) 90 : * 91 : CHARACTER*8 LISTYP(NBTYPE),MONTYP 92 : CHARACTER*4 MOCLEF(LCLEF),MOTCLE 93 : * 94 : DATA LISTYP/'CHPOINT ','SOLUTION','TABLE '/ 95 : DATA MOCLEF/'RORF','CREF','LCAR','AVEC','SANS'/ 96 : * 97 : * -- LECTURE DU MOT-CLE -- 98 : * 99 : IFLUI=0 100 : MOTCLE = ' ' 101 : * 102 : 1 ICODE = 0 102 : CALL LIRMOT(MOCLEF,LCLEF,IVAL,ICODE) 103 : IF(IVAL.EQ.1 .OR. IVAL.EQ.2 .OR. IVAL.EQ.3) THEN 103 : CALL LIRREE(RET,1,IRETOU) 104 : IF(IERR.NE.0) RETURN 105 : FLUI(IVAL)=RET 106 : IFLUI=IFLUI + 2**IVAL 107 : ELSE IF(IVAL.EQ.4 .OR. IVAL.EQ.5) THEN 108 : ELSE 109 : GOTO 2 110 : ENDIF 111 : GOTO 1 112 : * 113 : * -- LECTURE DE LA LISTE DE TYPES DE COMPOSANTE -- 114 : * 115 : 2 ICODE = 0 115 : CALL LIROBJ ('LISTMOTS',IPLMOT,ICODE,IRETOU) 116 : IF (IRETOU .EQ. 0) THEN 117 : IPLMOT = 0 118 : ELSE IF (MOTCLE .EQ. ' ') THEN 119 : * PAR DEFAUT, LES COMPOSANTES NOMMEES SONT LES COMPOSANTES 120 : * PRISES EN COMPTE (ET NON PAS LES COMPOSANTES EXCLUES): 121 : MOTCLE = 'AVEC' 122 : END IF 123 : * 124 : * -- LECTURE DE L'OBJET -- 125 : * 126 : NBTYP = NBTYPE 126 : CALL QUETYP(MONTYP,0,IRETOU) 127 : IF (IRETOU.EQ.0) THEN 127 : CALL ERREUR(533) 128 : RETURN 129 : ENDIF 130 : DO 10 IPOS=1,NBTYP 131 : IF (MONTYP.EQ.LISTYP(IPOS)) GOTO 11 132 : 10 CONTINUE 133 : MOTERR(1:8)=MONTYP 133 : CALL ERREUR(39) 134 : RETURN 135 : 11 CONTINUE 136 : IF (IPOS.EQ.3) THEN 136 : CALL LIRTAB('BASE_DE_MODES',ITBAS,1,IRETOU) 137 : ELSE 137 : CALL LIROBJ(MONTYP,IPOINT,1,IRETOU) 138 : ENDIF 139 : * 140 : * -- NORMALISATION -- 141 : * 142 : IF(IFLUI.EQ.0) THEN 143 : COEFP=0.D0 144 : COEFPI=0.D0 145 : ELSE IF(IFLUI.EQ.14) THEN 146 : IF(FLUI(3).EQ.0.D0) THEN 146 : CALL ERREUR(284) 147 : RETURN 148 : ENDIF 149 : COEFP= FLUI(1)*FLUI(2)*FLUI(2)/FLUI(3) 150 : COEFPI=FLUI(1)*FLUI(3) 151 : ELSE 151 : CALL ERREUR(284) 152 : * IL MANQUE DES VALEURS 153 : ENDIF 154 : * 155 : IF (IPOS .EQ. 1) THEN 156 : * 157 : * NORMALISATION D'UN "CHPOINT": 158 : IPLACE=0 158 : CALL NORMA3 (IPOINT,IPLMOT,MOTCLE,IFLUI,COEFP,COEFPI,IPLACE, 159 : 1 PGRAND) 160 : IF (IERR .NE. 0) RETURN 161 : * 162 : ELSE IF (IPOS .EQ. 2) THEN 163 : * 164 : * NORMALISATION D'UN "MSOLUT DE SOUS TYPE MODE": 164 : CALL NORMA4 (IPOINT,IPLMOT,MOTCLE,IFLUI,COEFP,COEFPI) 165 : IF (IERR .NE. 0) RETURN 166 : * 167 : ELSE IF (IPOS .EQ. 3) THEN 168 : * 169 : * NORMALISATION D'UNE TABLE DE SOUS TYPE "BASE_DE_MODES" 169 : CALL NORMA5 (ITBAS,IPLMOT,MOTCLE,IFLUI,COEFP,COEFPI) 170 : IF (IERR .NE. 0) RETURN 171 : * 172 : * ELSE IF (IPOS .EQ. 4) THEN 173 : * ETC.... 174 : * 175 : END IF 176 : * 177 : END 178 :
© Cast3M 2003 - All rights reserved.
Disclaimer