Télécharger la plaquette Cast3M


fr en

Télécharger spltcc.eso

Retour à la liste

Numérotation des lignes : 

spltcc

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

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