Télécharger norme2.eso

Retour à la liste

Numérotation des lignes :

  1. C NORME2 SOURCE CHAT 05/01/13 02:00:22 5004
  2. SUBROUTINE NORME2 (IPX,XNORM2,IPRR,IPY,YNORM2,IPLMOX,
  3. C IPLMOY,IPRX)
  4. IMPLICIT INTEGER(I-N)
  5. IMPLICIT REAL*8 (A-H,O-Z)
  6. ************************************************************************
  7. *
  8. * N O R M E 2
  9. * -----------
  10. *
  11. * FONCTION:
  12. * ---------
  13. *
  14. * MODIFIER PAR UN COEFFICIENT DE PROPORTIONALITE UN 'CHPOINT' POUR
  15. * QUE SA "NORME AU CARRE" VAILLE +/- "XNORM2".
  16. *
  17. * MODE D'APPEL:
  18. * -------------
  19. *
  20. * CALL NORME2 (IPX,XNORM2,IPRR,IPY,YNORM2)
  21. *
  22. * PARAMETRES: (E)=ENTREE (S)=SORTIE
  23. * -----------
  24. *
  25. * IPX ENTIER (E) POINTEUR DU 'CHPOINT' A MODIFIER.
  26. * XNORM2 REEL DP (E) VALEUR DESIREE POUR LA "NORME AU CARRE".
  27. * IPRR ENTIER (E) POINTEUR DE LA 'RIGIDITE' SERVANT A
  28. * "NORMER".
  29. * IPY ENTIER (S) POINTEUR DU 'CHPOINT' MODIFIE.
  30. * YNORM2 REEL DP (S) VALEUR DE LA "NORME AU CARRE" DU 'CHPOINT'
  31. * DE POINTEUR "IPY".
  32. *
  33. * REMARQUES:
  34. * ----------
  35. *
  36. * LA "NORME AU CARRE" EST DEFINIE PAR "XT.RR.X"
  37. *
  38. * SI L'ON ECRIT "NORME AU CARRE" ENTRE GUILLEMETS, C'EST PARCE
  39. * QU'IL NE S'AGIT PAS D'UNE VERITABLE NORME SI "RR" N'EST PAS
  40. * DEFINIE POSITIVE.
  41. *
  42. * LA VARIABLE "YNORM2" EXISTE PRECISEMENT POUR INDIQUER SI L'ON A
  43. * BIEN OBTENU "XNORM2" POUR NORME AU CARRE ET NON PAS "-XNORM2".
  44. * ELLE MET EGALEMENT EN EVIDENCE LES ERREURS D'ARRONDI.
  45. *
  46. * SOUS-PROGRAMMES APPELES:
  47. * ------------------------
  48. *
  49. * MUCHPO, XTMX.
  50. *
  51. * AUTEUR, DATE DE CREATION:
  52. * -------------------------
  53. *
  54. * PASCAL MANIGOT 17 AVRIL 1985
  55. *
  56. * LANGAGE:
  57. * --------
  58. *
  59. * FORTRAN77
  60. *
  61. ************************************************************************
  62. *
  63. -INC CCOPTIO
  64. *
  65. *
  66. IPRX=0
  67. IPRRX=0
  68. IF((IPLMOX*IPLMOY).EQ.0) GOTO 10
  69. CALL MUCPRI(IPX,IPRR,IPRRX)
  70. CALL XTY1(IPX,IPRRX,IPLMOX,IPLMOY,XTRRX)
  71. GOTO 20
  72. 10 CALL XTMX (IPX,IPRR, XTRRX)
  73. IF (IERR .NE. 0) RETURN
  74. 20 CONTINUE
  75. *
  76. COEFF = SQRT( ABS(XNORM2 / XTRRX) )
  77. MULTPL = 1
  78. CALL MUCHPO (IPX,COEFF, IPY,MULTPL)
  79. IF (IERR .NE. 0) RETURN
  80. IF(IPRRX.EQ.0) GOTO 30
  81. CALL MUCHPO (IPRRX,COEFF,IPRX,MULTPL)
  82. CALL DTCHPO(IPRRX)
  83. *
  84. 30 CONTINUE
  85. YNORM2 = ABS(XNORM2/XTRRX) * XTRRX
  86. IF (IERR .NE. 0) RETURN
  87. IF (IIMPI .EQ. 627) THEN
  88. WRITE (IOIMP,*) 'ON DOIT AVOIR ',YNORM2,' = +/- ',XNORM2
  89. END IF
  90. *
  91. END
  92.  
  93.  

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