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

Go to the documentation of this file.
00001 !     #########
00002       SUBROUTINE AVERAGE1_COVER(KLUOUT,PLAT,PLON,PVALUE)
00003 !     #######################################################
00004 !
00005 !!**** *AVERAGE1_COVER* computes the sum of values of a cover fractions
00006 !!                              and the nature of terrain on the grid
00007 !!                              from a data in land-cover file
00008 !!
00009 !!    PURPOSE
00010 !!    -------
00011 !!
00012 !!    METHOD
00013 !!    ------
00014 !!   
00015 !!    EXTERNAL
00016 !!    --------
00017 !!
00018 !!    IMPLICIT ARGUMENTS
00019 !!    ------------------
00020 !!
00021 !!
00022 !!    REFERENCE
00023 !!    ---------
00024 !!
00025 !!    AUTHOR
00026 !!    ------
00027 !!
00028 !!    V. Masson         Meteo-France
00029 !!
00030 !!    MODIFICATION
00031 !!    ------------
00032 !!
00033 !!    Original    12/09/95
00034 !!
00035 !----------------------------------------------------------------------------
00036 !
00037 !*    0.     DECLARATION
00038 !            -----------
00039 !
00040 USE MODD_PGDWORK, ONLY : XSUMCOVER, NSIZE
00041 !
00042 USE MODI_GET_MESH_INDEX
00043 USE MODD_POINT_OVERLAY
00044 !
00045 !
00046 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00047 USE PARKIND1  ,ONLY : JPRB
00048 !
00049 IMPLICIT NONE
00050 !
00051 !*    0.1    Declaration of arguments
00052 !            ------------------------
00053 !
00054 INTEGER,                 INTENT(IN)    :: KLUOUT
00055 REAL, DIMENSION(:),      INTENT(IN)    :: PLAT    ! latitude of the point to add
00056 REAL, DIMENSION(:),      INTENT(IN)    :: PLON    ! longitude of the point to add
00057 REAL, DIMENSION(:),      INTENT(IN)    :: PVALUE  ! value of the point to add
00058 !
00059 !*    0.2    Declaration of other local variables
00060 !            ------------------------------------
00061 !
00062 INTEGER, DIMENSION(SIZE(PLAT)) :: IINDEX ! mesh index of all input points
00063                                          ! 0 indicates the point is out of the domain                              
00064 !
00065 INTEGER :: JLOOP        ! loop index on input arrays
00066 INTEGER :: ICOVERCLASS  ! class of cover type
00067 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00068 !----------------------------------------------------------------------------
00069 !
00070 !
00071 !*    1.     Get position
00072 !            ------------
00073 !     
00074 IF (LHOOK) CALL DR_HOOK('AVERAGE1_COVER',0,ZHOOK_HANDLE)
00075 IF (ALLOCATED(XNUM)) DEALLOCATE(XNUM)
00076 ALLOCATE(XNUM(SIZE(PLAT)))
00077 !
00078 XNUM(:)=1
00079 !                                         
00080 DO WHILE(MAXVAL(XNUM).NE.0)
00081 !
00082   CALL GET_MESH_INDEX(KLUOUT,PLAT,PLON,IINDEX)
00083 !
00084 !*    2.     Loop on all input data points
00085 !            -----------------------------
00086 !     
00087   DO JLOOP = 1 , SIZE(PLAT)
00088 !
00089 !*    3.     Tests on position
00090 !            -----------------
00091 !     
00092     IF (IINDEX(JLOOP)==0) CYCLE
00093 !
00094 !*    4.     Test on value meaning
00095 !            ---------------------
00096 !
00097     ICOVERCLASS = NINT(PVALUE(JLOOP))
00098 !
00099     IF (ICOVERCLASS<1 .OR. ICOVERCLASS > SIZE(XSUMCOVER,2) )  CYCLE
00100 !
00101 !*    5.     Summation
00102 !            ---------
00103 !
00104     NSIZE(IINDEX(JLOOP))=NSIZE(IINDEX(JLOOP))+1
00105 !
00106 !*    6.     Fraction of cover type
00107 !            ----------------------
00108 !
00109     XSUMCOVER(IINDEX(JLOOP),ICOVERCLASS)=XSUMCOVER(IINDEX(JLOOP),ICOVERCLASS)+1.
00110 !
00111   END DO
00112 ENDDO
00113 IF (LHOOK) CALL DR_HOOK('AVERAGE1_COVER',1,ZHOOK_HANDLE)
00114 !
00115 !-------------------------------------------------------------------------------
00116 !
00117 END SUBROUTINE AVERAGE1_COVER