cxdef 1440 linear -179.875 0.25
cydef 720 linear -89.875 0.25
      include "../../../include/all.inc"
      PARAMETER(IM=-WBD/DLMD+1.5,JM=-2.*SBD/DPHD+1.5)
c      parameter(ILL=1440, JLL=720)
c      parameter(bw= -179.875, BS=-89.875,DLL=0.25)
C      parameter(ILL=7200, JLL=3600)
C      parameter(bw= -179.975, BS=-89.975,DLL=0.05)
      parameter(ILL=14400, JLL=7200)
      parameter(bw= -179.9875, BS=-89.9875,DLL=0.025)
      parameter(imh=9,ip=8)
      dimension id7(7),ar7(7), s(ILL,JLL),s2(im,jm)
      dimension ima0(im,jm,2),src(im,jm),ima100(im,jm,2)
      dimension ima3(im,jm),cly(im,jm),slt(im,jm)
      dimension sums5(im,jm),imas5(im,jm,2),fname(2)

      character *17 fname 
      character *7 tail
      character *1 dum1
      fname(1)="dsource_cl_is.asc"
      fname(2)="dsource_sl_is.asc"
        i0w=5000
        i0e=7700
        j0s=5050
        j0n=7200

c      hots=1.65
      DTR = .01745329
      AR7(1)=2.     !0 -  latlon; 1 -  imjm; 2 -  im,jm
      AR7(2)=TLM0D
      AR7(3)=WBD
      AR7(4)=DLMD
      AR7(5)=TPH0D
      AR7(6)=SBD
      AR7(7)=DPHD


      ctph0=cos(tph0d*dtr)
      stph0=sin(tph0d*dtr)
c-----------island

                  do ipr=1,2
      s2=0.
      src=0.
      ima3=0
      sums5=0.


      open (10,file=fname(ipr),form="unformatted",status="old")
      read (10) s

      k=0
      
          do i=1,ill
           do j=1,jll
           if(s(i,j).gt.101.)s(i,j)=0. 
           enddo
          enddo
      print *,"minval=",fname(ipr),minval(s),"  maxval=",maxval(s) 
c--------------------------------------------------------------

      close(10)

        do i1=i0w,i0e
          olok=bw+(i1-1)*dll 
         do j1=j0s,j0n
          olak=bs+(j1-1)*dll  
          call hbox ( ar7,IM,JM,olak,olok,i2,j2)
           if(i2.ne.0.and.j2.ne.0) then
           ima0(i2,j2,ipr)=ima0(i2,j2,ipr)+1 
           endif        
          if(s(i1,j1).gt.99.and.s(i1,j1).lt.101.) then 
          call hbox ( ar7,IM,JM,olak,olok,i2,j2)

           if(i2.ne.0.and.j2.ne.0) then
           ima100(i2,j2,ipr)=ima100(i2,j2,ipr)+1
           write(77,*),i2,j2,ima100(i2,j2,ipr)       
           endif

          else if(s(i1,j1).gt.0.0001.and.s(i1,j1).le.99.) then 
          call hbox ( ar7,IM,JM,olak,olok,i2,j2)
           if(i2.ne.0.and.j2.ne.0) then
           imas5(i2,j2,ipr)=imas5(i2,j2,ipr)+1
           sums5(i2,j2)=sums5(i2,j2)+s(i1,j1) 
           endif

          endif      
         enddo
        enddo
 
      
          sum3= sum(sum(SUM(imas5, DIM=1),dim=1),dim=1)
          sumas5= sum(SUM(sums5, DIM=1),dim=1)
          sum0= sum(sum(SUM(ima0, DIM=1),dim=1),dim=1)
          sum100= sum(sum(SUM(ima100, DIM=1),dim=1),dim=1)

          print *,'sum0,sum3,sum100,sumas5'           
          print *,sum0,sum3,sum100,sumas5
          print *,'maxval ima,ima3,ima100,sums5'           
          print *,maxval(ima0),maxval(imas5)
          print *,maxval(ima100),maxval(sums5)
          prag=maxval(ima100)/10.

        maxis5=maxval(imas5)

       do i=1,im
        do j=1,jm  

       if(ima100(i,j,ipr).ge.prag)then
         write(33,*)ima0(i,j,ipr),imas5(i,j,ipr),ima100(i,j,ipr)
         src(i,j) =0.
         else
c       write(88,*)
        src(i,j)=sums5(i,j)
         endif 
c
        if(ipr.eq.1)then
        cly(i,j)=src(i,j)
        else
        slt(i,j)=src(i,j)  
        endif  
       write(88,*)ima0(i,j,ipr),ima100(i,j,ipr)
     &,imas5(i,j,ipr),src(i,j)
        enddo
       enddo
                end do
       rmv=maxval(cly+slt)   
       print *,"max cl+sl=",rmv
      do j=1,jm
      do i=1,im  
      if(imas5(i,j,1).ne.0.)cly(i,j)=cly(i,j)/imas5(i,j,1)
      if(imas5(i,j,2).ne.0.)slt(i,j)=slt(i,j)/imas5(i,j,2)
      enddo
      enddo
      OPEN(UNIT=25,FILE='../../../output/ALPHA2.sltcly'
     & ,FORM='UNFORMATTED',STATUS='UNKNOWN')
      WRITE(25)slt
      WRITE(25)cly
      close(25)
      D=-99.

      ID7(1)=11
      ID7(2)=01
      ID7(3)=15
      ID7(4)=00
      ID7(5)=0
      ID7(6)=00   ! minf
      ID7(7)=00   ! secf
        print *,ID7
        print *,"_________________",im,jm
        print *,AR7
        print *,"____________",maxval(s2)
         
      CALL WGRADS(ID7,46,0,0,1,0,AR7,IM,JM,1,0.,cly ,DUM)
      CALL WGRADS(ID7,47,0,0,1,0,AR7,IM,JM,1,0.,slt ,DUM)

      stop
c
      open (10,file="tails.txt",status="old")
      dxy = 1./120.
1     read(10,"(a)",end=99) tail
      read (tail(2:4),*) bwt
      read (tail(6:7),*) bnt
      if(tail(1:1).eq."W") bwt = -bwt
      if(tail(5:5).eq."S") bnt = -bnt
      jj = 0
      do rlat=bnt,bnt-50,-dxy
      jj = jj + 1
      ii = 0
      do rlon=bwt,bwt+40,+dxy
      ii = ii + 1
      enddo
      enddo
      print *,tail,"xx",jj,ii
      goto 1
99    close(10)


        end
        
c&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
      SUBROUTINE RTLLMx(TLM,TPH,TLM0D,DTR,CTPH0,STPH0,ALMD,APHD)
C
      STPH=SIN(TPH)
      CTPH=COS(TPH)
      CTLM=COS(TLM)
      STLM=SIN(TLM)
C
      APH=ASIN(STPH0*CTPH*CTLM+CTPH0*STPH)
      CPH=COS(APH)
C
      ALMD=TLM0D+ASIN(STLM*CTPH/CPH)/DTR
      APHD=APH/DTR
C
      RETURN
      END