text:
c
c     version 1.2  Mar 1992
c
c     Pltsec routine for PLTSYN
c
c     ----------------------------------------------------------------
c
      subroutine pltsec(vred,xomit,nskip,ipol,tol,nptsw,itrev,idump,
     +                  iamp,twin,imeth,iroute)
c
c     plot synthetic seismic sections using the time, amplitude,
c     and phase of each arrival read in from unit 11
c
      include 'pltsyn.par'
c
      real dist(pseis),s(ppseis),r(ppseis+121),time(ppseis),
     +     sect(pseis,parriv,3),max,wavlet(pwavlt),xamp(parriv*pseis),
     +     tamp(parriv*pseis),
     +     hil(121),xomit(1),sp(ppseis),tp(ppseis),maxamp,minamp
      integer na(pseis),ipamp(parriv*pseis)
      character tlab*12
c
      include 'pltsyn.com'
c
      data wavlet/.01,.072,.121,.12,.044,-.113,-.32,-.512,-.607,
     +           -.538,-.283,.112,.542,.875,1.0,.875,.542,.112,
     +           -.283,-.538,-.607,-.512,-.32,-.113,.044,.12,
     +            .121,.072,.01,71*0./
      nseg=0
      p121=ppseis+121
      pi2=6.283185307
      dens=dens/2.
      fifi=float(ifill)
      tol=tol/xscale
      npts=nint((tmax-tmin)*sps)+1
      nptsp=npts+121
      nomit=0
      if(vred.ne.0.) then
        rvred=1./vred
      else
        rvred=0.
      end if
      nwin=nint(twin*sps)
      do 40 i=1,pseis
         if(xomit(i).lt.-99998.) go to 50
         nomit=nomit+1
40    continue
50    do 80 i=1,npts
         if(itrev.ne.1) then
           time(i)=(float(i-1)/sps)/tscale+orig
         else
           time(i)=(tmin+float(i-1)/sps-tmax)/tscale+orig
         end if
80    continue
      if(ishade.eq.1) then
        ptmm=abs(tscale)*sps
        if(ptmm.lt.dens) then
          nvaplt=nint(dens*float(npts)/ptmm)
        else
          nvaplt=npts
        end if
        if(nvaplt.gt.ppseis) then
          write(6,565)
565       format(/'***  interpolated trace for shading too long  ***'/)
          stop
        end if
        if(nvaplt.gt.npts) call intrtr(time,npts,nvaplt)
      end if
      do 90 i=2,60,2
         fudge=float(i)*.00018604-.00037207
         hil(61+i-1)=.6366198/float(i-1)-fudge
         hil(61-i+1)=-hil(61+i-1)
90    continue
      if(iconv.eq.1) then
        if(iwavlt.lt.2) then
          if(iwavlt.eq.0) then
            nwave=29
            nwave1=30
          else
            nwave=nptsw
            nwave1=nwave+1
            pf=pi2/float(nptsw-1)
            do 430 i=1,nptsw
               wavlet(i)=sin(pf*float(i-1))
430         continue
          end if
        else
          nwave1=1
450       read(20,451,end=440) wavlet(nwave1)
451       format(f10.3)
          nwave1=nwave1+1
          go to 450
440       nwave=nwave1-1
          if(nwave.eq.0) then
            write(6,505)
505         format(/'***  w.in is empty  ***'/)
            stop
          end if
        end if
        wsum=0.
        do 445 i=1,nwave
           wsum=wsum+wavlet(i)
445     continue
        wmean=wsum/float(nwave)
        do 455 i=1,nwave
           wavlet(i)=wavlet(i)-wmean
455     continue
        wmax=0.
        do 465 i=1,nwave
           if(abs(wavlet(i)).gt.wmax) wmax=abs(wavlet(i))
465     continue
        if(wmax.gt..000001) then
          do 475 i=1,nwave
             wavlet(i)=wavlet(i)/wmax
475       continue
        else
          write(6,405)
405       format(/'***  source wavelet is zero  ***'/)
          stop
        end if
        if(abs(wavlet(1)).lt..001) wavlet(1)=sign(.001,wavlet(1))
        if(abs(wavlet(nwave)).lt..001)
     +                wavlet(nwave)=sign(.001,wavlet(nwave))
        if(ipol.eq.-1) then
          do 130 i=1,nwave
             wavlet(i)=-wavlet(i)
130       continue
        end if
        twave=float(nwave-1)/sps
      end if
      if(itrev.ne.1) then
        yorig=orig
        iside=1
      else
        yorig=orig+tmm
        iside=-1
      end if
c
      if(iplot.ge.-1) then
        call plots(xwndow,ywndow,iroute)
        iplots=1
      end if
      read(11,5,end=999) xshot,idum
c
1000  continue
c
      maxamp=0
      ntplt=0
      nsexsp=0
      nhpts=npts
      if(iplot.ge.-1) call erase
      if(iplot.ge.-1.and.iseg.eq.1) call segmnt(1)
      if(iplot.ge.-1) then
      if(vred.eq.0.) then
        nchart=8
        tlab='TIME (s)'
      else
        i1=int(vred)
        id1=int((vred-float(i1))*10+.05)
        id2=int((vred-float(i1)-float(id1)/10.)*100.+.5)
        if(id1.eq.0.and.id2.eq.0) then
          nchart=9
          tlab='T-D/  (s)'
          tlab(5:5)=char(i1+48)
        else
          if(id2.eq.0) then
            nchart=11
            tlab='T-D/    (s)'
            tlab(5:7)=char(i1+48)//'.'//char(id1+48)
          else
            nchart=12
            tlab='T-D/     (s)'
            tlab(5:8)=char(i1+48)//'.'//char(id1+48)//char(id2+48)
          end if
        end if
      end if
      call axtick(xmin,xmax,xtmin,xtmax,ntickx,ndecix)
      call axtick(tmin,tmax,ttmin,ttmax,ntickt,ndecit)
      call axis(orig,yorig,xmin,xmax,xmm,xscale,0.,iside,
     +          xtmin,xtmax,ntickx,ndecix,'DISTANCE (km)',13,albht)
      call axis(orig,orig,tmin,tmax,tmm,tscale,90.,1,
     +          ttmin,ttmax,ntickt,ndecit,tlab,nchart,albht)
      call box(orig,orig,orig+xmm,orig+tmm)
      end if
c
      nseis=0
c
180   read(11,5,end=991) dists,nas
5     format(f10.3,i10)
      if(nas.lt.0) then
        xshotn=dists
        go to 99
      end if
      nseis=nseis+1
      dist(nseis)=dists
      na(nseis)=nas
      if(na(nseis).gt.parriv) then
        write(6,555) dist(nseis)
555     format(/
     +  '***  max # of arrivals on seismogram at',f10.3,
     +  ' km exceeded ***'/)
        stop
      end if
      if(na(nseis).gt.0) then
        if(iscale.eq.2) then
          range=abs(dist(nseis)-xshot)
          if(range.eq.0.) range=.001
          rr=range**rcor
        end if
        do 190 j=1,na(nseis)
           read(11,15,end=999) (sect(nseis,j,k),k=1,3)
15         format(3e12.5)
           if(iscale.eq.2) then
             samp=abs(sect(nseis,j,2)*rr)
             if(samp.gt.maxamp) maxamp=samp
           end if
           if(vred.gt.0.) then
             sect(nseis,j,1)=
     +            sect(nseis,j,1)-abs(dist(nseis)-xshot)/vred
           end if
190     continue
      end if
      go to 180
c
991   xshotn=-999999.
99    if(iscale.eq.2) then
        scalef=amp/maxamp
        write(6,25) scalef*xnorm**rcor
25      format(/'***  scalef=',f15.5,'  ***')
      end if
c
      if(iamp.gt.0) then
        namp=0
        rewind(17)
107     read(17,45) xr,tr,ur,ir
45      format(3f10.3,i10)
        if(ir.le.0) then
          if(ir.lt.0) go to 108
          if(abs(xshot-xr).lt..001) then
            iflags=1
          else
            iflags=0
          end if
        else
          if(iflags.eq.1) then
            namp=namp+1
            xamp(namp)=xr
            tamp(namp)=tr-abs(xshot-xr)*rvred
            ipamp(namp)=ir
          end if
        end if
        go to 107
108     if(namp.eq.0) write(*, fmt="(/
     +                '***  error in file tx.out  ***'/)")
        if(namp.gt.0) write(18,45) xshot,0.,0.,0
      end if
      idir=1
c
      do 70 i=1,nseis
         npts=nhpts
         if(mod(i,nskip).ne.0) go to 70
         if(dist(i).lt.xmin.or.dist(i).gt.xmax) go to 70
         if(nomit.gt.0) then
           do 75 j=1,nomit
              if(abs(xomit(j)-dist(i)).lt..001) go to 70
75         continue
         end if
         nsexsp=nsexsp+1
         do 170 j=1,nptsp
            r(j)=0.
170      continue
         if(na(i).gt.0) then
           do 270 j=1,na(i)
              if(iconv.eq.1.and.((sect(i,j,1)+twave).lt.tmin.or.
     +           sect(i,j,1).gt.tmax)) go to 270
              nstart=nint((sect(i,j,1)-tmin)*sps)
              sn=sin(sect(i,j,3))*sect(i,j,2)
              kpos=nstart+61
              if(kpos.gt.0.and.kpos.le.nptsp)
     +          r(kpos)=r(kpos)+cos(sect(i,j,3))*sect(i,j,2)
              do 370 k=2,120,2
                 kpos=nstart+k
                 if(kpos.gt.0.and.kpos.le.nptsp)
     +             r(kpos)=r(kpos)-hil(k)*sn
370           continue
270        continue
         end if
         if(nsmth.gt.0) then
           do 280 j=1,nsmth
              call smooth(r,nptsp)
280        continue
         end if
         if(iconv.eq.1) then
           do 470 j=1,npts
              s(j)=0.
              if(j.le.(nwave-60)) then
                kmax=j-59
              else
                kmax=nwave
              end if
              do 570 k=1,kmax
                 s(j)=s(j)+wavlet(k)*r(j-k+60)
570           continue
470        continue
         else
           do 460 j=1,npts
              s(j)=r(j+60)
460        continue
         end if
c
         if(inmo.eq.1) call nmo(s,npts,sps,tmin,dist(i),vrms)
c
         if(idump.eq.1) then
           write(12,35) (s(j),j=1,npts)
35         format(36(100a4))
         end if
c
         if(namp.gt.0) then
           do 109 j=1,namp
              if(abs(xamp(j)-dist(i)).lt..001) then
                n0=nint((tamp(j)-tmin)*sps)+1
                n1=n0+nwin
                if(n0.lt.1) n0=1
                if(n1.lt.1) n1=1
                if(n0.gt.npts) n0=npts
                if(n1.gt.npts) n1=npts
                nwina=n1-n0+1
                minamp=0.
                maxamp=0.
c
                if(n1.gt.n0) then
                  if(imeth.ne.1) then
                    do 360 jj=n0,n1
                       if(s(jj).lt.minamp) minamp=s(jj)
                       if(s(jj).gt.maxamp) maxamp=s(jj)
360                 continue
                    maxamp=(abs(minamp)+abs(maxamp))/2.
                  else
                    sum=0.
                    do 361 jj=n0,n1
                       sum=sum+abs(s(jj))
361                 continue
                    maxamp=sum/float(nwina)
                  end if
                  if(maxamp.gt.0.) maxamp=alog10(maxamp)
                  write(18,45) xamp(j),maxamp,0.,ipamp(j)
                end if
              end if
109        continue
         end if
c
         if(iplot.lt.-1) go to 70
         if(iscale.eq.0) then
           max=0.
           do 480 j=1,npts
              if(abs(s(j)).gt.max) max=abs(s(j))
480        continue
           if(max.gt.0.) then
             f=amp/max
             do 490 j=1,npts
                s(j)=f*s(j)
490          continue
           end if
         end if
         if(iscale.gt.0) then
           range=abs(dist(i)-xshot)
           if(range.eq.0.) range=.001
         end if
         if(iscale.eq.1) then
           srn=scalef*(range/xnorm)**rcor
           do 580 j=1,npts
              s(j)=srn*s(j)
580        continue
         end if
         if(iscale.eq.2) then
           sr=scalef*range**rcor
           do 610 j=1,npts
              s(j)=sr*s(j)
610        continue
         end if
         if(clip.gt.0..and.iscale.eq.1) then
           do 590 j=1,npts
              if(abs(s(j)).gt.clip) s(j)=sign(clip,s(j))
590        continue
         end if
         tmean=(dist(i)-xmin)/xscale+orig
         do 600 j=1,npts
            s(j)=s(j)/xscale+tmean
