Télécharger nqf2nl.eso

Retour à la liste

Numérotation des lignes :

  1. C NQF2NL SOURCE BP208322 16/11/18 21:19:35 9177
  2. SUBROUTINE NQF2NL(KELQ,KELL)
  3. IMPLICIT REAL*8 (A-H,O-Z)
  4. IMPLICIT INTEGER (I-N)
  5. C***********************************************************************
  6. C NOM : NQF2NL
  7. C DESCRIPTION : Numéro d'un quaf -> numéro d'un linéaire
  8. C de même forme géométrique
  9. C KELL=0 si KELQ n'est pas un numéro de quaf
  10. C
  11. C LANGAGE : ESOPE
  12. C AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  13. C mél : gounand@semt2.smts.cea.fr
  14. C***********************************************************************
  15. C ENTREES : KEL
  16. C ENTREES/SORTIES : INOMIL
  17. C SORTIES :
  18. C***********************************************************************
  19. C VERSION : v1, 28/04/2006, version initiale
  20. C***********************************************************************
  21. -INC CCGEOME
  22. PARAMETER (NQUAF=6)
  23. CHARACTER*4 NMQUAF(NQUAF)
  24. CHARACTER*4 NMLINE(NQUAF)
  25. CHARACTER*4 NOMELQ
  26. CHARACTER*4 NOMELL
  27. INTEGER IMPR,IRET
  28. DATA NMQUAF/'TRI7','QUA9','CU27','PR21','TE15','PY19'/
  29. DATA NMLINE/'TRI3','QUA4','CUB8','PRI6','TET4','PYR5'/
  30. *
  31. * Executable statements
  32. *
  33. *
  34. * Trouve si c'est un QUAF
  35. *
  36. NOMELQ=NOMS(KELQ)
  37. IQ=0
  38. DO IQUAF=1,NQUAF
  39. IF (NOMELQ.EQ.NMQUAF(IQUAF)) THEN
  40. IQ=IQUAF
  41. GOTO 2
  42. ENDIF
  43. ENDDO
  44. 2 CONTINUE
  45. IF (IQ.EQ.0) THEN
  46. KELL=0
  47. RETURN
  48. ENDIF
  49. *
  50. * Trouve le LINE correspondant
  51. *
  52. NOMELL=NMLINE(IQ)
  53. IMPR=0
  54. CALL FIMOT2(NOMELL,NOMS,NOMBR,
  55. $ KELL,
  56. $ IMPR,IRET)
  57. IF (IRET.NE.0.OR.KELL.EQ.0) THEN
  58. CALL ERREUR(5)
  59. ENDIF
  60. *
  61. * Normal termination
  62. *
  63. RETURN
  64. *
  65. * End of subroutine NQF2NL
  66. *
  67. END
  68.  
  69.  
  70.  
  71.  
  72.  
  73.  

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