Télécharger la plaquette Cast3M


fr en

Télécharger mipcdb.eso

Retour à la liste

Numérotation des lignes : 

mipcdb

  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.  
  35. -INC PPARAM
  36. -INC CCOPTIO
  37. -INC SMLENTI
  38.       POINTEUR JCDUAB.MLENTI
  39.       POINTEUR ICPCDB.MLENTI
  40.       INTEGER JG
  41.       POINTEUR KRPCDB.MLENTI
  42. *
  43.       INTEGER NIUNIQ
  44.       INTEGER IMPR,IRET
  45. *
  46.        INTEGER LDG,NNBMEB
  47.        INTEGER IDG,INBMEB
  48.        INTEGER NUPCDB,LAST,PREC
  49. *
  50. * Executable statements
  51. *
  52.       IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans mipcdb.eso'
  53.       SEGACT JCDUAB
  54.       NNBMEB=JCDUAB.LECT(/1)
  55.       JG=NIUNIQ
  56.       SEGINI,KRPCDB
  57. * Degré et fin de la liste chaînée
  58.       LDG=0
  59.       LAST=-1
  60.       DO 1 INBMEB=1,NNBMEB
  61.          NUPCDB=JCDUAB.LECT(INBMEB)
  62.          IF (KRPCDB.LECT(NUPCDB).EQ.0) THEN
  63.             LDG=LDG+1
  64.             KRPCDB.LECT(NUPCDB)=LAST
  65.             LAST=NUPCDB
  66.          ENDIF
  67.  1    CONTINUE
  68.       SEGDES JCDUAB
  69. * Vidage de la liste chaînée dans ICPCDB
  70.       JG=LDG
  71.       SEGINI,ICPCDB
  72.       DO 3 IDG=1,LDG
  73.          PREC=KRPCDB.LECT(LAST)
  74.          ICPCDB.LECT(IDG)=LAST
  75.          LAST=PREC
  76.  3    CONTINUE
  77.       SEGDES ICPCDB
  78.       SEGSUP KRPCDB
  79. *
  80. * Normal termination
  81. *
  82.       IRET=0
  83.       RETURN
  84. *
  85. * Format handling
  86. *
  87. *
  88. * Error handling
  89. *
  90.  9999 CONTINUE
  91.       IRET=1
  92.       WRITE(IOIMP,*) 'An error was detected in subroutine mipcdb'
  93.       RETURN
  94. *
  95. * End of subroutine MIPCDB
  96. *
  97.       END
  98.  
  99.  
  100.  
  101.  

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