C @(#)usrinp.for	19.1 (ES0-DMD) 02/25/03 13:30:49
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
      SUBROUTINE USRINP(A,N,TYPE,CHARST)                                        
C+++                                                                            
C.PURPOSE:  Decode a character string into integer or real array
C.AUTHOR:   J.P. Terlouw, Kapteynlab, Groningen
C.COMMENTS: none
C.VERSION:  ?????? RHW implementation
C.VERSION:  910115 RHW IMPLICIT NONE added
C---  
      IMPLICIT     NONE
      INTEGER      NR8
      PARAMETER    (NR8=512)                                           
      REAL         A(NR8)	
      INTEGER      N
      CHARACTER    TYPE
      CHARACTER    CHARST(72)
                                                                          
      INTEGER      MAXLP
      PARAMETER    (MAXLP=10)
C
      INTEGER      IREAL, ILOOP
      INTEGER      I, II
      INTEGER      IPOS, ITYPE
      INTEGER      IA, IIN                                                      
      INTEGER      NREAL
      INTEGER      NI, NLOOP
      INTEGER      NCH, NREST
      INTEGER      NWORD, INSERT
      INTEGER      DOLOOP(2,MAXLP)
      INTEGER      NEL
      REAL         AA
      REAL         B8(NR8)
      REAL         INCR
      REAL         LOW                                      
      REAL         RA                                                    
      REAL         UPP
      LOGICAL      LOOP,SEP,ERR                                                 
      CHARACTER    B1(72)                                            
      CHARACTER    ATYPE(2),LPSYM                                          
      EXTERNAL     NEL	
C                                                                               
      EQUIVALENCE  (RA,IA,AA)                                                   
      DATA         ATYPE/'R','I'/                                               
C
C ***
      ERR    = .FALSE.               ! error in do-loop                         
      LPSYM  = ':'                   ! loop symbol                              
      NI     = 0                     ! initial number of used words for array   
      IPOS   = 0                     ! starting for array pointer               
      ITYPE  = 1                     ! default type is real                     
                                                                                
      DO 10 I = 1,72                                                            
         B1(I)  = ' '                                                           
   10 CONTINUE                                                                  
      CALL ALPHA(CHARST,72,NCH,NREST)                                           
                                                                                
      DO 20 II = 1,NCH                                                          
         B1(II) = CHARST(II)                                                    
   20 CONTINUE                                                                  
                                                                                
      DO 30 I = 1,2                                                             
         IF (TYPE.EQ.ATYPE(I)) THEN                                 ! what type?
            ITYPE  = I                                                          
         END IF                                                                 
   30 CONTINUE                                                                  
C                                                                               
C *** GET INPUT PARAMETERS IF PRESENT                                           
C                                                                               
      IF (NCH.NE.0) THEN                                                        
         ERR    = .FALSE.                                     ! reset error flag
         NLOOP  = 0                                                             
         IF ((ITYPE.EQ.1) .OR. (ITYPE.EQ.3)) THEN                  ! decode loop
            DO 40 I = 1,MAXLP                                                   
               DOLOOP(1,I) = 0                                                  
               DOLOOP(2,I) = 0                                                  
   40       CONTINUE                                                            
            NLOOP  = 1                                                          
            NWORD  = 1                              ! startword of do-loop in b1
            INSERT = 0                                                          
            LOOP   = .FALSE.                                                    
            SEP    = .TRUE.                                                     
            DO 50 I = 1,NCH                                                     
               IF (B1(I).EQ.LPSYM) THEN                                         
                  IF (B1(I-1).EQ.' ' .OR. B1(I+1).EQ.' ') THEN      ! bad syntax
                     ERR    = .TRUE.                                            
                     GO TO 60                                                   
                  END IF                                                        
                  IF (DOLOOP(2,NLOOP).EQ.1) THEN                                
                     DOLOOP(2,NLOOP) = 2               ! increment value present
                     INSERT = INSERT + 1                                        
                                                                                
                  ELSE IF (DOLOOP(2,NLOOP).EQ.2) THEN                           
                     ERR    = .TRUE.             ! error in do-loop input string
                     NCH    = 0                                                 
                     GO TO 60                                     ! back to inpu
                  ELSE                                     ! upper value present
                     DOLOOP(1,NLOOP) = NWORD + INSERT                           
                     DOLOOP(2,NLOOP) = 1                                        
                     INSERT = INSERT + 1                                        
                  END IF                                                        
                                                                                
                  LOOP   = .TRUE.                                               
                  B1(I)  = ','                                                  
                                                                                
               ELSE                                                             
                  IF (B1(I).EQ.' ' .OR. B1(I).EQ.',') THEN        ! sep. symbols
                                                                                
                     IF ( .NOT. SEP) THEN                                       
                        NWORD  = NWORD + 1                                      
                        SEP    = .TRUE.                                         
                     END IF                                                     
C                                                                               
                     IF (LOOP) THEN                                             
                        NLOOP  = NLOOP + 1                                      
                        LOOP   = .FALSE.                                        
                     END IF                                                     
                                                                                
                  ELSE                                                          
                     SEP    = .FALSE.                                           
                  END IF                                                        
               END IF                                                           
   50       CONTINUE                                                            
C                                                                               
   60       CONTINUE                                                            
            IF ((.NOT.LOOP) .AND. (.NOT.ERR)) THEN                              
               NLOOP  = NLOOP - 1                                               
            END IF                                                              
         END IF                                                                 
      END IF                                                                    
C                                                                               
      IF ((NCH.GT.0) .AND. (.NOT.ERR)) THEN    ! decode input into real or char.
         CALL DECUSR(B1,NCH,B8,NR8)           ! decodes input array into b8(nr8)
         NI     = NEL(B8,NR8)         ! actual number of words (=array elements)
      END IF                                                                    
C                                                                               
C  *** CONSTRUCT THE OUTPUT ARRAY ************************************          
C                                                                               
      IPOS   = 0   ! position in a                                              
      ILOOP  = 1   ! next loop (if present)                                     
      IIN    = 0   ! position in b8                                             
                                                                                
      IF (NI.GT.0) THEN                                                         
   70    CONTINUE                                                               
         IIN    = IIN + 1                                                       
         RA     = B8(IIN)                                                       
         IF (ITYPE.EQ.3) THEN                          ! real+integer conversion
            IA     = NINT(RA)                                                   
         END IF                                                                 
         IF (IPOS+1.LE.N) THEN                ! conversion if ipos+1<# array el.
            A(IPOS+1) = RA                                                      
         END IF                                                                 
         IPOS   = IPOS + 1                            ! increase position by one
                                                                                
         IF (IIN.EQ.DOLOOP(1,ILOOP)) THEN                                       
            LOW    = B8(IIN)                                                    
            IIN    = IIN + 1                                                    
            UPP    = B8(IIN)                                                    
            IF (DOLOOP(2,ILOOP).EQ.1) THEN              ! no increment was given
               INCR   = 1.                                                      
            ELSE                                                                
               IIN    = IIN + 1                                                 
               INCR   = B8(IIN)                                                 
            END IF                                                              
            AA     = ((UPP-LOW)/INCR)              ! # of reals to be added in A
            NREAL  = ANINT(AA)                                                  
                                                                                
            IF (NREAL.GT.0) THEN                                                
               DO 80 IREAL = 1,NREAL                                            
                  LOW    = LOW + INCR                                           
                  RA     = LOW                                                  
                  IF (ITYPE.EQ.3) THEN                ! real+integer conversion 
                     IA     = NINT(RA)                                          
                  END IF                                                        
                  IF (IPOS+1.LE.N) THEN       ! conversion if ipos+1<# array el.
                     A(IPOS+1) = RA                                             
                  END IF                                                        
                  IPOS   = IPOS + 1                   ! increase position by one
   80         CONTINUE                                                          
            END IF                                                              
            ILOOP  = ILOOP + 1                                                  
         END IF                                                                 
                                                                                
         IF (IIN.LT.NI) GO TO 70                                                
      END IF                                                                    
C                                                                               
      IF (IPOS.LT.N) THEN                                                       
         CALL SETEND(A(IPOS+1))                                                 
      END IF                                                                    
                                                                                
      RETURN                                                                    
      END                                                                       



      SUBROUTINE DECUSR(SS,L,ARRAY,NIN)                                         
C+++                                                                            
C.PURPOSE:  Subroutine to decode input string into a real array
C.AUTHOR:   J.P. Terlouw, Kapteynlab Groningen
C.COMMENTS: none
C.VERSION:  87???? RHW adjustments for and implementation in MIDAS
C.VERSION:  910115 RHW IMPLICIT NONE added
C---                                                                            
      IMPLICIT   NONE
      INTEGER    L                            ! IN: length of character string
      CHARACTER  SS(L)                        ! IN: character string
      REAL       ARRAY(50)                    ! OUT: real array  
      INTEGER    NIN                          ! OUT: length of the array
C
      INTEGER    IPOINT, IEPOW, ISIGN
      INTEGER    I, II, IARR, IFMT
      INTEGER    J
      INTEGER    NOUT, N1 
      INTEGER    LF, LD
      REAL       ENDLN
C
      CHARACTER  FMT*150,SSS*150                                                
      LOGICAL    REAL,EPOW,SIGN,CHAR,SEP                                        
                                                                                
 9000 FORMAT ('A',I1)                                                           
 9010 FORMAT (I2.2,'X')                                                         
 9020 FORMAT ('F',I2.2,'.',I2.2)                                                
C                                                                               
C *** start                                                                     
      REAL   = .FALSE.                                                          
      EPOW   = .FALSE.                                                          
      SIGN   = .FALSE.                                                          
      CHAR   = .FALSE.                                                          
      SEP    = .TRUE.                                                           
      IPOINT = 0                                                                
      IEPOW  = 0                                                                
      ISIGN  = 0                                                                
C                                                                               
      DO 10 II = 1,L                          !  put ss(1 --> l) into sss(1:l)  
         SSS(II:II) = SS(II)                                                    
   10 CONTINUE                                                                  
      DO 20 II = L + 1,150                                                      
         SSS(II:II) = ' '                                                       
   20 CONTINUE                                                                  
C                                                                               
      I      = 1                                 !   index used for ss(1 ---> l)
      NOUT   = 0                                !  # of elements filled in array
      FMT(1:1) = '('                                                            
      IFMT   = 2                                                                
      N1     = 1                                !   first position of next field
      CALL SETEND(ENDLN)                                                        
      DO 30 IARR = 1,NIN                                                        
         ARRAY(IARR) = ENDLN                                                    
   30 CONTINUE                                                                  
C                                                                               
   40 CONTINUE                                                                  
      IF (I.LE.L .AND. NOUT.LT.NIN) THEN                                        
         IF (SS(I).EQ.' ' .OR. SS(I).EQ.',' .OR. SS(I).EQ.':') THEN             
            IF ( .NOT. SEP) THEN                                                
               LF     = I - N1                              !   character string
               IF (CHAR) THEN                                                   
                  LF     = MIN(((NIN-NOUT)*1),LF)         !   max space in array
   50             CONTINUE                                                      
                  IF (LF.GT.0) THEN                                             
                     WRITE (FMT(IFMT:IFMT+1),9000) MIN(1,LF)                    
                     LF     = LF - 1                                            
                     IFMT   = IFMT + 2                                          
                     FMT(IFMT:IFMT) = ','                                       
                     IFMT   = IFMT + 1                                          
                     NOUT   = NOUT + 1                                          
                     GO TO 50                                                   
                  END IF                                                        
                                                                                
               ELSE                                                             
                  IF (IEPOW.EQ.0) THEN                                          
                     IEPOW  = I                                                 
                  END IF                                                        
                                                                                
                  IF (IPOINT.EQ.0) THEN                                         
                     IPOINT = I                                                 
                  END IF                                                        
                                                                                
                  LD     = MAX((IEPOW-IPOINT-1),0)                              
                  WRITE (FMT(IFMT:IFMT+5),9020) LF,LD                           
                  IFMT   = IFMT + 6                                             
                  FMT(IFMT:IFMT) = ','                                          
                  IFMT   = IFMT + 1                                             
                  NOUT   = NOUT + 1                                             
               END IF                                                           
                                                                                
               N1     = I                                                       
C                                                                               
               REAL   = .FALSE.                                                 
               EPOW   = .FALSE.                                                 
               SIGN   = .FALSE.                                                 
               CHAR   = .FALSE.                                                 
               SEP    = .TRUE.                                                  
               IPOINT = 0                                                       
               IEPOW  = 0                                                       
               ISIGN  = 0                                                       
            END IF                                                              
                                                                                
         ELSE                                                                   
            IF (SEP) THEN                                                       
               LF     = I - N1                                                  
               IF (LF.GT.0) THEN                                                
                  WRITE (FMT(IFMT:IFMT+2),9010) LF                              
                  IFMT   = IFMT + 3                                             
                  FMT(IFMT:IFMT) = ','                                          
                  IFMT   = IFMT + 1                                             
               END IF                                                           
               N1     = I                                                       
C                                                                               
C *** input element is real                                                     
               IF (SS(I).GE.'0' .AND. SS(I).LE.'9' .OR. SS(I).EQ.               
     +            '+' .OR. SS(I).EQ.'-') THEN                                   
                  REAL   = .TRUE.                                               
               ELSE                                                             
                  IF (SS(I).EQ.'.') THEN                       !   decimal point
                     REAL   = .TRUE.                                            
                     IPOINT = I                                                 
                  ELSE                                                          
                     CHAR   = .TRUE.               !  input element is character
                  END IF                                                        
               END IF                                                           
               SEP    = .FALSE.                                                 
                                                                                
            ELSE                                                                
               IF ( .NOT. CHAR) THEN                                            
                  IF (EPOW) THEN                                                
                     IF ( .NOT. SIGN) THEN                                      
                        IF (SS(I).EQ.'+' .OR. SS(I).EQ.'-') THEN                
                           ISIGN  = 1                                           
                           SIGN   = .TRUE.                                      
                        ELSE                                                    
                           IF (SS(I).GE.'0' .AND. SS(I).LE.'9') THEN            
                              SIGN   = .TRUE.                                   
                           ELSE                                                 
                              CHAR   = .TRUE.                                   
                           END IF                                               
                        END IF                                                  
                                                                                
                     ELSE                                                       
                        IF (SS(I).LT.'0' .OR. SS(I).GT.'9' .OR.                 
     +                     ((IEPOW+ISIGN+2).LT.I)) THEN                         
                           CHAR   = .TRUE.                                      
                        END IF                                                  
                     END IF                                                     
                                                                                
                  ELSE                                                          
                     IF (SS(I).EQ.'E') THEN                                     
                        EPOW   = .TRUE.                                         
                        IEPOW  = I                                              
                                                                                
                     ELSE                                                       
                        IF (SS(I).EQ.'.') THEN                                  
                           IF (IPOINT.GT.0) THEN                                
                              CHAR   = .TRUE.                                   
                           ELSE                                                 
                              IPOINT = I                                        
                           END IF                                               
                        ELSE                                                    
                           IF (SS(I).LT.'0' .OR. SS(I).GT.'9') THEN             
                              CHAR   = .TRUE.                                   
                           END IF                                               
                        END IF                                                  
                     END IF                                                     
                  END IF                                                        
               END IF                                                           
            END IF                                                              
         END IF                                                                 
                                                                                
         I      = I + 1                                                         
         GO TO 40                                                               
      END IF                                                                    
C                                                                               
      IF (I.GT.N1) THEN                                                         
         IF ( .NOT. SEP) THEN                                                   
            LF     = I - N1                                                     
            IF (CHAR) THEN                                  !   character string
               LF     = MIN(((NIN-NOUT)*1),LF)            !   max space in array
   60          CONTINUE                                                         
               IF (LF.GT.0) THEN                                                
                  WRITE (FMT(IFMT:IFMT+1),9000) MIN(1,LF)                       
                  LF     = LF - 1                                               
                  IFMT   = IFMT + 2                                             
                  FMT(IFMT:IFMT) = ','                                          
                  IFMT   = IFMT + 1                                             
                  NOUT   = NOUT + 1                                             
                  GO TO 60                                                      
               END IF                                                           
                                                                                
            ELSE                                                                
               IF (IEPOW.EQ.0) THEN                                             
                  IEPOW  = I                                                    
               END IF                                                           
                                                                                
               IF (IPOINT.EQ.0) THEN                                            
                  IPOINT = I                                                    
               END IF                                                           
                                                                                
               LD     = MAX((IEPOW-IPOINT-1),0)                                 
               WRITE (FMT(IFMT:IFMT+5),9020) LF,LD                              
               IFMT   = IFMT + 6                                                
               FMT(IFMT:IFMT) = ','                                             
               IFMT   = IFMT + 1                                                
               NOUT   = NOUT + 1                                                
            END IF                                                              
                                                                                
            N1     = I                                                          
         END IF                                                                 
      END IF                                                                    
C                                                                               
      FMT(IFMT-1:IFMT-1) = ')'                                                  
      IF (NOUT.GT.0) THEN                                                       
          READ (SSS(1:L),FMT=FMT(1:IFMT-1)) (ARRAY(J),J=1,NOUT)                 
      END IF                                                                    
C                                                                               
      RETURN                                                                    
      END                                                                       



      INTEGER FUNCTION NEL(A,N)
C+++
C.PURPOSE:  Count the number of words in the input array of dimension
C           N by testing the array on -0 value
C.AUTHOR:   Rein H. Warmels
C.COMMENTS: none
C.VERSION:  890117 RHW Documented
C.VERSION:  910115 RHW IMPLICIT NONE added
C---
      IMPLICIT NONE
      INTEGER  N
      REAL     A(N)
C
      INTEGER  I 
      REAL     END
C
      DATA     END/-32768/
C
C ***
      DO 10 I = 1,N
         IF (A(I).EQ.END) THEN
            GO TO 20
        END IF
   10 CONTINUE

   20 CONTINUE
      NEL    = I - 1

      RETURN
      END



      SUBROUTINE SETEND(X)                                                      
C+++                                                                            
C.PURPOSE:  put an end of array word in X    
C.COMMENTS: none
C.VERSION:  910115 RHW IMPLICIT NONE added
C---                                                                            
      REAL   X
C
      REAL   END	
      DATA   END/-32768/
C
C ***
      X      = END                                                              
                                                                                
      RETURN                                                                    
      END                                                                       
      SUBROUTINE ALPHA(A,LENGTH,NCHAR,NREST)
C+++                                        
C.PURPOSE:  Alphanumeric handling routine
C.AUTHOR:   Rein H. Warmels
C.COMMENTS: none
C.VERSION:  87???? RHW  creation
C.VERSION:  910115 RHW  IMPLICIT NONE added
C---
      IMPLICIT     NONE
      CHARACTER*(*) A                  ! IN: input array of dimension n        
      INTEGER      LENGTH              ! IN: max length of the character string
      INTEGER      NCHAR               ! OUT: number of actual characters
      INTEGER      NREST               ! OUT: number of remaining characters
C
      CHARACTER    X
      INTEGER      I
C
C***
      NCHAR  = 0 
      DO 10 I = 1,LENGTH 
         X      = A(LENGTH-I+1:LENGTH-I+1)
         IF (X.NE.' ') THEN 
            NCHAR  = LENGTH + 1 - I 
            NREST  = LENGTH - NCHAR
            RETURN
         END IF
   10 CONTINUE 
      RETURN 
      END

