Télécharger geopc.eso

Retour à la liste

Numérotation des lignes :

  1. C GEOPC SOURCE GOUNAND 06/04/06 17:53:43 5371
  2. SUBROUTINE GEOPC(JCOOR,FFPG,
  3. $ JPC,
  4. $ IMPR,IRET)
  5. IMPLICIT REAL*8 (A-H,O-Z)
  6. IMPLICIT INTEGER (I-N)
  7. C***********************************************************************
  8. C NOM : GEOPC
  9. C PROJET : Noyau linéaire NLIN
  10. C DESCRIPTION : Récupération de la première coordonnée
  11. C
  12. C LANGAGE : ESOPE
  13. C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  14. C mél : gounand@semt2.smts.cea.fr
  15. C***********************************************************************
  16. C APPELES :
  17. C APPELE PAR :
  18. C***********************************************************************
  19. C ENTREES :
  20. C ENTREES/SORTIES : -
  21. C SORTIES :
  22. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  23. C***********************************************************************
  24. C VERSION : v1, 23/03/06, version initiale
  25. C HISTORIQUE : v1, 23/03/06, création
  26. C HISTORIQUE :
  27. C HISTORIQUE :
  28. C***********************************************************************
  29. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  30. C en cas de modification de ce sous-programme afin de faciliter
  31. C la maintenance !
  32. C***********************************************************************
  33.  
  34. -INC PPARAM
  35. -INC CCOPTIO
  36. CBEGININCLUDE SMCHAEL
  37. SEGMENT MCHAEL
  38. POINTEUR IMACHE(N1).MELEME
  39. POINTEUR ICHEVA(N1).MCHEVA
  40. ENDSEGMENT
  41. SEGMENT MCHEVA
  42. REAL*8 VELCHE(NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM)
  43. ENDSEGMENT
  44. SEGMENT LCHEVA
  45. POINTEUR LISCHE(NBCHE).MCHEVA
  46. ENDSEGMENT
  47. CENDINCLUDE SMCHAEL
  48. POINTEUR JCOOR.MCHEVA
  49. POINTEUR JPC.MCHEVA
  50. * Valeurs des fns d'interpolation du coeff. aux points de Gauss
  51. POINTEUR FFPG.MCHEVA
  52. *
  53. INTEGER IMPR,IRET
  54. *
  55. INTEGER NDLIG,NDCOL,N2DLIG,N2DCOL,NDNOEU,NDELM
  56. INTEGER NDDL,IESREL,NBPOGO,NBELEM
  57. *
  58. * Executable statements
  59. *
  60. IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans geopc'
  61. IESREL=IDIM
  62. SEGACT JCOOR
  63. NDLIG=JCOOR.VELCHE(/1)
  64. NDCOL=JCOOR.VELCHE(/2)
  65. N2DLIG=JCOOR.VELCHE(/3)
  66. N2DCOL=JCOOR.VELCHE(/4)
  67. NDNOEU=JCOOR.VELCHE(/5)
  68. NDELM=JCOOR.VELCHE(/6)
  69. IF (NDLIG.NE.1.OR.N2DLIG.NE.1.OR.N2DCOL.NE.IESREL.
  70. $ OR.NDNOEU.NE.1) THEN
  71. WRITE(IOIMP,*) 'Erreur dims JCOOR'
  72. GOTO 9999
  73. ENDIF
  74. NDDL=NDCOL
  75. NBELEM=NDELM
  76. SEGACT FFPG
  77. NDLIG=FFPG.VELCHE(/1)
  78. NDCOL=FFPG.VELCHE(/2)
  79. N2DLIG=FFPG.VELCHE(/3)
  80. N2DCOL=FFPG.VELCHE(/4)
  81. NDNOEU=FFPG.VELCHE(/5)
  82. NDELM=FFPG.VELCHE(/6)
  83. IF (NDLIG.NE.1.OR.NDCOL.NE.NDDL.OR.N2DLIG.NE.1
  84. $ .OR.N2DCOL.NE.1.OR.NDELM.NE.1) THEN
  85. WRITE(IOIMP,*) 'Erreur dims FFPG'
  86. GOTO 9999
  87. ENDIF
  88. NBPOGO=NDNOEU
  89. *
  90. NBLIG=1
  91. NBCOL=1
  92. N2LIG=1
  93. N2COL=1
  94. NBPOI=NBPOGO
  95. NBELM=NBELEM
  96. SEGINI JPC
  97. CALL GEOPC1(NDDL,IESREL,NBPOGO,NBELEM,
  98. $ JCOOR.VELCHE,FFPG.VELCHE,
  99. $ JPC.VELCHE,
  100. $ IMPR,IRET)
  101. IF (IRET.NE.0) GOTO 9999
  102. SEGDES JPC
  103. IF (IMPR.GT.3) THEN
  104. WRITE(IOIMP,*) 'On a créé',
  105. $ ' JPC(élément , poi.gauss ,',
  106. $ ' 1,1,1,1)'
  107. CALL PRCHVA(JPC,IMPR,IRET)
  108. IF (IRET.NE.0) GOTO 9999
  109. ENDIF
  110. SEGDES FFPG
  111. SEGDES JCOOR
  112. *
  113. * Normal termination
  114. *
  115. IRET=0
  116. RETURN
  117. *
  118. * Format handling
  119. *
  120. *
  121. * Error handling
  122. *
  123. 9999 CONTINUE
  124. IRET=1
  125. WRITE(IOIMP,*) 'An error was detected in subroutine geopc'
  126. RETURN
  127. *
  128. * End of subroutine GEOPC
  129. *
  130. END
  131.  
  132.  
  133.  

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