source: LMDZ.3.3/branches/rel-LF/libf/phylmd/albedo.F @ 406

Last change on this file since 406 was 406, checked in by lmdzadmin, 22 years ago

Albedo ECHAM3 (SB)
IM/LF

  • Property svn:eol-style set to native
  • Property svn:executable set to *
  • Property svn:keywords set to Author Date Id Revision
File size: 5.8 KB
Line 
1      SUBROUTINE alboc(rjour,rlat,albedo)
2      IMPLICIT none
3c======================================================================
4c Auteur(s): Z.X. Li (LMD/CNRS) (adaptation du GCM du LMD)
5c Date: le 16 mars 1995
6c Objet: Calculer l'albedo sur l'ocean
7c Methode: Integrer numeriquement l'albedo pendant une journee
8c
9c Arguments;
10c rjour (in,R)  : jour dans l'annee (a compter du 1 janvier)
11c rlat (in,R)   : latitude en degre
12c albedo (out,R): albedo obtenu (de 0 a 1)
13c======================================================================
14#include "dimensions.h"
15#include "dimphy.h"
16#include "YOMCST.h"
17c
18      REAL fmagic ! un facteur magique pour regler l'albedo
19ccc      PARAMETER (fmagic=0.7)
20cccIM => a remplacer 
21cccIM   PARAMETER (fmagic=1.1)
22c       PARAMETER (fmagic=1.0)
23        PARAMETER (fmagic=0.7)
24      INTEGER npts ! il controle la precision de l'integration
25      PARAMETER (npts=120) ! 120 correspond a l'interval 6 minutes
26c
27      REAL rlat(klon), rjour, albedo(klon)
28      REAL zdist, zlonsun, zpi, zdeclin
29      REAL rmu,alb, srmu, salb, fauxo, aa, bb
30      INTEGER i, k
31cccIM
32      LOGICAL ancien_albedo
33      PARAMETER(ancien_albedo=.FALSE.)
34c     SAVE albedo
35c
36      IF ( ancien_albedo ) THEN
37c
38      zpi = 4. * ATAN(1.)
39c
40c Calculer la longitude vraie de l'orbite terrestre:
41      CALL orbite(rjour,zlonsun,zdist)
42c
43c Calculer la declinaison du soleil (qui varie entre + et - R_incl):
44      zdeclin = ASIN(SIN(zlonsun*zpi/180.0)*SIN(R_incl*zpi/180.0))
45c
46      DO 999 i=1,klon
47      aa = SIN(rlat(i)*zpi/180.0) * SIN(zdeclin)
48      bb = COS(rlat(i)*zpi/180.0) * COS(zdeclin)
49c
50c Midi local (angle du temps = 0.0):
51      rmu = aa + bb * COS(0.0)
52      rmu = MAX(0.0, rmu)
53      fauxo = (1.47-ACOS(rmu))/.15
54      alb = 0.03+0.630/(1.+fauxo*fauxo)
55      srmu = rmu
56      salb = alb * rmu
57c
58c Faire l'integration numerique de midi a minuit (le facteur 2
59c prend en compte l'autre moitie de la journee):
60      DO k = 1, npts
61         rmu = aa + bb * COS(FLOAT(k)/FLOAT(npts)*zpi)
62         rmu = MAX(0.0, rmu)
63         fauxo = (1.47-ACOS(rmu))/.15
64         alb = 0.03+0.630/(1.+fauxo*fauxo)
65         srmu = srmu + rmu * 2.0
66         salb = salb + alb*rmu * 2.0
67      ENDDO
68      IF (srmu .NE. 0.0) THEN
69         albedo(i) = salb / srmu * fmagic
70      ELSE ! nuit polaire (on peut prendre une valeur quelconque)
71         albedo(i) = fmagic
72      ENDIF
73  999 CONTINUE
74c
75c nouvel albedo
76c
77      ELSE
78c
79      zpi = 4. * ATAN(1.)
80c
81c Calculer la longitude vraie de l'orbite terrestre:
82      CALL orbite(rjour,zlonsun,zdist)
83c
84c Calculer la declinaison du soleil (qui varie entre + et - R_incl):
85      zdeclin = ASIN(SIN(zlonsun*zpi/180.0)*SIN(R_incl*zpi/180.0))
86c
87      DO 1999 i=1,klon
88      aa = SIN(rlat(i)*zpi/180.0) * SIN(zdeclin)
89      bb = COS(rlat(i)*zpi/180.0) * COS(zdeclin)
90c
91c Midi local (angle du temps = 0.0):
92      rmu = aa + bb * COS(0.0)
93      rmu = MAX(0.0, rmu)
94      alb = 0.058/(rmu + 0.30)
95      srmu = rmu
96      salb = alb * rmu
97c
98c Faire l'integration numerique de midi a minuit (le facteur 2
99c prend en compte l'autre moitie de la journee):
100      DO k = 1, npts
101         rmu = aa + bb * COS(FLOAT(k)/FLOAT(npts)*zpi)
102         rmu = MAX(0.0, rmu)
103         alb = 0.058/(rmu + 0.30)
104         srmu = srmu + rmu * 2.0
105         salb = salb + alb*rmu * 2.0
106      ENDDO
107      IF (srmu .NE. 0.0) THEN
108         albedo(i) = salb / srmu * fmagic
109      ELSE ! nuit polaire (on peut prendre une valeur quelconque)
110         albedo(i) = fmagic
111      ENDIF
1121999  CONTINUE
113      ENDIF
114      RETURN
115      END
116c=====================================================================
117      SUBROUTINE alboc_cd(rmu0,albedo)
118      IMPLICIT none
119c======================================================================
120c Auteur(s): Z.X. Li (LMD/CNRS)
121c date: 19940624
122c Calculer l'albedo sur l'ocean en fonction de l'angle zenithal moyen
123c Formule due a Larson and Barkstrom (1977) Proc. of the symposium
124C on radiation in the atmosphere, 19-28 August 1976, science Press,
125C 1977 pp 451-453, ou These de 3eme cycle de Sylvie Joussaume.
126c
127c Arguments
128c rmu0    (in): cosinus de l'angle solaire zenithal
129c albedo (out): albedo de surface de l'ocean
130c======================================================================
131#include "dimensions.h"
132#include "dimphy.h"
133      REAL rmu0(klon), albedo(klon)
134c
135      REAL fmagic ! un facteur magique pour regler l'albedo
136ccc      PARAMETER (fmagic=0.7)
137cccIM => a remplacer 
138cccIM   PARAMETER (fmagic=1.1)
139c       PARAMETER (fmagic=1.0)
140        PARAMETER (fmagic=0.7)
141c
142      REAL fauxo
143      INTEGER i
144cccIM
145      LOGICAL ancien_albedo
146      PARAMETER(ancien_albedo=.FALSE.)
147c     SAVE albedo
148c
149      IF ( ancien_albedo ) THEN
150c
151      DO i = 1, klon
152c
153         rmu0(i) = MAX(rmu0(i),0.0)
154c
155         fauxo = ( 1.47 - ACOS( rmu0(i) ) )/0.15
156         albedo(i) = fmagic*( .03 + .630/( 1. + fauxo*fauxo))
157         albedo(i) = MAX(MIN(albedo(i),0.60),0.04)
158      ENDDO
159c
160c nouvel albedo
161c
162      ELSE
163c
164      DO i = 1, klon
165         rmu0(i) = MAX(rmu0(i),0.0)
166         albedo(i) = 0.058/(rmu0(i) + 0.30)
167         albedo(i) = MAX(MIN(albedo(i),0.60),0.04)
168      ENDDO
169c
170      ENDIF
171c
172      RETURN
173      END
174c========================================================================
175      SUBROUTINE albsno(veget, agesno, alb_neig)
176      IMPLICIT none
177c
178#include "dimensions.h"
179#include "dimphy.h"
180      INTEGER nvm
181      PARAMETER (nvm=8)
182      REAL veget(klon,nvm)
183      REAL alb_neig(klon)
184      REAL agesno(klon)
185c
186      INTEGER i, nv
187c
188      REAL init(nvm), decay(nvm), as
189      SAVE init, decay
190      DATA init /0.55, 0.14, 0.18, 0.29, 0.15, 0.15, 0.14, 0./
191      DATA decay/0.30, 0.67, 0.63, 0.45, 0.40, 0.14, 0.06, 1./
192c
193      DO i = 1, klon
194         alb_neig(i) = 0.0
195      ENDDO
196      DO nv = 1, nvm
197         DO i = 1, klon
198            as = init(nv)+decay(nv)*EXP(-agesno(i)/5.)
199            alb_neig(i) = alb_neig(i) + veget(i,nv)*as
200         ENDDO
201      ENDDO
202c
203      RETURN
204      END
Note: See TracBrowser for help on using the repository browser.