!> \file tab-litho-0.3.f90 !! Repartition des enfoncement en fonction de la rigidite de la lithosphere. !< !> SUBROUTINE: tab_litho !! \author ... !! \date ... !! @note Subroutine qui donne la repartition des enfoncements !! en fonction de la rigidite de la lithosphere. !! @note variables en entree !! - ROM masse volumique du manteau !! - RL rayon de rigidite relative !! - DL rigidite flexural !! !! @note variables en sortie !! - WE deflection due a une charge unitaire !! !! @note Used modules: !! @note - use module3D_phy !! @note - use param_phy_mod !! @note - use ISO_DECLAR !< subroutine tab_litho USE module3D_phy USE param_phy_mod USE ISO_DECLAR ! module de declaration pour l'isostasie implicit none INTEGER, PARAMETER :: nk=1000 REAL, dimension(0:nk) :: kei REAL :: stepk,AL,XL,DIST REAL :: som ! pour la lithosphere STEPK=100. AL=-RL*RL/(2.*PI*DL)*DX*DY ! fonction de kelvin ! lecture de la table kei qui est tous les 0.01 entre 0 et 10 ! STEPK=100=1/ecart open(num_kelvin,file=trim(dirnameinp)//'../kelvin.res') read(num_kelvin,*) do K=0,NK read(num_kelvin,*) XL,kei(K) end do close(num_kelvin) do I=-LBLOC,LBLOC do J=-LBLOC,LBLOC DIST=dx*sqrt(1.*(I*I+J*J)) XL=DIST/RL*STEPK K=int(XL) if ((K.gt.834).or.(DIST.gt.dx*LBLOC)) then We(I,J)=0. else We(I,J)=kei(k)+(kei(k+1)-kei(k))*(XL-K) if (K.eq.834) We(I,J)=max(We(I,J),0.) endif We(I,J)=We(I,J)*Al end do end do !open(55,file='iso-cat') !write(55,*) 'WE avec LBLOC sur 480 km' !do i=-lbloc,lbloc ! write(55,'25(i4,1x)') (int(WE(i,j)*1.e08),j=-lbloc,lbloc) !end do !close(55) ! sommation des elements de WE dans som pour normaliser ! la somme des enfoncements a 1 som = SUM(WE(:,:)) ! normalisation WE(:,:) = WE(:,:)/(som*ROM*g) ! ATTENTION DESSOUS VALABLE SEULEMENT EN 40 km ! la partie ci-dessous doit etre mise dans une routine specifique Philippe ! pour faire exactement la meme isostasie que Philippe !if ((icouple.eq.2).or.(icouple.eq.4)) then ! LBLOC=10 ! do I=-LBLOC,LBLOC ! do J=-LBLOC,LBLOC ! We(i,j)=0. ! mise a 0 partout ! end do ! end do ! open(num_phil,file='../INPUT/iso-philippe') ! read(num_phil,*) ! read(num_phil,*) ! read(num_phil,*) ! read(num_phil,*) ! do J=-10,10 ! read(num_phil,*)(We(i,j),i=-10,10) ! end do ! close(num_phil) ! do i=-LBLOC,LBLOC ! do j=-LBLOC,LBLOC ! we(i,j)=we(i,j)/11030/g/rom ! end do ! end do !endif return end subroutine tab_litho