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    GOUNAND   24/11/06    21:15:02     12073          
  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)
  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.             call ecrcha('MECANIQUE')
  238.             call ecrobj('MAILLAGE',MELEME)
  239.             call modeli
  240.             IF (IERR.NE.0) GOTO 9999
  241.             call lirobj('MMODEL  ',MMODEL,1,IRET)
  242.             IF (IERR.NE.0) GOTO 9999
  243.             CALL REDUAF(MCHELM,MMODEL,MCHEL2,0,IR,KER)
  244.             IF(IR   .NE. 1) CALL ERREUR(KER)
  245.             IF(IERR .NE. 0) GOTO 9999
  246.             IF (MCHEL2.EQ.0) THEN
  247.                WRITE(IOIMP,*) 'Erreur REDU'
  248.                GOTO 9999
  249.             ENDIF
  250. * Osons...
  251.             CALL DTCHAM(MCHELM)
  252.             SEGSUP MMODEL
  253.             MCHELM=MCHEL2
  254.             IF (IDISC.NE.3) SEGSUP MELEME
  255. *
  256. * Création et remplissage du champ par éléments
  257. * En même temps, on supprime les MELEME crees.
  258. *            SEGACT MELEME
  259.             NSOUS=CGEOMQ.LISOUS(/1)
  260.             CALL ACTOBJ('MCHAML  ',MCHELM,1)
  261. *         write(ioimp,*) 'MCHELM=',MCHELM
  262.             N1=NSOUS
  263.             SEGINI MYMCHA
  264.             DO 3 ISOUS=1,NSOUS
  265. *               write(ioimp,*) 'isous=',isous
  266. *               write(ioimp,*) 'ichaml(/1)=',ichaml(/1)
  267. *               write(ioimp,*) 'lisous(/1)=',lisous(/1)
  268.                SOUMAI=CGEOMQ.LISOUS(ISOUS)
  269.                SEGACT SOUMAI
  270.                SOUMEL=IMACHE(ISOUS)
  271.                SEGACT SOUMEL
  272.                MCHAML=ICHAML(ISOUS)
  273.                N2=IELVAL(/1)
  274. * Normalement, 1 seule composante vu qu'on a reduit le champ dessus
  275.                IF (N2.NE.1) THEN
  276.                   WRITE(IOIMP,*) 'Programming error 4'
  277.                   GOTO 9999
  278.                ENDIF
  279.                IF (TYPCHE(1).NE.'REAL*8') THEN
  280.                   WRITE(IOIMP,*) 'Error : component ',NOMCHE(1)
  281.      $                 ,' not REAL*8 in the MCHAML object'
  282.                   GOTO 9999
  283.                ENDIF
  284. *               write(ioimp,*) 'N1,N2=',N1,N2
  285. *            do i=1,n2
  286. *               write(ioimp,*) 'i,nomche',i,nomche(i)
  287. *            enddo
  288. *            SEGPRT,MYLMOT
  289. *            SEGPRT,MCHAML
  290.                ITQUAF=SOUMAI.ITYPEL
  291.                CALL KEEF(ITQUAF,MYDISC,
  292.      $              MYFALS,
  293.      $              MYLRF,
  294.      $              IMPR,IRET)
  295.                IF (IRET.NE.0) GOTO 9999
  296.                SEGACT MYLRF
  297.                NDDL=MYLRF.NPQUAF(/1)
  298.                NDDL2=SOUMEL.NUM(/1)
  299.                if (NDDL.NE.NDDL2) then
  300.                   write(ioimp,*) 'Erreur grave dimensions soumel'
  301.                   goto 9999
  302.                endif
  303.                NBEL=SOUMEL.NUM(/2)
  304.                MELVAL=IELVAL(1)
  305.                N1PTEL=VELCHE(/1)
  306.                N1EL=VELCHE(/2)
  307.                IF ((N1PTEL.NE.NDDL.AND.N1PTEL.NE.1).OR.
  308.      $             (N1EL.NE.1.AND.N1EL.NE.NBEL)) THEN
  309.                   write(ioimp,*) 'Erreur grave dimensions MELVAL'
  310.                   write(ioimp,*) 'N1PTEL,NDDL=',N1PTEL,NDDL
  311.                   write(ioimp,*) 'N1EL,NBEL=',N1EL,NBEL
  312.                   GOTO 9999
  313.                ENDIF
  314. * On initialise le MCHEVA a remplir
  315.                NBLIG=1
  316.                NBCOL=NDDL
  317.                N2LIG=1
  318.                N2COL=1
  319.                NBPOI=1
  320.                NBELM=N1EL
  321.                SEGINI MZMCHA
  322. *     Construisons le segment qui permet de parcourir les ddl dans
  323. *     l'ordre croissant des points du quaf
  324. *     Implicitement, on utilise le fait que les maillages LINE et QUAD
  325. *     parcourent les points du QUAF en croissant aussi.
  326. *     On utilise le tri par insertion car les listes sont petites
  327.                JG=NDDL
  328.                SEGINI MPQUAF
  329.                SEGINI IORDO
  330.                DO IG=1,JG
  331.                   MPQUAF.LECT(IG)=MYLRF.NPQUAF(IG)
  332.                   IORDO.LECT(IG)=IG
  333.                ENDDO
  334.                LCROI=.TRUE.
  335.                CALL ORDO04(MPQUAF.LECT(1),NDDL,LCROI,IORDO.LECT(1))
  336.                SEGDES MYLRF
  337. *
  338. *               DO IDDL=1,NDDL
  339. *                  write(ioimp,*) 'I,NPQUAF,IORDO=',IDDL
  340. *     $                 ,MYLRF.NPQUAF(IDDL),IORDO.LECT(IDDL)
  341. *               ENDDO
  342. *               SEGPRT,MYLRF
  343. *               SEGPRT,SOUMAI
  344. *               SEGPRT,SOUMEL
  345. *               SEGPRT,IORDO
  346.                DO I1EL=1,N1EL
  347.                   DO IDDL=1,NDDL
  348.                      JDDL=IORDO.LECT(IDDL)
  349. *********** Cette partie est un test que l'on pourrait supprimmer**********
  350. *                     NNQUA=MYLRF.NPQUAF(JDDL)
  351. *                     NNGLO=SOUMAI.NUM(NNQUA,I1EL)
  352. **                     do 99 jddl=1,nddl
  353. *                     NNGLO2=SOUMEL.NUM(IDDL,I1EL)
  354. **                        if (nnglo2.eq.nnglo) goto 999
  355. **     99                  continue
  356. *                     if (nnglo2.ne.nnglo) then
  357. *                        write(ioimp,*) 'Erreur grave'
  358. *                        write(ioimp,*) 'IDDL,NNQUA,JDDL=',IDDL,NNQUA
  359. *     $                       ,JDDL
  360. *                        write(ioimp,*) 'NNGLO,NNGLO2=',NNGLO,NNGLO2
  361. *                        goto 9999
  362. *                     endif
  363. ** 999                 continue
  364. ****************************************************************************
  365.                      IF (N1PTEL.EQ.1) THEN
  366.                         I1PTEL=1
  367.                      ELSE
  368.                         I1PTEL=IDDL
  369.                      ENDIF
  370.                      MZMCHA.WELCHE(1,JDDL,1,1,1,I1EL)=VELCHE(I1PTEL
  371.      $                    ,I1EL)
  372.                   ENDDO
  373.                ENDDO
  374.                SEGSUP IORDO
  375.                SEGSUP MPQUAF
  376.                SEGDES MZMCHA
  377.                MYMCHA.ICHEVA(ISOUS)=MZMCHA
  378.                SEGDES SOUMEL
  379.                SEGDES SOUMAI
  380.                MYMCHA.JMACHE(ISOUS)=SOUMAI
  381. *               IF (SOUMEL.NE.SOUMAI) SEGSUP SOUMEL
  382.  3          CONTINUE
  383. *        IMPR=6
  384.             IF (IMPR.GT.3) THEN
  385.                CALL PRCAEL(MYMCHA,IMPR,IRET)
  386.                IF (IRET.NE.0) GOTO 9999
  387.             ENDIF
  388. *         IMPR=0
  389.             SEGDES MYMCHA
  390.             SEGDES CGEOMQ
  391. *            SEGSUP MELEME
  392.             CALL DTCHAM(MCHELM)
  393.          ELSEIF (TYPCHA.EQ.'CHPOINT ') THEN
  394.             MYCHPO=ICHAM
  395. *
  396. * Transformation du chpoint en un objet MTRAV plus commode
  397. *
  398.             CALL CP2TRA(MYCHPO,
  399.      $           MYMTRA,LVIDE,
  400.      $           IMPR,IRET)
  401.             IF (IRET.NE.0) GOTO 9999
  402. *
  403. * Warning, si aucune valeur du chpoint n'a servi
  404. *
  405. *Pour débugger
  406.             LWARN=.TRUE.
  407. *     LWARN=.FALSE.
  408.             LINIZ=.FALSE.
  409. *
  410. * Segments de repérage dans MTRAV
  411. *
  412.             SEGACT MYMTRA
  413.             JGN=MYMTRA.INCO(/1)
  414.             NNIN=MYMTRA.INCO(/2)
  415.             NNNOE=MYMTRA.IGEO(/1)
  416. *  Création du segment de répérage dans IGEO
  417.             NTOGPO=nbpts
  418.             JG=NTOGPO
  419.             SEGINI,KRIGEO
  420.             CALL RSETEE(MYMTRA.IGEO,NNNOE,
  421.      $           KRIGEO.LECT,NTOGPO,
  422.      $           IMPR,IRET)
  423.             IF (IRET.NE.0) GOTO 9999
  424. *  Création du segment de repérage dans INCO
  425.             SEGACT MYLMOT
  426.             NNMDDL=MYLMOT.MOTS(/2)
  427.             JG=NNMDDL
  428.             SEGINI KRINCO
  429.             CALL CREPE2(JGN,NNMDDL,NNIN,
  430.      $           MYLMOT.MOTS,MYMTRA.INCO,
  431.      $           KRINCO.LECT,
  432.      $           IMPR,IRET)
  433.             IF (IRET.NE.0) GOTO 9999
  434. *
  435. * Création et remplissage du champ par éléments
  436. *
  437.             SEGACT CGEOMQ
  438.             NSOUS=CGEOMQ.LISOUS(/1)
  439.             N1=NSOUS
  440.             SEGINI MYMCHA
  441.             DO 1 ISOUS=1,NSOUS
  442.                SOUMAI=CGEOMQ.LISOUS(ISOUS)
  443.                SEGACT SOUMAI
  444. *            SEGPRT,SOUMAI
  445. * On cherche l'élément fini correspondant au QUAF
  446.                ITQUAF=SOUMAI.ITYPEL
  447.                CALL KEEF(ITQUAF,MYDISC,
  448.      $              MYFALS,
  449.      $              MYLRF,
  450.      $              IMPR,IRET)
  451.                IF (IRET.NE.0) GOTO 9999
  452. *               SEGPRT,MYLRF
  453.                SEGACT MYLRF
  454.                NDDL=MYLRF.NPQUAF(/1)
  455.                NBEL=SOUMAI.NUM(/2)
  456. * On initialise le MCHEVA a remplir
  457.                NBLIG=1
  458.                NBCOL=NDDL
  459.                N2LIG=1
  460.                N2COL=1
  461.                NBPOI=1
  462.                NBELM=NBEL
  463.                SEGINI MZMCHA
  464.                DO IBEL=1,NBEL
  465.                   DO IDDL=1,NDDL
  466.                      NNQUA=MYLRF.NPQUAF(IDDL)
  467.                      NNGLO=SOUMAI.NUM(NNQUA,IBEL)
  468.                      NNLOC=KRIGEO.LECT(NNGLO)
  469.                      NMQUA=MYLRF.NUMCMP(IDDL)
  470.                      NMLOC=KRINCO.LECT(NMQUA)
  471.                      IF (NNLOC.EQ.0.OR.NMLOC.EQ.0) THEN
  472.                         LINIZ=.TRUE.
  473.                         CONTRI=0.D0
  474.                      ELSE
  475.                         LDDLEX=MYMTRA.IBIN(NMLOC,NNLOC).EQ.1
  476.                         IF (.NOT.LDDLEX) THEN
  477.                            LINIZ=.TRUE.
  478.                            CONTRI=0.D0
  479.                         ELSE
  480.                            LWARN=.FALSE.
  481.                            CONTRI=MYMTRA.BB(NMLOC,NNLOC)
  482.                         ENDIF
  483.                      ENDIF
  484.                      MZMCHA.WELCHE(1,IDDL,1,1,1,IBEL)=CONTRI
  485.                   ENDDO
  486.                ENDDO
  487.                SEGDES MZMCHA
  488. *            SEGPRT,MZMCHA
  489.                MYMCHA.ICHEVA(ISOUS)=MZMCHA
  490.                SEGDES MYLRF
  491.                SEGDES SOUMAI
  492.                MYMCHA.JMACHE(ISOUS)=SOUMAI
  493.  1          CONTINUE
  494.             SEGDES MYMCHA
  495.             SEGDES CGEOMQ
  496.             SEGSUP KRINCO
  497.             SEGDES MYLMOT
  498.             SEGSUP KRIGEO
  499.             SEGSUP MYMTRA
  500. *      IMPR=6
  501.             IF (IMPR.GT.3) THEN
  502.                WRITE(IOIMP,*) 'On a créé',
  503.      $              ' MYMCHA(élément ,1, 1 , 1 ,1, ddl)'
  504.                CALL PRCAEL(MYMCHA,IMPR,IRET)
  505.                IF (IRET.NE.0) GOTO 9999
  506.             ENDIF
  507. *      IMPR=0
  508. *
  509. * Warning
  510. *
  511.             IF (LWARN.AND.(.NOT.LVIDE)) THEN
  512.                WRITE(IOIMP,*) 'Error : no values of the given CHPOINT',
  513.      $              ' were used'
  514.                GOTO 9999
  515.             ENDIF
  516.             IF (LINIZ) THEN
  517.                WRITE(IOIMP,*) 'Error : the given CHPOINT',
  518.      $              ' does not give all the required values'
  519.                GOTO 9999
  520.             ENDIF
  521.          ELSE
  522.             write(ioimp,*) 'TYPCHA=',TYPCHA,' unexpected'
  523.             goto 9999
  524.          ENDIF
  525.       ENDIF
  526. *
  527. * Normal termination
  528. *
  529.       IRET=0
  530.       RETURN
  531. *
  532. * Format handling
  533. *
  534. *
  535. * Error handling
  536. *
  537.  9999 CONTINUE
  538.       IRET=1
  539.       WRITE(IOIMP,*) 'An error was detected in subroutine cp2cv7'
  540.       RETURN
  541. *
  542. * End of subroutine CP2CV7
  543. *
  544.       END
  545.  
  546.  

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