Ignore:
Timestamp:
Dec 14, 2015, 11:43:09 AM (9 years ago)
Author:
Laurent Fairhead
Message:

Merged trunk changes r2298:2396 into testing branch

Location:
LMDZ5/branches/testing
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • LMDZ5/branches/testing

  • LMDZ5/branches/testing/libf/phylmd/albedo.F90

    r1999 r2408  
     1! $Id$
     2module albedo
    13
    2 ! $Id$
     4  IMPLICIT NONE
    35
     6contains
    47
     8  SUBROUTINE alboc(rjour, rlat, albedo)
     9    USE dimphy
     10    ! ======================================================================
     11    ! Auteur(s): Z.X. Li (LMD/CNRS) (adaptation du GCM du LMD)
     12    ! Date: le 16 mars 1995
     13    ! Objet: Calculer l'albedo sur l'ocean
     14    ! Methode: Integrer numeriquement l'albedo pendant une journee
    515
    6 SUBROUTINE 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
     16    ! Arguments;
     17    ! rjour (in,R)  : jour dans l'annee (a compter du 1 janvier)
     18    ! rlat (in,R)   : latitude en degre
     19    ! albedo (out,R): albedo obtenu (de 0 a 1)
     20    ! ======================================================================
     21    include "YOMCST.h"
     22    include "clesphys.h"
    1423
    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    ! fmagic -> clesphys.h/.inc
     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
    2433
    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    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
    3442
    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    IF (ancien_albedo) THEN
    4344
    44   IF (ancien_albedo) THEN
     45       zpi = 4.*atan(1.)
    4546
    46     zpi = 4.*atan(1.)
     47       ! Calculer la longitude vraie de l'orbite terrestre:
     48       CALL orbite(rjour, zlonsun, zdist)
    4749
    48     ! Calculer la longitude vraie de l'orbite terrestre:
    49     CALL orbite(rjour, zlonsun, zdist)
     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))
    5052
    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       DO i = 1, klon
     54          aa = sin(rlat(i)*zpi/180.0)*sin(zdeclin)
     55          bb = cos(rlat(i)*zpi/180.0)*cos(zdeclin)
    5356
    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          ! 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
    5764
    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          ! 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(real(k)/real(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 + pmagic
     77          ELSE ! nuit polaire (on peut prendre une valeur quelconque)
     78             albedo(i) = fmagic
     79          END IF
     80       END DO
    6581
    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       ! nouvel albedo
    8283
    83     ! nouvel albedo
     84    ELSE
    8485
    85   ELSE
     86       zpi = 4.*atan(1.)
    8687
    87     zpi = 4.*atan(1.)
     88       ! Calculer la longitude vraie de l'orbite terrestre:
     89       CALL orbite(rjour, zlonsun, zdist)
    8890
    89     ! Calculer la longitude vraie de l'orbite terrestre:
    90     CALL orbite(rjour, zlonsun, zdist)
     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))
    9193
    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       DO i = 1, klon
     95          aa = sin(rlat(i)*zpi/180.0)*sin(zdeclin)
     96          bb = cos(rlat(i)*zpi/180.0)*cos(zdeclin)
    9497
    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          ! 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
    98107
    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          ! 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(real(k)/real(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 + pmagic
     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 dimphy
    108132
    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
    129 END SUBROUTINE alboc
    130 ! =====================================================================
    131 SUBROUTINE 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.
     133    ! Auteur(s): Z.X. Li (LMD/CNRS)
     134    ! date: 19940624
     135    ! Calculer l'albedo sur l'ocean en fonction de l'angle zenithal moyen
     136    ! Formule due a Larson and Barkstrom (1977) Proc. of the symposium
     137    ! on radiation in the atmosphere, 19-28 August 1976, science Press,
     138    ! 1977 pp 451-453, ou These de 3eme cycle de Sylvie Joussaume.
    141139
    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)
     140    ! Arguments
     141    ! rmu0    (in): cosinus de l'angle solaire zenithal
     142    ! albedo (out): albedo de surface de l'ocean
     143    ! ======================================================================
     144    include "clesphys.h"
     145    REAL, intent(in):: rmu0(klon)
     146    real, intent(out):: albedo(klon)
    150147
    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)
     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)
    157154
    158   REAL fauxo
    159   INTEGER i
    160   ! ccIM
    161   LOGICAL ancien_albedo
    162   PARAMETER (ancien_albedo=.FALSE.)
    163   ! SAVE albedo
     155    REAL fauxo
     156    INTEGER i
     157    LOGICAL ancien_albedo
     158    PARAMETER (ancien_albedo=.FALSE.)
    164159
    165   IF (ancien_albedo) THEN
     160    IF (ancien_albedo) THEN
     161       DO i = 1, klon
     162          fauxo = (1.47-acos(max(rmu0(i), 0.0)))/0.15
     163          albedo(i) = fmagic*(.03+.630/(1.+fauxo*fauxo)) + pmagic
     164          albedo(i) = max(min(albedo(i),0.60), 0.04)
     165       END DO
     166    ELSE
     167       DO i = 1, klon
     168          albedo(i) = fmagic*0.058/(max(rmu0(i), 0.0)+0.30) + pmagic
     169          albedo(i) = max(min(albedo(i),0.60), 0.04)
     170       END DO
     171    END IF
    166172
    167     DO i = 1, klon
     173  END SUBROUTINE alboc_cd
    168174
    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
    190 END SUBROUTINE alboc_cd
    191 ! ========================================================================
     175end module albedo
Note: See TracChangeset for help on using the changeset viewer.