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

Go to the documentation of this file.
00001 !     #########
00002       SUBROUTINE TREAT_GLOBAL_LAKE_DEPTH(HPROGRAM,PDEPTH,KSTATUS)
00003 !     ##############################################################
00004 !
00005 !!**** *TREAT_GLOBAL_LAKE_DEPTH* monitor for averaging and interpolations of ISBA physiographic fields
00006 !!
00007 !!    PURPOSE
00008 !!    -------
00009 !!
00010 !!    METHOD
00011 !!    ------
00012 !!   
00013 !
00014 !!    EXTERNAL
00015 !!    --------
00016 !!
00017 !!    IMPLICIT ARGUMENTS
00018 !!    ------------------
00019 !!
00020 !!    REFERENCE
00021 !!    ---------
00022 !!
00023 !!    AUTHOR
00024 !!    ------
00025 !!
00026 !!    S. Faroux        Meteo-France
00027 !!
00028 !!    MODIFICATION
00029 !!    ------------
00030 !!
00031 !!    Original    17/02/11
00032 !!
00033 !----------------------------------------------------------------------------
00034 !
00035 !*    0.     DECLARATION
00036 !            -----------
00037 !
00038 USE MODD_SURF_PAR,       ONLY : XUNDEF
00039 USE MODD_PGD_GRID,       ONLY : NL
00040 USE MODD_PGDWORK,        ONLY : XTNG, NSIZE
00041 USE MODD_SURF_ATM_n,     ONLY : XWATER
00042 USE MODD_DATA_LAKE,      ONLY : CLAKELDB, CSTATUSLDB, NGRADDEPTH_LDB, NGRADSTATUS_LDB 
00043 !
00044 USE MODI_GET_LUOUT
00045 USE MODI_TREAT_FIELD
00046 USE MODI_PACK_SAME_RANK
00047 !
00048 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00049 USE PARKIND1  ,ONLY : JPRB
00050 !
00051 USE MODI_ABOR1_SFX
00052 USE MODI_GET_SURF_MASK_n
00053 USE MODI_GET_TYPE_DIM_n
00054 !
00055 IMPLICIT NONE
00056 !
00057 !*    0.1    Declaration of arguments
00058 !            ------------------------
00059 !
00060  CHARACTER(LEN=6),  INTENT(IN) :: HPROGRAM  ! Type of program
00061 REAL, DIMENSION(:),INTENT(OUT):: PDEPTH    ! physiographic field
00062 INTEGER, DIMENSION(:),INTENT(OUT):: KSTATUS   ! physiographic field
00063 !
00064 !
00065 !*    0.2    Declaration of local variables
00066 !            ------------------------------
00067 !
00068 INTEGER                        :: ILU    ! expected physical size of full surface array
00069 INTEGER                        :: ILUOUT ! output listing logical unit
00070 INTEGER, DIMENSION(:), POINTER :: IMASK  ! mask for packing from complete field to nature field
00071 INTEGER                        :: IDIM   !
00072 INTEGER                        :: JI
00073 !
00074  CHARACTER(LEN=6)    :: YMASK
00075 INTEGER, DIMENSION(NL) :: ISTATUS
00076 REAL, DIMENSION(NL) :: ZDEPTH, ZSTATUS    ! physiographic field on full grid
00077 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00078 !-------------------------------------------------------------------------------
00079 !
00080 !*    1.      Initializations
00081 !             ---------------
00082 !
00083 IF (LHOOK) CALL DR_HOOK('TREAT_GLOBAL_LAKE_DEPTH',0,ZHOOK_HANDLE)
00084 ZDEPTH(:) = XUNDEF
00085 ZSTATUS(:) = XUNDEF
00086 !-------------------------------------------------------------------------------
00087 !
00088 !*    2.      Output listing logical unit
00089 !             ---------------------------
00090 !
00091  CALL GET_LUOUT(HPROGRAM,ILUOUT)
00092 !
00093 !-------------------------------------------------------------------------------
00094 !
00095 !*    4.      Averages the field
00096 !             ------------------
00097 !
00098 ALLOCATE(NSIZE     (NL))
00099 ALLOCATE(XTNG      (NL,NGRADDEPTH_LDB))
00100 !
00101 NSIZE  (:) = 0.
00102 XTNG   (:,:) = 0.
00103 !
00104  CALL TREAT_FIELD(HPROGRAM,'SURF  ','DIRECT','A_LDBD', CLAKELDB,   &
00105                  'water depth         ',ZDEPTH,'WAT'              ) 
00106 !
00107 DEALLOCATE(XTNG)
00108 ALLOCATE(XTNG      (NL,NGRADSTATUS_LDB))
00109 !
00110 NSIZE  (:) = 0.
00111 XTNG   (:,:) = 0.
00112 !
00113  CALL TREAT_FIELD(HPROGRAM,'SURF  ','DIRECT','A_LDBS', CSTATUSLDB,  &
00114                  'water status        ',ZSTATUS,'WAT'              )
00115 !
00116 ISTATUS = NINT(ZSTATUS)
00117 !
00118 DEALLOCATE(NSIZE)
00119 DEALLOCATE(XTNG)
00120 !
00121 !-------------------------------------------------------------------------------
00122 !
00123 !*    5.      Consistancy check
00124 !             ------------------
00125 !
00126 DO JI = 1, SIZE(ZDEPTH)
00127   IF (XWATER(JI).GT.0.) THEN
00128     IF (ISTATUS(JI).LE.2) ZDEPTH(JI) = 10.
00129     IF (ISTATUS(JI)==3.AND.ZDEPTH(JI)==0.) ZDEPTH(JI) = 10.
00130   ELSE
00131     ZDEPTH(JI) = 0.
00132   ENDIF
00133 ENDDO
00134 !
00135 !*    6.      Mask for the field
00136 !             ------------------
00137 !
00138 YMASK='WATER '
00139  CALL GET_TYPE_DIM_n(YMASK,IDIM)
00140 IF (IDIM/=SIZE(PDEPTH) .OR. IDIM/=SIZE(KSTATUS)) THEN
00141    WRITE(ILUOUT,*)'Wrong dimension of MASK: ',IDIM,SIZE(PDEPTH),SIZE(KSTATUS)
00142    CALL ABOR1_SFX('TREAT_GLOBAL_LAKE_DEPTH: WRONG DIMENSION OF MASK')
00143 ENDIF
00144 
00145 ALLOCATE(IMASK(IDIM))
00146 ILU=0
00147  CALL GET_SURF_MASK_n(YMASK,IDIM,IMASK,ILU,ILUOUT)
00148  CALL PACK_SAME_RANK(IMASK,ZDEPTH(:),PDEPTH(:))
00149  CALL PACK_SAME_RANK(IMASK,ISTATUS(:),KSTATUS(:))
00150 DEALLOCATE(IMASK)
00151 !
00152 IF (LHOOK) CALL DR_HOOK('TREAT_GLOBAL_LAKE_DEPTH',1,ZHOOK_HANDLE)
00153 !
00154 !-------------------------------------------------------------------------------
00155 !
00156 END SUBROUTINE TREAT_GLOBAL_LAKE_DEPTH