source: CPL/oasis3/trunk/src/lib/anaism/src/pmesh.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: 4.2 KB
Line 
1      SUBROUTINE pmesh (kx, ky, px, py, kngx, kngy, cdper, kper,
2     $                  pxi, pxs, pyi, pys)
3C****
4C               *****************************
5C               * OASIS ROUTINE  -  LEVEL 3 *
6C               * -------------     ------- *
7C               *****************************
8C
9C**** *pmesh* -  Calculate the mesh controlled by one point on a
10C               periodical or non-periodical grid.
11C
12C     Purpose:
13C     -------
14C     For one point defined by the coordinates (px(k),py(k)) 
15C     on a lat-lon grid, gives the inferior and superior longitudes 
16C     (pxi,pxs) and latitudes (pyi,pys) of the associated mesh.
17C     
18C
19C**   Interface:
20C     ---------
21C       *CALL*  *pmesh(kx, ky, px, py, kngx, kngy, cdper, kper,
22C                      pxi, pxs, pyi, pys)*
23C
24C     Input:
25C     -----
26C                kx    : point longitude index
27C                ky    : point latitude index
28C                px    : longitude array (real 2D)
29C                py    : latitude array (real 2D)
30C                kngx  : number of longitudes
31C                kngy  : number of latitudes
32C                cdper : grid periodicity
33C                kper  : number of overlapped points
34C
35C     Output:
36C     ------
37C                pxi  : inferior longitude
38C                pxs  : superior longitude
39C                pyi  : inferior latitude
40C                pys  : superior latitude
41C
42C     Workspace:
43C     ---------
44C     None
45C
46C     External:
47C     --------
48C     None
49C
50C     References:
51C     ----------
52C     O. Thual, Simple ocean-atmosphere interpolation. 
53C               Part A: The method, EPICOA 0629 (1992)
54C               Part B: Software implementation, EPICOA 0630 (1992)
55C     See also OASIS manual (1995)
56C
57C     History:
58C     -------
59C       Version   Programmer     Date      Description
60C       -------   ----------     ----      ----------- 
61C       1.1       O. Thual       93/04/15  created 
62C       2.0       L. Terray      95/10/01  modified: new structure
63C       2.3       L. Terray      99/09/15  changed periodicity variables
64C
65C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
66C
67C* ---------------------------- Include files ---------------------------
68C
69      USE mod_kinds_oasis
70      USE mod_unit
71C
72C* ---------------------------- Argument declarations -------------------
73C
74      REAL (kind=ip_realwp_p) px(kngx,kngy), py(kngx,kngy)
75      CHARACTER*8 cdper
76C
77C* ---------------------------- Poema verses ----------------------------
78C
79C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
80C
81C*    1. Left or right 
82C        -------------
83C
84C* Periodic grid with kper overlapped points
85C 
86      IF (cdper .EQ. 'P') THEN
87          IF (kx .EQ. 1) THEN
88              pxi = 0.5 * (px(kx,ky) + px(kngx-kper,ky) - 360.)
89              pxs = 0.5 * (px(kx,ky) + px(kx+1,ky))
90             ELSE IF (kx .EQ. kngx) THEN
91              pxi = 0.5 * (px(kx-1,ky) + px(kx,ky))
92              pxs = 0.5 * (px(kx,ky) + px(1+kper,ky) + 360. )
93            ELSE
94              pxi = 0.5 * (px(kx-1,ky) + px(kx,ky))
95              pxs = 0.5 * (px(kx,ky) + px(kx+1,ky))           
96          ENDIF
97C     
98C* Regional grid
99C 
100        ELSE IF (cdper .EQ. 'R') THEN
101          IF (kx .EQ. 1) THEN
102              pxi = px(kx,ky)
103              pxs = 0.5 * (px(kx,ky) + px(kx+1,ky))
104            ELSE IF (kx .EQ. kngx) THEN
105              pxi = 0.5 * (px(kx-1,ky) + px(kx,ky))
106              pxs = px(kx,ky)
107            ELSE
108              pxi = 0.5 * (px(kx-1,ky) + px(kx,ky))
109              pxs = 0.5 * (px(kx,ky) + px(kx+1,ky))
110          ENDIF
111      END IF
112C
113C
114C*    2. Bottom or top (idem for both types of grid) 
115C        -------------------------------------------
116C True only if it is a global grid in latitude [-90 , 90]
117C or as it is the case for regional models if the first and last 
118C latitude row are masked ---> then we only go through the else statement.
119C
120      IF (ky .EQ. 1) THEN
121          pyi = -90.
122          pys = 0.5 * (py(kx,ky) + py(kx,ky+1))
123        ELSE IF (ky .EQ. kngy) THEN
124          pyi = 0.5 * (py(kx,ky-1) + py(kx,ky))
125          pys = 90.
126        ELSE
127          pyi = 0.5 * (py(kx,ky-1) + py(kx,ky))
128          pys = 0.5 * (py(kx,ky)+ py(kx,ky+1))
129      ENDIF
130C
131C* End of routine
132C
133      RETURN
134      END
135
Note: See TracBrowser for help on using the repository browser.