Télécharger la plaquette Cast3M


fr en

Télécharger hholi2.eso

Retour à la liste

Numérotation des lignes : 

hholi2

  1. C HHOLI2    SOURCE    OF166741  24/05/06    21:15:11     11082          
  2. C HHOLI2    SOURCE    FANDEUR                                           
  3. C
  4.       SUBROUTINE HHOLI2 (chopt,IPGEO,IPOSL,INDSL,iret)
  5.  
  6.       IMPLICIT INTEGER(I-N)
  7.       IMPLICIT REAL*8(A-H,O-Z)
  8.  
  9. -INC PPARAM
  10. -INC CCOPTIO
  11.  
  12. c*-INC CCHHOPA
  13. c*-INC CCHHOPR
  14.  
  15. -INC SMCOORD
  16. -INC SMELEME
  17.  
  18.       SEGMENT ipos(nbpt)
  19.       SEGMENT inds(mm)
  20.  
  21.       CHARACTER*(*) chopt
  22.  
  23.       iret = 0
  24.  
  25. C Segment IPOS : creation si demande
  26.       IF (chopt(1:9).EQ.'INIT_IPOS') THEN
  27.         nbpt = NBPTS + 1
  28.         SEGINI,ipos
  29.         IPOSL = ipos
  30.         RETURN
  31.       END IF
  32.  
  33. C Segment INDS : creation si demande
  34.       IF (chopt(1:9).EQ.'INIT_INDS') THEN
  35.         mm = IPOSL
  36.         SEGINI,inds
  37.         INDSL = inds
  38.         RETURN
  39.       END IF
  40.  
  41. C Segments IPOS/INDS : Verification maillage avant remplissage
  42.       IF ((chopt(1:9).EQ.'REMP_IPOS') .OR.
  43.      &    (chopt(1:9).EQ.'REMP_INDS') .OR.
  44.      &    (chopt(1:9).EQ.'REMP_TOUS')) THEN
  45.         meleme = IPGEO
  46. C*        SEGACT,meleme <- Segment actif en Entree
  47. C Petits tests sur le maillage mais a priori inutiles :
  48.         nbsou = meleme.lisous(/1)
  49.         IF (nbsou.NE.0) THEN
  50.           iret = 21
  51.           RETURN
  52.         END IF
  53. c*        ityp = meleme.itypel
  54.         nbnoe = meleme.num(/1)
  55.         nbelt = meleme.num(/2)
  56.         IF (nbnoe.EQ.0 .OR. nbelt.EQ.0) THEN
  57.           iret = 21
  58.           RETURN
  59.         END IF
  60.       END IF
  61.  
  62. C Segment IPOS : Remplissage
  63.       IF ((chopt(1:9).EQ.'REMP_IPOS') .OR.
  64.      &    (chopt(1:9).EQ.'REMP_TOUS')) THEN
  65.         ipos = IPOSL
  66. c*        SEGACT,ipos*MOD
  67.         nbpt = ipos(/1)
  68.         np = nbpt - 1
  69.         DO in = 1, nbpt
  70.           ipos(in) = 0
  71.         END DO
  72.         DO ie = 1, nbelt
  73.           DO in = 1, nbnoe
  74.             ia = meleme.num(in,ie)
  75.             ipos(ia) = ipos(ia)+1
  76.           END DO
  77.         END DO
  78.         i_z = ipos(1)
  79.         DO in = 2, np
  80.           i_z = i_z + ipos(in)
  81.           ipos(in) = i_z
  82.         END DO
  83.         ipos(nbpt) = ipos(np)
  84.         IF (chopt(6:9).EQ.'IPOS') THEN
  85.           INDSL = ipos(nbpt)
  86. C*          SEGDES,meleme  <- Segment actif en Sortie (non modifie)
  87. C*          SEGDES,ipos    <- Segment actif en Sortie
  88.           RETURN
  89.         END IF
  90.       END IF
  91.  
  92. C Segment INDS : Remplissage
  93.       IF ((chopt(1:9).EQ.'REMP_INDS') .OR.
  94.      &    (chopt(1:9).EQ.'REMP_TOUS')) THEN
  95.         ipos = IPOSL
  96. c*        SEGACT,ipos*MOD
  97.         nbpt = ipos(/1)
  98.         inds = INDSL
  99. c*        SEGACT,inds*MOD
  100.         mm = inds(/1)
  101.         IF (mm.LT.ipos(nbpt)) THEN
  102.           iret = 5
  103.           RETURN
  104.         END IF
  105.         DO in = 1, mm
  106.           inds(in) = 0
  107.         END DO
  108.         DO ie = 1, nbelt
  109.           DO in = 1, nbnoe
  110.             ia = meleme.num(in,ie)
  111.             id = ipos(ia)
  112.             inds(id) = ie
  113.             ipos(ia) = id-1
  114.           END DO
  115.         END DO
  116.  
  117. C*      SEGDES,meleme  <- Segment actif en Sortie (non modifie)
  118. C*      SEGDES,ipos,inds <- Segments actifs en Sortie
  119.         RETURN
  120.       END IF
  121.  
  122. C= Erreur arnomale si on arrive ici
  123.       iret = 5
  124.  
  125. C*      RETURN
  126.       END
  127.  
  128.  
  129.  

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