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   21/07/06    21:15:04     11061          
  2.       SUBROUTINE CV2CML(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 sue 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 SOUMAI.MELEME
  54. -INC SMLENTI
  55.       POINTEUR MPQUAF.MLENTI
  56.       POINTEUR IORDO.MLENTI
  57. -INC SMLMOTS
  58.       POINTEUR MYLMOT.MLMOTS
  59. *
  60. * Includes persos
  61. *
  62. -INC TNLIN      
  63. *-INC SMCHAEL
  64.       POINTEUR MYMCHA.MCHAEL
  65.       POINTEUR MZMCHA.MCHEVA
  66. *-INC SFALRF
  67.       POINTEUR MYFALS.FALRFS
  68. *-INC SELREF
  69.       POINTEUR MYLRF.ELREF
  70. *
  71.       CHARACTER*(4) MYDISC
  72.       CHARACTER*(4) NMELEM,NMELEQ
  73.       PARAMETER (NDISC=4)
  74.       CHARACTER*(4) DISCS(NDISC)
  75.       PARAMETER (NQUAF=7)
  76.       CHARACTER*4 NMQUAF(NQUAF)
  77.       CHARACTER*4 NMQUAI(NQUAF)
  78.       CHARACTER*4 NMLINE(NQUAF)
  79.       LOGICAL LCROI
  80.       INTEGER IMPR,IRET
  81. *
  82.       DATA DISCS/'CSTE','LINE','QUAI','QUAF'/
  83.       DATA NMQUAF/'SEG3','TRI7','QUA9','CU27','PR21','TE15','PY19'/
  84.       DATA NMQUAI/'SEG3','TRI6','QUA8','CU20','PR15','TE10','PY13'/
  85.       DATA NMLINE/'SEG2','TRI3','QUA4','CUB8','PRI6','TET4','PYR5'/
  86. *
  87. * Executable statements
  88. *
  89.       IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans cv2cml'
  90. *
  91.       CALL PLACE5(DISCS,NDISC,IDISC,MYDISC)
  92. * Cas particulier MYDISC='CSTE'
  93.       IF (IDISC.EQ.1) THEN
  94.          SEGACT MYMCHA
  95.          NSOUS=MYMCHA.JMACHE(/1)
  96. *
  97.          L1=8
  98.          N1=NSOUS
  99.          N3=6
  100.          SEGINI MCHELM
  101.          TITCHE='NLIN    '
  102.          IFOCHE=IFOUR
  103.          SEGACT MYLMOT
  104.          NNCOMP=MYLMOT.MOTS(/2)
  105.          IF (NNCOMP.NE.1) THEN
  106.             WRITE(IOIMP,*) 'Programming Error 1'
  107.             GOTO 9999
  108.          ENDIF
  109.          DO ISOUS=1,NSOUS
  110.             SOUMAI=MYMCHA.JMACHE(ISOUS)
  111.             SEGACT SOUMAI
  112.             MZMCHA=MYMCHA.ICHEVA(ISOUS)
  113.             SEGACT,MZMCHA
  114.             NBEL=SOUMAI.NUM(/2)
  115. * Petits tests
  116.             NDLIG=MZMCHA.WELCHE(/1)
  117.             NDCOL=MZMCHA.WELCHE(/2)
  118.             N2DLIG=MZMCHA.WELCHE(/3)
  119.             N2DCOL=MZMCHA.WELCHE(/4)
  120.             NDNOEU=MZMCHA.WELCHE(/5)
  121.             NDELM=MZMCHA.WELCHE(/6)
  122.             IF (.NOT.(NDLIG.EQ.1
  123.      $           .AND.NDCOL.EQ.1
  124.      $           .AND.N2DLIG.EQ.1
  125.      $           .AND.N2DCOL.EQ.1.AND.NDNOEU.EQ.1
  126.      $           .AND.(NDELM.EQ.1.OR.NDELM.EQ.NBEL))) THEN
  127.                WRITE(IOIMP,*) 'Erreur dims MZMCHA'
  128.                write(ioimp,*) 'NDLIG,NDCOL=',NDLIG,NDCOL
  129.                write(ioimp,*) 'N2DLIG,N2DCOL=',N2DLIG,N2DCOL
  130.                write(ioimp,*) 'NDNOEU,NDELM,NBEL=',NDNOEU,NDELM,NBEL
  131.                GOTO 9999
  132.             ENDIF
  133.             N2=1
  134.             SEGINI MCHAML
  135.             NOMCHE(1)=MYLMOT.MOTS(1)
  136.             TYPCHE(1)='REAL*8          '
  137.             N1PTEL=1
  138.             N1EL=NDELM
  139.             N2PTEL=0
  140.             N2EL=0
  141.             SEGINI MELVAL
  142.             DO IDELM=1,NDELM
  143.                VELCHE(1,IDELM)=MZMCHA.WELCHE(1,1,1,1,1,IDELM)
  144.             ENDDO
  145.             IELVAL(1)=MELVAL
  146.             CONCHE(ISOUS)=' '
  147.             ICHAML(ISOUS)=MCHAML
  148. * SOUMAI est supprime par ailleurs a cause de regma2               
  149.             SEGINI,MELEME=SOUMAI
  150.             IMACHE(ISOUS)=MELEME
  151.             INFCHE(ISOUS,1)=0
  152.             INFCHE(ISOUS,2)=0
  153.             INFCHE(ISOUS,3)=NIFOUR
  154.             INFCHE(ISOUS,4)=0
  155.             INFCHE(ISOUS,5)=0
  156.             INFCHE(ISOUS,6)=0
  157.          ENDDO
  158. * Cas MYDISC='LINE','QUAI','QUAF'
  159.       ELSEIF (IDISC.GT.1.AND.IDISC.LE.NDISC) THEN
  160.          SEGACT MYMCHA
  161.          NSOUS=MYMCHA.JMACHE(/1)
  162.          L1=8
  163.          N1=NSOUS
  164.          N3=6
  165.          SEGINI MCHELM
  166.          TITCHE='NLIN    '
  167.          IFOCHE=IFOUR
  168.          SEGACT MYLMOT
  169.          NNCOMP=MYLMOT.MOTS(/2)
  170.          IF (NNCOMP.NE.1) THEN
  171.             WRITE(IOIMP,*) 'Programming Error 2'
  172.             GOTO 9999
  173.          ENDIF
  174.          DO ISOUS=1,NSOUS
  175.             SOUMAI=MYMCHA.JMACHE(ISOUS)
  176.             SEGACT SOUMAI
  177.             MZMCHA=MYMCHA.ICHEVA(ISOUS)
  178.             SEGACT,MZMCHA
  179.             NBNN=SOUMAI.NUM(/1)
  180.             NBEL=SOUMAI.NUM(/2)
  181.             ITQUAF=SOUMAI.ITYPEL
  182. * Faut-il faire un maillage différent de SOUMAI ?
  183.             NMELEQ=NOMS(ITQUAF)
  184.             CALL PLACE5(NMQUAF,NQUAF,IQUAF,NMELEQ)
  185.             IF (IQUAF.EQ.0) THEN
  186.                WRITE(IOIMP,*) NOMS(ITQUAF),'n''est pas un QUAF ??'
  187.                GOTO 9999
  188.             ENDIF
  189.             IF (IDISC.EQ.2) THEN
  190.                NMELEM=NMLINE(IQUAF)
  191.             ELSEIF (IDISC.EQ.3) THEN
  192.                NMELEM=NMQUAI(IQUAF)
  193.             ELSEIF (IDISC.EQ.4) THEN
  194.                NMELEM=NMQUAF(IQUAF)
  195.             ENDIF
  196.             CALL PLACE5(NOMS,NOMBR,ITELEM,NMELEM)
  197.             IF (ITELEM.NE.ITQUAF) THEN
  198.                NBNN=NBNNE(ITELEM)
  199.                NBELEM=NBEL
  200.                NBSOUS=0
  201.                NBREF=0
  202.                SEGINI MELEME
  203.                ITYPEL=ITELEM
  204.             ELSE
  205.                MELEME=0
  206.             ENDIF               
  207. * On cherche l'élément fini correspondant au QUAF
  208.             CALL KEEF(ITQUAF,MYDISC,
  209.      $           MYFALS,
  210.      $           MYLRF,
  211.      $           IMPR,IRET)
  212.             IF (IRET.NE.0) GOTO 9999
  213.             SEGACT MYLRF
  214.             NDDL=MYLRF.NPQUAF(/1)
  215.             IF (NDDL.NE.NBNN) THEN
  216.                WRITE(IOIMP,*) 'Programming error 3'
  217.                write(ioimp,*) 'NMELEM,NMELEQ,MYDISC=',NMELEM,NMELEQ
  218.      $              ,MYDISC 
  219.                write(ioimp,*) 'NBNN,NDDL=',NBNN,NDDL
  220.                GOTO 9999
  221.             ENDIF
  222. * Petits tests
  223.             NDLIG=MZMCHA.WELCHE(/1)
  224.             NDCOL=MZMCHA.WELCHE(/2)
  225.             N2DLIG=MZMCHA.WELCHE(/3)
  226.             N2DCOL=MZMCHA.WELCHE(/4)
  227.             NDNOEU=MZMCHA.WELCHE(/5)
  228.             NDELM=MZMCHA.WELCHE(/6)
  229.             IF (.NOT.( (NDLIG.EQ.1.AND.NDCOL.EQ.NDDL)
  230.      $           .OR. (NDLIG.EQ.NDDL.AND.NDCOL.EQ.1))
  231.      $           .AND.N2DLIG.NE.1
  232.      $           .AND.N2DCOL.NE.1.AND.NDNOEU.NE.1
  233.      $           .AND.(NDELM.NE.1.OR.NDELM.NE.NBEL)) THEN
  234.                WRITE(IOIMP,*) 'Erreur dims MZMCHA'
  235.                GOTO 9999
  236.             ENDIF
  237.             N2=1
  238.             SEGINI MCHAML
  239.             NOMCHE(1)=MYLMOT.MOTS(1)
  240.             TYPCHE(1)='REAL*8          '
  241.             N1PTEL=NDDL
  242.             N1EL=NDELM
  243.             N2PTEL=0
  244.             N2EL=0
  245.             SEGINI MELVAL
  246. *     Construisons le segment qui permet de parcourir les ddl dans
  247. *     l'ordre croissant des points du quaf
  248. *     Implicitement, on utilise le fait que les maillages LINE et QUAD
  249. *     parcourent les points du QUAF en croissant aussi.             
  250. *     On utilise le tri par insertion car les listes sont petites
  251.             JG=NDDL
  252.             SEGINI MPQUAF
  253.             SEGINI IORDO
  254.             DO IG=1,JG
  255.                MPQUAF.LECT(IG)=MYLRF.NPQUAF(IG)
  256.                IORDO.LECT(IG)=IG
  257.             ENDDO
  258.             LCROI=.TRUE.
  259.             CALL ORDO04(MPQUAF.LECT(1),NDDL,LCROI,IORDO.LECT(1))
  260. *            
  261.             DO IDELM=1,NDELM
  262.                DO IDDL=1,NDDL
  263.                   JDDL=IORDO.LECT(IDDL)
  264.                   IF (NDLIG.EQ.1) THEN
  265.                      ILIG=1
  266.                      ICOL=JDDL
  267.                   ELSE
  268.                      ILIG=JDDL
  269.                      ICOL=1
  270.                   ENDIF
  271.                   VELCHE(IDDL,IDELM)=MZMCHA.WELCHE(ILIG,ICOL,1,1,1
  272.      $                 ,IDELM)
  273.                ENDDO
  274.             ENDDO
  275.             IF (MELEME.NE.0) THEN 
  276.                DO IBEL=1,NBEL
  277.                   DO IDDL=1,NDDL
  278.                      JDDL=IORDO.LECT(IDDL)
  279.                      IF (NDLIG.EQ.1) THEN
  280.                         ILIG=1
  281.                         ICOL=JDDL
  282.                      ELSE
  283.                         ILIG=JDDL
  284.                         ICOL=1
  285.                      ENDIF
  286.                      NNQUA=MYLRF.NPQUAF(JDDL)
  287.                      NNGLO=SOUMAI.NUM(NNQUA,IBEL)
  288.                      NUM(IDDL,IBEL)=NNGLO
  289.                   ENDDO                  
  290.                ENDDO
  291.             ENDIF
  292.             SEGSUP IORDO
  293.             SEGSUP MPQUAF
  294.             IELVAL(1)=MELVAL
  295.             CONCHE(ISOUS)=' '
  296.             ICHAML(ISOUS)=MCHAML
  297.             IF (MELEME.EQ.0) THEN
  298. * SOUMAI est supprime par ailleurs a cause de regma2               
  299.                SEGINI,MELEME=SOUMAI
  300.             ENDIF
  301.             IMACHE(ISOUS)=MELEME
  302.             INFCHE(ISOUS,1)=0
  303.             INFCHE(ISOUS,2)=0
  304.             INFCHE(ISOUS,3)=NIFOUR
  305.             INFCHE(ISOUS,4)=0
  306.             INFCHE(ISOUS,5)=0
  307.             INFCHE(ISOUS,6)=0
  308.          ENDDO
  309.       ELSE
  310.          WRITE(IOIMP,*) 'CHAM keyword incompatible with discretization '
  311.      $        ,MYDISC
  312.          GOTO 9999
  313.       ENDIF
  314. *      IMPR=6
  315.       IF (IMPR.GT.3) THEN
  316.          CALL ECROBJ('MCHAML  ',MCHELM)
  317.          CALL PRLIST
  318.       ENDIF
  319. *      IMPR=0
  320. *
  321. * Normal termination
  322. *
  323.       IRET=0
  324.       RETURN
  325. *
  326. * Format handling
  327. *
  328. *
  329. * Error handling
  330. *
  331.  9999 CONTINUE
  332.       IRET=1
  333.       WRITE(IOIMP,*) 'An error was detected in subroutine cv2cml'
  334.       RETURN
  335. *
  336. * End of subroutine CV2CML
  337. *
  338.       END
  339.  
  340.  
  341.  
  342.  
  343.  
  344.  
  345.  
  346.  
  347.  

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