Télécharger la plaquette Cast3M


fr en

Télécharger hhoprm.eso

Retour à la liste

Numérotation des lignes : 

hhoprm

  1. C HHOPRM    SOURCE    OF166741  26/02/23    21:15:04     12480          
  2.  
  3.       SUBROUTINE HHOPRM (charHHO, modlHHO, nobHHO, lentHHO, iret)
  4.  
  5.       IMPLICIT INTEGER(I-N)
  6.       IMPLICIT REAL*8(A-H,O-Z)
  7.  
  8. -INC PPARAM
  9. -INC CCOPTIO
  10. -INC CCGEOME
  11.  
  12. -INC CCHHOPA
  13. -INC CCHHOPR
  14.  
  15. -INC SMMODEL
  16. -INC SMELEME
  17. -INC SMLENTI
  18. -INC SMLREEL
  19.  
  20.       EXTERNAL LONG
  21.  
  22.       CHARACTER*(*) charHHO
  23.  
  24.       CHARACTER*(6) nomsg
  25.       CHARACTER*(LOCHAI) charerr
  26.  
  27.       iret = 0
  28.  
  29. C= La chaine charHHO est de la forme : "hho_cc_ff_hyp" (suite a HHOPRE)
  30.       n_c = LONG(charHHO)
  31.       if (iimpi.eq.1972)
  32.      &   write(ioimp,*) 'HHOPRM =',charHHO(1:n_c)
  33.  
  34.       imodel = modlHHO
  35. c*      segact,imodel*nomod (segment actif en entree)
  36.  
  37.       mlent2 = lentHHO
  38. c*      segact,mlent2*nomod (segment actif en entree)
  39.  
  40.       mailHHO = imodel.IMAMOD
  41.       meleme  = mailHHO
  42. c*      segact,meleme*nomod (segment actif en entree)
  43.  
  44.       ity   = meleme.ITYPEL
  45.       nbnoe = meleme.NUM(/1)
  46. c* pour l'instant poly03->tri3 et poly04->qua4
  47.       ityl = ity
  48.       IF (ity.EQ.32) THEN
  49.         if (nbnoe.eq.3) ityl = 4
  50.         if (nbnoe.eq.4) ityl = 8
  51.       END IF
  52.       nomsg = '      '
  53.       CALL CHCASS(NOMS(ityl),0,nomsg(1:4))
  54.       IF (ityl.EQ.32) THEN
  55.         WRITE(nomsg(5:6),'(I2.2)') nbnoe
  56.       END IF
  57.       n_s = LONG(nomsg)
  58.       if (iimpi.eq.1972)
  59.      &  write(ioimp,*) 'HHOPRM =',nomsg(1:n_s),'=',nbnoe,ity,ityl
  60.  
  61.       JG = 20 + HHO_MAX_EDGE
  62.       SEGINI,mlenti
  63.       DO i = 1, JG
  64.         mlenti.lect(i) = -999
  65.       END DO
  66.       ile = JG
  67.  
  68.       mlenti.lect( 1) = mlent2.lect(1)
  69.       mlenti.lect( 2) = mlent2.lect(2)
  70.       mlenti.lect( 3) = mlent2.lect(3)
  71.       mlenti.lect( 4) = mlent2.lect(4)
  72.       mlenti.lect( 5) = mlent2.lect(5)
  73.       mlenti.lect( 6) = nbnoe
  74.       mlenti.lect( 7) = nbnoe
  75.  
  76. C= Tableau de flottants : inutilise ici
  77.       JG = 1
  78.       SEGINI,mlreel
  79.       ilr = JG
  80.  
  81.       iretc = 0
  82. C= On complete le tableau mlenti.LECT
  83.       CALL HHOC3M('INIT',charHHO(1:n_c)//'_'//nomsg(1:n_s),
  84.      &                   HHO_NomLib, HHO_MaxLib,
  85.      &                   mlenti.lect,ile, mlreel.prog,ilr,
  86.      &                   iretc,charerr)
  87.  
  88. C= Suppression du tableau de flottants
  89.       SEGSUP,MLREEL
  90.  
  91. C= Erreur dans HHOC3M : A affiner
  92.       IF (iretc.NE.0) THEN
  93.         write(ioimp,*) 'HHO -> HHOPRM - ERROR ='
  94.         write(ioimp,*) charerr(1:LONG(charerr))
  95.         iret = 21
  96.         return
  97.       END IF
  98.  
  99.       if (iimpi.eq.1972) then
  100.         write(ioimp,*) 'RETOUR de HHOC3M-INIT'
  101.         write(ioimp,*) (mlenti.lect(i),i=1,20)
  102.         write(ioimp,*) (mlenti.lect(i),i=20+1,ile)
  103.         write(ioimp,*) '---------------------'
  104.       endif
  105.  
  106. c-dbgC= Quelques affichages pour verification :
  107. c-dbg      segini,mlent3=mlenti
  108. c-dbg      mlent3.lect( 8) = 3*nbnoe
  109. c-dbg      mlent3.lect( 9) = IDIM
  110. c-dbg      mlent3.lect(10) = 3*3
  111. c-dbg      mlent3.lect(11) = mlent3.lect( 9) *
  112. c-dbg     &      ( mlent3.lect( 5) + mlent3.lect( 7) * mlent3.lect( 3) )
  113. c-dbg      mlent3.lect(12) = mlent3.lect( 9) *
  114. c-dbg     &      ( mlent3.lect( 7) * mlent3.lect( 3) )
  115. c-dbg      mlent3.lect(13) = mlent3.lect( 9) * mlent3.lect( 5)
  116. c-dbg      mlent3.lect(14) = 9 * mlent3.lect(11)
  117. c-dbg      mlent3.lect(15) = mlent3.lect(14) * mlent3.lect( 8)
  118. c-dbg      mlent3.lect(16) = mlent3.lect(11) * mlent3.lect(11)
  119. c-dbg      mlent3.lect(17) = mlent3.lect(13) * mlent3.lect(13)
  120. c-dbg      mlent3.lect(18) = mlent3.lect(13) * mlent3.lect(12)
  121. c-dbg      mlent3.lect(19) = mlent3.lect(13)
  122. c-dbgc      mentl3.lect(20+1:20+d % num_faces) = d % num_vertices_per_face(1:d%num_faces)
  123. c-dbg      write(ioimp,*) 'RETOUR de HHOC3M-INIT (bis)'
  124. c-dbg      write(ioimp,*) (mlenti.lect(i)-mlent3.lect(i),i=1,20)
  125. c-dbg      segsup,mlent3
  126.  
  127. C= On recherche les faces du maillage dans sa totalite :
  128.       CALL ECROBJ('MAILLAGE',mailHHO)
  129.       IF (IDIM.EQ.2) THEN
  130.         CALL CHANLG
  131.       ELSE 
  132.         CALL ECRCHA('NOID')
  133.         CALL ENVVO2(1)
  134.       END IF
  135.       CALL LIROBJ('MAILLAGE',mailSQE,1,iretc)
  136.       IF (IERR.NE.0) THEN
  137.         iret = 21
  138.         RETURN
  139.       END IF
  140.  
  141.       CALL ACTOBJ('MAILLAGE',mailHHO,1)
  142.       CALL HHOLIM('CELL',mailHHO,lentHHO,iret)
  143.       IF (iret.NE.0) RETURN
  144.  
  145.       CALL ACTOBJ('MAILLAGE',mailHHO,1)
  146.       CALL HHOLIM('FAEL',mailHHO,lentHHO,iret)
  147.       IF (iret.NE.0) RETURN
  148.  
  149.       CALL ACTOBJ('MAILLAGE',mailSQE,1)
  150.       CALL HHOLIM('FACE',mailSQE,lentHHO,iret)
  151.       IF (iret.NE.0) RETURN
  152.  
  153. C= Pour memoire      mlent2 = lentHHO
  154.  
  155. C= On stocke dans le IMODEL le nombre de ddls par face et par cellule
  156. C= Pour eviter souci dans ACTOBJ : entier < ou = 0 !
  157.       imodel.INFMOD( 9) = -1 * mlenti.lect(3)
  158.       imodel.INFMOD(12) = -1 * mlenti.lect(5)
  159.  
  160. C= Chaine pour les informations HHO
  161.       CALL POSCHA(charHHO(1:n_c)//'_'//nomsg(1:n_s),I_POS)
  162.       imodel.TYMODE(nobHHO+1) = 'MOT     '
  163.       imodel.IVAMOD(nobHHO+1) = I_POS
  164.  
  165. C= Le tableau des donnees de mlenti :
  166.       imodel.TYMODE(nobHHO+2) = 'LISTENTI'
  167.       imodel.IVAMOD(nobHHO+2) = mlenti
  168.  
  169. C Liste entiers de chaque arete de la zone 
  170.       imodel.TYMODE(nobHHO+3) = 'LISTENTI'
  171.       imodel.IVAMOD(nobHHO+3) = mlent2.lect(8)
  172.  
  173. C Liste entiers donnant les aretes pour chaque cellule de la zone
  174.       imodel.TYMODE(nobHHO+4) = 'LISTENTI'
  175.       imodel.IVAMOD(nobHHO+4) = mlent2.lect(9)
  176.  
  177. C Liste entiers donnant les cellules de la zone
  178.       imodel.TYMODE(nobHHO+5) = 'LISTENTI'
  179.       imodel.IVAMOD(nobHHO+5) = mlent2.lect(10)
  180.  
  181. c-dbgC Construction du maillage des points supports :
  182. c-dbg      mlent3 = mlent2.lect(8)
  183. c-dbg      CALL HHOMPO('FACE',mlent3,ipt3)
  184. c-dbg      imodel.TYMODE(nobHHO+6) = 'MAILLAGE'
  185. c-dbg      imodel.IVAMOD(nobHHO+6) = ipt3
  186. c-dbg
  187. c-dbgC Maillage des points supports :
  188. c-dbg      mlent3 = mlent2.lect(10)
  189. c-dbg      CALL HHOMPO('CELL',mlent3,ipt3)
  190. c-dbg      imodel.TYMODE(nobHHO+7) = 'MAILLAGE'
  191. c-dbg      imodel.IVAMOD(nobHHO+7) = ipt3
  192.  
  193.       if (iimpi.eq.1972) then
  194.         write(ioimp,*) 'TYMODE IVAMOD'//
  195.      &                 ' ->'//charHHO(1:n_c)//'_'//nomsg(1:n_s)//'<-'
  196.         do i=nobHHO+1,nobHHO+5
  197.           write(ioimp,*) imodel.tymode(i),imodel.ivamod(i)
  198.         enddo
  199.         write(ioimp,*) '---------------------'
  200.       endif
  201.  
  202. c      RETURN
  203.       END
  204.  
  205.  
  206.  

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