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   25/11/24    21:15:23     12406          
  2.       SUBROUTINE TOPV5(TRAVL,XVTOL,IMET,IMOMET,XDENS,KCMETR,NKPVIR)
  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 TMATOP1
  30.       POINTEUR LMCANS.MELEMX
  31.       POINTEUR KCMETR.METRIQ
  32.       POINTEUR TRAVK.TRAVJ
  33. -INC SMLENTI
  34.       POINTEUR LIDXCA.MLENTI
  35.       POINTEUR LOKVOL.MLENTI
  36.       POINTEUR LNQUAL.MLENTI
  37. -INC SMLREEL
  38.       POINTEUR LQUALS.MLREEL
  39. *
  40. * Executable statements
  41. *
  42. *      WRITE(IOIMP,*) 'coucou topv5'
  43. *
  44.       LMCANS=TRAVL.MCANS
  45.       LIDXCA=TRAVL.IDXCA
  46.       LOKVOL=TRAVL.OKVOL
  47.       LQUALS=TRAVL.QUALS
  48.       LNQUAL=TRAVL.NQUAL
  49. *
  50. *     Les candidats ayant le bon volume sont dans LOKVOL
  51. *     On calcule les qualités de chaque élément des candidats et on ordonne.
  52. *
  53.       DO JVOCOU=1,NVOCOU
  54. *
  55.          IVOCOU=JVOCOU
  56.          ICAND=LOKVOL.LECT(IVOCOU)
  57.          IELDEB=LIDXCA.LECT(ICAND)
  58.          IELFIN=LIDXCA.LECT(ICAND+1)-1
  59. *     NDQC : nombre de qualités calculés
  60. *     peut être différente de IELFIN-IELDEB+1
  61. *     car on ne calcule pas la qualité des éléments contenant le noeud
  62. *     virtuel
  63.          CALL QUALI6(LMCANS,IELDEB,IELFIN,IMET,IMOMET,XDENS,KCMETR
  64.      $        ,NKPVIR,XVTOL,LQUALS,NDQC)
  65.          IF (IERR.NE.0) RETURN
  66.          LNQUAL.LECT(ICAND)=NDQC
  67. *         Write(ioimp,*) 'Calcul qualite candidat 2 i,nqdc=',jvocou,ndqc
  68. *         Write(ioimp,*) (lquals.prog(iii),iii=ieldeb,ielfin)
  69. *     Algo de tri pas terrible ? (cf. ordon1.eso merge sort) mais en place
  70. *faux         CALL ORDO01(LQUALS.PROG(IELDEB),IELFIN-IELDEB+1,.TRUE.)
  71.          CALL ORDO01(LQUALS.PROG(IELDEB),LNQUAL.LECT(ICAND),.TRUE.)
  72.          IF (IERR.NE.0) RETURN
  73. *            Write(ioimp,*) 'Calcul qualite candidat 2 i=',jvocou
  74. *            Write(ioimp,*) (lquals.prog(iii),iii=ieldeb,ielfin)
  75.       ENDDO
  76.       RETURN
  77. *
  78. *
  79. *
  80.  9999 CONTINUE
  81.       MOTERR(1:8)='TOPV5   '
  82. * 349 2
  83. *Problème non prévu dans le s.p. %m1:8 contactez votre assistance
  84.       CALL ERREUR(349)
  85.       RETURN
  86. *
  87. * End of subroutine TOPV5
  88. *
  89.       END
  90.  
  91.  

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