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

Go to the documentation of this file.
00001 !     #########################
00002       SUBROUTINE AVERAGE2_LDB(PPGDARRAY,HTYPE,KSTAT)
00003 !     #########################
00004 !
00005 !!**** *AVERAGE2_LDB* 
00006 !!
00007 !!    PURPOSE
00008 !!    -------
00009 !!
00010 !!    METHOD
00011 !!    ------
00012 !!   
00013 !!    EXTERNAL
00014 !!    --------
00015 !!
00016 !!    IMPLICIT ARGUMENTS
00017 !!    ------------------
00018 !!
00019 !!    REFERENCE
00020 !!    ---------
00021 !!
00022 !!    AUTHOR
00023 !!    ------
00024 !!
00025 !!    S. Faroux         Meteo-France
00026 !!
00027 !!    MODIFICATION
00028 !!    ------------
00029 !!
00030 !!    Original    17/02/11
00031 !!
00032 !----------------------------------------------------------------------------
00033 !
00034 !*    0.     DECLARATION
00035 !            -----------
00036 !
00037 USE MODD_PGDWORK,   ONLY : NSIZE, XTNG
00038 USE MODD_DATA_LAKE, ONLY : XBOUNDGRADDEPTH_LDB, XBOUNDGRADSTATUS_LDB, &
00039                            XCENTRGRADDEPTH_LDB, NCENTRGRADSTATUS_LDB, &
00040                            XSMALL_DUMMY
00041 !
00042 USE MODI_ABOR1_SFX
00043 !
00044 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00045 USE PARKIND1  ,ONLY : JPRB
00046 !
00047 IMPLICIT NONE
00048 !
00049 !*    0.1    Declaration of arguments
00050 !            ------------------------
00051 !
00052 REAL,    DIMENSION(:), INTENT(OUT) :: PPGDARRAY
00053  CHARACTER(LEN=1), INTENT(IN) :: HTYPE
00054 INTEGER, INTENT(IN)          :: KSTAT
00055 !
00056 !*    0.2    Declaration of other local variables
00057 !            ------------------------------------
00058 !
00059 REAL, DIMENSION(:), ALLOCATABLE :: ZBOUND, ZCENTR
00060 REAL :: ZFRAC, ZMAX, ZPDF, ZAVE
00061 !
00062 INTEGER :: IGRAD_MODE
00063 INTEGER :: JGRAD, JI
00064 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00065 !----------------------------------------------------------------------------
00066 !
00067 !*    1.     Average values
00068 !            --------------
00069 !
00070 IF (LHOOK) CALL DR_HOOK('AVERAGE2_LDB',0,ZHOOK_HANDLE)
00071 !
00072 SELECT CASE (HTYPE)
00073 !
00074   CASE('D')
00075     ALLOCATE(ZBOUND(SIZE(XBOUNDGRADDEPTH_LDB)))
00076     ZBOUND(:) = XBOUNDGRADDEPTH_LDB(:)
00077     ALLOCATE(ZCENTR(SIZE(XCENTRGRADDEPTH_LDB)))
00078     ZCENTR(:) = XCENTRGRADDEPTH_LDB(:)    
00079 !
00080   CASE('S')
00081     ALLOCATE(ZBOUND(SIZE(XBOUNDGRADSTATUS_LDB)))
00082     ZBOUND(:) = XBOUNDGRADSTATUS_LDB(:)
00083     ALLOCATE(ZCENTR(SIZE(NCENTRGRADSTATUS_LDB)))
00084     ZCENTR(:) = NCENTRGRADSTATUS_LDB(:)
00085 !
00086   CASE DEFAULT
00087     CALL ABOR1_SFX("AVERAGE1_LDB: HTYPE NOT SUPPORTED")
00088 !
00089 END SELECT
00090 !
00091 !
00092 DO JI = 1,SIZE(XTNG,1)
00093   !
00094   DO JGRAD = 1,SIZE(XTNG,2)
00095     IF (NSIZE(JI).NE.0) XTNG(JI,JGRAD) = XTNG(JI,JGRAD)/NSIZE(JI)
00096   ENDDO
00097   !
00098   !2 because first centre is for values lower than 0
00099   ZFRAC = SUM(XTNG(JI,2:SIZE(XTNG,2)))
00100   !
00101   ZMAX = XSMALL_DUMMY
00102   IGRAD_MODE = 2
00103   !
00104   IF (KSTAT.EQ.1) THEN
00105     !
00106     DO JGRAD = 2, SIZE(XTNG,2)
00107       ZPDF = XTNG(JI,JGRAD) / (ZBOUND(JGRAD)-ZBOUND(JGRAD-1))
00108       IF (ZPDF.GT.ZMAX) THEN
00109         ZMAX = ZPDF
00110         IGRAD_MODE = JGRAD
00111       ENDIF
00112     ENDDO
00113     !
00114     IF (ZFRAC.GT.0.) THEN
00115       PPGDARRAY(JI) = ZCENTR(IGRAD_MODE)
00116     ELSE
00117       PPGDARRAY(JI) = 0.
00118     ENDIF
00119     !
00120   ELSEIF (KSTAT.EQ.2) THEN
00121     !
00122     ZAVE = 0.
00123     DO JGRAD = 2, SIZE(XTNG,2)
00124       ZAVE = ZAVE + ZCENTR(JGRAD) * XTNG(JI,JGRAD)
00125     ENDDO
00126     !
00127     IF (ZFRAC.LT.0.00001) THEN
00128       PPGDARRAY(JI) = 0.
00129     ELSE
00130       PPGDARRAY(JI) = ZAVE / ZFRAC
00131     ENDIF 
00132     !
00133   ENDIF
00134   !
00135 ENDDO
00136 !
00137 DEALLOCATE(ZBOUND)
00138 DEALLOCATE(ZCENTR)
00139 !
00140 IF (LHOOK) CALL DR_HOOK('AVERAGE2_LDB',1,ZHOOK_HANDLE)
00141 !
00142 !-------------------------------------------------------------------------------
00143 !
00144 END SUBROUTINE AVERAGE2_LDB