Télécharger la plaquette Cast3M


fr en

Télécharger ksisig.eso

Retour à la liste

Numérotation des lignes : 

ksisig

  1. C KSISIG    SOURCE    PV        11/03/07    21:17:24     6885
  2.       SUBROUTINE KSISIG(WRK0,JC,WRK2,NCOURB,KERRE)
  3.       IMPLICIT INTEGER(I-N)
  4.       IMPLICIT REAL*8(A-H,O-Z)
  5. -INC SMEVOLL
  6. -INC SMLREEL
  7.       SEGMENT WRK0
  8.        REAL*8 XMAT(NCOMAT)
  9.       ENDSEGMENT
  10.       SEGMENT/WRK2/(TRAC(LTRAC)*D)
  11.       DATA NCOMAX/130/
  12.       KERRE=0
  13.       MEVOLL=nint(XMAT(JC))
  14.       IF(MEVOLL.EQ.0) THEN
  15.       KERRE=37
  16.       RETURN
  17.       ENDIF
  18.       SEGACT MEVOLL
  19.       KEVOLL=IEVOLL(1)
  20.       SEGACT KEVOLL
  21.       MLREEL=IPROGX
  22.       MLREE1=IPROGY
  23.       SEGDES KEVOLL
  24.       SEGACT MLREEL,MLREE1
  25.       NBPOIX=PROG(/1)
  26.       NBPOIY=MLREE1.PROG(/1)
  27.       IF(NBPOIX.GT.NCOMAX+1) KERRE=31
  28.       IF(NBPOIX.LT.2)        KERRE=32
  29.       IF(KERRE.EQ.0) GO TO 693
  30.  692  CONTINUE
  31. C
  32. C   ERREUR
  33. C
  34.       SEGDES MLREEL,MLREE1
  35.       SEGDES MEVOLL
  36.       GO TO 777
  37.  693  CONTINUE
  38. C
  39. C        VERIFICATION ANODINE
  40. C
  41.       DO 100 I=3,NBPOIX
  42.       I1=I-1
  43.       DEPS=PROG(I)-PROG(I1)
  44.       IF(DEPS.EQ.0.D0) THEN
  45.       KERRE=33
  46.       GO TO 692
  47.       ENDIF
  48.  100  CONTINUE
  49. C
  50.       NCOURB=0
  51.       DO 695 I=1,NBPOIX
  52.       PKSI=PROG(I)
  53.       PK=MLREE1.PROG(I)
  54.       NCOURB=NCOURB+1
  55.       TRAC(2*NCOURB-1)=PKSI
  56.       TRAC(2*NCOURB)=PK
  57.   695 CONTINUE
  58. C
  59.       SEGDES MLREEL,MLREE1
  60.       SEGDES MEVOLL
  61.       RETURN
  62. C
  63.   777 CONTINUE
  64.       RETURN
  65.       END
  66.  
  67.  
  68.  

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