/[lmdze]/trunk/phylmd/alboc.f
ViewVC logotype

Contents of /trunk/phylmd/alboc.f

Parent Directory Parent Directory | Revision Log Revision Log


Revision 81 - (show annotations)
Wed Mar 5 14:38:41 2014 UTC (10 years, 2 months ago) by guez
Original Path: trunk/phylmd/albedo.f90
File size: 5505 byte(s)
 Converted to free source form files which were still in fixed source
form. The conversion was done using the polish mode of the NAG Fortran
Compiler.

In addition to converting to free source form, the processing of the
files also:

-- indented the code (including comments);

-- set Fortran keywords to uppercase, and set all other identifiers
to lower case;

-- added qualifiers to end statements (for example "end subroutine
conflx", instead of "end");

-- changed the terminating statements of all DO loops so that each
loop ends with an ENDDO statement (instead of a labeled continue).

1
2 ! $Header: /home/cvsroot/LMDZ4/libf/phylmd/albedo.F,v 1.2 2005/02/07 15:00:52
3 ! fairhead Exp $
4
5
6
7 SUBROUTINE alboc(rjour, rlat, albedo)
8 USE dimens_m
9 USE dimphy
10 USE yomcst
11 USE orbite_m, ONLY: orbite
12 IMPLICIT NONE
13 ! ======================================================================
14 ! Auteur(s): Z.X. Li (LMD/CNRS) (adaptation du GCM du LMD)
15 ! Date: le 16 mars 1995
16 ! Objet: Calculer l'albedo sur l'ocean
17 ! Methode: Integrer numeriquement l'albedo pendant une journee
18
19 ! Arguments;
20 ! rjour (in,R) : jour dans l'annee (a compter du 1 janvier)
21 ! rlat (in,R) : latitude en degre
22 ! albedo (out,R): albedo obtenu (de 0 a 1)
23 ! ======================================================================
24
25 REAL fmagic ! un facteur magique pour regler l'albedo
26 ! cc PARAMETER (fmagic=0.7)
27 ! ccIM => a remplacer
28 ! PARAMETER (fmagic=1.32)
29 PARAMETER (fmagic=1.0)
30 ! PARAMETER (fmagic=0.7)
31 INTEGER npts ! il controle la precision de l'integration
32 PARAMETER (npts=120) ! 120 correspond a l'interval 6 minutes
33
34 REAL rlat(klon), rjour, albedo(klon)
35 REAL zdist, zlonsun, zpi, zdeclin
36 REAL rmu, alb, srmu, salb, fauxo, aa, bb
37 INTEGER i, k
38 ! ccIM
39 LOGICAL ancien_albedo
40 PARAMETER (ancien_albedo=.FALSE.)
41 ! SAVE albedo
42
43 IF (ancien_albedo) THEN
44
45 zpi = 4.*atan(1.)
46
47 ! Calculer la longitude vraie de l'orbite terrestre:
48 CALL orbite(rjour, zlonsun, zdist)
49
50 ! Calculer la declinaison du soleil (qui varie entre + et - R_incl):
51 zdeclin = asin(sin(zlonsun*zpi/180.0)*sin(r_incl*zpi/180.0))
52
53 DO i = 1, klon
54 aa = sin(rlat(i)*zpi/180.0)*sin(zdeclin)
55 bb = cos(rlat(i)*zpi/180.0)*cos(zdeclin)
56
57 ! Midi local (angle du temps = 0.0):
58 rmu = aa + bb*cos(0.0)
59 rmu = max(0.0, rmu)
60 fauxo = (1.47-acos(rmu))/.15
61 alb = 0.03 + 0.630/(1.+fauxo*fauxo)
62 srmu = rmu
63 salb = alb*rmu
64
65 ! Faire l'integration numerique de midi a minuit (le facteur 2
66 ! prend en compte l'autre moitie de la journee):
67 DO k = 1, npts
68 rmu = aa + bb*cos(float(k)/float(npts)*zpi)
69 rmu = max(0.0, rmu)
70 fauxo = (1.47-acos(rmu))/.15
71 alb = 0.03 + 0.630/(1.+fauxo*fauxo)
72 srmu = srmu + rmu*2.0
73 salb = salb + alb*rmu*2.0
74 END DO
75 IF (srmu/=0.0) THEN
76 albedo(i) = salb/srmu*fmagic
77 ELSE ! nuit polaire (on peut prendre une valeur quelconque)
78 albedo(i) = fmagic
79 END IF
80 END DO
81
82 ! nouvel albedo
83
84 ELSE
85
86 zpi = 4.*atan(1.)
87
88 ! Calculer la longitude vraie de l'orbite terrestre:
89 CALL orbite(rjour, zlonsun, zdist)
90
91 ! Calculer la declinaison du soleil (qui varie entre + et - R_incl):
92 zdeclin = asin(sin(zlonsun*zpi/180.0)*sin(r_incl*zpi/180.0))
93
94 DO i = 1, klon
95 aa = sin(rlat(i)*zpi/180.0)*sin(zdeclin)
96 bb = cos(rlat(i)*zpi/180.0)*cos(zdeclin)
97
98 ! Midi local (angle du temps = 0.0):
99 rmu = aa + bb*cos(0.0)
100 rmu = max(0.0, rmu)
101 ! IM cf. PB alb = 0.058/(rmu + 0.30)
102 ! alb = 0.058/(rmu + 0.30) * 1.5
103 alb = 0.058/(rmu+0.30)*1.2
104 ! alb = 0.058/(rmu + 0.30) * 1.3
105 srmu = rmu
106 salb = alb*rmu
107
108 ! Faire l'integration numerique de midi a minuit (le facteur 2
109 ! prend en compte l'autre moitie de la journee):
110 DO k = 1, npts
111 rmu = aa + bb*cos(float(k)/float(npts)*zpi)
112 rmu = max(0.0, rmu)
113 ! IM cf. PB alb = 0.058/(rmu + 0.30)
114 ! alb = 0.058/(rmu + 0.30) * 1.5
115 alb = 0.058/(rmu+0.30)*1.2
116 ! alb = 0.058/(rmu + 0.30) * 1.3
117 srmu = srmu + rmu*2.0
118 salb = salb + alb*rmu*2.0
119 END DO
120 IF (srmu/=0.0) THEN
121 albedo(i) = salb/srmu*fmagic
122 ELSE ! nuit polaire (on peut prendre une valeur quelconque)
123 albedo(i) = fmagic
124 END IF
125 END DO
126 END IF
127 RETURN
128 END SUBROUTINE alboc
129 ! =====================================================================
130 SUBROUTINE alboc_cd(rmu0, albedo)
131 USE dimens_m
132 USE dimphy
133 IMPLICIT NONE
134 ! ======================================================================
135 ! Auteur(s): Z.X. Li (LMD/CNRS)
136 ! date: 19940624
137 ! Calculer l'albedo sur l'ocean en fonction de l'angle zenithal moyen
138 ! Formule due a Larson and Barkstrom (1977) Proc. of the symposium
139 ! on radiation in the atmosphere, 19-28 August 1976, science Press,
140 ! 1977 pp 451-453, ou These de 3eme cycle de Sylvie Joussaume.
141
142 ! Arguments
143 ! rmu0 (in): cosinus de l'angle solaire zenithal
144 ! albedo (out): albedo de surface de l'ocean
145 ! ======================================================================
146 REAL rmu0(klon), albedo(klon)
147
148 REAL fmagic ! un facteur magique pour regler l'albedo
149 ! cc PARAMETER (fmagic=0.7)
150 ! ccIM => a remplacer
151 ! PARAMETER (fmagic=1.32)
152 PARAMETER (fmagic=1.0)
153 ! PARAMETER (fmagic=0.7)
154
155 REAL fauxo
156 INTEGER i
157 ! ccIM
158 LOGICAL ancien_albedo
159 PARAMETER (ancien_albedo=.FALSE.)
160 ! SAVE albedo
161
162 IF (ancien_albedo) THEN
163
164 DO i = 1, klon
165
166 rmu0(i) = max(rmu0(i), 0.0)
167
168 fauxo = (1.47-acos(rmu0(i)))/0.15
169 albedo(i) = fmagic*(.03+.630/(1.+fauxo*fauxo))
170 albedo(i) = max(min(albedo(i),0.60), 0.04)
171 END DO
172
173 ! nouvel albedo
174
175 ELSE
176
177 DO i = 1, klon
178 rmu0(i) = max(rmu0(i), 0.0)
179 ! IM:orig albedo(i) = 0.058/(rmu0(i) + 0.30)
180 albedo(i) = fmagic*0.058/(rmu0(i)+0.30)
181 albedo(i) = max(min(albedo(i),0.60), 0.04)
182 END DO
183
184 END IF
185
186 RETURN
187 END SUBROUTINE alboc_cd
188 ! ========================================================================

  ViewVC Help
Powered by ViewVC 1.1.21