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   26/01/09    21:16:03     12442          
  2.       SUBROUTINE TOPV5(TRAVL,XVTOL,IMET,IMOMET,XDENS,KCMETR,NKPVIR
  3.      $     ,ISTRID)
  4.       IMPLICIT REAL*8 (A-H,O-Z)
  5.       IMPLICIT INTEGER (I-N)
  6. C***********************************************************************
  7. C NOM         : TOPV5
  8. C DESCRIPTION :
  9. C
  10. *
  11. *     Les candidats ayant le bon volume sont dans ITVOL
  12. *     On calcule les qualités de chaque élément des candidats et on ordonne.
  13. *
  14. C
  15. C
  16. C
  17. C
  18. C LANGAGE     : ESOPE
  19. C AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  20. C               mél : gounand@semt2.smts.cea.fr
  21. C***********************************************************************
  22. C VERSION    : v1, 09/11/2017, version initiale
  23. C HISTORIQUE : v1, 09/11/2017, création
  24. C HISTORIQUE :
  25. C HISTORIQUE :
  26. C***********************************************************************
  27. -INC PPARAM
  28. -INC CCOPTIO
  29. -INC CCREEL
  30. -INC TMATOP1
  31.       POINTEUR LMCANS.MELEMX
  32.       POINTEUR KCMETR.METRIQ
  33.       POINTEUR TRAVK.TRAVJ
  34. -INC SMLENTI
  35.       POINTEUR LIDXCA.MLENTI
  36.       POINTEUR LOKVOL.MLENTI
  37.       POINTEUR LNQUAL.MLENTI
  38. -INC SMLREEL
  39.       POINTEUR LQUALS.MLREEL
  40. *
  41. * Executable statements
  42. *
  43. *      WRITE(IOIMP,*) 'coucou topv5'
  44. *
  45.       LMCANS=TRAVL.MCANS
  46.       LIDXCA=TRAVL.IDXCA
  47.       LOKVOL=TRAVL.OKVOL
  48.       LQUALS=TRAVL.QUALS
  49.       LNQUAL=TRAVL.NQUAL
  50. *
  51. *     Les candidats ayant le bon volume sont dans LOKVOL
  52. *     On calcule les qualités de chaque élément des candidats et on ordonne.
  53. *
  54.       DO JVOCOU=1,NVOCOU
  55. *
  56.          IVOCOU=JVOCOU
  57.          ICAND=LOKVOL.LECT(IVOCOU)
  58.          IELDEB=LIDXCA.LECT(ICAND)
  59.          IELFIN=LIDXCA.LECT(ICAND+1)-1
  60. *     NDQC : nombre de qualités calculés
  61. *     peut être différente de IELFIN-IELDEB+1
  62. *     car on ne calcule pas la qualité des éléments contenant le noeud
  63. *     virtuel
  64.          CALL QUALI6(LMCANS,IELDEB,IELFIN,IMET,IMOMET,XDENS,KCMETR
  65.      $        ,NKPVIR,XVTOL,LQUALS,NDQC,ISTRID)
  66.          IF (IERR.NE.0) RETURN
  67.          LNQUAL.LECT(ICAND)=NDQC
  68. *         Write(ioimp,*) 'Calcul qualite candidat 2 i,ndqc=',jvocou,ndqc
  69. *         do iii=ieldeb,ielfin
  70. *            jjj=(iii-1)*istrid
  71. *            Write(ioimp,*) (lquals.prog(jjj+k),k=1,istrid)
  72. *         enddo
  73. *         Write(ioimp,*) (lquals.prog(iii),iii=ieldeb,ielfin)
  74. *     Algo de tri pas terrible ? (cf. ordon1.eso merge sort) mais en place
  75. *faux         CALL ORDO01(LQUALS.PROG(IELDEB),IELFIN-IELDEB+1,.TRUE.)
  76. *         CALL ORDO01(LQUALS.PROG(IELDEB),LNQUAL.LECT(ICAND),.TRUE.)
  77. *     CALL ORDS01(LQUALS.PROG(IELDEB),LNQUAL.LECT(ICAND),ISTRID)
  78.          JELDEB=((IELDEB-1)*istrid)+1
  79.          CALL ORDS01(LQUALS.PROG(JELDEB),LNQUAL.LECT(ICAND),ISTRID)
  80.          IF (IERR.NE.0) RETURN
  81. *         Write(ioimp,*) 'Apres tri qualite candidat 2 i=',jvocou
  82. *         do iii=ieldeb,ielfin
  83. *            jjj=(iii-1)*istrid
  84. *            Write(ioimp,*) (lquals.prog(jjj+k),k=1,istrid)
  85. *         enddo
  86.       ENDDO
  87.       RETURN
  88. *
  89. *
  90. *
  91.  9999 CONTINUE
  92.       MOTERR(1:8)='TOPV5   '
  93. * 349 2
  94. *Problème non prévu dans le s.p. %m1:8 contactez votre assistance
  95.       CALL ERREUR(349)
  96.       RETURN
  97. *
  98. * End of subroutine TOPV5
  99. *
  100.       END
  101.  
  102.  

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