Esope source files

   1 : C MLDCDB    SOURCE    CHAT      05/01/13    01:46:38     5004           
   2 :       SUBROUTINE MLDCDB(LILBLC,LMDUAC,NTOTPO,
   3 :      $     LMDCDB,
   4 :      $     IMPR,IRET)
   5 :       IMPLICIT INTEGER(I-N)
   6 :       IMPLICIT REAL*8 (A-H,O-Z)
   7 : C***********************************************************************
   8 : C NOM         : MLDCDB
   9 : C DESCRIPTION : On construit la liste des éléments duaux de CD-1Bt.
  10 : C
  11 : C
  12 : C LANGAGE     : ESOPE
  13 : C AUTEUR      : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  14 : C               mél : gounand@semt2.smts.cea.fr
  15 : C***********************************************************************
  16 : C APPELES          : -
  17 : C APPELE PAR       : PROMAT
  18 : C***********************************************************************
  19 : C ENTREES            : LILBLC, LMDUAC, NTOTPO
  20 : C SORTIES            : LMDCDB
  21 : C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  22 : C***********************************************************************
  23 : C VERSION    : v1, 09/02/2000, version initiale
  24 : C HISTORIQUE : v1, 09/02/2000, création
  25 : C HISTORIQUE :
  26 : C HISTORIQUE :
  27 : C***********************************************************************
  28 : C Prière de PRENDRE LE TEMPS de compléter les commentaires
  29 : C en cas de modification de ce sous-programme afin de faciliter
  30 : C la maintenance !
  31 : C***********************************************************************
  32 : -INC CCOPTIO
  33 : -INC SMLENTI
  34 :       INTEGER JG
  35 :       POINTEUR KPDCDB.MLENTI
  36 : * Includes persos
  37 : *     Segment LSTIND (liste séquentielle indexée)
  38 :       INTEGER NBM,NBTVAL
  39 :       SEGMENT LSTIND
  40 :       INTEGER IDX(NBM+1)
  41 :       INTEGER IVAL(NBTVAL)
  42 :       ENDSEGMENT
  43 : *-INC SLSTIND
  44 :       POINTEUR LILBLC.LSTIND
  45 :       POINTEUR LMDUAC.LSTIND
  46 :       POINTEUR LMDCDB.LSTIND
  47 : *
  48 :       INTEGER NTOTPO
  49 :       INTEGER IMPR,IRET
  50 : *
  51 :       INTEGER LDG,NEL
  52 :       INTEGER IDG,IEL,IVDCDB
  53 :       INTEGER IVLBLC,IVSTRT,IVSTOP
  54 :       INTEGER JVDUAC,JVSTRT,JVSTOP
  55 :       INTEGER LAST,PREC
  56 :       INTEGER NUELC,NUPODC
  57 : *     
  58 : * Executable statements
  59 : *
  60 :       IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans mldcdb.eso' 
  61 : * Dimensionnement de LMDCDB
  62 : * Pour l'instant LMDCDB.IDX(IEL+1)=nombre de points du IELeme élément de
  63 : * LMDCDB
  64 :       SEGACT LILBLC
  65 :       NEL=LILBLC.IDX(/1)-1
  66 :       NBM=NEL
  67 :       NBTVAL=0
  68 :       SEGINI LMDCDB
  69 :       SEGACT LMDUAC
  70 :       JG=NTOTPO
  71 :       SEGINI KPDCDB
  72 :       DO 1 IEL=1,NEL
  73 : * Degré et fin de la liste chaînée
  74 :          LDG=0
  75 :          LAST=-1
  76 :          IVSTRT=LILBLC.IDX(IEL)
  77 :          IVSTOP=LILBLC.IDX(IEL+1)-1
  78 :          DO 12 IVLBLC=IVSTRT,IVSTOP
  79 :             NUELC=LILBLC.IVAL(IVLBLC)
  80 :             JVSTRT=LMDUAC.IDX(NUELC)
  81 :             JVSTOP=LMDUAC.IDX(NUELC+1)-1
  82 :             DO 122 JVDUAC=JVSTRT,JVSTOP
  83 :                NUPODC=LMDUAC.IVAL(JVDUAC)
  84 :                IF (KPDCDB.LECT(NUPODC).EQ.0) THEN
  85 :                   LDG=LDG+1
  86 :                   KPDCDB.LECT(NUPODC)=LAST
  87 :                   LAST=NUPODC
  88 :                ENDIF
  89 :  122        CONTINUE
  90 :  12      CONTINUE
  91 :          LMDCDB.IDX(IEL+1)=LDG
  92 : * Remise à zéro de la liste chaînée
  93 :          DO 14 IDG=1,LDG
  94 :             PREC=KPDCDB.LECT(LAST)
  95 :             KPDCDB.LECT(LAST)=0
  96 :             LAST=PREC
  97 :  14      CONTINUE
  98 :  1    CONTINUE
  99 : * LMDCDB.IDX est transformé en la liste d'indexation sur
 100 : * LMDCDB.IVAL
 101 :       LMDCDB.IDX(1)=1
 102 :       DO 3 IEL=1,NEL
 103 :          LMDCDB.IDX(IEL+1)=LMDCDB.IDX(IEL+1)+LMDCDB.IDX(IEL)
 104 :  3    CONTINUE
 105 :       NBM=NEL
 106 :       NBTVAL=LMDCDB.IDX(NEL+1)-1
 107 :       SEGADJ,LMDCDB
 108 : * Remplissage de LMDCDB
 109 :       IVDCDB=0
 110 :       DO 5 IEL=1,NEL
 111 : * Degré et fin de la liste chaînée
 112 :          LDG=0
 113 :          LAST=-1
 114 :          IVSTRT=LILBLC.IDX(IEL)
 115 :          IVSTOP=LILBLC.IDX(IEL+1)-1
 116 :          DO 52 IVLBLC=IVSTRT,IVSTOP
 117 :             NUELC=LILBLC.IVAL(IVLBLC)
 118 :             JVSTRT=LMDUAC.IDX(NUELC)
 119 :             JVSTOP=LMDUAC.IDX(NUELC+1)-1
 120 :             DO 522 JVDUAC=JVSTRT,JVSTOP
 121 :                NUPODC=LMDUAC.IVAL(JVDUAC)
 122 :                IF (KPDCDB.LECT(NUPODC).EQ.0) THEN
 123 :                   LDG=LDG+1
 124 :                   KPDCDB.LECT(NUPODC)=LAST
 125 :                   LAST=NUPODC
 126 :                ENDIF
 127 :  522        CONTINUE
 128 :  52      CONTINUE
 129 : * Remise à zéro de la liste chaînée et vidage dans LMDCDB
 130 :          DO 54 IDG=1,LDG
 131 :             PREC=KPDCDB.LECT(LAST)
 132 :             IVDCDB=IVDCDB+1
 133 :             LMDCDB.IVAL(IVDCDB)=LAST
 134 :             KPDCDB.LECT(LAST)=0
 135 :             LAST=PREC
 136 :  54      CONTINUE
 137 :  5    CONTINUE
 138 :       SEGSUP KPDCDB
 139 :       SEGDES LMDUAC
 140 :       SEGDES LMDCDB
 141 :       SEGDES LILBLC
 142 : *
 143 : * Normal termination
 144 : *
 145 :       IRET=0
 146 :       RETURN
 147 : *
 148 : * Format handling
 149 : *
 150 : *
 151 : * Error handling
 152 : *
 153 :  9999 CONTINUE
 154 :       IRET=1
 155 :       WRITE(IOIMP,*) 'An error was detected in subroutine mldcdb'
 156 :       RETURN
 157 : *
 158 : * End of subroutine MLDCDB
 159 : *
 160 :       END
 161 : 
 162 :  
 163 :