Télécharger la plaquette Cast3M


fr en

Télécharger crepi0.eso

Retour à la liste

Numérotation des lignes : 

crepi0

  1. C CREPI0    SOURCE    CB215821  19/07/30    21:15:46     10273          
  2.       SUBROUTINE CREPI0(ICOLAC)
  3.       IMPLICIT INTEGER(I-N)
  4. -INC TMCOLAC
  5. -INC SMCOORD
  6.  
  7. -INC PPARAM
  8. -INC CCOPTIO
  9.         SEGACT ICOLAC*MOD
  10.         call ooohor(0)
  11.         DO 2 I=1,KCOLA(/1)
  12.         ITLACC=KCOLA(I)
  13.         SEGACT ITLACC*MOD
  14.         ISGTR=ICOLA(I)
  15.         SEGACT ISGTR*MOD
  16. C        write(6,*)' crepi0 itlacc isgtr',itlacc,isgtr
  17.     2   CONTINUE
  18. * pour les piles entiers flottant mot logique on réecrit tout
  19.         ks=0
  20.         do i=24,27
  21.           itlacc=kcola(i)
  22.           segsup itlacc
  23.           segini itlacc
  24.           mcola(i)=0
  25.           kcola(i)=itlacc
  26.           ISGTR=ICOLA(I)
  27.           segsup isgtr
  28.           segini isgtr
  29.           icola(i)=isgtr
  30.           kcolac(i)=0
  31.         enddo
  32. *      on vide la table inverse des reels
  33.         ILISSE = ILISSF
  34.         segact ilisse*mod
  35.         do i=1,iliseg(/1)
  36.          iliseg(i)=0
  37.         enddo
  38.  
  39.         ILISSE = ILISSG
  40.         SEGACT ILISSE*MOD
  41. *
  42. * pour les piles des tables (N° 10) et des OBJETS(N° 44) on
  43. * duplique les objets existants AU niveau de l'attribution des noms
  44. * il faudra parcourir la pile en sens inverse
  45. *  idem pour les config
  46.       ITLACC=KCOLA(10)
  47.       IN=ITLAC(/1)
  48.       IF(IN.NE.0) THEN
  49.         DO 1 J=1,IN
  50.          IF(ITLAC(J).NE.0) THEN
  51. *           ITLAC(**)=ITLAC(J)
  52.             ILISEG((ITLAC(J)-1)/npgcd)=0
  53.            ITLAC(J)=0
  54.          ENDIF
  55.     1   CONTINUE
  56.       ENDIF
  57.       ITLACC=KCOLA(44)
  58.       IN=ITLAC(/1)
  59.       IF(IN.NE.0) THEN
  60.         DO 3 J=1,IN
  61.          IF(ITLAC(J).NE.0) THEN
  62. *           ITLAC(**)=ITLAC(J)
  63.             ILISEG((ITLAC(J)-1)/npgcd)=0
  64.            ITLAC(J)=0
  65.          ENDIF
  66.     3   CONTINUE
  67.       ENDIF
  68. C pour les configu on met en premier la configuration courante
  69.       ITLACC=KCOLA(33)
  70. *      ITLAC(**)=MCOORD
  71.       IN=ITLAC(/1)
  72. ****  IF(IN.NE.1) THEN
  73. * on resauve toujours la configuration courante au cas ou il y ait eu renumerotation
  74.         DO 4 J=1,IN
  75.          IF(ITLAC(J).NE.0) THEN
  76. *           IF(ITLAC(J).NE.MCOORD)ITLAC(**)=ITLAC(J)
  77.            ILISEG((ITLAC(J)-1)/npgcd)=0
  78.            ITLAC(J)=0
  79.          ENDIF
  80.     4   CONTINUE
  81. **    ENDIF
  82.       RETURN
  83.       END
  84.  
  85.  
  86.  
  87.  
  88.  
  89.  
  90.  
  91.  
  92.  
  93.  
  94.  
  95.  
  96.  
  97.  

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