SURFEX v7.3: /home/dasprezs/EXPORT_v7_3/src/SURFEX/get_1d

Go to the documentation of this file.
00001 SUBROUTINE GET_1D_MASK(KSIZE,KFRAC,PFRAC,KMASK)
00002 !!
00003 !!    PURPOSE
00004 !!    -------
00005 !     Create a surface mask which is 1D in space
00006 !!
00007 !!    AUTHOR
00008 !!    ------
00009 !!     A. Boone
00010 !!
00011 !!    MODIFICATIONS
00012 !!    -------------
00013 !!      Original    01/2003
00014 !!------------------------------------------------------------------
00015 !
00016 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00017 USE PARKIND1  ,ONLY : JPRB
00018 !
00019 IMPLICIT NONE
00020 !
00021 !*      0.1    declarations of arguments
00022 !
00023 INTEGER, INTENT(IN)                      :: KSIZE
00024 INTEGER, INTENT(IN)                      :: KFRAC
00025 REAL, DIMENSION(KFRAC), INTENT(IN)       :: PFRAC
00026 !
00027 INTEGER, DIMENSION(KSIZE), INTENT(OUT)   :: KMASK
00028 !
00029 !*      0.2    declarations of local variables
00030 !
00031 INTEGER                                  :: JI, JJ
00032 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00033 !
00034 !-------------------------------------------------------------------------------
00035 !
00036 IF (LHOOK) CALL DR_HOOK('GET_1D_MASK',0,ZHOOK_HANDLE)
00037 KMASK(:)            = 0
00038 JI                  = 0
00039 DO JJ=1,SIZE(PFRAC)
00040    IF(PFRAC(JJ) > 0.0)THEN
00041       JI            = JI + 1
00042       KMASK(JI)     = JJ
00043    ENDIF
00044 ENDDO
00045 IF (LHOOK) CALL DR_HOOK('GET_1D_MASK',1,ZHOOK_HANDLE)
00046 !
00047 !-------------------------------------------------------------------------------
00048 !
00049 END SUBROUTINE GET_1D_MASK