GCC Code Coverage Report
Directory: ./ Exec Total Coverage
File: phylmd/initrrnpb.F90 Lines: 37 37 100.0 %
Date: 2023-06-30 12:51:15 Branches: 8 10 80.0 %

Line Branch Exec Source
1
!
2
! $Id: initrrnpb.F90 2320 2015-07-01 13:57:32Z emillour $
3
!
4
1
SUBROUTINE  initrrnpb(ftsol,pctsrf,masktr,fshtr,hsoltr,tautr,vdeptr,scavtr)
5
  USE dimphy
6
  USE infotrac_phy, ONLY : nbtr
7
  USE traclmdz_mod, ONLY : id_rn, id_pb
8
  USE indice_sol_mod
9
  IMPLICIT NONE
10
!======================================================================
11
! Auteur(s): AA + CG (LGGE/CNRS) Date 24-06-94
12
! Objet: initialisation des constantes des traceurs
13
! id_rn : identificateur du traceur radon
14
! id_pb : identificateur du traceur plomb
15
!======================================================================
16
! Arguments:
17
! nbtr.............. nombre de vrais traceurs (sans l'eau)
18
! ftsol....input-R-  Temperature du sol (Kelvin)
19
! pctsrf...input-R-  Nature de sol (pourcentage de sol)
20
! masktr...output-R- Masque reservoir de sol traceur (1 = reservoir)
21
! fshtr....output-R- Flux surfacique de production dans le reservoir de sol
22
! hsoltr...output-R- Epaisseur equivalente du reservoir de sol
23
! tautr....output-R- Constante de decroissance radioactive du traceur
24
! vdeptr...output-R- Vitesse de depot sec dans la couche Brownienne
25
! scavtr...output-R- Coefficient de lessivage
26
!======================================================================
27
28
  REAL,DIMENSION(klon,nbsrf),INTENT(IN) :: pctsrf
29
  REAL,DIMENSION(klon,nbsrf),INTENT(IN) :: ftsol
30
  REAL,DIMENSION(klon,nbtr),INTENT(OUT) :: masktr
31
  REAL,DIMENSION(klon,nbtr),INTENT(OUT) :: fshtr
32
  REAL,DIMENSION(nbtr),INTENT(OUT)      :: hsoltr
33
  REAL,DIMENSION(nbtr),INTENT(OUT)      :: tautr
34
  REAL,DIMENSION(nbtr),INTENT(OUT)      :: vdeptr
35
  REAL,DIMENSION(nbtr),INTENT(OUT)      :: scavtr
36
  INTEGER                               :: i, it
37
  REAL                                  :: s
38
39
  CHARACTER (LEN=20) :: modname='initrrnpb'
40
  CHARACTER (LEN=80) :: abort_message
41
42
!
43
! Radon it = id_rn
44
!----------------
45
1
  IF (id_rn /= 0) THEN
46
1
     it = id_rn
47
1
     s = 1.E4             ! Source: atome par m2
48
1
     hsoltr(it) = 0.1     ! Hauteur equivalente du reservoir :
49
                          ! 1 m * porosite 0.1
50
1
     tautr(it) = 4.765E5  ! Decroissance du radon, secondes
51
1
     vdeptr(it) = 0.      ! Pas de depot sec pour le radon
52
1
     scavtr(it) = 0.      ! Pas de lessivage pour le radon
53
54
1
     WRITE(*,*)'-------------- SOURCE DU RADON ------------------------ '
55
1
     WRITE(*,*)'it = ',it
56
1
     WRITE(*,*)'Source : ', s
57
1
     WRITE(*,*)'Hauteur equivalente du reservoir de sol: ',hsoltr(it)
58
1
     WRITE(*,*)'Decroissance (s): ', tautr(it)
59
1
     WRITE(*,*)'Vitesse de depot sec: ',vdeptr(it)
60
1
     WRITE(*,*)'Facteur de lessivage: ',scavtr(it)
61
62
995
     DO i = 1,klon
63
994
        masktr(i,it) = 0.
64
994
        IF ( NINT(pctsrf(i,1)) .EQ. 1 ) masktr(i,it) = 1.
65
995
        fshtr(i,it) = s * masktr(i,it)
66
     END DO
67
68
  END IF ! id_rn /= 0
69
70
!
71
! 210Pb it = id_pb
72
!----------------
73
1
  IF (id_pb /= 0) THEN
74
1
     it = id_pb
75
1
     s = 0.                ! Pas de source
76
1
     hsoltr(it) = 10.      ! Hauteur equivalente du reservoir
77
                           ! a partir duquel le depot Brownien a lieu
78
1
     tautr(it) = 1.028E9   ! Decroissance du Pb210, secondes
79
1
     vdeptr(it) = 1.E-3    ! 1 mm/s pour le 210Pb
80
1
     scavtr(it) =  .5      ! Lessivage du Pb210
81
995
     DO i = 1,klon
82
994
        masktr(i,it) = 1.  ! Le depot sec peut avoir lieu partout
83
995
        fshtr(i,it) = s * masktr(i,it)
84
     END DO
85
1
     WRITE(*,*)'-------------- SOURCE DU PLOMB ------------------------ '
86
1
     WRITE(*,*)'it = ',it
87
1
     WRITE(*,*)'Source : ', s
88
1
     WRITE(*,*)'Hauteur equivalente du reservoir : ',hsoltr(it)
89
1
     WRITE(*,*)'Decroissance (s): ', tautr(it)
90
1
     WRITE(*,*)'Vitesse de depot sec: ',vdeptr(it)
91
1
     WRITE(*,*)'Facteur de lessivage: ',scavtr(it)
92
93
  END IF
94
95
1
END SUBROUTINE initrrnpb