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

Diff of /trunk/Sources/phylmd/Interface_surf/alboc.f

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 207 by guez, Tue Jul 7 17:49:23 2015 UTC revision 208 by guez, Wed Dec 7 16:44:53 2016 UTC
# Line 4  module alboc_m Line 4  module alboc_m
4    
5  contains  contains
6    
7    SUBROUTINE alboc(jour, rlat, albedo)    pure function alboc(jour, rlat)
8    
9      ! From LMDZ4/libf/phylmd/albedo.F, version 1.2 2005/02/07 15:00:52      ! From LMDZ4/libf/phylmd/albedo.F, version 1.2, 2005/02/07 15:00:52
10    
11      ! Author: Z. X. Li (LMD/CNRS) (adaptation du GCM du LMD)      ! Author: Z. X. Li (LMD/CNRS)
12      ! Date : 16 mars 1995      ! Date : 16 mars 1995
13      ! Objet : Calculer l'alb\'edo sur l'oc\'ean      ! Objet : Calculer l'alb\'edo sur l'oc\'ean
14      ! M\'ethode: int\'egrer num\'eriquement l'alb\'edo pendant une journ\'ee      ! M\'ethode: int\'egrer num\'eriquement l'alb\'edo pendant une journ\'ee
# Line 19  contains Line 19  contains
19    
20      integer, intent(in):: jour ! jour dans l'annee (a compter du 1 janvier)      integer, intent(in):: jour ! jour dans l'annee (a compter du 1 janvier)
21      REAL, intent(in):: rlat(:) ! latitude en degre      REAL, intent(in):: rlat(:) ! latitude en degre
22      real, intent(out):: albedo(:) ! albedo obtenu (de 0 a 1)      real alboc(size(rlat)) ! albedo obtenu (de 0 a 1)
23    
24      ! Local:      ! Local:
25    
     REAL, PARAMETER:: fmagic=1. ! un facteur magique pour regler l'albedo  
   
26      INTEGER, PARAMETER:: npts =120      INTEGER, PARAMETER:: npts =120
27      ! Contr\^ole la pr\'ecision de l'int\'egration. 120 correspond \`a      ! Contr\^ole la pr\'ecision de l'int\'egration. 120 correspond \`a
28      ! l'intervalle 6 minutes.      ! l'intervalle 6 minutes.
29    
30      REAL zdist, zlonsun, zdeclin      REAL lonsun, declin
31      REAL rmu, alb, srmu, salb, aa, bb      REAL rmu, srmu, salb, aa, bb
32      INTEGER i, k      INTEGER i, k
33    
34      !----------------------------------------------------------------------      !----------------------------------------------------------------------
35    
36      ! Calculer la longitude vraie de l'orbite terrestre:      ! Calculer la longitude vraie de l'orbite terrestre:
37      CALL orbite(real(jour), zlonsun, zdist)      CALL orbite(real(jour), lonsun)
38    
39      ! Calculer la declinaison du soleil (qui varie entre + et - R_incl):      ! Calculer la declinaison du soleil (qui varie entre + R_incl et - R_incl) :
40      zdeclin = asin(sin(zlonsun*pi/180.0)*sin(r_incl*pi/180.0))      declin = asin(sin(lonsun * pi / 180.) * sin(r_incl * pi / 180.))
41    
42      DO i = 1, size(rlat)      DO i = 1, size(rlat)
43         aa = sin(rlat(i)*pi/180.0)*sin(zdeclin)         aa = sin(rlat(i) * pi / 180.) * sin(declin)
44         bb = cos(rlat(i)*pi/180.0)*cos(zdeclin)         bb = cos(rlat(i) * pi / 180.) * cos(declin)
45    
46         ! Midi local (angle du temps = 0.0):         ! Midi local (angle du temps = 0.):
47         rmu = aa + bb*cos(0.0)         rmu = max(0., aa + bb)
        rmu = max(0.0, rmu)  
        alb = 0.058/(rmu+0.30)*1.2  
48         srmu = rmu         srmu = rmu
49         salb = alb*rmu         salb = 0.058 / (rmu + 0.30) * 1.2 * rmu
50    
51         ! Faire l'integration numerique de midi a minuit (le facteur 2         ! Faire l'integration numerique de midi a minuit (le facteur 2
52         ! prend en compte l'autre moitie de la journee):         ! prend en compte l'autre moitie de la journee):
53         DO k = 1, npts         DO k = 1, npts
54            rmu = aa + bb*cos(float(k)/float(npts)*pi)            rmu = max(0., aa + bb * cos(real(k) / real(npts) * pi))
55            rmu = max(0.0, rmu)            srmu = srmu + rmu * 2.
56            alb = 0.058/(rmu+0.30)*1.2            salb = salb + 0.058 / (rmu + 0.30) * 1.2 * rmu * 2.
           srmu = srmu + rmu*2.0  
           salb = salb + alb*rmu*2.0  
57         END DO         END DO
58         IF (srmu/=0.0) THEN         IF (srmu /= 0.) THEN
59            albedo(i) = salb/srmu*fmagic            alboc(i) = salb / srmu
60         ELSE ! nuit polaire (on peut prendre une valeur quelconque)         ELSE
61            albedo(i) = fmagic            ! nuit polaire (on peut prendre une valeur quelconque)
62              alboc(i) = 1.
63         END IF         END IF
64      END DO      END DO
65    
66    END SUBROUTINE alboc    END function alboc
67    
68  end module alboc_m  end module alboc_m
Legend:
Removed from v.207  
changed lines
  Added in v.208
  ViewVC Help
Powered by ViewVC 1.1.21