! rd_grille read a grid file
! Copyright (C) 1999,2010 Gauthier Delerce
!
! 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; either version 2, or (at your option)
! any later version.
!
! 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., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
!
! Gauthier Delerce <gauthier@delerce.fr>
! 26022003 : fix problem with allocation of grilletmp with grid file , allocate 0
!050624 : remove border elimination
subroutine rd_grille
use mod_parameters
!use modvsv
!use modgrille
!use modnetcdf
!use MODEXCHG
implicit none
integer::i,ii,iii,j,k
real::xl,yl,ul,vl
integer,dimension(:),allocatable::image
character(120)::pingname
integer::cpt1,cpt3,cptin,cptout
character(1)::yorn
external from_png
!INTERFACE
! SUBROUTINE F_from_png (pingname)
! !DEC$ ATTRIBUTES C, ALIAS:'_C_from_png' :: F_from_png
! !DEC$ ATTRIBUTES REFERENCE :: pingname
!
! character(120)::pingname
! END SUBROUTINE F_from_png
!END INTERFACE
print*,"DEBUG, call rd_grille"
allocate(image(nx*ny))
image=255.
if((yorn.eq.'y').or.(yorn.eq.'Y')) then
i=0
! call test_png(maskname,i)
i=index(maskname,'.png',back=.true.)
! print*,'test png',i,maskname
j=0
if(i==0) then
open(unit=10,file=trim(maskname),access='direct',recl=1,form='unformatted',status='old',err=10)
close(10)
j=1
call rd_i12(maskname,image,nx*ny,ii)
10 continue
endif
if(j==0) then
if(i==0) then
pingname=maskname
maskname=trim(pingname)//'.png'
endif
print*,'reading png mask ',trim(maskname)
indexx=index(maskname,' ')
pingname=trim(maskname)//'\0'
call from_png(pingname,in,nbpp,pngx,pngy)
if((pngx/=nx).or.(pngy/=ny)) then
print*,'Error in mask image size'
print*,pngx,nx,pngy,ny
stop
endif
! call from_png(pingname,in,nbpp,pngx,pngy)
if(nbpp>8) then
print*,"Mask MUST be code in 8 bits"
print*,"CIV1 STOPPED"
stop
endif
k=1
! do j=ny,1,-1
do j=1,ny
image((1+(j-1)*nx):(nx+(j-1)*nx))=in(k:k+nx-1)
k=k+nx
enddo
!imagea=reshape(in,(/768,484/))
forall(i=1:nx*ny,image(i)<0)
image(i)=image(i)+256
endforall
print*,'minmax du mask',minval(image),maxval(image)
endif
print*,'MASK DEFINITION : gray level > 200 no masked'
print*,' undefined velocity : level > 20 soft mask '
print*,' nulle velocity : level < 20 hard mask'
print*,' USE 8 bits images only, no 16bits png please '
print*,''
endif
!if( (shift_flag==1).AND.(xoffset==0).AND.(yoffset==0.)) then ! we'll read a .v file as guess and grid
!
! indx=scan(fpix,'.')
! indx=indx-1
! open(45,file=fpix(1:indx)//'.v',form='binary',status='unknown',ACTION='READ' )
! read(45) mg
! !print*,'nb de lignes :',mg
!
! ng=1
! if(test_seuil) then
! allocate (grille(mg*ng,10))
! else
! allocate(grille(mg*ng,7))
! endif
! grille=0.
! do i=1,mg
! read(45) xl,yl,ul,vl
! ! print*,x,y,u,v,pixcmx,pixcmy,dt
! xl=xl*pixcmx
! yl=yl*pixcmy
! ul=ul*pixcmx*dt
! vl=vl*pixcmy*dt
! iii=iii+4
!
! ii=(ny-yl)*(nx)+xl
!! print*,x,y,ii
! if (image(ii).lt.200.) then
! if ( image(ii).lt.20. ) then
! grille(i,:)=(/xl,yl,0.,0.,0.,0./)
! else
! grille(i,:)=(/xl,yl,3.,0.,0.,0./)
! endif
! else
! grille(i,:)=(/xl,yl,-1.,ul,-vl,0./)
! endif
! enddo
! close(45)
! goto 152
!
!endif
cpt1=0 ! compteur des vecteurs a calculer et allouer
cpt2=0 ! compteur des vecteurs nuls, stocker leurs coordonnées dans un tab tmp pour les retrouver a la fin
cpt3=0 ! compteur des vecteurs masqué "soft"
if(new_default) then
print*,'GRID: new_default'
allocate(grilletmp(mg*ng,7),grilletmp2(mg*ng,2))
grilletmp=0.
grilletmp2=0.
cptin=0
cptout=0
do i=1,(mg*ng)
! read(9,*) xl,yl
xl=grille(i,1)
!print*,'new default'
yl=grille(i,2)
! if( xl < (isrx+1)/2-power4_dist ) then
! cpt3=cpt3+1
! goto 168
! endif
! if( yl < (isry+1)/2-power4_dist ) then
! cpt3=cpt3+1
! goto 168
! endif
! if( xl > nx-((isrx-1)/2+power4_dist) ) then
! cpt3=cpt3+1
! goto 168
! endif
! if( yl > ny-((isry-1)/2+power4_dist) ) then
! cpt3=cpt3+1
! goto 168
! endif
ii=(ny-yl)*(nx)+xl
if (image(ii).lt.200.) then
! print*,'noeud ds le mask'
cptin=cptin+1
if ( image(ii).lt.20. ) then
cpt2=cpt2+1
grilletmp2(cpt2,1:2)=(/xl,yl/)
!grille(i,:)=(/xl,yl,0.,0.,0.,0./)
else
cpt3=cpt3+1
!grille(i,:)=(/xl,yl,3.,0.,0.,0./)
endif
else
! print*,'noeud en dehors du mask'
cptout=cptout+1
cpt1=cpt1+1
grilletmp(cpt1,1:6)=(/xl,yl,-1.,float(xoffset),float(yoffset),0./)
!grille(i,:)=(/xl,yl,-1.,xoffset,-yoffset,0./)
endif
168 continue
end do
print*,'noeud in et out ',cptin,cptout,mg*ng
deallocate(grille)
mg=cpt1;ng=1
allocate(grille(mg*ng,7))
grille(1:mg*ng,:)=grilletmp(1:mg*ng,:)
deallocate(grilletmp)
else
print*,'GRID: NOT new_default'
open(unit=9,file=trim(adjustl(fgrille)),form='formatted',status='old',ACTION='READ' )
print*,'Open file grid: ',trim(adjustl(fgrille))
read(9,*) mg,ng
print*,'Size is:',mg,ng,mg*ng
allocate(grilletmp(mg*ng,7),grilletmp2(mg*ng,2))
grilletmp=0.
grilletmp2=0.
!allocate(grille(mg*ng,7))
!grille=0.
do i=1,(mg*ng)
read(9,*) xl,yl
! print*,i,xl,yl
if( xl < (isrx+1)/2-power4_dist ) then
cpt3=cpt3+1
goto 167
endif
if( yl < (isry+1)/2-power4_dist ) then
cpt3=cpt3+1
goto 167
endif
if( xl > nx-((isrx-1)/2+power4_dist) ) then
cpt3=cpt3+1
goto 167
endif
if( yl > ny-((isry-1)/2+power4_dist) ) then
cpt3=cpt3+1
goto 167
endif
ii=(ny-yl)*(nx)+xl
! print*,cpt1,cpt2,cpt3,ii,nx,ny,image(1)
if (image(ii).lt.200.) then
if ( image(ii).lt.20. ) then
cpt2=cpt2+1
grilletmp2(cpt2,1:2)=(/xl,yl/)
!grille(i,:)=(/xl,yl,0.,0.,0.,0./)
else
cpt3=cpt3+1
!grille(i,:)=(/xl,yl,3.,0.,0.,0./)
endif
else
cpt1=cpt1+1
! print*,xl,yl,-1.,xoffset,-yoffset,0.
grilletmp(cpt1,1:6)=(/xl,yl,-1.,float(xoffset),float(yoffset),0./)
!grille(i,:)=(/xl,yl,-1.,xoffset,-yoffset,0./)
endif
167 continue
end do
mg=cpt1;ng=1
deallocate(grille)
allocate(grille(mg*ng,7))
grille(1:mg*ng,:)=grilletmp(1:mg*ng,:)
deallocate(grilletmp)
close(9)
endif
152 continue
!_______________________f__________________________________
! GRID BOUND CHECKER
!do i=1,(mg*ng)
! if( grille(i,1) < (isrx+1)/2-power4_dist ) grille(i,3)=3.
! if( grille(i,2) < (isry+1)/2-power4_dist ) grille(i,3)=3.
! if( grille(i,1) > nx-((isrx-1)/2+power4_dist) ) grille(i,3)=3.
! if( grille(i,2) > ny-((isry-1)/2+power4_dist) ) grille(i,3)=3.
!enddo
! GRID BOUND CHECKER
!_________________________________________________________
if (ALLOCATED (ib)) DEALLOCATE(ib)
if (ALLOCATED (is)) DEALLOCATE(is)
allocate(ib(mg*ng,2),is(mg*ng,2))
print*,'IB & IS allocated',mg*ng
!pause
ib(:,1)=ibsx
ib(:,2)=ibsy
is(:,1)=isrx
is(:,2)=isry
deallocate(image)
print*,'***OFFSET***',xoffset,yoffset
return
end