Télécharger la plaquette Cast3M


fr en

Télécharger nuachp.eso

Retour à la liste

Numérotation des lignes : 

nuachp

  1. C NUACHP    SOURCE    CB215821  20/11/25    13:35:19     10792          
  2.       SUBROUTINE NUACHP(ICHP)
  3. *
  4. *    sous routine de l'operateur nuage pour creer un objet
  5. *    nuage à partir d'un champ par point.
  6. *
  7.       IMPLICIT INTEGER(I-N)
  8.       IMPLICIT REAL*8(A-H,O-Z)
  9. *
  10. -INC PPARAM
  11. -INC CCOPTIO
  12. -INC SMELEME
  13. -INC SMNUAGE
  14. -INC SMLMOTS
  15. -INC SMCHPOI
  16. *
  17. *
  18. *
  19.        IRETOU = 0
  20. *
  21. *------------------------ Lecture du CHPOINT ---------------------
  22. *
  23.       MCHPOI = ICHP
  24.       SEGACT MCHPOI
  25.       NSOUPO = IPCHP(/1)
  26. *
  27. *-------- Boucle créant un LISTMOT contenant les noms des variables ---
  28. *-------- contenues dans le CHPOINT. Ces noms n'apparaissent qu'une ---
  29. *-------- seule fois --------------------------------------------------
  30. *
  31.       IF (NSOUPO .EQ. 0) THEN
  32.          NVAR = 0
  33.          NBCOUP = 0
  34.          SEGINI MNUAGE
  35.          SEGDES MNUAGE
  36.       ENDIF
  37. *
  38.       DO 10 I=1,NSOUPO
  39.          MSOUPO = IPCHP(I)
  40.          SEGACT MSOUPO
  41.          IF(I.EQ.1) THEN
  42.             JGN = LOCOMP
  43.             JGM = 20
  44.             SEGINI MLMOTS
  45.             NC = NOCOMP(/2)
  46.             IF(NC.GT.20) THEN
  47.                JGM = NC + 10
  48.                SEGADJ MLMOTS
  49.             ENDIF
  50.             DO 20 J=1,NC
  51.                MOTS(J) = NOCOMP(J)
  52.   20        CONTINUE
  53.             NBMO = NC
  54.          ELSE
  55.             NC = NOCOMP(/2)
  56.             DO 30 J = 1,NC
  57.                NEXIS = 0
  58.                DO 40 K = 1,NBMO
  59.                   IF(NOCOMP(J).EQ.MOTS(K)) THEN
  60.                      NEXIS = 1
  61.                   ENDIF
  62.   40           CONTINUE
  63.                IF(NEXIS.EQ.0) THEN
  64.                   NBMO = NBMO + 1
  65.                   IF (NBMO.GT.MOTS(/2)) THEN
  66.                      JGM = JGM + 10
  67.                      SEGADJ MLMOTS
  68.                   ENDIF
  69.                   MOTS(NBMO) = NOCOMP(J)
  70.                ENDIF
  71.   30        CONTINUE
  72.          ENDIF
  73.          SEGDES MSOUPO
  74.   10  CONTINUE
  75. *
  76. *------------------ on redefinit la taille du LISTMOT  ----------------
  77. *
  78.       JGM = NBMO
  79.       SEGADJ MLMOTS
  80. *
  81. *--------------Calcul du nombre total de points-------------------------
  82. *
  83.       NBPOI = 0
  84.       DO 50 I=1,NSOUPO
  85.          MSOUPO = IPCHP(I)
  86.          SEGACT MSOUPO
  87.          MELEME = IGEOC
  88.          SEGACT MELEME
  89.          NBPOI = NBPOI + NUM(/2)
  90.          SEGDES MELEME
  91.          SEGDES MSOUPO
  92.   50  CONTINUE
  93. *
  94. *
  95. *
  96. *---------------Initialisation de l'objet nuage-------------------------
  97. *
  98.        NVAR = NBMO
  99.        SEGINI MNUAGE
  100.        DO 60 I = 1,NVAR
  101.           NUANOM(I) = MOTS(I)
  102.   60   CONTINUE
  103.        NBCOUP = NBPOI
  104.        DO 70 I = 1,NVAR
  105.           NUATYP(I) = 'FLOTTANT'
  106.   70   CONTINUE
  107.  
  108.        SEGSUP MLMOTS
  109. *
  110. *
  111. *-------------------Création des n-uplets du nuage---------------
  112. *
  113. *---------A chaque n-uplet correspond une liste de réels---------
  114. *---------comportant les composantes contenues dans le-----------
  115. *---------champ par point----------------------------------------
  116. *
  117. *---------Boucle sur les composantes du nuage--------------------
  118. *
  119.        DO 90 I = 1,NVAR
  120.           SEGINI NUAVFL
  121.           NUAPOI(I) = NUAVFL
  122.           IND = 1
  123. *
  124. *---------Boucle sur les sous-maillages--------------------------
  125. *
  126.           DO 100 J = 1,NSOUPO
  127.              MSOUPO = IPCHP(J)
  128.              SEGACT MSOUPO
  129.              MELEME = MSOUPO.IGEOC
  130.              SEGACT MELEME
  131.              MPOVAL = IPOVAL
  132.              SEGACT MPOVAL
  133.              N = VPOCHA(/1)
  134.              NC = VPOCHA(/2)
  135. *
  136. *---------Boucle sur les points du sous-maillage intégrant-------
  137. *---------une boucle sur les différentes composantes du----------
  138. *---------point. Remplissage du tableau de valeurs--------------
  139. *
  140.              DO 110 L = 1,N
  141.                 DO 120 K = 1,NC
  142.                    IF (NUANOM(I) .EQ. NOCOMP(K)) THEN
  143.                       NUAFLO(IND) = VPOCHA(L,K)
  144.                    ENDIF
  145.   120           CONTINUE
  146.                    IND = IND + 1
  147.   110        CONTINUE
  148.  
  149.              SEGDES MPOVAL
  150.              SEGDES MELEME
  151.              SEGDES MSOUPO
  152.  
  153.   100     CONTINUE
  154.           SEGDES NUAVFL
  155.  
  156.   90   CONTINUE
  157.  
  158.       SEGDES MCHPOI
  159.       SEGDES MNUAGE
  160. *
  161. *---------------------Ecriture du nuage---------------------------
  162. *
  163.       CALL ECROBJ('NUAGE   ', MNUAGE)
  164.       RETURN
  165. *
  166.       END
  167.  
  168.  
  169.  

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