source: tags/LIM1D_v3.20/SOURCES/source_3.20/shine.f

Last change on this file was 6, checked in by vancop, 8 years ago

initial import of v3.20 /Users/ioulianikolskaia/Boulot/CODES/LIM1D/ARCHIVE/TMP/LIM1D_v3.20/
File size: 5.0 KB
Line 
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                                                               
Note: See TracBrowser for help on using the repository browser.