source: CPL/oasis3/trunk/src/lib/anaism/src/pminm.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: 6.6 KB
Line 
1      SUBROUTINE pminm (kflag, psurf,
2     $                  p2xi, p2xs, p2yi, p2ys,
3     $                  p1xi, p1xs, p1yi, p1ys)
4C****
5C               *****************************
6C               * OASIS ROUTINE  -  LEVEL 3 *
7C               * -------------     ------- *
8C               *****************************
9C
10C**** *pminm* -  calculate intersection between two meshes
11C
12C     Purpose:
13C     -------
14C     For two meshes defined by their inf. and sup. latitude and
15C     longitude (p1xi,p1xs,p1yi,p1ys) and (p2xi,p2xs,p2yi,p2ys), checks
16C     if they have any intersection and calculates the surface, psurf, 
17C     of that intersection. The 2 grids considered may be periodic
18C     or non-periodic.
19C
20C     N.B: Intersection surface is given by the following formula:
21C          Si = r*r * (sin(lat2)-sin(lat1)) * (phi2-phi1)
22C              with lat2, lat1 sup. and inf. latitudes
23C                   phi2, phi1 sup. and inf. longitudes
24C          This results from the integration of dS=r*r*cos(lat)*d(lat)*d(phi)
25C
26C**   Interface:
27C     ---------
28C       *CALL*  *pminm(kflag, psurf,
29C                      p2xi, p2xs, p2yi, p2ys,
30C                      p1xi, p1xs, p1yi, p1ys)*
31C
32C     Input:
33C     -----
34C                p2xi  : target grid square inferior longitude
35C                p2xs  : target grid square superior longitude
36C                p2yi  : target grid square inferior latitude
37C                p2ys  : target grid square superior latitude
38C                p1xi  : source grid square inferior longitude
39C                p1xs  : source grid square superior longitude
40C                p1yi  : source grid square inferior latitude
41C                p1ys  : source grid square superior latitude
42C
43C     Output:
44C     ------
45C                psurf  : the intersection's surface
46C                kflag  : 1 if intersection is not empty, 0 otherwise
47C
48C     Workspace:
49C     ---------
50C     None
51C
52C     External:
53C     --------
54C     None
55C
56C     References:
57C     ----------
58C     O. Thual, Simple ocean-atmosphere interpolation. 
59C               Part A: The method, EPICOA 0629 (1992)
60C               Part B: Software implementation, EPICOA 0630 (1992)
61C     See also OASIS manual (1995)
62C
63C     History:
64C     -------
65C       Version   Programmer     Date      Description
66C       -------   ----------     ----      ----------- 
67C       1.1       O. Thual       93/04/15  created 
68C       2.0       L. Terray      95/10/01  modified: new structure
69C
70C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
71C
72C* ---------------------------- Include files ---------------------------
73C
74      USE mod_kinds_oasis
75      USE mod_unit
76C
77C* ---------------------------- Poema verses ----------------------------
78C
79C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
80C
81C*    1. Initialization
82C        --------------
83C
84      kflag = 0
85      psurf = 0.
86      z2pi = 2. * acos(-1.)
87      zconv = 1.74532925199432957692e-2
88C
89C* Assign local variables
90C
91      zfi1i = p1xi
92      zfi1s = p1xs
93      zfi2i = p2xi
94      zfi2s = p2xs
95C
96C* Put longitudes in the [0-360] interval to avoid problem in 
97C  surface calculation.
98C
99      IF (p1xi .GE. 360.0) zfi1i = zfi1i - 360.0
100      IF (p1xi .LT. 0. ) zfi1i = zfi1i + 360.0
101      IF (p1xs .GT. 360.0) zfi1s = zfi1s - 360.0
102      IF (p1xs .LE. 0. ) zfi1s = zfi1s + 360.0
103      IF (p2xi .GE. 360.0) zfi2i = zfi2i - 360.0
104      IF (p2xi .LT. 0. ) zfi2i = zfi2i + 360.0
105      IF (p2xs .GT. 360.0) zfi2s = zfi2s - 360.0
106      IF (p2xs .LE. 0. ) zfi2s = zfi2s + 360.0
107C
108C* Conversion degrees to radians
109C
110      zfi1i = zfi1i * zconv
111      zfi1s = zfi1s * zconv
112      zth1i = p1yi * zconv
113      zth1s = p1ys * zconv
114      zfi2i = zfi2i * zconv
115      zfi2s = zfi2s * zconv
116      zth2i = p2yi * zconv
117      zth2s = p2ys * zconv
118C
119C
120C*    2. Check and calculation of intersection
121C        -------------------------------------
122C
123C* Check of latitudinal intersection
124C 
125      IF (zth2s .GT. zth1i .AND. zth2i .LT. zth1s) THEN
126C
127C* Calculate the delta(latitude)
128C
129C* Latitude inf.
130C
131          zlati = amax1(zth2i,zth1i)
132C
133C* Latitude sup.
134C
135          zlats = amin1(zth2s,zth1s)
136C
137C* sin(lat_sup) - sin(lat_inf)
138C
139          zdth = sin(zlats) - sin(zlati)
140C
141C* Check of longitudinal intersection
142C
143          zfi1ir = zfi1i - z2pi
144          zfi2ir = zfi2i - z2pi
145          zfi2sr = zfi2s - z2pi
146C   
147C* Case of a mesh 1 whose minimal longitude zfi1i is less than the
148C  maximal one zfi1s (normal case). The opposite can occur only for
149C  a periodic grid.
150C 
151          IF (zfi1i .LT. zfi1s) THEN
152C
153C - Check if it is similar for mesh 2
154C
155              IF (zfi2i .LT. zfi2s) THEN
156C
157C - If yes, find the intersection
158C
159                  IF (zfi2s .GT. zfi1i .AND. zfi2i .LT. zfi1s) THEN
160                      kflag = 1
161                      zdfi = amin1(zfi2s,zfi1s) - amax1(zfi2i,zfi1i)
162                      psurf = zdth * zdfi
163                  ENDIF
164C
165C - If not, mesh 2 is periodic
166C
167                ELSE IF (zfi2i .GT. zfi2s) THEN
168C
169C - Find intersection in that case
170C 
171                  IF (zfi2s .GT. zfi1i .AND. zfi2ir .LT. zfi1s) THEN
172                      kflag = 1
173                      zdfi = amin1(zfi2s,zfi1s) - zfi1i
174                      psurf = zdth * zdfi
175                  ENDIF
176                  IF (zfi2s .GT. zfi1ir .AND. zfi2i .LT. zfi1s) THEN
177                      kflag = 1
178                      zdfi = amin1(zfi2i,zfi1s) - zfi1i
179                      psurf = zdth * zdfi
180                  ENDIF
181              ENDIF
182          ENDIF
183C
184C* Case of a mesh 1 whose minimal longitude zfi1i is located
185C  on the right of the grid and whose maximum longitude zfi1s
186C  is on the left of the grid. This occurs only for a periodic mesh
187C 
188          IF (zfi1i .GT. zfi1s) THEN
189C
190C - Check for mesh 2
191C
192              IF (zfi2i .LT. zfi2s) THEN
193C
194C - Find intersection
195C
196                  IF (zfi2s .GT. zfi1ir .AND. zfi2i .LT. zfi1s) THEN
197                      kflag = 1
198                      zdfi = amin1(zfi2s,zfi1s) - zfi2i
199                      psurf = zdth * zdfi 
200                    ELSE IF (zfi2sr .GT. zfi1ir .AND. 
201     $                    zfi2ir .LT. zfi1s) THEN
202                      kflag = 1
203                      zdfi = zfi2s - amin1(zfi2i,zfi1i)
204                      psurf = zdth * zdfi
205                  ENDIF
206C
207C - Mesh 2 is periodic
208C
209                ELSE IF (zfi2i .GT. zfi2s) THEN
210C
211C - Find intersection
212C
213                  IF (zfi2s .GT. zfi1ir .AND. zfi2ir .LT. zfi1s) THEN
214                      kflag = 1
215                      zdfi = amin1(zfi2s,zfi1s) - amax1(zfi2ir,zfi1ir)
216                      psurf = zdth * zdfi 
217                  ENDIF
218              ENDIF
219          ENDIF
220      ENDIF
221C
222C* End of routine
223C
224      RETURN
225      END
226
Note: See TracBrowser for help on using the repository browser.