source: LMDZ5/branches/testing/libf/phylmd/albedo.F90 @ 1999

Last change on this file since 1999 was 1999, checked in by Laurent Fairhead, 10 years ago

Merged trunk changes r1920:1997 into testing branch

  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 5.5 KB
Line 
1
2! $Id: albedo.F90 1999 2014-03-20 09:57:19Z fairhead $
3
4
5
6SUBROUTINE alboc(rjour, rlat, albedo)
7  USE dimphy
8  IMPLICIT NONE
9  ! ======================================================================
10  ! Auteur(s): Z.X. Li (LMD/CNRS) (adaptation du GCM du LMD)
11  ! Date: le 16 mars 1995
12  ! Objet: Calculer l'albedo sur l'ocean
13  ! Methode: Integrer numeriquement l'albedo pendant une journee
14
15  ! Arguments;
16  ! rjour (in,R)  : jour dans l'annee (a compter du 1 janvier)
17  ! rlat (in,R)   : latitude en degre
18  ! albedo (out,R): albedo obtenu (de 0 a 1)
19  ! ======================================================================
20  ! ym#include "dimensions.h"
21  ! ym#include "dimphy.h"
22  include "YOMCST.h"
23  include "clesphys.h"
24
25  ! fmagic -> clesphys.h/.inc
26  ! REAL fmagic ! un facteur magique pour regler l'albedo
27  ! cc      PARAMETER (fmagic=0.7)
28  ! ccIM => a remplacer
29  ! PARAMETER (fmagic=1.32)
30  ! PARAMETER (fmagic=1.0)
31  ! PARAMETER (fmagic=0.7)
32  INTEGER npts ! il controle la precision de l'integration
33  PARAMETER (npts=120) ! 120 correspond a l'interval 6 minutes
34
35  REAL rlat(klon), rjour, albedo(klon)
36  REAL zdist, zlonsun, zpi, zdeclin
37  REAL rmu, alb, srmu, salb, fauxo, aa, bb
38  INTEGER i, k
39  ! ccIM
40  LOGICAL ancien_albedo
41  PARAMETER (ancien_albedo=.FALSE.)
42  ! SAVE albedo
43
44  IF (ancien_albedo) THEN
45
46    zpi = 4.*atan(1.)
47
48    ! Calculer la longitude vraie de l'orbite terrestre:
49    CALL orbite(rjour, zlonsun, zdist)
50
51    ! Calculer la declinaison du soleil (qui varie entre + et - R_incl):
52    zdeclin = asin(sin(zlonsun*zpi/180.0)*sin(r_incl*zpi/180.0))
53
54    DO i = 1, klon
55      aa = sin(rlat(i)*zpi/180.0)*sin(zdeclin)
56      bb = cos(rlat(i)*zpi/180.0)*cos(zdeclin)
57
58      ! Midi local (angle du temps = 0.0):
59      rmu = aa + bb*cos(0.0)
60      rmu = max(0.0, rmu)
61      fauxo = (1.47-acos(rmu))/.15
62      alb = 0.03 + 0.630/(1.+fauxo*fauxo)
63      srmu = rmu
64      salb = alb*rmu
65
66      ! Faire l'integration numerique de midi a minuit (le facteur 2
67      ! prend en compte l'autre moitie de la journee):
68      DO k = 1, npts
69        rmu = aa + bb*cos(real(k)/real(npts)*zpi)
70        rmu = max(0.0, rmu)
71        fauxo = (1.47-acos(rmu))/.15
72        alb = 0.03 + 0.630/(1.+fauxo*fauxo)
73        srmu = srmu + rmu*2.0
74        salb = salb + alb*rmu*2.0
75      END DO
76      IF (srmu/=0.0) THEN
77        albedo(i) = salb/srmu*fmagic + pmagic
78      ELSE ! nuit polaire (on peut prendre une valeur quelconque)
79        albedo(i) = fmagic
80      END IF
81    END DO
82
83    ! nouvel albedo
84
85  ELSE
86
87    zpi = 4.*atan(1.)
88
89    ! Calculer la longitude vraie de l'orbite terrestre:
90    CALL orbite(rjour, zlonsun, zdist)
91
92    ! Calculer la declinaison du soleil (qui varie entre + et - R_incl):
93    zdeclin = asin(sin(zlonsun*zpi/180.0)*sin(r_incl*zpi/180.0))
94
95    DO i = 1, klon
96      aa = sin(rlat(i)*zpi/180.0)*sin(zdeclin)
97      bb = cos(rlat(i)*zpi/180.0)*cos(zdeclin)
98
99      ! Midi local (angle du temps = 0.0):
100      rmu = aa + bb*cos(0.0)
101      rmu = max(0.0, rmu)
102      ! IM cf. PB  alb = 0.058/(rmu + 0.30)
103      ! alb = 0.058/(rmu + 0.30) * 1.5
104      alb = 0.058/(rmu+0.30)*1.2
105      ! alb = 0.058/(rmu + 0.30) * 1.3
106      srmu = rmu
107      salb = alb*rmu
108
109      ! Faire l'integration numerique de midi a minuit (le facteur 2
110      ! prend en compte l'autre moitie de la journee):
111      DO k = 1, npts
112        rmu = aa + bb*cos(real(k)/real(npts)*zpi)
113        rmu = max(0.0, rmu)
114        ! IM cf. PB      alb = 0.058/(rmu + 0.30)
115        ! alb = 0.058/(rmu + 0.30) * 1.5
116        alb = 0.058/(rmu+0.30)*1.2
117        ! alb = 0.058/(rmu + 0.30) * 1.3
118        srmu = srmu + rmu*2.0
119        salb = salb + alb*rmu*2.0
120      END DO
121      IF (srmu/=0.0) THEN
122        albedo(i) = salb/srmu*fmagic + pmagic
123      ELSE ! nuit polaire (on peut prendre une valeur quelconque)
124        albedo(i) = fmagic
125      END IF
126    END DO
127  END IF
128  RETURN
129END SUBROUTINE alboc
130! =====================================================================
131SUBROUTINE alboc_cd(rmu0, albedo)
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  ! ym#include "dimensions.h"
147  ! ym#include "dimphy.h"
148  include "clesphys.h"
149  REAL rmu0(klon), albedo(klon)
150
151  ! REAL fmagic ! un facteur magique pour regler l'albedo
152  ! cc      PARAMETER (fmagic=0.7)
153  ! ccIM => a remplacer
154  ! PARAMETER (fmagic=1.32)
155  ! PARAMETER (fmagic=1.0)
156  ! PARAMETER (fmagic=0.7)
157
158  REAL fauxo
159  INTEGER i
160  ! ccIM
161  LOGICAL ancien_albedo
162  PARAMETER (ancien_albedo=.FALSE.)
163  ! SAVE albedo
164
165  IF (ancien_albedo) THEN
166
167    DO i = 1, klon
168
169      rmu0(i) = max(rmu0(i), 0.0)
170
171      fauxo = (1.47-acos(rmu0(i)))/0.15
172      albedo(i) = fmagic*(.03+.630/(1.+fauxo*fauxo)) + pmagic
173      albedo(i) = max(min(albedo(i),0.60), 0.04)
174    END DO
175
176    ! nouvel albedo
177
178  ELSE
179
180    DO i = 1, klon
181      rmu0(i) = max(rmu0(i), 0.0)
182      ! IM:orig albedo(i) = 0.058/(rmu0(i) + 0.30)
183      albedo(i) = fmagic*0.058/(rmu0(i)+0.30) + pmagic
184      albedo(i) = max(min(albedo(i),0.60), 0.04)
185    END DO
186
187  END IF
188
189  RETURN
190END SUBROUTINE alboc_cd
191! ========================================================================
Note: See TracBrowser for help on using the repository browser.