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

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