Télécharger crimp.eso

Retour à la liste

Numérotation des lignes :

  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
  23. CALL LIROBJ('EVOLUTIO',IRET,1,IRETOU)
  24. IF(IERR.NE.0) GOTO 5000
  25. C
  26. MEVOLL=IRET
  27. SEGACT MEVOLL
  28. C
  29. C L'OBJET EVOLUTION DOIT ETRE DE SOUS-TYPE COMPLEXE
  30. C
  31. IF (MEVOLL.ITYEVO.EQ.'COMPLEXE') GO TO 198
  32. 197 MOTERR(1:8)='EVOLUTIO'
  33. CALL ERREUR(302)
  34. SEGDES MEVOLL
  35. RETURN
  36. 198 CONTINUE
  37. NC=IEVOLL(/1)
  38. DO 200 IC=1,NC,2
  39. KEVOL1=IEVOLL(IC)
  40. KEVOL2=IEVOLL(IC+1)
  41. SEGACT KEVOL1*MOD,KEVOL2*MOD
  42. MLREE1=KEVOL1.IPROGY
  43. MLREE2=KEVOL2.IPROGY
  44. SEGACT MLREE1*MOD,MLREE2*MOD
  45. NPT=MLREE1.PROG(/1)
  46. NPT2=MLREE2.PROG(/1)
  47. IF ( NPT .NE. NPT2 ) THEN
  48. CALL ERREUR(217)
  49. SEGDES KEVOL1,KEVOL2,MLREE1,MLREE2
  50. RETURN
  51. ENDIF
  52. SEGINI TEMPP
  53. C
  54. C TEST DES SOUS-TYPES
  55. C
  56. C
  57. IF (KEVOL1.NUMEVY.EQ.'PREE') THEN
  58. DO 100 I=1,NPT
  59. DR(I)=MLREE1.PROG(I)
  60. DI(I)=MLREE2.PROG(I)
  61. 100 CONTINUE
  62. CALL CONVCP(DR,DI,DM,DP,NPT,1)
  63. DO 110 I=1,NPT
  64. MLREE1.PROG(I)=DM(I)
  65. MLREE2.PROG(I)=DP(I)
  66. 110 CONTINUE
  67. KEVOL1.NUMEVY='MODU'
  68. KEVOL2.NUMEVY='PHAS'
  69. C
  70. ELSE
  71. DO 120 I=1,NPT
  72. DM(I)=MLREE1.PROG(I)
  73. DP(I)=MLREE2.PROG(I)
  74. 120 CONTINUE
  75. CALL CONVCP(DR,DI,DM,DP,NPT,-1)
  76. DO 130 I=1,NPT
  77. MLREE1.PROG(I)=DR(I)
  78. MLREE2.PROG(I)=DI(I)
  79. 130 CONTINUE
  80. KEVOL1.NUMEVY='PREE'
  81. KEVOL2.NUMEVY='PIMA'
  82. ENDIF
  83. SEGDES KEVOL1,KEVOL2,MLREE1,MLREE2
  84. C
  85. SEGSUP TEMPP
  86. 200 CONTINUE
  87. C
  88. SEGDES MEVOLL
  89. 5000 RETURN
  90. END
  91.  
  92.  
  93.  
  94.  

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