600      continue
         if(ishade.eq.1) then
           if(nvaplt.gt.npts) call intrtr(s,npts,nvaplt)
           npts=nvaplt
         end if
         if(tol.gt.0..and.npts.gt.2) then
           nplt=1
           sp(nplt)=s(1)
           tp(nplt)=time(1)
           do 700 j=2,npts-1
              if(abs(s(j)-tmean).ge.tol) then
                nplt=nplt+1
                sp(nplt)=s(j)
                tp(nplt)=time(j)
              end if
700        continue
           nplt=nplt+1
           sp(nplt)=s(npts)
           tp(nplt)=time(npts)
         else
           nplt=npts
           do 710 j=1,nplt
              sp(j)=s(j)
              tp(j)=time(j)
710        continue
         end if
         ntplt=ntplt+nplt
         if(idir.eq.1) then
           nl1=1
           nl2=2
           nl3=nplt
           istep=1
         else
           nl1=nplt
           nl2=nplt-1
           nl3=1
           istep=-1
         end if
         call plot(sp(nl1),tp(nl1),3)
         do 620 j=nl2,nl3,istep
            if(ishade.eq.1) then
              if((fifi*(sp(j)-tmean)).ge.0..and.
     +           (fifi*(sp(j-istep)-tmean)).ge.0.)
     +           call plot(tmean,(tp(j)+tp(j-istep))/2.,2)
                 ntplt=ntplt+1
            end if
            call plot(sp(j),tp(j),2)
620      continue
c
         call empty
c
         idir=-idir
70    continue
c
      npts=nhpts
      if(iplot.ge.-1.and.nsexsp.gt.0.and.tol.gt.0.) then
        per=float(ntplt)/float(nsexsp*npts)*100.
        write(6,105) per,tol*xscale
105     format(/'***  ',f6.2,' % of points'
     +         ,' plotted using spmin=',e9.3,'  ***')
      end if
c
      write(6,665) xshot
665   format(/'>>>  shot at ',f10.3,' km completed  <<<')
      if(xshotn.gt.-999998.) then
        xshot=xshotn
        if(iplot.ge.-1.and.iseg.eq.1) call segmnt(0)
        if(iplot.ge.-1.and.iroute.eq.1) call aldone
        go to 1000
      end if
c
      if(namp.gt.0) write(18,45) 0.,0.,0.,-1
c
      return
c
999   write(6,995)
995   format(/'***  insufficient data in sect.out  ***'/)
c
      return
      end


text:
        subroutine compare_analysis_to_rad(i4time,ni,nj          ! I
     1  ,cvr_sao_max,solar_alt,cvr_snow,cloud_albedo             ! I
     1  ,cloud_frac_vis_a,tb8_k,t_gnd_k,td_sfc_k,cvr_max,r_missing_data
     1  ,dbz_max_2d,cld_snd,ista_snd,max_cld_snd,cld_hts,KCLOUD
     1  ,rad_s,n_cld_snd,c_stations,lat_s,lon_s,elev_s,maxstns
     1  ,n_obs_b
     1  ,swi_2d)                                                 ! O

        include 'trigd.inc'

        difftwi(altf) = ! W/m**2
     1         4. * exp(0.50 * altf - 0.108 * altf**2 - .0044 * altf**3)

        real cloud_frac_vis_a(ni,nj),tb8_k(ni,nj),t_gnd_k(ni,nj)
     1        ,td_sfc_k(ni,nj),cvr_max(ni,nj),cvr_sao_max(ni,nj)
     1        ,dbz_max_2d(ni,nj),solar_alt(ni,nj),swi_2d(ni,nj)
     1        ,cvr_snow(ni,nj),cloud_albedo(ni,nj)

!       How much the solar radiation varies with changes in cloud fraction
        real cvr_scl_a(ni,nj)
        real cvr_rad(ni,nj)

        real rad_clr(ni,nj)

        real airmass_2d(ni,nj)
        real pw_2d(ni,nj)
        real trans_h2o_2d(ni,nj)

        real dum_2d(ni,nj)

        real cld_snd(max_cld_snd,KCLOUD)
        integer ista_snd(max_cld_snd)
        real cld_hts(KCLOUD)

        character c_stations(maxstns)*(*)
        character stn(maxstns)*20
        character a24time*24

        real lat_s(maxstns), lon_s(maxstns), elev_s(maxstns)
        real rad_s(maxstns)
        real rad2_s(maxstns)
        real swi_s(maxstns)
        real resid_s(maxstns)
        real cvr_s(maxstns)

        real dum_s(maxstns)

        real ea(maxstns)

        integer ii_s(maxstns)
        integer jj_s(maxstns)
        integer doy

        character*3 c3_discrep
        character*1 c1_c
        character title*60, ver_file*256, filename*9

        write(6,*)' Comparing cloud/sat/sfc data to solar radiation'

        do j = 1,nj
        do i = 1,ni
            cvr_max(i,j) = min(cvr_max(i,j),1.00)

            if(solar_alt(i,j) .gt. 0.)then
                airmass_2d(i,j) = min(1./cosd(solar_alt(i,j)),40.)
            else
                airmass_2d(i,j) = 40.
            endif

        enddo ! i
        enddo ! j

        ea = 100. ! default
        resid_s = r_missing_data
        call make_fnam_lp(i4time,filename,istatus)

!       Get zenithal solar radiation
        read(filename(3:5),*)doy
        rad_dist_factor = radnorm(doy)
        write(6,*)' distance rad_factor = ',rad_dist_factor

        solar_constant = 1353.
        solar_irradiance = solar_constant * rad_dist_factor
        transmittance = 0.820 ! catchall for various types of absorption / scattering

        model = 1
        if(model .eq. 1)then
            rad_zenith_clr = solar_irradiance * transmittance
            write(6,*)' rad_zenith_clr = ',rad_zenith_clr
        elseif(model .eq. 2)then ! Laue formula
            a = 0.14
            h = 1600. / 1000. ! elevation in km
!           direct = solar_irradiance
!    1             * ( (1. - a*h) * 0.7**(airmass_2d**0.678) + a*h )
!           global = 1.1 * direct
        elseif(model .eq. 3)then ! Drexel model
            pw_2d = 1.0 ! cm
            trans_h2o_2d = 1.0 - 0.077 * (pw_2d * airmass_2d)**0.3
        endif

!       Calculate solar radiation field
!       Some type of regression to the solar radiation obs can be considered later
!       Note that 'cvr_rad' is used instead of 'cvr_max'. Perhaps the criteria here
!       can be used upstream to improve 'cvr_max', so that the visible satellite can
!       be used to increase cloud fraction.
        do j = 1,nj
        do i = 1,ni
!           Set how much solar radiation varies with changes in cloud fraction
            if(cloud_frac_vis_a(i,j) .ne. r_missing_data)then
                if(cvr_snow(i,j) .eq. r_missing_data .OR.
     1             cvr_snow(i,j) .le. 0.50                )then
                    cvr_scl_a(i,j) = 1.0 ! scaling where we have VIS data
                    if(cloud_albedo(i,j) .ne. r_missing_data)then
                        cvr_rad(i,j) = cloud_albedo(i,j)
                    else
                        cvr_rad(i,j) = cvr_max(i,j) ! cloud_frac_vis_a(i,j)
                    endif
                else
                    cvr_scl_a(i,j) = 1.0 ! scaling where we have VIS data & snow cover
                    if(cloud_albedo(i,j) .ne. r_missing_data)then
                        cvr_rad(i,j) = cloud_albedo(i,j)
                    else
                        cvr_rad(i,j) = cvr_max(i,j)
                    endif
                endif
            else
                cvr_scl_a(i,j) = 0.7 ! scaling without VIS data (just IR)
                if(cloud_albedo(i,j) .ne. r_missing_data)then
                    cvr_rad(i,j) = cloud_albedo(i,j)
                else
                    cvr_rad(i,j) = cvr_max(i,j)
                endif
            endif

            if(model .eq. 1)then ! simple formula (radiation on horizontal)
                x = solar_alt(i,j)
!               altfunc = sind(x)
!               altfunc = sind(x)**(1.0 + 0.2 * cosd(x)**9.)
                altfunc = (0.9 * sind(x)) + (0.1 * sind(x)**2)
                vapor_p = esat(td_sfc_k(i,j) - 273.15) ! mb
                trans_h2o_2d(i,j) = (1.0 - (vapor_p / 200.))
                rad_clr(i,j) = max(rad_zenith_clr * altfunc
     1                           * trans_h2o_2d(i,j),0.)

