1 | SUBROUTINE shine(tfsn, tfsg, ts, tsn, hgbq, hnbq, alb_c, alb_o) |
---|
2 | !-----------------------------------------------------------------------------! |
---|
3 | ! |
---|
4 | ! Computes albedo of snow-sea ice following SHINE & |
---|
5 | ! HENDERSSON-SELLERS [1985]. |
---|
6 | ! Simplified by Martouf for use in LIM1D |
---|
7 | ! fucking scientists!!! |
---|
8 | ! |
---|
9 | INCLUDE 'type.com' |
---|
10 | |
---|
11 | ! OUTPUTS : |
---|
12 | ! alb_c : Albedo for clear sky. |
---|
13 | ! alb_o : Albedo for overcast sky. |
---|
14 | ! |
---|
15 | !-----------------------------------------------------------------------------! |
---|
16 | ! 1) Computation of surface albedo. ! |
---|
17 | !-----------------------------------------------------------------------------! |
---|
18 | ! |
---|
19 | WRITE(84,*) ' ' |
---|
20 | WRITE(84,*) ' shine ' |
---|
21 | WRITE(84,*) ' ~~~~~~' |
---|
22 | |
---|
23 | cgren = 0.06 ! corr factor under cloudy skies (Grenfell Perovich 84) |
---|
24 | alphd = 0.80 ! fixed boundary values of albedo |
---|
25 | alphdi = 0.72 |
---|
26 | alphs = 0.65 |
---|
27 | albice = 0.53 ! albedo of melting ice |
---|
28 | ! |
---|
29 | if (hnbq.gt.0.0) then |
---|
30 | !------------------ |
---|
31 | ! Snow covered-ice |
---|
32 | !------------------ |
---|
33 | if ( (ts.lt.tfsn) .AND. (tsn.lt.tfsn) ) THEN |
---|
34 | |
---|
35 | ! Cold snow. |
---|
36 | !------------ |
---|
37 | if (hnbq.gt.0.05) then |
---|
38 | alb_c = alphd |
---|
39 | else |
---|
40 | if (hgbq.gt.1.5) then |
---|
41 | alb_c = alphdi+(hnbq*(alphd-alphdi)/0.05) |
---|
42 | else if (hgbq.gt.1.0.and.hgbq.le.1.5) then |
---|
43 | al = 0.472+2.0*(alphdi-0.472)*(hgbq-1.0) |
---|
44 | else if (hgbq.gt.0.05.and.hgbq.le.1.0) then |
---|
45 | al = 0.2467+(0.7049*hgbq)-(0.8608*(hgbq*hgbq))+ |
---|
46 | & (0.3812*(hgbq*hgbq*hgbq)) |
---|
47 | else |
---|
48 | & al = 0.1+3.6*hgbq |
---|
49 | endif |
---|
50 | if (hgbq.le.1.5) alb_c=al+(hnbq*(alphd-al)/0.05) |
---|
51 | endif |
---|
52 | else |
---|
53 | ! Melting snow. |
---|
54 | !-------------- |
---|
55 | if (hnbq.ge.0.1) then |
---|
56 | alb_c = 0.65 |
---|
57 | alb_c = alphs |
---|
58 | else |
---|
59 | alb_c = albice+((alphs-albice)/0.1)*hnbq |
---|
60 | endif |
---|
61 | endif |
---|
62 | else |
---|
63 | !---------- |
---|
64 | ! Bare ice |
---|
65 | !---------- |
---|
66 | if (ts.lt.tfsg) then |
---|
67 | |
---|
68 | ! Cold ice |
---|
69 | !----------- |
---|
70 | if (hgbq.gt.1.5) then |
---|
71 | alb_c = alphdi |
---|
72 | else if (hgbq.gt.1..and.hgbq.le.1.5) then |
---|
73 | alb_c = 0.472+2.*(alphdi-0.472)*(hgbq-1.) |
---|
74 | else if (hgbq.gt.0.05.and.hgbq.le.1.) then |
---|
75 | alb_c = 0.2467+ |
---|
76 | & (0.7049*hgbq)-(0.8608*(hgbq*hgbq))+ |
---|
77 | & (0.3812*(hgbq*hgbq*hgbq)) |
---|
78 | else |
---|
79 | alb_c = 0.1+3.6*hgbq |
---|
80 | endif |
---|
81 | else |
---|
82 | ! Melting ice. |
---|
83 | !-------------- |
---|
84 | if (hgbq.gt.1.5) then |
---|
85 | alb_c = albice |
---|
86 | else if (hgbq.gt.1..and.hgbq.le.1.5) then |
---|
87 | alb_c = 0.472+(2.*(albice-0.472)*(hgbq-1.)) |
---|
88 | else if (hgbq.gt.0.05.and.hgbq.le.1.) then |
---|
89 | alb_c = 0.2467+0.7049*hgbq |
---|
90 | & -(0.8608*(hgbq*hgbq)) |
---|
91 | & +(0.3812*(hgbq*hgbq*hgbq)) |
---|
92 | else |
---|
93 | alb_c = 0.1+3.6*hgbq |
---|
94 | endif |
---|
95 | endif |
---|
96 | endif |
---|
97 | |
---|
98 | !-------------------------- |
---|
99 | ! Correction due to clouds |
---|
100 | !-------------------------- |
---|
101 | alb_o= alb_c + cgren |
---|
102 | |
---|
103 | WRITE(84,*) ' alb_o: ', alb_o |
---|
104 | WRITE(84,*) ' alb_c: ', alb_c |
---|
105 | |
---|
106 | !------------------------------------------------------------------------------! |
---|
107 | !- Fin de la routine shine - |
---|
108 | RETURN |
---|
109 | END |
---|