source: trunk/SOURCES/taubed-0.3.f90 @ 334

!> \file taubed-0.3.f90
!! Calcul la charge en chaque point de la grille puis appel la routine litho pour calculer la contribution 
!! de chaque point a la deflexion de la lithosphere    
!<

!> SUBROUTINE: taubed()
!! \author ...
!! \date  16 Novembre 1999
!! @note  Routine qui calcul la charge en chaque point de la grille
!! puis appel la routine litho pour calculer la contribution 
!! de chaque point a la deflexion de la lithosphere    
!! @note En entree
!!        - H, 
!!        - BSOC, 
!!        - SEALEVEL, 
!!        - RO, 
!!        - ROW
!! @note En sortie
!!        - CHARGE(1-LBLOC:NX+LBLOC,1-LBLOC:NY+LBLOC) : poids par unite de surface
!!               (unite ?)   Elle est calculee initialement dans initial2
!!               Poids de la colonne d'eau ou de la colonne de glace.
!!               a l'exterieur du domaine : 1-LBLOC:1 et NX+1:NX+LBLOC
!!               on donne les valeurs des bords de la grille
!!               CHARGE est utilise par litho uniquement
!!        - W1(NX,NY) est l'enfoncement courant, c'est le resultat 
!!               de la routine litho
!!               W1 peut etre calcule de plusieurs facons selon le modele 
!!               d'isostasie utilise
!! @note Used module:
!! @note   - use module3D_phy
!! @note   - use param_phy_mod
!! @note   - use ISO_DECLAR
!!
!<

!!     ****************************************************************
!!     *           BEDROCK ADJUSTMENT avec temps de reaction          *
!!     *  changement de nom B -> Bsoc                                 * 
!!     ****************************************************************



subroutine taubed()

  !$USE OMP_LIB 
  USE module3D_phy
  USE param_phy_mod
  USE ISO_DECLAR ! module de declaration des variables de l'isostasie

  implicit none

  !    ********* calcul de W1 l'enfoncement d'equilibre au temps t
  ! NLITH est defini dans isostasie et permet le choix du modele d'isostasie

  
  if (NLITH.eq.1) then
     !       avec rigidite de la lithosphere
     !$OMP PARALLEL
     !$OMP DO
     do J=1,NY 
        do I=1,NX
           if (RO*H(I,J).ge.-ROW*(BSOC(I,J)-SEALEVEL_2D(i,j))) then
              !           glace ou terre 
              CHARGE(I,J)=ROG*H(I,J)
           else
              !           ocean
              CHARGE(I,J)=-ROWG*(BSOC(I,J)-SEALEVEL_2D(i,j))
           endif
        end do
     end do
     !$OMP END DO

     ! il faut remplir CHARGE dans les parties a l'exterieur de la grille :
     ! a l'exterieur de la grille CHARGE est egale a la valeur sur le bord
     !$OMP DO
     do J=1,NY
        CHARGE(1-LBLOC:0,J)=CHARGE(1,J)      ! bord W
        CHARGE(NX+1:NX+LBLOC,J)=CHARGE(NX,J) ! bord E
     end do
     !$OMP END DO
     !$OMP DO
     do I=1,NX
        CHARGE(I,1-LBLOC:0)=CHARGE(I,1)      ! bord S
        CHARGE(I,NY+1:NY+LBLOC)=CHARGE(I,NY) ! bord N
     end do
     !$OMP END DO

     ! valeur dans les quatres coins exterieurs au domaine       
          !$OMP WORKSHARE
     CHARGE(1-LBLOC:0,1-LBLOC:0)=CHARGE(1,1)           ! coin SW
     CHARGE(1-LBLOC:0,NY+1:NY+LBLOC)=CHARGE(1,NY)      ! coin NW
     CHARGE(NX+1:NX+LBLOC,1-LBLOC:0)=CHARGE(NX,1)      ! coin SE
     CHARGE(NX+1:NX+LBLOC,NY+1:NY+LBLOC)=CHARGE(NX,NY) ! coin NE
     !$OMP END WORKSHARE
     !$OMP END PARALLEL 
     call litho

  else
     !     enfoncement local
     !$OMP PARALLEL
     !$OMP DO
     do J=1,NY
        do I=1,NX
           if (RO*H(I,J).ge.-ROW*(BSOC(I,J)-SEALEVEL_2D(i,j))) then
              !           glace ou terre 
              W1(I,J)=RO/ROM*H(I,J)
           else
              !           ocean
              W1(I,J)=-ROW/ROM*(BSOC(I,J)-SEALEVEL_2D(i,j))
           endif
        end do
     end do
     !$OMP END DO
     !$OMP END PARALLEL
  endif

  !     decroissance exponentielle de l'enfoncement
  !$OMP PARALLEL
  !$OMP DO
  do J=1,NY
     do I=1,NX
        BDOT(I,J)=((Bsoc0(I,J)-BSOC(I,J))-(W1(I,J)-W0(I,J)))/TAUSOC
        BSOC(I,J)=BSOC(I,J)+BDOT(I,J)*DT_ISO
     end do
  end do
  !$OMP END DO
  !$OMP END PARALLEL

end subroutine taubed