Télécharger la plaquette Cast3M


fr en

Télécharger crimp.eso

Retour à la liste

Numérotation des lignes : 

crimp

  1. C CRIMP     SOURCE    FANDEUR   21/12/15    21:15:01     10824          
  2.  
  3. C***********************************************************************
  4. C  OPERATEUR TRANSFORMANT UN OBJET EVOLUTION COMPLEXE
  5. C            REelleIMaginaire ----> MOPH  OU  MOdulePHase ----> REIM
  6. C
  7. C  CREATION    : 15/12/87 - F.ROULLIER
  8. C  TRANSFORMATION DIRECTIVE EN OPERATEUR : 15/12/2021 FA 10824
  9. C***********************************************************************
  10.  
  11.       SUBROUTINE CRIMP
  12.  
  13.       IMPLICIT INTEGER(I-N)
  14.       IMPLICIT REAL*8(A-H,O-Z)
  15.  
  16. -INC PPARAM
  17. -INC CCOPTIO
  18.  
  19. -INC SMEVOLL
  20. -INC SMLREEL
  21.       POINTEUR MLREE4.MLREEL
  22.  
  23.       IEVOS = 0
  24.  
  25.       CALL LIROBJ('EVOLUTIO',IEVOE,1,IRETOU)
  26.       IF (IERR.NE.0) RETURN
  27.  
  28.       MEVOL1 = IEVOE
  29.       SEGINI,MEVOLL=MEVOL1
  30.  
  31. C  L'OBJET EVOLUTION DOIT ETRE DE SOUS-TYPE COMPLEXE
  32.       IF (mevoll.ITYEVO(1:8).NE.'COMPLEXE') THEN
  33.         MOTERR(1:8) = 'EVOLUTIO'
  34.         CALL ERREUR(302)
  35.         GOTO 999
  36.       ENDIF
  37.  
  38.       NC = mevoll.IEVOLL(/1)
  39.  
  40.       DO IC = 1, NC
  41.         KEVOL1 = mevoll.IEVOLL(IC)
  42.         SEGINI,KEVOLL=KEVOL1
  43.         mevoll.IEVOLL(IC) = KEVOLL
  44.       ENDDO
  45.  
  46.       DO IC = 1, NC, 2
  47.         KEVOL1 = mevoll.IEVOLL(IC)
  48.         KEVOL2 = mevoll.IEVOLL(IC+1)
  49.  
  50.         MLREE1 = KEVOL1.IPROGY
  51.         MLREE2 = KEVOL2.IPROGY
  52.         SEGACT,MLREE1,MLREE2
  53.         NPT1 = MLREE1.PROG(/1)
  54.         NPT2 = MLREE2.PROG(/1)
  55.         IF (NPT1.NE.NPT2) THEN
  56.           CALL ERREUR(217)
  57.           GOTO 999
  58.         ENDIF
  59.         JG = NPT1
  60.         SEGINI,MLREE3,MLREE4
  61.  
  62. C     TEST DES SOUS-TYPES
  63.         IF (KEVOL1.NUMEVY(1:4).EQ.'PREE') THEN
  64.           IF (KEVOL2.NUMEVY(1:4).NE.'PIMA') THEN
  65.             MOTERR(1:8) = 'PIMA    '
  66.             CALL ERREUR(37)
  67.             GOTO 999
  68.           ENDIF
  69.           KEVOL1.NUMEVY = 'MODU'
  70.           KEVOL2.NUMEVY = 'PHAS'
  71.           CALL CONVCP(MLREE1.PROG(1),MLREE2.PROG(1),
  72.      &                MLREE3.PROG(1),MLREE4.PROG(1),
  73.      &                NPT1,+1)
  74.         ELSE IF (KEVOL1.NUMEVY(1:4).EQ.'MODU') THEN
  75.           IF (KEVOL2.NUMEVY(1:4).NE.'PHAS') THEN
  76.             MOTERR(1:8) = 'PHAS    '
  77.             CALL ERREUR(37)
  78.             GOTO 999
  79.           ENDIF
  80.           KEVOL1.NUMEVY = 'PREE'
  81.           KEVOL2.NUMEVY = 'PIMA'
  82.           CALL CONVCP(MLREE3.PROG(1),MLREE4.PROG(1),
  83.      &                MLREE1.PROG(1),MLREE2.PROG(1),
  84.      &                NPT1,-1)
  85.         ELSE
  86.           MOTERR(1:8) = 'PREEMODU'
  87.           CALL ERREUR(37)
  88.           GOTO 999
  89.         ENDIF
  90.         SEGDES,MLREE1,MLREE2
  91.         SEGDES,MLREE3,MLREE4
  92.  
  93.         KEVOL1.IPROGY = MLREE3
  94.         KEVOL2.IPROGY = MLREE4
  95.         SEGDES,KEVOL1,KEVOL2
  96.  
  97.       ENDDO
  98.  
  99.       SEGDES,MEVOLL
  100.       IEVOS = MEVOLL
  101.       CALL ECROBJ('EVOLUTIO',IEVOS)
  102.  
  103.  999  CONTINUE
  104.  
  105. C      RETURN
  106.       END
  107.  
  108.  
  109.  

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