Télécharger la plaquette Cast3M


fr en

Télécharger mkcoor.eso

Retour à la liste

Numérotation des lignes : 

mkcoor

  1. C MKCOOR    SOURCE    GOUNAND   21/06/02    21:17:12     11022          
  2.       SUBROUTINE MKCOOR(CGEOME,MDISCR,
  3.      $     MYFALS,
  4.      $     ICOOR,
  5.      $     IMPR,IRET)
  6.       IMPLICIT REAL*8 (A-H,O-Z)
  7.       IMPLICIT INTEGER (I-N)
  8. C***********************************************************************
  9. C NOM         : MKCOOR
  10. C PROJET      : Noyau linéaire NLIN
  11. C DESCRIPTION : On crée le champ par éléments contenant les coordonnées
  12. C               des points servant pour la transformation géométrique
  13. C               (ddl de la transformation géométrique)...
  14. C
  15. C LANGAGE     : ESOPE
  16. C AUTEUR      : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  17. C               mél : gounand@semt2.smts.cea.fr
  18. C***********************************************************************
  19. C APPELES          : KEEF (recherche de l'élément fini)
  20. C                    NOMINC (nommage des inconnues)
  21. C                    MKCOO1 (remplissage du sous-champ par élément
  22. C                    (fortran 77))
  23. C                    PRCAEL (impression du champ créé)
  24. C APPELE PAR       : PRNLI2
  25. C***********************************************************************
  26. C ENTREES            : * CGEOME (type MELEME) : maillage de QUAFs
  27. C                        partitionné.
  28. C                      * MDISCR (type CH*(*)) : nom d'espace de
  29. C                        discrétisation (cf. NOMFA dans l'include
  30. C                        SFALRF)
  31. C                      * MYFALS (type FALRFS) : segment de description
  32. C                        des familles d'éléments de références.
  33. C SORTIES            : * ICOOR  (type MCHAEL) : champ par éléments de
  34. C                        coordonnées de points (degrés de liberté de la
  35. C                        transformation géométrique).
  36. C TRAVAIL            : * SOUGEO (type MELEME) : maillage élémentaire.
  37. C                      * JCOOR  (type MCHEVA) : valeurs du champ ICOOR
  38. C                        sur le maillage élémentaire.
  39. C                        Structure (cf.include SMCHAEL) :
  40. C                        (1, nb. ddl, 1, dim. esp. réel, 1, nb. élément)
  41. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  42. C***********************************************************************
  43. C VERSION    : v1, 01/09/99, version initiale
  44. C HISTORIQUE : v1, 01/09/99, création
  45. C HISTORIQUE :
  46. C HISTORIQUE :
  47. C***********************************************************************
  48. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  49. C en cas de modification de ce sous-programme afin de faciliter
  50. C la maintenance !
  51. C***********************************************************************
  52.  
  53. -INC PPARAM
  54. -INC CCOPTIO
  55. -INC CCGEOME
  56. -INC SMCOORD
  57. -INC SMELEME
  58.       POINTEUR CGEOME.MELEME
  59.       POINTEUR SOUGEO.MELEME
  60. * Segments à moi
  61. -INC TNLIN      
  62. *-INC SMCHAEL
  63.       INTEGER N1
  64.       POINTEUR ICOOR.MCHAEL
  65.       INTEGER NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM
  66.       POINTEUR JCOOR.MCHEVA
  67. *-INC SFALRF
  68.       POINTEUR MYFALS.FALRFS
  69. *-INC SELREF
  70.       POINTEUR MYLRF.ELREF
  71. *
  72.       CHARACTER*(*) MDISCR
  73.       INTEGER IMPR,IRET
  74. *
  75.       INTEGER ISOUS
  76.       INTEGER NSOUS,NNOEU,NELEM,NDDL,NXCO
  77.       INTEGER ITQUAF
  78. *
  79. * Executable statements
  80. *
  81.       IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans mkcoor'
  82.       SEGACT CGEOME
  83.       NSOUS=CGEOME.LISOUS(/1)
  84.       N1=NSOUS
  85.       SEGINI ICOOR
  86.       NXCO=nbpts*(idim+1)
  87. * Par sous-domaine...
  88.       DO 1 ISOUS=1,NSOUS
  89.          SOUGEO=CGEOME.LISOUS(ISOUS)
  90.          SEGACT SOUGEO
  91. * On cherche l'élément fini correspondant au QUAF
  92.          ITQUAF=SOUGEO.ITYPEL
  93.          CALL KEEF(ITQUAF,MDISCR,
  94.      $        MYFALS,
  95.      $        MYLRF,
  96.      $        IMPR,IRET)
  97.          IF (IRET.NE.0) GOTO 9999
  98.          SEGACT MYLRF
  99.          NDDL=MYLRF.NPQUAF(/1)
  100.          NNOEU=SOUGEO.NUM(/1)
  101.          NELEM=SOUGEO.NUM(/2)
  102.          NBLIG=1
  103.          NBCOL=NDDL
  104.          N2LIG=1
  105.          N2COL=IDIM
  106.          NBPOI=1
  107.          NBELM=NELEM
  108.          SEGINI JCOOR
  109.          segact mcoord
  110.          CALL MKCOO1(NNOEU,NELEM,NXCO,NDDL,IDIM,
  111.      $        SOUGEO.NUM,MCOORD.XCOOR,MYLRF.NPQUAF,
  112.      $        JCOOR.WELCHE,
  113.      $        IMPR,IRET)
  114.          IF (IRET.NE.0) GOTO 9999
  115.          SEGDES JCOOR
  116.          ICOOR.ICHEVA(ISOUS)=JCOOR
  117.          SEGDES MYLRF
  118.          SEGDES SOUGEO
  119.          ICOOR.JMACHE(ISOUS)=SOUGEO
  120.  1    CONTINUE
  121.       SEGDES ICOOR
  122.       SEGDES CGEOME
  123.       IF (IMPR.GT.3) THEN
  124.          WRITE(IOIMP,*) 'On a créé',
  125.      $   ' ICOOR(élément ,1, coor.esp ,1, ddl ,1)=',ICOOR
  126.          CALL PRCAEL(ICOOR,IMPR,IRET)
  127.          IF (IRET.NE.0) GOTO 9999
  128.       ENDIF
  129. *
  130. * Normal termination
  131. *
  132.       IRET=0
  133.       RETURN
  134. *
  135. * Format handling
  136. *
  137. *
  138. * Error handling
  139. *
  140.  9999 CONTINUE
  141.       IRET=1
  142.       WRITE(IOIMP,*) 'An error was detected in subroutine mkcoor'
  143.       RETURN
  144. *
  145. * End of subroutine MKCOOR
  146. *
  147.       END
  148.  
  149.  
  150.  
  151.  
  152.  
  153.  
  154.  
  155.  

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