C @(#)profi5.for	17.1.1.1 (ES0-DMD) 01/25/02 17:17:57
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 PROFI5 (RNY,MX,MY,NP,NC,IC,FM,FM1)
C+++++
C     Authors: R. Buonanno, G. Buscema, C. Corsi, I. Ferraro, G. Iannicola
C              Osservatorio Astronomico di Roma
C-----
      IMPLICIT  NONE
      INTEGER   MX
      INTEGER   MY
      REAL      RNY(MY,MX)
      INTEGER   NP
      INTEGER   NC
      INTEGER   IC
      REAL      FM
      CHARACTER FM1
C
      INTEGER   I, J, KL
      REAL      A, B 
      REAL      PPP
      INTEGER   IX(101),IY(101)
      INTEGER   ERRCOD,WHITE
C
      INCLUDE  'MID_INCLUDE:IDIDEV.INC'
      INCLUDE  'MID_INCLUDE:IDIMEM.INC'
C
      WHITE = 2
      IF (IDINUM.LT.11) THEN
         CALL IIMSTW(QDSPNO,QOVCH,LOADDR,NSX,NSY,QMDEP,
     2               SSPX,SSPY,ERRCOD)
      ENDIF          
C
      IF (FM.EQ.0.) FM=0.0001
      I = 0
      DO 10 KL=1,NP
         A = -10.E35
         DO 20 J=1,NC
            B = RNY(J,KL)
            A = AMAX1(B,A)
  20     CONTINUE
C
         IF (A.GT.-1000000000.) THEN
            IF (A .LT. 0.0) A = 0.0
            I     = I + 1
            IX(I) = KL*3
            PPP   = A/3.*FM+IC
            IF (PPP.GE.511.) PPP=511.
            IY(I) = PPP

         ELSE
            IF (I.GT.0) THEN
               CALL IIGPLY(QDSPNO,QOVCH,IX,IY,I,WHITE,1,ERRCOD)
            END IF
            I = 0
         END IF
  10  CONTINUE
C
      IF (I.GT.0) THEN
         CALL IIGPLY(QDSPNO,QOVCH,IX,IY,I,WHITE,1,ERRCOD)
      END IF
C
      J = 0
      IF (FM1.NE.'N') THEN
         DO 30 KL = 1,NC
            A = -10.E35
            DO 40 I = 1,NP
               B = RNY(KL,I)
               A = AMAX1(B,A)
  40        CONTINUE
C
            IF (A.GT.-1000000000.) THEN
               IF (A.LT.0.0) A = 0.0
               J     = J + 1
               IX(J) = KL*3+256
               PPP   = A/3.*FM+IC
               IF (PPP.GE.511.) PPP=511.
               IY(J)  = PPP
            ELSE
               IF (J.GT.0) THEN
                  CALL IIGPLY(QDSPNO,QOVCH,IX,IY,J,WHITE,1,ERRCOD)
               END IF
               J = 0
            END IF
  30     CONTINUE
C
         IF (J.GT.0) THEN
            CALL IIGPLY(QDSPNO,QOVCH,IX,IY,J,WHITE,1,ERRCOD)
         END IF
         J = 0
      END IF
C
      IF (FM1.NE.'Y') THEN
         DO 50 KL = 1,NC
            A = -10.E35
            DO 60 I = 1,NP
               B = RNY(KL,I)
               A = AMAX1(B,A)
  60        CONTINUE
C
            IF (A.GT.-1000000000.) THEN
               IF (A.LT.0.0) A = 0.0
               J     = J + 1
               IY(J) = KL*3
               PPP   = A/3.*FM+256.+IC-300.
               IF (PPP.GE.511.) PPP=511.
               IX(J) = PPP

            ELSE
               IF (J.GT.0) THEN
                  CALL IIGPLY(QDSPNO,QOVCH,IX,IY,J,WHITE,1,ERRCOD)
               END IF
               J = 0
            END IF
 50      CONTINUE
C
         IF (J.GT.0) THEN
            CALL IIGPLY(QDSPNO,QOVCH,IX,IY,J,WHITE,1,ERRCOD)
         END IF
      END IF
C
      RETURN
      END