source: LMDZ5/trunk/libf/phylmd/albedo.F90 @ 2214

Last change on this file since 2214 was 1992, checked in by lguez, 11 years ago

Converted to free source form files in libf/phylmd 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).

-- replaced #include by include.

  • 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 1992 2014-03-05 13:19:12Z oboucher $
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.