doc-doxygen/html/qlsst_8f_source.html

00001        SUBROUTINE qlsst (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**** *qlsst* - Interpolate a field with a ponderation technique
00010 C
00011 C     Purpose:
00012 C     -------
00013 C     Given the weights prho and indices kto of field pqtb on a source grid,
00014 C     performs a ponderation to generate 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* *qlsst*(pqta, prho, kto, kwg, knga, pqtb, kngb,
00021 C                      kmska, pmask, kvma)*
00022 C
00023 C     Input:
00024 C     -----
00025 C               prho: array, the weights
00026 C               kto: array, the indices in source grid
00027 C               kwg: the number of neighbors
00028 C               knga: the target grid size
00029 C               pqtb: array, the field on source grid
00030 C               kngb: the source grid size
00031 C               kmska: mask of the target grid
00032 C               kvma:  value of the mask on target grid
00033 C
00034 C     Output:
00035 C     ------
00036 C               pqta: array, the field to calculate
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.0       O. Thual       93/04/15  created
00058 C       1.1       E. Guilyardi   93/11/23  modified
00059 C       2.0       L. Terray      95/10/01  modified: new structure
00060 C
00061 C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
00062 C
00063 C* ---------------------------- Include files ---------------------------
00064 C
00065       USE mod_printing
00066       USE mod_unit
00067 C
00068 C* ---------------------------- Argument declarations -------------------
00069 C
00070       REAL (kind=ip_realwp_p) pqtb(kngb), pqta(knga), prho(kwg,knga)
00071       INTEGER (kind=ip_intwp_p) kmska(knga), kto(kwg,knga)
00072 C
00073 C* ---------------------------- Poema verses ----------------------------
00074 C
00075 C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
00076 C
00077       IF (nlogprt .GE. 2) THEN
00078           WRITE(nulou,*) '***** * Entering ROUTINE qlsst ******* '
00079           CALL FLUSH(nulou)
00080       ENDIF
00081 C
00082 C*    1. Ponderation
00083 C        -----------
00084 C
00085       DO 110 j1 = 1, knga
00086 C
00087 C* Nothing happens if it is a continental point
00088 C
00089         IF (kmska(j1) .NE. kvma) THEN
00090             zsum = 0.
00091             DO 120 j2 = 1, kwg
00092               zsum = zsum + prho(j2,j1) * pqtb(kto(j2,j1))
00093  120        CONTINUE
00094             pqta(j1) = zsum
00095         ENDIF
00096  110  CONTINUE
00097 C
00098       IF (nlogprt .GE. 2) THEN
00099           WRITE(nulou,*) '***** * Leaving ROUTINE qlsst ******* '
00100           CALL FLUSH(nulou)
00101       ENDIF
00102 C* End of routine
00103 C
00104       RETURN
00105       END