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   25/11/24    21:15:23     12406          
  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 TMATOP1
  27.       POINTEUR TRAVK.TRAVJ
  28. -INC SMLENTI
  29.       POINTEUR LIDXCA.MLENTI
  30.       POINTEUR LOKVOL.MLENTI
  31.       POINTEUR LNQUAL.MLENTI
  32.       POINTEUR LINDI.MLENTI
  33.       POINTEUR LINDJ.MLENTI
  34. -INC SMLREEL
  35.       POINTEUR LQUALS.MLREEL
  36. *
  37. * Executable statements
  38. *
  39. *      WRITE(IOIMP,*) 'coucou topv6'
  40. *
  41.       LIDXCA=TRAVL.IDXCA
  42.       LOKVOL=TRAVL.OKVOL
  43.       LQUALS=TRAVL.QUALS
  44.       LNQUAL=TRAVL.NQUAL
  45.       LINDI=TRAVL.INDI
  46.       LINDJ=TRAVL.INDJ
  47. *
  48. * Calcul la liste des indices des meilleurs candidats dans ITVOL
  49. * cf. procedure MAXLEXI
  50. * Il est sans doute possible
  51. * de n'avoir que ILIND
  52. *
  53.       IINDIC=1
  54. *
  55.       NINDI=0
  56.       DO IVOCOU=1,NVOCOU
  57.          NINDI=NINDI+1
  58.          LINDI.LECT(NINDI)=IVOCOU
  59.       ENDDO
  60. *
  61.  10   CONTINUE
  62.       XMAX2=-1.D0
  63. *
  64.       NINDJ=0
  65. *
  66.       DO IQ=1,NINDI
  67.          II=LINDI.LECT(IQ)
  68.          ICAND=LOKVOL.LECT(II)
  69.          IF (IINDIC.GT.LNQUAL.LECT(ICAND)) THEN
  70.             NINDJ=NINDJ+1
  71.             LINDJ.LECT(NINDJ)=II
  72.          ELSE
  73.             IELDEB=LIDXCA.LECT(ICAND)
  74.             XMAX2=MAX(XMAX2,LQUALS.PROG(IELDEB+IINDIC-1))
  75.          ENDIF
  76.       ENDDO
  77. *
  78.       IF (NINDJ.GT.0) THEN
  79.          DO IINDJ=1,NINDJ
  80.             LINDI.LECT(IINDJ)=LINDJ.LECT(IINDJ)
  81.          ENDDO
  82.          NINDI=NINDJ
  83. *
  84.          GOTO 20
  85.       ELSE
  86.          DO IQ=1,NINDI
  87.             II=LINDI.LECT(IQ)
  88.             ICAND=LOKVOL.LECT(II)
  89.             IELDEB=LIDXCA.LECT(ICAND)
  90.             XQUAL=LQUALS.PROG(IELDEB+IINDIC-1)
  91. *            IF (ABS(XMAX-XQUAL).LE.XZPREC) THEN
  92. * Il faut faire tres attention à ce critère
  93.             XPREC=MAX(XZPREC*1.D2,XMAX2*QTOL)
  94.             IF (ABS(XMAX2-XQUAL).LE.XPREC) THEN
  95.                NINDJ=NINDJ+1
  96.                LINDJ.LECT(NINDJ)=II
  97.             ENDIF
  98.          ENDDO
  99. *
  100.          DO IINDJ=1,NINDJ
  101.             LINDI.LECT(IINDJ)=LINDJ.LECT(IINDJ)
  102.          ENDDO
  103.          NINDI=NINDJ
  104. *
  105.          IF (NINDI.EQ.1) GOTO 20
  106.       ENDIF
  107. *
  108.       IINDIC=IINDIC+1
  109.       GOTO 10
  110.  20   CONTINUE
  111. *
  112.       ICBES=LOKVOL.LECT(LINDI.LECT(1))
  113.       RETURN
  114. *
  115. *
  116. *
  117.  9999 CONTINUE
  118.       MOTERR(1:8)='TOPV6   '
  119. * 349 2
  120. *Problème non prévu dans le s.p. %m1:8 contactez votre assistance
  121.       CALL ERREUR(349)
  122.       RETURN
  123. *
  124. * End of subroutine TOPV6
  125. *
  126.       END
  127.  
  128.  

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