C @(#)prfcnv.for	17.1.1.1 (ES0-DMD) 01/25/02 17:15:44
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.IDENTIFICATION
C  subroutine PRFCNV         version 1         820719
C  A. Kruszewski             ESO Garching
C.KEYWORDS
C  magnitude profile
C.PURPOSE
C  calculates stellar magnitudes "AMAG" by convolving observed
C  profiles "PRCT" with one dimensional standard point spread
C  function "SPRF"
C.INPUT/OUTPUT
C  input arguments
C  PRCT        real*4 array      catalog of observed profiles
C  SPRF        real*4 array      one-dimensional standard point
C                                spread function
C  M           integer*4         number of catalogued objects
C  HHCUT       real*4            higher limit for usable profiles
C  output parameters
C  AMAG        real*4 array      calculated stellar magnitudes
C-----------------------------------------------------------------------
      SUBROUTINE PRFCNV(L0, L1, LW, NREG, LSTP,
     &                  NCAT, PMTR, PRCT, IARR, RARR,
     &                  ICT, ABGRD)
C
      IMPLICIT  NONE
      INCLUDE  'MID_REL_INCL:INVENT.INC/NOLIST'
C
      INTEGER   L0
      INTEGER   L1
      INTEGER   LW
      INTEGER   NREG
      INTEGER   LSTP(0:4,0:NREG)
      INTEGER   NCAT(NIPAR,MAXCNT)
      REAL      PMTR(NRPAR,MAXCNT)
      REAL      PRCT(0:MAXSUB,MAXCNT)
      INTEGER   IARR(32)
      REAL      RARR(64)
      INTEGER   ICT
      REAL      ABGRD
C
      INTEGER   NB, NP
      INTEGER   I, I1, IUNT, ICNT
      INTEGER   K, K2
      INTEGER   M, MARK
      INTEGER   L, LZ, LIM
C
      REAL      AAMG
      REAL      SAMG
      REAL      BCOR
      REAL      TRSH
      REAL      ZRMG
      REAL      TINT
      REAL      PRIN
      REAL      PINL
C     
      REAL      APSF(0:MAXSUB) , HHCUT
      REAL      NPXL(0:MAXSUB)
C     REAL      SPRF(0:MAXSUB)
C
C *** Define array NPXL holding numbers
C *** of pixels in each of annular rings.
C
      DATA NPXL/1,8,12,16,32,28,40,40,48,68,56,72,68,88,88,84,112,
     +  112,112,116,112,144,140,144,144,168,164,160,184,172,200,192,
     +  188,208,224,224,228,224,248,236,264,248,264,276,264,288,276,
     +  304,304,312,316/
C
      NP = MAXCNT
      TRSH = RARR(3)
      ZRMG = RARR(11)
      TINT = RARR(10)
      IUNT = IARR(10)
      MARK = 1
C
C *** Transform logarithmic profile into one dimensional psf
C *** APRF, which is normalized to 1.0 at the central pixel.
C
      APSF(0) = 1.0
      I1 = MIN( MAXSUB , 25 ) 
      DO 10 I = 1 , I1
          APSF(I) = APSF(I-1) * 10.0**(-RARR(I+13))
   10 CONTINUE
      DO 20 I = 26 , MAXSUB
          APSF(I) = APSF(I-1) * 10.0**(-RARR(I1+13))
   20 CONTINUE
      HHCUT = 0.7 * ( RARR(2) - ABGRD )
C
C *** Calculate normalizing integral over the profile
C *** PRIN and its value expressed in magnitudes PINL.
C
      PRIN = 0.0
      DO 30 K = 0 , MAXSUB
          PRIN = PRIN + NPXL(K) * APSF(K)
   30 CONTINUE
      PINL = 2.5 * ALOG10( PRIN )
      IF ( IUNT .EQ. 1 ) THEN
          BCOR = -2.5 * ALOG10(TINT)
      ELSE
          BCOR = -2.5 * ALOG10(ABGRD)
      ENDIF
C
C *** Perform convolution.
C
      M = MAX( L1 , LW )
      K2 = NINT( RARR(13) ) + 1
      NB = 0
      DO 40 L = 1 , M
C          IF ( L .GT. L1 .OR. L .LE. L0 ) THEN
C              IOCOD = 0
C              CALL PARFIL( ISF , L , L0 , L1 , LW ,
C     &                     IOCOD , MARK , NCAT , PMTR , PRCT )
C              IF ( NB .EQ. 0 ) THEN
C                  ABGRD = 0.0
C              ENDIF
C              CALL AVBGRD( L0 , L1 , PMTR , RARR(39) , BGRD )
C              NC = L1 - L0
C              ABGRD = ( NB * ABGRD + NC * BGRD ) / ( NB + NC )
C              NB = NB + NC
C          ENDIF
          LZ = L - L0
          IF ( NCAT(9,LZ) .GT. 0 ) GOTO 60
          LIM = NCAT(5,LZ)
          ICNT = 0
          K = 0
          AAMG = 0.0
          SAMG = 0.0
   50     CONTINUE
              IF ( ICNT .GT. K2 .OR. K .GT. LIM ) GOTO 51
              IF ( PRCT(K,LZ) .LT. HHCUT ) THEN
                  AAMG = AAMG + APSF(K)*PRCT(K,LZ)*NPXL(K)
                  SAMG = SAMG + APSF(K)*APSF(K)*NPXL(K)
                  ICNT = ICNT + 1
              ENDIF
              K = K + 1
              GOTO 50
   51     CONTINUE
C
C ***     Calculate magnitude.
C
          IF ( MIN( AAMG , SAMG ) .GT. 0.0 ) THEN
              PMTR(12,LZ) = AAMG / SAMG
          ELSE
              PMTR(12,LZ) = 1.0E-20 * TRSH
          ENDIF
   60     CONTINUE
          IF ( ICT .EQ. 1 ) THEN
C
C ***         Magnitudes are transformed  before being output.
C
              IF ( PMTR(12,LZ) .GT. 0.0 ) THEN
                  PMTR(12,LZ) = -2.5 * ALOG10( PMTR(12,LZ) )
     &                          - PINL + ZRMG - BCOR
              ELSE
                  PMTR(12,LZ) = 80.0
              ENDIF
              PMTR(5,LZ) = PMTR(5,LZ) - BCOR
              PMTR(13,LZ) = PMTR(13,LZ) - BCOR
              PMTR(16,LZ) = PMTR(16,LZ) - BCOR
              PMTR(20,LZ) = PMTR(20,LZ) - BCOR
          ENDIF
   40 CONTINUE
C
      RETURN
C
      END