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

Go to the documentation of this file.
00001 !     #########
00002       SUBROUTINE AVERAGE1_MESH(KLUOUT,PLAT,PLON,PVALUE)
00003 !     #######################################################
00004 !
00005 !!**** *AVERAGE1_MESH* computes the sum of orography, squared orography
00006 !!                              and subgrid orography characteristics
00007 !!
00008 !!    PURPOSE
00009 !!    -------
00010 !!
00011 !!    METHOD
00012 !!    ------
00013 !!   
00014 !!    EXTERNAL
00015 !!    --------
00016 !!
00017 !!    IMPLICIT ARGUMENTS
00018 !!    ------------------
00019 !!
00020 !!
00021 !!    REFERENCE
00022 !!    ---------
00023 !!
00024 !!    AUTHOR
00025 !!    ------
00026 !!
00027 !!    V. Masson         Meteo-France
00028 !!
00029 !!    MODIFICATION
00030 !!    ------------
00031 !!
00032 !!    Original    12/09/95
00033 !!
00034 !----------------------------------------------------------------------------
00035 !
00036 !*    0.     DECLARATION
00037 !            -----------
00038 !
00039 USE MODD_PGDWORK,       ONLY : XSUMVAL, NSIZE, CATYPE, &
00040                                NVALNBR, NVALCOUNT, XVALLIST, JPVALMAX
00041 USE MODD_DATA_COVER_PAR,ONLY : XCDREF
00042 !
00043 USE MODI_GET_MESH_INDEX
00044 USE MODD_POINT_OVERLAY
00045 USE MODI_ABOR1_SFX
00046 !
00047 !
00048 !
00049 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00050 USE PARKIND1  ,ONLY : JPRB
00051 !
00052 IMPLICIT NONE
00053 !
00054 !*    0.1    Declaration of arguments
00055 !            ------------------------
00056 !
00057 INTEGER,                 INTENT(IN)    :: KLUOUT
00058 REAL, DIMENSION(:),      INTENT(IN)    :: PLAT    ! latitude of the point to add
00059 REAL, DIMENSION(:),      INTENT(IN)    :: PLON    ! longitude of the point to add
00060 REAL, DIMENSION(:),      INTENT(IN)    :: PVALUE  ! value of the point to add
00061 !
00062 !*    0.2    Declaration of other local variables
00063 !            ------------------------------------
00064 !
00065 INTEGER, DIMENSION(SIZE(PLAT)) :: IINDEX ! mesh index of all input points
00066                                          ! 0 indicates the point is out of the domain
00067 INTEGER :: JVAL         ! loop counter on encoutered values
00068 INTEGER :: JLOOP        ! loop index on input arrays
00069 REAL    :: ZEPS=1.E-10  ! a small value
00070 LOGICAL :: GFOUND       ! T : Value already found in this grid point
00071 !
00072 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00073 !----------------------------------------------------------------------------
00074 !
00075 !*    1.     Get position
00076 !            ------------
00077 ! 
00078 IF (LHOOK) CALL DR_HOOK('AVERAGE1_MESH',0,ZHOOK_HANDLE)
00079 IF (ALLOCATED(XNUM)) DEALLOCATE(XNUM)
00080 ALLOCATE(XNUM(SIZE(PLAT)))
00081 !
00082 XNUM(:)=1
00083 !
00084 DO WHILE(MAXVAL(XNUM).NE.0)
00085 !
00086   CALL GET_MESH_INDEX(KLUOUT,PLAT,PLON,IINDEX)
00087 !
00088 !*    2.     Loop on all input data points
00089 !            -----------------------------
00090 !     
00091   DO JLOOP = 1 , SIZE(PLAT)
00092 !
00093 !*    3.     Tests on position
00094 !            -----------------
00095 !     
00096     IF (IINDEX(JLOOP)==0) CYCLE
00097 !
00098 !*    4.     Summation
00099 !            ---------
00100 !
00101     NSIZE(IINDEX(JLOOP))=NSIZE(IINDEX(JLOOP))+1
00102 !
00103 !*    5.     Choice of type of summation
00104 !            ---------------------------
00105 !
00106     SELECT CASE (CATYPE)
00107       CASE ('ARI')
00108         XSUMVAL(IINDEX(JLOOP))=XSUMVAL(IINDEX(JLOOP))+   PVALUE(JLOOP)
00109       CASE ('INV')
00110         XSUMVAL(IINDEX(JLOOP))=XSUMVAL(IINDEX(JLOOP))+1./PVALUE(JLOOP)
00111       CASE ('CDN')
00112         XSUMVAL(IINDEX(JLOOP))=XSUMVAL(IINDEX(JLOOP))+1./(LOG(XCDREF/PVALUE(JLOOP)))**2
00113       CASE ('MAJ')
00114         GFOUND=.FALSE.
00115         DO JVAL=1,NVALNBR(IINDEX(JLOOP))
00116           IF (ABS( XVALLIST(IINDEX(JLOOP),JVAL) - PVALUE(JLOOP)) < ZEPS) THEN
00117             NVALCOUNT(IINDEX(JLOOP),JVAL) = NVALCOUNT(IINDEX(JLOOP),JVAL) + 1
00118             GFOUND=.TRUE.
00119             EXIT
00120           END IF
00121         END DO
00122         IF (.NOT. GFOUND) THEN
00123           IF (NVALNBR(IINDEX(JLOOP))==JPVALMAX) &
00124             CALL ABOR1_SFX('TOO MANY DIFFERENT VALUES TO AGGREGATE WITH THE MAJORITY RULE')
00125           NVALNBR(IINDEX(JLOOP)) = NVALNBR(IINDEX(JLOOP)) +1
00126           JVAL = NVALNBR(IINDEX(JLOOP))
00127           NVALCOUNT(IINDEX(JLOOP),JVAL) = 1
00128           XVALLIST (IINDEX(JLOOP),JVAL) = PVALUE(JLOOP)
00129         END IF
00130     END SELECT
00131 !
00132   ENDDO
00133 END DO
00134 IF (LHOOK) CALL DR_HOOK('AVERAGE1_MESH',1,ZHOOK_HANDLE)
00135 !
00136 !-------------------------------------------------------------------------------
00137 !
00138 END SUBROUTINE AVERAGE1_MESH