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

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