Esope source files

   1 : C CRIMP     SOURCE    CHAT      05/01/12    22:30:30     5004           
   2 :       SUBROUTINE CRIMP
   3 : C
   4 : C       DIRECTIVE TRANSFORMANT UN OBJET EVOLUTION
   5 : C                   REIM ----> MOPH
   6 : C                    ET VICE-VERSA
   7 : C
   8 : C     CREATION    : 15/12/87
   9 : C     F.ROULLIER
  10 : C***********************************************************************
  11 : C
  12 : C
  13 :       IMPLICIT INTEGER(I-N)
  14 :       IMPLICIT REAL*8(A-H,O-Z)
  15 : -INC CCOPTIO
  16 : -INC SMEVOLL
  17 : -INC SMLREEL
  18 :       SEGMENT TEMPP
  19 :       IMPLIED DR(NPT),DI(NPT),DM(NPT),DP(NPT)
  20 :       ENDSEGMENT
  21 : C
  22 : C
  22 :       CALL LIROBJ('EVOLUTIO',IRET,1,IRETOU)
  23 :       IF(IERR.NE.0) GOTO 5000
  24 : C
  25 :       MEVOLL=IRET
  26 :       SEGACT MEVOLL
  27 : C
  28 : C     L'OBJET EVOLUTION DOIT ETRE DE SOUS-TYPE COMPLEXE
  29 : C
  30 :       IF (MEVOLL.ITYEVO.EQ.'COMPLEXE') GO TO 198
  31 :   197 MOTERR(1:8)='EVOLUTIO'
  31 :       CALL ERREUR(302)
  32 :       SEGDES MEVOLL
  33 :       RETURN
  34 :   198 CONTINUE
  35 :       NC=IEVOLL(/1)
  36 :       DO 200 IC=1,NC,2
  37 :           KEVOL1=IEVOLL(IC)
  38 :           KEVOL2=IEVOLL(IC+1)
  39 :           SEGACT KEVOL1*MOD,KEVOL2*MOD
  40 :           MLREE1=KEVOL1.IPROGY
  41 :           MLREE2=KEVOL2.IPROGY
  42 :           SEGACT MLREE1*MOD,MLREE2*MOD
  43 :           NPT=MLREE1.PROG(/1)
  44 :           NPT2=MLREE2.PROG(/1)
  45 :           IF ( NPT .NE. NPT2 ) THEN
  45 :               CALL ERREUR(217)
  46 :               SEGDES  KEVOL1,KEVOL2,MLREE1,MLREE2
  47 :               RETURN
  48 :           ENDIF
  49 :               SEGINI TEMPP
  50 : C
  51 : C                 TEST DES SOUS-TYPES
  52 : C
  53 : C
  54 :               IF (KEVOL1.NUMEVY.EQ.'PREE') THEN
  55 :                   DO 100 I=1,NPT
  56 :                       DR(I)=MLREE1.PROG(I)
  57 :                       DI(I)=MLREE2.PROG(I)
  58 :   100             CONTINUE
  58 :                   CALL CONVCP(DR,DI,DM,DP,NPT,1)
  59 :                   DO 110 I=1,NPT
  60 :                       MLREE1.PROG(I)=DM(I)
  61 :                       MLREE2.PROG(I)=DP(I)
  62 :   110             CONTINUE
  63 :                   KEVOL1.NUMEVY='MODU'
  64 :                   KEVOL2.NUMEVY='PHAS'
  65 : C
  66 :               ELSE
  67 :                   DO 120 I=1,NPT
  68 :                       DM(I)=MLREE1.PROG(I)
  69 :                       DP(I)=MLREE2.PROG(I)
  70 :   120             CONTINUE
  70 :                   CALL CONVCP(DR,DI,DM,DP,NPT,-1)
  71 :                   DO 130 I=1,NPT
  72 :                       MLREE1.PROG(I)=DR(I)
  73 :                       MLREE2.PROG(I)=DI(I)
  74 :   130             CONTINUE
  75 :                   KEVOL1.NUMEVY='PREE'
  76 :                   KEVOL2.NUMEVY='PIMA'
  77 :               ENDIF
  78 :               SEGDES KEVOL1,KEVOL2,MLREE1,MLREE2
  79 : C
  80 :               SEGSUP TEMPP
  81 :  200      CONTINUE
  82 : C
  83 :           SEGDES MEVOLL
  84 :  5000     RETURN
  85 :           END
  86 : 
  87 :  
  88 :