C @(#)tdforlib.for 17.1.1.1 (ES0-DMD) 01/25/02 17:47:14 C=========================================================================== C Copyright (C) 1995 European Southern Observatory (ESO) C C This program is free software; you can redistribute it and/or C modify it under the terms of the GNU General Public License as C published by the Free Software Foundation; either version 2 of C the License, or (at your option) any later version. C C This program is distributed in the hope that it will be useful, C but WITHOUT ANY WARRANTY; without even the implied warranty of C MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the C GNU General Public License for more details. C C You should have received a copy of the GNU General Public C License along with this program; if not, write to the Free C Software Foundation, Inc., 675 Massachusetss Ave, Cambridge, C MA 02139, USA. C C Corresponding concerning ESO-MIDAS should be addressed as follows: C Internet e-mail: midas@eso.org C Postal address: European Southern Observatory C Data Management Division C Karl-Schwarzschild-Strasse 2 C D 85748 Garching bei Muenchen C GERMANY C=========================================================================== C INTEGER FUNCTION FORLOC(SA,SB) C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ C.COPYRIGHT: Copyright (c) 1987 European Southern Observatory, C all rights reserved C C.VERSION: 1.0 ESO-FORTRAN Conversion, AA 19:55 - 11 DEC 1987 C C.LANGUAGE: F77+ESOext C C.AUTHOR: J.D.PONZ C.IDENTIFICATION FORLOC.FOR C.KEYWORDS FORTRAN FUNCTION C.ENVIRONMENT MIDAS C.PURPOSE C Locates a character in a string. C Corresponds to LIB$LOCC in VAX 11 FORTRAN. C C------------------------------------------------------------------ IMPLICIT NONE CHARACTER*(*) SA ! IN : character to be found CHARACTER*(*) SB ! IN : string to be searched C INTEGER N,KLEN,LEN C C ... check string length C FORLOC = 0 KLEN = LEN(SA) IF (KLEN.EQ.0) RETURN KLEN = LEN(SB) IF (KLEN.EQ.0) RETURN C C ... compare each input character with lowercase alphabet C DO 100 N=1,KLEN IF (SA(1:1).EQ.SB(N:N)) THEN FORLOC = N RETURN END IF 100 CONTINUE RETURN END SUBROUTINE FORUPC(SA,SB) C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ C.COPYRIGHT: Copyright (c) 1987 European Southern Observatory, C all rights reserved C C.VERSION: 1.0 ESO-FORTRAN Conversion, AA 19:55 - 11 DEC 1987 C C.LANGUAGE: F77+ESOext C C.AUTHOR: K.BANSE C.IDENTIFICATION FORUPC.FOR C.KEYWORDS FORTRAN FUNCTION C.ENVIRONMENT MIDAS C.PURPOSE C Really converts characters in the input string into uppercase. C The routine corresponds to STR$UPCASE in VAX 11 FORTRAN C C------------------------------------------------------------------ IMPLICIT NONE CHARACTER*(*) SA ! IN : Input string CHARACTER*(*) SB ! OUT : Destination string C INTEGER N,KLEN,LEN,M CHARACTER*26 ALPHU,ALPHL C DATA ALPHU /'ABCDEFGHIJKLMNOPQRSTUVWXYZ'/ DATA ALPHL /'abcdefghijklmnopqrstuvwxyz'/ C KLEN = LEN(SA) C C compare each input character with lowercase alphabet DO 100 N=1,KLEN C SB(N:N) = SA(N:N) DO 50 M=1,26 IF (SA(N:N).EQ.ALPHL(M:M)) SB(N:N) = ALPHU(M:M) 50 CONTINUE C 100 CONTINUE C RETURN END INTEGER FUNCTION FORSKP(SA,SB) C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ C.COPYRIGHT: Copyright (c) 1987 European Southern Observatory, C all rights reserved C C.VERSION: 1.0 ESO-FORTRAN Conversion, AA 19:55 - 11 DEC 1987 C C.LANGUAGE: F77+ESOext C C.AUTHOR: J.D.PONZ C.IDENTIFICATION FORSKP.FOR C.KEYWORDS FORTRAN FUNCTION C.ENVIRONMENT MIDAS C.PURPOSE C Compares a string with a given character and returns the C relative position of the first nonequal character as an index. C The character is compared until and inequality is found or C the string is exhausted. The relative position of the C unequal character or zero is returned. C If the source string has a zero length, then zero is returned. C Corresponds to LIB$SKPC in VAX 11 FORTRAN. C C------------------------------------------------------------------ IMPLICIT NONE CHARACTER*(*) SA ! IN : character to be found CHARACTER*(*) SB ! IN : string to be searched C INTEGER N,KLEN,LEN C C ... check string length C FORSKP = 0 KLEN = LEN(SA) IF (KLEN.EQ.0) RETURN KLEN = LEN(SB) IF (KLEN.EQ.0) RETURN C C ... compare each input character with lowercase alphabet C DO 100 N=1,KLEN IF (SA(1:1).NE.SB(N:N)) THEN FORSKP = N RETURN END IF 100 CONTINUE RETURN END