      program prepmegan
!*****************************************************************************
!*
!*    This program reads the netcdf EFiso, LAI and PFTs file(s) from MEGAN
!*    input datasources and averages to the nmmb global grid
!*
!*    author: Oriol Jorba
!*****************************************************************************
  use netcdf
  implicit none

  integer input_id,ncid_in,numLons,numLats,stat,i,j,imi,jmi,im,jm,ifn_args,ierr
  integer iso_id,lx_id,ly_id
  integer,parameter :: n_files=17
  integer iarg,ii,count,count2,jj,ffile
  real dlmd_d,dphd_d,dlmd,dphd,tlm0d,tph0d,wbd,sbd,wbd_in,sbd_in,inc_mgn
  real*8 sumup,sumup2
  logical global
  character*200 file_inp,var_inp,fileiso,filepft_bt,filepft_sb,filepft_hb,filepft_nt
  character*200 file_lai01,file_lai02,file_lai03,file_lai04,file_lai05,file_lai06, &
                file_lai07,file_lai08,file_lai09,file_lai10,file_lai11,file_lai12
  integer, dimension(nf90_max_var_dims) :: dimIDs
  real, dimension (:,:), allocatable :: field, umovar,padded2
  real, dimension (:), allocatable :: lon, lat
  character*200,dimension(n_files) :: file_names
namelist /args/ imi,jmi,tlm0d,tph0d,wbd,sbd,dlmd_d,dphd_d,global,inc_mgn,file_names
!                fileiso,filepft_bt,filepft_nt,  &
!                filepft_sb,filepft_hb,file_lai01,file_lai02,file_lai03,file_lai04,  &
!                file_lai05,file_lai06,file_lai07,file_lai08,file_lai09,file_lai10,  &
!                file_lai11,file_lai12

  integer nlats,nlons,nlate,nlone
  integer poslatmgn21,poslatmgn22,poslatmgn12,poslatmgn11
  integer poslonmgn21,poslonmgn22,poslonmgn12,poslonmgn11
  real    lon_nmmb,lat_nmmb,lon_nmmbr,lat_nmmbr,ctph0,stph0,tph0,dlm,dph
  real lonmin,lonmax,latmin,latmax,rangelat,rangelon
  logical,save :: firstime
  real,parameter :: dtr=3.1415926535897932384626433832795/180.

!  character(len=100),dimension(n_files) :: name_files
!  data name_files /fileiso,filepft_bt,filepft_nt,filepft_sb,filepft_hb, &
!                 file_lai01,file_lai02,file_lai03,file_lai04,           &
!                file_lai05,file_lai06,file_lai07,file_lai08,file_lai09,file_lai10,  &
!                file_lai11,file_lai12/

  character(len=100),dimension(n_files) :: var_files
  data var_files /"isoprene_(microgram_per_m2_per_hr)","Broadleaf_tree_cover_fraction_for_year_2001_(m2_per_m2)", &
  "Needleleaf_tree_cover_fraction_for_year_2001_(m2_per_m2)","Shrub_cover_fraction_for_year_2001_(m2_per_m2)",    &
  "Herbaceous_cover_fraction_for_year_2001_(m2_per_m2)","LAI_for_Jan_2003_(m2_per_m2)","LAI_for_Feb_2003_(m2_per_m2)", &
  "LAI_for_Mar_2003_(m2_per_m2)","LAI_for_Apr_2003_(m2_per_m2)","LAI_for_May_2003_(m2_per_m2)","LAI_for_Jun_2003_(m2_per_m2)", &
  "LAI_for_Jul_2003_(m2_per_m2)","LAI_for_Aug_2003_(m2_per_m2)","LAI_for_Sep_2003_(m2_per_m2)","LAI_for_Oct_2003_(m2_per_m2)", &
  "LAI_for_Nov_2003_(m2_per_m2)","LAI_for_Dec_2003_(m2_per_m2)"/

  character(len=10),dimension(n_files) :: out_files
  data out_files /"isop","pftp_bt","pftp_nt","pftp_sb","pftp_hb","lai01","lai02","lai03","lai04","lai05","lai06","lai07","lai08", &
                  "lai09","lai10","lai11","lai12"/
  character(len=20) :: output_file
