Download nqf2nl.eso

Back to the list

   1 : C NQF2NL    SOURCE    CHAT      07/10/29    21:25:07     5940           
   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
  53 :       CALL FIMOT2(NOMELL,NOMS,NOMBR,
  54 :      $     KELL,
  55 :      $     IMPR,IRET)
  56 :       IF (IRET.NE.0.OR.KELL.EQ.0) THEN
  56 :          CALL ERREUR(5)
  57 :       ENDIF
  58 : *
  59 : * Normal termination
  60 : *
  61 :       RETURN
  62 : *
  63 : * End of subroutine NQF2NL
  64 : *
  65 :       END
  66 : 
  67 :  
  68 :  

© Cast3M 2003 - All rights reserved.
Disclaimer