Esope source files

   1 : C MIPCDB    SOURCE    CHAT      05/01/13    01:45:29     5004           
   2 :       SUBROUTINE MIPCDB(JCDUAB,NIUNIQ,
   3 :      $     ICPCDB,
   4 :      $     IMPR,IRET)
   5 :       IMPLICIT INTEGER(I-N)
   6 :       IMPLICIT REAL*8 (A-H,O-Z)
   7 : C***********************************************************************
   8 : C NOM         : MIPCDB
   9 : C DESCRIPTION : On construit la liste des inconnues primales de CD-1Bt. 
  10 : C               Une simple suppression des doublons à l'aide des listes
  11 : C               chaînées.
  12 : C
  13 : C
  14 : C LANGAGE     : ESOPE
  15 : C AUTEUR      : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  16 : C               mél : gounand@semt2.smts.cea.fr
  17 : C***********************************************************************
  18 : C APPELES          : -
  19 : C APPELE PAR       : PROMAT
  20 : C***********************************************************************
  21 : C ENTREES            :
  22 : C SORTIES            :
  23 : C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  24 : C***********************************************************************
  25 : C VERSION    : v1, 07/02/2000, version initiale
  26 : C HISTORIQUE : v1, 07/02/2000, création
  27 : C HISTORIQUE :
  28 : C HISTORIQUE :
  29 : C***********************************************************************
  30 : C Prière de PRENDRE LE TEMPS de compléter les commentaires
  31 : C en cas de modification de ce sous-programme afin de faciliter
  32 : C la maintenance !
  33 : C***********************************************************************
  34 : -INC CCOPTIO
  35 : -INC SMLENTI
  36 :       POINTEUR JCDUAB.MLENTI
  37 :       POINTEUR ICPCDB.MLENTI
  38 :       INTEGER JG
  39 :       POINTEUR KRPCDB.MLENTI
  40 : *
  41 :       INTEGER NIUNIQ
  42 :       INTEGER IMPR,IRET
  43 : *
  44 :        INTEGER LDG,NNBMEB
  45 :        INTEGER IDG,INBMEB
  46 :        INTEGER NUPCDB,LAST,PREC
  47 : *     
  48 : * Executable statements
  49 : *
  50 :       IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans mipcdb.eso' 
  51 :       SEGACT JCDUAB
  52 :       NNBMEB=JCDUAB.LECT(/1)
  53 :       JG=NIUNIQ
  54 :       SEGINI,KRPCDB
  55 : * Degré et fin de la liste chaînée
  56 :       LDG=0
  57 :       LAST=-1
  58 :       DO 1 INBMEB=1,NNBMEB
  59 :          NUPCDB=JCDUAB.LECT(INBMEB)
  60 :          IF (KRPCDB.LECT(NUPCDB).EQ.0) THEN
  61 :             LDG=LDG+1
  62 :             KRPCDB.LECT(NUPCDB)=LAST
  63 :             LAST=NUPCDB
  64 :          ENDIF
  65 :  1    CONTINUE
  66 :       SEGDES JCDUAB
  67 : * Vidage de la liste chaînée dans ICPCDB
  68 :       JG=LDG
  69 :       SEGINI,ICPCDB
  70 :       DO 3 IDG=1,LDG
  71 :          PREC=KRPCDB.LECT(LAST)
  72 :          ICPCDB.LECT(IDG)=LAST
  73 :          LAST=PREC
  74 :  3    CONTINUE
  75 :       SEGDES ICPCDB
  76 :       SEGSUP KRPCDB
  77 : *
  78 : * Normal termination
  79 : *
  80 :       IRET=0
  81 :       RETURN
  82 : *
  83 : * Format handling
  84 : *
  85 : *
  86 : * Error handling
  87 : *
  88 :  9999 CONTINUE
  89 :       IRET=1
  90 :       WRITE(IOIMP,*) 'An error was detected in subroutine mipcdb'
  91 :       RETURN
  92 : *
  93 : * End of subroutine MIPCDB
  94 : *
  95 :       END
  96 : 
  97 :  
  98 :