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

Last change on this file 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.