← Back to branch summary

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

« back to all changes in this revision

Viewing changes to prim/general/libsrc/yf2cgen-2.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:
prim/general/libsrc/yf2cgen-2.for
 
1
C===========================================================================
 
2
C Copyright (C) 1995-2010 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 ++++++++++++++++++++++++  YF2CGEN.FOR +++++++++++++++++++++++++++++++++++++++
 
29
C .LANGUAGE Fortran 77
 
30
C .IDENTIFICATION Module YF2CGEN.FOR
 
31
C .COMMENTS
 
32
C Module contains layer between the keyword related FORTRAN STxxxx interfaces
 
33
C and the SC_interfaces written in (hopefully independent) C
 
34
C .AUTHOR         K. Banse        ESO - Garching
 
35
C .KEYWORDS       standard interfaces.
 
36
C .ENVIRONMENT    FORTRAN and C standards
 
37
C .VERSION  [1.00] 871207:  created from SXFTOC.C
 
38
C
 
39
C 100209        last modif
 
40
C ......................................................
 
41
C
 
42
 
 
43
      SUBROUTINE COPWND(PNTRA,NPIXA,PNTRB,NPIXB,BGNA,BGNB,ENDA)
 
44
C
 
45
      IMPLICIT NONE
 
46
C
 
47
      REAL   PNTRA(*), PNTRB(*)
 
48
      INTEGER  NPIXA,NPIXB,BGNA,BGNB,ENDA
 
49
C 
 
50
      CALL YY1(NPIXA,NPIXB,BGNA,BGNB)
 
51
      CALL YY2(PNTRA,PNTRB,ENDA)
 
52
C
 
53
      RETURN
 
54
      END
 
55
C
 
56
      SUBROUTINE COPYF1(PNTRA,NPIXA,BGNA,DIMWA,PNTRB,NPIXB,BGNB)
 
57
C
 
58
      IMPLICIT NONE
 
59
C
 
60
      REAL   PNTRA(*), PNTRB(*)
 
61
      INTEGER  NPIXA,NPIXB,BGNA,BGNB,DIMWA
 
62
C
 
63
      CALL YY1(NPIXA,NPIXB,BGNA,BGNB)
 
64
      CALL YY3(PNTRA,DIMWA,PNTRB)
 
65
C
 
66
      RETURN
 
67
      END
 
68
C
 
69
      SUBROUTINE JMAGN(JMETH, ARR, NX, NY, NI, NB, FAC, XC, YC,
 
70
     +                 MAG, DMAG, SKY, DSKY, NRPIX, FLUX, STAT )
 
71
C
 
72
      IMPLICIT NONE
 
73
C
 
74
      REAL   ARR(*), FAC, XC, YC, MAG, DMAG, SKY, DSKY
 
75
      REAL   NRPIX, FLUX
 
76
      INTEGER  JMETH, NX, NY, NI, NB, STAT
 
77
      CALL YY1(JMETH,NI,NB,0)
 
78
      CALL YY1a(NX, NY,XC, YC)
 
79
      CALL YY1b(MAG,DMAG,SKY,DSKY)
 
80
      CALL YY4(ARR,FAC,NRPIX,FLUX,STAT)
 
81
C
 
82
      RETURN
 
83
      END
 
84
C
 
85
 
 
86
      SUBROUTINE STACEN(P_IMG,DIMX,DIMY,METH,IMAGE,XOUT,YOUT,XERR,YERR,
 
87
     +             XSIG,YSIG,XYVAL,STAT)
 
88
C
 
89
      IMPLICIT NONE
 
90
C
 
91
      CHARACTER*(*) METH
 
92
      REAL   P_IMG(*), XOUT,YOUT,XERR,YERR,XSIG,YSIG, XYVAL
 
93
      INTEGER  DIMX, DIMY, IMAGE(*), STAT
 
94
C
 
95
      CALL STSTR(1,METH)
 
96
C 
 
97
      CALL YY1a(DIMX,DIMY,0.,0.)
 
98
      CALL YY1b(XOUT,YOUT,XERR,YERR)
 
99
      CALL YY1c(XSIG,YSIG,XYVAL)
 
100
      CALL YY5(P_IMG,IMAGE,STAT)
 
101
 
 
102
C
 
103
      RETURN
 
104
      END
 
105
C
 
106
 
 
107
      SUBROUTINE PIXLIN(XA,YA,XB,YB,STEP,XINDX,YINDX,LIMIT,NINDX)
 
108
C
 
109
      IMPLICIT NONE
 
110
C
 
111
      REAL   XA,YA,XB,YB,STEP,XINDX,YINDX
 
112
      INTEGER  LIMIT, NINDX
 
113
C
 
114
      CALL YY1b(XA,YA,XB,YB)
 
115
      CALL YY6(STEP,XINDX,YINDX,LIMIT,NINDX)
 
116
C
 
117
      RETURN
 
118
      END
 
119
C
 
120
      SUBROUTINE ZIMA(P_IN,NPIX,XINDX,YINDX,NDIM,P_OUT,FMIN,FMAX)
 
121
C
 
122
      IMPLICIT NONE
 
123
C
 
124
      REAL   P_IN(*),P_OUT(*)
 
125
      REAL   XINDX,YINDX,FMIN,FMAX
 
126
      INTEGER  NPIX(*), NDIM
 
127
C
 
128
      CALL YY1b(XINDX,YINDX,FMIN,FMAX)
 
129
      CALL YY7(P_IN,NPIX,NDIM,P_OUT)
 
130
C
 
131
      RETURN
 
132
      END
 
133
C
 