!inc_mgn : resolution of megan input netcdfs in seconds
!
firstime=.true.
!***  Gets arguments from inputfile
ifn_args=10
iarg = 1                          ! inp file
!call GETARG(iarg,file_inp)
file_inp="namelist.input"
open(ifn_args,file=file_inp,form='formatted',status='old',action='read',iostat=ierr) 
read(ifn_args,nml=args,iostat=ierr)

dlmd=dlmd_d
dphd=dphd_d
if(global)then
im=imi+2
jm=jmi+2
else
im=imi
jm=jmi
tph0=tph0d*dtr
ctph0=cos(tph0)
stph0=sin(tph0)
dlm=dlmd*dtr
dph=dphd*dtr
!wbd=wbd+tlm0d
!sbd=sbd+tph0d
endif
close(ifn_args)

!Average MEGAN input files to NMMB grid
allocate(umovar(imi,jmi))
allocate(padded2(im,jm))

!LOOP OVER INPUT FILES
do ffile=1,n_files
count2=0
!Initialize umovar
umovar=0.

!Opening input file (read only)
file_inp=file_names(ffile) !fileiso
var_inp=trim(var_files(ffile)) !"isoprene_(microgram_per_m2_per_hr)"
print*,'OPEN FILE: ',trim(file_inp),' FOR VARIABLE: ',trim(var_inp)
stat=nf90_open(file_inp,nf90_nowrite,input_id)
call check_stat(stat,'open')
!!!!!!!!!!read lon!!!!!!!!!!!!!
stat=nf90_inq_varid(input_id,"lon",ncid_in)
call check_stat(stat,'varid lon')
stat=nf90_inquire_variable(input_id,ncid_in, dimids = dimIDs)
call check_stat(stat,'variable lon')
stat=nf90_inquire_dimension(input_id,dimIDs(1), len = numLons)
call check_stat(stat,'dim lon')
if(firstime)allocate(lon(numLons))
stat=nf90_get_var(input_id,ncid_in,lon)
call check_stat(stat,'get lon')
!!!!!!!!!!read lat!!!!!!!!!!!!!
stat=nf90_inq_varid(input_id,"lat",ncid_in)
call check_stat(stat,'varid lat')
stat=nf90_inquire_variable(input_id,ncid_in, dimids = dimIDs)
call check_stat(stat,'variable lat')
stat=nf90_inquire_dimension(input_id,dimIDs(1), len = numLats)
call check_stat(stat,'dim lat')
if(firstime)allocate(lat(numLats))
stat=nf90_get_var(input_id,ncid_in,lat)
call check_stat(stat,'get lat')
!!!!!!!!!!read field!!!!!!!!!!!!!
stat=nf90_inq_varid(input_id,var_inp,ncid_in)
call check_stat(stat,'varid field')                
stat=nf90_inquire_variable(input_id,ncid_in, dimids = dimIDs)
call check_stat(stat,'variable field')                  
stat=nf90_inquire_dimension(input_id,dimIDs(1), len = numLons)
call check_stat(stat,'dim field')                 
stat=nf90_inquire_dimension(input_id,dimIDs(2), len = numLats)
call check_stat(stat,'dim2 field')                   
if(firstime)allocate(field(numLons,numLats))
stat=nf90_get_var(input_id,ncid_in,field)
call check_stat(stat,'get field')                  

!!TEMP
!field(1:2000,:)=0.5
!field(2001:4000,:)=1.
!!!

stat=nf90_close(input_id)

!Start process

latmax=lat(1) 
lonmin=lon(1)
latmin=lat(numLats)
lonmax=lon(numLons)

!First we find the nmmb cell to the lower-left upper-right side of latmin-lonmin latmax-lonmax
if(global)then
nlons=nint(abs(wbd-lonmin)/dlmd)+1
nlats=nint(abs(sbd-latmin)/dphd)+1
nlone=nint(abs(wbd-lonmax)/dlmd+0.5)-1
nlate=nint(abs(sbd-latmax)/dphd+0.5)-1
else !Regional
!we suppose that the nmmb regional domain falls within domain of megan datafiles - need improvement for a general case
nlons=1
nlats=1
nlone=im
nlate=jm
endif

