← Back to branch summary

~ubuntu-branches/debian/jessie/eso-midas/jessie

« back to all changes in this revision

Viewing changes to libsrc/ftoc-new/ytbd.for

  • Committer: Package Import Robot
  • Author(s): Ole Streicher
  • Date: 2014-04-22 14:44:58 UTC
  • Revision ID: package-import@ubuntu.com-20140422144458-okiwi1assxkkiz39
Tags: upstream-13.09pl1.2+dfsg
Import upstream version 13.09pl1.2+dfsg

Show diffs side-by-side

added added

removed removed

Lines of Context:
libsrc/ftoc-new/ytbd.for
 
1
C===========================================================================
 
2
C Copyright (C) 1995-2006 European Southern Observatory (ESO)
 
3
C
 
4
C This program is free software; you can redistribute it and/or 
 
5
C modify it under the terms of the GNU General Public License as 
 
6
C published by the Free Software Foundation; either version 2 of 
 
7
C the License, or (at your option) any later version.
 
8
C
 
9
C This program is distributed in the hope that it will be useful,
 
10
C but WITHOUT ANY WARRANTY; without even the implied warranty of
 
11
C MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 
12
C GNU General Public License for more details.
 
13
C
 
14
C You should have received a copy of the GNU General Public 
 
15
C License along with this program; if not, write to the Free 
 
16
C Software Foundation, Inc., 675 Massachusetts Ave, Cambridge, 
 
17
C MA 02139, USA.
 
18
C
 
19
C Correspondence concerning ESO-MIDAS should be addressed as follows:
 
20
C       Internet e-mail: midas@eso.org
 
21
C       Postal address: European Southern Observatory
 
22
C                       Data Management Division 
 
23
C                       Karl-Schwarzschild-Strasse 2
 
24
C                       D 85748 Garching bei Muenchen 
 
25
C                       GERMANY
 
26
C===========================================================================
 
27
 
 
28
C ++++++++++++++++++++++++  TBD.FOR +++++++++++++++++++++++++++++++++++++++
 
29
C .LANGUAGE Fortran 77
 
30
C .IDENTIFICATION Module TBD.FOR
 
31
C  AUTHOR         K. Banse
 
32
C  Module contains layer between the table related FORTRAN TBxxxx interfaces
 
33
C  and the TC_interfaces written in (hopefully independent) C
 
34
C .KEYWORDS       standard interfaces.
 
35
C .ENVIRONMENT    FORTRAN and C standards
 
36
C .VERSION  [1.00] 871207:  created from SXFTOC.C
 
37
C 
 
38
C 060328        last modif
 
39
C 
 
40
C -----------------------------------------------------------------------------
 
41
C
 
42
      SUBROUTINE TBFGET(TID,COLUMN,FORM,LEN,DTYPE,STATUS)
 
43
C
 
44
      IMPLICIT NONE
 
45
C
 
46
      CHARACTER*(*)   FORM
 
47
      INTEGER     TID, COLUMN, LEN, DTYPE
 
48
      INTEGER     STATUS
 
49
C 
 
50
      CALL STLOC(1,1,FORM)                      !blanked CHAR_LOC
 
51
C 
 
52
      CALL TBF1(TID, COLUMN, LEN, DTYPE, STATUS)
 
53
C
 
54
      RETURN
 
55
      END
 
56
C 
 
57
      SUBROUTINE TBFPUT(TID,COLUMN,FORM,STATUS)
 
58
C
 
59
      IMPLICIT NONE
 
60
C
 
61
      CHARACTER*(*)   FORM
 
62
      INTEGER     TID, COLUMN
 
63
      INTEGER     STATUS
 
64
C
 
65
      CALL STSTR(1,FORM)                        !STRIPPED_STRING
 
66
C
 
67
      CALL TBF2(TID, COLUMN, STATUS)
 
68
C
 
69
      RETURN
 
70
      END
 
71
C 
 
72
C 
 
73
      SUBROUTINE TBLGET(TID, COL, LABEL, STATUS)
 
74
C
 
75
      IMPLICIT NONE
 
76
C
 
77
      CHARACTER*(*)   LABEL
 
78
      INTEGER     TID, COL 
 
79
      INTEGER     STATUS
 
80
C
 
81
      CALL STLOC(1,1,LABEL)                      !blanked CHAR_LOC
 
82
C 
 
83
      CALL TBL1(TID, COL, STATUS)
 
84
C
 
85
      RETURN
 
86
      END
 
87
 
 
88
C
 
89
C
 
90
      SUBROUTINE TBLPUT(TID, COL, LABEL, STATUS)
 
91
C
 
92
      IMPLICIT NONE
 
93
C
 
94
      CHARACTER*(*)   LABEL
 
95
      INTEGER     TID, COL
 
96
      INTEGER     STATUS
 
97
C
 
98
      CALL STSTR(1,LABEL)                        !STRIPPED_STRING
 
99
C
 
100
      CALL TBL2(TID, COL, STATUS)
 
101
C
 
102
      RETURN
 
103
      END
 
104
C 
 
105
C 
 
106
      SUBROUTINE TBLSER(TID, LABEL, COL,STATUS)
 
107
C
 
108
      IMPLICIT NONE
 
109
C
 
110
      CHARACTER*(*)   LABEL
 
111
      INTEGER     TID, COL
 
112
      INTEGER     STATUS
 
113
C
 
114
      CALL STSTR(1,LABEL)                        !STRIPPED_STRING
 
115
C 
 
116
      CALL TBL3(TID, COL, STATUS)
 
117
C
 
118
      RETURN
 
119
      END
 
120
C
 
121
C
 
122
      SUBROUTINE TBUGET(TID,COL,TUNIT,STATUS)
 
123
C
 
124
      IMPLICIT NONE
 
125
C
 
126
      CHARACTER*(*)   TUNIT
 
127
      INTEGER     TID, COL
 
128
      INTEGER     STATUS
 
129
C
 
130
      CALL STLOC(1,1,TUNIT)                      !blanked CHAR_LOC
 
131
C
 
132
      CALL TBU1(TID,COL,STATUS)
 
133
C
 
134
      RETURN
 
135
      END
 
136
C
 
137
C
 
138
      SUBROUTINE TBUPUT(TID,COL,TUNIT,STATUS)
 
139
C
 
140
      IMPLICIT NONE
 
141
C
 
142
      CHARACTER*(*)   TUNIT
 
143
      INTEGER     TID, COL
 
144
      INTEGER     STATUS
 
145
C
 
146
      CALL STSTR(1,TUNIT)                        !STRIPPED_STRING
 
147
C
 
148
      CALL TBU2(TID,COL,STATUS)
 
149
C
 
150
      RETURN
 
151
      END
 
152
 
 
153
 
 
154