source: CPL/oasis3/trunk/src/lib/anaisg/src/nagsst.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.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.