Télécharger la plaquette Cast3M


fr en

Télécharger varchp.eso

Retour à la liste

Numérotation des lignes : 

varchp

  1. C VARCHP    SOURCE    CB215821  20/11/25    13:41:54     10792          
  2.  
  3. C----------------------------------------------------------------
  4. C  ENTREES:
  5. C     IPOI1=POINTEUR SUR UN CHPOINT
  6. C     IPOI2=POINTEUR SUR UN EVOLUTION
  7. C  SORTIE:
  8. C     IPOI3=POINTEUR SUR LE CHPOINT RESULTAT
  9. C     IRET = 1 SI SUCCES 0 SINON
  10. C----------------------------------------------------------------
  11.  
  12.       SUBROUTINE VARCHP (IPOI1,IPOI2,IPOI3,IRET)
  13.  
  14.       IMPLICIT INTEGER(I-N)
  15.       IMPLICIT REAL*8(A-H,O-Z)
  16.  
  17.  
  18. -INC PPARAM
  19. -INC CCOPTIO
  20.  
  21. -INC SMEVOLL
  22. -INC SMCHPOI
  23. -INC SMLREEL
  24.  
  25.       IRET  = 0
  26.       IPOI3 = 0
  27. C
  28. C  ON RECUPERE L'OBJET EVOLUTION
  29. C
  30.       MEVOLL = IPOI2
  31.       SEGACT,MEVOLL
  32.       KEVOLL = mevoll.IEVOLL(1)
  33.       SEGDES,MEVOLL
  34.       SEGACT,KEVOLL
  35.       IF (kevoll.TYPX .NE. 'LISTREEL' .OR.
  36.      &    kevoll.TYPY .NE. 'LISTREEL') THEN
  37.         SEGDES,KEVOLL
  38.         MOTERR(1:8) = 'LISTREEL'
  39.         CALL ERREUR(37)
  40.         RETURN
  41.       ENDIF
  42.       MLREE1 = kevoll.IPROGX
  43.       MLREE2 = kevoll.IPROGY
  44.       SEGDES,KEVOLL
  45.  
  46.       SEGACT,MLREE1,MLREE2
  47.       NBPOIX = MLREE1.PROG(/1)
  48.       NBPOIY = MLREE2.PROG(/1)
  49. * Petites verifications sur le contenu de l'evolution
  50.       IF (NBPOIX.NE.NBPOIY) THEN
  51.         CALL ERREUR(577)
  52.         GOTO 999
  53.       ENDIF
  54.       JORDO = 0
  55.       CALL VARIFV(MLREE1.PROG,NBPOIX,JORDO)
  56.       IF (JORDO.EQ.0) THEN
  57.         CALL ERREUR(872)
  58.         GOTO 999
  59.       ENDIF
  60. C
  61. C  ON RECUPERE LE CHPOINT
  62. C
  63.       MCHPO1 = IPOI1
  64.       SEGINI,MCHPOI=MCHPO1
  65.       NSOUPO = MCHPOI.IPCHP(/1)
  66. C
  67. C     BOUCLE SUR LES SOUS PAQUETS
  68. C
  69.       DO 100 IA = 1, NSOUPO
  70.  
  71.         MSOUP1 = MCHPOI.IPCHP(IA)
  72.         SEGINI,MSOUPO=MSOUP1
  73.         MCHPOI.IPCHP(IA) = MSOUPO
  74.         MPOVA1 = MSOUPO.IPOVAL
  75.         SEGACT,MPOVA1
  76.         N  = MPOVA1.VPOCHA(/1)
  77.         NC = MPOVA1.VPOCHA(/2)
  78.         SEGINI,MPOVAL
  79.         MSOUPO.IPOVAL = MPOVAL
  80.         DO 200 IC = 1,NC
  81.           DO 200 IB = 1, N
  82.             XTT1 = MPOVA1.VPOCHA(IB,IC)
  83.             CALL VARIFO(MLREE1.PROG,MLREE2.PROG,NBPOIX,JORDO,XTT1,YTT1)
  84.             MPOVAL.VPOCHA(IB,IC) = YTT1
  85.  200    CONTINUE
  86.         SEGDES,MPOVA1,MPOVAL,MSOUPO
  87.  
  88.  100  CONTINUE
  89.  
  90.       SEGDES,MCHPOI
  91.  
  92.       IRET  = 1
  93.       IPOI3 = MCHPOI
  94.  
  95.  999  CONTINUE
  96.       SEGDES MLREE1,MLREE2
  97.  
  98.       RETURN
  99.       END
  100.  
  101.  
  102.  
  103.  

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