134
      SUBROUTINE DATFIL(INFILE,DATTYP,TOTAL,A,B,MINFLG,FMIN,FMAX)
 
135
C
 
136
      IMPLICIT NONE
 
137
C
 
138
      CHARACTER*(*) INFILE
 
139
      REAL   A(*),B(*)
 
140
      REAL   FMIN,FMAX
 
141
      INTEGER  DATTYP,TOTAL,MINFLG
 
142
C
 
143
      CALL STSTR(1,INFILE)
 
144
C 
 
145
      CALL YY1(DATTYP,TOTAL,MINFLG,0)
 
146
      CALL YY8(INFILE,A,B,FMIN,FMAX)
 
147
C
 
148
      RETURN
 
149
      END
 
150
 
 
151
      SUBROUTINE W1FORM(FORM,FLAG,IVA,RVA,DVA,OUTSTR)
 
152
C
 
153
      CHARACTER*(*) FORM, OUTSTR
 
154
      INTEGER  FLAG,IVA
 
155
      REAL RVA
 
156
      DOUBLE PRECISION DVA
 
157
C
 
158
      CALL STSTR(1,FORM)
 
159
      CALL STLOC(1,1,OUTSTR)                              !blank CHAR_LOC
 
160
C 
 
161
      CALL YY14(FLAG,IVA,RVA,DVA)
 
162
C
 
163
      RETURN
 
164
      END
 
165
 
 
166
 
 
167
 
 
168
      SUBROUTINE FRAMOU( FRAME )
 
169
C 
 
170
      CHARACTER*(*) FRAME
 
171
      INTEGER  IDUM
 
172
C
 
173
      CALL STSTR(1,FRAME)
 
174
      CALL YY9(IDUM)
 
175
C
 
176
      RETURN
 
177
      END
 
178
 
 
179
      SUBROUTINE OPNTAB( TABLE, TID, NCOLS, NROWS, STAT )
 
180
C
 
181
      IMPLICIT NONE
 
182
C
 
183
      CHARACTER*(*) TABLE
 
184
      INTEGER  TID, NCOLS, NROWS, STAT
 
185
C
 
186
      CALL STSTR(1,TABLE)
 
187
      CALL YY10(TID, NCOLS, NROWS, STAT)
 
188
C
 
189
      RETURN
 
190
      END
 
191
 
 
192
      SUBROUTINE BLDLUT(TABLE,RLUT,STAT)
 
193
C 
 
194
      IMPLICIT NONE
 
195
C
 
196
      CHARACTER*(*) TABLE
 
197
      INTEGER  STAT
 
198
      REAL   RLUT(*)
 
199
C
 
200
      CALL STSTR(1,TABLE)
 
201
      CALL YY11(RLUT,STAT)
 
202
C
 
203
      RETURN
 
204
      END
 
205
 
 
206
      SUBROUTINE BLDITT( TABLE, RITT, STAT )
 
207
C 
 
208
      IMPLICIT NONE
 
209
C
 
210
      CHARACTER*(*) TABLE
 
211
      INTEGER  STAT
 
212
      REAL   RITT(*)
 
213
C
 
214
      CALL STSTR(1,TABLE)
 
215
C
 
216
      CALL YY12(RITT,STAT)
 
217
C
 
218
      RETURN
 
219
      END
 
220
 
 
221
      SUBROUTINE TCOLIM(TABLE,COLUMN,COLNO,STAT)
 
222
C
 
223
      IMPLICIT NONE
 
224
C
 
225
      CHARACTER*(*) TABLE
 
226
      CHARACTER*(*)  COLUMN
 
227
      INTEGER  COLNO, STAT
 
228
C
 
229
      CALL STSTR(1,TABLE)
 
230
      CALL STSTR(2,COLUMN)
 
231
C
 
232
      CALL YY13(COLNO,STAT)
 
233
C
 
234
      RETURN
 
235
      END
 
236
 
 
237
 
 
238
      SUBROUTINE CLNFRA(INFILE,OUTFILE,OPTIO)
 
239
C
 
240
      IMPLICIT NONE
 
241
C
 
242
      CHARACTER*(*) INFILE, OUTFILE
 
243
C 
 
244
      INTEGER  OPTIO
 
245
C
 
246
      CALL STSTR(1,INFILE)
 
247
      CALL STLOC(1,1,OUTFILE)                              !blank CHAR_LOC
 
248
C 
 
249
      CALL YYA1(1,OPTIO)
 
250
C
 
251
      RETURN
 
252
      END
 
253
 
 
254
 
 
255
 
 
256
      SUBROUTINE CLNTAB(INFILE,OUTFILE,OPTIO)
 
257
C
 
258
      IMPLICIT NONE
 
259
C
 
260
      CHARACTER*(*) INFILE, OUTFILE
 
261
C
 
262
      INTEGER  OPTIO
 
263
C
 
264
      CALL STSTR(1,INFILE)
 
265
      CALL STLOC(1,1,OUTFILE)
 
266
C
 
267
      CALL YYA1(3,OPTIO)
 
268
C
 
269
      RETURN
 
270
      END
 
271
 
 
272
 
 
273
 
 
274
      SUBROUTINE CLNFIT(INFILE,OUTFILE,OPTIO)
 
275
C
 
276
      IMPLICIT NONE
 
277
C
 
278
      CHARACTER*(*) INFILE, OUTFILE
 
279
C
 
280
      INTEGER  OPTIO
 
281
C
 
282
      CALL STSTR(1,INFILE)
 
283
      CALL STLOC(1,1,OUTFILE)
 
284
C
 
285
      CALL YYA1(4,OPTIO)
 
286
C
 
287
      RETURN
 
288
      END
 
289
 
 
290
 
 
291