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

Go to the documentation of this file.
00001 !     ########################################
00002       SUBROUTINE PUT_ZS_n(HPROGRAM,KI,PZS)
00003 !     ########################################
00004 !
00005 !!****  *PUT_ZS_n* - routine to modify surface oropgraphy of each tile using atmospheric
00006 !                    model orography
00007 !!
00008 !!    PURPOSE
00009 !!    -------
00010 !!
00011 !!**  METHOD
00012 !!    ------
00013 !!
00014 !!    EXTERNAL
00015 !!    --------
00016 !!
00017 !!
00018 !!    IMPLICIT ARGUMENTS
00019 !!    ------------------
00020 !!
00021 !!    REFERENCE
00022 !!    ---------
00023 !!
00024 !!
00025 !!    AUTHOR
00026 !!    ------
00027 !!      V. Masson   *Meteo France*      
00028 !!
00029 !!    MODIFICATIONS
00030 !!    -------------
00031 !!      Original     01/2004
00032 !!      P. Le Moigne 05/2007: write model orography over each tile
00033 !-------------------------------------------------------------------------------
00034 !      
00035 USE MODD_SURF_ATM_n, ONLY : NSIZE_WATER, NSIZE_TOWN, NSIZE_NATURE, &
00036                             NR_WATER,    NR_TOWN,    NR_NATURE,    &
00037                             CWATER, NSIZE_SEA, NR_SEA,             &
00038                             CSEA, CNATURE, CWATER, CTOWN,          &
00039                             NDIM_FULL, NSIZE_FULL, XNATURE, XSEA,  &
00040                             XWATER, XTOWN
00041 !
00042 !*       0.    DECLARATIONS
00043 !              ------------
00044 !
00045 !
00046 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00047 USE PARKIND1  ,ONLY : JPRB
00048 !
00049 USE MODI_PUT_ZS_INLAND_WATER_n
00050 !
00051 USE MODI_PUT_ZS_NATURE_n
00052 !
00053 USE MODI_PUT_ZS_SEA_n
00054 !
00055 USE MODI_PUT_ZS_SURF_ATM_n
00056 !
00057 USE MODI_PUT_ZS_TOWN_n
00058 USE MODI_GET_SIZE_FULL_n
00059 USE MODI_GET_1D_MASK
00060 !
00061 IMPLICIT NONE
00062 !
00063 !*       0.1   Declarations of arguments
00064 !              -------------------------
00065 !
00066  CHARACTER(LEN=6),    INTENT(IN)  :: HPROGRAM
00067 INTEGER,             INTENT(IN)  :: KI      ! horizontal dim. of cover
00068 REAL, DIMENSION(KI), INTENT(IN)  :: PZS     ! orography
00069 !
00070 !
00071 !*       0.2   Declarations of local variables
00072 !              -------------------------------
00073 !
00074 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00075 !
00076 !-------------------------------------------------------------------------------
00077 IF (LHOOK) CALL DR_HOOK('PUT_ZS_N',0,ZHOOK_HANDLE)
00078 !
00079 !*       1. Full surface
00080 !           ------------
00081 !
00082  CALL PUT_ZS_SURF_ATM_n(HPROGRAM,KI,PZS)
00083 !
00084 !*       2. inland water
00085 !           ------------
00086 !
00087 IF (NSIZE_WATER > 0 .AND. CWATER/='NONE' .AND. CWATER/='FLUX') CALL PACK_ZS(NSIZE_WATER,NR_WATER,'W')
00088 !
00089 !*       3. nature
00090 !           ------
00091 !
00092 IF (NSIZE_NATURE > 0 .AND. CNATURE/='NONE' .AND. CNATURE/='FLUX') CALL PACK_ZS(NSIZE_NATURE,NR_NATURE,'N')
00093 !
00094 !*       4. town
00095 !           ----
00096 !
00097 IF (NSIZE_TOWN > 0 .AND. CTOWN/='NONE' .AND. CTOWN/='FLUX') CALL PACK_ZS(NSIZE_TOWN,NR_TOWN,'T')
00098 !
00099 !        5.sea
00100 !           ----
00101 !
00102 IF (NSIZE_SEA > 0 .AND. CSEA/='NONE' .AND. CSEA/='FLUX') CALL PACK_ZS(NSIZE_SEA,NR_SEA,'S')
00103 !
00104 IF (LHOOK) CALL DR_HOOK('PUT_ZS_N',1,ZHOOK_HANDLE)
00105 !
00106 CONTAINS
00107 !=======================================================================================
00108 SUBROUTINE PACK_ZS(KSIZE,KMASK,YTYPE)
00109 !
00110 INTEGER, INTENT(IN)               :: KSIZE
00111 INTEGER, POINTER, DIMENSION(:)    :: KMASK
00112  CHARACTER(LEN=1), INTENT(IN)      :: YTYPE
00113 !
00114 REAL, DIMENSION(KSIZE) :: ZP_ZS
00115 INTEGER :: JJ
00116 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00117 !
00118 ! input arguments:
00119 !
00120 IF (LHOOK) CALL DR_HOOK('PUT_ZS_N:PACK_ZS',0,ZHOOK_HANDLE)
00121 !
00122 IF (.NOT.ASSOCIATED(KMASK)) THEN
00123   ALLOCATE(KMASK (KSIZE))
00124   IF (KSIZE>0) THEN
00125     CALL GET_SIZE_FULL_n(HPROGRAM,NDIM_FULL,NSIZE_FULL)
00126     IF (YTYPE=='W') THEN
00127       CALL GET_1D_MASK( KSIZE, NSIZE_FULL, XWATER, KMASK)
00128     ELSEIF (YTYPE=='N') THEN
00129       CALL GET_1D_MASK( KSIZE, NSIZE_FULL, XNATURE, KMASK)
00130     ELSEIF (YTYPE=='T') THEN
00131       CALL GET_1D_MASK( KSIZE, NSIZE_FULL, XTOWN, KMASK)
00132     ELSEIF (YTYPE=='S') THEN
00133       CALL GET_1D_MASK( KSIZE, NSIZE_FULL, XSEA, KMASK)
00134     ENDIF     
00135   ENDIF
00136 ENDIF
00137 !
00138 DO JJ=1,KSIZE
00139   ZP_ZS(JJ)         = PZS         (KMASK(JJ))
00140 ENDDO
00141 !
00142 IF (YTYPE=='W') THEN
00143   CALL PUT_ZS_INLAND_WATER_n(HPROGRAM,KSIZE,ZP_ZS,CWATER)
00144 ELSEIF (YTYPE=='N') THEN
00145   CALL PUT_ZS_NATURE_n(HPROGRAM,KSIZE,ZP_ZS)
00146 ELSEIF (YTYPE=='T') THEN
00147   CALL PUT_ZS_TOWN_n(HPROGRAM,KSIZE,ZP_ZS)
00148 ELSEIF (YTYPE=='S') THEN
00149   CALL PUT_ZS_SEA_n(HPROGRAM,KSIZE,ZP_ZS)
00150 ENDIF
00151 !
00152 IF (LHOOK) CALL DR_HOOK('PUT_ZS_N:PACK_ZS',1,ZHOOK_HANDLE)
00153 !
00154 END SUBROUTINE PACK_ZS
00155 !=======================================================================================
00156 !
00157 END SUBROUTINE PUT_ZS_n