doc-doxygen/html/masq_8f_source.html

00001       SUBROUTINE masq (pfild, ksize, pmask, kmask)
00002 C****
00003 C               *****************************
00004 C               * OASIS ROUTINE  -  LEVEL 3 *
00005 C               * -------------     ------- *
00006 C               *****************************
00007 C
00008 C**** *masq* - Mask routine
00009 C
00010 C     Purpose:
00011 C     -------
00012 C     Mask field with chosen value
00013 C
00014 C**   Interface:
00015 C     ---------
00016 C       *CALL*  *masq (pfild, ksize, pmask, kmask)*
00017 C
00018 C     Input:
00019 C     -----
00020 C                pfild : field to be masked (real 1D)
00021 C                ksize : array size
00022 C                pmask : mask value given from input
00023 C                kmask : mask array : 0 ---> ocean , 1 ---> land (integer 1D)
00024 C
00025 C     Output:
00026 C     ------
00027 C                pfild : field masked (real 1D)
00028 C
00029 C     Workspace:
00030 C     ---------
00031 C     None
00032 C
00033 C     Externals:
00034 C     ---------
00035 C     cvmgp
00036 C
00037 C     Reference:
00038 C     ---------
00039 C     See OASIS manual (1995)
00040 C
00041 C     History:
00042 C     -------
00043 C       Version   Programmer     Date      Description
00044 C       -------   ----------     ----      -----------
00045 C       1.0       L. Terray      94/01/01  created
00046 C       2.0beta   L. Terray      95/10/01  modified: new structure
00047 C       2.0       L. Terray      96/02/01  modified: suppression of file
00048 C                                                    doctor.h
00049 C       2.3       S. Valcke      99/04/30  added: printing levels
00050 C       2.5       S. Valcke      2K/09/04  Remove cmach and cvmgp
00051 C
00052 C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
00053 C
00054 C* ---------------------------- Include files ---------------------------
00055 C
00056       USE mod_kinds_oasis
00057       USE mod_unit
00058       USE mod_hardware
00059       USE mod_printing
00060 C
00061 C* ---------------------------- Argument declarations -------------------
00062 C
00063       REAL (kind=ip_realwp_p) pfild(ksize)
00064       INTEGER (kind=ip_intwp_p) kmask(ksize)
00065 C
00066 C* ---------------------------- Poema verses ----------------------------
00067 C
00068 C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
00069 C
00070 C*    1. Initialization
00071 C        --------------
00072 C
00073       IF (nlogprt .GE. 2) THEN
00074           WRITE (UNIT = nulou,FMT = *)' '
00075           WRITE (UNIT = nulou,FMT = *)'        ROUTINE masq  -  Level 3'
00076           WRITE (UNIT = nulou,FMT = *)'        ************     *******'
00077           WRITE (UNIT = nulou,FMT = *)' '
00078           WRITE (UNIT = nulou,FMT = *)' Mask field with input value'
00079           WRITE (UNIT = nulou,FMT = *)' '
00080           CALL FLUSH(nulou)
00081       ENDIF
00082 C
00083 C
00084 C*    2. Mask field with value
00085 C        ---------------------
00086 C
00087       DO 220 jk = 1, ksize
00088         ztest = float(1 - kmask(jk)) -.5
00089         IF (ztest .LT. 0.) pfild(jk) = pmask
00090  220  CONTINUE
00091 C
00092 C
00093 C*    3. End of routine
00094 C        --------------
00095 C
00096       IF (nlogprt .GE. 2) THEN
00097           WRITE (UNIT = nulou,FMT = *) ' '
00098           WRITE (UNIT = nulou,FMT = *)
00099      $    '          --------- End of ROUTINE masq ---------'
00100           CALL FLUSH (nulou)
00101       ENDIF
00102       RETURN
00103       END