!> \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