Télécharger hhopar.eso

Retour à la liste

Numérotation des lignes :

hhopar
  1. C HHOPAR SOURCE OF166741 24/06/19 21:15:08 11942
  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.  
  125.  

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