Sources Esope | Cast3M

chevol
C CHEVOL    SOURCE    SP204843  24/09/27    21:15:03     12017          
C
      SUBROUTINE CHEVOL(IEV1,ITIT,K,CHAR1,IENT1,IEV2)
      IMPLICIT REAL*8 (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
C***********************************************************************
C NOM         : CHEVOL
C DESCRIPTION : Change certains noms dans une evolution
C
C
C LANGAGE     : ESOPE
C CREATION    : bp, 2015-05-12
c MODIFS      : ...
c
C***********************************************************************
      PARAMETER    (NBSTY=7,NBMAR=13,NBTAI=5)
      CHARACTER*4  MOSTYL(NBSTY),MOMARQ(NBMAR),MOTAIL(NBTAI),CHAR2
      CHARACTER*72 CHAR1
 
      DATA MOSTYL/'LIGN','TIRR','TIRC','TIRL','TIRM','POIN','NOLI'/
      DATA MOMARQ/'CROI','PLUS','MOIN','BARR','ETOI','CARR',
     &            'LOSA','ROND','TRID','TRIU','TRIL','TRIR',
     &            'NOMA'/
      DATA MOTAIL/'XS','S','M','L','XL'/
 
-INC SMEVOLL
-INC PPARAM
-INC CCOPTIO
-INC CCGEOME
 
 
      MEVOL1=IEV1
      SEGINI,MEVOLL=MEVOL1
      IEV2=MEVOLL
 
C     Aiguillage
      GOTO(100,200,200,200,200,200,200,200),ITIT
 
C     Modif du titre general
 100  CONTINUE
      IEVTEX=CHAR1
      SEGDES,MEVOLL
      RETURN
 
C     Modif du titre d'une ou de toutes les legendes
 200  CONTINUE
      N=IEVOLL(/1)
      IF ((K .GT. N) .OR. (K .LT. 0)) THEN
        INTERR(1)=K
        INTERR(2)=1
        INTERR(3)=N
        SEGSUP,MEVOLL
        CALL ERREUR(1068)
        RETURN
      ENDIF
 
C     Traitement style des courbes :
      IF (ITIT.GT.4) THEN
        IF (IENT1.EQ.0) THEN 
          CHAR2(1:4) = CHAR1(1:4)
C          write(6,*)'chevol:char2=',char2
          IF (ITIT.EQ.5) THEN
            CALL PLACE(MOSTYL,NBSTY,IENT1,CHAR2)
            IF(IERR.NE.0) RETURN
          ELSE IF (ITIT.EQ.6) THEN
            CALL PLACE(MOMARQ,NBMAR,IENT1,CHAR2)
            IF(IERR.NE.0) RETURN
          ELSE IF (ITIT.EQ.7) THEN
            CALL PLACE(MOTAIL,NBTAI,IENT1,CHAR2)
            IF(IERR.NE.0) RETURN
          ELSE IF (ITIT.EQ.8) THEN
            CALL PLACE(NCOUL,NBCOUL,IENT1,CHAR2)
            IF(IERR.NE.0) RETURN
            IENT1 = IENT1 - 1
          ENDIF
        ELSE
          IF (IENT1.EQ.-1) IENT1=0
          IF (ITIT.EQ.5) THEN
            IENT1 = MAX(IENT1,0)
            IENT1 = MOD(IENT1,NBSTY)
            IF (IENT1.EQ.0) IENT1 = NBSTY
          ELSE IF (ITIT.EQ.6) THEN
            IENT1 = MAX(IENT1,0)
            IENT1 = MOD(IENT1,NBMAR)
            IF (IENT1.EQ.0) IENT1 = NBMAR
          ELSE IF (ITIT.EQ.7) THEN
            IENT1 = MAX(IENT1,1)
            IENT1 = MOD(IENT1-1,NBTAI)+1
          ELSE IF (ITIT.EQ.8) THEN
            IF (IENT1.LT.0) IENT1 = IDCOUL
            IENT1 = MOD(IENT1-1,NBCOUL)+1
            IENT1 = IENT1 - 1
          ENDIF
        ENDIF
C       write(6,*)'chevol:ient1=',ient1,IDCOUL
      ENDIF
 
      IF(K.NE.0) THEN
        KI=K
      ELSE
        KI=1
      ENDIF
 
 201  CONTINUE
      KEVOL1=IEVOLL(KI)
      SEGINI,KEVOLL=KEVOL1
      IEVOLL(KI)=KEVOLL
      IF(ITIT.EQ.2) KEVTEX=CHAR1
      IF(ITIT.EQ.3) NOMEVX=CHAR1(1:12)
      IF(ITIT.EQ.4) NOMEVY=CHAR1(1:12)
      IF(ITIT.EQ.5) LSTYL = IENT1
      IF(ITIT.EQ.6) MMARQ = IENT1
      IF(ITIT.EQ.7) KTAIL = IENT1
      IF(ITIT.EQ.8) NUMEVX = IENT1
      SEGDES,KEVOLL
      IF(K.EQ.0) THEN
        KI=KI+1
        IF(KI.LE.N)  GOTO 201
      ENDIF
      SEGDES,MEVOLL
      RETURN
 
      END