Télécharger la plaquette Cast3M


fr en

Télécharger cv2cml.eso

Retour à la liste

Numérotation des lignes : 

cv2cml

  1. C CV2CML    SOURCE    GOUNAND   24/11/06    21:15:04     12073          
  2.       SUBROUTINE CV2CML(CGEOMQ,MYDISC,MYLMOT,MYMCHA,
  3.      $     MYFALS,
  4.      $     MCHELM,
  5.      $     IMPR,IRET)
  6.       IMPLICIT REAL*8 (A-H,O-Z)
  7.       IMPLICIT INTEGER (I-N)
  8. C***********************************************************************
  9. C NOM         : CV2CML
  10. C DESCRIPTION : Transforme un MCHAEL en MCHAML pour peu que
  11. C               MYDISC = QUAF ou QUAI ou LINE => MCHAML AUX noeuds
  12. C               MYDISC = CSTE => MCHAML AUX noeuds du QUAF constant par
  13. C               éléments
  14. C
  15. C LANGAGE     : ESOPE
  16. C AUTEUR      : Stéphane GOUNAND (CEA/DES/ISAS/DM2S/SEMT/LTA)
  17. C               mél : gounand@semt2.smts.cea.fr
  18. C***********************************************************************
  19. C APPELES          :
  20. C APPELE PAR       : PRLIN2
  21. C***********************************************************************
  22. C ENTREES            : * CGEOME (type MELEME) : maillage de QUAFs
  23. C                        partitionné.
  24. C                      * MYDISC (type CH*(4)) : nom d'espace de
  25. C                        discrétisation (cf. NOMFA dans l'include
  26. C                        SFALRF)
  27. C                      * MYFALS (type FALRFS) : segment de description
  28. C                        des familles d'éléments de références.
  29. C SORTIES            : * MYMCHA (type MCHAEL) : champ par éléments de
  30. C                        la grandeur tensorielle (degrés de liberté de
  31. C                        la grandeur).
  32. C ENTREES/SORTIES    : -
  33. C TRAVAIL            :
  34. C                        (1, nb. ddl, NCOMPD, NCOMPP, 1, nb. élément)
  35. C
  36. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  37. C***********************************************************************
  38. C VERSION    : v1, 21/05/21, version initiale basée sur CV2CP9
  39. C HISTORIQUE : v1, 21/05/21, création
  40. C HISTORIQUE :
  41. C HISTORIQUE :
  42. C***********************************************************************
  43. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  44. C en cas de modification de ce sous-programme afin de faciliter
  45. C la maintenance !
  46. C***********************************************************************
  47.  
  48. -INC PPARAM
  49. -INC CCOPTIO
  50. -INC CCGEOME
  51. -INC SMCHAML
  52. -INC SMELEME
  53.       POINTEUR CGEOMQ.MELEME
  54.       POINTEUR SOUMAI.MELEME
  55.       POINTEUR SOUMAQ.MELEME
  56. -INC SMLENTI
  57.       POINTEUR MPQUAF.MLENTI
  58.       POINTEUR IORDO.MLENTI
  59. -INC SMLMOTS
  60.       POINTEUR MYLMOT.MLMOTS
  61. *
  62. * Includes persos
  63. *
  64. -INC TNLIN
  65. *-INC SMCHAEL
  66.       POINTEUR MYMCHA.MCHAEL
  67.       POINTEUR MZMCHA.MCHEVA
  68. *-INC SFALRF
  69.       POINTEUR MYFALS.FALRFS
  70. *-INC SELREF
  71.       POINTEUR MYLRF.ELREF
  72. *
  73.       CHARACTER*(4) MYDISC
  74.       PARAMETER (NDISC=4)
  75.       CHARACTER*(4) DISCS(NDISC)
  76.       LOGICAL LCROI
  77.       INTEGER IMPR,IRET
  78. *
  79.       DATA DISCS/'CSTE','LINE','QUAI','QUAF'/
  80. *
  81. * Executable statements
  82. *
  83.       IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans cv2cml'
  84. *
  85.       CALL PLACE5(DISCS,NDISC,IDISC,MYDISC)
  86. * Cas particulier MYDISC='CSTE'
  87.       IF (IDISC.EQ.1) THEN
  88.          SEGACT MYMCHA
  89.          NSOUS=MYMCHA.JMACHE(/1)
  90.          SEGACT CGEOMQ
  91. *
  92.          L1=8
  93.          N1=NSOUS
  94.          N3=6
  95.          SEGINI MCHELM
  96.          TITCHE='NLIN    '
  97.          IFOCHE=IFOUR
  98.          SEGACT MYLMOT
  99.          NNCOMP=MYLMOT.MOTS(/2)
  100.          IF (NNCOMP.NE.1) THEN
  101.             WRITE(IOIMP,*) 'Programming Error 1'
  102.             GOTO 9999
  103.          ENDIF
  104.          DO ISOUS=1,NSOUS
  105.             SOUMAI=CGEOMQ.LISREF(ISOUS)
  106.             IF (SOUMAI.EQ.0) THEN
  107.                SOUMAI=CGEOMQ.LISOUS(ISOUS)
  108.             ENDIF
  109.             SEGACT SOUMAI
  110.             MZMCHA=MYMCHA.ICHEVA(ISOUS)
  111.             SEGACT,MZMCHA
  112.             NBEL=SOUMAI.NUM(/2)
  113. * Petits tests
  114.             NDLIG=MZMCHA.WELCHE(/1)
  115.             NDCOL=MZMCHA.WELCHE(/2)
  116.             N2DLIG=MZMCHA.WELCHE(/3)
  117.             N2DCOL=MZMCHA.WELCHE(/4)
  118.             NDNOEU=MZMCHA.WELCHE(/5)
  119.             NDELM=MZMCHA.WELCHE(/6)
  120.             IF (.NOT.(NDLIG.EQ.1
  121.      $           .AND.NDCOL.EQ.1
  122.      $           .AND.N2DLIG.EQ.1
  123.      $           .AND.N2DCOL.EQ.1.AND.NDNOEU.EQ.1
  124.      $           .AND.(NDELM.EQ.1.OR.NDELM.EQ.NBEL))) THEN
  125.                WRITE(IOIMP,*) 'Erreur dims MZMCHA'
  126.                write(ioimp,*) 'NDLIG,NDCOL=',NDLIG,NDCOL
  127.                write(ioimp,*) 'N2DLIG,N2DCOL=',N2DLIG,N2DCOL
  128.                write(ioimp,*) 'NDNOEU,NDELM,NBEL=',NDNOEU,NDELM,NBEL
  129.                GOTO 9999
  130.             ENDIF
  131.             N2=1
  132.             SEGINI MCHAML
  133.             NOMCHE(1)=MYLMOT.MOTS(1)
  134.             TYPCHE(1)='REAL*8          '
  135.             N1PTEL=1
  136.             N1EL=NDELM
  137.             N2PTEL=0
  138.             N2EL=0
  139.             SEGINI MELVAL
  140.             DO IDELM=1,NDELM
  141.                VELCHE(1,IDELM)=MZMCHA.WELCHE(1,1,1,1,1,IDELM)
  142.             ENDDO
  143.             IELVAL(1)=MELVAL
  144.             CONCHE(ISOUS)=' '
  145.             ICHAML(ISOUS)=MCHAML
  146.             IMACHE(ISOUS)=SOUMAI
  147.             INFCHE(ISOUS,1)=0
  148.             INFCHE(ISOUS,2)=0
  149.             INFCHE(ISOUS,3)=NIFOUR
  150.             INFCHE(ISOUS,4)=0
  151.             INFCHE(ISOUS,5)=0
  152.             INFCHE(ISOUS,6)=1
  153.          ENDDO
  154. * Cas MYDISC='LINE','QUAI','QUAF'
  155.       ELSEIF (IDISC.GT.1.AND.IDISC.LE.NDISC) THEN
  156.          SEGACT MYMCHA
  157.          NSOUS=MYMCHA.JMACHE(/1)
  158.          SEGACT CGEOMQ
  159.          L1=8
  160.          N1=NSOUS
  161.          N3=6
  162.          SEGINI MCHELM
  163.          TITCHE='NLIN    '
  164.          IFOCHE=IFOUR
  165.          SEGACT MYLMOT
  166.          NNCOMP=MYLMOT.MOTS(/2)
  167.          IF (NNCOMP.NE.1) THEN
  168.             WRITE(IOIMP,*) 'Programming Error 2'
  169.             GOTO 9999
  170.          ENDIF
  171.          DO ISOUS=1,NSOUS
  172.             SOUMAQ=CGEOMQ.LISOUS(ISOUS)
  173.             SEGACT SOUMAQ
  174.             SOUMAI=CGEOMQ.LISREF(ISOUS)
  175.             IF (SOUMAI.EQ.0) THEN
  176.                SOUMAI=SOUMAQ
  177.             ELSE
  178.                SEGACT SOUMAI
  179.             ENDIF
  180.             MZMCHA=MYMCHA.ICHEVA(ISOUS)
  181.             SEGACT,MZMCHA
  182.             NBNN=SOUMAI.NUM(/1)
  183.             NBEL=SOUMAQ.NUM(/2)
  184.             ITQUAF=SOUMAQ.ITYPEL
  185. * On cherche l'élément fini correspondant au QUAF
  186.             CALL KEEF(ITQUAF,MYDISC,
  187.      $           MYFALS,
  188.      $           MYLRF,
  189.      $           IMPR,IRET)
  190.             IF (IRET.NE.0) GOTO 9999
  191.             SEGACT MYLRF
  192.             NDDL=MYLRF.NPQUAF(/1)
  193.             IF (NDDL.NE.NBNN) THEN
  194.                WRITE(IOIMP,*) 'Programming error 3'
  195.                write(ioimp,*) 'MYDISC=',MYDISC
  196.                write(ioimp,*) 'NBNN,NDDL=',NBNN,NDDL
  197.                GOTO 9999
  198.             ENDIF
  199. * Petits tests
  200.             NDLIG=MZMCHA.WELCHE(/1)
  201.             NDCOL=MZMCHA.WELCHE(/2)
  202.             N2DLIG=MZMCHA.WELCHE(/3)
  203.             N2DCOL=MZMCHA.WELCHE(/4)
  204.             NDNOEU=MZMCHA.WELCHE(/5)
  205.             NDELM=MZMCHA.WELCHE(/6)
  206.             IF (.NOT.( (NDLIG.EQ.1.AND.NDCOL.EQ.NDDL)
  207.      $           .OR. (NDLIG.EQ.NDDL.AND.NDCOL.EQ.1))
  208.      $           .AND.N2DLIG.NE.1
  209.      $           .AND.N2DCOL.NE.1.AND.NDNOEU.NE.1
  210.      $           .AND.(NDELM.NE.1.OR.NDELM.NE.NBEL)) THEN
  211.                WRITE(IOIMP,*) 'Erreur dims MZMCHA'
  212.                GOTO 9999
  213.             ENDIF
  214.             N2=1
  215.             SEGINI MCHAML
  216.             NOMCHE(1)=MYLMOT.MOTS(1)
  217.             TYPCHE(1)='REAL*8          '
  218.             N1PTEL=NDDL
  219.             N1EL=NDELM
  220.             N2PTEL=0
  221.             N2EL=0
  222.             SEGINI MELVAL
  223. *     Construisons le segment qui permet de parcourir les ddl dans
  224. *     l'ordre croissant des points du quaf
  225. *     Implicitement, on utilise le fait que les maillages LINE et QUAD
  226. *     parcourent les points du QUAF en croissant aussi.
  227. *     On utilise le tri par insertion car les listes sont petites
  228.             JG=NDDL
  229.             SEGINI MPQUAF
  230.             SEGINI IORDO
  231.             DO IG=1,JG
  232.                MPQUAF.LECT(IG)=MYLRF.NPQUAF(IG)
  233.                IORDO.LECT(IG)=IG
  234.             ENDDO
  235.             LCROI=.TRUE.
  236.             CALL ORDO04(MPQUAF.LECT(1),NDDL,LCROI,IORDO.LECT(1))
  237. *
  238.             DO IDELM=1,NDELM
  239.                DO IDDL=1,NDDL
  240.                   JDDL=IORDO.LECT(IDDL)
  241.                   IF (NDLIG.EQ.1) THEN
  242.                      ILIG=1
  243.                      ICOL=JDDL
  244.                   ELSE
  245.                      ILIG=JDDL
  246.                      ICOL=1
  247.                   ENDIF
  248.                   VELCHE(IDDL,IDELM)=MZMCHA.WELCHE(ILIG,ICOL,1,1,1
  249.      $                 ,IDELM)
  250.                ENDDO
  251.             ENDDO
  252.             SEGSUP IORDO
  253.             SEGSUP MPQUAF
  254.             IELVAL(1)=MELVAL
  255.             CONCHE(ISOUS)=' '
  256.             ICHAML(ISOUS)=MCHAML
  257.             IMACHE(ISOUS)=SOUMAI
  258.             INFCHE(ISOUS,1)=0
  259.             INFCHE(ISOUS,2)=0
  260.             INFCHE(ISOUS,3)=NIFOUR
  261.             INFCHE(ISOUS,4)=0
  262.             INFCHE(ISOUS,5)=0
  263.             INFCHE(ISOUS,6)=1
  264.          ENDDO
  265.       ELSE
  266.          WRITE(IOIMP,*) 'CHAM keyword incompatible with discretization '
  267.      $        ,MYDISC
  268.          GOTO 9999
  269.       ENDIF
  270. *      IMPR=6
  271.       IF (IMPR.GT.3) THEN
  272.          CALL ECROBJ('MCHAML  ',MCHELM)
  273.          CALL PRLIST
  274.       ENDIF
  275. *      IMPR=0
  276. *
  277. * Normal termination
  278. *
  279.       IRET=0
  280.       RETURN
  281. *
  282. * Format handling
  283. *
  284. *
  285. * Error handling
  286. *
  287.  9999 CONTINUE
  288.       IRET=1
  289.       WRITE(IOIMP,*) 'An error was detected in subroutine cv2cml'
  290.       RETURN
  291. *
  292. * End of subroutine CV2CML
  293. *
  294.       END
  295.  
  296.  

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