source: CPL/oasis3/trunk/src/lib/anaisg/src/qlsst.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: 2.8 KB
Line 
1       SUBROUTINE qlsst (pqta, prho, kto, kwg, knga, pqtb,
2     $                   kngb, kmska, kvma)
3C****
4C               *****************************
5C               * OASIS ROUTINE  -  LEVEL 3 *
6C               * -------------     ------- *
7C               *****************************
8C
9C**** *qlsst* - Interpolate a field with a ponderation technique
10C
11C     Purpose:
12C     -------
13C     Given the weights prho and indices kto of field pqtb on a source grid,
14C     performs a ponderation to generate pqta on target grid.
15C 
16C     N.B: Nothing is done for the masked points 
17C     
18C**   Interface:
19C     ---------
20C       *CALL* *qlsst*(pqta, prho, kto, kwg, knga, pqtb, kngb,
21C                      kmska, pmask, kvma)*
22C
23C     Input:
24C     -----
25C               prho: array, the weights
26C               kto: array, the indices in source grid
27C               kwg: the number of neighbors
28C               knga: the target grid size
29C               pqtb: array, the field on source grid
30C               kngb: the source grid size
31C               kmska: mask of the target grid
32C               kvma:  value of the mask on target grid
33C
34C     Output:
35C     ------
36C               pqta: array, the field to calculate
37C
38C     Workspace:
39C     ---------
40C     None
41C
42C     External:
43C     --------
44C     None
45C
46C     References:
47C     ----------
48C     O. Thual, Simple ocean-atmosphere interpolation. 
49C               Part A: The method, EPICOA 0629 (1992)
50C               Part B: Software implementation, EPICOA 0630 (1992)
51C     See also OASIS manual (1995)
52C
53C     History:
54C     -------
55C       Version   Programmer     Date      Description
56C       -------   ----------     ----      ----------- 
57C       1.0       O. Thual       93/04/15  created 
58C       1.1       E. Guilyardi   93/11/23  modified
59C       2.0       L. Terray      95/10/01  modified: new structure
60C
61C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
62C
63C* ---------------------------- Include files ---------------------------
64C
65      USE mod_kinds_oasis
66      USE mod_unit
67C
68C* ---------------------------- Argument declarations -------------------
69C
70      REAL (kind=ip_realwp_p) pqtb(kngb), pqta(knga), prho(kwg,knga)
71      INTEGER (kind=ip_intwp_p) kmska(knga), kto(kwg,knga)
72C
73C* ---------------------------- Poema verses ----------------------------
74C
75C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
76C 
77C*    1. Ponderation
78C        -----------
79C
80      DO 110 j1 = 1, knga
81C
82C* Nothing happens if it is a continental point
83C
84        IF (kmska(j1) .NE. kvma) THEN
85            zsum = 0.
86            DO 120 j2 = 1, kwg
87              zsum = zsum + prho(j2,j1) * pqtb(kto(j2,j1))
88 120        CONTINUE
89            pqta(j1) = zsum
90        ENDIF
91 110  CONTINUE
92C
93C* End of routine
94C
95      RETURN
96      END
Note: See TracBrowser for help on using the repository browser.