Télécharger nomopt.eso

Retour à la liste

Numérotation des lignes :

nomopt
  1. C NOMOPT SOURCE PASCAL 22/04/21 21:15:07 11352
  2. SUBROUTINE NOMOPT(CTYP,MLNOMS,COPT,MLNOM1)
  3. IMPLICIT INTEGER(I-N)
  4. implicit real*8(a-h,o-z)
  5.  
  6. -INC CCNOYAU
  7. -INC PPARAM
  8. -INC CCOPTIO
  9. -INC CCGEOME
  10. -INC SMELEME
  11. -INC TMLNOMS
  12. POINTEUR MLNOM1.MLNOMS
  13.  
  14. PARAMETER (NTYPE=1, NOPT=4, NTYP1=2, NTYP2=5, NTYP3=8)
  15.  
  16. LOGICAL LVAL
  17. CHARACTER*(4) COPT,MOTOP(NOPT)
  18. CHARACTER*(4) MTYP1(NTYP1),MTYP2(NTYP2),MTYP3(NTYP3)
  19. CHARACTER*(8) CTYP,MOTYP(NTYPE),CVAL
  20. CHARACTER*(LONOM) CNOM
  21. EXTERNAL LONG
  22.  
  23. DATA MOTYP /'MAILLAGE'/
  24. DATA MOTOP /'POIN','LIGN','SURF','VOLU'/
  25.  
  26. C VERIFICATION DU TYPE DE L'OBJET
  27. CALL PLACE(MOTYP,NTYPE,ITYPO,CTYP)
  28. IF (IERR.NE.0) RETURN
  29.  
  30. C SI TYPE NON IMPLEMENTE
  31. IF (ITYPO.EQ.0) THEN
  32. CALL ERREUR(19)
  33. RETURN
  34. ENDIF
  35.  
  36. C VERIFICATION DE L'OPTION
  37. CALL PLACE(MOTOP,NOPT,IOPTI,COPT)
  38. IF (IERR.NE.0) RETURN
  39.  
  40. C SI OPTION NON IMPLEMENTEE
  41. IF (IOPTI.EQ.0) THEN
  42. CALL ERREUR(19)
  43. RETURN
  44. ENDIF
  45.  
  46. C BRANCHEMENT SELON TYPE
  47. GOTO (10),ITYPO
  48.  
  49. CALL ERREUR(5)
  50. RETURN
  51.  
  52. C---- TYPE MAILLAGE ----
  53. 10 CONTINUE
  54.  
  55. SEGACT MLNOMS
  56. NNOMS = LINOMS(/2)
  57. M = NNOMS
  58. SEGINI, MLNOM1
  59. NNOM1 = 0
  60. DO 101 IN=1,NNOMS
  61.  
  62. C Lecture d'un maillage
  63. CNOM = LINOMS(IN)
  64. CALL CQUOI(CNOM,CTYP,IVAL,RVAL,CVAL,LVAL,IPGEO1)
  65. C write(6,*) 'CNOM, IOBJ=',CNOM(1:10),IPGEO1
  66. CALL ACTOBJ(CTYP,IPGEO1,1)
  67. IF (IERR.NE.0) RETURN
  68.  
  69. C Analyse du type d'element
  70. MELEME = IPGEO1
  71. NBS = MAX(1,LISOUS(/1))
  72. IPT1 = IPGEO1
  73. DO 102 IS=1,NBS
  74. IF (LISOUS(/1).NE.0) THEN
  75. IPT1 = LISOUS(IS)
  76. ENDIF
  77. IOK = 0
  78. KTYP1 = IPT1.ITYPEL
  79. C write(6,*) 'IOPTI, KTYP1, NOMS(KTYP1)=',IOPTI, KTYP1, NOMS(KTYP1)
  80. IF (LDLR(KTYP1).EQ.(IOPTI-1)) THEN
  81. NNOM1 = NNOM1+1
  82. MLNOM1.LINOMS(NNOM1) = CNOM
  83. ENDIF
  84. 102 CONTINUE
  85. 101 CONTINUE
  86. M = NNOM1
  87. SEGADJ,MLNOM1
  88.  
  89. RETURN
  90. END
  91.  
  92.  
  93.  
  94.  
  95.  
  96.  

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