source: CPL/oasis3/trunk/src/lib/anaism/src/pcssph.f @ 1677

Last change on this file since 1677 was 1677, checked in by aclsce, 12 years ago

Imported oasis3 (tag ipslcm5a) from cvs server to svn server (igcmg project).

File size: 3.2 KB
Line 
1      SUBROUTINE pcssph (px, py, psgr, kngx, kngy)
2C****
3C               *****************************
4C               * OASIS ROUTINE  -  LEVEL T *
5C               * -------------     ------- *
6C               *****************************
7C
8C**** *pcssph* -  Arithmetic routine
9C
10C     Purpose:
11C     -------
12C     Calculate surface element for a spheric and periodic grid.
13C     The coordinates are in degrees, there are no pole points.
14C
15C**   Interface:
16C     ---------
17C       *CALL*  *pcssph(px, py, psgr, kngx, kngy)*
18C
19C     Input:
20C     -----
21C                px   : grid longitudes (real 2D)
22C                py   : grid latitudes (real 2D)
23C                kngx : number of longitudes
24C                kngy : number of latitudes
25C
26C     Output:
27C     ------
28C                psgr : grid surface elements (real 2D)
29C
30C
31C     Workspace:
32C     ---------
33C     None
34C
35C     External:
36C     --------
37C     None
38C
39C     References:
40C     ----------
41C     O. Thual, Simple ocean-atmosphere interpolation. 
42C               Part A: The method, EPICOA 0629 (1992)
43C               Part B: Software implementation, EPICOA 0630 (1992)
44C     See also OASIS manual (1995)
45C
46C     History:
47C     -------
48C       Version   Programmer     Date      Description
49C       -------   ----------     ----      ----------- 
50C       1.1       O. Thual       93/04/15  created 
51C       2.0       L. Terray      95/10/01  modified: new structure
52C
53C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
54C
55C* ---------------------------- Include files ---------------------------
56C
57      USE mod_kinds_oasis
58      USE mod_unit
59C
60C* ---------------------------- Argument declarations -------------------
61C     
62      REAL (kind=ip_realwp_p) px(kngx,kngy), py(kngx,kngy)
63      REAL (kind=ip_realwp_p) psgr(kngx,kngy)
64C
65C* ---------------------------- Poema verses ----------------------------
66C
67C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
68C
69C*    1. Degres to radians conversion factor
70C        -----------------------------------
71C
72      zconv = 1.74532925199432957692e-2
73C
74C
75C*    2. Surfaces 
76C        --------
77C
78      DO 210 j2 = 1, kngy
79        DO 220 j1 = 1, kngx
80C
81C* Left or right periodicity
82C
83          IF (J1 .EQ. 1) THEN
84              zx1 = px(kngx,j2) - 360.
85              zx2 = px(2,j2)
86            ELSE IF (j1 .EQ. kngx)  THEN
87              zx1 = px(kngx-1,j2)
88              zx2 = px(1,j2) + 360.
89            ELSE
90              zx1 = px(j1-1,j2)
91              zx2 = px(j1+1,j2)
92          ENDIF
93C
94C* Bottom or top treatment
95C
96          IF (j2 .EQ. 1) THEN
97              zy1 = -90.
98              zy2 = .5 * (py(j1,j2) + py(j1,j2+1))
99            ELSE IF (j2 .EQ. kngy) THEN
100              zy1 = .5 * (py(j1,j2) + py(j1,j2-1))
101              zy2 = 90.
102            ELSE
103              zy1 = .5 * (py(j1,j2) + py(j1,j2-1))
104              zy2 = .5 * (py(j1,j2) + py(j1,j2+1))
105          ENDIF
106C
107C* Conversion to radians
108C
109          zfi1 = zx1 * zconv
110          zfi2 = zx2 * zconv
111          zth1 = zy1 * zconv
112          zth2 = zy2 * zconv
113C
114C* Calculate grid square surface
115C   
116          zfac = sin(zth2) - sin(zth1) 
117          psgr(j1,j2) = abs(.5 * (zfi2-zfi1) * zfac)     
118 220    continue
119 210  CONTINUE
120C
121C* End of routine
122C
123      RETURN
124      END
125
126
127
128
129
130
131
Note: See TracBrowser for help on using the repository browser.