Download spltcc.eso

Back to the list

   1 : C SPLTCC    SOURCE    MAGN      09/07/30    21:21:00     6458           
   2 :       SUBROUTINE SPLTCC
   3 :       IMPLICIT INTEGER(I-N)
   4 :       IMPLICIT REAL*8 (A-H,O-Z)
   5 : -INC SMMATRIK
   6 :       POINTEUR MAT1.MATRIK,MAT2.MATRIK
   7 : 
   8 : 
   8 :       CALL LIROBJ('MATRIK',MATRIK,1,IRET)
   9 :             IF(IRET.EQ.0)RETURN
  10 : 
  11 :             NRIGE=7
  12 :             NMATRI=0
  13 :             NKID =9
  14 :             NKMT =7
  15 :             SEGINI MAT1,MAT2
  16 : 
  17 :       NMAT1=0
  18 :       NMAT2=0
  19 : 
  20 :       SEGACT MATRIK
  21 :       NMATR=IRIGEL(/2)
  22 :       DO 1 L=1,NMATR
  23 :       IF(IRIGEL(7,L).NE.4)THEN
  24 :       NMAT1 = NMAT1 + 1
  25 :       NMATRI=NMAT1
  26 :       SEGADJ MAT1
  26 :       CALL RSETI(MAT1.IRIGEL(1,NMATRI),IRIGEL(1,L),NRIGE)
  27 :       ELSE
  28 :       NMAT2 = NMAT2 + 1
  29 :       NMATRI=NMAT2
  30 :       SEGADJ MAT2
  30 :       CALL RSETI(MAT2.IRIGEL(1,NMATRI),IRIGEL(1,L),NRIGE)
  31 :       MAT2.IRIGEL(7,NMATRI)=-3
  32 :       ENDIF
  33 :  1    CONTINUE
  34 :       SEGDES MATRIK,MAT1,MAT2
  35 :       IF(NMAT2.EQ.0)RETURN
  36 : 
  37 : 
  37 :       CALL ECROBJ('MATRIK',MAT2)
  37 :       CALL ECROBJ('MATRIK',MAT1)
  38 :       RETURN
  39 :       END
  40 :  
  41 :  
  42 :  

© Cast3M 2003 - All rights reserved.
Disclaimer