Esope source files

   1 : C COTRAD    SOURCE    CHAT      05/01/12    22:23:36     5004           
   2 :       SUBROUTINE COTRAD(WRK0,WRK2,NCOURB,KERRE)
   3 : C-----------------------------------------------------------------
   4 : C
   5 : C     RECUPERAGE DE COURBE ADAPTE A TAKEDA
   6 : C
   7 : C     PP 18/9/92
   8 : C-----------------------------------------------------------------
   9 :       IMPLICIT INTEGER(I-N)
  10 :       IMPLICIT REAL*8(A-H,O-Z)
  11 : -INC SMEVOLL
  12 : -INC SMLREEL
  13 :       SEGMENT WRK0
  14 :         REAL*8 XMAT(NCOMAT)
  15 :       ENDSEGMENT
  16 :       SEGMENT WRK2
  17 :         REAL*8 TRAC(LTRAC)
  18 :       ENDSEGMENT
  19 : *
  20 : *     QUELQUES INITIALISATIONS A 0
  21 : *
  22 :       KERRE=0
  23 :       NCOURB=0
  24 :       LTRAC=TRAC(/1)
  24 :       CALL ZDANUL(TRAC,LTRAC)
  25 : *
  26 : *     LOIS MOMENT-COURBURE ...
  27 : *
  28 :       MEVOLL=XMAT(5)
  29 :       IF(MEVOLL.EQ.0) THEN
  30 :         KERRE=37
  31 :         RETURN
  32 :       ENDIF
  33 :       SEGACT MEVOLL
  34 :       IF(IEVOLL(/1).NE.1) THEN
  35 :         KERRE=31
  36 :         SEGDES MEVOLL
  37 :         RETURN
  38 :       ENDIF
  39 : *
  40 : *     COURBE  ( SELON Y )
  41 : *
  42 :       KEVOLL=IEVOLL(1)
  43 :       SEGACT KEVOLL
  44 :       MLREEL=IPROGX
  45 :       MLREE1=IPROGY
  46 :       SEGDES KEVOLL
  47 :       SEGACT MLREEL,MLREE1
  48 :       NBPOIX=PROG(/1)
  49 :       NBPOIY=MLREE1.PROG(/1)
  50 :       IF(NBPOIX.NE.NBPOIY) KERRE=31
  51 :       IF(NBPOIX.GT.7) KERRE=31
  52 :       IF(NBPOIX.LT.4) KERRE=32
  53 : *
  54 : *   ERREUR
  55 : *
  56 :       IF(KERRE.NE.0) THEN
  57 :         SEGDES MLREEL,MLREE1
  58 :         SEGDES MEVOLL
  59 :         RETURN
  60 :       ENDIF
  61 : *
  62 :       DO 10 I=1,NBPOIX
  63 :         PEPS=PROG(I)
  64 :         PSIG=MLREE1.PROG(I)
  65 :         NCOURB=NCOURB+1
  66 :         TRAC(2*NCOURB-1)=PSIG
  67 :         TRAC(2*NCOURB)  =PEPS
  68 :   10  CONTINUE
  69 : C
  70 :       SEGDES MLREEL,MLREE1
  71 :       SEGDES MEVOLL
  72 :       RETURN
  73 :       END
  74 :  
  75 :