source: CPL/oasis3/trunk/src/lib/anaism/src/namsst.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: 3.7 KB
Line 
1      SUBROUTINE namsst (pflda, kmska, kvmska, kngxa, kngya,
2     $                   prbtoa, kbtoa, kwbtoa,
3     $                   pfldb, kngxb, kngyb)
4C****
5C               *****************************
6C               * OASIS ROUTINE  -  LEVEL 3 *
7C               * -------------     ------- *
8C               *****************************
9C
10C**** *namsst* -  Interpolation  Anaism method 
11C
12C     Purpose:
13C     -------
14C     Performs subgrid averaged interpolation
15C
16C**   Interface:
17C     ---------
18C       *CALL*  *namsst(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 Anaism interpolation (real 2D)
29C                kbtoa  : source grid neighbors adresses (integer 2D)
30C                kwbtoa : maximum number of overlapped 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     plsst
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. Initialization
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 namsst  -  Level 3'
89          WRITE(UNIT = nulou,FMT = *) 
90     $    '           **************     *******'
91          WRITE(UNIT = nulou,FMT = *) ' '
92          WRITE(UNIT = nulou,FMT = *) 
93     $    ' Perform ANAIS-MESH interpolation'
94          WRITE(UNIT = nulou,FMT = *) ' '
95          WRITE(UNIT = nulou,FMT = *) ' '
96      ENDIF
97      inga = kngxa *kngya
98      ingb = kngxb *kngyb
99C
100C
101C*    2. Call interpolator
102C        -----------------
103C
104      CALL plsst (pflda, prbtoa, kbtoa, kwbtoa, inga, pfldb,
105     $            ingb, kmska, kvmska)
106C
107C
108C*    3. End of routine
109C        --------------
110C
111      IF (nlogprt .GE. 2) THEN
112          WRITE (UNIT = nulou,FMT = *) ' '
113          WRITE (UNIT = nulou,FMT = *) 
114     $    '          --------- End of routine namsst ---------'
115          CALL FLUSH (nulou)
116      ENDIF
117      RETURN
118      END
Note: See TracBrowser for help on using the repository browser.