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. -INC CCOPTIO
  34. CBEGININCLUDE SMCHAEL
  35. SEGMENT MCHAEL
  36. POINTEUR IMACHE(N1).MELEME
  37. POINTEUR ICHEVA(N1).MCHEVA
  38. ENDSEGMENT
  39. SEGMENT MCHEVA
  40. REAL*8 VELCHE(NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM)
  41. ENDSEGMENT
  42. SEGMENT LCHEVA
  43. POINTEUR LISCHE(NBCHE).MCHEVA
  44. ENDSEGMENT
  45. CENDINCLUDE SMCHAEL
  46. POINTEUR JCOOR.MCHEVA
  47. POINTEUR JPC.MCHEVA
  48. * Valeurs des fns d'interpolation du coeff. aux points de Gauss
  49. POINTEUR FFPG.MCHEVA
  50. *
  51. INTEGER IMPR,IRET
  52. *
  53. INTEGER NDLIG,NDCOL,N2DLIG,N2DCOL,NDNOEU,NDELM
  54. INTEGER NDDL,IESREL,NBPOGO,NBELEM
  55. *
  56. * Executable statements
  57. *
  58. IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans geopc'
  59. IESREL=IDIM
  60. SEGACT JCOOR
  61. NDLIG=JCOOR.VELCHE(/1)
  62. NDCOL=JCOOR.VELCHE(/2)
  63. N2DLIG=JCOOR.VELCHE(/3)
  64. N2DCOL=JCOOR.VELCHE(/4)
  65. NDNOEU=JCOOR.VELCHE(/5)
  66. NDELM=JCOOR.VELCHE(/6)
  67. IF (NDLIG.NE.1.OR.N2DLIG.NE.1.OR.N2DCOL.NE.IESREL.
  68. $ OR.NDNOEU.NE.1) THEN
  69. WRITE(IOIMP,*) 'Erreur dims JCOOR'
  70. GOTO 9999
  71. ENDIF
  72. NDDL=NDCOL
  73. NBELEM=NDELM
  74. SEGACT FFPG
  75. NDLIG=FFPG.VELCHE(/1)
  76. NDCOL=FFPG.VELCHE(/2)
  77. N2DLIG=FFPG.VELCHE(/3)
  78. N2DCOL=FFPG.VELCHE(/4)
  79. NDNOEU=FFPG.VELCHE(/5)
  80. NDELM=FFPG.VELCHE(/6)
  81. IF (NDLIG.NE.1.OR.NDCOL.NE.NDDL.OR.N2DLIG.NE.1
  82. $ .OR.N2DCOL.NE.1.OR.NDELM.NE.1) THEN
  83. WRITE(IOIMP,*) 'Erreur dims FFPG'
  84. GOTO 9999
  85. ENDIF
  86. NBPOGO=NDNOEU
  87. *
  88. NBLIG=1
  89. NBCOL=1
  90. N2LIG=1
  91. N2COL=1
  92. NBPOI=NBPOGO
  93. NBELM=NBELEM
  94. SEGINI JPC
  95. CALL GEOPC1(NDDL,IESREL,NBPOGO,NBELEM,
  96. $ JCOOR.VELCHE,FFPG.VELCHE,
  97. $ JPC.VELCHE,
  98. $ IMPR,IRET)
  99. IF (IRET.NE.0) GOTO 9999
  100. SEGDES JPC
  101. IF (IMPR.GT.3) THEN
  102. WRITE(IOIMP,*) 'On a créé',
  103. $ ' JPC(élément , poi.gauss ,',
  104. $ ' 1,1,1,1)'
  105. CALL PRCHVA(JPC,IMPR,IRET)
  106. IF (IRET.NE.0) GOTO 9999
  107. ENDIF
  108. SEGDES FFPG
  109. SEGDES JCOOR
  110. *
  111. * Normal termination
  112. *
  113. IRET=0
  114. RETURN
  115. *
  116. * Format handling
  117. *
  118. *
  119. * Error handling
  120. *
  121. 9999 CONTINUE
  122. IRET=1
  123. WRITE(IOIMP,*) 'An error was detected in subroutine geopc'
  124. RETURN
  125. *
  126. * End of subroutine GEOPC
  127. *
  128. END
  129.  
  130.  
  131.  

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