Télécharger la plaquette Cast3M


fr en

Télécharger ecevol.eso

Retour à la liste

Numérotation des lignes : 

ecevol

  1. C ECEVOL    SOURCE    FANDEUR   21/04/20    21:15:01     10973          
  2.  
  3.       SUBROUTINE ECEVOL(MEVOLL,jentet)
  4.       IMPLICIT INTEGER(I-N)
  5.       IMPLICIT REAL*8(A-H,O-Z)
  6. C
  7. C  ====================================================================
  8. C  =  ECRITURE DE L'OBJET EVOLUTION                                   =
  9. C  =  CREATION    : 01/10/86                                          =
  10. C  =  PROGRAMMEUR : GUILBAUD                                          =
  11. C  ====================================================================
  12. C
  13. -INC PPARAM
  14. -INC CCOPTIO
  15. -INC CCGEOME
  16.  
  17. -INC SMLREEL
  18. -INC SMEVOLL
  19. -INC SMLENTI
  20. -INC SMLMOTS
  21.  
  22.       SEGACT MEVOLL
  23.       WRITE (IOIMP,100) IEVTEX
  24.  100  FORMAT (2X,A72)
  25.       N=IEVOLL(/1)
  26.       INTERR(1)=MEVOLL
  27.       INTERR(2)=N
  28.       MOTERR(1:8)=ITYEVO
  29.       CALL ERREUR(-116)
  30. C
  31.       DO 1 I=1,N
  32.       KEVOLL=IEVOLL(I)
  33.       SEGACT KEVOLL
  34.       INTERR(1)=I
  35.       MOTERR(1:4)=NCOUL(NUMEVX)
  36.       CALL ERREUR(-117)
  37.       WRITE (IOIMP,100) KEVTEX
  38.       MOTERR(1:12)= NOMEVX
  39.       CALL ERREUR(-118)
  40.       MOTERR(1:4)=NUMEVY
  41.       MOTERR(5:16)=NOMEVY
  42.       CALL ERREUR(-119)
  43.  
  44.       IF(TYPX.EQ.'LISTREEL')THEN
  45.          MLREEL=IPROGX
  46.          SEGACT MLREEL
  47.          NPAS=PROG(/1)
  48.          npi=npas
  49.          if(jentet.eq.1) npi=min(npi,10)
  50.          INTERR(1)=NPAS
  51.          CALL ERREUR(-120)
  52.  
  53.          IF(TYPY.EQ.'LISTREEL') THEN
  54.             MLREE2=IPROGY
  55.             SEGACT,MLREE2
  56.             WRITE(IOIMP,101)(J,PROG(J),MLREE2.PROG(J),J=1,NPi)
  57. C 101        FORMAT(/4(1X,I5,1X,1PE12.5,1X,1PE12.5,1X))
  58.  101        FORMAT(/(3X,I5,3X,1PE12.5,3X,1PE12.5))
  59.             SEGDES,MLREE2
  60.  
  61.           ELSEIF(TYPY.EQ.'LISTMOTS') THEN
  62.             MLMOT2=IPROGY
  63.             SEGACT,MLMOT2
  64.             WRITE(IOIMP,102)(J,PROG(J),MLMOT2.MOTS(J),J=1,NPi)
  65. C 102        FORMAT(/4(1X,I5,1X,1PE12.5,1X,A8,1X))
  66.  102        FORMAT(/(3X,I5,3X,1PE12.5,3X,A24))
  67.             SEGDES,MLMOT2
  68.  
  69.           ELSEIF(TYPY.EQ.'LISTENTI') THEN
  70.             MLENT2=IPROGY
  71.             SEGACT,MLENT2
  72.             WRITE(IOIMP,103)(J,PROG(J),MLENT2.LECT(J),J=1,NPi)
  73. C 103        FORMAT(/4(1X,I5,1X,1PE12.5,1X,A8,1X))
  74.  103        FORMAT(/(3X,I5,3X,1PE12.5,3X,I8))
  75.             SEGDES,MLENT2
  76.           ENDIF
  77.           SEGDES,MLREEL
  78.  
  79.       ELSEIF(TYPX.EQ.'LISTMOTS') THEN
  80.          MLMOTS=IPROGX
  81.          SEGACT MLMOTS
  82.          NPAS=MOTS(/2)
  83.          npi=npas
  84.          if(jentet.eq.1) npi=min(npi,10)
  85.          INTERR(1)=NPAS
  86.          CALL ERREUR(-120)
  87.  
  88.          IF(TYPY.EQ.'LISTREEL') THEN
  89.             MLREE2=IPROGY
  90.             SEGACT,MLREE2
  91.             WRITE(IOIMP,111)(J,MOTS(J),MLREE2.PROG(J),J=1,NPi)
  92. C 111        FORMAT(/4(1X,I5,1X,A8,1X,1PE12.5,1X))
  93.  111        FORMAT(/(3X,I5,3X,A24,3X,1PE12.5))
  94.             SEGDES,MLREE2
  95.  
  96.           ELSEIF(TYPY.EQ.'LISTMOTS') THEN
  97.             MLMOT2=IPROGY
  98.             SEGACT,MLMOT2
  99.             WRITE(IOIMP,112)(J,MOTS(J),MLMOT2.MOTS(J),J=1,NPi)
  100. C 112         FORMAT(/4(1X,I5,1X,A8,1X,A8,1X))
  101.  112         FORMAT(/(3X,I5,3X,A24,3X,A24))
  102.             SEGDES,MLMOT2
  103.  
  104.           ELSEIF(TYPY.EQ.'LISTENTI') THEN
  105.             MLENT2=IPROGY
  106.             SEGACT,MLENT2
  107.             WRITE(IOIMP,113)(J,MOTS(J),MLENT2.LECT(J),J=1,NPi)
  108. C 113         FORMAT(/4(1X,I5,1X,A8,1X,A8,1X))
  109.  113         FORMAT(/(3X,I5,3X,A24,3X,I8))
  110.             SEGDES,MLENT2
  111.           ENDIF
  112.           SEGDES,MLMOTS
  113.  
  114.       ELSEIF(TYPX.EQ.'LISTENTI') THEN
  115.          MLENTI=IPROGX
  116.          SEGACT MLENTI
  117.          NPAS=LECT(/1)
  118.          npi=npas
  119.          if(jentet.eq.1) npi=min(npi,10)
  120.          INTERR(1)=NPAS
  121.          CALL ERREUR(-120)
  122.  
  123.          IF(TYPY.EQ.'LISTREEL') THEN
  124.             MLREE2=IPROGY
  125.             SEGACT,MLREE2
  126.             WRITE(IOIMP,121)(J,LECT(J),MLREE2.PROG(J),J=1,NPi)
  127. C 121        FORMAT(/4(1X,I5,1X,A8,1X,1PE12.5,1X))
  128.  121        FORMAT(/(3X,I5,3X,I8,3X,1PE12.5))
  129.             SEGDES,MLREE2
  130.  
  131.           ELSEIF(TYPY.EQ.'LISTMOTS') THEN
  132.             MLMOT2=IPROGY
  133.             SEGACT MLMOT2
  134.             WRITE(IOIMP,122)(J,LECT(J),MLMOT2.MOTS(J),J=1,NPi)
  135. C 122         FORMAT(/4(1X,I5,1X,A8,1X,A8,1X))
  136.  122         FORMAT(/(3X,I5,3X,I8,3X,A24))
  137.             SEGDES,MLMOT2
  138.  
  139.           ELSEIF(TYPY.EQ.'LISTENTI') THEN
  140.             MLENT2=IPROGY
  141.             SEGACT,MLENT2
  142.             WRITE(IOIMP,123)(J,LECT(J),MLENT2.LECT(J),J=1,NPi)
  143. C 123         FORMAT(/4(1X,I5,1X,A8,1X,A8,1X))
  144.  123         FORMAT(/(3X,I5,3X,I8,3X,I8))
  145.             SEGDES,MLENT2
  146.           ENDIF
  147.           SEGDES,MLENTI
  148.       ENDIF
  149.       SEGDES KEVOLL
  150.    1  CONTINUE
  151.       SEGDES MEVOLL
  152.  
  153. C      RETURN
  154.       END
  155.  
  156.  
  157.  

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