program eta_boco
c
c *** Creates the eta boundary condition file.
c
c *** Original code obtained from U. of Athens and modified at FSL.
c
c      implicit none

CCCCCCC Trocar de acordo com a rodada (ETAIN)
       integer, parameter :: im=285, jm=601    
CCCCCCC

       integer :: imt=2*im-1, jmt=jm/2+1
 
       integer :: lb=(jm/2+1)*2+(2*im-1)-3, lm=38

c
       real*4 
     .    pdba(lb)  ,tba(lb,lm)  ,qba(lb,lm)  ,uba(lb,lm)  ,vba(lb,lm)
     .   ,pdbb(lb)  ,tbb(lb,lm)  ,qbb(lb,lm)  ,ubb(lb,lm)  ,vbb(lb,lm)          
     .   ,pdb (lb,2),tb (lb,lm,2),qb (lb,lm,2),ub (lb,lm,2),vb (lb,lm,2)  
     .   ,q2b(lb,lm,2),cwmb(lb,lm,2)
     .   ,pdb2(lb,2),tb2(lb,lm,2),qb2(lb,lm,2),ub2(lb,lm,2),vb2(lb,lm,2)
     .   ,rtboco,run
c
       integer*4 itboco,ibc,nibc,idat(3),ihrst,i,j,k,l,len,n
c
       character*255 fname1,fname2,fname
       character*8   ftime
       character*3   ced
c
       real*4 epsq2
       parameter (epsq2=0.2)

       real*4 dummy
c_______________________________________________________________________________
c

c
c *** Read ETA namelist.
c
c      open(1,file='ETAIN',form='formatted',status='old',err=900)
c      read(1,model_grids,end=901)
c      read(1,sfc_init,end=902)
c      close(1)

CCCCCCC Trocar de acordo com a rodada (ETAIN)
       TLM0D=-65.0
       TPH0D=-12.0
       NINIT=2
       TBOCO=6
CCCCCCC  
  
        NHOUR=(NINIT-1)*TBOCO
        write(6,*) 'initializing for a model run of length: ',
     +  NHOUR, 'hours'

      WBD=-(IM-1)*DLMD
      SBD=-((JM-1)/2.)*DPHD

c      imt=2*im-1
c      jmt=jm/2+1
      imjm=im*jm-jm/2
      imjm1=imjm-1
      im1=im-1
      im2=im-2
      jm1=jm-1
      jm2=jm-2
      jm3=jm-3
      jm4=jm-4
      jm5=jm-5
      imm1=imt-1
      imm3=imt-3
      imm5=imt-5
      jmm1=jmt-1
      jmm2=jmt-2
      kb=im*2+jm-3
C      lb=jmt*2+imt-3
      lmp1=lm+1
      jam=6+2*(jm-10)

      ctph0=cos(tph0d/factor)
      stph0=sin(tph0d/factor)

      print *,' '
      print *,'Creating eta boundary condition files...'
	print *, 'these are dimensioned as lb, which is= ', lb
	print *, 'kb,im,jm,imjm,imt,jmt= ',kb,im,jm,imjm,imt,jmt
c
c      len=index(init_out,' ')-1
c      if (init_out(len:len) .ne. '/') then
c         len=len+1
c         init_out(len:len)='/'
c      endif
c
c *** Open boundary condition file.
c     Bndy conditions will be written sequentially into one file (NCEP style).
c
c      write(ftime,'(4i2.2)') mod(iyear,100),imonth,idate,istrtim
Cmp      l=len+13
	l=9
Cmp      fname(1:l)=init_out(1:len)//'bndy.'//ftime
      fname(1:l)='bndy.file'
      print *,'Open BC file  : ',fname(1:l)

      open(2,file=fname(1:l),status='unknown',form='unformatted')
c
c *** Loop through for all boco files.
c
      rtboco=1./(tboco*3600.)                                             
      itboco=nint(tboco)
      nibc=nhour/itboco

      do ibc=1,nibc

         fname(1:l)='bndy.file'
         print *,'Reading ',fname(1:l)
 

         if (ibc .eq. 1) read(2) run,idat,ihrst,tboco

         write(6,*) run,idat,ihrst,tboco

C         read(2) float(ibc-1)*tboco
         read(2) dummy
	 
         read(2) pdb
         read(2) tb

	write(6,*) 'pdb(1) ', pdb(1,1),pdb(1,2)
	write(6,*) 'pdb(lb/2) ', pdb(lb/2,1),pdb(lb/2,2)
	write(6,*) 'pdb(last) ', pdb(lb,1),pdb(lb,2)
	write(6,*) 't(1,lm/2) ', tb(1,lm/2,1),tb(1,lm/2,2)
	write(6,*) 't(lb,lm/2) ', tb(lb,lm/2,1),tb(lb,lm/2,2)

         read(2) qb
         read(2) ub
         read(2) vb

	write(6,*) 'T Q U V '
        do l=1,lm
	do i=1,lb
	write(6,633) i,l,tb(i,l,1),qb(i,l,1)*1.e6,ub(i,l,1),vb(i,l,1),
     +                ( ub(i,l,1)**2.+ vb(i,l,1)**2. ) ** 0.5
	enddo
	enddo

  633	format(I6,I3,1x,5(f12.1,1x))
Cmp         do k=1,2
         do j=1,lm
         do i=1,lb
            q2b(i,j,1)=epsq2
            q2b(i,j,2)=0.
            cwmb(i,j,1)=0.
            cwmb(i,j,2)=0.
         enddo
         enddo
Cmp         enddo
         read(2) q2b
         read(2) cwmb 
c
      enddo
c      read(2) float(nibc)*tboco
        read(2) dummy
Cmp
Cmp	duplicate last tendency
        write(6,*) 'duping last tendency with some modification'

C       tendencies dont matter here, but the value does.
c
C       want to dump the terminal value here, not the "before" value!
C
         do n=1,lb
            pdb(n,1)=pdba(n)
            pdb(n,2)=(pdba(n)-pdbb(n))*rtboco
         enddo
c
         do l=1,lm
         do n=1,lb
            tb(n,l,1)=tba(n,l)
            qb(n,l,1)=qba(n,l)
            ub(n,l,1)=uba(n,l)
            vb(n,l,1)=vba(n,l)
c
            tb(n,l,2)=(tba(n,l)-tbb(n,l))*rtboco
            qb(n,l,2)=(qba(n,l)-qbb(n,l))*rtboco
            ub(n,l,2)=(uba(n,l)-ubb(n,l))*rtboco
            vb(n,l,2)=(vba(n,l)-vbb(n,l))*rtboco
         enddo
         enddo
c
	 read(2) pdb
         read(2) tb
         read(2) qb
         read(2) ub
         read(2) vb
 	 read(2) q2b
         read(2) cwmb


	write(6,*) 'pdb(1) ', pdb(1,1),pdb(1,2)
	write(6,*) 'pdb(last) ', pdb(lb,1),pdb(lb,2)
	write(6,*) 't(1,lm/2) ', tb(1,lm/2,1),tb(1,lm/2,2)
	write(6,*) 't(lb,lm/2) ', tb(lb,lm/2,1),tb(lb,lm/2,2)

      print *,'Close BC file : ',fname(1:l)
      close(2)
c
      end