SUBROUTINE CALC_BOUNDARY_RADIANCES (BCFLAG, IPFLAG, JOCT, IZ,
     .                           NX, NY, NZ, XGRID, YGRID, ZGRID,
     .                           NA, NPTS, NCELLS, GRIDPTR,
     .                           NEIGHPTR, TREEPTR, CELLFLAGS, GRIDPOS,
     .                           MU, PHI, EXTINCT, NSTOKES, SOURCE,
     .                           KANG, GRIDRAD)

      IMPLICIT NONE
      INTEGER BCFLAG, IPFLAG, JOCT, IZ
      INTEGER NX, NY, NZ, NA, NPTS, NCELLS, NSTOKES, KANG
      REAL    XGRID(NX), YGRID(NY), ZGRID(NZ)
      INTEGER GRIDPTR(8,NCELLS), NEIGHPTR(6,NCELLS), TREEPTR(2,NCELLS)
      INTEGER*2 CELLFLAGS(NCELLS)
      REAL    GRIDPOS(3,NPTS), MU, PHI
      REAL    EXTINCT(NPTS), SOURCE(NSTOKES,NA,NPTS)
      REAL    GRIDRAD(NSTOKES,NPTS)

      RETURN
      END



      SUBROUTINE COMPUTE_RADIANCE_PAR (NSTOKES, NX,NY,NZ, NPTS,NCELLS,
     .             ML, MM, NSTLEG, NLEG, NUMPHASE,
     .             NMU, NPHI0MAX, NPHI0, MU, PHI, WTDO,
     .             BCFLAG, XDOMAIN, YDOMAIN, IPFLAG,
     .             SRCTYPE, DELTAM, SOLARMU, SOLARAZ,
     .             SFCTYPE, NSFCPAR, SFCGRIDPARMS,
     .             MAXNBC, NTOPPTS, NBOTPTS, BCPTR, BCRAD,
     .             GNDTEMP, GNDALBEDO, SKYRAD, WAVENO, WAVELEN, UNITS,
     .             XGRID, YGRID, ZGRID, GRIDPOS,
     .             GRIDPTR, NEIGHPTR, TREEPTR, CELLFLAGS,
     .             EXTINCT, ALBEDO, LEGEN, IPHASE, DIRFLUX, FLUXES,
     .             SHPTR, SOURCE, SOURCE1, GRIDRAD,
     .             OUTPARMS,  NRAD, RADOUT)
      IMPLICIT NONE
      INTEGER NSTOKES, NX, NY, NZ, BCFLAG, IPFLAG, NPTS, NCELLS
      INTEGER ML, MM, NSTLEG, NLEG, NUMPHASE
      INTEGER NMU, NPHI0MAX, NPHI0(NMU), NRAD
      INTEGER MAXNBC, NTOPPTS, NBOTPTS, NSFCPAR
      INTEGER GRIDPTR(8,NCELLS), NEIGHPTR(6,NCELLS), TREEPTR(2,NCELLS)
      INTEGER SHPTR(NPTS+1), BCPTR(MAXNBC,2)
      INTEGER*2 CELLFLAGS(NCELLS), IPHASE(NPTS)
      LOGICAL DELTAM
      REAL    SOLARMU, SOLARAZ
      REAL    GNDTEMP, GNDALBEDO, SKYRAD, WAVENO(2), WAVELEN
      REAL    MU(NMU), PHI(NMU,NPHI0MAX), WTDO(NMU,NPHI0MAX)
      REAL    XDOMAIN, YDOMAIN, XGRID(NX+1), YGRID(NY+1), ZGRID(NZ)
      REAL    GRIDPOS(3,NPTS)
      REAL    SFCGRIDPARMS(*), BCRAD(NSTOKES,*)
      REAL    EXTINCT(NPTS), ALBEDO(NPTS), LEGEN(NSTLEG,0:NLEG,NPTS)
      REAL    DIRFLUX(NPTS), FLUXES(2,NPTS), SOURCE(*)
      REAL    SOURCE1(NSTOKES,NPTS), GRIDRAD(NSTOKES,NPTS)
      REAL    OUTPARMS(*), RADOUT(NSTOKES,*)
      CHARACTER SRCTYPE*1, SFCTYPE*2, UNITS*1

      RETURN
      END



      SUBROUTINE VISUALIZE_RADIANCE_PAR (NSTOKES,NX,NY,NZ, NPTS,NCELLS,
     .             ML, MM, NLM, NSTLEG, NLEG, NUMPHASE, 
     .             NMU, NPHI0MAX, NPHI0, MU, PHI, WTDO,
     .             BCFLAG, XDOMAIN, YDOMAIN, IPFLAG, 
     .             SRCTYPE, DELTAM, SOLARMU, SOLARAZ,
     .             SFCTYPE, NSFCPAR, SFCGRIDPARMS, 
     .             MAXNBC, NTOPPTS, NBOTPTS, BCPTR, BCRAD,
     .             GNDTEMP, GNDALBEDO, SKYRAD, WAVENO, WAVELEN, UNITS,
     .             XGRID, YGRID, ZGRID, GRIDPOS, 
     .             GRIDPTR, NEIGHPTR, TREEPTR, CELLFLAGS,
     .             EXTINCT, ALBEDO, LEGEN, IPHASE, DIRFLUX, FLUXES,
     .             SHPTR, SOURCE,  OUTPARMS,  IVIS, VISOUT)
      IMPLICIT NONE
      INTEGER NSTOKES, NX, NY, NZ, BCFLAG, IPFLAG, NPTS, NCELLS
      INTEGER ML, MM, NLM, NSTLEG, NLEG, NUMPHASE
      INTEGER NMU, NPHI0MAX, NPHI0(NMU), IVIS
      INTEGER MAXNBC, NTOPPTS, NBOTPTS, NSFCPAR
      INTEGER GRIDPTR(8,NCELLS), NEIGHPTR(6,NCELLS), TREEPTR(2,NCELLS)
      INTEGER SHPTR(NPTS+1), BCPTR(MAXNBC,2)
      INTEGER*2 CELLFLAGS(NCELLS), IPHASE(NPTS)
      LOGICAL DELTAM
      REAL    SOLARMU, SOLARAZ
      REAL    GNDTEMP, GNDALBEDO, SKYRAD, WAVENO(2), WAVELEN
      REAL    MU(NMU), PHI(NMU,NPHI0MAX), WTDO(NMU,NPHI0MAX)
      REAL    XDOMAIN, YDOMAIN, XGRID(NX+1), YGRID(NY+1), ZGRID(NZ)
      REAL    GRIDPOS(3,NPTS)
      REAL    SFCGRIDPARMS(*), BCRAD(NSTOKES,*)
      REAL    EXTINCT(NPTS), ALBEDO(NPTS), LEGEN(NSTLEG,0:NLEG,*)
      REAL    DIRFLUX(NPTS), FLUXES(2,NPTS), SOURCE(NSTOKES,*)
      REAL    OUTPARMS(*), VISOUT(NSTOKES,*)
      CHARACTER SRCTYPE*1, SFCTYPE*2, UNITS*1

      RETURN
      END


      SUBROUTINE CALC_ACCEL_SOLCRIT (DOACCEL, DELJDOT, DELJOLD, DELJNEW, 
     .                               JNORM, ACCELPAR, SOLCRIT)
