subroutine opacity(lw1, lw2, ww, wdop, temp, wav, str, dstr & , nlines, xvgt, yvgt, dvgt, dxvgt, nvgt, op, dp) parameter (zero = 0.d0, half = 5.d-1) c ------------------------------------------------------------- c External variables c ------------------------------------------------------------- real*8 ww,wdop,temp,wav(1),str(1),dstr(1),xvgt(1),yvgt(1) & ,dvgt(1),dxvgt,op,dp integer*4 lw1,lw2,nlines,nvgt c ------------------------------------------------------------- c Internal variables c ------------------------------------------------------------- real*8 sum,smd,xw,rw,vg,dvg,rr integer*4 i1,i2,lw sum = zero smd = zero do lw = lw1, lw2 xw = dabs(ww - wav(lw)) / wdop if (xw .ge. xvgt(nvgt)-dxvgt) then rw = (xvgt(nvgt) / xw) ** 2 vg = yvgt(nvgt) * rw dvg = dvgt(nvgt) * rw else i1 = xw/dxvgt i1 = i1 + 1 i2 = i1 + 1 rr = (xw - xvgt(i1)) / (xvgt(i2) - xvgt(i1)) vg = yvgt(i1) + rr*(yvgt(i2) - yvgt(i1)) dvg = dvgt(i1) + rr*(dvgt(i2)-dvgt(i1)) end if sum = sum + str(lw)*vg smd = smd + str(lw)*dvg+dstr(lw)*vg-half*str(lw)*vg/temp end do op = sum/wdop dp = smd/wdop return end