Télécharger invchp.eso

Retour à la liste

Numérotation des lignes :

  1. C INVCHP SOURCE JC220346 10/11/08 21:15:07 6789
  2. C INVCHPO SOURCE DEGAY 97/03/19 21:15:03 2601
  3. SUBROUTINE INVCHP(ICHP,ICHP2)
  4. ************************************************************************
  5. * NOM : INVCHP
  6. * DESCRIPTION : Inverse un CHPOINT (appelé par l'opérateur INVE)
  7. ************************************************************************
  8. * HISTORIQUE : 18/03/1997 : DEGAY : création de la routine INVCHPO
  9. * branchement sur l'opérateur INVE
  10. * HISTORIQUE : 4/04/1997 : PYROS1 : INVCHPO renommé en INVCHP
  11. * HISTORIQUE : 29/10/2010 : JCARDO : détection des NaN pour un message
  12. * d'erreur plus clair (n°1012)
  13. * HISTORIQUE :
  14. * HISTORIQUE :
  15. ************************************************************************
  16. * Prière de PRENDRE LE TEMPS DE COMPLÉTER LES COMMENTAIRES
  17. * en cas de modification de ce sous-programme afin de faciliter
  18. * la maintenance !
  19. ************************************************************************
  20. * SYNTAXE
  21. *
  22. * CALL INVCHP(ICHP,ICHP2)
  23. *
  24. * - ENTRÉE : ICHP : pointeur sur le CHPOINT à inverser
  25. * - SORTIE : ICHP2 : pointeur sur le CHPOINT après inversion
  26. *
  27. ************************************************************************
  28.  
  29. IMPLICIT INTEGER(I-N)
  30. IMPLICIT REAL*8(A-H,O-Z)
  31. -INC CCOPTIO
  32. -INC CCREEL
  33. -INC SMCHPOI
  34. -INC SMELEME
  35. C
  36. C
  37. * GMAXI = 1.d-50
  38. MCHPOI = ICHP
  39. SEGACT MCHPOI
  40. SEGINI,MCHPO1=MCHPOI
  41. SEGDES MCHPOI
  42. NSOUPO = MCHPO1.IPCHP(/1)
  43. DO 300 I=1,NSOUPO
  44. MSOUPO = MCHPO1.IPCHP(I)
  45. SEGACT MSOUPO
  46. SEGINI,MSOUP1=MSOUPO
  47. SEGDES MSOUPO
  48. MCHPO1.IPCHP(I)=MSOUP1
  49. MPOVAL = MSOUP1.IPOVAL
  50. SEGACT MPOVAL
  51. N=VPOCHA(/1)
  52. NC=VPOCHA(/2)
  53. SEGINI MPOVA1
  54. MSOUP1.IPOVAL = MPOVA1
  55. DO 200 J=1,NC
  56. DO 100 K=1,N
  57.  
  58. * IF (ABS(VPOCHA(K,J)).GT.(XPETIT*GMAXI)) THEN
  59. IF (ABS(VPOCHA(K,J)).GT.(XPETIT*1.d10)) THEN
  60. MPOVA1.VPOCHA(K,J)=1.D0/VPOCHA(K,J)
  61. * GMAXI = MAX(GMAXI,ABS(VPOCHA(K,J)))
  62.  
  63. ELSE
  64.  
  65. AA = VPOCHA(K,J)
  66.  
  67. SEGDES MPOVAL,MSOUPO
  68. SEGSUP MPOVA1
  69. SEGSUP MCHPO1
  70.  
  71. IF ((AA .LT. 0.) .EQV. (AA .GE. 0.)) THEN
  72. * Opération interrompue: valeur NaN détectée dans l'objet CHPOINT
  73. MOTERR(1:8)='CHPOINT '
  74. CALL ERREUR(1012)
  75. ELSE
  76. * Opération impossible: division par zéro
  77. CALL ERREUR(835)
  78. ENDIF
  79.  
  80. RETURN
  81.  
  82. ENDIF
  83.  
  84. 100 CONTINUE
  85. 200 CONTINUE
  86. SEGDES MPOVAL
  87. SEGDES MPOVA1
  88. SEGDES MSOUP1
  89. 300 CONTINUE
  90. SEGDES MCHPO1
  91. ICHP2=MCHPO1
  92. RETURN
  93. END
  94.  
  95.  
  96.  
  97.  
  98.  
  99.  
  100.  
  101.  
  102.  

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