/[lmdze]/trunk/libf/phylmd/Interface_surf/interfoce_slab.f90
ViewVC logotype

Contents of /trunk/libf/phylmd/Interface_surf/interfoce_slab.f90

Parent Directory Parent Directory | Revision Log Revision Log


Revision 54 - (show annotations)
Tue Dec 6 15:07:04 2011 UTC (12 years, 6 months ago) by guez
File size: 6751 byte(s)
Removed Numerical Recipes procedure "ran1". Replaced calls to "ran1"
in "inidissip" by calls to intrinsic procedures.

Split file "interface_surf.f90" into a file with a module containing
only variables, "interface_surf", and single-procedure files. Gathered
files into directory "Interface_surf".

Added argument "cdivu" to "gradiv" and "gradiv2", "cdivh" to
"divgrad2" and "divgrad", and "crot" to "nxgraro2" and
"nxgrarot". "dissip" now uses variables "cdivu", "cdivh" and "crot"
from module "inidissip_m", so it can pass them to "gradiv2",
etc. Thanks to this modification, we avoid a circular dependency
betwwen "inidissip.f90" and "gradiv2.f90", etc. The value -1. used by
"gradiv2", for instance, during computation of eigenvalues is not the
value "cdivu" computed by "inidissip".

Extracted procedure "start_inter_3d" from module "startdyn", to its
own module.

In "inidissip", unrolled loop on "ii". I find it clearer now.

Moved variables "matriceun", "matriceus", "matricevn", "matricevs",
"matrinvn" and "matrinvs" from module "parafilt" to module
"inifilr_m". Moved variables "jfiltnu", "jfiltnv", "jfiltsu",
"jfiltsv" from module "coefils" to module "inifilr_m".