!               Add term when sun is near or below the horizon
                if(x .gt. 0.)then
                    ghi_twiterm = 4. * exp(-((x/5.)**2))
                elseif(x .gt. -18.)then ! twilight
                    ghi_twiterm = difftwi(x)
                else
                    ghi_twiterm = 0.
                endif

                rad_clr(i,j) = rad_clr(i,j) + ghi_twiterm

            elseif(model .eq. 2)then ! start to using Laue formula
                                     ! (normal to sun's rays)
                a = 0.14
                h = 1600. / 1000. ! elevation in km
                if(solar_alt(i_i,i_j) .gt. 0.)then
!                   direct = solar_irradiance
!    1                    * ( (1. - a*h) * 0.7**(airmass**0.678) + a*h )
!                   global = 1.1 * direct
                endif

            endif

!           100% cloud cover has (1-cvr_scl) of possible solar radiation
            swi_2d(i,j) = rad_clr(i,j)
     1                  * (1.0- (cvr_scl_a(i,j)*cvr_rad(i,j)))
        enddo ! i
        enddo ! j

        write(6,*)' solar_alt CTR = ',solar_alt(ni/2,nj/2)
        write(6,*)' cloud_alb CTR = ',cloud_albedo(ni/2,nj/2)
        write(6,*)' rad_clr   CTR = ',rad_clr(ni/2,nj/2)
        write(6,*)' cvr_scl_a CTR = ',cvr_scl_a(ni/2,nj/2)
        write(6,*)' cvr_rad   CTR = ',cvr_rad(ni/2,nj/2)
        write(6,*)' swi_2d    CTR = ',swi_2d(ni/2,nj/2)

        if(.true.)then
            iwrite = 0

            n_ovc = 0
            n_tovc = 0
            n_sct = 0
            n_bkn = 0
            n_tsct = 0
            n_tbkn = 0
            ovc_sum = 0.
            tovc_sum = 0.
            sct_sum = 0.
            bkn_sum = 0.
            tsct_sum = 0.
            tbkn_sum = 0.

            sumobs = 0.
            sumanl = 0.
            sumalt = 0.
            sumresid = 0.
            sumscl = 0.
            cnt = 0.

            sumcld = 0.
            sumsnow = 0.
            sumclr = 0.

            swi_s = r_missing_data
            rad2_s = r_missing_data

            do ista = 1,n_obs_b
              stn(ista) = c_stations(ista)(1:3)

!             write(6,*)ista,rad_s(ista)

              if(rad_s(ista) .ge. 0.)then ! valid value
                call latlon_to_rlapsgrid(lat_s(ista),lon_s(ista),lat,lon
     1                          ,ni,nj,ri,rj,istatus)

                i_i = nint(ri)
                i_j = nint(rj)

                ii_s(ista) = i_i
                jj_s(ista) = i_j

                if(i_i .ge. 3 .and. i_i .le. ni-2 .and.
     1             i_j .ge. 3 .and. i_j .le. nj-2            )then

                    if(iwrite .eq. iwrite/20*20)then
                        write(6,*)'sv '
                        write(6,*)'sv Sta   i    j   VIS frac tb8_k  '
     1                  //'t_gnd_k transmt cv_s_mx cvr_mx '
     1                  //'solalt cv_r rad_an '
     1                  //'rad_ob rad_th ratio cv_sol  df'
                    endif

!                   Calculate 9pt cover
                    cvr_9pt = 0.
                    do ii = -1,1
                    do jj = -1,1
                        cvr_9pt = cvr_9pt + cvr_rad(i_i+ii,i_j+jj)
                    enddo ! jj
                    enddo ! ii
                    cvr_9pt = cvr_9pt / 9.

!                   Calculate 25pt cover
                    cvr_25pt = 0.
                    do ii = -2,2
                    do jj = -2,2
                        cvr_25pt = cvr_25pt + cvr_rad(i_i+ii,i_j+jj)
                    enddo ! jj
                    enddo ! ii
                    cvr_25pt = cvr_25pt / 25.

                    iwrite = iwrite + 1

                    c1_c = ' '
                    c3_discrep = '   '

                    if(solar_alt(i_i,i_j) .gt. 0.)then
                        rad_ratio = rad_s(ista) / rad_clr(i_i,i_j)
                        cv_solar = (1.0 - rad_ratio)       ! 100% cloud cover
     1                           / (cvr_scl_a(i_i,i_j))    ! has (1-cvr_scl) of possible
                                                           ! solar radiation
                        cv_diff = cv_solar - cvr_rad(i_i,i_j)

!                       Determine residual of clear sky vs observed radiation
                        resid_s(ista) = 1.0 - rad_ratio

                    else
                        rad_ratio = 0.
                        cv_solar = 0.
                        cv_diff = 0.
                        resid_s(ista) = 0.0

                    endif

                    rad2_s(ista) = rad_s(ista)
                    swi_s(ista) = swi_2d(i_i,i_j)

                    if(swi_s(ista) .gt. 0.)then
                        radob_ratio = rad_s(ista) / swi_s(ista)
                    else
                        radob_ratio = 1.0
                    endif

!                   QC checks
                    if(radob_ratio .lt. 0.5      .and.
     1                 rad_s(ista) .ge. 100.           )then
                        c1_c = '+' ! Suspected high analysis
                    endif

                    if(radob_ratio .gt. 2.0      .and.
     1                 rad_s(ista) .ge. 100.           )then
                        c1_c = '-' ! Suspected low analysis
                    endif

                    if(radob_ratio .lt. 0.1 .and.
     1                 swi_s(ista) .ge. 100.      )then
                        c1_c = '*' ! QC'd out
                        rad2_s(ista) = r_missing_data
                    endif

                    if(rad_s(ista) - rad_clr(i_i,i_j) .gt. 500.)then
                       if(rad_clr(i_i,i_j) .gt. 100.)then
                          if(rad_s(ista)/rad_clr(i_i,i_j) .gt. 2.5)then
                             c1_c = '*' ! QC'd out
                             rad2_s(ista) = r_missing_data
                          endif
                       endif
                    endif

                    call qc_solar_ob(rad_s(ista),solar_alt(i_i,i_j)
     1                              ,r_missing_data,iqc
     1                              ,rad_clr(i_i,i_j))

                    if(iqc .ne. 0)then
                       c1_c = '*' ! QC'd out
                       rad2_s(ista) = r_missing_data
                    endif

                    write(6,1111,err=1112)'sv',c_stations(ista)(1:3)
     1                           ,i_i,i_j
     1                           ,cloud_frac_vis_a(i_i,i_j)
     1                           ,tb8_k(i_i,i_j)
     1                           ,t_gnd_k(i_i,i_j)
     1                           ,transmittance*trans_h2o_2d(i_i,i_j)
     1                           ,cvr_snow(i_i,i_j)
     1                           ,cvr_max(i_i,i_j)
     1                           ,solar_alt(i_i,i_j)
     1                           ,cvr_rad(i_i,i_j)
!    1                           ,cvr_25pt
     1                           ,swi_2d(i_i,i_j)
     1                           ,rad_s(ista)
     1                           ,rad_clr(i_i,i_j)
     1                           ,rad_ratio
     1                           ,cv_solar
     1                           ,cv_diff
     1                           ,c1_c
1111                format(1x,a2,1x,a3,2i5,f8.2,3f8.2,f7.2,f8.2,f6.1
     1                    ,f6.2,f8.1,2f7.1,3f6.2,1x,a,1x)

                    sumobs = sumobs + rad_s(ista)
                    sumanl = sumanl + swi_2d(i_i,i_j)
                    sumcld = sumcld + cvr_rad(i_i,i_j)
                    sumsnow = sumsnow + cvr_snow(i_i,i_j)
                    sumalt = sumalt + solar_alt(i_i,i_j)
                    sumresid = sumresid + resid_s(ista)
                    sumscl = sumscl + cvr_scl_a(i_i,i_j)
                    sumclr = sumclr + rad_clr(i_i,i_j)
                    cnt = cnt + 1.

                    cvr_s(ista) = cvr_rad(i_i,i_j)

1112            endif ! ob is in domain
              endif ! valid value
            enddo ! isnd

            write(6,*)
            write(6,*)' Generic stats:'
            call stats_1d(maxstns,swi_s,rad2_s
     1                   ,'Solar Radiation (QCed): '
     1                   ,a_t,b_t,xbar,ybar
     1                   ,bias,std,r_missing_data,istatus)

!           Write out line of stats for gnuplot (if data are valid)
            call cv_i4tim_asc_lp(i4time,a24time,istatus)
            if(cnt .gt. 0)then
                write(6,710)a24time,xbar,ybar,std,sumclr/cnt
            else
                write(6,*)' Write missing data due to zero count'
                pmsg = -99.9
                write(6,710)a24time,pmsg,pmsg,pmsg,pmsg
            endif
710         format(1x,a24,4f10.3,' gnuplot')

!           Calculate other stats
            if(cnt .gt. 0.)then
                write(6,*)' sw radiation comparison stats'
                if(sumanl .gt. 0.)then
                    write(6,*)' obs / anl ratio = ',sumobs/sumanl
                else
                    write(6,*)' obs / anl ratio not computed'
                endif

                write(6,801)sumcld/cnt,sumsnow/cnt,sumalt/cnt,xbar,ybar
     1                     ,sumclr/cnt
801             format(
     1          '  means: cloud frac, snow cover, solar alt = '
     1          ,2f7.2,f8.1,2x,
     1          '  analyzed, observed, clr_sky rad =',3f8.1)

                write(6,802)sumresid/sumcld, sumscl/cnt
802             format('  sensitivity of radiation to cloud '
     1                ,'fraction - measured/used: ',2f8.3)
            endif

            write(6,*)
            write(6,*)' Do regression on residuals vs cloud fraction'
            call regression(maxstns,cvr_s,resid_s
     1                   ,'Residuals vs cloud fraction: '
     1                   ,a_t,b_t,xbar,ybar
     1                   ,bias,std,r_missing_data,istatus)

!           Open file and call verification routine
            iunit = 11
            call get_directory('log', ver_file, len)
            ver_file = ver_file(1:len)//'qc/laps_sol.ver.'
     1                                //filename(6:9)
            call s_len(ver_file, len)
            open(iunit,file=ver_file(1:len),status='unknown',err=990)

            title = 'Solar Radiation (before qc): '

            call verify(swi_2d,rad_s,stn,maxstns,title,iunit
     &                 ,ni,nj,maxstns,dum_s,dum_s,dum_2d
     &                 ,ii_s,jj_s,ea,badflag)

            close(iunit)

990         continue

        endif ! do radiation comparison to analysis

        return
        end

ext: f

max_stars_repo_name: maxinye/laps-mirror

max_stars_repo_licenses: Intel Unlicense OLDAP-2.2.1 NetCDF

max_issues_repo_name: longwosion/laps-mirror

max_issues_repo_licenses: Intel NetCDF OLDAP-2.2.1 Unlicense

max_forks_repo_name: longwosion/laps-mirror

max_forks_repo_licenses: Intel NetCDF OLDAP-2.2.1 Unlicense


text:
Describe Users/JenniferH here.

20130319 10:44:41 nbsp Ok, I have created a page for the Center for Integrative Animal Medicine!  Maybe you can fill it out a bit, since you have some experience with the business. Users/CovertProfessor

20130319 10:54:43 nbsp There are plenty of us who will help, so if you provide the basic information, dont sweat about formatting or anything.  On the other hand, if you do want to learn, plenty of people will be happy to help teach you the finer details of wiki editing.  It is your wiki, so add what you know!  Users/JabberWokky Evan JabberWokky Edwards

20130319 11:51:26 nbsp Hi, welcome to the wiki and thanks for bringing my attention to CIAM! One of my rabbits has limited mobility and might benefit from trying out some alternative therapies. Have you used the doc or do you just know her? If youve used her services definitely post a review when you get a chance ) Users/MeggoWaffle

20130319 13:29:23 nbsp Hello, I don’t edit the wiki often but regularly use it for reviews and recommendations. I have not used the CIAM but I know someone who brings their kitty there for acupuncture and they are quite pleased with her services. When I was looking for a human acupuncturist for myself I came across your question about your pet and remembered my friend’s cat that goes to the CIAM. I was surprised she wasn’t listed on the wiki yet so I enlisted CovertProfessor to help create the page.  Jennifer Users/JenniferH

max_stars_repo_name: voflo/Search

max_issues_repo_name: voflo/Search

max_forks_repo_name: voflo/Search


text:
Kabul Afghan Cuisine was a restaurants restaurant that served (as one might expect) Afghan cuisine.  Food is available for take out, but there are plenty of reasons to sit down and enjoy your stay. The vast orange interior overlooks 2nd St. and is sparsely decorated with intricate Middle Eastern rugs. Other than Sophias, Thai Recipes and Mirai, Kabul provides the only other opportunity to sit on the floor while eating in Davis. However, less adventurous or flexible restaurant goers can find standard seating throughout the restaurant. Tables are adorned with a candle and a glass bottle of a spicy salad dressing. Customers are immediately given a basket of Afghan breads bread and individual bowls of undressed salad (iceberg lettuce, bell pepper, broccoli, cucumber).

The entrees are large, and their prices range from $8$13.   Coupons are available at their website.  They also have a buffet.

Appetizers
  Bolani kachaloo: turnover with chopped leeks, potatoes and seasoning, served with yogurt
  Bolani gandana: turnover stuffed with chopped leeks, cilantro and seasoning, served with yogurt
  Mantoo: Dumplings, stuffed with ground beef, chopped onions and seasonings. Topped with sauce
  Boarani badenjan: eggplant sauteed with fresh tomatoes, seasoned with herbs and garlic

