| [2077] | 1 | ! |
|---|
| 2 | ! $Header$ |
|---|
| 3 | ! |
|---|
| 4 | MODULE icefrac_lsc_mod |
|---|
| 5 | |
|---|
| [2109] | 6 | IMPLICIT NONE |
|---|
| 7 | |
|---|
| [2077] | 8 | CONTAINS |
|---|
| 9 | !******************************************************************* |
|---|
| 10 | |
|---|
| [2109] | 11 | SUBROUTINE icefrac_lsc(np,temp, sig, icefrac) |
|---|
| [2077] | 12 | ! |
|---|
| 13 | ! Compute the ice fraction 1-xliq (see e.g. |
|---|
| 14 | ! Doutriaux-Boucher & Quaas 2004, section 2.2.) |
|---|
| 15 | ! |
|---|
| [2542] | 16 | ! (JBM 3/14 8/14 5/16) |
|---|
| [2109] | 17 | |
|---|
| [2542] | 18 | USE print_control_mod, ONLY: lunout, prt_level |
|---|
| [2109] | 19 | INCLUDE "nuage.h" |
|---|
| 20 | |
|---|
| 21 | ! nuage.h contains: |
|---|
| 22 | ! t_glace_min: if T < Tmin, the cloud is only made of water ice |
|---|
| 23 | ! t_glace_max: if T > Tmax, the cloud is only made of liquid water |
|---|
| 24 | ! exposant_glace: controls the sharpness of the transition |
|---|
| [2077] | 25 | INTEGER :: np |
|---|
| 26 | REAL, DIMENSION(np), INTENT(IN) :: temp ! temperature |
|---|
| 27 | REAL, DIMENSION(np), INTENT(IN) :: sig |
|---|
| 28 | REAL, DIMENSION(np), INTENT(OUT) :: icefrac |
|---|
| 29 | |
|---|
| 30 | REAL :: sig0,www,tmin_tmp,icefrac_tmp |
|---|
| 31 | INTEGER :: ip |
|---|
| 32 | |
|---|
| 33 | sig0=0.8 |
|---|
| 34 | |
|---|
| 35 | DO ip=1,np |
|---|
| [2542] | 36 | IF (iflag_t_glace.EQ.1) THEN |
|---|
| 37 | ! Transition to ice close to surface for T<Tmax |
|---|
| 38 | ! w=1 at the surface and 0 for sig < sig0 |
|---|
| 39 | www=(max(sig(ip)-sig0,0.))/(1.-sig0) |
|---|
| 40 | ELSEIF (iflag_t_glace.GE.2) THEN |
|---|
| 41 | ! No convertion to ice close to surface |
|---|
| 42 | www = 0. |
|---|
| 43 | ENDIF |
|---|
| [2109] | 44 | tmin_tmp=www*t_glace_max+(1.-www)*t_glace_min |
|---|
| 45 | icefrac_tmp= 1.0 - (temp(ip)-tmin_tmp) / (t_glace_max-tmin_tmp) |
|---|
| [2077] | 46 | icefrac_tmp = MIN(MAX(icefrac_tmp,0.0),1.0) |
|---|
| [2109] | 47 | icefrac(ip) = icefrac_tmp**exposant_glace |
|---|
| [2077] | 48 | ENDDO |
|---|
| 49 | |
|---|
| 50 | RETURN |
|---|
| 51 | END SUBROUTINE icefrac_lsc |
|---|
| 52 | |
|---|
| 53 | !******************************************************************* |
|---|
| 54 | ! |
|---|
| 55 | END MODULE icefrac_lsc_mod |
|---|