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    CB215821  24/04/12    21:15:31     11897          
  2.       SUBROUTINE CP2CV7(CGEOME,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            : * 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, 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 CGEOME.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
  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.       PARAMETER (NQUAF=7)
  100.       CHARACTER*4 NMQUAF(NQUAF)
  101.       CHARACTER*4 NMQUAI(NQUAF)
  102.       CHARACTER*4 NMLINE(NQUAF)
  103.       INTEGER IMPR,IRET
  104. *
  105.       DATA DISCS/'LINE','QUAI','QUAF'/
  106. * A supprimer ?      
  107.       DATA NMQUAF/'SEG3','TRI7','QUA9','CU27','PR21','TE15','PY19'/
  108.       DATA NMQUAI/'SEG3','TRI6','QUA8','CU20','PR15','TE10','PY13'/
  109.       DATA NMLINE/'SEG2','TRI3','QUA4','CUB8','PRI6','TET4','PYR5'/
  110. *
  111. * Executable statements
  112. *
  113.       IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans cp2cv7'
  114. *
  115. * Transformation du chpoint en un objet MTRAV plus commode
  116. *
  117.       IF (ICHAM.EQ.0) THEN
  118.          MYMCHA=0
  119.       ELSEIF (ICHAM.LT.0) THEN
  120.          SEGACT CGEOME
  121.          NSOUS=CGEOME.LISOUS(/1)
  122.          N1=NSOUS
  123.          SEGINI MYMCHA
  124.          DO 2 ISOUS=1,NSOUS
  125.             SOUMAI=CGEOME.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 CGEOME
  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 CGEOME (QUAF) qui ne va porter
  187. * que sur les noeuds du QUAD ou du LINE si necessaire (voir aussi cv2cml.eso)            
  188.             IF (IDISC.EQ.1) THEN
  189.                CALL ECROBJ('MAILLAGE',CGEOME)
  190.                CALL CHANLI
  191.                CALL LIROBJ('MAILLAGE',MELEME,1,IRETOU)
  192.                IF(IERR.NE.0) RETURN
  193.             ELSEIF (IDISC.EQ.2) THEN
  194.                CALL ECROBJ('MAILLAGE',CGEOME)
  195.                CALL CHANQU
  196.                CALL LIROBJ('MAILLAGE',MELEME,1,IRETOU)
  197.                IF(IERR.NE.0) RETURN
  198.             ELSEIF (IDISC.EQ.3) THEN
  199.                MELEME=CGEOME
  200.             ENDIF
  201. * Réduisons sur le maillage cree
  202. *            WRITE(IOIMP,*) 'MELEME'
  203. *            CALL ECROBJ('MAILLAGE',MELEME)
  204. *            CALL PRLIST
  205. *            CALL ECROBJ('MCHAML  ',MCHELM)
  206. *            CALL PRLIST
  207. * On passe par un modele car le REDUIC ne fait pas ce que l'on veut            
  208. *            CALL REDUIC(MCHELM,MELEME,MCHEL2)
  209. *            IF (IERR.NE.0) GOTO 9999
  210.             call ecrcha('MECANIQUE')
  211.             call ecrobj('MAILLAGE',MELEME)
  212.             call modeli
  213.             IF (IERR.NE.0) GOTO 9999
  214.             call lirobj('MMODEL  ',MMODEL,1,IRET)
  215.             IF (IERR.NE.0) GOTO 9999
  216.             CALL REDUAF(MCHELM,MMODEL,MCHEL2,0,IR,KER)
  217.             IF(IR   .NE. 1) CALL ERREUR(KER)
  218.             IF(IERR .NE. 0) GOTO 9999
  219.             IF (MCHEL2.EQ.0) THEN
  220.                WRITE(IOIMP,*) 'Erreur REDU'
  221.                GOTO 9999
  222.             ENDIF
  223. * Osons...            
  224.             CALL DTCHAM(MCHELM)
  225.             SEGSUP MMODEL
  226.             MCHELM=MCHEL2
  227. *     
  228. * Création et remplissage du champ par éléments
  229. * En même temps, on supprime les MELEME crees.
  230.             SEGACT CGEOME
  231. *            SEGACT MELEME
  232.             NSOUS=CGEOME.LISOUS(/1)
  233.             CALL ACTOBJ('MCHAML  ',MCHELM,1)
  234. *         write(ioimp,*) 'MCHELM=',MCHELM
  235.             N1=NSOUS
  236.             SEGINI MYMCHA
  237.             DO 3 ISOUS=1,NSOUS
  238. *               write(ioimp,*) 'isous=',isous
  239. *               write(ioimp,*) 'ichaml(/1)=',ichaml(/1)
  240. *               write(ioimp,*) 'lisous(/1)=',lisous(/1)
  241.                SOUMAI=CGEOME.LISOUS(ISOUS)
  242.                SEGACT SOUMAI
  243.                SOUMEL=IMACHE(ISOUS)
  244.                SEGACT SOUMEL
  245.                MCHAML=ICHAML(ISOUS)
  246.                N2=IELVAL(/1)
  247. * Normalement, 1 seule composante vu qu'on a reduit le champ dessus
  248.                IF (N2.NE.1) THEN
  249.                   WRITE(IOIMP,*) 'Programming error 4'
  250.                   GOTO 9999
  251.                ENDIF
  252.                IF (TYPCHE(1).NE.'REAL*8') THEN
  253.                   WRITE(IOIMP,*) 'Error : component ',NOMCHE(1)
  254.      $                 ,' not REAL*8 in the MCHAML object'
  255.                   GOTO 9999
  256.                ENDIF
  257. *               write(ioimp,*) 'N1,N2=',N1,N2
  258. *            do i=1,n2
  259. *               write(ioimp,*) 'i,nomche',i,nomche(i)
  260. *            enddo
  261. *            SEGPRT,MYLMOT
  262. *            SEGPRT,MCHAML
  263.                ITQUAF=SOUMAI.ITYPEL
  264.                CALL KEEF(ITQUAF,MYDISC,
  265.      $              MYFALS,
  266.      $              MYLRF,
  267.      $              IMPR,IRET)
  268.                IF (IRET.NE.0) GOTO 9999
  269.                SEGACT MYLRF
  270.                NDDL=MYLRF.NPQUAF(/1)
  271.                NDDL2=SOUMEL.NUM(/1)
  272.                if (NDDL.NE.NDDL2) then 
  273.                   write(ioimp,*) 'Erreur grave dimensions soumel'
  274.                   goto 9999
  275.                endif
  276.                NBEL=SOUMEL.NUM(/2)
  277.                MELVAL=IELVAL(1)
  278.                N1PTEL=VELCHE(/1)
  279.                N1EL=VELCHE(/2)
  280.                IF ((N1PTEL.NE.NDDL.AND.N1PTEL.NE.1).OR.
  281.      $             (N1EL.NE.1.AND.N1EL.NE.NBEL)) THEN
  282.                   write(ioimp,*) 'Erreur grave dimensions MELVAL'
  283.                   write(ioimp,*) 'N1PTEL,NDDL=',N1PTEL,NDDL
  284.                   write(ioimp,*) 'N1EL,NBEL=',N1EL,NBEL
  285.                   GOTO 9999
  286.                ENDIF
  287. * On initialise le MCHEVA a remplir
  288.                NBLIG=1
  289.                NBCOL=NDDL
  290.                N2LIG=1
  291.                N2COL=1
  292.                NBPOI=1
  293.                NBELM=N1EL
  294.                SEGINI MZMCHA
  295. *     Construisons le segment qui permet de parcourir les ddl dans
  296. *     l'ordre croissant des points du quaf
  297. *     Implicitement, on utilise le fait que les maillages LINE et QUAD
  298. *     parcourent les points du QUAF en croissant aussi.             
  299. *     On utilise le tri par insertion car les listes sont petites
  300.                JG=NDDL
  301.                SEGINI MPQUAF
  302.                SEGINI IORDO
  303.                DO IG=1,JG
  304.                   MPQUAF.LECT(IG)=MYLRF.NPQUAF(IG)
  305.                   IORDO.LECT(IG)=IG
  306.                ENDDO
  307.                LCROI=.TRUE.
  308.                CALL ORDO04(MPQUAF.LECT(1),NDDL,LCROI,IORDO.LECT(1))
  309.                SEGDES MYLRF
  310. *
  311. *               DO IDDL=1,NDDL
  312. *                  write(ioimp,*) 'I,NPQUAF,IORDO=',IDDL
  313. *     $                 ,MYLRF.NPQUAF(IDDL),IORDO.LECT(IDDL) 
  314. *               ENDDO
  315. *               SEGPRT,MYLRF
  316. *               SEGPRT,SOUMAI
  317. *               SEGPRT,SOUMEL
  318. *               SEGPRT,IORDO
  319.                DO I1EL=1,N1EL
  320.                   DO IDDL=1,NDDL
  321.                      JDDL=IORDO.LECT(IDDL)
  322. *********** Cette partie est un test que l'on pourrait supprimmer**********           
  323. *                     NNQUA=MYLRF.NPQUAF(JDDL)
  324. *                     NNGLO=SOUMAI.NUM(NNQUA,I1EL)
  325. **                     do 99 jddl=1,nddl
  326. *                     NNGLO2=SOUMEL.NUM(IDDL,I1EL)
  327. **                        if (nnglo2.eq.nnglo) goto 999
  328. **     99                  continue
  329. *                     if (nnglo2.ne.nnglo) then
  330. *                        write(ioimp,*) 'Erreur grave'
  331. *                        write(ioimp,*) 'IDDL,NNQUA,JDDL=',IDDL,NNQUA
  332. *     $                       ,JDDL
  333. *                        write(ioimp,*) 'NNGLO,NNGLO2=',NNGLO,NNGLO2
  334. *                        goto 9999
  335. *                     endif
  336. ** 999                 continue
  337. ****************************************************************************
  338.                      IF (N1PTEL.EQ.1) THEN
  339.                         I1PTEL=1
  340.                      ELSE
  341.                         I1PTEL=IDDL
  342.                      ENDIF
  343.                      MZMCHA.WELCHE(1,JDDL,1,1,1,I1EL)=VELCHE(I1PTEL
  344.      $                    ,I1EL)
  345.                   ENDDO
  346.                ENDDO
  347.                SEGSUP IORDO
  348.                SEGSUP MPQUAF
  349.                SEGDES MZMCHA
  350.                MYMCHA.ICHEVA(ISOUS)=MZMCHA
  351.                SEGDES SOUMEL
  352.                SEGDES SOUMAI
  353.                MYMCHA.JMACHE(ISOUS)=SOUMAI
  354. *               IF (SOUMEL.NE.SOUMAI) SEGSUP SOUMEL
  355.  3          CONTINUE
  356. *        IMPR=6
  357.             IF (IMPR.GT.3) THEN
  358.                CALL PRCAEL(MYMCHA,IMPR,IRET)
  359.                IF (IRET.NE.0) GOTO 9999
  360.             ENDIF
  361. *         IMPR=0 
  362.             SEGDES MYMCHA
  363.             SEGDES CGEOME
  364. *            SEGSUP MELEME
  365.             CALL DTCHAM(MCHELM)
  366.          ELSEIF (TYPCHA.EQ.'CHPOINT ') THEN
  367.             MYCHPO=ICHAM
  368. *
  369. * Transformation du chpoint en un objet MTRAV plus commode
  370. *
  371.             CALL CP2TRA(MYCHPO,
  372.      $           MYMTRA,LVIDE,
  373.      $           IMPR,IRET)
  374.             IF (IRET.NE.0) GOTO 9999
  375. *
  376. * Warning, si aucune valeur du chpoint n'a servi
  377. *
  378. *Pour débugger
  379.             LWARN=.TRUE.
  380. *     LWARN=.FALSE.
  381.             LINIZ=.FALSE.
  382. *
  383. * Segments de repérage dans MTRAV
  384. *
  385.             SEGACT MYMTRA
  386.             JGN=MYMTRA.INCO(/1)
  387.             NNIN=MYMTRA.INCO(/2)
  388.             NNNOE=MYMTRA.IGEO(/1)
  389. *  Création du segment de répérage dans IGEO
  390.             NTOGPO=nbpts
  391.             JG=NTOGPO
  392.             SEGINI,KRIGEO
  393.             CALL RSETEE(MYMTRA.IGEO,NNNOE,
  394.      $           KRIGEO.LECT,NTOGPO,
  395.      $           IMPR,IRET)
  396.             IF (IRET.NE.0) GOTO 9999
  397. *  Création du segment de repérage dans INCO
  398.             SEGACT MYLMOT
  399.             NNMDDL=MYLMOT.MOTS(/2)
  400.             JG=NNMDDL
  401.             SEGINI KRINCO
  402.             CALL CREPE2(JGN,NNMDDL,NNIN,
  403.      $           MYLMOT.MOTS,MYMTRA.INCO,
  404.      $           KRINCO.LECT,
  405.      $           IMPR,IRET)
  406.             IF (IRET.NE.0) GOTO 9999
  407. *
  408. * Création et remplissage du champ par éléments
  409. *
  410.             SEGACT CGEOME
  411.             NSOUS=CGEOME.LISOUS(/1)
  412.             N1=NSOUS
  413.             SEGINI MYMCHA
  414.             DO 1 ISOUS=1,NSOUS
  415.                SOUMAI=CGEOME.LISOUS(ISOUS)
  416.                SEGACT SOUMAI
  417. *            SEGPRT,SOUMAI
  418. * On cherche l'élément fini correspondant au QUAF
  419.                ITQUAF=SOUMAI.ITYPEL
  420.                CALL KEEF(ITQUAF,MYDISC,
  421.      $              MYFALS,
  422.      $              MYLRF,
  423.      $              IMPR,IRET)
  424.                IF (IRET.NE.0) GOTO 9999
  425. *               SEGPRT,MYLRF
  426.                SEGACT MYLRF
  427.                NDDL=MYLRF.NPQUAF(/1)
  428.                NBEL=SOUMAI.NUM(/2)
  429. * On initialise le MCHEVA a remplir
  430.                NBLIG=1
  431.                NBCOL=NDDL
  432.                N2LIG=1
  433.                N2COL=1
  434.                NBPOI=1
  435.                NBELM=NBEL
  436.                SEGINI MZMCHA
  437.                DO IBEL=1,NBEL
  438.                   DO IDDL=1,NDDL
  439.                      NNQUA=MYLRF.NPQUAF(IDDL)
  440.                      NNGLO=SOUMAI.NUM(NNQUA,IBEL)
  441.                      NNLOC=KRIGEO.LECT(NNGLO)
  442.                      NMQUA=MYLRF.NUMCMP(IDDL)
  443.                      NMLOC=KRINCO.LECT(NMQUA)
  444.                      IF (NNLOC.EQ.0.OR.NMLOC.EQ.0) THEN
  445.                         LINIZ=.TRUE.
  446.                         CONTRI=0.D0
  447.                      ELSE
  448.                         LDDLEX=MYMTRA.IBIN(NMLOC,NNLOC).EQ.1
  449.                         IF (.NOT.LDDLEX) THEN
  450.                            LINIZ=.TRUE.
  451.                            CONTRI=0.D0
  452.                         ELSE
  453.                            LWARN=.FALSE.
  454.                            CONTRI=MYMTRA.BB(NMLOC,NNLOC)
  455.                         ENDIF
  456.                      ENDIF
  457.                      MZMCHA.WELCHE(1,IDDL,1,1,1,IBEL)=CONTRI
  458.                   ENDDO
  459.                ENDDO
  460.                SEGDES MZMCHA
  461. *            SEGPRT,MZMCHA
  462.                MYMCHA.ICHEVA(ISOUS)=MZMCHA
  463.                SEGDES MYLRF
  464.                SEGDES SOUMAI
  465.                MYMCHA.JMACHE(ISOUS)=SOUMAI
  466.  1          CONTINUE
  467.             SEGDES MYMCHA
  468.             SEGDES CGEOME
  469.             SEGSUP KRINCO
  470.             SEGDES MYLMOT
  471.             SEGSUP KRIGEO
  472.             SEGSUP MYMTRA
  473. *      IMPR=6
  474.             IF (IMPR.GT.3) THEN
  475.                WRITE(IOIMP,*) 'On a créé',
  476.      $              ' MYMCHA(élément ,1, 1 , 1 ,1, ddl)'
  477.                CALL PRCAEL(MYMCHA,IMPR,IRET)
  478.                IF (IRET.NE.0) GOTO 9999
  479.             ENDIF
  480. *      IMPR=0
  481. *
  482. * Warning
  483. *
  484.             IF (LWARN.AND.(.NOT.LVIDE)) THEN
  485.                WRITE(IOIMP,*) 'Error : no values of the given CHPOINT',
  486.      $              ' were used'
  487.                GOTO 9999
  488.             ENDIF
  489.             IF (LINIZ) THEN
  490.                WRITE(IOIMP,*) 'Error : the given CHPOINT',
  491.      $              ' does not give all the required values'
  492.                GOTO 9999
  493.             ENDIF
  494.          ELSE
  495.             write(ioimp,*) 'TYPCHA=',TYPCHA,' unexpected'
  496.             goto 9999
  497.          ENDIF
  498.       ENDIF
  499. *
  500. * Normal termination
  501. *
  502.       IRET=0
  503.       RETURN
  504. *
  505. * Format handling
  506. *
  507. *
  508. * Error handling
  509. *
  510.  9999 CONTINUE
  511.       IRET=1
  512.       WRITE(IOIMP,*) 'An error was detected in subroutine cp2cv7'
  513.       RETURN
  514. *
  515. * End of subroutine CP2CV7
  516. *
  517.       END
  518.  
  519.  
  520.  
  521.  
  522.  
  523.  
  524.  
  525.  
  526.  
  527.  
  528.  

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