Esope source files

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