

C LAST UPDATE:
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C*****************************
C**  LSC_ABSSURFACE_PLOT    **
C*****************************
C
C **** LSC SERVICE ROUTINE ONLY ****
C
C Routine: Plots absorption surface in graphic window - LSC_ABSSURFACE_PLOT
C This routine plots absorption correction factors for all psi- and nu-angles
C of the data range in graphic window 
C
      SUBROUTINE LSC_ABSSURFACE_PLOT (MINDX, NPMAXX, NPMAXY,
     +               NCOLOR, ALAMPLOT)
C
      INCLUDE 'implicit_none.finc'
C
C Purpose : displays absorption surface in window mode
C
C Author:  Steffi Arzt, John Campbell, July 1997
C
C Arguments:
C
      INTEGER MINDX
      INTEGER NPMAXX, NPMAXY
      INTEGER NCOLOR
      REAL ALAMPLOT
C
C Parameters:
C   NPMAXX    i  (R)    no. of pixels for plot in x-direction
C   NPMAXY    i  (R)    no. of pixels for plot in y-direction
C   NCOLOR    i  (R)    no. of colours
C   KCOLOR()  i  (R)    colours(last one used for plot frame) 
C   ALAMPLOT  r  (R)    wavelength for plot

C
C====== PARAMETERS:
C
      INCLUDE 'limits.finc'
C
C====== GLOBALS:
C
      INCLUDE 'other_scale.finc'
      INCLUDE 'scp.finc'
      INCLUDE 'use_reflns.finc'
      INCLUDE 'scale_presets.finc'
      INCLUDE 'screen_params.finc'
      INCLUDE 'view_handles.finc'
      INCLUDE 'get_soft.finc'
C
C====== FUNCTION TYPES:
C
      INTEGER XDLSTR
      DOUBLE PRECISION LSM_ABSFACGLOB
      REAL LSM_ABSC_MU
C
C====== LOCALS:
C
      INTEGER I, J, K, IERR, KERR
      INTEGER LIML, LIMU
      INTEGER NREFS
      INTEGER NPIXX, NPIXY
      INTEGER MINROW(600), MAXROW(600)
      INTEGER NCOLVAL(800,600)
      INTEGER IH, IK, IL, IPACK, IPLATE, KSYM
      INTEGER MULT, MINHARM, MAXHARM, INCHARM
      INTEGER ISPAT, IOVLD, IBAD, IMEAS
      INTEGER ICODE, ICLOS, JERR
      INTEGER LIMRAN
      INTEGER IRED(64), IGREEN(64), IBLUE(64)
      INTEGER IXROOT, IYROOT
      INTEGER INTYP
      REAL ABSFAC, ABSMIN, ABSMAX
      REAL APSI, ANU, PSI, NU, PSX, NUY
      REAL XFAC, YFAC
      REAL XFD, YFD, ALAM 
      REAL PSI_MIN, PSI_MAX, NU_MIN, NU_MAX
      REAL PSI_RANGE, NU_RANGE
      REAL AI, SIGI
      REAL ABSCOR_LAMFN
      LOGICAL FLAG(800, 600)
      LOGICAL ROWFL(600) 

C
C===== initialize
C
      ABSMIN = 10.0E20
      ABSMAX = 0.0
      PSI = 0.0

      DO 170 I = 1, NPMAXY
         MAXROW(I) = NPMAXX
         MINROW(I) = 1
         ROWFL(I) = .FALSE.
         DO 180 J = 1, NPMAXX
            FLAG(J,I) = .FALSE.
            NCOLVAL(J,I) = 1
 180     CONTINUE
 170  CONTINUE

      DO 310 I = 1, MAXPACK
         IF (AMINCTOF.LT.CTOF(I,1)) AMINCTOF = CTOF(I,1)
 310  CONTINUE

      CALL LSM_SELECT_SCREFS (.FALSE., .TRUE., SIGCUT_USE,  
     +                        .FALSE., .FALSE.) 
  
      CALL LSM_TOP_LIRL (MINDX, IERR)

      CALL LIRLF_NUMREFS (MINDX, NREFS)

