Esope source files

   1 : C RESMIK    SOURCE    MAGN      09/07/30    21:20:51     6458           
   2 :       SUBROUTINE RESMIK (ICOLAC,ITLACC,IMAX1,IDEB)
   3 : 
   4 :       IMPLICIT INTEGER(I-N)
   5 :       IMPLICIT REAL*8 (A-H,O-Z)
   6 : C***********************************************************************
   7 : C NOM         : RESMIK
   8 : C DESCRIPTION : Restauration des pointeurs dans les objets
   9 : C               de type MATRIK.
  10 : C               (appelé par restpi.eso)
  11 : C     
  12 : C LANGAGE     : ESOPE
  13 : C AUTEUR      : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/TTMF)
  14 : C               mél : gounand@semt2.smts.cea.fr
  15 : C***********************************************************************
  16 : C SYNTAXE GIBIANE    : -
  17 : C ENTREES            : ICOLAC, chapeau sur les piles ITLACC
  18 : C                      (une pour chaque type d'objets)
  19 : C                      IDEB, IMAX1, indice de début et de fin
  20 : C                      sur la pile d'objets MATRIK
  21 : C ENTREES/SORTIES    : ITLACC, la pile des objets MATRIK sur
  22 : C                      lesquels on va restaurer des pointeurs
  23 : C***********************************************************************
  24 : C VERSION    : v1, 15/07/98, version initiale
  25 : C HISTORIQUE : v1, 15/07/98, création
  26 : C HISTORIQUE :
  27 : C HISTORIQUE :
  28 : C***********************************************************************
  29 : C Prière de PRENDRE LE TEMPS de compléter les commentaires
  30 : C en cas de modification de ce sous-programme afin de faciliter
  31 : C la maintenance !
  32 : C***********************************************************************
  33 : -INC CCOPTIO
  34 : -INC SMMATRIK
  35 : -INC TMCOLAC
  36 : C     
  37 : C     ************************* MATRIK ********************************
  38 : C Pile des MELEME
  39 :       ITLAC1=KCOLA(1)
  40 : C Pile des CHPOINT
  41 :       ITLAC2=KCOLA(2)
  42 : C Pile des MATRIK
  43 :       ITLAC3=KCOLA(43)
  44 :       DO 1 IEL=IDEB,IMAX1
  45 :          MATRIK=ITLAC(IEL)
  46 :          IF (MATRIK.EQ.0) THEN
  47 :             WRITE(IOIMP,*) 'Failing to save a nil pointer'
  48 :             WRITE(IOIMP,*) 'MATRIK type object...'
  49 :             GOTO 9999
  50 :          ENDIF
  51 :          SEGACT MATRIK*MOD
  52 :          NMATRI=IRIGEL(/2)
  53 :          DO 11 I=1,NMATRI
  54 :             IVA=ABS(IRIGEL(1,I))
  55 :             IF (IVA.NE.0) IRIGEL(1,I)=ITLAC1.ITLAC(IVA)
  56 :             IVA=ABS(IRIGEL(2,I))
  57 :             IF (IVA.NE.0) IRIGEL(2,I)=ITLAC1.ITLAC(IVA)
  58 :             IMATRI=IRIGEL(4,I)
  59 :             IF (IMATRI.NE.0) THEN
  60 :                SEGACT IMATRI*MOD
  61 :                IVA=ABS(KSPGP)
  62 :                IF (IVA.NE.0) KSPGP=ITLAC1.ITLAC(IVA)
  63 :                IVA=ABS(KSPGD)
  64 :                IF (IVA.NE.0) KSPGD=ITLAC1.ITLAC(IVA)
  65 :                SEGDES IMATRI
  66 :             ENDIF
  67 :  11      CONTINUE
  68 :          IVA=ABS(KIZM)
  69 :          IF (IVA.NE.0) KIZM=ITLAC1.ITLAC(IVA)
  70 :          IVA=ABS(KISPGT)
  71 :          IF (IVA.NE.0) KISPGT=ITLAC1.ITLAC(IVA)
  72 :          IVA=ABS(KISPGP)
  73 :          IF (IVA.NE.0) KISPGP=ITLAC1.ITLAC(IVA)
  74 :          IVA=ABS(KISPGD)
  75 :          IF (IVA.NE.0) KISPGD=ITLAC1.ITLAC(IVA)
  76 :          IVA=ABS(KIDMAT(8))
  77 :          IF (IVA.NE.0) KIDMAT(8)=ITLAC2.ITLAC(IVA)
  78 :          IVA=ABS(KKMMT(2))
  79 :          IF (IVA.NE.0) KKMMT(2)=ITLAC3.ITLAC(IVA)
  80 :          IVA=ABS(KKMMT(3))
  81 :          IF (IVA.NE.0) KKMMT(3)=ITLAC3.ITLAC(IVA)
  82 :          SEGDES MATRIK
  83 :  1    CONTINUE
  84 : *     
  85 : * Normal termination
  86 : *     
  87 :       RETURN
  88 : *     
  89 : * Format handling
  90 : *     
  91 : *     
  92 : * Error handling
  93 : *     
  94 :  9999 CONTINUE
  95 :       WRITE(IOIMP,*) 'An error was detected in subroutine resmik'
  96 :       RETURN
  97 : *     
  98 : * End of subroutine RESMIK
  99 : *     
 100 :       END
 101 : 
 102 : 
 103 : 
 104 : 
 105 : 
 106 : 
 107 : 
 108 :  
 109 :  
 110 :  
 111 :  
 112 :  
 113 :