Télécharger norm1c.eso

Retour à la liste

Numérotation des lignes :

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

© Cast3M 2003 - Tous droits réservés.
Mentions légales