foam.f

Go to the documentation of this file.

      subroutine foam
c
c     compute the contribution from foam to the upwelling radiance
c     just above the sea surface
c
c**********************************************************************
c
      implicit real*8 (a-h,o-z)
      include 'afrt_rt2.cmn'
      real*8 ref(39)
c
c     effective reflectance of the whitecaps (Koepke, 1984)
      data ref/
     &0.220,0.220,0.220,0.220,0.220,0.220,0.215,0.210,0.200,0.190,
     &0.175,0.155,0.130,0.080,0.100,0.105,0.100,0.080,0.045,0.055,
     &0.065,0.060,0.055,0.040,0.000,0.000,0.000,0.000,0.000,0.000,
     &0.000,0.000,0.000,0.000,0.000,0.000,0.000,0.000,0.000/
c
      wl=xlam*1.0d4
c     write(6,50)pi,vz,wl,pflx
50    format('pi,vz,wl,pflx',1p4e11.3)
C     compute whitecaps reflectance 'afoam' for wavelength 'wl'
      iwl=1+idint((wl-0.2)/0.1)
c     write(6,*)'iwl',iwl
      wlp=0.5+(iwl-1)*0.1
      afoam=ref(iwl+1)+(wl-wlp)/0.1*(ref(iwl)-ref(iwl+1))
c
c     write(6,100)wl,wlp,afoam
100   format('white caps ref. wl,wlp,afoam',1p3e11.3)
      if(ifoam.eq.1)then
         fracfm=2.95d-6*vz**3.52d0
         bfr1(75)=fracfm
         ffoam=afoam*fracfm
c        write(6,150)fracfm,afoam,ffoam
150      format('fracfm,afoam,ffoam',1p3e11.3)
c        foam reflected radiance
         xifm=(ffoam*pflx)/pi
      else
         ffoam=0.0d0
         fracfm=0.0d0
         xifm=0.0d0
      endif
c     write(6,9988)ifoam,iwatr,fracfm,xifm
 9988  format('ifoam,iwatr,fracfm,xifm',2i2,1x,1p2e11.3)
c
      return
      end
c
c**********************************************************************