source: trunk/SOURCES/Temperature-routines/Old/temperature_column.f90 @ 154

Last change on this file since 154 was 4, checked in by dumas, 10 years ago

initial import GRISLI trunk
File size: 6.6 KB
Line 
1!> \file temperature_column.f90
2!!
3!! Implementation of functions and subroutines for vertical temperature calculation
4!!
5!<
6
7
8!///////////////////////////////////////////////////////////////////////
9!///////////////////////////////////////////////////////////////////////
10
11!> SUBROUTINE: Temp_column
12!!
13!! Vertical temperature calculation
14!!
15!! Used modules:
16!! - use Icetemp_declar
17!! - use Tridiagmod
18!! - use temperature_type
19!! - use autre_pr_temp_type
20!! - use step_temp_type
21!>
22
23Subroutine  Temp_column(Ii,Jj,Newtempcol_m,Ct_m,Flot_m,H_m,Tbmer_m,&
24     Temperature_m,Autre_pr_temp_m,step_temp_m)
25
26  Use Icetemp_declar
27  Use Tridiagmod
28  use temperature_type
29  use autre_pr_temp_type
30  use step_temp_type
31
32 
33  Implicit None
34  integer :: Ii,Jj
35  Real,Dimension(:,:,:),         Intent(Out) :: Newtempcol_m   !< Tableau 1d Vert. Des Temperatures En Sortie
36  Real,Dimension(:),         Intent(In) :: Ct_m            !< Tableau 1d Vert. Conductivite Thermique
37  Logical,                   Intent(In) :: Flot_m          !< Vrai Si Flot_mtant (Test D'Archimede) 'O'
38  Real,                      Intent(In) :: H_m             !< Ice Thickness  'O'
39  Real,                      Intent(In) :: Tbmer_m         !< Temperature De La Mer A La Base De L'Ice Shelf
40  type (Temperature), intent(inout) :: temperature_m 
41  type (Autre_pr_temp), intent(inout) :: Autre_pr_temp_m
42  type (step_temp),intent(in) :: step_temp_m
43
44
45  If (H_m.Gt.10.) Then
46
47     ! Conditions Aux Limites À La Base De La Glace
48     !________________________________________________
49
50     ! Base Froide
51     If ( ((Autre_pr_temp_m%Ibase(Ii,Jj).Eq.1).Or.(Autre_pr_temp_m%Ibase(Ii,Jj).Eq.4) &
52          .Or. ((Autre_pr_temp_m%Ibase(Ii,Jj).Eq.5).And.(Temperature_m%Temperature(Ii,Jj,Nz_m).Lt.Temperature_m%Temp_melting(Ii,Jj,Nz_m)))) &
53          .And..Not.Flot_m) Then
54
55        Autre_pr_temp_m%Ibase(Ii,Jj)=1
56        Bb(Nz_m)=1.
57
58        If (Ncond.Eq.1) Then ! Avec Socle
59           Dzi=H_m*De*Cm/Ct_m(Nz_m)
60           Aa(Nz_m)=-Dzm/(Dzm+Dzi)
61           Cc(Nz_m)=-Dzi/(Dzm+Dzi)
62           Rr(Nz_m)=H_m*De*Autre_pr_temp_m%Phid(Ii,Jj)*Dzm/Ct_m(Nz_m)/(Dzm+Dzi)
63        Else                 ! Sans Socle
64           Aa(Nz_m)=-1.
65           Cc(Nz_m)=0.
66           Rr(Nz_m)=-(Autre_pr_temp_m%Ghf(Ii,Jj)-Autre_pr_temp_m%Phid(Ii,Jj))/Ct_m(Nz_m)*H_m*De
67        Endif
68
69     Else
70
71        ! Base Temperee Ou Shelf
72        ! ----------------------               
73        If (Autre_pr_temp_m%Ibase(Ii,Jj).Eq.5)  Autre_pr_temp_m%Ibase(Ii,Jj)=2
74        Autre_pr_temp_m%Ibase(Ii,Jj)=Max(Autre_pr_temp_m%Ibase(Ii,Jj),2)
75        Aa(Nz_m)=0.
76        Bb(Nz_m)=1.
77        Cc(Nz_m)=0.
78
79        If (.Not.Flot_m) Then
80           Rr(Nz_m)=Temperature_m%Temp_melting(Ii,Jj,Nz_m)
81        Else
82           Rr(Nz_m)=Tbmer_m
83        End If
84
85     Endif
86
87
88     If (Ncond.Eq.1) Then ! Avec Socle
89        Do K=Nz_m+1,NzNzm_m-1
90           Rr(K)=Temperature_m%Temperature(Ii,Jj,K)
91        End Do
92        Call Tridiag (Aa,Bb,Cc,Rr,Hh,NzNzm_m,Ifail1)
93
94     Else                 ! Sans Socle
95
96        Call Tridiag (Aa,Bb,Cc,Rr,Hh,Nz_m,Ifail1)
97     Endif
98
99
100     ! Temperature Dans Le Socle Si Ncond=0, Lineaire Avec Le Gradient Ghf
101     If (Ncond.Eq.0) Then
102        Do K=Nz_m+1,NzNzm_m
103           Hh(K)=Hh(Nz_m)-Dzm*(K-Nz_m)*Autre_pr_temp_m%Ghf(Ii,Jj)/Cm
104        End Do
105     Endif
106
107     Do K=1,NzNzm_m
108        Newtempcol_m(Ii,Jj,K)=Hh(K)
109     End Do
110     Autre_pr_temp_m%Tbdot(Ii,Jj)=(Newtempcol_m(Ii,Jj,Nz_m)-Temperature_m%Temperature(Ii,Jj,Nz_m))/step_temp_m%Dtt
111
112     !      ------------------------------------------------- Glace Tres Fine (H<10m Ou H=0)
113  Else If (H_m.Le.10.) Then
114
115     !       Pour Eviter Des Problemes Lorsque H Est Inferieur A 10 M
116     !       Profil Lineaire, Pente=Flux Geothermique
117     !       Le Cas Sans Glace Est Traite De La Meme Facon  (Dou=0)
118
119     ! ........................................ Avec Calcul Dans Le Socle
120     If (Ncond.Eq.1.And..Not.Flot_m) Then   
121        If (H_m.Gt.0.) Then
122           ! Gradient Dans Le Socle
123           Dou=(Temperature_m%Temperature(Ii,Jj,Nz_m+1)-Temperature_m%Temperature(Ii,Jj,Nz_m))/Dzm*Cm     
124           Dou=Dou/Ct_m(Nz_m)*De*H_m
125
126           Tss=Min(0.,Autre_pr_temp_m%Ts(Ii,Jj))
127           Do K=1,Nz_m
128              Newtempcol_m(Ii,Jj,K)=Tss+Dou*(K-1.)
129           End Do
130
131        Else
132           ! Pas De Glace
133           Tss=Autre_pr_temp_m%Ts(Ii,Jj)
134           Do K=1,Nz_m
135              Newtempcol_m(Ii,Jj,K)=Tss
136           End Do
137        End If
138
139        ! Calcul Dans Le Socle Meme S'Il N'Y A Pas De Glace
140        Rr(Nz_m)=Newtempcol_m(Ii,Jj,Nz_m)
141        Aa(Nz_m)=0
142        Bb(Nz_m)=1
143        Cc(Nz_m)=0
144
145        Do K=Nz_m+1,NzNzm_m-1
146           Rr(K)=Temperature_m%Temperature(Ii,Jj,K)
147        End Do
148
149        ! Creation De Nouveaux Tableaux Juste Pour Tridiag     
150        Do K=1,Nzm_m+1
151           Abis(K)=Aa(Nz_m-1+K)
152           Bbis(K)=Bb(Nz_m-1+K)
153           Cbis(K)=Cc(Nz_m-1+K)
154           Rbis(K)=Rr(Nz_m-1+K)
155        End Do
156
157        Call Tridiag (Abis,Bbis,Cbis,Rbis,Hbis,Nzm_m+1,Ifail1)
158
159        Do K=1,Nzm_m+1
160           Hh(Nz_m-1+K)=Hbis(K)
161        End Do
162
163        ! ........................................ Sans Calcul Dans Le Socle
164     Else
165        ! Calotte Posee                   
166        If ((H_m.Gt.0.).And..Not.Flot_m) Then
167           Dou=-Autre_pr_temp_m%Ghf(Ii,Jj)/Ct_m(Nz_m)*De*H_m
168           Tss=Min(0.,Autre_pr_temp_m%Ts(Ii,Jj))
169           Do K=1,Nz_m
170              Newtempcol_m(Ii,Jj,K)=Tss+Dou*(K-1.)
171           End Do
172
173           !  Shelf
174        Else If ((H_m.Gt.0.).And.Flot_m) Then
175           Tss=Min(0.,Autre_pr_temp_m%Ts(Ii,Jj))
176           Dou=(Tbmer_m-Tss)*De
177           Do K=1,Nz_m
178              Newtempcol_m(Ii,Jj,K)=Tss+Dou*(K-1.)
179           End Do
180
181           ! Pas De Glace
182        Else
183           Tss=Autre_pr_temp_m%Ts(Ii,Jj)     
184           Do K=1,Nz_m
185              Newtempcol_m(Ii,Jj,K)=Tss
186           End Do
187        End If
188
189        ! Temperature Dans Le Socle, Lineaire Avec Le Gradient Ghf
190        If (.Not.Flot_m) Then
191           Do K=Nz_m+1,NzNzm_m
192              Hh(K)=Newtempcol_m(Ii,Jj,Nz_m)-Dzm*(K-Nz_m)*Autre_pr_temp_m%Ghf(Ii,Jj)/Cm
193           End Do
194        Else
195           Do K=Nz_m+1,NzNzm_m
196              Hh(K)=Tbmer_m-Dzm*(K-Nz_m)*Autre_pr_temp_m%Ghf(Ii,Jj)/Cm
197           End Do
198        End If
199
200     Endif
201     ! Fin Du Test Socle
202
203
204     Do K=Nz_m+1,NzNzm_m
205        Newtempcol_m(Ii,Jj,K)=Hh(K)
206     End Do
207
208     Autre_pr_temp_m%Tbdot(Ii,Jj)=(Newtempcol_m(Ii,Jj,Nz_m)-Temperature_m%Temperature(Ii,Jj,Nz_m))/step_temp_m%Dtt
209     Autre_pr_temp_m%Bmelt(Ii,Jj)=0.
210     Autre_pr_temp_m%Ibase(Ii,Jj)=5
211     Autre_pr_temp_m%Phid(Ii,Jj)=0.
212
213
214  End If
215
216End Subroutine Temp_column
217
218!///////////////////////////////////////////////////////////////////////
219!///////////////////////////////////////////////////////////////////////
Note: See TracBrowser for help on using the repository browser.