source: trunk/SOURCES/Hudson_files/dragging_hudson_jorge_mod_old.f90 @ 334

!> \file dragging_hudson_jorge_mod_old.f90
!! Module qui definie les zones de stream
!<

!> \namespace  dragging_hudson_jorge
!! Definie les zones de stream avec uniquement:
!! @note - un critere sur la hauteur d'eau 
!! @note jalv: module inspire par le dragging_hwat_contmaj mais simplifie
!! \author ...
!! \date ...
!! @note Used module
!! @note   - use module3D_phy
!! @note   - use sedim_declar
!<


module dragging_hudson_jorge

!jalv: module inspire par le dragging_hwat_contmaj mais simplifie
! Definie les zones de stream avec uniquement:
! * un critere sur la hauteur d'eau 
 

  use module3d_phy
  use sedim_declar

implicit none
logical,dimension(nx,ny) :: fleuvemx
logical,dimension(nx,ny) :: fleuvemy
logical,dimension(nx,ny) :: fleuve
logical,dimension(nx,ny) :: cote

real :: seuil_sedim              !< seuil sur hwater pour avoir du glissement
real :: valmax
integer :: imax,jmax
integer :: i_moins1,i_plus1,j_moins1,j_plus1
integer :: lmax=20
integer :: idep,jdep,iloc,jloc

integer :: itestd


real :: tostick   !< pour la glace posee
real :: tob_ile    !< pour les iles
real :: cry_lim=50.  !< courbure limite pour le suivi des fleuves
contains
!-------------------------------------------------------------------------------

!> SUBROUTINE: init_dragging
!! Cette routine fait l'initialisation du dragging.
!<
subroutine init_dragging      ! Cette routine fait l'initialisation du dragging.

implicit none
 
namelist/drag_hudson_jorge/hwatstream,cf,betamax,toblim,tostick,seuil_sedim    

if (itracebug.eq.1)  call tracebug(' Dragging avec hwatermax')


! formats pour les ecritures dans 42
428 format(A)

! lecture des parametres du run                      block dra_hudson_jorge
!--------------------------------------------------------------------

rewind(num_param)        ! pour revenir au debut du fichier param_list.dat
read(num_param,drag_hudson_jorge)

write(num_rep_42,428)'!___________________________________________________________' 
write(num_rep_42,428) '&drag_hudson_jorge              ! nom du bloc drag_hudson_jorge '
write(num_rep_42,*)
write(num_rep_42,*) 'hwatstream      = ',hwatstream 
write(num_rep_42,*) 'cf             = ',cf
write(num_rep_42,*) 'betamax         = ', betamax
write(num_rep_42,*) 'toblim         = ', toblim
write(num_rep_42,*) 'seuil_sedim         = ', seuil_sedim
write(num_rep_42,*)'/'                            
write(num_rep_42,428) '! hwatstream (m) :  critere de passage en stream en partant de la cote'
write(num_rep_42,428) '!  si hwater > hwatstream '
write(num_rep_42,428) '! cf coefficient de la loi de frottement fonction Neff'
write(num_rep_42,428) '! seulement pour les points cotiers'
write(num_rep_42,428) '! betamax : (Pa) frottement maxi sous les streams '
write(num_rep_42,428) '! toblim : (Pa)  pour les iles '
write(num_rep_42,*)

tostick=1.e5   ! valeurs pour les points non flgzmx
tob_ile=betamax/2.
moteurmax=toblim

!-------------------------------------------------------------------
! masque stream

      mstream_mx(:,:)=1
      mstream_my(:,:)=1

! coefficient permettant de modifier le basal drag.
      drag_mx(:,:)=1.
      drag_my(:,:)=1.

return
end subroutine init_dragging
!________________________________________________________________________________



!-------------------------------------------------------------------------

!> SUBROUTINE: dragging
!! Defini la localisation des streams et le frottement basal
!<
subroutine dragging   ! defini la localisation des streams et le frottement basal


fleuvemx(:,:)=.false.
fleuvemy(:,:)=.false.
fleuve(:,:)=.false.
ilemx(:,:)=.false.
ilemy(:,:)=.false.