Soups
  Aush soup: noodles, vegetables, and yogurt soup topped with meat sauce and sprinkled with dill
  Vegetable soup (Kabuls Special: a mixture of fresh vegetables and herbs

Entrees
  Quabili fallow: baked basmati rice with lamb, seasoned and topped with sauteed raisins and carrots
  Sabzi challow: sauteed spinach and herbs with lamb or chicken
  Kofta challow: beef meatballs in a seasoned tomato and split peas sauce
  Mantoo: Dumplings, stuffed with ground beef, chopped onions, and seasonings. Topped with sauce
  Korma: mushrooms, broccoli, carrots, peas, green beans, and lima beans sauteed in tomato and onion puree

Bolani
 (a larger portion of the appetizer. better suited to split across a group than as an entree)
  Bolani kachaloo: turnover with chopped leeks, potatoes and seasoning, served with yogurt
  Bolani gandana: turnover stuffed with chopped looks, cilantro and seasonings, served with yogurt

Kabobs
 (served with white or brown basmati rice)
  Chaplee kabob (ground sirloin)
  Teka beef kabob (whole beef)
  Shaami kabob (ground sirloin)
  Chicken kabob
  Lamb kabob
  Combination kabob

Desserts
  Firni: pudding with milk, rosewater and cardamom. Topped with pistachios.
  Sheer yaku: ice cream flavored with rosewater and cardamom. Topped with pistachios.

More Vegetarian Options vegetarian options are to be added. Belly dancers are also expected. They are freshly opened and still very much getting settled.

Prior to Kabul, the location hosted Hings, a Chinese restaurant.  The SBC telephone book lists Sara Onay instead of Kabul Afghan Cuisine, possibly indicating a change in name while the restaurant was being founded.

20050307 17:12:12 nbsp I tried the Quabili fallow and the Mantoo; both were great. Im looking forward to trying some of their other dishes. Users/JasonAller

20050412 10:12:42 nbsp The décor is very unusual, combining interesting textured fabrics with bold wall color. The lighting could use some help. The food is great (we had vegetarian sabzi challow and Bolani gandana, both excellent). Dont miss the Dough (cucumber & mint yoghurt drink). They need a graphic designer for the menu, though, to match the skill of the interior designer... and they need more waitstaff. Users/AlisonKent

20050415 15:16:10 nbsp My boyfriend and I went on a busy Friday night.  We were seated and it was 10 minutes before we got a menu and another 10 before we got water.  I ordered an eggplant entree and he got some beef dumplings.  Bad idea.  The eggplant which was around $8 consisted of 3 slices of eggplant in a tomato sauce.  Reminiscent of eggplant parm.  The dumplings were ok but not better than something from the Trader Joes freezer section.  Tried the Firni for dessert.  Could not detect any taste of rosewater or other spices it was rice pudding.  Considering the prices, small quantities, and the wait, were not going back.  If you go make sure to get the kababs.  I saw other customers with giant plates of food and am fairly certain thats what they ordered. Users/SamanthaGrant

20050430 02:21:48 nbsp Although the quality of food that you receive at Kabul Afghan Cuisine is good, for the size of the dishes themselves, the restaurant is overpriced. The decor of the restaurant was nice, but the restaurant is understaffed (and they need to be trained a little better). I went with three other people and we had the Vegetarian Sambosa and Pakawra (appetizer), Quabili Fallow, Mantoo, and the Chicken Kebob. Both appetizers were good, but not anything to write home about. The basmati rice with sauteed raisins and carrots that came with the Quabili was delicious, but we only received a small amount of lamb (too little for the price). The Mantoo was our tables favorite dish, a relatively generous portion of dumplings which had a nice texture and balance to them. Finally, the Chicken Kebob was delicious (but there were only five pieces of Chicken for $9). Overall Grade: C+  Users/AlvinTsao

20050508 16:11:12 nbsp We tried Kabul and I am sorry to say, we are not planning to try it again.  Users/ReuvenSegev

This place is totally underwhelming. While the interior is rather enjoyable ( other Davis restaurants could take a hint ) the food was mediocre and the waiter a complete asshole. I would never go back to this place! Users/SoniaPflaster

The decor is like anything else in Davis  painted walls with random ethnic wall hangings.  Yes, the eggplant is disappointing, but the kebabs are what you should go for.  Even better, go to the farmers market and get some amazing flatbread with excellent spreads. Users/EllenWoodall

20050614 13:32:50 nbsp They added a Lunch Buffet today ($7.95).  This is supposed to run 7 days/week.  The dishes were:   Vegetable soup,  Basmati Rice, Sabzi Spinach,  Kofta challow,  Badenjan challow, and a couple others (one with chicken, one with Cauliflower, and maybe one more that I cant remember).  They also had Afghan salad and bread.  I spoke with one of the staff and was told that after today there will also be a daily special dish in the buffet (Moday: Shaami Kabob, Wednesday: Chicken Kabob).  Over all I enjoyed it and will return. Users/OddBall

20050722 00:07:18 nbsp It was such BAD service! I hate asking for water when you are supposed to get some. Secondly, saying, Oh were going to need a couple of extra minutes does not mean, Leave me here to starve! We ordered the veg sambosas and the teka kabobs and then we waited. There were two parties that arrived after we did and they received their food first. Wheres the bread or salad? Another table asked for their bread and finally we were given ours (2 pieces). The hostess came over to us w/ our appetizer and said, Did you order an appetizer? Um yes. But it was pretty tasty and not overtly greasy. Eventually our kabob plate came. The meat was pretty goodwell seasoned, although well done. The rice was slightly on the drier side. To sum up: Bad service, decent (although overly priced) food, and there needs to be some belly dancers to improve the environmentthere is absolutely no energy there! Users/KarlaFung

I wasnt impressed.  Users/Wayne Schiller Wayne Schiller

20050825 10:52:08 nbsp Karen and I had lunch there a couple of days ago.  We arrived after 1pm and had the luncheon buffet.  Everything was wonderful!  There was rice, soup, a spinach dish, an eggplant dish, an okra dish, a cauliflower dish, meatballs, kabobs, mixed vegetables, cabbage salad,watermelon and Afgani bread.  We loved all of it!  We each returned for 2nds of the vegetables (particularly the cauliflower, okra and eggplant.)  The atmosphere is lovely and elegant, and the owner, Mustafa, is very gracious.  I will return as often as I possibly can!  HIGHLY recommended. Users/TammyMcNiff

20050904 21:04:22 nbsp Party of 4, on a Sunday just as they opened.  They apologized that the food would take a while since they needed to cook everything right then, so the lamb was going to take a while.  They were very attentive with refilling our water.  They brought us bread and butter.  They came back out again and said it was still taking a while to cook the lamb.  So then they were nice enough to bring us a small plate of samosas, one each, which we thought was very nice.  Unfortunately our lamb dishes were a bit on the salty side and the lamb was a bit tough.  It was not the same lamb dish that they serve in the buffet (which I have heard is very good).  I would go back and try the kabobs next time.  Not bad, but could be better. Users/IrenePark

20050918 11:26:54 nbsp Went to this place on a Friday night with my boyfriend. The place was kinda empty with one girl waiting on all the tables. The sambosas were good, but I had ordered the Champion Kabob and was completely disappointed. I couldnt even cut through the meat with the knife they gave me. The lamb was really subpar, and I was just disappointed with the whole meal. At least the waitress was really nice and funny. I wont be going back. Users/SuperRedhead

20050922 18:55:15 nbsp I had the buffet lunch at Kabul today and it was fabulous. The aromas of spices were pleasant and the food was mouthwatering. Our waitstaff was friendly and I enjoyed the atmosphere. All of the different choices of food complimented each other well. I am definintely coming back! You have to try it or you will be missing out on some great food. Users/MelissaChristianson

20051020 10:45:15 nbsp I ate dinner there Sat, very good kabobs.  Spicy, juicy, and not so spicy as to give indigestion.  Great belly dancing on Friday an saturday nights to boot! Users/AdamYergovich

20060130 13:40:55 nbsp Its not worth it unless you go when they have buffet. The plate sizes are not that big for the price you pay. The service is bad because they didnt come around to add water when we ran out. Everything was mushy and salsalike except for the kabobs.  Users/KiwiSelina

20060204 01:45:42 nbsp I took an old friend here last weekend.  I had the turnovers filled with leeks, and they were tasty.  But my friend, her fiancé, and their guest all ordered different things, and every one of them had frozen vegetable medley in its sauce (you know, that mixture of green bean pieces, corn kernels, peas, and little carrot bits?).  Something tells me that frozen vegetable medley is not an authentic Afghani cuisine element.  (That said, I liked my food, and my friends liked theirs, though we were none of us especially filled up.) Users/DanielBrown

20060322 19:49:15 nbsp A great place to go for good dinner in davis. Food is great. The owner is a very nice and friendly guy and the service is excellent. Users/CarolinaSandh

20060526 08:43:57 nbsp Me and the girlfriend had the teka beef and the lamb with sambosas. The service was excellent. Best I have ever had in Davis. Very attentitive, and knowledgeable. He asked if I wanted recommendations and explained everything I asked about on the menu. The food was GREAT! Probably one of the best foods youll have in Davis for sure. The lamb was so good, and the beef just right. Would highly recommend. Users/AlexKang

20060526 15:46:37 nbsp This place is really good... I love the Sabzi Chalau... spinach with lamb or chicken sauteed under longgrain Basmati rice. The staff is friendly and not in your face. I went in recently to get food to go   it was a short wait, and the food was yummy! For taste, one of my favorite restaurants in Davis. Users/GreenThing

20060530 09:08:01 nbsp I stopped in yesterday to try the lunch buffet and apparently its gone.  The lady behind the counter said no more buffet and it was crossed out on all their take home menus. Users/AlexPomeranz

20060611 14:33:14 nbsp Stopped by the day for their advertised weekday buffet and they got rid of it!  Very lame.  Was looking forward to trying it, but their meals prices look out of sight.  Am thinking no.  (note: My fiancee wrote this) Users/AlexPomeranz

20060617 10:42:55 nbsp Went there last night, and told the big guy we were in a hurry to catch a movie. He said theyd get us food in time to make it. We had the chicken kabob and an eggplant dish (waiter picked it with our approval, not sure which it actually was). The food was really good, we liked that the portions are not gigantic. Rice was good, spinach side was excellent. There was a belly dancer  dont forget to bring a few dollar bills! ;) Turns out, we were five minutes late for the movie, but the food was worth it. We plan on going back when we have a little more time. Oh, and all of the employees were pleasant. Users/JeffieBaby

20060804 10:32:14 nbsp When Hings closed down in Davis, I was visibly upset. This was the very first restaurant I had ever been to in Davis, and in my opinion the best Chinese food to. Soon many years went by, and I never dropped by the old haunt.

Lets go get Aghani food.

I sat a little dumbstruck for a moment. Afghani? First off, I had no idea what this style of cuisine consisted of. Second, there was a new Afghani restaurant in Davis? And I didnt know about it? Sure, sounds good. What kind of food is Afghani food?

Afghani food. I could hear her smile over the phone, amused by her own little snap. Ill see you at 6.

Apparently, Kabul Restaurant had moved into Hings old place, and right away I was more than glad. The inside had been lavishly decked out in ornate and richly colored rugs, a slight ersatz, but enjoyable and garunteed to put a smile on your face. The smiling hostess led Sarah and I up stairs to the raised seating area. We left our shoes behind us and sat on the floor amongst some squishy pillows on another rustic rug.

Afghani food definetly stands out in my mind amongst the various styles of middle eastern food. Each ingredient has been cooked to leave it feeling light, allowing each flavor and texture to be delicately dissected by your mouth. No dish is to glitzy or esoteric, relying on only three or four complimentary flavors to bring the whole dish together. Its quite amazing really. Plus, many of the dishes were IBS okay, and the kitchen was more than happy to offer veggie dishes, or alter any they had for you veggies out there.

I decided to start my meal with sheer chai. I heart chai. I even grind my own once in a blue moon, and love to make chai chocolate cupcakes, and chai truffles. Of course I would have to try a different variety when presented with it. The full flavored black tea, milk, with hints of sugar and cardamom and sugar, it tastes like a drink only a childs imagination could create. Refreshing, cool, sweet, and sigh can I even go on?

The Kabul Special Fish was a perfect example. Cat fish that was lightly flavored with saffron and admittedly, a spice completely foreign to us both, but heavenly. Served with rice and light veggies, the whole experience transported you to a little Afghani grandmas kitchen.

The Quabuli Palau was awesome. Its a traditional meal of sauteed lamb underneath basmati rice with slivers of carrots and raisins. Mint and turmeric gave this a definite pop, with a slight cool undertaste waiting to surprise you in the back, only to calm you down with the sweet pulp of the raisins.

Service was quick, prices were perfect for generous and tasty portions, and the hostess was able to awnser any and all questions I threw at her about the food and the establishment. Props to the knowledgable staff.

One visit was not enough, I soon returned with Rob to sit down once again, this time to a full house and belly dancers. Lots of patrons and belly dancers do make this place a tad bit loud, and we had to struggle a bit to hear each other, but I had a feeling this was an exceptionally raucous evening.

The Bolani Grandana were delicious turnover and eggplant, filled with chopped leeks, cilantro, and special seasoning which I didnt bother to ask about as I doubt the waitress knew sign language and I wasnt about to shout out my inquisition.

The Shaami Kabob was a skewer of ground sirloin served with sauteed vegetables, yogurt, a cilantro sauce, and topped with sumac. Honestly I never had sumac before, and all I knew was that it could cause blindness if it gets in your eyes, but damn, theres no way to put it. It has a slightly tangy, fruity, tart flavor with a subtle undertone of pine.

Sarah was dead on the money with this place. The only real downside I found was the afghani bread. Dry, hard, and really flavorless. Adding just some herb, salt, or oil would dramatically improve this.

For a new flavor at a great price (between $8$13) and great portions, I highly suggest you kick off your shoes, sit down with some sheer chai, and order yourself some kabobs from Kabul. Users/ProtoGarrett

20060917 13:21:12 nbsp i really like this place.  the presentation is clean, the service is good and the flavors are great.  i certainly reccomend anything lamb here.  ive had bad experiences with lamb in the past, usually it is quite chewy, but here it is as tender as any piece of beaf.  the egplant dish was great, so were the chicken kabob and the turnovers.  the kormas were ok (i perfer the indian style myself), but their pudding was surprisingly good and so was there sambosas.  will come back again.  its nice to finally have a medium priced upscale place in davis. The only con is the buffet, i found it quite underwhelming on both of my mid day ventures. Users/MattHh

20061028 22:21:09 nbsp At first, we were dissapointed. The bellydancing advertized only a week ago was discontinued. The host said they may start it up again, but was unsure when. However, I was sooooo glad that we stayed. The food was AMAZING! So my only complaint would be that they should keep up on their advertizing. Users/KellyEvans

20061220 22:36:50 nbsp One of my favorite restaurants in Davis (and I dont have many favorites). Food is delicious. Service is best on slow days. On busy days, they are somewhat understaffed, but no one has been rude to me. I usually come here once a week, when Im too lazy to cook. Users/ThucNghiNguyen

20070107 12:44:37 nbsp Ive been here several times and their food is delicious.  I havent been there in a while so I dont know if they still have their buffet, but I prefer their entrees rather than their buffet. Users/BeeBooBee

20070127 12:53:27 nbsp The Teka Beef and Lamb kabobs are excellent and accentuate the natural flavors of the meats. The Chicken Kabob was good, the Bolani kachaloo was too much for one person but very good to split with others, the Korma was hearty for a vegetarian dish. The Kofta challow (meatballs) didnt do anything for me. The meat Mantoo dumplings were delicious, the Quabili fallow was a good combo of sweet and savory flavors, and the  Sabzi challow had a sparse amount of meat. If they have the special bonein Lamb Kebob, drop everything and get this this is some majorly awesome meat. As with any hunk of meat this tender, there are huge globs of fat in it, but thats a small sacrifice for such a delicious payoff. Users/CraigBrozinsky

20070402 00:14:28 nbsp My boyfriend and I went here last night, and we were not impressed.  His lamb korma was okay, and my bonein lamb dish was only soso.  What was weirdest was the bellydancing  although we did enjoy the entertainment, one of the servers stuck a tip in her waistband, and a couple of kids dining with family followed suit.  This cant be customary?!?!

