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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 54 - (hide 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 guez 54 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