C CRIMP     SOURCE    CHAT      05/01/12    22:30:30     5004           
      SUBROUTINE CRIMP
C
C       DIRECTIVE TRANSFORMANT UN OBJET EVOLUTION
C                   REIM ----> MOPH
C                    ET VICE-VERSA
C
C     CREATION    : 15/12/87
C     F.ROULLIER
C***********************************************************************
C
C
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
-INC CCOPTIO
-INC SMEVOLL
-INC SMLREEL
      SEGMENT TEMPP
      IMPLIED DR(NPT),DI(NPT),DM(NPT),DP(NPT)
      ENDSEGMENT
C
C
      CALL LIROBJ('EVOLUTIO',IRET,1,IRETOU)
      IF(IERR.NE.0) GOTO 5000
C
      MEVOLL=IRET
      SEGACT MEVOLL
C
C     L'OBJET EVOLUTION DOIT ETRE DE SOUS-TYPE COMPLEXE
C
      IF (MEVOLL.ITYEVO.EQ.'COMPLEXE') GO TO 198
  197 MOTERR(1:8)='EVOLUTIO'
      CALL ERREUR(302)
      SEGDES MEVOLL
      RETURN
  198 CONTINUE
      NC=IEVOLL(/1)
      DO 200 IC=1,NC,2
          KEVOL1=IEVOLL(IC)
          KEVOL2=IEVOLL(IC+1)
          SEGACT KEVOL1*MOD,KEVOL2*MOD
          MLREE1=KEVOL1.IPROGY
          MLREE2=KEVOL2.IPROGY
          SEGACT MLREE1*MOD,MLREE2*MOD
          NPT=MLREE1.PROG(/1)
          NPT2=MLREE2.PROG(/1)
          IF ( NPT .NE. NPT2 ) THEN
              CALL ERREUR(217)
              SEGDES  KEVOL1,KEVOL2,MLREE1,MLREE2
              RETURN
          ENDIF
              SEGINI TEMPP
C
C                 TEST DES SOUS-TYPES
C
C
              IF (KEVOL1.NUMEVY.EQ.'PREE') THEN
                  DO 100 I=1,NPT
                      DR(I)=MLREE1.PROG(I)
                      DI(I)=MLREE2.PROG(I)
  100             CONTINUE
                  CALL CONVCP(DR,DI,DM,DP,NPT,1)
                  DO 110 I=1,NPT
                      MLREE1.PROG(I)=DM(I)
                      MLREE2.PROG(I)=DP(I)
  110             CONTINUE
                  KEVOL1.NUMEVY='MODU'
                  KEVOL2.NUMEVY='PHAS'
C
              ELSE
                  DO 120 I=1,NPT
                      DM(I)=MLREE1.PROG(I)
                      DP(I)=MLREE2.PROG(I)
  120             CONTINUE
                  CALL CONVCP(DR,DI,DM,DP,NPT,-1)
                  DO 130 I=1,NPT
                      MLREE1.PROG(I)=DR(I)
                      MLREE2.PROG(I)=DI(I)
  130             CONTINUE
                  KEVOL1.NUMEVY='PREE'
                  KEVOL2.NUMEVY='PIMA'
              ENDIF
              SEGDES KEVOL1,KEVOL2,MLREE1,MLREE2
C
              SEGSUP TEMPP
 200      CONTINUE
C
          SEGDES MEVOLL
 5000     RETURN
          END