Télécharger la plaquette Cast3M


fr en

Télécharger hhopar.eso

Retour à la liste

Numérotation des lignes : 

hhopar

  1. C HHOPAR    SOURCE    OF166741  24/05/06    21:15:13     11082          
  2. C HHOPAR    SOURCE                                                      
  3.  
  4.       SUBROUTINE HHOPAR (modlHHO, iret)
  5.  
  6.       IMPLICIT INTEGER(I-N)
  7.       IMPLICIT REAL*8(A-H,O-Z)
  8.  
  9. -INC PPARAM
  10. -INC CCOPTIO
  11.  
  12. -INC CCHHOPA
  13. -INC CCHHOPR
  14.  
  15. -INC SMMODEL
  16. -INC SMELEME
  17. -INC SMLENTI
  18.  
  19.       CHARACTER*(4)  motOPT
  20.  
  21.       iret = 0
  22.  
  23.       imodel = modlHHO
  24.       SEGACT,imodel*MOD
  25.  
  26.       CALL HHONOB(modlHHO, nobHHO, iret)
  27.       IF (nobHHO.LE.0) THEN
  28.         write(ioimp,*) 'HHOPAR: nobHHO undefined'
  29.         CALL ERREUR(5)
  30.         RETURN
  31.       END IF
  32.  
  33.       mailHHO = imodel.IMAMOD
  34. c*      meleme  = mailHHO
  35. c*      segact,meleme*nomod (segment actif en entree)
  36.  
  37. c== Segment lentHHO :
  38.       JG = 10
  39.       SEGINI,mlent2
  40.       DO i = 1, JG
  41.         mlent2.lect(i) = -999
  42.       END DO
  43.       lentHHO = mlent2
  44.  
  45. C= Remplissage de segments :
  46.       IPOSR = 0
  47.       INDSR = 0
  48.       NMAXR = MAX(NISFHO,NISCHO)
  49.       i_z = 0
  50.       CALL HHOLI2('INIT_IPOS',i_z,IPOSR,i_z,iret)
  51.       if (iret.ne.0) return
  52.       CALL HHOLI2('INIT_INDS',i_z,NMAXR,INDSR,iret)
  53.       if (iret.ne.0) return
  54.       mlent2.lect(6) = IPOSR
  55.       mlent2.lect(7) = INDSR
  56.  
  57. C= On recherche les faces du maillage dans sa totalite :
  58.       CALL ECROBJ('MAILLAGE',mailHHO)
  59.       IF (IDIM.EQ.2) THEN
  60.         CALL CHANLG
  61.       ELSE 
  62.         CALL ECRCHA('NOID')
  63.         CALL ENVVO2(1)
  64.       END IF
  65.       CALL LIROBJ('MAILLAGE',mailSQE,1,iretc)
  66.       IF (IERR.NE.0) THEN
  67.         iret = 21
  68.         RETURN
  69.       END IF
  70.  
  71. c-dbg      write(ioimp,*) 'HHOPAR - mailHHO'
  72. c-dbg      CALL ecmail(mailhho,0)
  73. c-dbg      write(ioimp,*) 'HHOPAR - mailSQE'
  74. c-dbg      CALL ecmail(mailSQE,0)
  75.  
  76.       CALL ACTOBJ('MAILLAGE',mailHHO,1)
  77.  
  78.       motOPT = 'CELL'
  79.       CALL HHOLIM(motOPT,mailHHO,lentHHO,iret)
  80.       IF (iret.NE.0) RETURN
  81.  
  82.       motOPT = 'FAEL'
  83.       CALL HHOLIM(motOPT,mailHHO,lentHHO,iret)
  84.       IF (iret.NE.0) RETURN
  85.  
  86.       CALL ACTOBJ('MAILLAGE',mailSQE,1)
  87.  
  88.       motOPT = 'FACE'
  89.       CALL HHOLIM(motOPT,mailSQE,lentHHO,iret)
  90.       IF (iret.NE.0) RETURN
  91.  
  92. C= On stocke dans le IMODEL les informations mises a jour 
  93. c* Pour memoire      mlent2 = lentHHO
  94. C Liste entiers de chaque arete de la zone 
  95.       imodel.TYMODE(nobHHO+2) = 'LISTENTI'
  96.       imodel.IVAMOD(nobHHO+2) = mlent2.lect( 8)
  97.  
  98. C Liste entiers donnant les aretes pour chaque cellule de la zone
  99.       imodel.TYMODE(nobHHO+3) = 'LISTENTI'
  100.       imodel.IVAMOD(nobHHO+3) = mlent2.lect( 9)
  101.  
  102. C Liste entiers donnant les cellules de la zone
  103.       imodel.TYMODE(nobHHO+4) = 'LISTENTI'
  104.       imodel.IVAMOD(nobHHO+4) = mlent2.lect(10)
  105.  
  106. c-dbgC Construction du maillage des points supports des faces :
  107. c-dbg      mlent3 = mlent2.lect(8)
  108. c-dbg      CALL HHOMPO('FACE',mlent3,ipt3)
  109. c-dbg      imodel.TYMODE(nobHHO+5) = 'MAILLAGE'
  110. c-dbg      imodel.IVAMOD(nobHHO+5) = ipt3
  111. c-dbg
  112. c-dbgC Construction du maillage des points supports des cellules :
  113. c-dbg      mlent3 = mlent2.lect(10)
  114. c-dbg      CALL HHOMPO('CELL',mlent3,ipt3)
  115. c-dbg      imodel.TYMODE(nobHHO+6) = 'MAILLAGE'
  116. c-dbg      imodel.IVAMOD(nobHHO+6) = ipt3
  117.  
  118.       SEGACT,imodel*NOMOD
  119.  
  120. c**      RETURN
  121.       END
  122.  
  123.  
  124.  

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