source: trunk/LMDZ.MARS/libf/phymars/geticecover.F90 @ 2156

Last change on this file since 2156 was 332, checked in by aslmd, 13 years ago

LMDZ.MARS and MESOSCALE: added evolutive CO2 seasonal caps according to Titus crocus lines

compiles fine. to be tested in mesoscale polar simulations.

27/10/11 == AS

--> Added geticecover.F90 which computes seasonal ice cover given ls, lati(ngrid), long(ngrid)

as proposed by T. Titus from TES observations [fitting functions for crocus line]
... output is icecover(ngrid) which value is 0 [no ice cover] or 1 [ice cover]
... no calculations are done for latitudes between -40 and +40 [ice cover is directly set to 0]

--> In physiq.F, co2ice is set to a dummy high value to simulate a CO2 cap

wherever icecover(ngrid) is 1. This is done at each timestep before newcondens is called.

--> For the moment this is MESOSCALE only, but potentially useful to everyone.

File size: 14.1 KB
Line 
1SUBROUTINE geticecover( ngrid, ls, lontab, lattab, icecover )
2  !!**********************************************!!
3  ! A. Spiga (aymeric.spiga@upmc.fr) October 2011  !
4  !!**********************************************!!
5  IMPLICIT NONE
6  !! INPUTS
7  REAL, DIMENSION(ngrid), INTENT(IN)  :: lontab,lattab
8  REAL,                   INTENT(IN)  :: ls
9  INTEGER,                INTENT(IN)  :: ngrid
10  !! OUTPUTS
11  REAL, DIMENSION(ngrid), INTENT(OUT) :: icecover
12  !! LOCAL
13  REAL :: isitice
14  INTEGER :: ig
15  icecover(:) = 0.
16  DO ig=1,ngrid
17    icecover(ig) = isitice( ls, lontab(ig), lattab(ig) )
18  ENDDO
19END SUBROUTINE geticecover
20
21REAL FUNCTION isitice( ls, lon, lat )
22  !!**********************************************!!
23  ! A. Spiga (aymeric.spiga@upmc.fr) October 2011  !
24  !!**********************************************!!
25  IMPLICIT NONE
26  REAL, INTENT(IN) :: ls,lon,lat
27  REAL :: nplatcrocus, splatcrocus
28  isitice = 0.
29  !! for speedup purposes:
30  !! useless to call functions for lats between -40. and 40.
31  IF (lat .le. -40.) THEN
32    IF ( lat .le. splatcrocus(ls,lon) ) isitice = 1.
33  ENDIF
34  IF (lat .ge. 40.) THEN
35    IF ( lat .ge. nplatcrocus(ls,lon) ) isitice = 1.
36  ENDIF
37END FUNCTION isitice
38
39REAL FUNCTION nplatcrocus( ls, lon )
40  !;Purpose: To return the areocentric latitude of the IR cap edge for TES year "1".
41  !;
42  !;Inputs:
43  !;  ls: Season in degrees of L_s.
44  !;  lo: East Longitude of interest.
45  !;
46  !;Dates of TES data used:  1999 FEB 28 to  2001 JAN 15
47  !;Dates of TES data used:  2001 JAN 15 to  2002 DEC 2
48  !;Dates of TES data used:  2002 DEC 2 to  1980 JAN 1
49  !;
50  !;Written by T.N. Titus Thu Dec 15 11:54:26 2005
51  !;U.S. Geological Survey Astrogeology Team.
52  !;2255 North Gemini Drive
53  !;Flagstaff, AZ 86001 USA
54  !;http://www.mars-ice.org
55  !;
56  !;If using this function for research or publication, please cite:
57  !; T. N. Titus (2005), Mars Polar Cap Edges Tracked over 3 Full Mars Years,
58  !;   36th Annual Lunar and Planetary Science Conference, March 14-18, 2005,
59  !;   in League City, Texas, abstract no.1993
60  !!**********************************************************!!
61  ! ADAPTATION: A. Spiga (aymeric.spiga@upmc.fr) October 2011  !
62  !!**********************************************************!!
63  IMPLICIT NONE
64  !! INPUT
65  REAL, INTENT(IN) :: ls,lon
66  !! LOCAL
67  REAL, DIMENSION(40) :: gen1, gen2, quan, c, s
68  REAL, DIMENSION(40,2,3) :: tes
69  INTEGER :: year
70  REAL, DIMENSION(3) :: const, line
71  !!*****************************************************************************************
72  !! CONSTANT
73  const(:) = (/ 71.4648,70.4607,71.5339 /)
74  !! GENERIC TABS
75  gen1(:) = (/ &
76  & 0.00000,1.00000,2.00000,3.00000,4.00000, &
77  & 0.00000,1.00000,2.00000,3.00000,4.00000, &
78  & 0.00000,1.00000,2.00000,3.00000,4.00000, &
79  & 0.00000,1.00000,2.00000,3.00000,4.00000, &
80  & 1.00000,2.00000,3.00000,4.00000, &
81  & 1.00000,2.00000,3.00000,4.00000, &
82  & 1.00000,2.00000,3.00000,4.00000, &
83  & 1.00000,2.00000,3.00000,4.00000, &
84  & 1.00000,2.00000,3.00000,4.00000 &
85  /)
86  gen2(:) = (/ &
87  & 1.00000,1.00000,1.00000,1.00000,1.00000, &
88  & 2.00000,2.00000,2.00000,2.00000,2.00000, &
89  & 3.00000,3.00000,3.00000,3.00000,3.00000, &
90  & 4.00000,4.00000,4.00000,4.00000,4.00000, &
91  &  0.00000, 0.00000, 0.00000, 0.00000, &
92  & -1.00000,-1.00000,-1.00000,-1.00000, &
93  & -2.00000,-2.00000,-2.00000,-2.00000, &
94  & -3.00000,-3.00000,-3.00000,-3.00000, &
95  & -4.00000,-4.00000,-4.00000,-4.00000 &
96  /)
97  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! NORTHERN CAP
98  !!! FIRST YEAR TES
99  tes(:,1,1) = (/ &
100  & -1.04928,  -0.217329,  0.101174, -0.0374879, 0.00576928, &
101  & -0.467708,  0.213426, -0.322449,  0.248625, -0.0879115, &
102  & -0.0852889,-0.0280091,-0.185435,  0.0160633, 0.0485029, &
103  & -0.0402631, 0.163700, -0.115792, -0.0468377,-0.00756858, &
104  & -11.1382,   0.918513,  0.754372, -0.288945,  0.0435517, &
105  & 0.143201,  -0.195657,  0.0378341,-0.640119,  0.429567, &
106  & -0.114784, -0.0829540,-0.179708,  0.0328001, 0.0342086, &
107  & -0.0193232, 0.0279848, 0.180155, -0.154807,  0.0971645 &
108  /)
109  tes(:,2,1) = (/ &
110  &  0.673412,   0.194463,  0.0213440, -0.219141,   0.124593, &
111  &  0.0526366, -0.604908,  0.113683,   0.0372814, -0.0714123, &
112  & -0.00710610,-0.0933308, 0.0241633,  0.0559299, -0.0924497, &
113  &  0.0747056,  0.0400294,-0.127268,  -0.0222301,  0.0272872, &
114  & -19.2296,    4.86860,  -0.454119,  -0.375147,  -0.119044, &
115  &  0.209839,  -0.271209,  0.367698,   0.171835,   0.350654, &
116  & -0.288149,  -0.0152939, 0.0195934,  0.184573,  -0.0272326, &
117  & -0.0466995,  0.299228,- 0.0593913, -0.0660705,  0.0282595 &
118  /)
119  !!! SECOND YEAR TES
120  tes(:,1,2) = (/ &
121  & -0.728762,-0.671618,0.154561,0.112470,-0.152911,-0.633290, &
122  &  0.372959,-0.241842,0.100173,0.0558815,-0.0258014,0.0138332, &
123  & -0.113160,0.0965581,-0.0478080,0.0199076,0.0360519,-0.119565, &
124  & -0.0564988,0.00166589,-10.8664,1.34367,0.334286,-0.0889369, &
125  & 0.170191,-0.241918,0.0406942,-0.0312268,-0.542561,0.440734,&
126  & -0.181151,-0.178009,-0.216867,-0.00154585,0.0381691,0.0333462,&
127  & 0.0558955,0.0512524,-0.0389391,0.0705681 &
128  /)
129  tes(:,2,2) = (/ &
130  & 0.133511,0.301999,0.354979,-0.471594,0.151863,0.0575986, &
131  & -0.478402,-0.0168485,0.148232,-0.128787,-0.0914331,-0.0603194, &
132  & 0.0611823,0.0668322,-0.0833629,0.0176089,0.0570124,-0.0641502, &
133  & 0.0196993,-0.0272954,-18.8258,4.08857,-0.252963,-0.0642321, &
134  & -0.463212,0.380846,-0.00712758,0.0374067,0.230256,0.154810, &
135  & -0.235321,0.0838983,0.0737168,0.115381,-0.00787243,-0.0289239, &
136  & 0.169424,-0.00376776,-0.0134735,0.00663328 &
137  /)
138  !!! THIRD YEAR TES
139  tes(:,1,3) = (/ &
140  & -0.170075,-0.706807,-0.0725778,0.266425,-0.166670,-0.408371, &
141  & 0.106833,-0.318539,0.319422,-0.0361432,-0.0366784,-0.0231430, &
142  & -0.129665,0.0478013,0.0283050,0.399130,-0.177498,-0.113099, &
143  & 0.0885522,-0.0503254,-12.2470,1.40947,0.401761,-0.149156, &
144  & -0.256222,-0.0307999,0.173418,-0.112992,-0.628345,0.286791, &
145  & -0.0395388,-0.0634619,-0.263644,0.0727097,0.0679133,0.0350731, &
146  & -0.140744,0.0673651,0.0457041,-0.0454068 &
147  /)
148  tes(:,2,3) = (/ &
149  & 0.447200,-0.251112,0.597279,-0.374734,-0.0290520,-0.0208475, &
150  & -0.682811,0.146231,0.0122089,-0.0917365,0.00708168,-0.143992, &
151  & 0.0724996,0.102962,-0.0703368,-0.0429708,-0.173888,0.189929, &
152  & -0.107449,-0.0505178,-19.3010,4.83420,-1.09834,0.430944, &
153  & -0.643534,0.710448,-0.299251,0.135935,0.134539,0.320505, &
154  & -0.200302,-0.0106718,0.0166824,0.260126,-0.0992902,-0.0182585, &
155  & -0.0627401,0.232410,-0.126134,-0.0100335 &
156  /)
157  !!! MAIN CALCULATIONS
158  quan = (acos(-1.)/180.)*ls*gen1 + (acos(-1.)/180.)*lon*gen2
159  c = cos(quan)
160  s = sin(quan)
161  line(:) = 0.
162  DO year=1,3
163    line(year) = DOT_PRODUCT(c,tes(:,1,year)) - DOT_PRODUCT(s,tes(:,2,year)) + const(year)
164    !!! this is taken into account in isitice
165    !if (line(year) < -90.) line(year) = -90.
166    !if (line(year) >  90.) line(year) =  90.
167  ENDDO
168  !!! THIS IS TEMPORARY, BUT WHY NOT FOR MODELING
169  nplatcrocus = (line(1)+line(2)+line(3))/3.
170END FUNCTION nplatcrocus
171
172REAL FUNCTION splatcrocus( ls, lon )
173  !;Purpose: To return the areocentric latitude of the IR cap edge for TES year "1".
174  !;
175  !;Inputs:
176  !;  ls: Season in degrees of L_s.
177  !;  lo: East Longitude of interest.
178  !;
179  !;Dates of TES data used:  1999 FEB 28 to  2001 JAN 15
180  !;Dates of TES data used:  2001 JAN 15 to  2002 DEC 2
181  !;Dates of TES data used:  2002 DEC 2 to  1980 JAN 1
182  !;
183  !;Written by T.N. Titus Thu Dec 15 11:54:26 2005
184  !;U.S. Geological Survey Astrogeology Team.
185  !;2255 North Gemini Drive
186  !;Flagstaff, AZ 86001 USA
187  !;http://www.mars-ice.org
188  !;
189  !;If using this function for research or publication, please cite:
190  !; T. N. Titus (2005), Mars Polar Cap Edges Tracked over 3 Full Mars Years,
191  !;   36th Annual Lunar and Planetary Science Conference, March 14-18, 2005,
192  !;   in League City, Texas, abstract no.1993
193  !!**********************************************************!!
194  ! ADAPTATION: A. Spiga (aymeric.spiga@upmc.fr) October 2011  !
195  !!**********************************************************!!
196  IMPLICIT NONE
197  !! INPUT
198  REAL, INTENT(IN) :: ls,lon
199  !! LOCAL
200  REAL, DIMENSION(60) :: gen1, gen2, quan, c, s
201  REAL, DIMENSION(60,2,2) :: tes
202  INTEGER :: year
203  REAL, DIMENSION(2) :: const, line
204  !!*****************************************************************************************
205  !! CONSTANT
206  const(:) = (/ -69.6039, -68.8420 /)
207  !! GENERIC TABS
208  gen1(:) = (/ &
209  & 0.00000,1.00000,2.00000,3.00000,4.00000, &
210  & 5.00000,0.00000,1.00000,2.00000,3.00000, &
211  & 4.00000,5.00000,0.00000,1.00000,2.00000, &
212  & 3.00000,4.00000,5.00000,0.00000,1.00000, &
213  & 2.00000,3.00000,4.00000,5.00000,0.00000, &
214  & 1.00000,2.00000,3.00000,4.00000,5.00000, &
215  & 1.00000,2.00000,3.00000,4.00000,5.00000, &
216  & 1.00000,2.00000,3.00000,4.00000,5.00000, &
217  & 1.00000,2.00000,3.00000,4.00000,5.00000, &
218  & 1.00000,2.00000,3.00000,4.00000,5.00000, &
219  & 1.00000,2.00000,3.00000,4.00000,5.00000, &
220  & 1.00000,2.00000,3.00000,4.00000,5.00000 &
221  /)
222  gen2(:) = (/ &
223  &  1.00000, 1.00000, 1.00000, 1.00000, 1.00000, &
224  &  1.00000, 2.00000, 2.00000, 2.00000, 2.00000, &
225  &  2.00000, 2.00000, 3.00000, 3.00000, 3.00000, &
226  &  3.00000, 3.00000, 3.00000, 4.00000, 4.00000, &
227  &  4.00000, 4.00000, 4.00000, 4.00000, 5.00000, &
228  &  5.00000, 5.00000, 5.00000, 5.00000, 5.00000, &
229  &  0.00000, 0.00000, 0.00000, 0.00000, 0.00000, &
230  & -1.00000,-1.00000,-1.00000,-1.00000,-1.00000, &
231  & -2.00000,-2.00000,-2.00000,-2.00000,-2.00000, &
232  & -3.00000,-3.00000,-3.00000,-3.00000,-3.00000, &
233  & -4.00000,-4.00000,-4.00000,-4.00000,-4.00000, &
234  & -5.00000,-5.00000,-5.00000,-5.00000,-5.00000 &
235  /)
236  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! SOUTHERN CAP
237  !!! FIRST YEAR TES
238  tes(:,1,1) = (/ &
239  &  3.53762,  -1.57584,  -2.97332,  -1.07670,    0.272623,  &
240  &  0.311819,  0.842387,  1.11375,   0.388617,  -0.575892,  &
241  & -0.502105, -0.0357803,-0.689386,  0.743998,   0.796186,  &
242  &  0.304092, -0.172464, -0.290923, -0.542742,  -0.577187,  &
243  & -0.439117,  0.266552,  0.393525,  0.0654230,  0.296123,  &
244  &  0.0949434,-0.162267, -0.175361,  0.000162221,0.105111,  &
245  & -12.4148,   0.177898,  1.45822,   0.309320,  -0.148393, 3.51232, &
246  &  0.355009, -0.782760, -0.427043, -0.178686,  -0.429962,  &
247  & -0.649747, -0.487551,  0.259459,  0.139186,  -0.964653,  &
248  & -0.409536,  0.137911,  0.293971,  0.0248885,  0.238855,  &
249  &  0.612519,  0.172469, -0.0462983,-0.0129877,  0.00532444,&
250  & -0.189464, -0.139035, -0.0231797, 0.0903127 &
251  /)
252  tes(:,2,1) = (/ &
253  &  3.21178,   3.81330,    0.357977,  -1.85466,   -1.01477,  &
254  & -0.209586, -0.797844,   0.334659,   0.828534,   0.519493, &
255  & -0.0512511,-0.204263,  -0.924137,  -0.694012, -0.0666508, &
256  &  0.632104,  0.397041,  -0.00521332, 0.933057,  0.0136105, &
257  & -0.646719, -0.480330,  -0.0122939,  0.214389,  0.0880269, &
258  &  0.0896852, 0.158164,  -0.00717643,-0.130884, -0.0425004, &
259  & -21.5000,  -5.88472,   -0.767056,   0.261383,  0.232822,  &
260  &  1.18087,   2.13123,    1.00744,   -0.0527458,-0.0417051, &
261  &  1.05940,   0.00149598,-0.501423,  -0.290405, -0.0562713, &
262  &  0.335254, -0.480024,  -0.604500,   0.0411040, 0.0403603, &
263  & -0.489831,  0.109007,   0.217500,   0.109769, -0.000845153, &
264  &  0.152139,  0.206418,  -0.0980599, -0.180992, -0.00685824 &
265  /)
266  !!! SECOND YEAR TES
267  tes(:,1,2) = (/ &
268  &  3.10733,  -0.0926926, -1.38769,   -0.638410,  0.0598460, &
269  &  0.0212056,-0.574512,  -0.687073,  -0.193427,  0.161192,  &
270  &  0.242137,  0.0178444, -0.427617,   0.892971,  0.650940,  &
271  & -0.0372970,-0.311147,  -0.123042,  -0.221688, -0.467191,  &
272  & -0.659134,  0.0246518,  0.257168,   0.124850,  0.174360,  &
273  &  0.320583,  0.136864,  -0.0606024, -0.0941828, 0.00372431,&
274  & -11.1678,  -0.376356,   0.316746,  -0.100600,  -0.119510, &
275  &  1.35807,  -1.53000,   -0.867922,   0.301309,   0.258290, &
276  &  0.0813258, 0.601762,   0.268272,   0.0989900, -0.0737015,&
277  & -0.968944, -0.599203,   0.217550,   0.466813,   0.0202996,&
278  &  0.693900,  0.653567,  -0.0888332, -0.219429,  -0.0298150,&
279  & -0.186738, -0.329258,  -0.155475,   0.0241376,  0.0613455 &
280  /)
281  tes(:,2,2) = (/ &
282  &  0.745574,  2.34362,    0.617967,  -0.847462,  -0.440483, &
283  & -0.135479,  0.546528,  -0.0659467, -0.627697,  -0.358895, &
284  &  0.0292012, 0.0797757, -0.953241,  -0.386098,   0.325419, &
285  &  0.543846,  0.108148,  -0.0596165,  1.15557,    0.436356, &
286  & -0.392191, -0.500867,  -0.205739,   0.194082,  -0.239364, &
287  & -0.136630,  0.135228,   0.213587,   0.0299697, -0.0101247,&
288  & -19.9097,  -5.34634,    0.103437,  -0.343399,  -0.348643, &
289  &  2.20957,   1.02330,   -0.722428,  -0.574345,   0.149871, &
290  & -0.635328, -0.317596,   0.154507,   0.110691,   0.0265673,&
291  &  0.593630, -0.516898  ,-0.689954,   0.00465230, 0.120493, &
292  & -0.323229,  0.491035,   0.508041,   0.0373988, -0.106504, &
293  &  0.241758,  0.0470212, -0.236231,  -0.186565,   0.0105776 &
294  /)
295  !!! MAIN CALCULATIONS
296  quan = (acos(-1.)/180.)*ls*gen1 + (acos(-1.)/180.)*lon*gen2
297  c = cos(quan)
298  s = sin(quan)
299  line(:) = 0.
300  DO year=1,2
301    line(year) = DOT_PRODUCT(c,tes(:,1,year)) - DOT_PRODUCT(s,tes(:,2,year)) + const(year)
302    !!! this is taken into account in isitice
303    !if (line(year) < -90.) line(year) = -90.
304    !if (line(year) >  90.) line(year) =  90.
305  ENDDO
306  !!! THIS IS TEMPORARY, BUT WHY NOT FOR MODELING
307  splatcrocus = (line(1)+line(2))/2.
308END FUNCTION splatcrocus
309
310!PROGRAM main
311!
312!implicit none
313!INTEGER, PARAMETER :: ngrid = 12
314!REAL,DIMENSION(ngrid) :: lontab,lattab,icecover
315!REAL :: ls,lo,outputs,isitice
316!REAL :: nplatcrocus,splatcrocus
317!INTEGER :: i,j,zels
318!
319!DO i=0,360,30
320!print *, 'ls,np,sp ', float(i), nplatcrocus(float(i),0.), splatcrocus(float(i),0.)
321!ENDDO
322!
323!print *, 'isitice(90.,0.,50.)',isitice(90.,0.,50.)
324!print *, 'isitice(90.,0.,87.)',isitice(90.,0.,87.)
325!print *, 'isitice(90.,0.,-50.)',isitice(90.,0.,-50.)
326!print *, 'isitice(90.,0.,-87.)',isitice(90.,0.,-87.)
327!print *, 'isitice(290.,0.,50.)',isitice(290.,0.,50.)
328!print *, 'isitice(290.,0.,87.)',isitice(290.,0.,87.)
329!print *, 'isitice(290.,0.,-50.)',isitice(290.,0.,-50.)
330!print *, 'isitice(290.,0.,-87.)',isitice(290.,0.,-87.)
331!print *, 'isitice(120.,0.,90.)',isitice(120.,0.,90.)
332!
333!lontab(:) = 0.
334!lattab = (/ -90., -75., -60., -45., -30., -15.,  15.,  30.,  45.,  60.,  75.,  90. /)
335!print *,'ls. lat:', lattab
336!DO zels=0,360,30
337!  CALL geticecover( ngrid, float(zels), lontab, lattab, icecover )
338!  print *, zels, icecover
339!ENDDO
340!
341!END PROGRAM main
Note: See TracBrowser for help on using the repository browser.