sumup=0.
sumup2=0.
!Start loop for average

do j=nlats,nlate
  do i=nlons,nlone

  if(global)then
    Lat_nmmb=sbd+(j-1)*dphd
    Lon_nmmb=wbd+(i-1)*dlmd
    rangelat=dphd/2
    rangelon=dlmd/2
  else
    rangelat=dphd/2
    rangelon=dlmd/2

    Lat_nmmbr=(sbd+(j-1)*dphd)*dtr
    Lon_nmmbr=(wbd+(i-1)*dlmd)*dtr

    call rtll(Lon_nmmbr,Lat_nmmbr,tlm0d,ctph0,stph0,Lon_nmmb,Lat_nmmb)
  endif

  if(global)then
!    print*,'aqui3',j,i,Lat_nmmb,Lon_nmmb,rangelat,rangelon
    if(j.eq.nlats)then
      if(i.eq.nlons)then !lower-left corner

    posLatmgn11=numLats-(nint(abs(latmin-(Lat_nmmb))/(inc_mgn/3600.)+0.5))
    posLatmgn12=posLatmgn11
    posLatmgn21=numLats-nint(abs(latmin-(Lat_nmmb+rangelat))/(inc_mgn/3600.)+0.5)+1
    posLatmgn22=posLatmgn21

    posLonmgn11=nint(abs(lonmin-(Lon_nmmb))/(inc_mgn/3600.)+0.5)+1
    posLonmgn21=posLonmgn11
    posLonmgn12=nint(abs(lonmin-(Lon_nmmb+rangelon))/(inc_mgn/3600.)+0.5)
    posLonmgn22=posLonmgn12

      elseif(i.eq.nlone)then !lower-right corner

    posLatmgn11=numLats-(nint(abs(latmin-(Lat_nmmb-rangelat))/(inc_mgn/3600.)+0.5))
    posLatmgn12=posLatmgn11
    posLatmgn21=numLats-nint(abs(latmin-(Lat_nmmb))/(inc_mgn/3600.)+0.5)+1
    posLatmgn22=posLatmgn21

    posLonmgn11=nint(abs(lonmin-(Lon_nmmb-rangelon))/(inc_mgn/3600.)+0.5)+1
    posLonmgn21=posLonmgn11
    posLonmgn12=nint(abs(lonmin-(Lon_nmmb))/(inc_mgn/3600.)+0.5)
    posLonmgn22=posLonmgn12

      else ! southern boundary

    posLatmgn11=numLats-(nint(abs(latmin-(Lat_nmmb))/(inc_mgn/3600.)+0.5))
    posLatmgn12=posLatmgn11
    posLatmgn21=numLats-nint(abs(latmin-(Lat_nmmb+rangelat))/(inc_mgn/3600.)+0.5)+1
    posLatmgn22=posLatmgn21

    posLonmgn11=nint(abs(lonmin-(Lon_nmmb-rangelon))/(inc_mgn/3600.)+0.5)+1
    posLonmgn21=posLonmgn11
    posLonmgn12=nint(abs(lonmin-(Lon_nmmb+rangelon))/(inc_mgn/3600.)+0.5)
    posLonmgn22=posLonmgn12

      endif
    elseif(j.eq.nlate)then
      if(i.eq.nlons)then !upper-left corner

    posLatmgn11=numLats-(nint(abs(latmin-(Lat_nmmb-rangelat))/(inc_mgn/3600.)+0.5))
    posLatmgn12=posLatmgn11
    posLatmgn21=numLats-nint(abs(latmin-(Lat_nmmb))/(inc_mgn/3600.)+0.5)+1
    posLatmgn22=posLatmgn21

    posLonmgn11=nint(abs(lonmin-(Lon_nmmb))/(inc_mgn/3600.)+0.5)+1
    posLonmgn21=posLonmgn11
    posLonmgn12=nint(abs(lonmin-(Lon_nmmb+rangelon))/(inc_mgn/3600.)+0.5)
    posLonmgn22=posLonmgn12

      elseif(i.eq.nlone)then !upper-right corner

    posLatmgn11=numLats-(nint(abs(latmin-(Lat_nmmb-rangelat))/(inc_mgn/3600.)+0.5))
    posLatmgn12=posLatmgn11
    posLatmgn21=numLats-nint(abs(latmin-(Lat_nmmb))/(inc_mgn/3600.)+0.5)+1
    posLatmgn22=posLatmgn21

    posLonmgn11=nint(abs(lonmin-(Lon_nmmb-rangelon))/(inc_mgn/3600.)+0.5)+1
    posLonmgn21=posLonmgn11
    posLonmgn12=nint(abs(lonmin-(Lon_nmmb))/(inc_mgn/3600.)+0.5)
    posLonmgn22=posLonmgn12

      else ! northern boundary

    posLatmgn11=numLats-(nint(abs(latmin-(Lat_nmmb-rangelat))/(inc_mgn/3600.)+0.5))
    posLatmgn12=posLatmgn11
    posLatmgn21=numLats-nint(abs(latmin-(Lat_nmmb))/(inc_mgn/3600.)+0.5)+1
    posLatmgn22=posLatmgn21

    posLonmgn11=nint(abs(lonmin-(Lon_nmmb-rangelon))/(inc_mgn/3600.)+0.5)+1
    posLonmgn21=posLonmgn11
    posLonmgn12=nint(abs(lonmin-(Lon_nmmb+rangelon))/(inc_mgn/3600.)+0.5)
    posLonmgn22=posLonmgn12

      endif
    elseif(i.eq.nlons)then
      if(j.gt.nlats.and.j.lt.nlate)then !eastern boundary

    posLatmgn11=numLats-(nint(abs(latmin-(Lat_nmmb-rangelat))/(inc_mgn/3600.)+0.5))
    posLatmgn12=posLatmgn11
    posLatmgn21=numLats-nint(abs(latmin-(Lat_nmmb+rangelat))/(inc_mgn/3600.)+0.5)+1
    posLatmgn22=posLatmgn21

    posLonmgn11=nint(abs(lonmin-(Lon_nmmb))/(inc_mgn/3600.)+0.5)+1
    posLonmgn21=posLonmgn11
    posLonmgn12=nint(abs(lonmin-(Lon_nmmb+rangelon))/(inc_mgn/3600.)+0.5)
    posLonmgn22=posLonmgn12

      endif
    elseif(i.eq.nlone)then
      if(j.gt.nlats.and.j.lt.nlate)then !western boundary

    posLatmgn11=numLats-(nint(abs(latmin-(Lat_nmmb-rangelat))/(inc_mgn/3600.)+0.5))
    posLatmgn12=posLatmgn11
    posLatmgn21=numLats-nint(abs(latmin-(Lat_nmmb+rangelat))/(inc_mgn/3600.)+0.5)+1
    posLatmgn22=posLatmgn21

    posLonmgn11=nint(abs(lonmin-(Lon_nmmb-rangelon))/(inc_mgn/3600.)+0.5)+1
    posLonmgn21=posLonmgn11
    posLonmgn12=nint(abs(lonmin-(Lon_nmmb))/(inc_mgn/3600.)+0.5)
    posLonmgn22=posLonmgn12

      endif
    else !center of the domain

    posLatmgn11=numLats-(nint(abs(latmin-(Lat_nmmb-rangelat))/(inc_mgn/3600.)+0.5))
    posLatmgn12=posLatmgn11
    posLatmgn21=numLats-nint(abs(latmin-(Lat_nmmb+rangelat))/(inc_mgn/3600.)+0.5)+1
    posLatmgn22=posLatmgn21

    posLonmgn11=nint(abs(lonmin-(Lon_nmmb-rangelon))/(inc_mgn/3600.)+0.5)+1
    posLonmgn21=posLonmgn11
    posLonmgn12=nint(abs(lonmin-(Lon_nmmb+rangelon))/(inc_mgn/3600.)+0.5)
    posLonmgn22=posLonmgn12

    endif

  else !Regional
