source: CPL/oasis3/trunk/src/mod/oasis3/src/mod_intlin.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: 5.2 KB
Line 
1      MODULE mod_intlin
2      CONTAINS
3      SUBROUTINE intlin ( pin, pax, pay, ki, kj,
4     $                   pout, px, py, kpts, ldvect)
5C****
6C               *****************************
7C               * OASIS ROUTINE  -  LEVEL 3 *
8C               * -------------     ------- *
9C               *****************************
10C
11C**** *intlin* - Interface for bilinear interpolation
12C
13C     Purpose:
14C     -------
15C     Interpolates field with bilinear scheme
16C     Source grid : global periodic grid, longitude/latitude, possibly irregular
17C     Target grid : any
18C
19C**   Interface:
20C     ---------
21C       *CALL*  *intlin* ( pin, pax, pay, ki, kj,
22C     $                  pout, px, py, kpts, ldvect)
23C
24C     Input:
25C     -----
26C                pin       : input field on source grid
27C                pax       : longitudes of source grid
28C                pay       : latitudes of source grid
29C                ki, kj    : dimension of source grid
30C                px        : longitude of target grid
31C                py        : latitudes of target grid
32C                kpts      : dimension of target grid
33C                ldvect    : flag for vector fields               
34C
35C     Output:
36C     ------
37C                poutp     : output field on target grid (real 2D)
38C
39C     Workspace:
40C     ---------
41C     Automatic arrays (sorry: not doctor)
42C               kndx, kndy : index of target point in source grid
43C               zt         : extended input field
44C               plx        : extended longitudes of source grid
45C               ply        : extended latitudes of source grid
46C     Local variables
47C               zsgn, xmin, xmax, ymin, ymax, ji, jj
48C
49C     Externals:
50C     ---------
51C     findlin, bilin
52C
53C     Reference:
54C     ---------
55C     See OASIS manual (1995)
56C
57C     History:
58C     -------
59C       Version   Programmer     Date      Description
60C       -------   ----------     ----      ----------- 
61C       2.0       O. Marti       96/07/15  Created
62C
63C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
64C
65      USE mod_findlin
66      USE mod_bilin
67CAC
68      USE mod_unit
69CAC
70C
71      IMPLICIT NONE
72C
73C* ---------------------------- Include files ---------------------------
74C
75C
76CAC      INCLUDE 'unit.h'
77C
78C* ---------------------------- Argument declarations -------------------
79C
80      INTEGER, INTENT ( in) :: ki, kj
81      REAL, DIMENSION ( ki, kj), INTENT ( in) :: pin
82      REAL, DIMENSION ( ki), INTENT ( in) :: pax 
83      REAL, DIMENSION ( kj), INTENT ( in) :: pay
84      LOGICAL, INTENT ( in) :: ldvect
85      INTEGER, INTENT ( in) :: kpts
86      REAL, DIMENSION ( kpts), INTENT ( inout) :: px, py
87      REAL, DIMENSION ( kpts), INTENT ( out) :: pout
88C
89C* ---------------------------- Local declarations ----------------------
90C
91      REAL, DIMENSION ( 0: ki + 1, 0: kj + 1) :: zt
92      REAL, DIMENSION ( 0: ki + 1) :: plx
93      REAL, DIMENSION ( 0: kj + 1) :: ply
94      INTEGER, DIMENSION ( kpts) :: kndx, kndy
95      LOGICAL :: llnorth, llsouth
96      REAL    :: zsgn, xmin, xmax, ymin, ymax
97      INTEGER :: ji, jj
98C
99C* ---------------------------- Poema verses ----------------------------
100C
101C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
102C
103C*    1. Initialization
104C        --------------
105C
106      WRITE (UNIT = nulou,FMT = *) ' '
107      WRITE (UNIT = nulou,FMT = *) ' '
108      WRITE (UNIT = nulou,FMT = *) 
109     $    '           ROUTINE intlin  -  Level 3'
110      WRITE (UNIT = nulou,FMT = *) 
111     $    '           **************     *******'
112      WRITE (UNIT = nulou,FMT = *) ' '
113      WRITE (UNIT = nulou,FMT = *) 
114     $    ' Bilinear nterpolation package '
115      WRITE (UNIT = nulou,FMT = *) ' '
116      WRITE (UNIT = nulou,FMT = *) ' '
117C
118C* Print some informations on source grid
119C
120      xmin = MINVAL ( pax) ; xmax = MAXVAL ( pax)
121      ymin = MINVAL ( pay) ; ymax = MAXVAL ( pay)
122C     
123      WRITE (UNIT = nulou,FMT = *) 
124     $    'Source grid longitude extremas : ', xmin, xmax
125      WRITE (UNIT = nulou,FMT = *) 
126     $    'Source grid latitude  extremas : ', ymin, ymax
127C
128C*    2. Interpolation
129C        -------------
130C
131C* Seek position of target points in source grid
132C
133      CALL findlin ( px, py, kpts, pax, pay, ki, kj,
134     $    kndx, kndy, plx, ply, llnorth, llsouth)
135C
136C* Extend source field
137C
138      zt ( 1:ki, 1:kj) = pin ( :, :)
139C
140C* Periodicity
141C
142      zt (    0  , 1:kj ) = pin ( ki    , 1:kj )
143      zt ( ki + 1, 1:kj ) = pin (   1   , 1:kj )
144C
145C * Filling near poles
146C
147      zsgn = 1.0
148      IF ( ldvect ) zsgn = -1.0
149      IF ( llsouth ) THEN
150          zt ( 0: ki + 1,  0) = zsgn * zt ( 0: ki + 1, 2)
151      ELSE
152          zt ( 0: ki + 1,  0) = zsgn * zt ( 0: ki + 1, 1)
153      ENDIF
154      IF ( llnorth ) THEN
155          zt ( 0: ki + 1, kj + 1) = zsgn * zt ( -1: ki + 1, kj - 1)
156      ELSE
157          zt ( 0: ki + 1, kj + 1) = zsgn * zt ( -1: ki + 1, kj)
158      END IF
159C
160C* Interpolates
161C
162      CALL bilin ( pout, px, py, kndx, kndy, plx, ply, kpts 
163     $    ,        zt, ki, kj)
164C
165C*    3. End of routine
166C        --------------
167      WRITE (UNIT = nulou,FMT = *) ' '
168      WRITE (UNIT = nulou,FMT = *) 
169     $    '          --------- End of routine intlin ---------'
170      CALL FLUSH (nulou)
171      RETURN
172      END SUBROUTINE intlin
173      END MODULE mod_intlin
Note: See TracBrowser for help on using the repository browser.