Context Navigation

mrgrnk.F90 @ 5209

Last change on this file since 5209 was 5099, checked in by abarral, 2 months ago
Replace most uses of CPP_DUST by the corresponding logical defined in lmdz_cppkeys_wrapper.F90 Convert several files from .F to .f90 to allow Dust to compile w/o rrtm/ecrad Create lmdz_yoerad.f90 (lint) Remove "!" on otherwise empty line
File size: 18.5 KB

Line
1	! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2	! Copyright (c) 2015, Regents of the University of Colorado
3	! All rights reserved.
4
5	! Redistribution and use in source and binary forms, with or without modification, are
6	! permitted provided that the following conditions are met:
7
8	! 1. Redistributions of source code must retain the above copyright notice, this list of
9	! conditions and the following disclaimer.
10
11	! 2. Redistributions in binary form must reproduce the above copyright notice, this list
12	! of conditions and the following disclaimer in the documentation and/or other
13	! materials provided with the distribution.
14
15	! 3. Neither the name of the copyright holder nor the names of its contributors may be
16	! used to endorse or promote products derived from this software without specific prior
17	! written permission.
18
19	! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY
20	! EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
21	! MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL
22	! THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
23	! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT
24	! OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
25	! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
26	! LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
27	! OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
28
29	! History:
30	! May 2015: Dustin Swales - Modified for COSPv2.0
31
32	! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
33	Module m_mrgrnk
34	USE COSP_KINDS, ONLY: wp
35	Integer, Parameter :: kdp = selected_real_kind(15)
36	public :: mrgrnk
37	private :: kdp
38	private :: R_mrgrnk, I_mrgrnk, D_mrgrnk
39
40	interface mrgrnk
41	! module procedure D_mrgrnk, R_mrgrnk, I_mrgrnk
42	module procedure R_mrgrnk, I_mrgrnk
43
44	end interface
45	contains
46
47	Subroutine D_mrgrnk (XDONT, IRNGT)
48	! __________________________________________________________
49	! MRGRNK = Merge-sort ranking of an array
50	! For performance reasons, the first 2 passes are taken
51	! out of the standard loop, and use dedicated coding.
52	! __________________________________________________________
53	! __________________________________________________________
54	Real (wp), Dimension (:), Intent (In) :: XDONT
55	Integer, Dimension (:), Intent (Out) :: IRNGT
56	! __________________________________________________________
57	Real (wp) :: XVALA, XVALB
58
59	Integer, Dimension (SIZE(IRNGT)) :: JWRKT
60	Integer :: LMTNA, LMTNC, IRNG1, IRNG2
61	Integer :: NVAL, IIND, IWRKD, IWRK, IWRKF, JINDA, IINDA, IINDB
62
63	NVAL = Min (SIZE(XDONT), SIZE(IRNGT))
64	Select Case (NVAL)
65	Case (:0)
66	Return
67	Case (1)
68	IRNGT (1) = 1
69	Return
70	Case Default
71	Continue
72	End Select
73
74	! Fill-in the index array, creating ordered couples
75
76	Do IIND = 2, NVAL, 2
77	If (XDONT(IIND-1) <= XDONT(IIND)) Then
78	IRNGT (IIND-1) = IIND - 1
79	IRNGT (IIND) = IIND
80	Else
81	IRNGT (IIND-1) = IIND
82	IRNGT (IIND) = IIND - 1
83	End If
84	End Do
85	If (Modulo(NVAL, 2) /= 0) Then
86	IRNGT (NVAL) = NVAL
87	End If
88
89	! We will now have ordered subsets A - B - A - B - ...
90	! and merge A and B couples into C - C - ...
91
92	LMTNA = 2
93	LMTNC = 4
94
95	! First iteration. The length of the ordered subsets goes from 2 to 4
96
97	Do
98	If (NVAL <= 2) Exit
99
100	! Loop on merges of A and B into C
101
102	Do IWRKD = 0, NVAL - 1, 4
103	If ((IWRKD+4) > NVAL) Then
104	If ((IWRKD+2) >= NVAL) Exit
105
106	! 1 2 3
107
108	If (XDONT(IRNGT(IWRKD+2)) <= XDONT(IRNGT(IWRKD+3))) Exit
109
110	! 1 3 2
111
112	If (XDONT(IRNGT(IWRKD+1)) <= XDONT(IRNGT(IWRKD+3))) Then
113	IRNG2 = IRNGT (IWRKD+2)
114	IRNGT (IWRKD+2) = IRNGT (IWRKD+3)
115	IRNGT (IWRKD+3) = IRNG2
116
117	! 3 1 2
118
119	Else
120	IRNG1 = IRNGT (IWRKD+1)
121	IRNGT (IWRKD+1) = IRNGT (IWRKD+3)
122	IRNGT (IWRKD+3) = IRNGT (IWRKD+2)
123	IRNGT (IWRKD+2) = IRNG1
124	End If
125	Exit
126	End If
127
128	! 1 2 3 4
129
130	If (XDONT(IRNGT(IWRKD+2)) <= XDONT(IRNGT(IWRKD+3))) Cycle
131
132	! 1 3 x x
133
134	If (XDONT(IRNGT(IWRKD+1)) <= XDONT(IRNGT(IWRKD+3))) Then
135	IRNG2 = IRNGT (IWRKD+2)
136	IRNGT (IWRKD+2) = IRNGT (IWRKD+3)
137	If (XDONT(IRNG2) <= XDONT(IRNGT(IWRKD+4))) Then
138	! 1 3 2 4
139	IRNGT (IWRKD+3) = IRNG2
140	Else
141	! 1 3 4 2
142	IRNGT (IWRKD+3) = IRNGT (IWRKD+4)
143	IRNGT (IWRKD+4) = IRNG2
144	End If
145
146	! 3 x x x
147
148	Else
149	IRNG1 = IRNGT (IWRKD+1)
150	IRNG2 = IRNGT (IWRKD+2)
151	IRNGT (IWRKD+1) = IRNGT (IWRKD+3)
152	If (XDONT(IRNG1) <= XDONT(IRNGT(IWRKD+4))) Then
153	IRNGT (IWRKD+2) = IRNG1
154	If (XDONT(IRNG2) <= XDONT(IRNGT(IWRKD+4))) Then
155	! 3 1 2 4
156	IRNGT (IWRKD+3) = IRNG2
157	Else
158	! 3 1 4 2
159	IRNGT (IWRKD+3) = IRNGT (IWRKD+4)
160	IRNGT (IWRKD+4) = IRNG2
161	End If
162	Else
163	! 3 4 1 2
164	IRNGT (IWRKD+2) = IRNGT (IWRKD+4)
165	IRNGT (IWRKD+3) = IRNG1
166	IRNGT (IWRKD+4) = IRNG2
167	End If
168	End If
169	End Do
170
171	! The Cs become As and Bs
172
173	LMTNA = 4
174	Exit
175	End Do
176
177	! Iteration loop. Each time, the length of the ordered subsets
178	! is doubled.
179
180	Do
181	If (LMTNA >= NVAL) Exit
182	IWRKF = 0
183	LMTNC = 2 * LMTNC
184
185	! Loop on merges of A and B into C
186
187	Do
188	IWRK = IWRKF
189	IWRKD = IWRKF + 1
190	JINDA = IWRKF + LMTNA
191	IWRKF = IWRKF + LMTNC
192	If (IWRKF >= NVAL) Then
193	If (JINDA >= NVAL) Exit
194	IWRKF = NVAL
195	End If
196	IINDA = 1
197	IINDB = JINDA + 1
198
199	! Shortcut for the case when the max of A is smaller
200	! than the min of B. This line may be activated when the
201	! initial set is already close to sorted.
202
203	! IF (XDONT(IRNGT(JINDA)) <= XDONT(IRNGT(IINDB))) CYCLE
204
205	! One steps in the C subset, that we build in the final rank array
206
207	! Make a copy of the rank array for the merge iteration
208
209	JWRKT (1:LMTNA) = IRNGT (IWRKD:JINDA)
210
211	XVALA = XDONT (JWRKT(IINDA))
212	XVALB = XDONT (IRNGT(IINDB))
213
214	Do
215	IWRK = IWRK + 1
216
217	! We still have unprocessed values in both A and B
218
219	If (XVALA > XVALB) Then
220	IRNGT (IWRK) = IRNGT (IINDB)
221	IINDB = IINDB + 1
222	If (IINDB > IWRKF) Then
223	! Only A still with unprocessed values
224	IRNGT (IWRK+1:IWRKF) = JWRKT (IINDA:LMTNA)
225	Exit
226	End If
227	XVALB = XDONT (IRNGT(IINDB))
228	Else
229	IRNGT (IWRK) = JWRKT (IINDA)
230	IINDA = IINDA + 1
231	If (IINDA > LMTNA) Exit! Only B still with unprocessed values
232	XVALA = XDONT (JWRKT(IINDA))
233	End If
234
235	End Do
236	End Do
237
238	! The Cs become As and Bs
239
240	LMTNA = 2 * LMTNA
241	End Do
242
243	Return
244
245	End Subroutine D_mrgrnk
246
247	Subroutine R_mrgrnk (XDONT, IRNGT)
248	! __________________________________________________________
249	! MRGRNK = Merge-sort ranking of an array
250	! For performance reasons, the first 2 passes are taken
251	! out of the standard loop, and use dedicated coding.
252	! __________________________________________________________
253	! _________________________________________________________
254	Real(wp), Dimension (:), Intent (In) :: XDONT
255	Integer, Dimension (:), Intent (Out) :: IRNGT
256	! __________________________________________________________
257	Real(wp) :: XVALA, XVALB
258
259	Integer, Dimension (SIZE(IRNGT)) :: JWRKT
260	Integer :: LMTNA, LMTNC, IRNG1, IRNG2
261	Integer :: NVAL, IIND, IWRKD, IWRK, IWRKF, JINDA, IINDA, IINDB
262
263	NVAL = Min (SIZE(XDONT), SIZE(IRNGT))
264	Select Case (NVAL)
265	Case (:0)
266	Return
267	Case (1)
268	IRNGT (1) = 1
269	Return
270	Case Default
271	Continue
272	End Select
273
274	! Fill-in the index array, creating ordered couples
275
276	Do IIND = 2, NVAL, 2
277	If (XDONT(IIND-1) <= XDONT(IIND)) Then
278	IRNGT (IIND-1) = IIND - 1
279	IRNGT (IIND) = IIND
280	Else
281	IRNGT (IIND-1) = IIND
282	IRNGT (IIND) = IIND - 1
283	End If
284	End Do
285	If (Modulo(NVAL, 2) /= 0) Then
286	IRNGT (NVAL) = NVAL
287	End If
288
289	! We will now have ordered subsets A - B - A - B - ...
290	! and merge A and B couples into C - C - ...
291
292	LMTNA = 2
293	LMTNC = 4
294
295	! First iteration. The length of the ordered subsets goes from 2 to 4
296
297	Do
298	If (NVAL <= 2) Exit
299
300	! Loop on merges of A and B into C
301
302	Do IWRKD = 0, NVAL - 1, 4
303	If ((IWRKD+4) > NVAL) Then
304	If ((IWRKD+2) >= NVAL) Exit
305
306	! 1 2 3
307
308	If (XDONT(IRNGT(IWRKD+2)) <= XDONT(IRNGT(IWRKD+3))) Exit
309
310	! 1 3 2
311
312	If (XDONT(IRNGT(IWRKD+1)) <= XDONT(IRNGT(IWRKD+3))) Then
313	IRNG2 = IRNGT (IWRKD+2)
314	IRNGT (IWRKD+2) = IRNGT (IWRKD+3)
315	IRNGT (IWRKD+3) = IRNG2
316
317	! 3 1 2
318
319	Else
320	IRNG1 = IRNGT (IWRKD+1)
321	IRNGT (IWRKD+1) = IRNGT (IWRKD+3)
322	IRNGT (IWRKD+3) = IRNGT (IWRKD+2)
323	IRNGT (IWRKD+2) = IRNG1
324	End If
325	Exit
326	End If
327
328	! 1 2 3 4
329
330	If (XDONT(IRNGT(IWRKD+2)) <= XDONT(IRNGT(IWRKD+3))) Cycle
331
332	! 1 3 x x
333
334	If (XDONT(IRNGT(IWRKD+1)) <= XDONT(IRNGT(IWRKD+3))) Then
335	IRNG2 = IRNGT (IWRKD+2)
336	IRNGT (IWRKD+2) = IRNGT (IWRKD+3)
337	If (XDONT(IRNG2) <= XDONT(IRNGT(IWRKD+4))) Then
338	! 1 3 2 4
339	IRNGT (IWRKD+3) = IRNG2
340	Else
341	! 1 3 4 2
342	IRNGT (IWRKD+3) = IRNGT (IWRKD+4)
343	IRNGT (IWRKD+4) = IRNG2
344	End If
345
346	! 3 x x x
347
348	Else
349	IRNG1 = IRNGT (IWRKD+1)
350	IRNG2 = IRNGT (IWRKD+2)
351	IRNGT (IWRKD+1) = IRNGT (IWRKD+3)
352	If (XDONT(IRNG1) <= XDONT(IRNGT(IWRKD+4))) Then
353	IRNGT (IWRKD+2) = IRNG1
354	If (XDONT(IRNG2) <= XDONT(IRNGT(IWRKD+4))) Then
355	! 3 1 2 4
356	IRNGT (IWRKD+3) = IRNG2
357	Else
358	! 3 1 4 2
359	IRNGT (IWRKD+3) = IRNGT (IWRKD+4)
360	IRNGT (IWRKD+4) = IRNG2
361	End If
362	Else
363	! 3 4 1 2
364	IRNGT (IWRKD+2) = IRNGT (IWRKD+4)
365	IRNGT (IWRKD+3) = IRNG1
366	IRNGT (IWRKD+4) = IRNG2
367	End If
368	End If
369	End Do
370
371	! The Cs become As and Bs
372
373	LMTNA = 4
374	Exit
375	End Do
376
377	! Iteration loop. Each time, the length of the ordered subsets
378	! is doubled.
379
380	Do
381	If (LMTNA >= NVAL) Exit
382	IWRKF = 0
383	LMTNC = 2 * LMTNC
384
385	! Loop on merges of A and B into C
386
387	Do
388	IWRK = IWRKF
389	IWRKD = IWRKF + 1
390	JINDA = IWRKF + LMTNA
391	IWRKF = IWRKF + LMTNC
392	If (IWRKF >= NVAL) Then
393	If (JINDA >= NVAL) Exit
394	IWRKF = NVAL
395	End If
396	IINDA = 1
397	IINDB = JINDA + 1
398
399	! Shortcut for the case when the max of A is smaller
400	! than the min of B. This line may be activated when the
401	! initial set is already close to sorted.
402
403	! IF (XDONT(IRNGT(JINDA)) <= XDONT(IRNGT(IINDB))) CYCLE
404
405	! One steps in the C subset, that we build in the final rank array
406
407	! Make a copy of the rank array for the merge iteration
408
409	JWRKT (1:LMTNA) = IRNGT (IWRKD:JINDA)
410
411	XVALA = XDONT (JWRKT(IINDA))
412	XVALB = XDONT (IRNGT(IINDB))
413
414	Do
415	IWRK = IWRK + 1
416
417	! We still have unprocessed values in both A and B
418
419	If (XVALA > XVALB) Then
420	IRNGT (IWRK) = IRNGT (IINDB)
421	IINDB = IINDB + 1
422	If (IINDB > IWRKF) Then
423	! Only A still with unprocessed values
424	IRNGT (IWRK+1:IWRKF) = JWRKT (IINDA:LMTNA)
425	Exit
426	End If
427	XVALB = XDONT (IRNGT(IINDB))
428	Else
429	IRNGT (IWRK) = JWRKT (IINDA)
430	IINDA = IINDA + 1
431	If (IINDA > LMTNA) Exit! Only B still with unprocessed values
432	XVALA = XDONT (JWRKT(IINDA))
433	End If
434
435	End Do
436	End Do
437
438	! The Cs become As and Bs
439
440	LMTNA = 2 * LMTNA
441	End Do
442
443	Return
444
445	End Subroutine R_mrgrnk
446	Subroutine I_mrgrnk (XDONT, IRNGT)
447	! __________________________________________________________
448	! MRGRNK = Merge-sort ranking of an array
449	! For performance reasons, the first 2 passes are taken
450	! out of the standard loop, and use dedicated coding.
451	! __________________________________________________________
452	! __________________________________________________________
453	Integer, Dimension (:), Intent (In) :: XDONT
454	Integer, Dimension (:), Intent (Out) :: IRNGT
455	! __________________________________________________________
456	Integer :: XVALA, XVALB
457
458	Integer, Dimension (SIZE(IRNGT)) :: JWRKT
459	Integer :: LMTNA, LMTNC, IRNG1, IRNG2
460	Integer :: NVAL, IIND, IWRKD, IWRK, IWRKF, JINDA, IINDA, IINDB
461
462	NVAL = Min (SIZE(XDONT), SIZE(IRNGT))
463	Select Case (NVAL)
464	Case (:0)
465	Return
466	Case (1)
467	IRNGT (1) = 1
468	Return
469	Case Default
470	Continue
471	End Select
472
473	! Fill-in the index array, creating ordered couples
474
475	Do IIND = 2, NVAL, 2
476	If (XDONT(IIND-1) <= XDONT(IIND)) Then
477	IRNGT (IIND-1) = IIND - 1
478	IRNGT (IIND) = IIND
479	Else
480	IRNGT (IIND-1) = IIND
481	IRNGT (IIND) = IIND - 1
482	End If
483	End Do
484	If (Modulo(NVAL, 2) /= 0) Then
485	IRNGT (NVAL) = NVAL
486	End If
487
488	! We will now have ordered subsets A - B - A - B - ...
489	! and merge A and B couples into C - C - ...
490
491	LMTNA = 2
492	LMTNC = 4
493
494	! First iteration. The length of the ordered subsets goes from 2 to 4
495
496	Do
497	If (NVAL <= 2) Exit
498
499	! Loop on merges of A and B into C
500
501	Do IWRKD = 0, NVAL - 1, 4
502	If ((IWRKD+4) > NVAL) Then
503	If ((IWRKD+2) >= NVAL) Exit
504
505	! 1 2 3
506
507	If (XDONT(IRNGT(IWRKD+2)) <= XDONT(IRNGT(IWRKD+3))) Exit
508
509	! 1 3 2
510
511	If (XDONT(IRNGT(IWRKD+1)) <= XDONT(IRNGT(IWRKD+3))) Then
512	IRNG2 = IRNGT (IWRKD+2)
513	IRNGT (IWRKD+2) = IRNGT (IWRKD+3)
514	IRNGT (IWRKD+3) = IRNG2
515
516	! 3 1 2
517
518	Else
519	IRNG1 = IRNGT (IWRKD+1)
520	IRNGT (IWRKD+1) = IRNGT (IWRKD+3)
521	IRNGT (IWRKD+3) = IRNGT (IWRKD+2)
522	IRNGT (IWRKD+2) = IRNG1
523	End If
524	Exit
525	End If
526
527	! 1 2 3 4
528
529	If (XDONT(IRNGT(IWRKD+2)) <= XDONT(IRNGT(IWRKD+3))) Cycle
530
531	! 1 3 x x
532
533	If (XDONT(IRNGT(IWRKD+1)) <= XDONT(IRNGT(IWRKD+3))) Then
534	IRNG2 = IRNGT (IWRKD+2)
535	IRNGT (IWRKD+2) = IRNGT (IWRKD+3)
536	If (XDONT(IRNG2) <= XDONT(IRNGT(IWRKD+4))) Then
537	! 1 3 2 4
538	IRNGT (IWRKD+3) = IRNG2
539	Else
540	! 1 3 4 2
541	IRNGT (IWRKD+3) = IRNGT (IWRKD+4)
542	IRNGT (IWRKD+4) = IRNG2
543	End If
544
545	! 3 x x x
546
547	Else
548	IRNG1 = IRNGT (IWRKD+1)
549	IRNG2 = IRNGT (IWRKD+2)
550	IRNGT (IWRKD+1) = IRNGT (IWRKD+3)
551	If (XDONT(IRNG1) <= XDONT(IRNGT(IWRKD+4))) Then
552	IRNGT (IWRKD+2) = IRNG1
553	If (XDONT(IRNG2) <= XDONT(IRNGT(IWRKD+4))) Then
554	! 3 1 2 4
555	IRNGT (IWRKD+3) = IRNG2
556	Else
557	! 3 1 4 2
558	IRNGT (IWRKD+3) = IRNGT (IWRKD+4)
559	IRNGT (IWRKD+4) = IRNG2
560	End If
561	Else
562	! 3 4 1 2
563	IRNGT (IWRKD+2) = IRNGT (IWRKD+4)
564	IRNGT (IWRKD+3) = IRNG1
565	IRNGT (IWRKD+4) = IRNG2
566	End If
567	End If
568	End Do
569
570	! The Cs become As and Bs
571
572	LMTNA = 4
573	Exit
574	End Do
575
576	! Iteration loop. Each time, the length of the ordered subsets
577	! is doubled.
578
579	Do
580	If (LMTNA >= NVAL) Exit
581	IWRKF = 0
582	LMTNC = 2 * LMTNC
583
584	! Loop on merges of A and B into C
585
586	Do
587	IWRK = IWRKF
588	IWRKD = IWRKF + 1
589	JINDA = IWRKF + LMTNA
590	IWRKF = IWRKF + LMTNC
591	If (IWRKF >= NVAL) Then
592	If (JINDA >= NVAL) Exit
593	IWRKF = NVAL
594	End If
595	IINDA = 1
596	IINDB = JINDA + 1
597
598	! Shortcut for the case when the max of A is smaller
599	! than the min of B. This line may be activated when the
600	! initial set is already close to sorted.
601
602	! IF (XDONT(IRNGT(JINDA)) <= XDONT(IRNGT(IINDB))) CYCLE
603
604	! One steps in the C subset, that we build in the final rank array
605
606	! Make a copy of the rank array for the merge iteration
607
608	JWRKT (1:LMTNA) = IRNGT (IWRKD:JINDA)
609
610	XVALA = XDONT (JWRKT(IINDA))
611	XVALB = XDONT (IRNGT(IINDB))
612
613	Do
614	IWRK = IWRK + 1
615
616	! We still have unprocessed values in both A and B
617
618	If (XVALA > XVALB) Then
619	IRNGT (IWRK) = IRNGT (IINDB)
620	IINDB = IINDB + 1
621	If (IINDB > IWRKF) Then
622	! Only A still with unprocessed values
623	IRNGT (IWRK+1:IWRKF) = JWRKT (IINDA:LMTNA)
624	Exit
625	End If
626	XVALB = XDONT (IRNGT(IINDB))
627	Else
628	IRNGT (IWRK) = JWRKT (IINDA)
629	IINDA = IINDA + 1
630	If (IINDA > LMTNA) Exit! Only B still with unprocessed values
631	XVALA = XDONT (JWRKT(IINDA))
632	End If
633
634	End Do
635	End Do
636
637	! The Cs become As and Bs
638
639	LMTNA = 2 * LMTNA
640	End Do
641
642	Return
643
644	End Subroutine I_mrgrnk
645	end module m_mrgrnk

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

Original Format