source: LMDZ6/branches/Amaury_dev/libf/phylmd/ocean_albedo.F90 @ 5201

Last change on this file since 5201 was 5158, checked in by abarral, 7 weeks ago

Add missing klon on strataer_emiss_mod.F90
Correct various missing explicit declarations
Replace tabs by spaces (tabs are not part of the fortran charset)
Continue cleaning modules
Removed unused arguments and variables

File size: 10.1 KB
RevLine 
[5099]1
[2227]2! $Id$
3
[2677]4SUBROUTINE ocean_albedo(knon,zrmu0,knindex,pwind,SFRWL,alb_dir_new,alb_dif_new)
5!!
[2227]6!!****  *ALBEDO_RS14* 
7!!
8!!    PURPOSE
9!!    -------
[2677]10!!     computes the direct & diffuse albedo over open water
11!!     
[2227]12!!**  METHOD
13!!    ------
[2677]14!!
[2227]15!!    EXTERNAL
16!!    --------
17!!
18!!    IMPLICIT ARGUMENTS
19!!    ------------------
20!!     
21!!    REFERENCE
22!!    ---------
23!!     
24!!    AUTHOR
25!!    ------
[5158]26!!    R. Séférian           * Meteo-France *
[2227]27!!
28!!    MODIFICATIONS
29!!    -------------
30!!      Original    03/2014
[2677]31!!                  05/2014 R. Séférian & B. Decharme :: Adaptation to spectral
32!!                  computation for diffuse and direct albedo
33!!                  08/2014 S. Baek :: for wider wavelength range 200-4000nm and
34!!                  adaptation to LMDZ + whitecap effect by Koepke + chrolophyll
35!!                  map from climatology file
36!!                  10/2016 O. Boucher :: some optimisation following R.
37!!                  Seferian's work in the CNRM Model
38!!       
[2227]39!-------------------------------------------------------------------------------
[5099]40
[2227]41!*           DECLARATIONS
42!            ------------
[5099]43
[2227]44USE ocean_albedo_para
[2677]45USE dimphy
[5101]46USE phys_state_var_mod, ONLY: chl_con
[5137]47USE lmdz_clesphys
[5099]48
[2227]49IMPLICIT NONE
[5099]50
[2227]51!*      0.1    declarations of arguments
52!              -------------------------
[5099]53
[2677]54INTEGER, INTENT(IN) :: knon
55INTEGER, DIMENSION(klon), INTENT(IN) :: knindex
56REAL, DIMENSION(klon), INTENT(IN) :: zrmu0         !--cos(SZA) on full vector
57REAL, DIMENSION(klon), INTENT(IN) :: pwind         !--wind speed on compressed vector
58REAL, DIMENSION(6),INTENT(IN) :: SFRWL
59REAL, DIMENSION(klon,nsw), INTENT(OUT) :: alb_dir_new, alb_dif_new
[5099]60
[2227]61!*      0.2    declarations of local variables
62!              -------------------------
[5099]63
[2677]64REAL, DIMENSION(klon)           :: ZCHL        ! surface chlorophyll
65REAL, DIMENSION(klon)           :: ZCOSZEN     ! Cosine of the zenith solar angle
[5099]66
[2677]67INTEGER                         :: JWL, INU    ! indexes
[2709]68INTEGER                         :: JI
[2677]69REAL                            :: ZWL         ! input parameter: wavelength and diffuse/direct fraction of light
[2697]70REAL:: ZCHLABS, ZAW, ZBW, ZREFM, ZYLMD, ZUE, ZUE2 ! scalar computation variables
[5099]71
[2677]72REAL, DIMENSION(klon) :: ZAP, ZXX2, ZR00, ZRR0, ZRRR               ! computation variables
[2697]73REAL, DIMENSION(klon) :: ZR22, ZR11DF                              ! computation variables
[2677]74REAL, DIMENSION(klon) :: ZBBP, ZNU, ZHB                            ! computation variables
75REAL, DIMENSION(klon) :: ZR11, ZRW, ZRWDF, ZRDF                    ! 4 components of the OSA
76REAL, DIMENSION(klon) :: ZSIG, ZFWC, ZWORK1, ZWORK2, ZWORK3
[5099]77
[2677]78!--initialisations-------------
[2680]79
80IF (knon==0) RETURN ! A verifier pourquoi on en a besoin...
81
[2227]82alb_dir_new(:,:) = 0.
83alb_dif_new(:,:) = 0.
[5099]84
[2677]85! Initialisation of chlorophyll content
86! ZCHL(:) = CHL_CON!0.05 ! averaged global values for surface chlorophyll
87IF (ok_chlorophyll) THEN
88  ZCHL(1:knon)=CHL_CON(knindex(1:knon))
89ELSE
90  ZCHL(1:knon) = 0.05
91ENDIF
[2227]92
[2677]93! variables that do not depend on wavelengths
94! loop over the grid points
95! functions of chlorophyll content
96ZWORK1(1:knon)= EXP(LOG(ZCHL(1:knon))*0.65)
97ZWORK2(1:knon)= 0.416 * EXP(LOG(ZCHL(1:knon))*0.766)
98ZWORK3(1:knon)= LOG10(ZCHL(1:knon))
99! store the cosine of the solar zenith angle
100ZCOSZEN(1:knon) = zrmu0(knindex(1:knon))
101! Compute sigma derived from wind speed (Cox & Munk reflectance model)
102ZSIG(1:knon)=SQRT(0.003+0.00512*PWIND(1:knon))
103! original : correction for foam (Eq 16-17)
104! has to be update once we have information from wave model (discussion with G. Madec)
105ZFWC(1:knon)=3.97e-4*PWIND(1:knon)**1.59 ! Salisbury 2014 eq(2) at 37GHz, value in fraction
[5099]106
[2677]107DO JWL=1,NNWL           ! loop over the wavelengths
[5099]108
[2677]109  !---------------------------------------------------------------------------------
110  ! 0- Compute baseline values
111  !---------------------------------------------------------------------------------
[2227]112   
[2677]113  ! Get refractive index for the correspoding wavelength
114  ZWL=XAKWL(JWL)      !!!--------- wavelength value
115  ZREFM= XAKREFM(JWL) !!!--------- refraction index value
[2227]116 
[2677]117  !---------------------------------------------------------------------------------
118  ! 1- Compute direct surface albedo (ZR11)
119  !---------------------------------------------------------------------------------
[5099]120
[2677]121  ZXX2(1:knon)=SQRT(1.0-(1.0-ZCOSZEN(1:knon)**2)/ZREFM**2)
122  ZRR0(1:knon)=0.50*(((ZXX2(1:knon)-ZREFM*ZCOSZEN(1:knon))/(ZXX2(1:knon)+ZREFM*ZCOSZEN(1:knon)))**2 +  &
123               ((ZCOSZEN(1:knon)-ZREFM*ZXX2(1:knon))/(ZCOSZEN(1:knon)+ZREFM*ZXX2(1:knon)))**2)
124  ZRRR(1:knon)=0.50*(((ZXX2(1:knon)-1.34*ZCOSZEN(1:knon))/(ZXX2(1:knon)+1.34*ZCOSZEN(1:knon)))**2 + &
125               ((ZCOSZEN(1:knon)-1.34*ZXX2(1:knon))/(ZCOSZEN(1:knon)+1.34*ZXX2(1:knon)))**2)
126  ZR11(1:knon)=ZRR0(1:knon)-(0.0152-1.7873*ZCOSZEN(1:knon)+6.8972*ZCOSZEN(1:knon)**2-8.5778*ZCOSZEN(1:knon)**3+ &
127               4.071*ZSIG(1:knon)-7.6446*ZCOSZEN(1:knon)*ZSIG(1:knon)) *  &
128               EXP(0.1643-7.8409*ZCOSZEN(1:knon)-3.5639*ZCOSZEN(1:knon)**2-2.3588*ZSIG(1:knon)+ &
129               10.0538*ZCOSZEN(1:knon)*ZSIG(1:knon))*ZRR0(1:knon)/ZRRR(1:knon)
[5099]130
[2677]131  !---------------------------------------------------------------------------------
132  ! 2- Compute surface diffuse albedo (ZRDF)
133  !---------------------------------------------------------------------------------
134  ! Diffuse albedo from Jin et al., 2006 + estimation from diffuse fraction of
135  ! light (relying later on AOD). CNRM model has opted for Eq 5b
136  ZRDF(1:knon)=-0.1482-0.012*ZSIG(1:knon)+0.1609*ZREFM-0.0244*ZSIG(1:knon)*ZREFM ! surface diffuse (Eq 5a)
137  !!ZRDF(1:knon)=-0.1479+0.1502*ZREFM-0.0176*ZSIG(1:knon)*ZREFM   ! surface diffuse (Eq 5b)
138 
139  !---------------------------------------------------------------------------------
140  ! *- Determine absorption and backscattering
141  ! coefficients to determine reflectance below the surface (Ro) once for all
[5099]142
[2677]143  ! *.1- Absorption by chlorophyll
144  ZCHLABS= XAKACHL(JWL)
145  ! *.2- Absorption by seawater
146  ZAW= XAKAW3(JWL)
147  ! *.3- Backscattering by seawater
148  ZBW= XAKBW(JWL)
149  ! *.4- Backscattering by chlorophyll
150  ZYLMD = EXP(0.014*(440.0-ZWL))
151  ZAP(1:knon) = 0.06*ZCHLABS*ZWORK1(1:knon) +0.2*(XAW440+0.06*ZWORK1(1:knon))*ZYLMD
[2227]152   
[2709]153!!  WHERE ( ZCHL(1:knon) > 0.02 )
154!!    ZNU(:)=MIN(0.0,0.5*(ZWORK3(:)-0.3))
155!!    ZBBP(:)=(0.002+0.01*(0.5-0.25*ZWORK3(:))*(ZWL/550.)**ZNU(:))*ZWORK2(:)
156!!  ELSEWHERE
157!!    ZBBP(:)=0.019*(550./ZWL)*ZWORK2(:)       !ZBBPf=0.0113 at chl<=0.02
158!!  ENDWHERE
159
[5158]160    DO JI = 1, knon
[2709]161      IF (ZCHL(JI) > 0.02) THEN
162        ZNU(JI)=MIN(0.0,0.5*(ZWORK3(JI)-0.3))
163        ZBBP(JI)=(0.002+0.01*(0.5-0.25*ZWORK3(JI))*(ZWL/550.)**ZNU(JI)) &
164                  *ZWORK2(JI)
165      ELSE
166        ZBBP(JI)=0.019*(550./ZWL)*ZWORK2(JI)       !ZBBPf=0.0113 at chl<=0.02
167      ENDIF
168    ENDDO
169
[2677]170  ! Morel-Gentili(1991), Eq (12)
171  ! ZHB=h/(h+2*ZBBPf*(1.-h))       
172  ZHB(1:knon)=0.5*ZBW/(0.5*ZBW+ZBBP(1:knon))
[2227]173   
[2677]174  !---------------------------------------------------------------------------------
175  ! 3- Compute direct water-leaving albedo (ZRW)
176  !---------------------------------------------------------------------------------
177  ! Based on Morel & Gentilli 1991 parametrization
178  ZR22(1:knon)=0.48168549-0.014894708*ZSIG(1:knon)-0.20703885*ZSIG(1:knon)**2
[2227]179
[2677]180  ! Use Morel 91 formula to compute the direct reflectance
181  ! below the surface
182  ZR00(1:knon)=(0.5*ZBW+ZBBP(1:knon))/(ZAW+ZAP(1:knon)) *  &
183               (0.6279-0.2227*ZHB(1:knon)-0.0513*ZHB(1:knon)**2 + &
184               (-0.3119+0.2465*ZHB(1:knon))*ZCOSZEN(1:knon))
185  ZRW(1:knon)=ZR00(1:knon)*(1.-ZR22(1:knon))/(1.-ZR00(1:knon)*ZR22(1:knon))
186
187  !---------------------------------------------------------------------------------
188  ! 4- Compute diffuse water-leaving albedo (ZRWDF)
189  !---------------------------------------------------------------------------------
190  ! as previous water-leaving computation but assumes a uniform incidence of
191  ! shortwave at surface (ue)
192  ZUE=0.676               ! equivalent u_unif for diffuse incidence
193  ZUE2=SQRT(1.0-(1.0-ZUE**2)/ZREFM**2)
194  ZRR0(1:knon)=0.50*(((ZUE2-ZREFM*ZUE)/(ZUE2+ZREFM*ZUE))**2 +((ZUE-ZREFM*ZUE2)/(ZUE+ZREFM*ZUE2))**2)
195  ZRRR(1:knon)=0.50*(((ZUE2-1.34*ZUE)/(ZUE2+1.34*ZUE))**2 +((ZUE-1.34*ZUE2)/(ZUE+1.34*ZUE2))**2)
196  ZR11DF(1:knon)=ZRR0(1:knon)-(0.0152-1.7873*ZUE+6.8972*ZUE**2-8.5778*ZUE**3+4.071*ZSIG(1:knon)-7.6446*ZUE*ZSIG(1:knon)) * &
197                 EXP(0.1643-7.8409*ZUE-3.5639*ZUE**2-2.3588*ZSIG(1:knon)+10.0538*ZUE*ZSIG(1:knon))*ZRR0(1:knon)/ZRRR(1:knon)
198
199  ! Use Morel 91 formula to compute the diffuse
200  ! reflectance below the surface
[2740]201  ZR00(1:knon) = (0.5*ZBW+ZBBP(1:knon)) / (ZAW+ZAP(1:knon)) &
202       * (0.6279-0.2227*ZHB(1:knon)-0.0513*ZHB(1:knon)**2 &
203       + (-0.3119+0.2465*ZHB(1:knon))*ZUE)
[2677]204  ZRWDF(1:knon)=ZR00(1:knon)*(1.-ZR22(1:knon))*(1.-ZR11DF(1:knon))/(1.-ZR00(1:knon)*ZR22(1:knon))
[2227]205   
[2677]206  ! get waveband index inu for each nsw band
207  SELECT CASE(nsw)
208  CASE(2)
[5082]209    IF (JWL<=49) THEN       ! from 200  to 680 nm
[2677]210     inu=1
211    ELSE                      ! from 690  to 4000 nm
212     inu=2
213    ENDIF
214  CASE(4)
[5082]215    IF (JWL<=49) THEN       ! from 200  to 680 nm
[2677]216     inu=1
[5082]217    ELSE IF (JWL<=99) THEN  ! from 690  to 1180 nm
[2677]218     inu=2
[5082]219    ELSE IF (JWL<=218) THEN ! from 1190 to 2370 nm
[2677]220     inu=3
221    ELSE                      ! from 2380 to 4000 nm
222     inu=4
223    ENDIF
224  CASE(6)
[5082]225    IF (JWL<=5) THEN        ! from 200  to 240 nm
[2677]226     inu=1
[5082]227    ELSE IF (JWL<=24) THEN  ! from 250  to 430 nm
[2677]228     inu=2
[5082]229    ELSE IF (JWL<=49) THEN  ! from 440  to 680 nm
[2677]230     inu=3
[5082]231    ELSE IF (JWL<=99) THEN  ! from 690  to 1180 nm
[2677]232     inu=4
[5082]233    ELSE IF (JWL<=218) THEN ! from 1190 to 2370 nm
[2677]234     inu=5
235    ELSE                      ! from 2380 to 4000 nm
236     inu=6
237    ENDIF
238  END SELECT
[2227]239
[2677]240  ! partitionning direct and diffuse albedo
241  ! excluding diffuse albedo ZRW on ZDIR_ALB
[2227]242
[2677]243  !--direct
244  alb_dir_new(1:knon,inu)=alb_dir_new(1:knon,inu) + &
245                          ( XFRWL(JWL) * ((1.-ZFWC(1:knon)) * (ZR11(1:knon)+ZRW(1:knon))   + ZFWC(1:knon)*XRWC(JWL)) )/SFRWL(inu)
246  !--diffuse
247  alb_dif_new(1:knon,inu)=alb_dif_new(1:knon,inu) + &
248                          ( XFRWL(JWL) * ((1.-ZFWC(1:knon)) * (ZRDF(1:knon)+ZRWDF(1:knon)) + ZFWC(1:knon)*XRWC(JWL)) )/SFRWL(inu)
[2227]249
250ENDDO ! ending loop over wavelengths
251
[2677]252END SUBROUTINE ocean_albedo
Note: See TracBrowser for help on using the repository browser.