Télécharger debit.eso

Retour à la liste

Numérotation des lignes :

  1. C DEBIT SOURCE CHAT 06/08/24 21:25:56 5529
  2. SUBROUTINE DEBIT
  3. *_______________________________________________________________________
  4. *
  5. * OPERATEUR DEBIT ( Inspire de PRESSI )
  6. *
  7. * FQ = DEBIT MODEL I D MAIL I (MOT1)
  8. * I CHPDEB I
  9. *
  10. * FQ CHPOINT CONTENANT LES FORCES NODALES EQUIVALENTES
  11. * MODEL OBJET MMODEL ,MASSIF , SUR LEQUEL S'APPLIQUE
  12. * LA CONDITION DE DEBIT
  13. * D VALEUR ALGEBRIQUE DU DEBIT
  14. * MAIL POUR LES MASSIFS ,OBJET MAILLAGE REPRESENTANT
  15. * LA FACE SUR LAQUELLE S'APPLIQUE LA CONDITION
  16. * DE DEBIT
  17. * CHPOT CHPOINT CONTENANT LES VALEURS ALGEBRIQUES
  18. * DES DEBITS AUX NOEUDS
  19. * MOT1 NOM DONNE AU RESULAT ( PAR DEFAUT , CELUI DU MODELE)
  20. *______________________________________________________________________
  21. *
  22. IMPLICIT INTEGER(I-N)
  23. -INC CCOPTIO
  24. -INC SMCHPOI
  25. *
  26. CHARACTER*(4) MOSCAL,MOPOI1,MOT1
  27. REAL*8 XXX
  28. *
  29. DATA MOSCAL/'SCAL'/,MOPOI1/'POI1'/,MOT1/' '/
  30. *
  31. * ON LIT UN MMODEL
  32. *
  33. CALL LIROBJ('MMODEL ',IPMODL,1,IRETM)
  34. IF (IERR.NE.0) RETURN
  35.  
  36. ICONV=0
  37. *
  38. * ON LIT SOIT UN FLOTTANT ET UN MAILLAGE ,SOIT UN CHPOINT
  39. *
  40. CALL LIRREE(XXX,0,IRETOU)
  41. IF (IRETOU.EQ.1) THEN
  42. CALL LIROBJ('MAILLAGE',IPTGEO,1,IRETOU)
  43. IF (IERR.NE.0) GOTO 666
  44. *
  45. CALL ECRREE (XXX)
  46. CALL PROG
  47. CALL ECRCHA(MOSCAL)
  48. CALL ECRENT(1)
  49. CALL ECROBJ('MAILLAGE',IPTGEO)
  50. CALL ECRCHA(MOPOI1)
  51. CALL PRCHAN
  52. IF (IERR.NE.0) GOTO 666
  53. CALL MANUCH
  54. CALL LIROBJ('CHPOINT ',ICHPOP,1,IRETOU)
  55. IF (IERR.NE.0) THEN
  56. CALL DTCHPO(ICHPOP)
  57. GOTO 666
  58. ENDIF
  59. ELSE
  60. CALL LIROBJ('CHPOINT ',ICHPOP,1,IRETOU)
  61. IF (IERR.NE.0) GOTO 666
  62. ENDIF
  63. *
  64. CALL LIRCHA(MOT1,0,IRETOU)
  65. *
  66. CALL FDEBIT(ICHPOP,IPMODL,IPTFP,MOT1,IRET)
  67. IF (IRET.EQ.0) GOTO 666
  68. *
  69. * LE NUMERO DE L HARMONIQUE EST PRIS EGAL A NIFOUR
  70. * POUR TOUTES LES COMPOSANTES DU CHPOINT
  71. *
  72. MCHPOI=IPTFP
  73. SEGACT MCHPOI
  74. * ATTRIBUTION D'UNE NATURE DISCRETE AU CHPO SORTANT
  75. NAT = MAX ( 1 , JATTRI(/1) )
  76. NSOUPO = IPCHP(/1)
  77. SEGADJ MCHPOI
  78. JATTRI(1) = 2
  79. *
  80. DO 100 IA=1,IPCHP(/1)
  81. MSOUPO=IPCHP(IA)
  82. SEGACT MSOUPO
  83. DO 101 NC=1,NOHARM(/1)
  84. NOHARM(NC)=NIFOUR
  85. 101 CONTINUE
  86. SEGDES MSOUPO
  87. 100 CONTINUE
  88. SEGDES MCHPOI
  89. *
  90. CALL ECROBJ('CHPOINT ',IPTFP)
  91. *
  92. 666 IF (ICONV.EQ.1) THEN
  93. CALL DTMODL(IPMODL)
  94. ENDIF
  95. RETURN
  96. END
  97.  
  98.  
  99.  
  100.  

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