Télécharger la plaquette Cast3M


fr en

Télécharger indic.eso

Retour à la liste

Numérotation des lignes : 

indic

  1. C INDIC     SOURCE    GOUNAND   26/01/11    21:15:02     12447          
  2.       SUBROUTINE INDIC
  3. C=======================================================================
  4. C     OPERATEUR INDIQUANT LA QUALITE D'UN MAILLAGE
  5. C          PHILIPPE BEAUMIER  90
  6. C     LECTURE DES MOTS CLES DE LA PROCEDURE ET APPEL A INDCR
  7. C
  8. C
  9. C     SYNTAXE
  10. C     -------
  11. C
  12. C     CHL = INDI GEOM1 NOMI ... ;
  13. C
  14. C        GEOM1 = OBJET DE TYPE GEOMETRIE
  15. C        NOMI  = MOTS CLES
  16. C        CHL   = OBJET DE TYPE CHAMALEM (NOUVEAU CHAMALEM, OF COURSE|)
  17. C
  18. C=======================================================================
  19. C
  20.       IMPLICIT INTEGER(I-N)
  21.       IMPLICIT REAL*8(A-H,O-Z)
  22.  
  23. -INC SMCOORD
  24. -INC PPARAM
  25. -INC CCOPTIO
  26. -INC SMLMOTS
  27.  
  28.  
  29.       PARAMETER (NCLE=3)
  30.       CHARACTER*4 MOCLE(NCLE)
  31.       CHARACTER*(LOCOMP) MOLUS(NCLE)
  32.       CHARACTER*8 CHAR
  33.       PARAMETER (NTOPO=6)
  34.       CHARACTER*4 MOTOPO(NTOPO)
  35. C
  36.       DATA MOCLE/'PLAN','ASPE','SKEW'/
  37.       DATA MOTOPO/'COHE','EQLT','ISOD','DENS','TOPO','TOP2'/
  38.       ICHA=0
  39. C
  40. C Lecture des mot-cles TOPO...
  41. C
  42.       CALL QUETYP(CHAR,0,IRETOU)
  43.       IF (CHAR.EQ.'MOT') THEN
  44.          CALL LIRMOT(MOTOPO,NTOPO,itopo,1)
  45.          if (ierr.ne.0) return
  46.          NLUS=0
  47.          JGN=4
  48.          JGM=NTOPO
  49.          SEGINI MLMOTS
  50.  2       CONTINUE
  51.          NLUS=NLUS+1
  52.          if (nlus.le.ntopo) then
  53.             MOTS(NLUS)=MOTOPO(ITOPO)
  54.             CALL LIRMOT(MOTOPO,NTOPO,itopo,0)
  55.             if (ierr.ne.0) return
  56.             if (itopo.ne.0) goto 2
  57.          endif
  58.          JGM=NLUS
  59.          SEGADJ MLMOTS
  60.          ITOPO=1
  61.       ELSE
  62.          ITOPO=0
  63.       ENDIF
  64. C
  65. C     LECTURE DU MAILLAGE (OBJET DE TYPE MAILLAGE)
  66. C
  67.       IMAIL=0
  68.       IER1=0
  69.       CALL LIROBJ('MAILLAGE',IMAIL,1,IER1)
  70.       IF(IERR .NE. 0)RETURN
  71.       CALL ACTOBJ('MAILLAGE',IMAIL,1)
  72.       IF(IERR .NE. 0)RETURN
  73.       if (itopo.ne.0) then
  74.          CALL INDI2(IMAIL,MLMOTS)
  75.          SEGSUP MLMOTS
  76.          RETURN
  77.       else
  78. C
  79. C     LECTURE DES MOTS CLES
  80. C
  81.          NLUS=0
  82.          DO I=1,NCLE
  83.             CALL QUETYP(CHAR,0,IRETOU)
  84.             IF (CHAR.EQ.'        ') GOTO 1
  85.             CALL LIRMOT(MOCLE,NCLE,ICLE,1)
  86.             IF(IERR .NE. 0)RETURN
  87.             MOLUS(I)=MOCLE(ICLE)
  88.             NLUS=NLUS+1
  89.          ENDDO
  90. C
  91.  1       CONTINUE
  92. C     SI AUCUN MOT CLEF LU
  93.          IF (NLUS.EQ.0) THEN
  94.             CALL ERREUR(498)
  95.             RETURN
  96.          ENDIF
  97. C     REALISATION DE LA TACHE
  98.          SEGACT,MCOORD
  99.          CALL INDCR(MOLUS,NLUS,IMAIL,ICHA)
  100.          SEGDES,MCOORD
  101.  
  102.          CALL ACTOBJ('MCHAML',ICHA,1)
  103.          CALL ECROBJ('MCHAML',ICHA)
  104.       endif
  105. C
  106. 666   RETURN
  107.       END
  108.  
  109.  

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