!we suppose that the nmmb regional domain falls within domain of megan datafiles - need improvement for a general case

    posLatmgn11=numLats-(nint(abs(latmin-(Lat_nmmb-rangelat))/(inc_mgn/3600.)+0.5))
    posLatmgn12=posLatmgn11
    posLatmgn21=numLats-nint(abs(latmin-(Lat_nmmb+rangelat))/(inc_mgn/3600.)+0.5)+1
    posLatmgn22=posLatmgn21
    
    posLonmgn11=nint(abs(lonmin-(Lon_nmmb-rangelon))/(inc_mgn/3600.)+0.5)+1
    posLonmgn21=posLonmgn11
    posLonmgn12=nint(abs(lonmin-(Lon_nmmb+rangelon))/(inc_mgn/3600.)+0.5)
    posLonmgn22=posLonmgn12

  endif

!print *,'aqui4',"lon",i,j,Lon_nmmb-rangelon,lon(posLonmgn11),Lon_nmmb+rangelon,lon(posLonmgn12),lon(posLonmgn12-1),lon(posLonmgn12+1),posLonmgn11,posLonmgn12
!print *,'aqui4',"lat",i,j,Lat_nmmb-rangelat,lat(posLatmgn11),Lat_nmmb+rangelat,lat(posLatmgn21),lat(posLatmgn21-1),lat(posLatmgn21+1),posLatmgn11,posLatmgn22
!lat(posLatmgn11+1),lat(posLatmgn11+5),numLats,posLatmgn11,latmin
!stop
!Lon_nmmb,posLatmgn11,posLatmgn22,posLonmgn11,posLonmgn12, lat(posLatmgn11),lon(posLonmgn21),field(posLonmgn21,posLatmgn11)

    count=0
    do jj=posLatmgn11,posLatmgn22,-1
      do ii=posLonmgn11,posLonmgn12
        if(field(ii,jj).gt.0) then
