Télécharger la plaquette Cast3M


fr en

Télécharger invchp.eso

Retour à la liste

Numérotation des lignes : 

invchp

  1. C INVCHP    SOURCE    CB215821  20/11/25    13:30:24     10792          
  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.  
  32. -INC PPARAM
  33. -INC CCOPTIO
  34. -INC CCREEL
  35. -INC SMCHPOI
  36. -INC SMELEME
  37. C
  38. C
  39. *      GMAXI = 1.d-50
  40.       MCHPOI = ICHP
  41.       SEGACT MCHPOI
  42.       SEGINI,MCHPO1=MCHPOI
  43.       SEGDES MCHPOI
  44.       NSOUPO = MCHPO1.IPCHP(/1)
  45.       DO 300 I=1,NSOUPO
  46.         MSOUPO = MCHPO1.IPCHP(I)
  47.         SEGACT MSOUPO
  48.         SEGINI,MSOUP1=MSOUPO
  49.         SEGDES MSOUPO
  50.         MCHPO1.IPCHP(I)=MSOUP1
  51.         MPOVAL = MSOUP1.IPOVAL
  52.         SEGACT MPOVAL
  53.         N=VPOCHA(/1)
  54.         NC=VPOCHA(/2)
  55.         SEGINI MPOVA1
  56.         MSOUP1.IPOVAL = MPOVA1
  57.         DO 200  J=1,NC
  58.           DO 100 K=1,N
  59.  
  60. *            IF (ABS(VPOCHA(K,J)).GT.(XPETIT*GMAXI)) THEN
  61.             IF (ABS(VPOCHA(K,J)).GT.(XPETIT*1.d10)) THEN
  62.               MPOVA1.VPOCHA(K,J)=1.D0/VPOCHA(K,J)
  63. *              GMAXI = MAX(GMAXI,ABS(VPOCHA(K,J)))
  64.  
  65.             ELSE
  66.  
  67.               AA = VPOCHA(K,J)
  68.  
  69.               SEGDES MPOVAL,MSOUPO
  70.               SEGSUP MPOVA1
  71.               SEGSUP MCHPO1
  72.  
  73.               IF ((AA .LT. 0.) .EQV. (AA .GE. 0.)) THEN
  74. *               Opération interrompue: valeur NaN détectée dans l'objet CHPOINT
  75.                 MOTERR(1:8)='CHPOINT '
  76.                 CALL ERREUR(1012)
  77.               ELSE
  78. *               Opération impossible: division par zéro
  79.                 CALL ERREUR(835)
  80.               ENDIF
  81.  
  82.               RETURN
  83.  
  84.             ENDIF
  85.  
  86.  100      CONTINUE
  87.  200    CONTINUE
  88.         SEGDES MPOVAL
  89.         SEGDES MPOVA1
  90.         SEGDES MSOUP1
  91.  300  CONTINUE
  92.       SEGDES MCHPO1
  93.       ICHP2=MCHPO1
  94.       RETURN
  95.       END
  96.  
  97.  
  98.  
  99.  
  100.  
  101.  
  102.  
  103.  
  104.  
  105.  

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