Télécharger la plaquette Cast3M


fr en

Télécharger borne3.eso

Retour à la liste

Numérotation des lignes : 

borne3

  1. C BORNE3    SOURCE    FANDEUR   11/04/12    21:15:06     6938
  2.  
  3.       SUBROUTINE BORNE3 (IEVOLE,MLIEVO,MLIOPE,MLBMIN,MLBMAX, IEVOLS)
  4.  
  5.       IMPLICIT INTEGER(I-N)
  6.       IMPLICIT REAL*8(A-H,O-Z)
  7.  
  8.  
  9. -INC PPARAM
  10. -INC CCOPTIO
  11. -INC SMEVOLL
  12. -INC SMLENTI
  13. -INC SMLREEL
  14.  
  15. C- Activation de l'evolution en entree
  16.       MEVOL1 = IEVOLE
  17.       SEGACT,MEVOL1
  18.       NCOUR = MEVOL1.IEVOLL(/1)
  19.  
  20. C- Creation de l'evolution resultat
  21.       IEVOLS = 0
  22.       SEGINI,MEVOLL=MEVOL1
  23.  
  24. C- Quelques verifications
  25.       MLENTI = MLIEVO
  26. C*    SEGACT,MLENTI
  27.       DO i = 1, LECT(/1)
  28.         icour = LECT(i)
  29.         IF (icour.LE.0) THEN
  30.           CALL ERREUR(352)
  31.         ELSE IF (icour.GT.NCOUR) THEN
  32.           INTERR(1) = icour
  33.           CALL ERREUR(351)
  34.         ELSE
  35.           DO j = 1, i-1
  36.             IF (icour.EQ.LECT(j)) LECT(j) = 0
  37.           ENDDO
  38.         ENDIF
  39.       ENDDO
  40.       IF (IERR.NE.0) GOTO 900
  41.       N = 0
  42.       DO i = 1, LECT(/1)
  43.         IF (LECT(i).NE.0) N = N+1
  44.       ENDDO
  45.       IF (N.EQ.0) CALL ERREUR(5)
  46.       IF (N.NE.NCOUR) SEGADJ,MEVOLL
  47.  
  48. C- Realisation du bornage des courbes
  49.       MLENT1 = MLIOPE
  50. C*    SEGACT,MLENT1
  51.       MLREE1 = MLBMIN
  52. C*    SEGACT,MLREE1
  53.       MLREE2 = MLBMAX
  54. C*    SEGACT,MLREE2
  55.  
  56.       N = 0
  57.       DO i = 1, LECT(/1)
  58.         icour = LECT(i)
  59.         IF (icour.NE.0) THEN
  60.           N = N+1
  61.           KEVOL1 = MEVOL1.IEVOLL(icour)
  62.           SEGINI,KEVOLL=KEVOL1
  63.           ILREEE = IPROGY
  64.           INDOPE = MLENT1.LECT(i)
  65.           XBMIN  = MLREE1.PROG(i)
  66.           XBMAX  = MLREE2.PROG(i)
  67.           CALL BORNE2(ILREEE,INDOPE,XBMIN,XBMAX,ILREES)
  68.           IPROGY = ILREES
  69.           SEGDES,KEVOLL
  70.           IEVOLL(N) = KEVOLL
  71.         ENDIF
  72.       ENDDO
  73.  
  74.       IEVOLS = MEVOLL
  75.  
  76.  900  CONTINUE
  77.       IF (IEVOLS.NE.0) THEN
  78.         SEGDES,MEVOLL
  79.       ELSE
  80.         SEGSUP,MEVOLL
  81.       ENDIF
  82.       SEGDES,MEVOL1
  83.  
  84.       RETURN
  85.       END
  86.  
  87.  
  88.  
  89.  

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