Télécharger la plaquette Cast3M


fr en

Télécharger chevol.eso

Retour à la liste

Numérotation des lignes : 

chevol

  1. C CHEVOL    SOURCE    SP204843  25/06/05    21:15:03     12270          
  2. C
  3.       SUBROUTINE CHEVOL(IEV1,ITIT,K,CHAR1,IENT1,IEV2)
  4.       IMPLICIT REAL*8 (A-H,O-Z)
  5.       IMPLICIT INTEGER (I-N)
  6. C***********************************************************************
  7. C NOM         : CHEVOL
  8. C DESCRIPTION : Change certains noms dans une evolution
  9. C
  10. C
  11. C LANGAGE     : ESOPE
  12. C CREATION    : bp, 2015-05-12
  13. c MODIFS      : ...
  14. c
  15. C***********************************************************************
  16.       CHARACTER*72 CHAR1
  17.       CHARACTER*4  CHAR2
  18.  
  19. -INC SMEVOLL
  20. -INC PPARAM
  21. -INC CCOPTIO
  22. -INC CCGEOME
  23.  
  24.  
  25.       MEVOL1=IEV1
  26.       SEGINI,MEVOLL=MEVOL1
  27.       IEV2=MEVOLL
  28.  
  29. C     Aiguillage
  30.       GOTO(100,200,200,200,200,200,200,200),ITIT
  31.  
  32. C     Modif du titre general
  33.  100  CONTINUE
  34.       IEVTEX=CHAR1
  35.       SEGDES,MEVOLL
  36.       RETURN
  37.  
  38. C     Modif du titre d'une ou de toutes les legendes
  39.  200  CONTINUE
  40.       N=IEVOLL(/1)
  41.       IF ((K .GT. N) .OR. (K .LT. 0)) THEN
  42.         INTERR(1)=K
  43.         INTERR(2)=1
  44.         INTERR(3)=N
  45.         SEGSUP,MEVOLL
  46.         CALL ERREUR(1068)
  47.         RETURN
  48.       ENDIF
  49.  
  50. C     Traitement style des courbes :
  51.       IF (ITIT.GT.4) THEN
  52.         IF (IENT1.EQ.0) THEN 
  53.           CHAR2(1:4) = CHAR1(1:4)
  54. C          write(6,*)'chevol:char2=',char2
  55.           IF (ITIT.EQ.5) THEN
  56.             CALL PLACE(MOSTYL,NBSTY,IENT1,CHAR2)
  57.             IF(IERR.NE.0) RETURN
  58.           ELSE IF (ITIT.EQ.6) THEN
  59.             CALL PLACE(MOMARQ,NBMAR,IENT1,CHAR2)
  60.             IF(IERR.NE.0) RETURN
  61.           ELSE IF (ITIT.EQ.7) THEN
  62.             CALL PLACE(MOTAIL,NBTAI,IENT1,CHAR2)
  63.             IF(IERR.NE.0) RETURN
  64.           ELSE IF (ITIT.EQ.8) THEN
  65.             CALL PLACE(NCOUL,NBCOUL,IENT1,CHAR2)
  66.             IF(IERR.NE.0) RETURN
  67.             IENT1 = IENT1 - 1
  68.           ENDIF
  69.         ELSE
  70.           IF (IENT1.EQ.-1) IENT1=0
  71.           IF (ITIT.EQ.5) THEN
  72.             IENT1 = MAX(IENT1,0)
  73.             IENT1 = MOD(IENT1,NBSTY)
  74.             IF (IENT1.EQ.0) IENT1 = NBSTY
  75.           ELSE IF (ITIT.EQ.6) THEN
  76.             IENT1 = MAX(IENT1,0)
  77.             IENT1 = MOD(IENT1,NBMAR)
  78.             IF (IENT1.EQ.0) IENT1 = NBMAR
  79.           ELSE IF (ITIT.EQ.7) THEN
  80.             IENT1 = MAX(IENT1,1)
  81.             IENT1 = MOD(IENT1-1,NBTAI)+1
  82.           ELSE IF (ITIT.EQ.8) THEN
  83.             IF (IENT1.LT.0) IENT1 = IDCOUL
  84.             IENT1 = MOD(IENT1-1,NBCOUL)+1
  85.             IENT1 = IENT1 - 1
  86.           ENDIF
  87.         ENDIF
  88. C       write(6,*)'chevol:ient1=',ient1,IDCOUL
  89.       ENDIF
  90.  
  91.       IF(K.NE.0) THEN
  92.         KI=K
  93.       ELSE
  94.         KI=1
  95.       ENDIF
  96.  
  97.  201  CONTINUE
  98.       KEVOL1=IEVOLL(KI)
  99.       SEGINI,KEVOLL=KEVOL1
  100.       IEVOLL(KI)=KEVOLL
  101.       IF(ITIT.EQ.2) KEVTEX=CHAR1
  102.       IF(ITIT.EQ.3) NOMEVX=CHAR1(1:12)
  103.       IF(ITIT.EQ.4) NOMEVY=CHAR1(1:12)
  104.       IF(ITIT.EQ.5) LSTYL = IENT1
  105.       IF(ITIT.EQ.6) MMARQ = IENT1
  106.       IF(ITIT.EQ.7) KTAIL = IENT1
  107.       IF(ITIT.EQ.8) NUMEVX = IENT1
  108.       SEGDES,KEVOLL
  109.       IF(K.EQ.0) THEN
  110.         KI=KI+1
  111.         IF(KI.LE.N)  GOTO 201
  112.       ENDIF
  113.       SEGDES,MEVOLL
  114.       RETURN
  115.  
  116.       END
  117.  
  118.  
  119.  
  120.  
  121.  
  122.  
  123.  

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