[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" *
> *******************************************************************
>
>
- References:
- MIDAS TABLE's
- From: Holger.Rendelmann@t-online.de (Holger Rendelmann)