C @(#)util.for	17.1.1.1 (ESO-DMD) 01/25/02 17:40:36
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 Correspondence 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 
      SUBROUTINE UPCAS(SA,SB)
C 
      IMPLICIT NONE
C
      INTEGER   M,N,KLEN,MLEN
C
      CHARACTER*(*)   SA,SB
      CHARACTER*27    ALPHU,ALPHL
C
      DATA   ALPHU  /' ABCDEFGHIJKLMNOPQRSTUVWXYZ'/
      DATA   ALPHL  /' abcdefghijklmnopqrstuvwxyz'/
C
      KLEN = LEN(SA)
      MLEN = LEN(SB)
      IF (KLEN.GT.MLEN) KLEN = MLEN
C
C  compare each input character with lowercase alphabet
      DO 100 N=1,KLEN
C
         DO 50 M=1,27
            IF (SA(N:N).EQ.ALPHL(M:M)) THEN
               SB(N:N) = ALPHU(M:M)
               GOTO 100
            ENDIF
50       CONTINUE
C 
         SB(N:N) = SA(N:N)
C
100   CONTINUE
C
      RETURN
      END

      SUBROUTINE LOWCAS(SA,SB)
C 
      IMPLICIT NONE
C
      INTEGER   M,N,KLEN,MLEN
C
      CHARACTER*(*)   SA,SB
      CHARACTER*27    ALPHU,ALPHL
C
      DATA   ALPHU  /' ABCDEFGHIJKLMNOPQRSTUVWXYZ'/
      DATA   ALPHL  /' abcdefghijklmnopqrstuvwxyz'/
C
      KLEN = LEN(SA)
      MLEN = LEN(SB)
      IF (KLEN.GT.MLEN) KLEN = MLEN
C
C  compare each input character with lowercase alphabet
      DO 100 N=1,KLEN
C
         DO 50 M=1,27
            IF (SA(N:N).EQ.ALPHU(M:M)) THEN
               SB(N:N) = ALPHL(M:M)
               GOTO 100
            ENDIF
50       CONTINUE
C 
         SB(N:N) = SA(N:N)
C
100   CONTINUE
C
      RETURN
      END

      SUBROUTINE BLANKO(STRING)
C
      INTEGER   N
C
      CHARACTER*(*)  STRING
C
      N = 2
C
200   IF (STRING(N:N).EQ.']') RETURN
C
      IF (STRING(N:N).EQ.' ') THEN
         STRING(N:) = STRING(N+1:)//' '
         GOTO 200
      ENDIF
C
      N = N + 1
      GOTO 200
C
      END

      SUBROUTINE BLANKI(STRING)
C
      INTEGER   N,M,K,KK
C
      CHARACTER*(*)  STRING
      CHARACTER*1    CC
C
      M = LEN(STRING)
      K = 1
C
      DO 100, N=1,M                      !get rid of leading blanks
         IF (STRING(N:N).NE.' ') THEN
            K = N
            GOTO 200
         ENDIF
100   CONTINUE
      RETURN                             !blank string
C
200   IF (K.GT.1) THEN
         STRING(1:) = STRING(K:)//' '
         M = M - K - 1
      ENDIF
C
220   DO 400, N=1,M
         IF (STRING(N:N).EQ.' ') THEN
            CC = STRING(N-1:N-1)
            IF ((CC.EQ. '(') .OR. (CC.EQ.'[')) THEN
               KK = N - 1
            ELSE
               KK = N
            ENDIF
            K = N
300         K = K + 1
            IF (K.GT.M) RETURN
C 
            IF (STRING(K:K) .EQ. ' ') THEN
               GOTO 300
            ELSE IF (K.GT.KK+1) THEN
               STRING(KK+1:) = STRING(K:)//' '
               M = M - (K-KK-1)
               GOTO 220                           !start afresh
            ENDIF
         ENDIF
400   CONTINUE
      RETURN                             !blank string
C 

      END

      SUBROUTINE GROWIT(ACT,NPIXA,A,NPIXB,B,LINNO)
C
C
      IMPLICIT NONE
C
      INTEGER     NPIXA(2),NPIXB(2),LINNO
      INTEGER     I,J,INOFF,OUTOFF,KIN,KOUT
C
      REAL        A(*),B(*)
C
      CHARACTER   ACT*1
C
      INOFF = (LINNO - 1) * NPIXA(1)
      OUTOFF = 0
C
      IF (ACT.EQ.'L') THEN
         DO 50, I=1,NPIXB(2)
            DO 10, J=1,NPIXB(1)
               KOUT = OUTOFF + J
               KIN = INOFF + J
               B(KOUT) = A(KIN)
10          CONTINUE
C
            OUTOFF = OUTOFF + NPIXB(1)
50       CONTINUE
C
      ELSE
         DO 150, I=1,NPIXB(2)
            KIN = INOFF + I
            DO 110, J=1,NPIXB(1)
               KOUT = OUTOFF + J
               B(KOUT) = A(KIN)
110         CONTINUE
C
            OUTOFF = OUTOFF + NPIXB(1)
150      CONTINUE
      ENDIF
C
      RETURN
      END