C @(#)tdname.for 17.1.1.1 (ES0-DMD) 01/25/02 17:47:15 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 C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ C.COPYRIGHT: Copyright (c) 1987 European Southern Observatory, C all rights reserved C C.VERSION: 1.0 ESO-FORTRAN Conversion, AA 17:58 - 11 DEC 1987 C C.LANGUAGE: F77+ESOext C C.AUTHOR: J.D.PONZ C.IDENTIFICATION TDNAME.FOR C.KEYWORDS TABLE, APPLICATIONS C.ENVIRONMENT MIDAS C.PURPOSE C Transfroms the short name (optionally without file type), C into the long name with type appended C C C------------------------------------------------------------------ SUBROUTINE TDNAME(INNAME,TYPE,OUTNAM) IMPLICIT NONE CHARACTER*(*) INNAME ! IN : short name CHARACTER*(*) TYPE ! IN : file type CHARACTER*(*) OUTNAM ! OUT : long name C CHARACTER*80 SDUM C INTEGER I1,I2,I3 C C ... search for end of name C SDUM = INNAME//' ' I1 = INDEX(SDUM,' ') - 1 C C ... search for VMS directory path C I2 = INDEX(INNAME(1:I1),']') C C ... search for filename type C I3 = INDEX(INNAME(I2+1:I1),'.') C C ... append file type if required C IF (I3.EQ.0) THEN OUTNAM = INNAME(1:I1)//'.'//TYPE ELSE OUTNAM = INNAME END IF RETURN END