C====== scale map

      NU_MAX = ATAN((IMAGESIZE(2)/2.0)/AMINCTOF)*180.0/PI   
      NU_MIN = -NU_MAX 

      IF (NPK.EQ.1) THEN
         IF (.NOT.CYLINDER) THEN
            PSI_MIN = -ATAN((IMAGESIZE(1)/2.0)/AMINCTOF)*180.0/PI   
         ELSE 
            PSI_MIN = (-(IMAGESIZE(1)/2.0)/AMINCTOF)*180.0/PI 
         END IF
         PSI_MAX = -PSI_MIN
         INTYP = 1
      ELSE IF (SPINDLE(1).EQ.0.0.AND.SPINDLE(2).GT.0.0) THEN
         IF (.NOT.CYLINDER) THEN
            PSI_MAX = ATAN((IMAGESIZE(1)/2.0)/AMINCTOF)*180.0/PI   
         ELSE 
            PSI_MAX = ((IMAGESIZE(1)/2.0)/AMINCTOF)*180.0/PI 
         END IF
         PSI_MIN = -PSI_MAX - (NPK-1)*SPINDLE(2)
         INTYP = 2
      ELSE IF (SPINDLE(1).EQ.0.0.AND.SPINDLE(2).LT.0.0) THEN
         IF (.NOT.CYLINDER) THEN
            PSI_MIN = -ATAN((IMAGESIZE(1)/2.0)/AMINCTOF)*180.0/PI   
         ELSE 
            PSI_MIN = (-(IMAGESIZE(1)/2.0)/AMINCTOF)*180.0/PI 
         END IF
         PSI_MAX = -PSI_MIN - (NPK-1)*SPINDLE(2)
         INTYP = 3
      ELSE IF (SPINDLE(1).NE.0.0.AND.
     +        (SPINDLE(1).LT.SPINDLE(2))) THEN
         IF (.NOT.CYLINDER) THEN
            PSI_MAX = ATAN((IMAGESIZE(1)/2.0)/AMINCTOF)
     +             *180.0/PI - SPINDLE(1)
         ELSE 
            PSI_MAX = ((IMAGESIZE(1)/2.0)/AMINCTOF)*180.0/PI 
     +           - SPINDLE(1)
         END IF
         PSI_MIN = -2*SPINDLE(1) - PSI_MAX - (NPK-1)*
     +            (SPINDLE(2)-SPINDLE(1))         
         INTYP = 4
      ELSE IF (SPINDLE(1).NE.0.0.AND.
     +        (SPINDLE(1).GT.SPINDLE(2))) THEN
         IF (.NOT.CYLINDER) THEN
            PSI_MIN = SPINDLE(1)-ATAN((IMAGESIZE(1)/2.0)/AMINCTOF)
     +             *180.0/PI
         ELSE
            PSI_MIN = SPINDLE(1)-((IMAGESIZE(1)/2.0)/AMINCTOF)*180.0/PI 
         END IF
         PSI_MAX = 2*SPINDLE(1) - PSI_MIN + (NPK-1)*
     +            (SPINDLE(2)-SPINDLE(1))
         INTYP = 5
      END IF

      PSI_RANGE = PSI_MAX - PSI_MIN
      NU_RANGE = NU_MAX - NU_MIN

      IF((PSI_RANGE/NU_RANGE).LT.((NPMAXX*1.0)/(NPMAXY*1.0))) THEN
         NPIXY = NPMAXY
         NPIXX = NINT(NPMAXY*1.0*(PSI_RANGE/NU_RANGE))
      ELSE
         NPIXX = NPMAXX
         NPIXY = NINT(NPMAXX*1.0/(PSI_RANGE/NU_RANGE))
      END IF

      CALL XDLF_VIEW_OBJECT_ROOTXY(IVH_GRAPH,120,180,IXROOT,IYROOT,IERR) 
  
      CALL XDLF_PROGRESS_BAR (IVH_BAR, IXROOT, IYROOT, 
     +     XDLSTR('Forming absorption surface:'), 27, 100, NPIXY,
     +     2, 5)
      
      DO 210 I = 1, NPIXY
         MAXROW(I) = NPIXX
         MINROW(I) = 1
 210  CONTINUE
      
      XFAC = PSI_RANGE/(NPIXX*1.0)
      YFAC = NU_RANGE/(NPIXY*1.0)

      CALL LSM_CALC_PRESETS 

      DO 30 K = 1, NREFS
         CALL LIRLF_GETREF (MINDX, K, IH, IK, IL, IPACK, 
     +              IPLATE, KSYM, XFD, YFD, ALAM,
     +              MULT, MINHARM, MAXHARM, INCHARM, AI, SIGI,
     +              ISPAT, ICLOS, IMEAS, IBAD, IOVLD, 
     +              ICODE, JERR)
         IF (MULT.NE.1) GO TO 30
         IF (.NOT.CYLINDER) THEN
            PSI = (ATAN(XFD/CTOF(IPACK,IPLATE)))*180.0/PI 
            NU = ATAN(COS(PSI*PI/180.0)*
     +                 YFD/CTOF(IPACK,IPLATE))*180.0/PI
         ELSE
            PSI =(XFD/CTOF(IPACK,IPLATE))*180.0/PI
            NU = ATAN(YFD/CTOF(IPACK,IPLATE))*180.0/PI
         END IF
         PSI = PSI - SPINDLE(IPACK)
         NUY = (NU_RANGE/2.0 - NU)/YFAC
         IF (INTYP.EQ.1) THEN
            PSX = (PSI_RANGE/2.0 - PSI)/XFAC
         ELSE 
            PSX = (PSI_MAX - PSI)/XFAC
         END IF
         FLAG(NINT(PSX),NINT(NUY)) = .TRUE.
 30   CONTINUE

      DO 50 I = 1, NPIXY
         DO 60 J = 1, NPIXX 
            IF (FLAG(J,I)) THEN 
               MINROW(I) = J
               ROWFL(I) = .TRUE.
               GO TO 50
            END IF
 60      CONTINUE
 50   CONTINUE

      DO 190 I = 1, NPIXY
         DO 200 J = NPIXX, 1, -1 
            IF (FLAG(J,I)) THEN 
               MAXROW(I) = J
               ROWFL(I) = .TRUE.
               GO TO 190
            END IF
 200     CONTINUE
 190  CONTINUE

      DO 250 I = 1, NPIXY
         DO 260 J = 1, NPIXX
            IF (FLAG(J,I)) THEN 
               ROWFL(I) = .TRUE.
               GO TO 250
            END IF
 260     CONTINUE
 250  CONTINUE

      DO 80 I = 1, NPIXY/2
         IF(I.GT.1.) THEN
            IF(ROWFL(I).AND.ROWFL(I-1)) THEN
               IF(MINROW(I).GT.MINROW(I-1)) MINROW(I) = MINROW(I-1)
               IF(MAXROW(I).LT.MAXROW(I-1)) MAXROW(I) = MAXROW(I-1)
               DO 90 J = MINROW(I), MAXROW(I)
                  FLAG(J,I) = .TRUE.
 90            CONTINUE
            ELSE IF(ROWFL(I).AND..NOT.ROWFL(I-1)) THEN
               DO 270 J = MINROW(I), MAXROW(I)
                  FLAG(J,I) = .TRUE.
 270           CONTINUE
            ELSE IF(.NOT.ROWFL(I).AND.ROWFL(I-1)) THEN
               MINROW(I) = MINROW(I-1)
               MAXROW(I) = MAXROW(I-1)
               ROWFL(I) = .TRUE.
               DO 290 J = MINROW(I), MAXROW(I)
                  FLAG(J,I) = .TRUE.
 290           CONTINUE
            END IF
         ELSE
            IF(ROWFL(1)) THEN
               DO 220 J = MINROW(1), MAXROW(1)
                  FLAG(J,1) = .TRUE.
 220           CONTINUE
            END IF
         END IF
 80   CONTINUE
      

      DO 100 I = NPIXY, NPIXY/2 + 1, -1
         IF(I.LT.NPIXY) THEN
            IF(ROWFL(I).AND.ROWFL(I+1)) THEN
               IF(MINROW(I).GT.MINROW(I+1)) MINROW(I) = MINROW(I+1)
               IF(MAXROW(I).LT.MAXROW(I+1)) MAXROW(I) = MAXROW(I+1)
               DO 110 J = MINROW(I), MAXROW(I)
                  FLAG(J,I) = .TRUE.
 110           CONTINUE
            ELSE IF(ROWFL(I).AND..NOT.ROWFL(I+1)) THEN
               DO 280 J = MINROW(I), MAXROW(I)
                  FLAG(J,I) = .TRUE.
 280           CONTINUE
            ELSE IF(.NOT.ROWFL(I).AND.ROWFL(I+1)) THEN
               MINROW(I) = MINROW(I+1)
               MAXROW(I) = MAXROW(I+1)
               ROWFL(I) = .TRUE.
               DO 300 J = MINROW(I), MAXROW(I)
                  FLAG(J,I) = .TRUE.
 300           CONTINUE
            END IF
         ELSE
            IF(ROWFL(NPIXY)) THEN
              DO 230 J = MINROW(NPIXY), MAXROW(NPIXY)
                  FLAG(J,NPIXY) = .TRUE.
 230           CONTINUE
            END IF
         END IF
 100  CONTINUE
     
      ABSCOR_LAMFN = LSM_ABSC_MU(ALAMPLOT)

      DO 140 I = 1, NPIXY 
            ANU = - YFAC * (I-1) + NU_RANGE/2.0
         DO 150 J = 1, NPIXX
            IF (INTYP.EQ.1) THEN
               APSI =  PSI_RANGE/2.0 - XFAC * (J-1) 
            ELSE IF (INTYP.EQ.2.OR.INTYP.EQ.3) THEN
               APSI =  PSI_MAX - XFAC * (J-1) 
            END IF
            IF (FLAG(J,I)) THEN
               ABSFAC = LSM_ABSFACGLOB(ANU,APSI,
     +                ABSCOR_LAMFN,.TRUE.,
     +                PQ00_GLOB_STORE, AKNORM_STORE, KERR)
