c      ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c      cc     Calculate Q_photo                                    ccc
c      cc                   cqpho.f                                ccc
c      ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
       subroutine cqpho( qpho, rhom, lamb, qp , fp )  

c
        implicit real*8 ( a-h, o-z )
        real*8 lamb
        dimension rhom( 1 ), lamb( 1 ), qp( 1 ), fp( 1 ), qpho( 1 )
        common /param/ ndat, n
c
           wa  = 0.2325d0
           cv  = 0.5d0 + 2.d0*wa
           ca  = 0.5d0
           cvp = 1.d0  - cv
           cap = 1.d0  - ca
            dn = float( n )
c
                coe1 = 0.5d0*(( cv **2.d0 + ca **2.d0 )
     &                   + dn*( cvp**2.d0 + cap**2.d0 ) )
                coe2 =  (( cv **2.d0 - ca **2.d0 )
     &              + dn*( cvp**2.d0 - cap**2.d0 ) )
     1                / (( cv **2.d0 + ca **2.d0 )
     &              + dn*( cvp**2.d0 + cap**2.d0 ) )
c
        do 100 k = 1 , ndat
           qpho( k ) = coe1*( 1.d0 - coe2*qp( k ) )* rhom( k )
     &                *lamb( k )**5.d0*fp( k )
 100    continue
        return
        end