[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]Author Index][Subject Index]

Re: MIDAS TABLE's



On Wed, Sep 09, 1998 at 05:50:08PM +0200, Holger Rendelmann wrote:
> Hello All,
> 
> I have a problem:
> 
> How can I convert a midas-table in an ASCII formatet table ????

i guess , this would exist in the midas package?
but i wrote such a weak program a long time ago... here below
hope this helps

---------------cut--------------

       PROGRAM CONVTAB

C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C                CENTRE D'OCEANOLOGIE DE MARSEILLE URA 41 CNRS
C AUTEUR  : M. LIBES
C DATE    : 07/08/92
C VERSION : 1.0
C OBJET   : ROUTINES DE CONVERSIONS DE TABLE
C                TABLE MIDAS .TBL --> FICHIER ASCII
C ROUTINES APPELLEES :
C 
C----------------------------------------------------------------
C
      IMPLICIT NONE 
C
      INTEGER   TAB_ID,
     +          TABCOL, TABROW, TABNSC, TABACOL, TABAROW, 
     +          NOELMI,NOELMF, KUN(1), KNULL, ISTAT
      INTEGER   COL(1024)  
C
      CHARACTER TAB_IN*40, FIC*40
      LOGICAL   NULL(1024)  
C
      INCLUDE 'MID_INCLUDE:ST_DEF.INC'
      COMMON  /VMR/MADRID
      INCLUDE 'MID_INCLUDE:ST_DAT.INC'
C
C
C
      CALL STSPRO('CONVTAB')            
C
      CALL STKRDC('IN_A',1,1,40,                   !!TABLE D'ENTREE A CONVERTIR
     +             NOELMI,TAB_IN,KUN,KNULL,ISTAT) 
C
      CALL STKRDC('FILEOUT',1,1,40,                 !!FICHIER ASCII DE SORTIE
     +             NOELMF,FIC,KUN,KNULL,ISTAT) 
      TYPE *,'--> conversion de la table ',TAB_IN(1:NOELMF),
     +            ' en fichier ',FIC(1:NOELMI)
C
      CALL TBTOPN (TAB_IN, F_I_MODE, TAB_ID, ISTAT )
C
      CALL TBIGET (TAB_ID,                                           !!IN
     +             TABCOL, TABROW, TABNSC, TABACOL, TABAROW, ISTAT ) !!OUT
      TYPE *, '--> Nb lignes : ',TABROW,' -- Nb colonnes : ',TABCOL
C
      CALL TAB_TO_FIC (TAB_ID, TABROW, TABCOL, FIC, COL,NULL )
C
      CALL TBTCLO(TAB_ID,ISTAT)
      CALL STSEPI
C
      END
C
C----------------------------------------------------------------------------
      SUBROUTINE TAB_TO_FIC (TIDNT, NL,NPL, FIC,COL,NULL )
C
      IMPLICIT NONE
C
      INTEGER        NPL,NL,TIDNT,ISTAT,I
      INTEGER        COL(NPL)
      CHARACTER*(*)  FIC
      REAL           VALEUR(NPL)
      LOGICAL        NULL(NPL)
C
      DO I=1,NPL
        COL(I)=I
      ENDDO
      LUN=10
      OPEN (LUN, FILE=FIC,FORM='FORMATTED',STATUS='UNKNOWN',IOSTAT=IOS)
      IF (IOS .NE. 0) THEN
           TYPE *,'--> ERREUR A L''OUVERTURE DU FICHIER ',IOS
           CALL EXIT
      ENDIF

C
      DO I=1,NL        !POUR TOUTES LES LIGNES
C
            CALL TBRRDR (TIDNT, I, NPL,COL(1),VALEUR,NULL,ISTAT)
C           WRITE (LUN,'(<NPL>F10.3)') (VALEUR(II),II=1,NPL)
            WRITE (LUN,'(<NPL>E12.4)') (VALEUR(II),II=1,NPL)
C
      ENDDO   
C
      CLOSE(LUN)
C
      RETURN
      END
---------------cut--------------
> 
> Regards to all,
> 
> Holger Rendelmann
> 
> --
> *******************************************************************
> * Holger Rendelmann   VdS CCD Working Group / Comet Working Group *
> *                                                                 *
> *           eMail : Holger.Rendelmann@t-online.de                 *
> *                  Phone/Fax : 49 5171 54725                      *
> *      Address: D-31241 Ilsede    Street: Breite-Strasse 20       *
> *                                                                 *
> *                    N52015'56"  E10012'44"                       *
> *******************************************************************
> 
>