C>>>>>>>
C               XX =  0.01*AMINCTOF*TAN(APSI*PI/180.0)
C               YY =  0.01*(TAN(ANU*PI/180.0)/COS(APSI*PI/180.0))
C     +                *AMINCTOF
C               ABSFAC = 0.3 + 2.5*(0.05*XX/(XX**2+0.1)+
C     +              0.05*YY/(YY**2+0.15))
C               ABSFAC = 1.0/(EXP(-ALAMPLOT**3*ABSFAC))
C               ABSFAC = ABSFAC * SIN((ALAM-0.4)*PI)

C>>>>
               IF (ABSFAC.NE.0.0) THEN
                  IF(ABSFAC.LT.ABSMIN) ABSMIN = ABSFAC
                  IF(ABSFAC.GT.ABSMAX) ABSMAX = ABSFAC
               END IF
               NCOLVAL(J,I) = ABSFAC*1000
            ELSE
               NCOLVAL(J,I) = 100000
            END IF
 150     CONTINUE
         CALL XDLF_PROGRESS_BAR_VALUE (IVH_BAR, I, IERR)  
 140  CONTINUE

      LIML = ABSMIN*1000 - 1
      LIMU = ABSMAX*1000 + 1
      LIMRAN = ((LIMU - LIML)/(NCOLOR-1)) + 1
      LIMU = LIML + LIMRAN*NCOLOR 

      CALL XDLF_DELETE_VIEW_OBJECT (IVH_BAR, IERR)

      CALL XDLF_VIEW_OBJECT_ROOTXY(IVH_GRAPH,0,0,IXROOT,IYROOT,IERR)        

      CALL XDLF_IMAGE (IVH_ABSURF, 0, IXROOT, IYROOT, 1, 
     +                 NCOLVAL, 3, NPIXY, NPIXX, NPMAXX, 
     +                 1, 1, NPIXX,NPIXY, 1,
     +                 5, 1,
     +                 LIML, MAX(10000,LIMU), LIML, LIMU, 0,0, 
     +                 0, 1, 1024, 0, IERR)

      CALL LSC_COLOURS (IRED, IGREEN, IBLUE)

      CALL XDLF_IMAGE_SET_COLORMAP (IVH_ABSURF, IRED, IGREEN, 
     +                                 IBLUE, IERR)      
      CALL XDLF_IMAGE_RESET (IVH_ABSURF, LIML, LIMU, 63,
     +                       1024, 6, 1,
     +                       1, 3, 1, IERR)
      CALL XDLF_IMAGE_DISPLAY_NOW (IVH_ABSURF, IERR)

      RETURN

      END
