The TELEMAC-MASCARET system  trunk
cvsp_init_from_layers.f
Go to the documentation of this file.
1 ! ********************************
2  SUBROUTINE cvsp_init_from_layers
3 ! ********************************
4 !
5 !
6 !***********************************************************************
7 ! SISYPHE V6P3 14/03/2013
8 !***********************************************************************
9 !
10 !brief INITS A VERTICAL SORTING PROFILE USING HIRANO LAYERS
11 !
12 !history UWE MERKEL
13 !+ 19/04/2012
14 !+ V6P2
15 !+
16 !
17 !history P. A. TASSI (EDF R&D, LNHE)
18 !+ 12/03/2013
19 !+ V6P3
20 !+ Cleaning, cosmetic
21 !
22 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
23 !| |---|
24 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
25 !
28 !
29  IMPLICIT NONE
30 !
31  INTEGER I, J, M, L
32  DOUBLE PRECISION DEPTH
33 !
34 !-----------------------------------------------------------------------
35 !
36  ALLOCATE(pro_d(npoin,pro_max_max,nsicla))
37  ALLOCATE(pro_f(npoin,pro_max_max,nsicla))
38  ALLOCATE(pro_max(npoin))
39 !
40 !-----------------------------------------------------------------------
41 !
42  DO j=1,npoin
43  depth = 0 ! INIT DEPTH OF THE VSP
44  pro_max(j) = 2* nlayer%I(j) ! 2 SECTION POINTS PER LAYER
45  l = pro_max(j)
46 !
47 !-----------------------------------------------------------------------
48 ! WATER / BOTTOM
49 !-----------------------------------------------------------------------
50 !
51  DO i=1,nsicla
52  pro_d(j,l,i) = zf%R(j)
53  pro_f(j,l,i) = avail(j,1,i)
54  ENDDO
55 !
56 !-----------------------------------------------------------------------
57 ! SECTIONS
58 !-----------------------------------------------------------------------
59 !
60  DO m=1,nlayer%I(j)-1 !FOR THE UPPER 8 LAYERS
61  depth = depth + es(j,m)
62  l = l - 1
63  DO i=1,nsicla
64  pro_d(j,l,i) = zf%R(j) - depth
65  pro_f(j,l,i) = avail(j,m,i)
66  ENDDO
67  l = l - 1
68  DO i=1,nsicla
69  pro_d(j,l,i) = zf%R(j) - depth
70  pro_f(j,l,i) = avail(j,m+1,i)
71  ENDDO
72  ENDDO
73 !
74 !-----------------------------------------------------------------------
75 ! BOTTOM / RIGID BED
76 !-----------------------------------------------------------------------
77 !
78  l = l - 1
79  DO i=1,nsicla
80  pro_d(j,l,i) = zr%R(j)
81  pro_f(j,l,i) = avail(j,nlayer%I(j),i)
82  ENDDO
83 !
84  CALL cvsp_compress_dp(j,1.d-5)
85 !
86  ENDDO
87 !
88 !-----------------------------------------------------------------------
89 !
90  RETURN
91  END SUBROUTINE cvsp_init_from_layers
type(bief_obj), target zr
double precision, dimension(:,:,:), allocatable, target pro_f
type(bief_obj), target nlayer
type(bief_obj), target zf
subroutine cvsp_init_from_layers
integer, dimension(:), allocatable pro_max
subroutine cvsp_compress_dp(J, THRESHOLD)
double precision, dimension(:,:,:), allocatable, target avail
double precision, dimension(:,:,:), allocatable, target pro_d
double precision, dimension(:,:), allocatable, target es