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

Go to the documentation of this file.
00001 !     #####################################################
00002       SUBROUTINE GET_SURF_MASK_n(HTYPE,KDIM,KMASK,KLU,KLUOUT)
00003 !     #####################################################
00004 !
00005 !!****  *GET_SURF_MASK_n* - routine to define the masks between all surface 
00006 !!    points and each of the four surface types
00007 !!
00008 !!    PURPOSE
00009 !!    -------
00010 !!
00011 !!**  METHOD
00012 !!    -------
00013 !!
00014 !!    REFERENCE
00015 !!    ---------
00016 !!
00017 !!
00018 !!    AUTHOR
00019 !!    ------
00020 !!      V. Masson    *Meteo France*     
00021 !!
00022 !!    MODIFICATIONS
00023 !!    -------------
00024 !!      Original    01/2004
00025 !-------------------------------------------------------------------------------
00026 !
00027 !*       0.    DECLARATIONS
00028 !              ------------
00029 !
00030 USE MODD_SURF_ATM_n, ONLY : XCOVER, XNATURE, XSEA, XTOWN, XWATER
00031 USE MODD_SURf_PAR,   ONLY : NUNDEF
00032 !
00033 USE MODI_CONVERT_COVER_FRAC
00034 !
00035 !
00036 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00037 USE PARKIND1  ,ONLY : JPRB
00038 !
00039 USE MODI_ABOR1_SFX
00040 !
00041 USE MODI_GET_1D_MASK
00042 !
00043 IMPLICIT NONE
00044 !
00045 !*       0.1   Declarations of arguments
00046 !              -------------------------
00047 !
00048  CHARACTER(LEN=*),  INTENT(IN)    :: HTYPE    ! Type of surface
00049 INTEGER, INTENT(IN)              :: KDIM     ! dimension of mask
00050 INTEGER, DIMENSION(KDIM), INTENT(OUT) :: KMASK    ! mask for reading of the files
00051 INTEGER, INTENT(INOUT)           :: KLU      ! expected physical size of full surface array
00052 INTEGER, INTENT(IN)              :: KLUOUT   ! output listing logical unit 
00053 !
00054 !*       0.2   Declarations of local variables
00055 !              -------------------------------
00056 !
00057 INTEGER           :: ILU    ! total horizontal size
00058 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00059 !-------------------------------------------------------------------------------
00060 !
00061 !*       1.     Dimension initializations:
00062 !               -------------------------
00063 !
00064 IF (LHOOK) CALL DR_HOOK('GET_SURF_MASK_N',0,ZHOOK_HANDLE)
00065 IF (.NOT. ASSOCIATED(XCOVER)) THEN
00066   CALL GET_MASK(KLU,'FULL',KMASK)
00067   IF (LHOOK) CALL DR_HOOK('GET_SURF_MASK_N',1,ZHOOK_HANDLE)
00068   RETURN
00069 END IF
00070 !
00071 !-------------------------------------------------------------------------------
00072 !
00073 !*        2.    Fractions
00074 !              ---------
00075 !
00076 ILU = SIZE(XCOVER,1)
00077 !
00078 IF (KLU==NUNDEF .OR. KLU==0) KLU = ILU
00079 !
00080 IF (ILU/=KLU) THEN
00081   WRITE(KLUOUT,*) 'Error in initialization of masks for reading or writing'
00082   WRITE(KLUOUT,*) 'size expected for reading/writing from atmosphere files : ',KLU
00083   WRITE(KLUOUT,*) 'size of surface array in module MODD_SURF_ATM           : ',ILU
00084   CALL ABOR1_SFX('GET_SURF_MASK: ERROR IN INITIALIZATION OF MASK FOR READING OR WRITING')
00085 END IF
00086 !
00087  CALL GET_MASK(ILU,HTYPE,KMASK)
00088 !
00089 IF (LHOOK) CALL DR_HOOK('GET_SURF_MASK_N',1,ZHOOK_HANDLE)
00090 !-------------------------------------------------------------------------------
00091 CONTAINS
00092 !
00093 SUBROUTINE GET_MASK(KLU,YTYPE,IMASK)
00094 !
00095 IMPLICIT NONE
00096 !
00097 INTEGER, INTENT(IN) :: KLU
00098  CHARACTER(LEN=*),  INTENT(IN)  :: YTYPE    ! Type of surface
00099 INTEGER, DIMENSION(:), INTENT(OUT) :: IMASK
00100 !
00101 REAL, DIMENSION(KLU) :: ZSEA   ! sea cover
00102 REAL, DIMENSION(KLU) :: ZNATURE! nature cover
00103 REAL, DIMENSION(KLU) :: ZTOWN  ! town cover
00104 REAL, DIMENSION(KLU) :: ZWATER ! water cover
00105 REAL, DIMENSION(KLU) :: ZLAND  ! land cover
00106 REAL, DIMENSION(KLU) :: ZSURF
00107 INTEGER :: ILU2
00108 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00109 !
00110 IF (LHOOK) CALL DR_HOOK('GET_SURF_MASK_N:GET_MASK',0,ZHOOK_HANDLE)
00111 !
00112 IF (YTYPE.NE.'FULL' .AND. YTYPE.NE.'EXTZON') THEN
00113   !      
00114   IF (.NOT. ASSOCIATED(XSEA)) THEN
00115     CALL CONVERT_COVER_FRAC(XCOVER,ZSEA,ZNATURE,ZTOWN,ZWATER)
00116   ELSE
00117     ZSEA    = XSEA
00118     ZNATURE = XNATURE
00119     ZWATER  = XWATER
00120     ZTOWN   = XTOWN
00121   END IF
00122   ZLAND =  ZNATURE + ZTOWN
00123   !
00124   SELECT CASE (YTYPE)
00125     CASE ('NATURE')
00126       ZSURF = ZNATURE
00127     CASE ('SEA')
00128       ZSURF = ZSEA
00129     CASE ('TOWN')
00130       ZSURF = ZTOWN
00131     CASE ('WATER')
00132       ZSURF = ZWATER
00133     CASE ('LAND')
00134       ZSURF = ZLAND
00135   END SELECT
00136   !
00137   ILU2 = COUNT(ZSURF(:) > 0.)
00138   !
00139 ELSE
00140   !
00141   ZSURF(:) = 1.
00142   ILU2 = KLU
00143   !
00144 ENDIF
00145 !
00146  CALL GET_1D_MASK(ILU2,KLU,ZSURF,IMASK)
00147 !
00148 IF (LHOOK) CALL DR_HOOK('GET_SURF_MASK_N:GET_MASK',1,ZHOOK_HANDLE)
00149 !
00150 END SUBROUTINE GET_MASK
00151 !
00152 END SUBROUTINE GET_SURF_MASK_n