Télécharger la plaquette Cast3M


fr en

Télécharger cp2cv7.eso

Retour à la liste

Numérotation des lignes : 

cp2cv7

  1. C CP2CV7    SOURCE    MB234859  25/08/26    21:15:03     12343          
  2.       SUBROUTINE CP2CV7(CGEOMQ,MYLMOT,MYDISC,TYPCHA,ICHAM,MYREAL,
  3.      $     MYFALS,
  4.      $     MYMCHA,
  5.      $     IMPR,IRET)
  6.       IMPLICIT REAL*8 (A-H,O-Z)
  7.       IMPLICIT INTEGER (I-N)
  8. C***********************************************************************
  9. C NOM         : CP2CV7
  10. C DESCRIPTION : Transforme un chpoint en MCHAEL
  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       : PRLS63
  18. C***********************************************************************
  19. C ENTREES            : * CGEOMQ (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, 24/09/03, version initiale
  36. C HISTORIQUE : v1, 24/09/03, création
  37. C HISTORIQUE :     18/05/21, ajout lecture MCHAML
  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 CCGEOME
  48. -INC SMCOORD
  49. -INC SMCHPOI
  50.       POINTEUR MYCHPO.MCHPOI
  51. -INC SMCHAML
  52.       POINTEUR MYCHAM.MCHAML
  53. -INC TMTRAV
  54.       POINTEUR MYMTRA.MTRAV
  55.       INTEGER NNIN,NNNOE
  56. -INC SMELEME
  57.       POINTEUR CGEOMQ.MELEME
  58.       POINTEUR SOUMAI.MELEME
  59.       POINTEUR SOUMEL.MELEME
  60. -INC SMLMOTS
  61.       POINTEUR MYLMOT.MLMOTS
  62.       INTEGER JGN
  63. -INC SMLENTI
  64.       POINTEUR KRIGEO.MLENTI
  65.       POINTEUR KRINCO.MLENTI
  66.       POINTEUR MPQUAF.MLENTI
  67.       POINTEUR IORDO.MLENTI
  68.       INTEGER JG
  69. -INC SMMODEL
  70. *
  71. * Includes persos
  72. *
  73. -INC TNLIN
  74. *-INC SMCHAEL
  75.       INTEGER N1
  76.       POINTEUR MYMCHA.MCHAEL
  77.       INTEGER NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM
  78.       POINTEUR MZMCHA.MCHEVA
  79. *-INC SFALRF
  80.       POINTEUR MYFALS.FALRFS
  81. *-INC SELREF
  82.       POINTEUR MYLRF.ELREF
  83. *
  84.       CHARACTER*(4) MYDISC,NOMEL1
  85.       CHARACTER*8 TYPCHA
  86. *
  87.       INTEGER IBEL,IDDL,ISOUS,ITQUAF
  88.       INTEGER NBEL,NDDL,NSOUS
  89.       INTEGER NMLOC,NMQUA,NNGLO,NNLOC,NNMDDL,NNQUA
  90.       INTEGER NTOGPO
  91.       LOGICAL LDDLEX
  92.       REAL*8 MYREAL
  93.       REAL*8 CONTRI
  94.       LOGICAL LWARN,LVIDE,LINIZ,LCROI
  95. *
  96.       CHARACTER*(4) NMELEM,NMELEQ
  97.       PARAMETER (NDISC=3)
  98.       CHARACTER*(4) DISCS(NDISC),MOEF
  99.       INTEGER IMPR,IRET
  100.       PARAMETER (NQUAF=7)
  101.       CHARACTER*4 NMQUAF(NQUAF)
  102.       CHARACTER*4 NMQUAI(NQUAF)
  103.       CHARACTER*4 NMLINE(NQUAF)
  104. *
  105.       DATA DISCS/'LINE','QUAI','QUAF'/
  106.       DATA NMQUAF/'SEG3','TRI7','QUA9','CU27','PR21','TE15','PY19'/
  107.       DATA NMQUAI/'SEG3','TRI6','QUA8','CU20','PR15','TE10','PY13'/
  108.       DATA NMLINE/'SEG2','TRI3','QUA4','CUB8','PRI6','TET4','PYR5'/
  109. *
  110. * Executable statements
  111. *
  112.       IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans cp2cv7'
  113. *
  114. * Transformation du chpoint en un objet MTRAV plus commode
  115. *
  116.       IF (ICHAM.EQ.0) THEN
  117.          MYMCHA=0
  118. * Valeur scalaire
  119.       ELSEIF (ICHAM.LT.0) THEN
  120.          SEGACT CGEOMQ
  121.          NSOUS=CGEOMQ.LISOUS(/1)
  122.          N1=NSOUS
  123.          SEGINI MYMCHA
  124.          DO 2 ISOUS=1,NSOUS
  125.             SOUMAI=CGEOMQ.LISOUS(ISOUS)
  126.             SEGACT SOUMAI
  127. * On cherche l'élément fini correspondant au QUAF
  128.             ITQUAF=SOUMAI.ITYPEL
  129.             CALL KEEF(ITQUAF,MYDISC,
  130.      $           MYFALS,
  131.      $           MYLRF,
  132.      $           IMPR,IRET)
  133.             IF (IRET.NE.0) GOTO 9999
  134.             SEGACT MYLRF
  135.             NDDL=MYLRF.NPQUAF(/1)
  136. *            NBEL=SOUMAI.NUM(/2)
  137. * On initialise le MCHEVA a remplir
  138.             NBLIG=1
  139.             NBCOL=NDDL
  140.             N2LIG=1
  141.             N2COL=1
  142.             NBPOI=1
  143. * Astuce !
  144.             NBELM=1
  145.             SEGINI MZMCHA
  146.             DO IDDL=1,NDDL
  147.                MZMCHA.WELCHE(1,IDDL,1,1,1,1)=
  148.      $              MYREAL
  149.             ENDDO
  150.             SEGDES MZMCHA
  151.             MYMCHA.ICHEVA(ISOUS)=MZMCHA
  152.             SEGDES MYLRF
  153.             SEGDES SOUMAI
  154.             MYMCHA.JMACHE(ISOUS)=SOUMAI
  155.  2       CONTINUE
  156.          SEGDES MYMCHA
  157.          SEGDES CGEOMQ
  158. * ICHAM.GT.0
  159.       ELSE
  160.          IF (TYPCHA.EQ.'MCHAML  ') THEN
  161.             MYCHAM=ICHAM
  162. * Vérifions que MYDISC permet l'utilisation des MCHAML
  163.             CALL PLACE5(DISCS,NDISC,IDISC,MYDISC)
  164.             IF (IDISC.EQ.0) THEN
  165.                WRITE(IOIMP,*)
  166.      $              'MCHAML datum incompatible with discretization '
  167.      $              ,MYDISC
  168.                GOTO 9999
  169.             ENDIF
  170. * Réduisons le champ par élément sur les composantes de MYLMOT
  171. *     Normalement, il n'y a qu'un mot dans MYLMOT compte tenu des
  172. *     espaces de discrétisation envisagés (LINE, QUAI, QUAF)
  173.             SEGACT MYLMOT
  174.             NNMDDL=MYLMOT.MOTS(/2)
  175.             IF (NNMDDL.NE.1) THEN
  176.                WRITE(IOIMP,*) 'Programming error 3'
  177.                write(ioimp,*) 'NMELEM,NMELEQ,MYDISC=',NMELEM
  178.      $              ,NMELEQ,MYDISC
  179.                write(ioimp,*) 'NBNN,NDDL=',NBNN,NDDL
  180.                GOTO 9999
  181.             ENDIF
  182. *
  183.             CALL ACTOBJ('MCHAML  ',MYCHAM,1)
  184.             CALL EXCOC2(MYCHAM,MYLMOT,MCHELM,MYLMOT,0)
  185.             IF (IERR.NE.0) GOTO 9999
  186. *     Construisons le maillage issu de CGEOMQ (QUAF) qui ne va porter
  187. *     que sur les noeuds du QUAD ou du LINE si necessaire (voir aussi
  188. *     cv2cml.eso)
  189. *     On essaie de voir d'abord s'il ne serait pas stocké dans les
  190. *     références de CGEOMQ
  191.             SEGACT CGEOMQ
  192.             IF (IDISC.EQ.3) THEN
  193.                MELEME=CGEOMQ
  194.             ELSE
  195.                NBNN=0
  196.                NBELEM=0
  197.                NBREF=0
  198.                NBSOUS=CGEOMQ.LISOUS(/1)
  199.                SEGINI MELEME
  200.                DO ISOUS=1,NBSOUS
  201.                   IPT1=CGEOMQ.LISREF(ISOUS)
  202.                   IDX=0
  203.                   IF (IPT1.NE.0) THEN
  204.                      ITYP1=IPT1.ITYPEL
  205.                      NOMEL1=NOMS(ITYP1)
  206.                      IF (IDISC.EQ.1) THEN
  207.                         CALL PLACE5(NMLINE,NQUAF,IDX,NOMEL1)
  208.                      ELSE
  209.                         CALL PLACE5(NMQUAI,NQUAF,IDX,NOMEL1)
  210.                      ENDIF
  211.                   ENDIF
  212.                   IF (IDX.NE.0) THEN
  213.                      IPT2=IPT1
  214.                   ELSE
  215.                      IPT1=CGEOMQ.LISOUS(ISOUS)
  216.                      CALL ECROBJ('MAILLAGE',IPT1)
  217.                      IF (IDISC.EQ.1) THEN
  218.                         CALL CHANLI
  219.                      ELSE
  220.                         CALL CHANQU
  221.                      ENDIF
  222.                      CALL LIROBJ('MAILLAGE',IPT2,1,IRETOU)
  223.                      IF(IERR.NE.0) RETURN
  224.                   ENDIF
  225.                   LISOUS(ISOUS)=IPT2
  226.                ENDDO
  227.             ENDIF
  228. * Réduisons sur le maillage cree
  229. *            WRITE(IOIMP,*) 'MELEME'
  230. *            CALL ECROBJ('MAILLAGE',MELEME)
  231. *            CALL PRLIST
  232. *            CALL ECROBJ('MCHAML  ',MCHELM)
  233. *            CALL PRLIST
  234. * On passe par un modele car le REDUIC ne fait pas ce que l'on veut
  235. *            CALL REDUIC(MCHELM,MELEME,MCHEL2)
  236. *            IF (IERR.NE.0) GOTO 9999
  237.             nbs=meleme.lisous(/1)
  238.             if (nbs.ne.0) then
  239.               do ic=1,nbs
  240.                 ipt3=meleme.lisous(ic)
  241.                 moef=NOMS(ipt3.itypel)
  242.                 call ecrcha(moef)
  243.               enddo
  244.             else
  245.               moef=NOMS(meleme.itypel)
  246.               call ecrcha(moef)
  247.             endif
  248.             call ecrcha('MECANIQUE')
  249.             call ecrobj('MAILLAGE',MELEME)
  250.             call modeli
  251.             IF (IERR.NE.0) GOTO 9999
  252.             call lirobj('MMODEL  ',MMODEL,1,IRET)
  253.             IF (IERR.NE.0) GOTO 9999
  254.             CALL REDUAF(MCHELM,MMODEL,MCHEL2,0,IR,KER)
  255.             IF(IR   .NE. 1) CALL ERREUR(KER)
  256.             IF(IERR .NE. 0) GOTO 9999
  257.             IF (MCHEL2.EQ.0) THEN
  258.                WRITE(IOIMP,*) 'Erreur REDU'
  259.                GOTO 9999
  260.             ENDIF
  261. * Osons...
  262.             CALL DTCHAM(MCHELM)
  263.             SEGSUP MMODEL
  264.             MCHELM=MCHEL2
  265.             IF (IDISC.NE.3) SEGSUP MELEME
  266. *
  267. * Création et remplissage du champ par éléments
  268. * En même temps, on supprime les MELEME crees.
  269. *            SEGACT MELEME
  270.             NSOUS=CGEOMQ.LISOUS(/1)
  271.             CALL ACTOBJ('MCHAML  ',MCHELM,1)
  272. *         write(ioimp,*) 'MCHELM=',MCHELM
  273.             N1=NSOUS
  274.             SEGINI MYMCHA
  275.             DO 3 ISOUS=1,NSOUS
  276. *               write(ioimp,*) 'isous=',isous
  277. *               write(ioimp,*) 'ichaml(/1)=',ichaml(/1)
  278. *               write(ioimp,*) 'lisous(/1)=',lisous(/1)
  279.                SOUMAI=CGEOMQ.LISOUS(ISOUS)
  280.                SEGACT SOUMAI
  281.                SOUMEL=IMACHE(ISOUS)
  282.                SEGACT SOUMEL
  283.                MCHAML=ICHAML(ISOUS)
  284.                N2=IELVAL(/1)
  285. * Normalement, 1 seule composante vu qu'on a reduit le champ dessus
  286.                IF (N2.NE.1) THEN
  287.                   WRITE(IOIMP,*) 'Programming error 4'
  288.                   GOTO 9999
  289.                ENDIF
  290.                IF (TYPCHE(1).NE.'REAL*8') THEN
  291.                   WRITE(IOIMP,*) 'Error : component ',NOMCHE(1)
  292.      $                 ,' not REAL*8 in the MCHAML object'
  293.                   GOTO 9999
  294.                ENDIF
  295. *               write(ioimp,*) 'N1,N2=',N1,N2
  296. *            do i=1,n2
  297. *               write(ioimp,*) 'i,nomche',i,nomche(i)
  298. *            enddo
  299. *            SEGPRT,MYLMOT
  300. *            SEGPRT,MCHAML
  301.                ITQUAF=SOUMAI.ITYPEL
  302.                CALL KEEF(ITQUAF,MYDISC,
  303.      $              MYFALS,
  304.      $              MYLRF,
  305.      $              IMPR,IRET)
  306.                IF (IRET.NE.0) GOTO 9999
  307.                SEGACT MYLRF
  308.                NDDL=MYLRF.NPQUAF(/1)
  309.                NDDL2=SOUMEL.NUM(/1)
  310.                if (NDDL.NE.NDDL2) then
  311.                   write(ioimp,*) 'Erreur grave dimensions soumel'
  312.                   goto 9999
  313.                endif
  314.                NBEL=SOUMEL.NUM(/2)
  315.                MELVAL=IELVAL(1)
  316.                N1PTEL=VELCHE(/1)
  317.                N1EL=VELCHE(/2)
  318.                IF ((N1PTEL.NE.NDDL.AND.N1PTEL.NE.1).OR.
  319.      $             (N1EL.NE.1.AND.N1EL.NE.NBEL)) THEN
  320.                   write(ioimp,*) 'Erreur grave dimensions MELVAL'
  321.                   write(ioimp,*) 'N1PTEL,NDDL=',N1PTEL,NDDL
  322.                   write(ioimp,*) 'N1EL,NBEL=',N1EL,NBEL
  323.                   GOTO 9999
  324.                ENDIF
  325. * On initialise le MCHEVA a remplir
  326.                NBLIG=1
  327.                NBCOL=NDDL
  328.                N2LIG=1
  329.                N2COL=1
  330.                NBPOI=1
  331.                NBELM=N1EL
  332.                SEGINI MZMCHA
  333. *     Construisons le segment qui permet de parcourir les ddl dans
  334. *     l'ordre croissant des points du quaf
  335. *     Implicitement, on utilise le fait que les maillages LINE et QUAD
  336. *     parcourent les points du QUAF en croissant aussi.
  337. *     On utilise le tri par insertion car les listes sont petites
  338.                JG=NDDL
  339.                SEGINI MPQUAF
  340.                SEGINI IORDO
  341.                DO IG=1,JG
  342.                   MPQUAF.LECT(IG)=MYLRF.NPQUAF(IG)
  343.                   IORDO.LECT(IG)=IG
  344.                ENDDO
  345.                LCROI=.TRUE.
  346.                CALL ORDO04(MPQUAF.LECT(1),NDDL,LCROI,IORDO.LECT(1))
  347.                SEGDES MYLRF
  348. *
  349. *               DO IDDL=1,NDDL
  350. *                  write(ioimp,*) 'I,NPQUAF,IORDO=',IDDL
  351. *     $                 ,MYLRF.NPQUAF(IDDL),IORDO.LECT(IDDL)
  352. *               ENDDO
  353. *               SEGPRT,MYLRF
  354. *               SEGPRT,SOUMAI
  355. *               SEGPRT,SOUMEL
  356. *               SEGPRT,IORDO
  357.                DO I1EL=1,N1EL
  358.                   DO IDDL=1,NDDL
  359.                      JDDL=IORDO.LECT(IDDL)
  360. *********** Cette partie est un test que l'on pourrait supprimmer**********
  361. *                     NNQUA=MYLRF.NPQUAF(JDDL)
  362. *                     NNGLO=SOUMAI.NUM(NNQUA,I1EL)
  363. **                     do 99 jddl=1,nddl
  364. *                     NNGLO2=SOUMEL.NUM(IDDL,I1EL)
  365. **                        if (nnglo2.eq.nnglo) goto 999
  366. **     99                  continue
  367. *                     if (nnglo2.ne.nnglo) then
  368. *                        write(ioimp,*) 'Erreur grave'
  369. *                        write(ioimp,*) 'IDDL,NNQUA,JDDL=',IDDL,NNQUA
  370. *     $                       ,JDDL
  371. *                        write(ioimp,*) 'NNGLO,NNGLO2=',NNGLO,NNGLO2
  372. *                        goto 9999
  373. *                     endif
  374. ** 999                 continue
  375. ****************************************************************************
  376.                      IF (N1PTEL.EQ.1) THEN
  377.                         I1PTEL=1
  378.                      ELSE
  379.                         I1PTEL=IDDL
  380.                      ENDIF
  381.                      MZMCHA.WELCHE(1,JDDL,1,1,1,I1EL)=VELCHE(I1PTEL
  382.      $                    ,I1EL)
  383.                   ENDDO
  384.                ENDDO
  385.                SEGSUP IORDO
  386.                SEGSUP MPQUAF
  387.                SEGDES MZMCHA
  388.                MYMCHA.ICHEVA(ISOUS)=MZMCHA
  389.                SEGDES SOUMEL
  390.                SEGDES SOUMAI
  391.                MYMCHA.JMACHE(ISOUS)=SOUMAI
  392. *               IF (SOUMEL.NE.SOUMAI) SEGSUP SOUMEL
  393.  3          CONTINUE
  394. *        IMPR=6
  395.             IF (IMPR.GT.3) THEN
  396.                CALL PRCAEL(MYMCHA,IMPR,IRET)
  397.                IF (IRET.NE.0) GOTO 9999
  398.             ENDIF
  399. *         IMPR=0
  400.             SEGDES MYMCHA
  401.             SEGDES CGEOMQ
  402. *            SEGSUP MELEME
  403.             CALL DTCHAM(MCHELM)
  404.          ELSEIF (TYPCHA.EQ.'CHPOINT ') THEN
  405.             MYCHPO=ICHAM
  406. *
  407. * Transformation du chpoint en un objet MTRAV plus commode
  408. *
  409.             CALL CP2TRA(MYCHPO,
  410.      $           MYMTRA,LVIDE,
  411.      $           IMPR,IRET)
  412.             IF (IRET.NE.0) GOTO 9999
  413. *
  414. * Warning, si aucune valeur du chpoint n'a servi
  415. *
  416. *Pour débugger
  417.             LWARN=.TRUE.
  418. *     LWARN=.FALSE.
  419.             LINIZ=.FALSE.
  420. *
  421. * Segments de repérage dans MTRAV
  422. *
  423.             SEGACT MYMTRA
  424.             JGN=MYMTRA.INCO(/1)
  425.             NNIN=MYMTRA.INCO(/2)
  426.             NNNOE=MYMTRA.IGEO(/1)
  427. *  Création du segment de répérage dans IGEO
  428.             NTOGPO=nbpts
  429.             JG=NTOGPO
  430.             SEGINI,KRIGEO
  431.             CALL RSETEE(MYMTRA.IGEO,NNNOE,
  432.      $           KRIGEO.LECT,NTOGPO,
  433.      $           IMPR,IRET)
  434.             IF (IRET.NE.0) GOTO 9999
  435. *  Création du segment de repérage dans INCO
  436.             SEGACT MYLMOT
  437.             NNMDDL=MYLMOT.MOTS(/2)
  438.             JG=NNMDDL
  439.             SEGINI KRINCO
  440.             CALL CREPE2(JGN,NNMDDL,NNIN,
  441.      $           MYLMOT.MOTS,MYMTRA.INCO,
  442.      $           KRINCO.LECT,
  443.      $           IMPR,IRET)
  444.             IF (IRET.NE.0) GOTO 9999
  445. *
  446. * Création et remplissage du champ par éléments
  447. *
  448.             SEGACT CGEOMQ
  449.             NSOUS=CGEOMQ.LISOUS(/1)
  450.             N1=NSOUS
  451.             SEGINI MYMCHA
  452.             DO 1 ISOUS=1,NSOUS
  453.                SOUMAI=CGEOMQ.LISOUS(ISOUS)
  454.                SEGACT SOUMAI
  455. *            SEGPRT,SOUMAI
  456. * On cherche l'élément fini correspondant au QUAF
  457.                ITQUAF=SOUMAI.ITYPEL
  458.                CALL KEEF(ITQUAF,MYDISC,
  459.      $              MYFALS,
  460.      $              MYLRF,
  461.      $              IMPR,IRET)
  462.                IF (IRET.NE.0) GOTO 9999
  463. *               SEGPRT,MYLRF
  464.                SEGACT MYLRF
  465.                NDDL=MYLRF.NPQUAF(/1)
  466.                NBEL=SOUMAI.NUM(/2)
  467. * On initialise le MCHEVA a remplir
  468.                NBLIG=1
  469.                NBCOL=NDDL
  470.                N2LIG=1
  471.                N2COL=1
  472.                NBPOI=1
  473.                NBELM=NBEL
  474.                SEGINI MZMCHA
  475.                DO IBEL=1,NBEL
  476.                   DO IDDL=1,NDDL
  477.                      NNQUA=MYLRF.NPQUAF(IDDL)
  478.                      NNGLO=SOUMAI.NUM(NNQUA,IBEL)
  479.                      NNLOC=KRIGEO.LECT(NNGLO)
  480.                      NMQUA=MYLRF.NUMCMP(IDDL)
  481.                      NMLOC=KRINCO.LECT(NMQUA)
  482.                      IF (NNLOC.EQ.0.OR.NMLOC.EQ.0) THEN
  483.                         LINIZ=.TRUE.
  484.                         CONTRI=0.D0
  485.                      ELSE
  486.                         LDDLEX=MYMTRA.IBIN(NMLOC,NNLOC).EQ.1
  487.                         IF (.NOT.LDDLEX) THEN
  488.                            LINIZ=.TRUE.
  489.                            CONTRI=0.D0
  490.                         ELSE
  491.                            LWARN=.FALSE.
  492.                            CONTRI=MYMTRA.BB(NMLOC,NNLOC)
  493.                         ENDIF
  494.                      ENDIF
  495.                      MZMCHA.WELCHE(1,IDDL,1,1,1,IBEL)=CONTRI
  496.                   ENDDO
  497.                ENDDO
  498.                SEGDES MZMCHA
  499. *            SEGPRT,MZMCHA
  500.                MYMCHA.ICHEVA(ISOUS)=MZMCHA
  501.                SEGDES MYLRF
  502.                SEGDES SOUMAI
  503.                MYMCHA.JMACHE(ISOUS)=SOUMAI
  504.  1          CONTINUE
  505.             SEGDES MYMCHA
  506.             SEGDES CGEOMQ
  507.             SEGSUP KRINCO
  508.             SEGDES MYLMOT
  509.             SEGSUP KRIGEO
  510.             SEGSUP MYMTRA
  511. *      IMPR=6
  512.             IF (IMPR.GT.3) THEN
  513.                WRITE(IOIMP,*) 'On a créé',
  514.      $              ' MYMCHA(élément ,1, 1 , 1 ,1, ddl)'
  515.                CALL PRCAEL(MYMCHA,IMPR,IRET)
  516.                IF (IRET.NE.0) GOTO 9999
  517.             ENDIF
  518. *      IMPR=0
  519. *
  520. * Warning
  521. *
  522.             IF (LWARN.AND.(.NOT.LVIDE)) THEN
  523.                WRITE(IOIMP,*) 'Error : no values of the given CHPOINT',
  524.      $              ' were used'
  525.                GOTO 9999
  526.             ENDIF
  527.             IF (LINIZ) THEN
  528.                WRITE(IOIMP,*) 'Error : the given CHPOINT',
  529.      $              ' does not give all the required values'
  530.                GOTO 9999
  531.             ENDIF
  532.          ELSE
  533.             write(ioimp,*) 'TYPCHA=',TYPCHA,' unexpected'
  534.             goto 9999
  535.          ENDIF
  536.       ENDIF
  537. *
  538. * Normal termination
  539. *
  540.       IRET=0
  541.       RETURN
  542. *
  543. * Format handling
  544. *
  545. *
  546. * Error handling
  547. *
  548.  9999 CONTINUE
  549.       IRET=1
  550.       WRITE(IOIMP,*) 'An error was detected in subroutine cp2cv7'
  551.       RETURN
  552. *
  553. * End of subroutine CP2CV7
  554. *
  555.       END
  556.  
  557.  
  558.  

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