Télécharger la plaquette Cast3M


fr en

Télécharger topv6.eso

Retour à la liste

Numérotation des lignes : 

topv6

  1. C TOPV6     SOURCE    GOUNAND   21/04/06    21:15:37     10940          
  2.       SUBROUTINE TOPV6(TRAVL,QTOL,ICBES)
  3.       IMPLICIT REAL*8 (A-H,O-Z)
  4.       IMPLICIT INTEGER (I-N)
  5. C***********************************************************************
  6. C NOM         : TOPV6
  7. C DESCRIPTION :
  8. *
  9. * Calcul des meilleurs candidats par maximum lexical
  10. *
  11. C     
  12. C     
  13. C     
  14. C LANGAGE     : ESOPE
  15. C AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  16. C               mél : gounand@semt2.smts.cea.fr
  17. C***********************************************************************
  18. C VERSION    : v1, 09/11/2017, version initiale
  19. C HISTORIQUE : v1, 09/11/2017, création
  20. C HISTORIQUE :
  21. C HISTORIQUE :
  22. C***********************************************************************
  23. -INC PPARAM
  24. -INC CCOPTIO
  25. -INC CCREEL
  26. -INC SMELEME
  27.       POINTEUR KELEM.MELEME
  28.       POINTEUR KEXTO.MELEME
  29.       POINTEUR IBTLOC.MELEME
  30.       POINTEUR IPBTL2.MELEME
  31.       POINTEUR KTBES.MELEME
  32.       POINTEUR KTBES2.MELEME
  33. *anc      POINTEUR IMCAND.MELEME
  34. -INC TMATOP1
  35. *-INC SMELEMX
  36.       POINTEUR LMCANS.MELEMX
  37.       POINTEUR IPBTL.MELEMX
  38. -INC SMLENTI
  39. *anc      POINTEUR KNNO.MLENTI
  40.       POINTEUR LIDXCA.MLENTI
  41.       POINTEUR LOKVOL.MLENTI
  42.       POINTEUR LNQUAL.MLENTI
  43.       POINTEUR LINDI.MLENTI
  44.       POINTEUR LINDJ.MLENTI
  45. -INC SMLREEL
  46.       POINTEUR IQUAL.MLREEL
  47.       POINTEUR LQUALS.MLREEL
  48. -INC SMCOORD
  49.       POINTEUR KCOORD.MCOORD
  50. *-INC STRAVJ
  51.       POINTEUR TRAVK.TRAVJ
  52. *-INC STRAVL
  53. *     
  54.       LOGICAL LOK
  55. *anc      LOGICAL LTOIBO
  56. *anc      LOGICAL LTOIBA
  57.       INTEGER JCAND
  58.       LOGICAL LCHANG
  59.       LOGICAL LCHTOP
  60. * Liste de topologies de maillages candidates
  61. *      SEGMENT ITCAND(0)
  62. * Liste de topologies de maillages candidats de plus petit volume non nul
  63. *      SEGMENT ITVOL(JG)
  64. * Liste de topologies de maillages candidats de plus petit volume
  65. * et de meilleure qualité
  66. *      SEGMENT ILQUAL(JG)
  67. *      SEGMENT ILIND(JG)
  68. *      SEGMENT JLIND(JG)
  69. *     
  70. * Executable statements
  71. *     
  72. *      WRITE(IOIMP,*) 'coucou topv6'
  73.       IDIMP1=IDIM+1
  74. *
  75.       LMCANS=TRAVL.MCANS
  76.       LIDXCA=TRAVL.IDXCA
  77.       LOKVOL=TRAVL.OKVOL
  78.       LQUALS=TRAVL.QUALS
  79.       LNQUAL=TRAVL.NQUAL
  80.       LINDI=TRAVL.INDI
  81.       LINDJ=TRAVL.INDJ
  82. *      IPBTL=TRAVL.PBTL
  83. *     
  84. * Calcul la liste des indices des meilleurs candidats dans ITVOL
  85. * cf. procedure MAXLEXI
  86. * Il est sans doute possible
  87. * de n'avoir que ILIND
  88. *     
  89.       IINDIC=1
  90. *
  91.       NINDI=0
  92.       DO IVOCOU=1,NVOCOU
  93.          NINDI=NINDI+1
  94.          LINDI.LECT(NINDI)=IVOCOU
  95.       ENDDO
  96. *      
  97.  10   CONTINUE
  98.       XMAX2=-1.D0
  99. *
  100.       NINDJ=0
  101. *      
  102.       DO IQ=1,NINDI
  103.          II=LINDI.LECT(IQ)
  104.          ICAND=LOKVOL.LECT(II)
  105.          IF (IINDIC.GT.LNQUAL.LECT(ICAND)) THEN
  106.             NINDJ=NINDJ+1
  107.             LINDJ.LECT(NINDJ)=II
  108.          ELSE
  109.             IELDEB=LIDXCA.LECT(ICAND)
  110.             XMAX2=MAX(XMAX2,LQUALS.PROG(IELDEB+IINDIC-1))
  111.          ENDIF
  112.       ENDDO
  113. *
  114.       IF (NINDJ.GT.0) THEN
  115.          DO IINDJ=1,NINDJ
  116.             LINDI.LECT(IINDJ)=LINDJ.LECT(IINDJ)
  117.          ENDDO
  118.          NINDI=NINDJ
  119. *         
  120.          GOTO 20
  121.       ELSE
  122.          DO IQ=1,NINDI
  123.             II=LINDI.LECT(IQ)
  124.             ICAND=LOKVOL.LECT(II)
  125.             IELDEB=LIDXCA.LECT(ICAND)
  126.             XQUAL=LQUALS.PROG(IELDEB+IINDIC-1)            
  127. *            IF (ABS(XMAX-XQUAL).LE.XZPREC) THEN
  128. * Il faut faire tres attention à ce critère
  129.             XPREC=MAX(XZPREC*1.D2,XMAX2*QTOL)
  130.             IF (ABS(XMAX2-XQUAL).LE.XPREC) THEN
  131.                NINDJ=NINDJ+1
  132.                LINDJ.LECT(NINDJ)=II
  133.             ENDIF
  134.          ENDDO
  135. *
  136.          DO IINDJ=1,NINDJ
  137.             LINDI.LECT(IINDJ)=LINDJ.LECT(IINDJ)
  138.          ENDDO
  139.          NINDI=NINDJ
  140. *
  141.          IF (NINDI.EQ.1) GOTO 20
  142.       ENDIF
  143. *      
  144.       IINDIC=IINDIC+1
  145.       GOTO 10
  146.  20   CONTINUE
  147. *
  148.       ICBES=LOKVOL.LECT(LINDI.LECT(1))
  149.       RETURN
  150. *     
  151. *     
  152. *     
  153.  9999 CONTINUE
  154.       MOTERR(1:8)='TOPV6   '
  155. * 349 2
  156. *Problème non prévu dans le s.p. %m1:8 contactez votre assistance
  157.       CALL ERREUR(349)
  158.       RETURN
  159. *     
  160. * End of subroutine TOPV6
  161. *     
  162.       END
  163.  
  164.  
  165.  

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