do j=1,ny
   do i=1,nx
      if ((hwater(i,j).gt.hwatstream).or.((mksedim(i,j).eq.2.).and.(hwater(i,j).ge.seuil_sedim))) then
         fleuve(i,j)=.true.
         fleuvemx(i,j)=.true.                  !ajoute par jalv
         fleuvemy(i,j)=.true.                  !ajoute par jalv
      else
         fleuve(i,j)=.false.
         fleuvemx(i,j)=.false.                 !ajoute par jalv
         fleuvemy(i,j)=.false.                 !ajoute par jalv
      end if
   end do
end do

!jalv
!call detect_assym(nx,ny,0,76,1,0,1,0,betamx,itestd)
!if (itestd.gt.0) then
!   write(6,*) 'avant calcul betax asymetrie sur betamx  pour time=',time
!   stop
!else
!   write(6,*) 'avant calcul betax pas d asymetrie sur betamx  pour time=',time
!end if

!call detect_assym(nx,ny,0,76,1,0,1,0,betamy,itestd)
!if (itestd.gt.0) then
!    write(6,*) 'avant calcul betay asymetrie sur betamy  pour time=',time
!    stop
!else
!    write(6,*) 'avant calcul betay pas d asymetrie sur betamy  pour time=',time
!end if

! pas de fleuve dans les endroits trop en pente
!test jalv: j'autorise les fleuves dans les endroits trop en pente

!fleuvemx(:,:)=fleuvemx(:,:).and.(abs(rog*Hmx(:,:)*sdx(:,:)).lt.toblim)
!fleuvemy(:,:)=fleuvemy(:,:).and.(abs(rog*Hmy(:,:)*sdy(:,:)).lt.toblim)

! calcul du frottement basal (ce bloc etait avant dans neffect)

do j=1,ny          
   do i=1,nx

      if (fleuvemy(i,j)) then
         betamy(i,j)=betamax
!         betamy(i,j)=cf*neffmy(i,j)*20. 
         betamy(i,j)=15. 
         betamy(i,j)=min(betamy(i,j),betamax)
         betamy(i,j)=max(betamy(i,j),20.)
      endif

 !     if (cf*neffmy(i,j).gt.1500.) then
 !        fleuvemy(i,j)=.false.
!      endif

      if (ilemy(i,j)) then
!         betamy(i,j)=cf*neffmy(i,j)
         betamy(i,j)=10.
         betamy(i,j)=min(betamy(i,j),tob_ile)       
      endif

      if (flotmy(i,j)) then     ! flottant
         betamy(i,j)=0.
      endif

   end do
end do


do j=1,ny           ! le noeud 1 n'est pas attribue
   do i=1,nx
      if (fleuvemx(i,j)) then
         betamx(i,j)=betamax
!         betamx(i,j)=cf*neffmx(i,j)*20.
         betamx(i,j)=15.         
         betamx(i,j)=min(betamx(i,j),betamax)
         betamx(i,j)=max(betamx(i,j),20.)
      endif

!      if (cf*neffmx(i,j).gt.1500.) then
!         fleuvemx(i,j)=.false.
!      endif

      if (ilemx(i,j)) then
!         betamx(i,j)=cf*neffmx(i,j)
         betamx(i,j)=10.
         betamx(i,j)=min(betamx(i,j),tob_ile)       
      endif

      if (flotmx(i,j)) then     ! flottant
         betamx(i,j)=0.
      endif

   end do
end do


!jalv
!call detect_assym(nx,ny,0,76,1,0,1,0,betamx,itestd)
!if (itestd.gt.0) then
!   write(6,*) 'apres dragging asymetrie sur betamx  pour time=',time
!   stop
!else
!   write(6,*) 'apres dragging pas d asymetrie sur betamx  pour time=',time
!end if

!call detect_assym(nx,ny,0,76,1,0,1,0,betamy,itestd)
!if (itestd.gt.0) then
!    write(6,*) 'apres dragging asymetrie sur betamy  pour time=',time
!    stop
!else
!    write(6,*) 'apres dragging pas d asymetrie sur betamy  pour time=',time
!end if

return

end subroutine dragging

end module dragging_hudson_jorge