!        print *,field(ii,jj)
          umovar(i,j)=umovar(i,j)+field(ii,jj)
          sumup=sumup+field(ii,jj)
        endif
        count=count+1
        count2=count2+1
      enddo
    enddo
    if(count.gt.0) umovar(i,j)=umovar(i,j)/count
!print *,i,j,count
        count=0
  enddo
enddo

!checksum
sumup=0.
if(global)then
  do jj=1,jmi
    do i=1,imi
      sumup=sumup+umovar(i,jj)
    enddo
  enddo
else
  do jj=1,jm
    do i=1,im
      sumup=sumup+umovar(i,jj)
    enddo
  enddo
endif

do jj=1,numLats
  do i=1,numLons
        if(field(ii,jj).gt.0) then
!        print *,field(ii,jj)
    sumup2=sumup2+field(ii,jj)
        endif
  enddo
enddo

print *,'Final: ',trim(var_inp),sumup, sumup2,sumup/(im*jm),sumup2/(numLats*numLons),count2,numLats*numLons,maxval(umovar),maxval(field)


!Pack the nmmb grid to binary file
output_file="../out/"
output_file=trim(output_file)//trim(out_files(ffile))//".dat"
open(22,file=output_file,form="unformatted",status='unknown')

if(global) then
      call padh2(umovar,padded2,imi,jmi,im,jm)
      write(22) padded2
else
      write(22) umovar
endif


close(22)

!For debug purpouses - create output netcdf file
output_file="../out/"
output_file=trim(output_file)//trim(out_files(ffile))//".nc"
print*,'Creating debug netcdf output file'
stat=nf90_create(output_file,nf90_write,input_id)
call check_stat(stat,'create debug file')
stat=nf90_def_dim(input_id, 'i_dim',im,lx_id)
stat=nf90_def_dim(input_id, 'j_dim',jm,ly_id)
call check_stat(stat,'Defining dimensions ')
stat=nf90_def_var(input_id,trim(out_files(ffile)),NF90_FLOAT,(/lx_id,ly_id/),iso_id)
call check_stat(stat,'Defining variable ')
stat=nf90_enddef(input_id)
call check_stat(stat,'End defining mode')
if(global) then
stat=nf90_put_var(input_id,iso_id,padded2,start=(/1,1/),count=(/im,jm/))
call check_stat(stat,'Writting field')
else
stat=nf90_put_var(input_id,iso_id,umovar,start=(/1,1/),count=(/imi,jmi/))
call check_stat(stat,'Writting field')
endif
stat=nf90_close(input_id)


