1 : C NORM1C SOURCE BP208322 09/03/20 21:15:13 6331 2 : C NORMA1 SOURCE CHAT 05/01/13 01:59:56 5004 3 : SUBROUTINE NORM1C (ICHP1R,ICHP1I,IPLMOT,MOTCLE,ICHP2R,ICHP2I) 4 : ************************************************************************ 5 : * 6 : * N O R M 1 C 7 : * ----------- 8 : * 9 : * ORIGINE: 10 : * --------- 11 : * 12 : * inspiré de NORMA1.eso et de MAXIM1.eso 13 : * utilisé pour le calcul de modes complexes (Rayleigh.eso) 14 : * 15 : * FONCTION: 16 : * --------- 17 : * 18 : * NORMER UN 'CHPOINT' complexe EN RAMENANT lA PLUS GRANDE VALEUR de sa norme a 1. 19 : * 20 : * MODE D'APPEL: 21 : * ------------- 22 : * 22 : * CALL NORM1C (ICHP1R,ICHP1I,IPLMOT,MOTCLE,ICHP2R,ICHP2I) 23 : * 24 : * ARGUMENTS: (E)=ENTREE (S)=SORTIE 25 : * ---------- 26 : * 27 : * ICHP1R + i*ICHP1I ENTIERs E) POINTEUR SUR LEs 'CHPOINT' A NORMER. 28 : * IPLMOT ENTIER (E) VOIR LE S.P. "MAXIM1". 29 : * MOTCLE CHARACTER (E) VOIR LE S.P. "MAXIM1". 30 : * ICHP2R + i*ICHP2I ENTIERs (S) POINTEUR SUR LEs 'CHPOINT' NORMEs. 31 : * 32 : * AUTEUR, DATE DE CREATION: 33 : * ------------------------- 34 : * 35 : * Benoit Prabel Novembre 2008 36 : * 37 : * LANGAGE: 38 : * -------- 39 : * 40 : * ESOPE + FORTRAN77 41 : * 42 : ************************************************************************ 43 : * 44 : *---- Partie declarative ----------------------------------------------* 45 : * 46 : IMPLICIT INTEGER(I-N) 47 : * 48 : -INC CCOPTIO 49 : -INC SMCHPOI 50 : -INC SMLMOTS 51 : * 52 : REAL*8 XMAXR,XMAXI,XMAXN 53 : CHARACTER*4 MOTCLE 54 : LOGICAL DEDANS,TRUFAL 55 : * 56 : *---- Lecture des options ---------------------------------------------* 57 : * 58 : IF (IPLMOT .EQ. 0) THEN 59 : DEDANS = .TRUE. 60 : TRUFAL = DEDANS 61 : ELSE 62 : IF (MOTCLE .EQ. 'AVEC') THEN 63 : TRUFAL = .TRUE. 64 : ELSE IF (MOTCLE .EQ. 'SANS') THEN 65 : TRUFAL = .FALSE. 66 : ELSE 67 : * MOT-CLE NON RECONNU: 68 : MOTERR(1:4)=MOTCLE 68 : CALL ERREUR(7) 69 : RETURN 70 : ENDIF 71 : MLMOTS = IPLMOT 72 : SEGACT,MLMOTS 73 : NBRMOT = MOTS(/2) 74 : * SEGDES,MLMOTS 75 : ENDIF 76 : * 77 : *---- CALCUL DE LA NORME ----------------------------------------------* 78 : * 79 : * initialisation 80 : MAXSOU = 1 81 : MAXN = 1 82 : MAXNC = 1 83 : XMAXR = 0.D0 84 : XMAXI = 0.D0 85 : XMAXN = 0.D0 86 : 87 : * ouverture des chpoints 88 : MCHPO1 = ICHP1R 89 : MCHPO2 = ICHP1I 90 : segact,MCHPO1,MCHPO2 91 : NSOUPO = MCHPO1.IPCHP(/1) 92 : NSOUPOI = MCHPO2.IPCHP(/1) 93 : if(NSOUPO .NE. NSOUPOI) then 94 : write(*,*) 'nom1c.eso : NSOUPO .NE. NSOUPOI' 94 : call ERREUR(103) 95 : return 96 : endif 97 : * 98 : * IF (IPLMOT .NE. 0) THEN 99 : * MLMOTS = IPLMOT 100 : * SEGACT,MLMOTS 101 : * ENDIF 102 : * 103 : * RECHERCHE DU MAXIMUM 104 : *---> boucle sur les zones des chpoints 105 : DO 100 IB100=1,NSOUPO 106 : * 107 : MSOUP1 = MCHPO1.IPCHP(IB100) 108 : MSOUP2 = MCHPO2.IPCHP(IB100) 109 : SEGACT,MSOUP1,MSOUP2 110 : NC = MSOUP1.NOCOMP(/2) 111 : NCI = MSOUP2.NOCOMP(/2) 112 : if(NC .NE. NCI) then 113 : write(*,*) 'nom1c.eso : NC .NE. NCI' 113 : call ERREUR(103) 114 : return 115 : endif 116 : MPOVA1 = MSOUP1.IPOVAL 117 : MPOVA2 = MSOUP2.IPOVAL 118 : SEGACT,MPOVA1,MPOVA2 119 : N = MPOVA1.VPOCHA(/1) 120 : NI = MPOVA2.VPOCHA(/1) 121 : if(N .NE. NI) then 121 : call ERREUR(103) 122 : return 123 : endif 124 : * 125 : *------> boucle sur les composantes 126 : DO 120 IB120=1,NC 127 : * 128 : IF (IPLMOT .NE. 0) THEN 128 : CALL PARMI (MSOUP1.NOCOMP(IB120),MOTS,NBRMOT, DEDANS) 129 : ENDIF 130 : * 131 : * SI LA COMPOSANTE NOCOMP(IB120) FAIT PARTIE DES COMPOSANTES 132 : * RETENUES POUR LA RECHERCHE DU MAXIMUM, ALORS... 133 : ** IF (DEDANS .EQV. TRUFAL) THEN 134 : ** (LIGNE CI-DESSUS INCOMPRISE PAR ESOPE 4.1.1 (MARS 84) ) 135 : IF((DEDANS.AND.TRUFAL).OR.((.NOT.DEDANS).AND.(.NOT.TRUFAL))) 136 : & THEN 137 : 138 : *------------> boucle sur les points 139 : DO 130 IB130=1,N 140 : 141 : * calcul de la norme au carré 142 : XR = MPOVA1.VPOCHA(IB130,IB120) 143 : XI = MPOVA2.VPOCHA(IB130,IB120) 144 : XN = (XR ** 2) + (XI ** 2) 145 : c write(*,*) IB100,IB120,IB130,' XN,XMAXN=',XN,XMAXN 146 : 147 : IF (XN .GT. XMAXN) THEN 148 : MAXSOU = IB100 149 : MAXN = IB130 150 : MAXNC = IB120 151 : XMAXR = XR 152 : XMAXI = XI 153 : XMAXN = XN 154 : ENDIF 155 : 130 CONTINUE 156 : *<------------ fin de boucle sur les points 157 : 158 : ENDIF 159 : * 160 : 120 CONTINUE 161 : *<--------- fin de boucle sur les composantes 162 : * 163 : SEGDES,MPOVA1,MPOVA2 164 : SEGDES,MSOUP1,MSOUP2 165 : * 166 : 100 CONTINUE 167 : *<--------- fin de boucle sur les zones 168 : * 169 : SEGDES,MCHPO1,MCHPO2 170 : IF (IPLMOT .NE. 0) THEN 171 : MLMOTS = IPLMOT 172 : SEGDES,MLMOTS 173 : ENDIF 174 : * 175 : * A-T-ON OBTENU UN MAXIMUM ? 176 : IF (XMAXN .eq. 0.) THEN 177 : * SOIT LE 'CHPOINT' EST VIDE, SOIT LE 'LISTMOTS' CONTIENT DES 178 : * NOMS DE TYPE TELS QUE, ETANT DONNE LA VALEUR DU MOT-CLE, 179 : * TOUTES LES COMPOSANTES DU 'CHPOINT' SONT EXCLUES, 180 : * soit le chpoint est nul, ce qui ne nous permet pas de la normer 180 : CALL ERREUR (156) 181 : RETURN 182 : ENDIF 183 : * 184 : 185 : *---- NORMALISATION Complexe ------------------------------------------* 186 : * 187 : * ouverture et initialisation des chpoints 188 : SEGACT,MCHPO1,MCHPO2 189 : SEGINI,MCHPO3=MCHPO1 190 : SEGINI,MCHPO4=MCHPO2 191 : ICHP2R = MCHPO3 192 : ICHP2I = MCHPO4 193 : * 194 : *---> boucle sur les zones des chpoints 195 : DO 200 IB200=1,NSOUPO 196 : * 197 : MSOUP1 = MCHPO1.IPCHP(IB200) 198 : MSOUP2 = MCHPO2.IPCHP(IB200) 199 : SEGACT,MSOUP1,MSOUP2 200 : NC = MSOUP1.NOCOMP(/2) 201 : SEGINI,MSOUP3=MSOUP1 202 : SEGINI,MSOUP4=MSOUP2 203 : MCHPO3.IPCHP(IB200) = MSOUP3 204 : MCHPO4.IPCHP(IB200) = MSOUP4 205 : MPOVA1 = MSOUP1.IPOVAL 206 : MPOVA2 = MSOUP2.IPOVAL 207 : SEGACT,MPOVA1,MPOVA2 208 : N = MPOVA1.VPOCHA(/1) 209 : SEGINI,MPOVA3=MPOVA1 210 : SEGINI,MPOVA4=MPOVA2 211 : MSOUP3.IPOVAL = MPOVA3 212 : MSOUP4.IPOVAL = MPOVA4 213 : * 214 : *------> boucle sur les composantes 215 : DO 220 IB220=1,NC 216 : * 217 : *------------> boucle sur les points 218 : DO 230 IB230=1,N 219 : 220 : * calcul du chpoint Complexe normé 221 : XR = MPOVA1.VPOCHA(IB230,IB220) 222 : XI = MPOVA2.VPOCHA(IB230,IB220) 223 : XR2 = ( (XR*XMAXR) + (XI*XMAXI) ) / XMAXN 224 : XI2 = ( (XI*XMAXR) - (XR*XMAXI) ) / XMAXN 225 : MPOVA3.VPOCHA(IB230,IB220) = XR2 226 : MPOVA4.VPOCHA(IB230,IB220) = XI2 227 : 228 : 230 CONTINUE 229 : *<------------ fin de boucle sur les points 230 : * 231 : 220 CONTINUE 232 : *<--------- fin de boucle sur les composantes 233 : * 234 : SEGDES,MPOVA1,MPOVA2,MPOVA3,MPOVA4 235 : SEGDES,MSOUP1,MSOUP2,MSOUP3,MSOUP4 236 : * 237 : 200 CONTINUE 238 : *<--------- fin de boucle sur les zones 239 : * 240 : SEGDES,MCHPO1,MCHPO2,MCHPO3,MCHPO4 241 : 242 : END 243 : 244 :
© Cast3M 2003 - All rights reserved.
Disclaimer