Télécharger kres.eso

Retour à la liste

Numérotation des lignes :

  1. C KRES SOURCE GOUNAND 06/03/06 21:17:51 5319
  2. SUBROUTINE KRES
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8 (A-H,O-Z)
  5. C*************************************************************************
  6. C Operateur KRES
  7. C
  8. C OBJET : Resoud l'equation de contrainte
  9. C SYNTAXE : PRES = KRES RVP <IMPR>
  10. C
  11. C*************************************************************************
  12. -INC SMCHPOI
  13. -INC CCOPTIO
  14. C
  15. CHARACTER*8 TYPE,MTYP
  16.  
  17. PARAMETER (NBM=3)
  18. CHARACTER*4 LMOT(NBM)
  19.  
  20. PARAMETER (NTB=1)
  21. CHARACTER*8 LTAB(NTB)
  22. DIMENSION KTAB(NTB)
  23. DATA LTAB/'EQPR '/
  24. DATA LMOT/'IMPR','BETA','PIMP'/
  25. C***
  26. CALL QUETYP(MTYP,1,IRET)
  27. IF (IRET.EQ.0) RETURN
  28. IF(MTYP.EQ.'MATRIK'.OR.MTYP.EQ.'RIGIDITE')THEN
  29. CALL KRES2
  30. RETURN
  31. ELSEIF(MTYP.EQ.'MOT ')THEN
  32. CALL LIRCHA(TYPE,1,LCHA)
  33. IF(LCHA.EQ.0)THEN
  34. * Opération illicite dans ce contexte
  35. CALL ERREUR(153)
  36. RETURN
  37. ENDIF
  38. IF(TYPE(1:2).EQ.'LL')THEN
  39. CALL KRESLL
  40. RETURN
  41. ELSE
  42. * Opération illicite dans ce contexte
  43. CALL ERREUR(153)
  44. RETURN
  45. ENDIF
  46. ENDIF
  47. NTO=1
  48. CALL LITABS(LTAB,KTAB,NTB,NTO,IRET)
  49. IF (IERR.NE.0) THEN
  50. RETURN
  51. ENDIF
  52. MTABP=KTAB(1)
  53.  
  54. TYPE='CHPOINT '
  55. CALL LIROBJ(TYPE,MCHB,1,IRET)
  56. IF(IRET.EQ.0)THEN
  57. WRITE(6,*)' On attend un CHPOINT-CENTRE'
  58. RETURN
  59. ENDIF
  60.  
  61. KDPDQ=0
  62. BETA=0.D0
  63. KPIMP=0
  64. PIMP=0.D0
  65.  
  66. IMPR=0
  67. 1 CONTINUE
  68. CALL LIRMOT(LMOT,NBM,IP,0)
  69. IF(IP.EQ.0)GO TO 2
  70. IF(IP.EQ.1)THEN
  71. IMPR=1
  72. ENDIF
  73. IF(IP.EQ.2)THEN
  74. CALL LIRENT(KDPDQ,1,IRETOU)
  75. IF(IRETOU.EQ.0)THEN
  76. RETURN
  77. ENDIF
  78. CALL LIRREE(BETA,1,IRETOU)
  79. IF(IRETOU.EQ.0)THEN
  80. RETURN
  81. ENDIF
  82. ENDIF
  83. IF(IP.EQ.3)THEN
  84. CALL LIRENT(KPIMP,1,IRETOU)
  85. IF(IRETOU.EQ.0)THEN
  86. RETURN
  87. ENDIF
  88. CALL LIRREE(PIMP,1,IRETOU)
  89. IF(IRETOU.EQ.0) THEN
  90. RETURN
  91. ENDIF
  92. C CALL LIRENT(NIMP,1,IRETOU)
  93. C IF(IRETOU.EQ.0)RETURN
  94. IF(KPIMP.NE.0.AND.KPIMP.NE.1)THEN
  95. C Tentative d'utilisation d'une option non implémentée
  96. CALL ERREUR (251)
  97. RETURN
  98. ENDIF
  99. ENDIF
  100. GO TO 1
  101. 2 CONTINUE
  102.  
  103. C ***********************************************************************
  104. C
  105. C ON PREPARE LE CALCUL DE LA PRESSION SUIVANT LE TYPE
  106. C
  107. C D'INVERSION (KTYPI)
  108. C
  109. C ***********************************************************************
  110.  
  111.  
  112. CALL LEKTAB(MTABP,'MATC',MATRIK)
  113. IF(MATRIK.EQ.0)GO TO 90
  114.  
  115. CALL ACME(MTABP,'KTYPI',KTYPI)
  116. C write(6,*)' Kres : KTYPI=',KTYPI
  117. C
  118. C------------------------------------------------------------------------
  119. C
  120. IF(KTYPI.EQ.1.OR.KTYPI.EQ.5)THEN
  121. C
  122. C METHODE DIRECTE
  123. C
  124. CALL KMDMT(MTABP,MCHB,MCHB,IMPR,BETA,KDPDQ,KPIMP,PIMP,NIMP)
  125. C
  126. C------------------------------------------------------------------------
  127. C
  128.  
  129. ELSEIF(KTYPI.GT.1.AND.KTYPI.LT.5)THEN
  130.  
  131. CALL KRESS(MTABP,MCHB,MCHB,IMPR,BETA,KDPDQ,KPIMP,PIMP,NIMP)
  132.  
  133. C
  134. C------------------------------------------------------------------------
  135. C
  136. ELSEIF(KTYPI.EQ.6)THEN
  137. C
  138. C NEDELEC 28 1 91 METHODE ITERATIVE CHEBYSHEV
  139. C
  140. CALL PROGC(MTABP)
  141. CALL CAPR(MTABP)
  142. C
  143. C----------------------------------------------------------------------
  144. C
  145. ELSEIF(KTYPI.EQ.7)THEN
  146. C
  147. C NEDELEC 11 4 91 GRADIENT CONJUGUE PRECON PAR DIAG
  148. C
  149. CALL KRESF(MTABP,MCHB,MCHB,IMPR)
  150. C
  151. C---------------------------------------------------------------------
  152. C
  153. ELSE
  154. WRITE(6,*)' KRES : OPTION NON PREVUE KTYPI=',KTYPI
  155. C Tentative d'utilisation d'une option non implémentée
  156. CALL ERREUR (251)
  157. RETURN
  158. ENDIF
  159. RETURN
  160. 1001 FORMAT(20(1X,I5))
  161. 1002 FORMAT(10(1X,1PE11.4))
  162. 90 CONTINUE
  163. C Les options de calcul sont erronées.
  164. CALL ERREUR(717)
  165. RETURN
  166. END
  167.  
  168.  
  169.  
  170.  
  171.  
  172.  
  173.  
  174.  
  175.  

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