20070414 13:37:10 nbsp Its my first shot and I tried Kofta challow and Korma but it tastes ok but not impressive. Maybe the buffet would be a better choice for the first visit.  Users/ShawnYe

20070502 20:35:13 nbsp I really like this Afghan restaurant quite a bit. They have an allyoucaneat lunch buffet and regular dinners. The atmosphere is comfortable, the waitstaff is friendly, and, most importantly, the food is delicious — it is wonderfully spiced and flavorful. Users/CovertProfessor

20070517 23:38:43 nbsp We ate there today and the buffet is back.  The food is good, only its generally too salty.  The solution to that is to drink plenty of water.  As for for service, there was only one guy looking after the whole restaurant, but he was a nice guy.  For an inexpensive buffet, you cant really complain.

No wait either.  More people ought to eat here. Users/GregKuperberg

20070525 17:36:24 nbsp Very very bad!! I ordered the Mantoo.. it was basically Costco potstickers in a bland, watery, salty gravy.  Also, the vegetables on top were obviously straight out of a bag of frozen veggies a la Green Giant or S&W or the like.  If you like this place, tell me what other places you like so I can avoid them as you obviously have terrible taste.  The aush soup was better but tasted like it came out of a can.  Also the service is terrible and slow.  Sorry, I really wanted to like this place.  Do not go here. Users/BillyBudd

20070530 18:30:43 nbsp Go to  http://theshamelessfoodies.blogspot.com/2007/05/treatiseoncurrentstateofculinary_30.html
For Brooks and Kristens review of our experience at Kabul
 Users/BrooksHayes

20070619 01:00:47 nbsp The food was fine, but it was very expensive.  I particularly liked the sambosatheres not much, but it is flavorful and comes with an interesting sauce.  The bread was different enough to please me.  Everyone enjoyed the chicken dishes.  The waiter was overworked. Users/MisterProfessor

20070713 20:49:27 nbsp The lamb kabob is hands down one of the best Ive ever hadvery juicy and flavorful with Afghan spices. However, you ONLY get 5 pieces of meat for $16. They try to compensate with mounds of rice, but that was a huge disappointment. Youll need to spend a lot of $ to feel satisfied or expect to eat a snack when you arrive home. Users/Jennysmilowitz

20070719 18:33:08 nbsp I am known for harsh criticism kabul is very good but this is my first ever afgan meal was very good not the best service but good food i will come back Users/dickjones

20070722 18:20:00 nbsp It wasnt very busy when I went there with my friend. Both of us were very impressed by the food. The decor was nice, not too much but not too plain. Everyone should try it at least once.  Users/AlexandraDeGrange

20070917 21:02:21 nbsp My wife and i had a very nice time here.  The food was very good, and the people were great as well.  We frequent Mediterranean, Middle Eastern, and Indian places as much as we can, and this one was very good.  8/10. Users/BC

20071012 23:28:14 nbsp I had the Sabzi challow and did not like it because the beef was hard and not very tasty.  Overall I was disapointed, I had high expectations for this one.   Users/ingrid

20071024 15:51:32 nbsp I loved this place.  I sat on the dais on the floor, which was very neat and pillows to sit on are very comfy.  The bread was so good (if you like hummus, get it, and an extra order of bread!) My dish, the typical dish of the region (Quabili) was not bad, but my boyfriend had the weekend special of the lamb which is marinated for 24 hours and served as a kabob.  It was honestly so good and I was so full after leaving.  They need more waitstaff, though.  All together, a great experience.   Users/LolaTorney

20071103 13:09:58 nbsp I had the misfortune of suggesting this place to a group of friends and I don’t think any of us will be going back anytime soon. We were there on a Friday night and there were a number of guests, albeit zero atmosphere – e.g. no music. We were seated for a long time without getting water or any other attention from the wait staff. When they took our order, several of the menu items were unavailable. We ordered some simple appetizers (falafel, hummus and yoghurt) and as these arrived, we were informed they only had French bread. Not ideal for an Afghan restaurant, but even worse, when the bread finally arrived, we literally got 4 pieces of dry toasted bread and were told that this was the end of it – 4 tiny pieces of bread for 8 people, which makes it pretty tricky to eat your hummus and yoghurt appetizer!! We finally got some water and our drink order. (Of course, they also ran out of the beer we were drinking). The food itself was mixed. My wife’s dish was way too oily, but to be fair, some of my friends did like their entrees. Ultimately, after an evening of miserable service, they still had the indecency to charge an 18% gratuity. Honestly, the place felt like they were going out of business…no bread, no beer, several dishes unavailable, not enough servers, and no music. Would not recommend this to anyone.  Users/Rune

20071115 08:12:31 nbsp Dear Kabul Restaurant,
I have noticed many cruel comments about you...evidently you do not know how to please your American customers.  Here are a few pointers:
(1) Most Americans are incredibly mean, spoiled and selfsatisfied.  Therefore expect to see cruel, nonconstructive and obscene criticism such as the waiter was a complete asshole, the food was like food from the freezer section of Trader Joes, etc.  Dont expect civility or kindness.
(2) You will be expected to provide food equal to the finest, most expensive restaurants in San Francisco or Napa, all for only $8 per plate, even though the aforementioned S.F. and Napa establishments charge more than $25 per plate.  Dont ask me why...yes, I know its illogical.  Thats the way people are.
(3) The meaner and nastier an American is, the more he or she feels like a real food critic, and the more sophisticated and prestigious he or she feels.  So expect lots of snide putdowns.
(4) Most Americans are incredibly obese pigs.  Therefore if you dont give them a mountain of food, theyll complain about the small portions for the price, as though one goes to a restaurant to store up fat for winter rather than to taste something interesting.
(5) Most Americans have no cultural sensitivity, though they congratulate themselves on their acceptance of diversity.  So expect that people will keep requesting belly dancers, even though your restaurant is one of only two halal (Muslim kosher) restaurants in town, is owned by Muslims, and attracts lots of Muslim clientele.  Dont expect, above all, that your customers will have any respect for women or for other peoples culture or beliefs.  (After all, its fine to leer at scantilydressed women as long as theyre from an exotic Eastern culture.)
I certainly hope youll successfully improve your restaurant in order to satisfy our wonderful Davis citizenry. Users/Patricia
   Wow, that is a remarkably nasty, vicious note. Users/JabberWokky jw
    Yes, it makes me wonder about my positive comment above.  Does that mean Im not a real American?   Users/CovertProfessor
       Does this even belong on the Wiki?  This is essentially an attack on people who have left comments, which, if more direct, would be an obvious violation.  I dont think its indirectness makes it excusable. Users/AlexPomeranz
         Youre certainly proving your point by demonstrating how dumb we Americans are. Users/NickStrand

20071209 19:20:11 nbsp We have been our first time at Kabul in September 07 we loved the restaurant, although the portions are fairly small for their price. When we came back in December the food was still great but the service sucked badly. After we finished eating we were sitting and talking for quite a while (note: the restaurant was pretty empty) the restaurant staff started looking at us so that I could not feel at ease at all. When we left the restaurant they did not even respond to a good bye. This totally ruined me night and I will definitely not recommend the place to anyone and for sure I will never go back! Users/Pia

20071214 13:46:32 nbsp If you like Indian buffet, youll love this Afghan cuisine.  For 8 bucks, this buffet is head and shoulders above the lunch buffet at Kathmandu.  By the way, if you want to taste the most delicious thing ever, try the chicken korma.   Users/MrJonny

20071219 19:31:21 nbsp I went for their buffet one time. The selection was small, but tasty and reasonable. Users/thelonepiper555

20080107 03:31:48 nbsp Came here for the first time on 11/08/07 to try their lunch buffet. Much to the delight of my fiance & I, they had plenty of tasty vegan options. However, the big guy working that day was not very friendly. He appeared to be the only one working that lunch, but there were only two other tables in the restaurant (one of which was a woman who must have worked there because she went into the back after eating). I had to go up to him to ask for two ice teas, as he never came back to the table after he seated us. Our plates from each trip up to the buffet just sat in a pile next to us the entire meal. I had to go up to him to pay as well. I dont expect a fullservice dining experience from a buffet, but I am used to someone at least taking drink orders & removing dirty plates. A smile would have bee nice too! We are planning to give it a second chance though. Everyone has bad days, I suppose.   Users/AprilAries

20080124 13:18:28 nbsp I went here with a friend in December 2007, deciding to give them a chance again after a twoyear hiatus due to a very bland and boring entree I once had there. We came in to check out the menu, which looked liked it had enough veggie options, but although there were two waiters there they didnt let us know that they were out of most veggie dishes, supposedly because the only supplier of a certain Afghan vegetable had a crop failure. We had already ordered drinks when they told us and thus decided reluctantly to stay. I dont remember what we ended up getting, but I recall that the samosas and one entree were subpar, and one entree was soso. The Indian beer I had also wasnt great, but I guess that would be too much to ask for anyway. I will never go here again. Users/JoFeuerstein

20080206 18:56:26 nbsp I work near this place and was going to go there for the first time ever only to find it closed up, the windows papered, and no signs saying anything.  Is this place to be added to the Departed Businesses List? Users/SunjeetBaadkar

20080211 13:54:07 nbsp It seems like Kabul has moved on.  I always went there for their buffets. The remark made by Patricia about muslims was totally inappropiate and does not belong here mainly since ITS NOT TRUE!! SUCH IGNORANCE!! Im a muslim so i should know what im talking about Users/LionelVo

20080218 21:26:06 nbsp What exactly happened to the place? Users/thelonepiper555

20080218 22:27:18 nbsp According to the Feb 08 issue of Davis Life Magazine (following their review of Kabul), it seems to be turning into a Japanese restaurant serving an allday sushi buffet. Users/PopsicleGirl

20080315 19:45:03 nbsp This place finally closed up shop?  I cant say that Im surprised.  I tried the lunch buffet circa 2006 and didnt like the food at all.  It was just. . .gross.  It was disappointing because I really wanted to like this place, too.  Davis needs more restaurants like this, but this place, for whatever reason, wasnt doing it right.  Every time I walked by (including around lunch and dinner) the place was completely empty.  I would walk by and make the same comment to whomever: This cant be a good sign.  Sad.
Ah well, off you go. . . to the Departed Business List!  Users/CurlyGirl26

20080411 11:18:52 nbsp So sad this place is gone. This is one of the first restaurants I ate at when I came to Davis to tour UCD... shame I didnt get back before it closed up shop, the food was delicious and the atmosphere was nice :) Users/BrandonBarrette

