doc-doxygen/html/plsst_8f_source.html

00001        SUBROUTINE plsst (pqta, prho, kto, kwg, knga, pqtb,
00002      $                   kngb, kmska, kvma)
00003 C****
00004 C               *****************************
00005 C               * OASIS ROUTINE  -  LEVEL 3 *
00006 C               * -------------     ------- *
00007 C               *****************************
00008 C
00009 C**** *plsst* -  Perform subgrid interpolation through Anaism method
00010 C
00011 C     Purpose:
00012 C     -------
00013 C     Given the weights prho and indices kto for field pqtb, performs
00014 C     a surface ponderation to generate field pqta on target grid.
00015 C
00016 C     N.B: Nothing is done for the masked points
00017 C
00018 C**   Interface:
00019 C     ---------
00020 C       *CALL*  *plsst(pqta, prho, kto, kwg, knga, pqtb,
00021 C                      kngb, kmska, kvma)*
00022 C
00023 C     Input:
00024 C     -----
00025 C                kmska : mask for target grid (integer 1D)
00026 C                kvma  : the value of the mask for target grid
00027 C                knga  : number of points for target grid
00028 C                prho  : weights for Anaism interpolation (real 2D)
00029 C                kto   : source grid neighbors adresses (integer 2D)
00030 C                kwg   : maximum number of overlapped neighbors
00031 C                pqtb  : field on source grid (real 1D)
00032 C                kngb  : number of points for source grid
00033 C
00034 C     Output:
00035 C     ------
00036 C                pqta  : field on target grid (real 1D)
00037 C
00038 C     Workspace:
00039 C     ---------
00040 C     None
00041 C
00042 C     External:
00043 C     --------
00044 C     None
00045 C
00046 C     References:
00047 C     ----------
00048 C     O. Thual, Simple ocean-atmosphere interpolation.
00049 C               Part A: The method, EPICOA 0629 (1992)
00050 C               Part B: Software implementation, EPICOA 0630 (1992)
00051 C     See also OASIS manual (1995)
00052 C
00053 C     History:
00054 C     -------
00055 C       Version   Programmer     Date      Description
00056 C       -------   ----------     ----      -----------
00057 C       1.1       O. Thual       93/04/15  created
00058 C       2.0       L. Terray      95/10/01  modified: new structure
00059 C
00060 C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
00061 C
00062 C* ---------------------------- Include files ---------------------------
00063 C
00064       USE mod_unit
00065 C
00066 C* ---------------------------- Argument declarations -------------------
00067 C
00068       REAL (kind=ip_realwp_p) pqtb(kngb), pqta(knga), prho(kwg,knga)
00069       INTEGER (kind=ip_intwp_p) kmska(knga), kto(kwg,knga)
00070 C
00071 C* ---------------------------- Poema verses ----------------------------
00072 C
00073 C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
00074 C
00075       IF (nlogprt .GE. 2) THEN
00076           WRITE(nulou,*) '***** * Entering ROUTINE plsst ******* '
00077           CALL FLUSH(nulou)
00078       ENDIF
00079 C
00080 C*     1. Ponderation
00081 C         -----------
00082 C* Loop over all target grid points
00083 C
00084       DO 110 j1 = 1, knga
00085 C
00086 C* Nothing happens if it is a continental point
00087 C
00088         IF (kmska(j1) .NE. kvma) THEN
00089             zsum = 0.
00090 C
00091 C* Ponderation over all overlapped source grid neighbors
00092 C
00093             DO 120 j2 = 1, kwg
00094               zsum = zsum + prho(j2,j1) * pqtb(kto(j2,j1))
00095  120        CONTINUE
00096             pqta(j1) = zsum
00097         ENDIF
00098  110  CONTINUE
00099 C
00100       IF (nlogprt .GE. 2) THEN
00101           WRITE(nulou,*) '***** * Entering ROUTINE plsst ******* '
00102           CALL FLUSH(nulou)
00103       ENDIF
00104 C
00105 C* End of routine
00106 C
00107       RETURN
00108       END