Télécharger la plaquette Cast3M


fr en

Télécharger topv5.eso

Retour à la liste

Numérotation des lignes : 

topv5

  1. C TOPV5     SOURCE    GOUNAND   21/04/06    21:15:36     10940          
  2.       SUBROUTINE TOPV5(TRAVL,XVTOL,IMET,IMOMET,XDENS,KCMETR,KPVIRT)
  3.       IMPLICIT REAL*8 (A-H,O-Z)
  4.       IMPLICIT INTEGER (I-N)
  5. C***********************************************************************
  6. C NOM         : TOPV5
  7. C DESCRIPTION :
  8. C
  9. *     
  10. *     Les candidats ayant le bon volume sont dans ITVOL
  11. *     On calcule les qualités de chaque élément des candidats et on ordonne.
  12. *     
  13. C      
  14. C     
  15. C     
  16. C     
  17. C LANGAGE     : ESOPE
  18. C AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  19. C               mél : gounand@semt2.smts.cea.fr
  20. C***********************************************************************
  21. C VERSION    : v1, 09/11/2017, version initiale
  22. C HISTORIQUE : v1, 09/11/2017, création
  23. C HISTORIQUE :
  24. C HISTORIQUE :
  25. C***********************************************************************
  26. -INC PPARAM
  27. -INC CCOPTIO
  28. -INC CCREEL
  29. -INC SMELEME
  30.       POINTEUR KELEM.MELEME
  31.       POINTEUR KEXTO.MELEME
  32.       POINTEUR IBTLOC.MELEME
  33.       POINTEUR IPBTL2.MELEME
  34.       POINTEUR KTBES.MELEME
  35.       POINTEUR KTBES2.MELEME
  36. *anc      POINTEUR IMCAND.MELEME
  37. -INC TMATOP1
  38. *-INC SMELEMX
  39.       POINTEUR LMCANS.MELEMX
  40.       POINTEUR IPBTL.MELEMX
  41. -INC SMLENTI
  42. *anc      POINTEUR KNNO.MLENTI
  43.       POINTEUR LIDXCA.MLENTI
  44.       POINTEUR LOKVOL.MLENTI
  45.       POINTEUR LNQUAL.MLENTI
  46.       POINTEUR LINDI.MLENTI
  47.       POINTEUR LINDJ.MLENTI
  48. -INC SMLREEL
  49.       POINTEUR IQUAL.MLREEL
  50.       POINTEUR LQUALS.MLREEL
  51. -INC SMCOORD
  52.       POINTEUR KCOORD.MCOORD
  53. *-INC SMETRIQ
  54.       POINTEUR KCMETR.METRIQ
  55. *-INC STRAVJ
  56.       POINTEUR TRAVK.TRAVJ
  57. *-INC STRAVL
  58. *     
  59.       LOGICAL LOK
  60. *anc      LOGICAL LTOIBO
  61. *anc      LOGICAL LTOIBA
  62.       INTEGER JCAND
  63.       LOGICAL LCHANG
  64.       LOGICAL LCHTOP
  65. * Liste de topologies de maillages candidates
  66. *      SEGMENT ITCAND(0)
  67. * Liste de topologies de maillages candidats de plus petit volume non nul
  68. *      SEGMENT ITVOL(JG)
  69. * Liste de topologies de maillages candidats de plus petit volume
  70. * et de meilleure qualité
  71. *      SEGMENT ILQUAL(JG)
  72. *      SEGMENT ILIND(JG)
  73. *      SEGMENT JLIND(JG)
  74. *     
  75. * Executable statements
  76. *     
  77. *      WRITE(IOIMP,*) 'coucou topv5'
  78. *
  79.       LMCANS=TRAVL.MCANS
  80.       LIDXCA=TRAVL.IDXCA
  81.       LOKVOL=TRAVL.OKVOL
  82.       LQUALS=TRAVL.QUALS
  83.       LNQUAL=TRAVL.NQUAL
  84. *      
  85. *     
  86. *     Les candidats ayant le bon volume sont dans ITVOL
  87. *     On calcule les qualités de chaque élément des candidats et on ordonne.
  88. *     
  89.       DO JVOCOU=1,NVOCOU
  90. *
  91.          IVOCOU=JVOCOU
  92.          ICAND=LOKVOL.LECT(IVOCOU)
  93.          IELDEB=LIDXCA.LECT(ICAND)
  94.          IELFIN=LIDXCA.LECT(ICAND+1)-1
  95. *     NDQC : nombre de qualités calculés
  96. *     peut être différente de IELFIN-IELDEB+1
  97. *     car on ne calcule pas la qualité des éléments contenant le noeud
  98. *     virtuel         
  99.          CALL QUALI6(LMCANS,IELDEB,IELFIN,IMET,IMOMET,XDENS,KCMETR
  100.      $        ,KPVIRT,XVTOL,LQUALS,NDQC)
  101.          IF (IERR.NE.0) RETURN
  102.          LNQUAL.LECT(ICAND)=NDQC
  103. *            Write(ioimp,*) 'Calcul qualite candidat 2 i=',jvocou
  104. *            Write(ioimp,*) (lquals.prog(iii),iii=ieldeb,ielfin)
  105. *     Algo de tri pas terrible ? (cf. ordon1.eso merge sort) mais en place
  106. *faux         CALL ORDO01(LQUALS.PROG(IELDEB),IELFIN-IELDEB+1,.TRUE.)
  107.          CALL ORDO01(LQUALS.PROG(IELDEB),LNQUAL.LECT(ICAND),.TRUE.)
  108.          IF (IERR.NE.0) RETURN
  109. *            Write(ioimp,*) 'Calcul qualite candidat 2 i=',jvocou
  110. *            Write(ioimp,*) (lquals.prog(iii),iii=ieldeb,ielfin)
  111.       ENDDO
  112.       RETURN
  113. *     
  114. *     
  115. *     
  116.  9999 CONTINUE
  117.       MOTERR(1:8)='TOPV5   '
  118. * 349 2
  119. *Problème non prévu dans le s.p. %m1:8 contactez votre assistance
  120.       CALL ERREUR(349)
  121.       RETURN
  122. *     
  123. * End of subroutine TOPV5
  124. *     
  125.       END
  126.  
  127.  
  128.  

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