firstime=.false.
!END LOOP OVER FILE
enddo !ffile

       end program prepmegan
!***********************************************************************
subroutine check_stat(stat,message)
  use netcdf
  implicit none
  include 'netcdf.inc'
  integer, intent(in)       :: stat
  character*100, intent(in) :: message

  if ( stat /= nf90_NoErr ) then
     print*, 'error in netcdf status while...'
     print*, TRIM(message)
     STOP
  endif
end subroutine check_stat
!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
      subroutine padh2(h2,ph2,imi,jmi,im,jm)
!-----------------------------------------------------------------------
!      include 'lmimjm_hires.inc'
!-----------------------------------------------------------------------
      dimension h2(imi,jmi),ph2(im,jm)
!-------------averaging at polar points---------------------------------
      rim=1./(imi-1)
      h2s=0.
      h2n=0.
      do i=1,imi-1
        h2s=h2(i,1)+h2s
        h2n=h2(i,jmi)+h2n
      enddo
      h2s=h2s*rim
      h2n=h2n*rim
      do i=1,imi
        h2(i,1  )=h2s
        h2(i,jmi)=h2n
      enddo
!-------------padding---------------------------------------------------
      do j=1,jmi
        do i=1,imi
          ph2(i+1,j+1)=h2(i,j)
        enddo
      enddo
!
      do i=2,im-1
        ph2(i,1 )=ph2(i,3   )
        ph2(i,jm)=ph2(i,jm-2)
      enddo
!
      do j=1,jm
        ph2(1   ,j)=ph2(im-2,j)
        ave=(ph2(2,j)+ph2(im-1,j))*0.5
        ph2(2   ,j)=ave
        ph2(im-1,j)=ave
        ph2(im  ,j)=ph2(3   ,j)
      enddo
!-----------------------------------------------------------------------
      return
      end
!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
!-----------------------------------------------------------------------
!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
!-----------------------------------------------------------------------
!
      subroutine rtll(tlm,tph,tlm0d,ctph0,stph0,almd,aphd)
!     ****************************************************************
!     *                                                              *
!     *  programer: z. janjic, shmz, feb. 1981                       *
!     *  ammended:  z. janjic, ncep, jan. 1996                       *
!     *                                                              *
!     *  transformation from rotated lat-lon to lat-lon coordinates  *
!     ****************************************************************
!     ****************************************************************
!     *  tlm   - transformed longitude, rad.                         *
!     *  tph   - transformed latitude, rad.                          *
!     *  tlm0d - the angle of rotation of the transformed lat-lon    *
!     *          system in the longitudinal direction, degs          *
!     *  ctph0 - cos(tph0), tph0 is the angle of rotation of the     *
!     *          transformed lat-lon systemn in the latitudinal      *
!     *          direction, precomputed                              *
!     *  stph0 - sin(tph0), tph0 is the angle of rotation of the     *
!     *          transformed lat-lon systemn in the latitudinal      *
!     *          direction, precomputed                              *
!     *  almd  - geographical longitude, degs, range -180.,180       *
!     *  aphd  - geographical latitude,  degs, range - 90., 90.,     *
!     *          poles are singular                                  *
!     ****************************************************************
!
!-----------------------------------------------------------------------
!
      parameter(dtr=3.1415926535897932384626433832795/180.)
!
      stlm=sin(tlm)
      ctlm=cos(tlm)
      stph=sin(tph)
      ctph=cos(tph)
!
      sph=ctph0*stph+stph0*ctph*ctlm
      sph=min(sph,1.)
      sph=max(sph,-1.)
      aph=asin(sph)
      aphd=aph/dtr
      anum=ctph*stlm
      denom=(ctlm*ctph-stph0*sph)/ctph0
      relm=atan2(anum,denom)
      almd=relm/dtr+tlm0d
!
      if(almd.gt. 180.)    almd=almd-360.
      if(almd.lt.-180.)    almd=almd+360.
!
!-----------------------------------------------------------------------
!
      return
      end
!
!-----------------------------------------------------------------------
!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

