Télécharger la plaquette Cast3M


fr en

Télécharger cv2cp9.eso

Retour à la liste

Numérotation des lignes : 

cv2cp9

  1. C CV2CP9    SOURCE    GOUNAND   21/06/02    21:15:35     11022          
  2.       SUBROUTINE CV2CP9(MYDISC,MYLMOT,MYMCHA,
  3.      $     MYFALS,
  4.      $     MYCHPO,
  5.      $     IMPR,IRET)
  6.       IMPLICIT REAL*8 (A-H,O-Z)
  7.       IMPLICIT INTEGER (I-N)
  8. C***********************************************************************
  9. C NOM         : CV2CP9
  10. C DESCRIPTION : Transforme un MCHAEL en MCHPOI
  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       : PRLS92
  18. C***********************************************************************
  19. C ENTREES            : * CGEOME (type MELEME) : maillage de QUAFs
  20. C                        partitionné.
  21. C                      * MYDISC (type CH*(4)) : nom d'espace de
  22. C                        discrétisation (cf. NOMFA dans l'include
  23. C                        SFALRF)
  24. C                      * MYFALS (type FALRFS) : segment de description
  25. C                        des familles d'éléments de références.
  26. C SORTIES            : * MYMCHA (type MCHAEL) : champ par éléments de
  27. C                        la grandeur tensorielle (degrés de liberté de
  28. C                        la grandeur).
  29. C ENTREES/SORTIES    : -
  30. C TRAVAIL            :
  31. C                        (1, nb. ddl, NCOMPD, NCOMPP, 1, nb. élément)
  32. C
  33. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  34. C***********************************************************************
  35. C VERSION    : v1, 07/10/02, version initiale
  36. C HISTORIQUE : v1, 07/10/02, création
  37. C HISTORIQUE :
  38. C HISTORIQUE :
  39. C***********************************************************************
  40. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  41. C en cas de modification de ce sous-programme afin de faciliter
  42. C la maintenance !
  43. C***********************************************************************
  44.  
  45. -INC PPARAM
  46. -INC CCOPTIO
  47. -INC SMCOORD
  48. -INC SMCHPOI
  49.       POINTEUR MYCHPO.MCHPOI
  50. -INC TMTRAV
  51.       POINTEUR MYMTRA.MTRAV
  52.       INTEGER NNIN,NNNOE
  53. -INC SMELEME
  54.       POINTEUR SOUMAI.MELEME
  55.       POINTEUR MELTOT.MELEME
  56.       POINTEUR SMLTOT.MELEME
  57.       POINTEUR ML1TOT.MELEME
  58.       INTEGER NBNN,NBELEM,NBSOUS,NBREF
  59. -INC SMLMOTS
  60.       POINTEUR MYLMOT.MLMOTS
  61. -INC SMLENTI
  62.       POINTEUR KRIGEO.MLENTI
  63.       INTEGER JG
  64. *
  65. * Includes persos
  66. *
  67. -INC TNLIN      
  68. *-INC SMCHAEL
  69.       POINTEUR MYMCHA.MCHAEL
  70.       POINTEUR MZMCHA.MCHEVA
  71. *-INC SFALRF
  72.       POINTEUR MYFALS.FALRFS
  73. *-INC SELREF
  74.       POINTEUR MYLRF.ELREF
  75. *
  76. * Includes persos
  77. *
  78. * Liste de MELEME
  79.       INTEGER NBMEL
  80.       SEGMENT MELS
  81.       POINTEUR LISMEL(NBMEL).MELEME
  82.       ENDSEGMENT
  83.       POINTEUR GPMELS.MELS
  84. *
  85.       CHARACTER*(4) MYDISC
  86.       INTEGER IMPR,IRET
  87. *
  88.       INTEGER NDLIG,NDCOL,N2DLIG,N2DCOL,NDNOEU,NDELM
  89.       INTEGER                                  IDELM
  90.       INTEGER IBEL,IDDL,ISOUS,ITQUAF
  91.       INTEGER NBEL,NDDL,NSOUS
  92.       INTEGER NNGLO,NNLOC,NNQUA
  93.       INTEGER ININ,INNOE
  94.       INTEGER NTOGPO
  95. *
  96. * Executable statements
  97. *
  98.       IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans cv2cp9'
  99.  
  100.  
  101. *
  102. * Création de MELTOT maillage des points sur lesquels reposent les ddl
  103. * (il y a des doublons)
  104. *
  105.       SEGACT MYMCHA
  106. *      SEGPRT,MYMCHA
  107.       NSOUS=MYMCHA.JMACHE(/1)
  108. *
  109.       NBNN=0
  110.       NBELEM=0
  111.       NBSOUS=NSOUS
  112.       NBREF=0
  113.       SEGINI,MELTOT
  114.       DO 1 ISOUS=1,NSOUS
  115.          SOUMAI=MYMCHA.JMACHE(ISOUS)
  116.          SEGACT SOUMAI
  117. * On cherche l'élément fini correspondant au QUAF
  118.          ITQUAF=SOUMAI.ITYPEL
  119.          CALL KEEF(ITQUAF,MYDISC,
  120.      $        MYFALS,
  121.      $        MYLRF,
  122.      $        IMPR,IRET)
  123.          IF (IRET.NE.0) GOTO 9999
  124.          SEGACT MYLRF
  125.          NDDL=MYLRF.NPQUAF(/1)
  126.          NBEL=SOUMAI.NUM(/2)
  127. *
  128.          NBNN=NDDL
  129.          NBELEM=NBEL
  130.          NBSOUS=0
  131.          NBREF=0
  132.          SEGINI,SMLTOT
  133.          DO IBEL=1,NBEL
  134.             DO IDDL=1,NDDL
  135.                NNQUA=MYLRF.NPQUAF(IDDL)
  136.                NNGLO=SOUMAI.NUM(NNQUA,IBEL)
  137.                SMLTOT.NUM(IDDL,IBEL)=NNGLO
  138.             ENDDO
  139.          ENDDO
  140.          SEGDES,SMLTOT
  141.          MELTOT.LISOUS(ISOUS)=SMLTOT
  142.          SEGDES,MYLRF
  143.          SEGDES,SOUMAI
  144.  1    CONTINUE
  145.       SEGDES,MELTOT
  146.       SEGDES,MYMCHA
  147. *
  148. * On construit ML1TOT, ensemble des points de MELTOT
  149. *
  150.       NBMEL=1
  151.       SEGINI,GPMELS
  152.       GPMELS.LISMEL(1)=MELTOT
  153.       CALL MLUNIQ(GPMELS,ML1TOT,
  154.      $     IMPR,IRET)
  155.       IF (IRET.NE.0) GOTO 9999
  156.       SEGSUP,GPMELS
  157. *
  158. * Destruction de MELTOT
  159. *
  160.       SEGACT,MELTOT*MOD
  161.       DO 3 ISOUS=1,NSOUS
  162.          SMLTOT=MELTOT.LISOUS(ISOUS)
  163. *         SEGACT,SMLTOT
  164.          SEGSUP,SMLTOT
  165.  3    CONTINUE
  166.       SEGSUP,MELTOT
  167. *
  168. * Initialisation de MYMTRA
  169. *
  170.       SEGACT MYLMOT
  171.       NNIN=MYLMOT.MOTS(/2)
  172.       SEGACT ML1TOT
  173.       NNNOE=ML1TOT.NUM(/2)
  174.       SEGINI,MYMTRA
  175. *   Remplissage de MYMTRA.INCO et MYMTRA.IGEO
  176.       DO ININ=1,NNIN
  177.          MYMTRA.INCO(ININ)=MYLMOT.MOTS(ININ)
  178.       ENDDO
  179.       DO INNOE=1,NNNOE
  180.          MYMTRA.IGEO(INNOE)=ML1TOT.NUM(1,INNOE)
  181.       ENDDO
  182.       SEGSUP,ML1TOT
  183.       SEGDES,MYLMOT
  184. *   Création du segment de repérage dans MYMTRA.IGEO
  185.       NTOGPO=nbpts
  186.       JG=NTOGPO
  187.       SEGINI,KRIGEO
  188.       CALL RSETEE(MYMTRA.IGEO,NNNOE,
  189.      $     KRIGEO.LECT,NTOGPO,
  190.      $     IMPR,IRET)
  191.       IF (IRET.NE.0) GOTO 9999
  192. *   Remplissage de MYMTRA.BB et MYMTRA.IBIN
  193.       SEGACT,MYMCHA
  194.       DO 5 ISOUS=1,NSOUS
  195.          SOUMAI=MYMCHA.JMACHE(ISOUS)
  196.          SEGACT,SOUMAI
  197.          MZMCHA=MYMCHA.ICHEVA(ISOUS)
  198.          IF (MZMCHA.NE.0) THEN
  199.             SEGACT,MZMCHA
  200. * On cherche l'élément fini correspondant au QUAF
  201.             ITQUAF=SOUMAI.ITYPEL
  202.             CALL KEEF(ITQUAF,MYDISC,
  203.      $           MYFALS,
  204.      $           MYLRF,
  205.      $           IMPR,IRET)
  206.             IF (IRET.NE.0) GOTO 9999
  207.             SEGACT MYLRF
  208.             NDDL=MYLRF.NPQUAF(/1)
  209.             NBEL=SOUMAI.NUM(/2)
  210. * Petits tests
  211.             NDLIG=MZMCHA.WELCHE(/1)
  212.             NDCOL=MZMCHA.WELCHE(/2)
  213.             N2DLIG=MZMCHA.WELCHE(/3)
  214.             N2DCOL=MZMCHA.WELCHE(/4)
  215.             NDNOEU=MZMCHA.WELCHE(/5)
  216.             NDELM=MZMCHA.WELCHE(/6)
  217.             IF (.NOT.(     (NDLIG.EQ.1.AND.NDCOL.EQ.NDDL)
  218.      $           .OR. (NDLIG.EQ.NDDL.AND.NDCOL.EQ.1))
  219.      $           .OR.N2DLIG.NE.1
  220.      $           .OR.N2DCOL.NE.1.OR.NDNOEU.NE.1
  221.      $           .OR.(NDELM.NE.1.AND.NDELM.NE.NBEL)) THEN
  222.                WRITE(IOIMP,*) 'Erreur dims MZMCHA'
  223.                GOTO 9999
  224.             ENDIF
  225.  
  226.             DO IBEL=1,NBEL
  227.                IF (NDELM.EQ.1) THEN
  228.                   IDELM=1
  229.                ELSE
  230.                   IDELM=IBEL
  231.                ENDIF
  232.                DO IDDL=1,NDDL
  233.                   IF (NDLIG.EQ.1) THEN
  234.                      ILIG=1
  235.                      ICOL=IDDL
  236.                   ELSE
  237.                      ILIG=IDDL
  238.                      ICOL=1
  239.                   ENDIF
  240.                   NNQUA=MYLRF.NPQUAF(IDDL)
  241.                   NNGLO=SOUMAI.NUM(NNQUA,IBEL)
  242.                   NNLOC=KRIGEO.LECT(NNGLO)
  243.                   IF (NNLOC.EQ.0) THEN
  244.                      WRITE(IOIMP,*) 'Erreur de programmation 1'
  245.                      GOTO 9999
  246.                   ENDIF
  247.                   ININ=MYLRF.NUMCMP(IDDL)
  248.                   MYMTRA.IBIN(ININ,NNLOC)=1
  249.                   MYMTRA.BB(ININ,NNLOC)=MYMTRA.BB(ININ,NNLOC)
  250.      $                 +MZMCHA.WELCHE(ILIG,ICOL,1,1,1,IDELM)
  251.                ENDDO
  252.             ENDDO
  253.             SEGDES,MYLRF
  254.             SEGDES,MZMCHA
  255.          ENDIF
  256.          SEGDES,SOUMAI
  257.  5    CONTINUE
  258.       SEGDES,MYMCHA
  259.       SEGSUP,KRIGEO
  260. *
  261. * Transformation l'objet MTRAV en chpoint
  262. *
  263.       CALL CRECHP(MYMTRA,MYCHPO)
  264.       SEGSUP MYMTRA
  265.       SEGACT MYCHPO*MOD
  266.       MYCHPO.JATTRI(1)=2
  267.       SEGDES MYCHPO
  268. *      IMPR=6
  269.       IF (IMPR.GT.3) THEN
  270.          CALL ECROBJ('CHPOINT ',MYCHPO)
  271.          CALL PRLIST
  272.       ENDIF
  273. *      IMPR=0
  274. *
  275. * Normal termination
  276. *
  277.       IRET=0
  278.       RETURN
  279. *
  280. * Format handling
  281. *
  282. *
  283. * Error handling
  284. *
  285.  9999 CONTINUE
  286.       IRET=1
  287.       WRITE(IOIMP,*) 'An error was detected in subroutine cv2cp9'
  288.       RETURN
  289. *
  290. * End of subroutine CV2CP9
  291. *
  292.       END
  293.  
  294.  
  295.  
  296.  
  297.  
  298.  
  299.  
  300.  

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