Télécharger la plaquette Cast3M


fr en

Télécharger norma1.eso

Retour à la liste

Numérotation des lignes : 

norma1

  1. C NORMA1    SOURCE    CB215821  20/11/25    13:35:02     10792          
  2.       SUBROUTINE NORMA1 (IPCHP1,IPLMOT,MOTCLE,IPCHP2)
  3. ************************************************************************
  4. *
  5. *                             N O R M A 1
  6. *                             -----------
  7. *
  8. * FONCTION:
  9. * ---------
  10. *
  11. *     NORMER UN 'CHPOINT' EN RAMENANT SA PLUS GRANDE VALEUR A 1.
  12. *
  13. * MODE D'APPEL:
  14. * -------------
  15. *
  16. *     CALL NORMA1 (IPCHP1,IPLMOT,MOTCLE,IPCHP2)
  17. *
  18. * ARGUMENTS:   (E)=ENTREE   (S)=SORTIE
  19. * ----------
  20. *
  21. *     IPCHP1  ENTIER    (E)  POINTEUR SUR L'OBJET 'CHPOINT' A NORMER.
  22. *     IPLMOT  ENTIER    (E)  VOIR LE S.P. "MAXIM1".
  23. *     MOTCLE  CHARACTER (E)  VOIR LE S.P. "MAXIM1".
  24. *     IPCHP2  ENTIER    (S)  POINTEUR SUR L'OBJET 'CHPOINT' NORME ISSU
  25. *                            DE L'OBJET DE POINTEUR "IPCHP1".
  26. *
  27. * SOUS-PROGRAMMES APPELES:
  28. * ------------------------
  29. *
  30. *     MAXIM1, ERREUR.
  31. *
  32. * AUTEUR, DATE DE CREATION:
  33. * -------------------------
  34. *
  35. *     PASCAL MANIGOT     16 OCTOBRE 1984
  36. *
  37. * LANGAGE:
  38. * --------
  39. *
  40. *     ESOPE + FORTRAN77
  41. *
  42. ************************************************************************
  43. *
  44.       IMPLICIT INTEGER(I-N)
  45.  
  46. -INC PPARAM
  47. -INC CCOPTIO
  48. -INC SMCHPOI
  49. *
  50.       SEGMENT/MTEMP2/ (MAXSOU,MAXN,MAXNC)
  51. *     (REMPLI DANS LE S.P. "MAXIM1")
  52. *
  53.       REAL*8 PGRAND
  54.       CHARACTER*(*) MOTCLE
  55. *
  56. *     -- RECHERCHE DU MAXIMUM --
  57. *
  58.       SEGINI,MTEMP2
  59.       IPLACE = MTEMP2
  60.       CALL MAXIM1 (IPCHP1,IPLMOT,MOTCLE,IPLACE,  PGRAND)
  61.       IF (IERR .NE. 0) RETURN
  62.       IF (PGRAND .EQ. 0.D0) THEN
  63.          NUMERR = 150
  64.          CALL ERREUR (NUMERR)
  65.          RETURN
  66.       END IF
  67. *
  68. *     -- NORMALISATION --
  69. *
  70.       MTEMP2 = IPLACE
  71.       SEGACT,MTEMP2
  72. *
  73.       MCHPO1 = IPCHP1
  74.       SEGINI,MCHPOI=MCHPO1
  75.       IPCHP2 = MCHPOI
  76.       NSOUPO = IPCHP(/1)
  77. *
  78.       DO 100 IB100=1,NSOUPO
  79. *
  80.          MSOUP1 = IPCHP(IB100)
  81.          SEGINI,MSOUPO=MSOUP1
  82.          IPCHP(IB100) = MSOUPO
  83.          MPOVA1 = IPOVAL
  84.          SEGACT MPOVA1
  85.          N=MPOVA1.VPOCHA(/1)
  86.          NC=MPOVA1.VPOCHA(/2)
  87.          SEGINI,MPOVAL
  88.          IPOVAL = MPOVAL
  89. *
  90.          DO 120 IB120=1,NC
  91.             DO 130 IB130=1,N
  92.               VPOCHA(IB130,IB120) = MPOVA1.VPOCHA(IB130,IB120) / PGRAND
  93.   130          CONTINUE
  94. *           END DO
  95.   120       CONTINUE
  96. *        END DO
  97.          IF (IB100.EQ.MAXSOU)
  98.      >            VPOCHA(MAXN,MAXNC) = 1.D0
  99. *
  100.          SEGACT,MPOVAL*NOMOD,MSOUPO*NOMOD
  101. *
  102.   100    CONTINUE
  103. *     END DO
  104. *
  105.       SEGACT,MCHPOI*NOMOD
  106.       SEGSUP,MTEMP2
  107. *
  108.       END
  109.  
  110.  
  111.  
  112.  
  113.  
  114.  

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