Télécharger la plaquette Cast3M


fr en

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