1 module interfoce_slab_m
2
3 implicit none
4
5 contains
6
7 SUBROUTINE interfoce_slab(klon, debut, itap, dtime, ijour, &
8 radsol, fluxo, fluxg, pctsrf, &
9 tslab, seaice, pctsrf_slab)
10
11 ! Cette routine calcule la temperature d'un slab ocean, la glace de mer
12 ! et les pourcentages de la maille couverte par l'ocean libre et/ou
13 ! la glace de mer pour un "slab" ocean de 50m
14
15 ! I. Musat 04.02.2005
16
17 ! input:
18 ! klon nombre total de points de grille
19 ! debut logical: 1er appel a la physique
20 ! itap numero du pas de temps
21 ! dtime pas de temps de la physique (en s)
22 ! ijour jour dans l'annee en cours
23 ! radsol rayonnement net au sol (LW + SW)
24 ! fluxo flux turbulent (sensible + latent) sur les mailles oceaniques
25 ! fluxg flux de conduction entre la surface de la glace de mer et l'ocean
26 ! pctsrf tableau des pourcentages de surface de chaque maille
27 ! output:
28 ! tslab temperature de l'ocean libre
29 ! seaice glace de mer (kg/m2)
30 ! pctsrf_slab "pourcentages" (valeurs entre 0. et 1.) surfaces issus du slab
31
32 use indicesol
33 use clesphys
34 use abort_gcm_m, only: abort_gcm
35 use SUPHEC_M
36
37 ! Parametres d'entree
38 integer, intent(IN) :: klon
39 logical, intent(IN) :: debut
40 INTEGER, intent(IN) :: itap
41 REAL, intent(IN) :: dtime
42 INTEGER, intent(IN) :: ijour
43 REAL, dimension(klon), intent(IN) :: radsol
44 REAL, dimension(klon), intent(IN) :: fluxo
45 REAL, dimension(klon), intent(IN) :: fluxg
46 real, dimension(klon, nbsrf), intent(IN) :: pctsrf
47 ! Parametres de sortie
48 real, dimension(klon), intent(INOUT) :: tslab
49 real, dimension(klon), intent(INOUT) :: seaice ! glace de mer (kg/m2)
50 real, dimension(klon, nbsrf), intent(OUT) :: pctsrf_slab
51
52 ! Variables locales :
53 INTEGER, save :: lmt_pas, julien, idayvrai
54 REAL, parameter :: unjour=86400.
55 real, allocatable, dimension(:), save :: tmp_tslab, tmp_seaice
56 REAL, allocatable, dimension(:), save :: slab_bils
57 REAL, allocatable, dimension(:), save :: lmt_bils
58 logical, save :: check = .false.
59
60 REAL, parameter :: cyang=50.0 * 4.228e+06 ! capacite calorifique volumetrique de l'eau J/(m2 K)
61 REAL, parameter :: cbing=0.334e+05 ! J/kg
62 real, dimension(klon) :: siceh !hauteur de la glace de mer (m)
63 INTEGER :: i
64 integer :: sum_error, error
65 REAL :: zz, za, zb
66
67 character (len = 80) :: abort_message
68 character (len = 20) :: modname = 'interfoce_slab'
69
70 julien = MOD(ijour, 360)
71 sum_error = 0
72 IF (debut) THEN
73 allocate(slab_bils(klon), stat = error)
74 sum_error = sum_error + error
75 allocate(lmt_bils(klon), stat = error)
76 sum_error = sum_error + error
77 allocate(tmp_tslab(klon), stat = error)
78 sum_error = sum_error + error
79 allocate(tmp_seaice(klon), stat = error)
80 sum_error = sum_error + error
81 if (sum_error /= 0) then
82 abort_message='Pb allocation var. slab_bils, lmt_bils, tmp_tslab, tmp_seaice'
83 call abort_gcm(modname, abort_message, 1)
84 endif
85 tmp_tslab=tslab
86 tmp_seaice=seaice
87 lmt_pas = nint(86400./dtime * 1.0) ! pour une lecture une fois par jour
88
89 IF (check) THEN
90 PRINT*, 'interfoce_slab klon, debut, itap, dtime, ijour, &
91 & lmt_pas ', klon, debut, itap, dtime, ijour, &
92 lmt_pas
93 ENDIF !check
94
95 PRINT*, '************************'
96 PRINT*, 'SLAB OCEAN est actif, prenez precautions !'
97 PRINT*, '************************'
98
99 ! a mettre un slab_bils aussi en force !!!
100
101 DO i = 1, klon
102 slab_bils(i) = 0.0
103 ENDDO
104
105 ENDIF !debut
106 pctsrf_slab(1:klon, 1:nbsrf) = pctsrf(1:klon, 1:nbsrf)
107
108 ! lecture du bilan au sol lmt_bils issu d'une simulation forcee en debut de journee
109
110 IF (MOD(itap, lmt_pas) .EQ. 1) THEN !1er pas de temps de la journee
111 idayvrai = ijour
112 CALL condsurf(julien, idayvrai, lmt_bils)
113 ENDIF !(MOD(itap-1, lmt_pas) .EQ. 0) THEN
114
115 DO i = 1, klon
116 IF((pctsrf_slab(i, is_oce).GT.epsfra).OR. &
117 (pctsrf_slab(i, is_sic).GT.epsfra)) THEN
118
119 ! fabriquer de la glace si congelation atteinte:
120
121 IF (tmp_tslab(i).LT.(RTT-1.8)) THEN
122 zz = (RTT-1.8)-tmp_tslab(i)
123 tmp_seaice(i) = tmp_seaice(i) + cyang/cbing * zz
124 seaice(i) = tmp_seaice(i)
125 tmp_tslab(i) = RTT-1.8
126 ENDIF
127
128 ! faire fondre de la glace si temperature est superieure a 0:
129
130 IF ((tmp_tslab(i).GT.RTT) .AND. (tmp_seaice(i).GT.0.0)) THEN
131 zz = cyang/cbing * (tmp_tslab(i)-RTT)
132 zz = MIN(zz, tmp_seaice(i))
133 tmp_seaice(i) = tmp_seaice(i) - zz
134 seaice(i) = tmp_seaice(i)
135 tmp_tslab(i) = tmp_tslab(i) - zz*cbing/cyang
136 ENDIF
137
138 ! limiter la glace de mer a 10 metres (10000 kg/m2)
139
140 IF(tmp_seaice(i).GT.45.) THEN
141 tmp_seaice(i) = MIN(tmp_seaice(i), 10000.0)
142 ELSE
143 tmp_seaice(i) = 0.
144 ENDIF
145 seaice(i) = tmp_seaice(i)
146 siceh(i)=tmp_seaice(i)/1000. !en metres
147
148 ! determiner la nature du sol (glace de mer ou ocean libre):
149
150 ! on fait dependre la fraction de seaice "pctsrf(i, is_sic)"
151 ! de l'epaisseur de seaice :
152 ! pctsrf(i, is_sic)=1. si l'epaisseur de la glace de mer est >= a 20cm
153 ! et pctsrf(i, is_sic) croit lineairement avec seaice de 0. a 20cm d'epaisseur
154
155 pctsrf_slab(i, is_sic)=MIN(siceh(i)/0.20, &
156 1.-(pctsrf_slab(i, is_ter)+pctsrf_slab(i, is_lic)))
157 pctsrf_slab(i, is_oce)=1.0 - &
158 (pctsrf_slab(i, is_ter)+pctsrf_slab(i, is_lic)+pctsrf_slab(i, is_sic))
159 ENDIF !pctsrf
160 ENDDO
161
162 ! Calculer le bilan du flux de chaleur au sol :
163
164 DO i = 1, klon
165 za = radsol(i) + fluxo(i)
166 zb = fluxg(i)
167 IF((pctsrf_slab(i, is_oce).GT.epsfra).OR. &
168 (pctsrf_slab(i, is_sic).GT.epsfra)) THEN
169 slab_bils(i)=slab_bils(i)+(za*pctsrf_slab(i, is_oce) &
170 +zb*pctsrf_slab(i, is_sic))/ FLOAT(lmt_pas)
171 ENDIF
172 ENDDO !klon
173
174 ! calcul tslab
175
176 IF (MOD(itap, lmt_pas).EQ.0) THEN !fin de journee
177 DO i = 1, klon
178 IF ((pctsrf_slab(i, is_oce).GT.epsfra).OR. &
179 (pctsrf_slab(i, is_sic).GT.epsfra)) THEN
180 tmp_tslab(i) = tmp_tslab(i) + &
181 (slab_bils(i)-lmt_bils(i)) &
182 /cyang*unjour
183 ! on remet l'accumulation a 0
184 slab_bils(i) = 0.
185 ENDIF !pctsrf
186 ENDDO !klon
187 ENDIF !(MOD(itap, lmt_pas).EQ.0) THEN
188
189 tslab = tmp_tslab
190 seaice = tmp_seaice
191 END SUBROUTINE interfoce_slab
192
193 end module interfoce_slab_m

  ViewVC Help
Powered by ViewVC 1.1.21