Télécharger la plaquette Cast3M


fr en

Télécharger mldcdb.eso

Retour à la liste

Numérotation des lignes : 

mldcdb

  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 PPARAM
  33. -INC CCOPTIO
  34. -INC SMLENTI
  35.       INTEGER JG
  36.       POINTEUR KPDCDB.MLENTI
  37. * Includes persos
  38. *     Segment LSTIND (liste séquentielle indexée)
  39.       INTEGER NBM,NBTVAL
  40.       SEGMENT LSTIND
  41.       INTEGER IDX(NBM+1)
  42.       INTEGER IVAL(NBTVAL)
  43.       ENDSEGMENT
  44. *-INC SLSTIND
  45.       POINTEUR LILBLC.LSTIND
  46.       POINTEUR LMDUAC.LSTIND
  47.       POINTEUR LMDCDB.LSTIND
  48. *
  49.       INTEGER NTOTPO
  50.       INTEGER IMPR,IRET
  51. *
  52.       INTEGER LDG,NEL
  53.       INTEGER IDG,IEL,IVDCDB
  54.       INTEGER IVLBLC,IVSTRT,IVSTOP
  55.       INTEGER JVDUAC,JVSTRT,JVSTOP
  56.       INTEGER LAST,PREC
  57.       INTEGER NUELC,NUPODC
  58. *
  59. * Executable statements
  60. *
  61.       IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans mldcdb.eso'
  62. * Dimensionnement de LMDCDB
  63. * Pour l'instant LMDCDB.IDX(IEL+1)=nombre de points du IELeme élément de
  64. * LMDCDB
  65.       SEGACT LILBLC
  66.       NEL=LILBLC.IDX(/1)-1
  67.       NBM=NEL
  68.       NBTVAL=0
  69.       SEGINI LMDCDB
  70.       SEGACT LMDUAC
  71.       JG=NTOTPO
  72.       SEGINI KPDCDB
  73.       DO 1 IEL=1,NEL
  74. * Degré et fin de la liste chaînée
  75.          LDG=0
  76.          LAST=-1
  77.          IVSTRT=LILBLC.IDX(IEL)
  78.          IVSTOP=LILBLC.IDX(IEL+1)-1
  79.          DO 12 IVLBLC=IVSTRT,IVSTOP
  80.             NUELC=LILBLC.IVAL(IVLBLC)
  81.             JVSTRT=LMDUAC.IDX(NUELC)
  82.             JVSTOP=LMDUAC.IDX(NUELC+1)-1
  83.             DO 122 JVDUAC=JVSTRT,JVSTOP
  84.                NUPODC=LMDUAC.IVAL(JVDUAC)
  85.                IF (KPDCDB.LECT(NUPODC).EQ.0) THEN
  86.                   LDG=LDG+1
  87.                   KPDCDB.LECT(NUPODC)=LAST
  88.                   LAST=NUPODC
  89.                ENDIF
  90.  122        CONTINUE
  91.  12      CONTINUE
  92.          LMDCDB.IDX(IEL+1)=LDG
  93. * Remise à zéro de la liste chaînée
  94.          DO 14 IDG=1,LDG
  95.             PREC=KPDCDB.LECT(LAST)
  96.             KPDCDB.LECT(LAST)=0
  97.             LAST=PREC
  98.  14      CONTINUE
  99.  1    CONTINUE
  100. * LMDCDB.IDX est transformé en la liste d'indexation sur
  101. * LMDCDB.IVAL
  102.       LMDCDB.IDX(1)=1
  103.       DO 3 IEL=1,NEL
  104.          LMDCDB.IDX(IEL+1)=LMDCDB.IDX(IEL+1)+LMDCDB.IDX(IEL)
  105.  3    CONTINUE
  106.       NBM=NEL
  107.       NBTVAL=LMDCDB.IDX(NEL+1)-1
  108.       SEGADJ,LMDCDB
  109. * Remplissage de LMDCDB
  110.       IVDCDB=0
  111.       DO 5 IEL=1,NEL
  112. * Degré et fin de la liste chaînée
  113.          LDG=0
  114.          LAST=-1
  115.          IVSTRT=LILBLC.IDX(IEL)
  116.          IVSTOP=LILBLC.IDX(IEL+1)-1
  117.          DO 52 IVLBLC=IVSTRT,IVSTOP
  118.             NUELC=LILBLC.IVAL(IVLBLC)
  119.             JVSTRT=LMDUAC.IDX(NUELC)
  120.             JVSTOP=LMDUAC.IDX(NUELC+1)-1
  121.             DO 522 JVDUAC=JVSTRT,JVSTOP
  122.                NUPODC=LMDUAC.IVAL(JVDUAC)
  123.                IF (KPDCDB.LECT(NUPODC).EQ.0) THEN
  124.                   LDG=LDG+1
  125.                   KPDCDB.LECT(NUPODC)=LAST
  126.                   LAST=NUPODC
  127.                ENDIF
  128.  522        CONTINUE
  129.  52      CONTINUE
  130. * Remise à zéro de la liste chaînée et vidage dans LMDCDB
  131.          DO 54 IDG=1,LDG
  132.             PREC=KPDCDB.LECT(LAST)
  133.             IVDCDB=IVDCDB+1
  134.             LMDCDB.IVAL(IVDCDB)=LAST
  135.             KPDCDB.LECT(LAST)=0
  136.             LAST=PREC
  137.  54      CONTINUE
  138.  5    CONTINUE
  139.       SEGSUP KPDCDB
  140.       SEGDES LMDUAC
  141.       SEGDES LMDCDB
  142.       SEGDES LILBLC
  143. *
  144. * Normal termination
  145. *
  146.       IRET=0
  147.       RETURN
  148. *
  149. * Format handling
  150. *
  151. *
  152. * Error handling
  153. *
  154.  9999 CONTINUE
  155.       IRET=1
  156.       WRITE(IOIMP,*) 'An error was detected in subroutine mldcdb'
  157.       RETURN
  158. *
  159. * End of subroutine MLDCDB
  160. *
  161.       END
  162.  
  163.  
  164.  
  165.  

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