Télécharger prchl1.eso

Retour à la liste

Numérotation des lignes :

  1. C PRCHL1 SOURCE PASCAL 17/07/27 21:15:25 9514
  2. C
  3. C-----------------------------------------------------------------------
  4. C Sous-programme de l'operateur PRESSION :
  5. C
  6. C IPCHE2 = PRES IPMOD1 IPCHE1 ;
  7. C
  8. C En entree :
  9. C -----------
  10. C IPMOD1 : MMODEL de formulation CHARGEMENT PRESSION
  11. C IPCHE1 : MCHAML passe par l'utilisateur, reduit sur IPMOD1
  12. C
  13. C En sortie :
  14. C -----------
  15. C IPCHE2 : contient le MCHAML de pression resultat / 0 si echec
  16. C desactive en sortie
  17. C
  18. C-----------------------------------------------------------------------
  19. SUBROUTINE PRCHL1(IPMOD10,IPCHE10,IPCHE2)
  20. C
  21. IMPLICIT INTEGER(I-N)
  22. IMPLICIT REAL*8 (A-H,O-Z)
  23.  
  24. CHARACTER*11 TITCHE
  25. CHARACTER*4 MOCONT
  26.  
  27.  
  28. -INC PPARAM
  29. -INC CCOPTIO
  30. -INC SMCHAML
  31. -INC SMMODEL
  32. C
  33. IPMOD1 = IPMOD10
  34. IPCHE1 = IPCHE10
  35. IPCHE2 = 0
  36. C
  37. C Verif du support / Changement si besoin
  38. ICOND = 0
  39. CALL QUESUP(IPMOD1,IPCHE1,0,ICOND,ISUP,IRET2)
  40. IF (IERR.NE.0) RETURN
  41. C
  42. C Changement de support si besoin
  43. IF (IRET2.EQ.9999) THEN
  44. CALL ERREUR(560)
  45. RETURN
  46. ELSEIF (ISUP.NE.5) THEN
  47. CALL CHASUP(IPMOD1,IPCHE1,IPCHEL,IRET,5)
  48. IF (IERR.NE.0) RETURN
  49. IPCHE1=IPCHEL
  50. ENDIF
  51. c write (6,*) ' Apres QUESUP, ISUP, IRET2=',ISUP,IRET2
  52. C
  53. C On active le MMODEL
  54. MMODEL=IPMOD1
  55. SEGACT, MMODEL
  56. NSZ = MMODEL.KMODEL(/1)
  57. C
  58. C Initialisation de IPCHE2 (MCHEL2)
  59. MCHEL1=IPCHE1
  60. SEGACT,MCHEL1
  61. SEGINI,MCHEL2=MCHEL1
  62. N1 = MCHEL1.ICHAML(/1)
  63. N3 = MCHEL1.INFCHE(/2)
  64. L1 = 11
  65. SEGADJ,MCHEL2
  66. MCHEL2.TITCHE='CONTRAINTES'
  67. MCHEL2.IFOCHE=IFOUR
  68. C
  69. C Verif nb sous-zones MCHAML < MMODEL
  70. IF (N1.GT.NSZ) THEN
  71. CALL ERREUR(553)
  72. GOTO 999
  73. ENDIF
  74. C
  75. C Boucles sur les sous-zones :
  76. DO I=1,N1
  77. MCHAM1=MCHEL1.ICHAML(I)
  78. SEGACT,MCHAM1
  79. C On verifie le type de la composante
  80. IF (MCHAM1.TYPCHE(1).NE.'REAL*8') THEN
  81. CALL ERREUR(671)
  82. GOTO 999
  83. ENDIF
  84. C Tests sur composantes
  85. NCPCH=MCHAM1.NOMCHE(/2)
  86. IMODEL=MMODEL.KMODEL(I)
  87. SEGACT,IMODEL
  88. C Noms des composantes de contrainte
  89. NOMID=IMODEL.LNOMID(4)
  90. SEGACT,NOMID
  91. NCPMO=NOMID.LESOBL(/2)
  92. C Le MCHAML doit avoir le meme nbr de composante que le MMODEL
  93. IF (NCPCH.NE.NCPMO) THEN
  94. MOTERR(1:8)='MCHAML '
  95. CALL ERREUR(980)
  96. GOTO 999
  97. ENDIF
  98. C S'il y a plusieurs composantes de contrainte, le MCHAML fourni
  99. C doit avoir les memes noms de composante que le MMODEL
  100. IF (NCPMO.NE.1) THEN
  101. DO J=1,NCPMO
  102. IF (MCHAM1.NOMCHE(J).NE.NOMID.LESOBL(J)) THEN
  103. MOTERR(1:4)=NOMID.LESOBL(J)(1:4)
  104. MOTERR(5:30)=' par element en argument '
  105. CALL ERREUR(77)
  106. GOTO 999
  107. ENDIF
  108. ENDDO
  109. ELSE
  110. C Initialisation de MCHAM2 pour changer le nom des composantes
  111. SEGINI,MCHAM2=MCHAM1
  112. MCHEL2.ICHAML(I)=MCHAM2
  113. MCHAM2.NOMCHE(1)=NOMID.LESOBL(1)(1:4)
  114. SEGDES,MCHAM2
  115. ENDIF
  116. SEGDES,NOMID
  117. C Mise a jour du tableabu INFCHE
  118. MCHEL2.INFCHE(I,1)=0
  119. MCHEL2.INFCHE(I,2)=0
  120. MCHEL2.INFCHE(I,3)=NIFOUR
  121. MCHEL2.INFCHE(I,4)=IMODEL.INFMOD(7)
  122. MCHEL2.INFCHE(I,5)=0
  123. MCHEL2.INFCHE(I,6)=5
  124. ENDDO
  125. C
  126. IPCHE2=MCHEL2
  127. C
  128. 999 SEGDES,MCHEL2
  129. C
  130. RETURN
  131. END
  132.  
  133.  
  134.  
  135.  
  136.  
  137.  
  138.  
  139.  
  140.  
  141.  
  142.  
  143.  
  144.  
  145.  
  146.  

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