Télécharger la plaquette Cast3M


fr en

Télécharger norm1c.eso

Retour à la liste

Numérotation des lignes : 

norm1c

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

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