source: CPL/oasis3/trunk/src/lib/anaisg/src/nagsst.f @ 1677

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

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

File size: 3.8 KB
Line 
1      SUBROUTINE nagsst (pflda, kmska, kvmska, kngxa, kngya,
2     $                   prbtoa, kbtoa, kwbtoa,
3     $                   pfldb, kngxb, kngyb)
4C****
5C               *****************************
6C               * OASIS ROUTINE  -  LEVEL 3 *
7C               * -------------     ------- *
8C               *****************************
9C
10C**** *nagsst* -  Interpolation  Anais-global  without constraints 
11C
12C     Purpose:
13C     -------
14C     Interpolate with a nearest neighbor method
15C
16C**   Interface:
17C     ---------
18C       *CALL*  *nagsst(pflda, kmska, kvmska, kngxa, kngya,
19C                       prbtoa, kbtoa, kwbtoa,
20C                       pfldb, kngxb, kngyb)*
21C
22C     Input:
23C     -----
24C                kmska  : mask for target grid (integer 2D)
25C                kvmska : the value of the mask for target grid
26C                kngxa  : number of longitudes for target grid
27C                kngya  : number of latitudes for target grid
28C                prbtoa : weights for Anaisg interpolation (real 2D)
29C                kbtoa  : source grid neighbors adresses (integer 2D)
30C                kwbtoa : maximum number of nearest neighbors
31C                pfldb  : field on source grid (real 2D)
32C                kngxb  : number of longitudes for source grid
33C                kngyb  : number of latitudes for source grid
34C
35C     Output:
36C     ------
37C                pflda: field on target grid (real 2D)
38C
39C     Workspace:
40C     ---------
41C     None
42C
43C     External:
44C     --------
45C     qlsst
46C
47C     References:
48C     ----------
49C     O. Thual, Simple ocean-atmosphere interpolation. 
50C               Part A: The method, EPICOA 0629 (1992)
51C               Part B: Software implementation, EPICOA 0630 (1992)
52C     See also OASIS manual (1995)
53C
54C     History:
55C     -------
56C       Version   Programmer     Date      Description
57C       -------   ----------     ----      ----------- 
58C       1.1       O. Thual       93/04/15  created 
59C       2.0       L. Terray      95/10/01  modified: new structure
60C       2.3       S. Valcke      99/04/30  added: printing levels
61C
62C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
63C
64C* ---------------------------- Include files ---------------------------
65C
66      USE mod_kinds_oasis
67      USE mod_unit
68      USE mod_printing
69C
70C* ---------------------------- Argument declarations -------------------
71C     
72      REAL (kind=ip_realwp_p) pflda(kngxa,kngya), pfldb(kngxb,kngyb)
73      REAL (kind=ip_realwp_p) prbtoa(kwbtoa,kngxb*kngyb)
74      INTEGER (kind=ip_intwp_p) kmska(kngxa,kngya), 
75     $    kbtoa(kwbtoa,kngxb*kngyb)
76C
77C* ---------------------------- Poema verses ----------------------------
78C
79C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
80C
81C*    1. Initializations and checkings
82C        -----------------------------
83C
84      IF (nlogprt .GE. 2) THEN
85          WRITE (UNIT = nulou,FMT = *) ' '
86          WRITE (UNIT = nulou,FMT = *) ' '
87          WRITE (UNIT = nulou,FMT = *) 
88     $    '           ROUTINE nagsst  -  Level 3'
89          WRITE (UNIT = nulou,FMT = *) 
90     $    '           **************     *******'
91          WRITE (UNIT = nulou,FMT = *) ' '
92          WRITE (UNIT = nulou,FMT = *) 
93     $    ' Does Anais-global interpolation'
94          WRITE (UNIT = nulou,FMT = *) ' '
95          WRITE (UNIT = nulou,FMT = *) ' '
96      ENDIF
97C
98C* Define global dimensions
99C
100      inga = kngxa * kngya
101      ingb = kngxb * kngyb
102C
103C
104C*    2. Interpolation
105C        -------------
106C
107      CALL qlsst (pflda, prbtoa, kbtoa, kwbtoa, inga, pfldb,
108     $            ingb, kmska, kvmska)
109C
110C
111C*    3. End of routine
112C        --------------
113C
114      IF (nlogprt .GE. 2) THEN
115          WRITE (UNIT = nulou,FMT = *) ' '
116          WRITE (UNIT = nulou,FMT = *) 
117     $    '          --------- End of routine nagsst ---------'
118          CALL FLUSH (nulou)
119      ENDIF
120      RETURN
121      END
Note: See TracBrowser for help on using the repository browser.