C     Calculates the acceleration parameter and solution criterion from
C     the delta source function vector dot  products.
      IMPLICIT NONE
      LOGICAL DOACCEL
      REAL    DELJDOT, DELJOLD, DELJNEW, JNORM, ACCELPAR, SOLCRIT
      REAL    R, THETA, A
      SAVE   A
      DATA   A/0.0/

C       Accelerate if desired, didn't last time, and things are converging. 
      IF (DOACCEL .AND. A .EQ. 0.0 .AND. DELJNEW .LT. DELJOLD) THEN
C       Compute the acceleration extrapolation factor and apply it.
        R = SQRT(DELJNEW/DELJOLD)
        THETA = ACOS(DELJDOT/SQRT(DELJOLD*DELJNEW))
        A = (1 - R*COS(THETA) + R**(1+0.5*3.14159/THETA))
     .         /(1 + R**2  - 2*R*COS(THETA))  - 1.0
        A = MIN(10.0,MAX(0.0,A))
C         WRITE (*,'(1X,A,3(1X,F7.3))') '! Acceleration: ', A,R,THETA
      ELSE
        A = 0.0
      ENDIF
      ACCELPAR = A

      IF (JNORM .GT. 0.0) THEN
        SOLCRIT = SQRT(DELJNEW/JNORM)
      ELSE IF (DELJNEW .EQ. 0.0) THEN
        SOLCRIT = 0.0
      ENDIF
      RETURN
      END




      SUBROUTINE END_SHDOM_MPI (NPTS, GRIDPOS, NPX,NPY, XSTART,YSTART,
     .                          DELX, DELY, NPXT, NPYT, PROPFILE)
      IMPLICIT NONE
      INTEGER NPTS, NPX, NPY, NPXT, NPYT
      REAL    GRIDPOS(3,NPTS), XSTART, YSTART, DELX, DELY
      CHARACTER PROPFILE*64

      RETURN
      END


      SUBROUTINE ABORT_SHDOM_MPI (ERRSTR)
      IMPLICIT NONE
      CHARACTER(*) ERRSTR

      WRITE (6,*) ERRSTR
      stop
      END