20080814 23:40:42 nbsp :( KABUUUUUUUL!!!!! Users/ArianeMetz


text:
      program zthin
      use mod_za  ! HYCOM array I/O interface
      implicit none
c
      integer   i,j,k,kdm,nhybrd,nsigma,nfill,nzero,np,ns
      real      hmaxa,hmaxb,hmina,hminb,flat
      real      dpk,dp00,dp00x,dp00m,dp00f,dsk,ds00,ds00x,ds00m,ds00f,
     &          zp(0:99),zpmin,zpmax,
     &          zs(0:99),zsmin,zsmax
      character preambl(5)*79,cline*80
c
c --- read in a hycom topography file and a vertical grid,
c --- write out a corrected bathymetry that has no thin partial z-cells.
c
      integer, allocatable :: ip(:,:)
      real,    allocatable :: dh(:,:)
c
      call xcspmd  !input idm,jdm
      allocate( ip(idm,jdm) )
      allocate( dh(idm,jdm) )
c
c --- read in the vertical grid parameters.
c
c --- 'kdm   ' = number of layers
c --- 'nhybrd' = number of hybrid levels (0=all isopycnal)
c --- 'nsigma' = number of sigma  levels (nhybrd-nsigma z-levels)
c --- 'dp00'   = deep    z-level spacing minimum thickness (m)
c --- 'dp00x'  = deep    z-level spacing maximum thickness (m)
c --- 'dp00m'  = deep    z-level minimum p. cell thickness (m)
c --- 'dp00f'  = deep    z-level spacing stretching factor (1.0=const.z)
c --- 'ds00'   = shallow z-level spacing minimum thickness (m)
c --- 'ds00x'  = shallow z-level spacing maximum thickness (m)
c --- 'ds00m'  = shallow z-level minimum p. cell thickness (m)
c --- 'ds00f'  = shallow z-level spacing stretching factor (1.0=const.z)
c
c --- the above specifies a vertical coord. that is isopycnal or:
c ---     z in    deep water, based on dp00,dp00x,dp00f
c ---     z in shallow water, based on ds00,ds00x,ds00f and nsigma
c ---     sigma between them, based on ds00,ds00x,ds00f and nsigma
c --- for z-only set nsigma=0 (and ds00,ds00x,ds00f=dp00,dp00x,dp00f)
c --- for sigma-z (shallow-deep) use a very small ds00
c ---  (pure sigma-z also has ds00f=dp00f and ds00x=dp00x*ds00/dp00)
c --- for z-sigma (shallow-deep) use a very large dp00 (not recommended)
c --- for sigma-only set nsigma=kdm, dp00 large, and ds00 small
c
      call blkini(kdm,   'kdm   ')
      call blkini(nhybrd,'nhybrd')
      call blkini(nsigma,'nsigma')
      call blkinr(dp00,  'dp00  ','(a6," =",f10.4," m")')
      call blkinr(dp00x, 'dp00x ','(a6," =",f10.4," m")')
      call blkinr(dp00m, 'dp00m ','(a6," =",f10.4," m")')
      call blkinr(dp00f, 'dp00f ','(a6," =",f10.4," ")')
      call blkinr(ds00,  'ds00  ','(a6," =",f10.4," m")')
      call blkinr(ds00x, 'ds00x ','(a6," =",f10.4," m")')
      call blkinr(ds00m, 'ds00m ','(a6," =",f10.4," m")')
      call blkinr(ds00f, 'ds00f ','(a6," =",f10.4," ")')
c
c --- configure nhybrd-nsigma z-levels.
c
      zp(0) = 0.0
      zp(1) = dp00
      dpk   = dp00
      write(6,'(a,i3,2f12.3)') 'k,dpk,zk = ',1,dpk,zp(1)
      do k= 2,kdm
        dpk = min( dp00*dp00f**(k-1), dp00x )
        zp(k) = zp(k-1) + dpk
        write(6,'(a,i3,2f12.3)') 'k,dpk,zk = ',k,dpk,zp(k)
      enddo
      if     (nsigma.eq.0) then
        zpmin = 0.0
      else
        zpmin = zp(nsigma)
      endif
      if     (nhybrd.eq.kdm) then
        zpmax = 1.e10
      else
        zpmax = zp(nhybrd)
      endif
c
      zs(0) = 0.0
      zs(1) = ds00
      dsk   = ds00
      write(6,'(a,i3,2f12.3)') 'k,dsk,zk = ',1,dsk,zs(1)
      do k= 2,kdm
        dsk = min( ds00*ds00f**(k-1), ds00x )
        zs(k) = zs(k-1) + dsk
        write(6,'(a,i3,2f12.3)') 'k,dsk,zk = ',k,dsk,zs(k)
      enddo
      zsmin = 0.0
      zsmax = zs(nsigma)
c
c --- read in a hycom topography file,
c
      call zhopen(51, 'formatted', 'old', 0)
      read (51,'(a79)') preambl
      read (51,'(a)')   cline
      close(unit=51)
      write(6,'(a/(a))') 'old header:',
     &                   preambl,cline(1:len_trim(cline))
c
      i = index(cline,'=')
      read (cline(i+1:),*)   hminb,hmaxb
c
      call zaiost
      call zaiopn('old', 51)
      call zaiord(dh,ip,.false., hmina,hmaxa, 51)
      call zaiocl(51)
c
      if     (abs(hmina-hminb).gt.abs(hminb)*1.e-4 .or.
     &        abs(hmaxa-hmaxb).gt.abs(hmaxb)*1.e-4     ) then
        write(6,'(/ a / a,1p3e14.6 / a,1p3e14.6 /)')
     &    'error - .a and .b topography files not consistent:',
     &    '.a,.b min = ',hmina,hminb,hmina-hminb,
     &    '.a,.b max = ',hmaxa,hmaxb,hmaxa-hmaxb
        call zhflsh(6)
        stop
      endif
c
c --- modified preambl.
c
      if     (len_trim(preambl(5)).ne.0) then
        if     (len_trim(preambl(4)).eq.0) then
          preambl(4) = preambl(5)
        elseif (len_trim(preambl(3)).eq.0) then
          preambl(3) = preambl(4)
          preambl(4) = preambl(5)
        elseif (len_trim(preambl(2)).eq.0) then
          preambl(2) = preambl(3)
          preambl(3) = preambl(4)
          preambl(4) = preambl(5)
        endif
      endif
      write(preambl(5),'(a,2f10.4)')
     &  'filled thin partial cells: dp00m,ds00m =',dp00m,ds00m
c
      write(6, *)
      write(6, *)       'new header:'
      write(6, '(A79)') preambl
      call zhflsh(6)
c
      call zhopen(61, 'formatted', 'new', 0)
      write(61,'(A79)') preambl
c
c --- land mask and fill cells.
c
      np = 0
      ns = 0
      do j= 1,jdm
        do i= 1,idm
          if     (dh(i,j).lt.2.0**99) then
            ip(i,j) = 1
            if     (dh(i,j).gt.zpmin .and. dh(i,j).lt.zpmax+dp00m) then
              do k= nsigma,nhybrd
                if     (dh(i,j)-zp(k).gt.0.0   .and.
     &                  dh(i,j)-zp(k).lt.dp00m      ) then
*                 write(6,'(a,2i5,2f20.4)')
*    &               'fill-p: i,j,old,new = ',i,j,dh(i,j),zp(k)
                  dh(i,j) = zp(k)
                  np = np + 1
                  exit
                endif
              enddo
            endif
            if     (dh(i,j).lt.zsmax) then
              do k= 1,nsigma
                if     (dh(i,j)-zs(k).gt.0.0   .and.
     &                  dh(i,j)-zs(k).lt.ds00m      ) then
*                 write(6,'(a,2i5,2f20.4)')
*    &               'fill-s: i,j,old,new = ',i,j,dh(i,j),zs(k)
                  dh(i,j) = zs(k)
                  ns = ns + 1
                  exit
                endif
              enddo
            endif
          else
            ip(i,j) = 0
            dh(i,j) = 0.0
          endif
        enddo
      enddo
c
      write(6,'(/ a,2i9 /)')
     &   'modified deep,shallow points =',np,ns
c
c --- fill single-width inlets and 1-point seas.
c
 100  continue
      nfill=0
      do j=1,jdm
        do i=1,idm
          nzero=0
          if (dh(i,j).gt.0.0) then
            if (i.eq.  1.or.dh(i-1,j).le.0.0) nzero=nzero+1
            if (i.eq.idm.or.dh(i+1,j).le.0.0) nzero=nzero+1
            if (j.eq.  1.or.dh(i,j-1).le.0.0) nzero=nzero+1
            if (j.eq.jdm.or.dh(i,j+1).le.0.0) nzero=nzero+1
            if (nzero.ge.3) then
              write (6,'(a,i4,a,i4,a,i1,a)')
     +          ' dh(',i,',',j,') set to zero (',
     +          nzero,' land nieghbours)'
              ip(i,j)=0
              dh(i,j)=0.0
              nfill=nfill+1
            end if
          end if
        enddo
      enddo
      if (nfill.gt.0) go to 100
c
c --- write out the corrected bottom hycom topography file,
c
      call zaiopn('new', 61)
      call zaiowr(dh, ip,.true., hmina,hmaxa, 61, .false.)
      write(61,6100) hmina,hmaxa
      write(6, 6100) hmina,hmaxa
      write(6, *)
 6100 format('min,max depth = ',2f10.3)
c
      end
      subroutine blkinr(rvar,cvar,cfmt)
      implicit none
c
      real             rvar
      character        cvar*6,cfmt*(*)
c
c     read in one real value from stdin
c
      character*6 cvarin
c
      read(*,*) rvar,cvarin
      write(6,cfmt) cvarin,rvar
      call flush(6)
c
      if     (cvar.ne.cvarin) then
        write(6,*)
        write(6,*) 'error in blkinr - input ',cvarin,
     +                      ' but should be ',cvar
        write(6,*)
        call flush(6)
        stop
      endif
      return
      end

      subroutine blkini(ivar,cvar)
      implicit none
c
      integer     ivar
      character*6 cvar
c
c     read in one integer value from stdin
c
      character*6 cvarin
c
      read(*,*) ivar,cvarin
      write(6,6000) cvarin,ivar
      call flush(6)
c
      if     (cvar.ne.cvarin) then
        write(6,*)
        write(6,*) 'error in blkini - input ',cvarin,
     +                      ' but should be ',cvar
        write(6,*)
        call flush(6)
        stop
      endif
      return
 6000 format('blkini: ',a6,' =',i6)
      end

max_stars_repo_name: TillRasmussen/HYCOM-tools

max_issues_repo_name: TillRasmussen/HYCOM-tools

max_forks_repo_name: TillRasmussen/HYCOM-tools


text:
	FUNCTION GAUSS(X,X0,SIGMA)

c	Returns value of gaussian function normalized to area = 1

c	Normalization constant
	data a/0./
	if (a.eq.0) then
		pi=4.*atan(1.)
		a=1./sqrt(2.*pi)
	endif
        c=a/sigma
        gauss=c*exp(-(x-x0)**2/sigma**2/2)
!	write (998,*) x,x0,a,sigma,c
        return
        end

max_stars_repo_name: jchavesmontero/galaxpy

max_issues_repo_name: jchavesmontero/galaxpy

max_forks_repo_name: jchavesmontero/galaxpy


text:
program main
  implicit none
  double precision x, y
  read(5,*) x, y
  write(6,*) x + y
end program main

max_stars_repo_name: ohno/RunningExternalPrograms

max_issues_repo_name: ohno/RunningExternalPrograms

max_forks_repo_name: ohno/RunningExternalPrograms


program test_runtime_parameters
    use,intrinsic :: iso_fortran_env
    use mod_runtime_parameters, only : class_runtime_parameters
    implicit none
    type(class_runtime_parameters) :: crp
    integer(int32) :: nerror
    character(len=20) :: filename

!   all parameters are not correct
    filename='error.txt'
    call crp%read_runtime_parameters(filename,nerror)
    if(nerror/=12) error stop
!   all parameters are correct
    filename='correct.txt'
    call crp%read_runtime_parameters(filename,nerror)
    if(nerror/=0) error stop

end program test_runtime_parameters


text:
	SUBROUTINE CSMTHN  ( nsmoth, npts, xpt, ypt, iret )
C************************************************************************
C* CSMTHN								*
C*									*
C* This subroutine applies a 3-point smoothing to the buffered contour	*
C* line.  The smoothing is performed NSMOTH times.			*
C*									*
C* CSMTHN  ( NSMOTH, NPTS, XPT, YPT, IRET )				*
C*									*
C* Input parameters:							*
C*	NSMOTH		INTEGER		Number of smoothing passes	*
C*	NPTS		INTEGER		Number of points		*
C*									*
C* Input and output parameters:						*
C*	XPT (NPTS)	REAL		X grid points			*
C*	YPT (NPTS)	REAL		Y grid points			*
C*									*
C* Output parameters:							*
C*	IRET		INTEGER		Return code			*
C*					  0 = normal return		*
C**									*
C* Log:									*
C* M. desJardins/NMC	11/91	From old CSMOTH				*
C************************************************************************
	INCLUDE		'GEMPRM.PRM'
	INCLUDE		'CONTUR.CMN'
C*
	REAL		xpt (*), ypt (*)
C------------------------------------------------------------------------
	iret = 0
C
C*	Check that there are at least two points.
C
	IF  ( npts .lt. 2 )  RETURN
C
C*	Loop through the points NSMOTH times.
C
	DO  ii = 1, nsmoth
	  xim1 = xpt (1)
	  yim1 = ypt (1)
	  DO  i = 2, npts - 1
	    xi = xpt (i)
	    yi = ypt (i)
	    xpt (i) = ( xim1 + xpt (i+1) + xi + xi ) / 4.
	    ypt (i) = ( yim1 + ypt (i+1) + yi + yi ) / 4.
	    xim1 = xi
	    yim1 = yi
	  END DO
	END DO
C*
	RETURN
	END

max_stars_repo_name: oxelson/gempak

max_issues_repo_name: oxelson/gempak

max_forks_repo_name: oxelson/gempak


text:
The Educational Opportunity Program
The Educational Opportunity Program (EOP) at the University of California, Davis began in 1968. The program offers an array of services to help students adapt both academically and socially to the University setting and achieve their educational and personal goals.  The transition from high school or community college to a large research university can be overwhelming.  EOP provides a caring and supportive environment for students to meet with peer and professional advisers and network with other students.  Three staff advisers and a group of 15 peer advising counselors, in conjunction with other campus units, work together to offer students the following services and activities.Please stop by the EOP office in South Hall to meet our friendly staff and peers.  The office is open from 94 daily, and no appointment is necessary.

  Preenrollment assistance
  Academic Advising
  Orientation and welcome activities
  Personal and social support
  Information and skill development workshops
  Weekly newsletter
  Tutoring and supplemental instruction through the Student Academic Success Center
  Guardian Scholars, a support network for former foster youth

Our Mission
The Educational Opportunity Program is committed to serving the UC Davis Community. We strive to maintain a climate of academic excellence and maximize retention by providing academic, and social support and peer counseling. We affirm our commitment by raising student awareness in current political and social issues. Through our programs we recognize, appreciate, and cherish the richness of our diversity.”

>Image(contact.jpg)  Image(office.jpg)  Image(staff1314.jpg)  Image(advising.jpg)<

How to be an EOP Student 101
>Step 1:
Check your UC Davis Email: You will be receiving Newsletters, Updates, and Reminders from your PAC<

>Step 2:<
>Go to the EOP Office
Why?<
>Academic Support
•   Academic Advising
•   Pre/Co classes
•   Lending Library <

>Personal Support
•   OneonOne Peer Counseling
•   Internship/Job opportunity<

>Social Support
•   EOPAC
•   Social Room
•   Workshops<
>Step 3:<
>Add EOP on Facebook and Instagram!
Facebook.com/ucdeopoffice<
>
Keep up with what’s
going on in EOP,
Post any updates you
have, network<
>Step 4:<
>Get involved with EOPAC
(Educational Opportunity Program Activities Club)<

>Meet other EOP Students
Flash Mobs
Game nights
IM Sports<
>Step 5:<
>Go to workshops!<

>Apartment Hunting 101
Relationships
Learning Styles
Budgeting
Professionalism
LEADR
You request topic!<

Peer Advising Counselors

Ariel Lopez
Year: 4th
Major: Sociology and Chicano Studies
Hometown: Calipatria, CA

Armando Figueroa
Year: 4th
Major: Sociology and Chicano Studies
Hometown: Los Angeles, CA

Arianne Riley
Year: 3rd
Major: Community and Regional Development
Hometown: Hayward, CA

Susan Flores
3rd Year
Major: CRD and MESA
Hometown: North Hollywood

Soroush Ghaffarpour
2nd Year
Major: Neurobiology, Physiology, and Behavior
Hometown: Fairfield, CA.

Pierre Morris
2nd Year
Major: Biology/ Psychology Double
Hometown: Greenville, Mississippi

E.J. Orozco
3rd Year
Major: Civil Engineering
Hometown: San Francisco, CA

Maritza VegaValdez
2nd Year
Major: Human Development and Spanish
Hometown: Patterson, CA

Austin Edmonson
4th Year
Major: Sociology B.A.
Hometown: Moorpark, CA

Elizabeth Lopez
3rd Year
Major: Psychology B.A
Hometown: South Los Angeles, CA

Veronica Serrato
4th Year
Major: Chicana/o Studies, Political Science Public Service Double
Philosophy minor
Hometown: Gardena, CA

David Le
4th Year
Major: Community and Regional Development
Hometown: Oakland California

Niat Afeworki
4th year
Major: History and Cultural Anthropology
Hometown: East Bay

Coordinators

Leonna Spilman
Year: 3rd year
Major: English
Hometown: Ramona, CA


text:
C ------------------------------------------------------------------------------
C Subroutine for the derivative of Jac with respect to rate coefficients
C Times a user vector
C -----------------------------------------------------------------------------

      SUBROUTINE  dJac_dRcoeff( V, F, U, NCOEFF, JCOEFF, DJDR )

      IMPLICIT NONE
      INCLUDE 'KPP_ROOT_Parameters.h'
      INCLUDE 'KPP_ROOT_Sparse.h'

C V - Concentrations of variable/radical/fixed species
      KPP_REAL V(NVAR), F(NFIX)
C U - User-supplied Vector
      KPP_REAL U(NVAR)
C NCOEFF - the number of rate coefficients with respect to which we differentiate
      INTEGER NCOEFF
C JCOEFF - a vector of integers containing the indices of reactions (rate
C          coefficients) with respect to which we differentiate
      INTEGER JCOEFF(NCOEFF)
C DFDR  - a matrix containg derivative values; specifically,
C         column j contains d Jac(1:NVAR) / d RCT( JCOEFF(j) ) * U
C                     for each 1 <= j <= NCOEFF
C         This matrix is stored in a column-wise linearized format
      KPP_REAL DJDR(NVAR*NCOEFF)

C Local vector for Jacobian of reactant products
      KPP_REAL JV_RPROD(NJVRP)
      KPP_REAL aj
      INTEGER i,j,k

C Compute the Jacobian of all reactant products
      CALL JacReactantProd( V, F, JV_RPROD )

C Compute the derivatives by multiplying column JCOEFF(j) of the stoichiometric matrix with A_PROD
      DO j=1,NCOEFF
C                  Initialize the j-th column of derivative matrix to zero
         DO i=1,NVAR
           DJDR(i+NVAR*(j-1)) = 0.0D0
         END DO
C                  Column JCOEFF(j) in the stoichiometric matrix times the
C                  ( Gradient of reactant product of the JCOEFF(j)-th reaction X user vector )
C                  give the j-th column of the derivative matrix
C
C          Row JCOEFF(j) of JV_RPROD times the user vector
         aj = 0.d0
         DO k=CROW_JVRP(JCOEFF(j)),CROW_JVRP(JCOEFF(j)+1)-1
	    aj = aj + JV_RPROD(k)*U(ICOL_JVRP(k))
	 END DO
C          Column JCOEFF(j) of Stoichiom. matrix times aj
         DO k=CCOL_STOICM(JCOEFF(j)),CCOL_STOICM(JCOEFF(j)+1)-1
           DJDR(IROW_STOICM(k)+NVAR*(j-1)) = STOICM(k)*aj
         END DO
      END DO

      RETURN
      END

max_stars_repo_name: matzegoebel/WRF-fluxavg

max_issues_repo_name: teb-model/wrf-teb

max_forks_repo_name: teb-model/wrf-teb


text:
!!  Copyright (C)  Stichting Deltares, 2012-2016.
!!
!!  This program is free software: you can redistribute it and/or modify
!!  it under the terms of the GNU General Public License version 3,
!!  as published by the Free Software Foundation.
!!
!!  This program is distributed in the hope that it will be useful,
!!  but WITHOUT ANY WARRANTY; without even the implied warranty of
!!  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
!!  GNU General Public License for more details.
!!
!!  You should have received a copy of the GNU General Public License
!!  along with this program. If not, see <http://www.gnu.org/licenses/>.
!!
!!  contact: delft3d.support@deltares.nl
!!  Stichting Deltares
!!  P.O. Box 177
!!  2600 MH Delft, The Netherlands
!!
!!  All indications and logos of, and references to registered trademarks
!!  of Stichting Deltares remain the property of Stichting Deltares. All
!!  rights reserved.

!> @file
!!    Run the computation step by step
!!

!> Main program steering the computation
program delwaq2_stepwise

    implicit none

    integer :: dummy
    integer :: ModelInitialize_By_Id, ModelPerformTimeStep, ModelFinalize
    integer :: GetTimeHorizon, GetWQCurrentTime, WriteRestartFileDefaultName, WriteRestartFile

    character(len=200)     :: runid
    character(len=200)     :: resfile
    integer                :: itimestamp
    real(kind=kind(1.0d0)) :: startTime, stopTime, currentTime
    integer                :: i ,status, found

    !
    ! Get the run-ID or quit
    !
    call get_command_argument( 1, runid, status )

    if ( runid == ' ' ) then
        write(*,*) 'Please specify the run-ID!'
        stop
    endif

    found = 0
    resfile = runid
    do i=1,200
      if ( resfile(i:i) .eq. ' ' .and. found .eq. 0 ) then
        itimestamp = i
        found = 1
      endif
    end do
    write (resfile(itimestamp+10:itimestamp+17), '(A)') '_res.map'

    !
    ! Start the computation - stepwise
    !
    dummy = ModelInitialize_By_Id( runid )

!    dummy = ModelInitialize_By_Id( runid ) ! Twice as a test

    dummy = GetTimeHorizon( startTime, stopTime )
    i = 0
    write (resfile(itimestamp:itimestamp+9), '(I10)') i
    dummy = WriteRestartFile ( resfile )

    do
        dummy = ModelPerformTimeStep()
        dummy = GetWQCurrentTime( currentTime )
        dummy = WriteRestartFileDefaultName ()
        i = i + 1
        if (mod(i,10) == 0) then
          write (resfile(itimestamp:itimestamp+9), '(I10)') i
          dummy = WriteRestartFile ( resfile )
        end if
        if ( currentTime >= stopTime ) then
            dummy = ModelPerformTimeStep()
            exit
        endif
    enddo

    !
    ! Properly complete the computation
    !
    dummy = ModelFinalize()

end program delwaq2_stepwise

max_stars_repo_name: liujiamingustc/phd

max_issues_repo_name: liujiamingustc/phd

max_forks_repo_name: liujiamingustc/phd


text:
      SUBROUTINE GXX (ZZ,RH,A,A2,XK,IRA,G1,G1P,G2,G2P,G3,GZP)
C     SEGMENT END CONTRIBUTIONS FOR EXT. THIN WIRE APPROX.
      COMPLEX GZ,C1,C2,C3,G1,G1P,G2,G2P,G3,GZP
      R2=ZZ*ZZ+RH*RH
      R=SQRT(R2)
      R4=R2*R2
      RK=XK*R
      RK2=RK*RK
      RH2=RH*RH
      T1=.25*A2*RH2/R4
      T2=.5*A2/R2
      C1=CMPLX(1.,RK)
      C2=3.*C1-RK2
      C3=CMPLX(6.,RK)*RK2-15.*C1
      GZ=CMPLX(COS(RK),-SIN(RK))/R
      G2=GZ*(1.+T1*C2)
      G1=G2-T2*C1*GZ
      GZ=GZ/R2
      G2P=GZ*(T1*C3-C1)
      GZP=T2*C2*GZ
      G3=G2P+GZP
      G1P=G3*ZZ
      IF (IRA.EQ.1) GO TO 2
      G3=(G3+GZP)*RH
      GZP=-ZZ*C1*GZ
      IF (RH.GT.1.E-10) GO TO 1
      G2=0.
      G2P=0.
      RETURN
1     G2=G2/RH
      G2P=G2P*ZZ/RH
      RETURN
2     T2=.5*A
      G2=-T2*C1*GZ
      G2P=T2*GZ*C2/R2
      G3=RH2*G2P-A*GZ*C1
      G2P=G2P*ZZ
      GZP=-ZZ*C1*GZ
      RETURN
      END

max_stars_repo_name: ViperScience/ViperNEC

max_issues_repo_name: ViperScience/ViperNEC

max_forks_repo_name: ViperScience/ViperNEC


text:
MODULE POTENTIAL
USE PARACLUSTER
USE CLUSTER
!
IMPLICIT NONE
!
! Fundamental quantity for each chemical species
!
REAL*8 :: ecoh(3), rat(3), mass(2)
REAL*8 :: t2m(3),arete(3)
REAL*8 :: dist(3)
REAL*8 :: ecohv(n_elposs),ratv(n_elposs),dmas(n_elposs)
CHARACTER*2 ::  leg(n_elposs)

!!!PARAMETERS ONLY FOR RGL
REAL*8 :: cutoff_start,cutoff_end, cutz(2,2)
REAL*8 :: znmax(2),nn(3),znmaxdist

REAL*8 :: a5(3),a4(3),a3(3),x5(3),x4(3),x3(3)
REAL*8 :: p(3),q(3),a(3),qsi(3)
CHARACTER*2 :: NA_elem
CHARACTER*3 :: sys
LOGICAL :: sologeom, lcutoff, lsubstrate

!!!PARAMETERS ONLY FOR LJ
REAL*8 :: U0,R0

!!!PARAMETERS ONLY FOR GIRIFALCO
REAL*8 :: Nball !(=60)atom number in a ball
REAL*8 :: Dnn   !distance NN in A
REAL*8 :: dball !diameter of a ball in A
REAL*8 :: ALJ   ! costante di un LJ in eV*A**6
REAL*8 :: BLJ   ! costante di un LJ in eV*A**12
!!!PARAMETERS ONLY FOR PACHECO-RAMALHO
REAL*8 :: dmu,dM0,epsilon,tau,DIST0
REAL*8 :: C6,C8,C10,C12
!
END MODULE POTENTIAL

max_stars_repo_name: kcl-tscm/LoDiS

max_issues_repo_name: kcl-tscm/LoDiS

max_forks_repo_name: kcl-tscm/LoDiS


!        Generated by TAPENADE     (INRIA, Ecuador team)
!  tapenade 3.x
!
!  Differentiation of check_domain in reverse (adjoint) mode (with options noISIZE i8):
!   gradient     of useful results: *temp *conc *pres
!   with respect to varying inputs: *temp *conc *pres
!   Plus diff mem management of: temp:in conc:in pres:in
! MIT License
!
! Copyright (c) 2020 SHEMAT-Suite
!
! Permission is hereby granted, free of charge, to any person obtaining a copy
! of this software and associated documentation files (the "Software"), to deal
! in the Software without restriction, including without limitation the rights
! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
! copies of the Software, and to permit persons to whom the Software is
! furnished to do so, subject to the following conditions:
!
! The above copyright notice and this permission notice shall be included in all
! copies or substantial portions of the Software.
!
! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
! SOFTWARE.
!>    @brief domain of validity for module ice
!>    @param[in] ismpl local sample index
SUBROUTINE CHECK_DOMAIN_AD(ismpl)
  use arrays

  USE ARRAYS_AD

  USE MOD_GENRL
  USE MOD_GENRLC
  USE MOD_CONC
  USE MOD_LINFOS
  IMPLICIT NONE
  INTEGER :: ismpl
  INTEGER :: i, j, k, l
!     counts the directions (thickness large enough)
  INTEGER :: icountp, icountt, icountc
!     [csmin] reasonable physical value when not [cmin]
  DOUBLE PRECISION :: pmin, pmax, tmin, tmax, cmin, csmin, cmax, hmin, &
& hmax, dpmax, dtmax, dcmax, dhmax, dpmin, dtmin, dcmin, dhmin
  PARAMETER (pmin=0.01d6, pmax=150.d6, tmin=-60.0d0, tmax=350.0, cmin=&
&   0.d0, csmin=1.d-30, cmax=1.d0)
  INTRINSIC TRIM
  INTRINSIC MIN
  INTRINSIC MAX
  INTEGER :: branch
  DO k=1,k0
    DO j=1,j0
      DO i=1,i0
        IF (pres(i, j, k, ismpl) .LT. pmin) THEN
          CALL PUSHREAL8(pres(i, j, k, ismpl))
          pres(i, j, k, ismpl) = pmin
          CALL PUSHCONTROL1B(0)
        ELSE
          CALL PUSHCONTROL1B(1)
        END IF
        IF (pres(i, j, k, ismpl) .GT. pmax) THEN
          CALL PUSHREAL8(pres(i, j, k, ismpl))
          pres(i, j, k, ismpl) = pmax
          CALL PUSHCONTROL1B(0)
        ELSE
          CALL PUSHCONTROL1B(1)
        END IF
        IF (temp(i, j, k, ismpl) .LT. tmin) THEN
          CALL PUSHREAL8(temp(i, j, k, ismpl))
          temp(i, j, k, ismpl) = tmin
          CALL PUSHCONTROL1B(0)
        ELSE
          CALL PUSHCONTROL1B(1)
        END IF
        IF (temp(i, j, k, ismpl) .GT. tmax) THEN
          CALL PUSHREAL8(temp(i, j, k, ismpl))
          temp(i, j, k, ismpl) = tmax
          CALL PUSHCONTROL1B(1)
        ELSE
          CALL PUSHCONTROL1B(0)
        END IF
        DO l=1,ntrac
          IF (conc(i, j, k, l, ismpl) .LT. cmin) THEN
            CALL PUSHREAL8(conc(i, j, k, l, ismpl))
            conc(i, j, k, l, ismpl) = cmin
            CALL PUSHCONTROL1B(0)
          ELSE
            CALL PUSHCONTROL1B(1)
          END IF
!aw-later                  if (conc(i,j,k,l,ismpl).gt.cmax) then
!aw-later                     icountc = icountc +1
!aw-later                     dcmax = max(dcmax, conc(i,j,k,l,ismpl))
!aw-later                     conc(i,j,k,l,ismpl) = cmax
!aw-later                  endif
!                 use reasonable physical value [csmin]
          IF (conc(i, j, k, l, ismpl) .LT. csmin) THEN
!                    to avoid numerically instabilities
            CALL PUSHREAL8(conc(i, j, k, l, ismpl))
            conc(i, j, k, l, ismpl) = cmin
            CALL PUSHCONTROL1B(1)
          ELSE
            CALL PUSHCONTROL1B(0)
          END IF
        END DO
      END DO
    END DO
  END DO
  DO k=k0,1,-1
    DO j=j0,1,-1
      DO i=i0,1,-1
        DO l=ntrac,1,-1
          CALL POPCONTROL1B(branch)
          IF (branch .NE. 0) THEN
            CALL POPREAL8(conc(i, j, k, l, ismpl))
            conc_ad(i, j, k, l, ismpl) = 0.D0
          END IF
          CALL POPCONTROL1B(branch)
          IF (branch .EQ. 0) THEN
            CALL POPREAL8(conc(i, j, k, l, ismpl))
            conc_ad(i, j, k, l, ismpl) = 0.D0
          END IF
        END DO
        CALL POPCONTROL1B(branch)
        IF (branch .NE. 0) THEN
          CALL POPREAL8(temp(i, j, k, ismpl))
          temp_ad(i, j, k, ismpl) = 0.D0
        END IF
        CALL POPCONTROL1B(branch)
        IF (branch .EQ. 0) THEN
          CALL POPREAL8(temp(i, j, k, ismpl))
          temp_ad(i, j, k, ismpl) = 0.D0
        END IF
        CALL POPCONTROL1B(branch)
        IF (branch .EQ. 0) THEN
          CALL POPREAL8(pres(i, j, k, ismpl))
          pres_ad(i, j, k, ismpl) = 0.D0
        END IF
        CALL POPCONTROL1B(branch)
        IF (branch .EQ. 0) THEN
          CALL POPREAL8(pres(i, j, k, ismpl))
          pres_ad(i, j, k, ismpl) = 0.D0
        END IF
      END DO
    END DO
  END DO
END SUBROUTINE CHECK_DOMAIN_AD


text:
      subroutine nderiv(x,y,nd,n,ndiv,dy)
* nd -- dimension of x,y,dy.  n--size,
* ndiv -- no. of divisions between succesive x
*         used for interpolation (ndiv~20)
      implicit real*8 (a-h,o-z)
      dimension x(nd),y(nd),dy(nd)
      dimension x2(n*ndiv),y2(n*ndiv)
      dx=(x(n)-x(1))/dfloat(n-1)
      dx1=dx/dfloat(ndiv)
      nres=n*ndiv
      x2(1)=x(1)-dx1
      y2(1)=polyint(x2(1),x,y,nd,n)
      do i=2,nres
        x2(i)=x2(i-1)+dx1
        y2(i)=polyint(x2(i),x,y,nd,n)
c        print '(1x,i5,5f12.6)', i,x2(i),y2(i),sin(x2(i))
      end do
      j=1
      do i=1,nres
        if(x2(i).ge.x(j))then
          dy(j)=(y2(i+1)-y2(i-1))/(x2(i+1)-x2(i-1))
          j=j+1
          if(j.eq.n+1)exit
        end if
      end do
      end

      real*8 function polyint(x,xi,yi,ndi,ni)
      implicit real*8 (a-h,o-z)
      dimension xi(ndi),yi(ndi)
      polyint=0.d0
      do i=1,ni
        prod=1.d0
        do j=1,ni
          if (i.eq.j) cycle
          prod=prod*(x-xi(j))/(xi(i)-xi(j))
        end do
        polyint=polyint+yi(i)*prod
      end do
      end


text:
! RUN: %S/test_errors.sh %s %t %f18 -fopenmp
! OpenMP Version 4.5
! 2.15.3.3 private Clause
! Pointers with the INTENT(IN) attribute may not appear in a private clause.

subroutine omp_private(p)
  integer :: a(10), b(10), c(10)
  integer, pointer, intent(in) :: p

  a = 10
  b = 20

  !ERROR: Pointer 'p' with the INTENT(IN) attribute may not appear in a PRIVATE clause
  !$omp parallel private(p)
  c = a + b + p
  !$omp end parallel

  print *, c

end subroutine omp_private

max_stars_repo_name: Machiry/checkedc-clang


text:
!
!     CalculiX - A 3-dimensional finite element program
!              Copyright (C) 1998-2020 Guido Dhondt
!
!     This program is free software; you can redistribute it and/or
!     modify it under the terms of the GNU General Public License as
!     published by the Free Software Foundation(version 2);
!
!
!     This program is distributed in the hope that it will be useful,
!     but WITHOUT ANY WARRANTY; without even the implied warranty of
!     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
!     GNU General Public License for more details.
!
!     You should have received a copy of the GNU General Public License
!     along with this program; if not, write to the Free Software
!     Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
!
      subroutine extrapol_vel02(ipbounv2,ibounv2,xbounv2,xbounact,vold,
     &     mi,nbpv2a,nbpv2b)
!
!     application of boundary conditions to the nodes
!     velocity in y-direction
!
      implicit none
!
      integer ipbounv2(2,*),node,nbpv2a,nbpv2b,mi(*),i,j,ibounv2(*)
!
      real*8 vold(0:mi(2),*),xbounact(*),xbounv2(*)
!
!
!
      do i=nbpv2a,nbpv2b
        node=ipbounv2(1,i)
        vold(2,node)=0.d0
        do j=ipbounv2(2,i)+1,ipbounv2(2,i+1)
          vold(2,node)=vold(2,node)+xbounact(ibounv2(j))
        enddo
        vold(2,node)=vold(2,node)*xbounv2(i)
      enddo
!
      return
      end

max_stars_repo_name: alleindrach/calculix-desktop

max_issues_repo_name: alleindrach/calculix-desktop

max_forks_repo_name: alleindrach/calculix-desktop


text:
      subroutine delt
c
c     *****************************************************************
c     *                                                               *
c     *   calculates the boundary layer thickness                     *
c     *                                                               *
c     *****************************************************************
c
      use dims
c
c     ******************************************************************
c
      use flo_var
      use mesh_var
      use solv_var
c
c     ******************************************************************
c
      use flo_param
      use solv_param
c
c     ******************************************************************
c
      real, dimension(je)               :: qs,dn,ut
c
c     ******************************************************************
c
      logical locke
c
c     ******************************************************************
c
c     js        = 2*jl/3  -2
      js        = .75*(ny  -4)

      do 20 i=2,il

      qs(1)     = 0.
      ut(1)     = 0.
      j         = js
      xy        = .5*(x(i,j,1)  -x(i,j-1,1)
     .               +x(i-1,j,1)  -x(i-1,j-1,1))
      yy        = .5*(x(i,j,2)  -x(i,j-1,2)
     .               +x(i-1,j,2)  -x(i-1,j-1,2))
      qs(j)     = (yy*w(i,j,2)  -xy*w(i,j,3))/(w(i,j,1))
      si        = sign(1.,qs(js))

      do j=2,js
         xy        = .5*(x(i,j,1)  -x(i,j-1,1)
     .                  +x(i-1,j,1)  -x(i-1,j-1,1))
         yy        = .5*(x(i,j,2)  -x(i,j-1,2)
     .                  +x(i-1,j,2)  -x(i-1,j-1,2))
         dsi       = 1./sqrt(xy**2  +yy**2)
         qs(j)     = si*(yy*w(i,j,2)  -xy*w(i,j,3))
         dn(j)     = 1./dsi
         ut(j)     = qs(j)*dsi
      end do

      dsti(i)   = 0.
      ynot(i)   = 0.
      ssmax(i)  = 0.
      cdu       = .98
      jmax      = idmax(js,ut,1)
      fx        = .6*ut(jmax)
      lend      = 2
      lbig      = 2
      locke     = .false.

      do  j=3,js
         if ( ut(j-1) .lt. 0. .and. ut(j) .ge. .0) then
            lbig      = j
         end if
         if (.not. locke) then
            if ( ut(j-1) .ge. cdu*ut(j) .and. ut(j) .gt. fx) then
               locke     = .true.
               lend      = j
            end if
         end if
      end do

      uinf      = 1./ut(lend)
      do j=lbig,lend
         dsti (i)  = dsti(i) + (ut(lend)*dn(j) - qs(j))
         ra        = w(i,lend,1)/w(i,j,1)
         ssmax(i)  = ssmax(i) + ra*ut(j)*uinf*(dn(j)-qs(j)*uinf)
      end do

      dsti(i)   = dsti(i)*uinf
      dsti (i)  = max(dsti(i),1.e-6)
      ra        = w(i,lend,1)/w(i,2,1)
      ssmax(i)  = max(ssmax(i),ra*qs(2)*uinf)
      fc        = .95*ut(lend)

      jse       = lend
      do j=2,jse
         lend      = j  -1
         if (ut(j).gt.fc) go to 11
      end do

   11 xbi       = .5*(x(i,1,1)+x(i-1,1,1))
      ybi       = .5*(x(i,1,2)+x(i-1,1,2))
      ycorr     = sqrt((xc(i,lend,1) - xbi)**2+(xc(i,lend,2)-ybi)**2)
      ynot(i)   = 1.5*(ycorr  +dn(lend)*
     .                (fc  -ut(lend))/(ut(lend+1)  -ut(lend)))

   20 continue

      return

      end

max_stars_repo_name: AlexT-L/RANS

max_issues_repo_name: AlexT-L/RANS

max_forks_repo_name: AlexT-L/RANS