|
SURFEX v7.3
General documentation of Surfex
|
|
SURFEX v7.3
General documentation of Surfex
|
00001 ! ######### 00002 SUBROUTINE AVERAGE1_LDB(KLUOUT,PLAT,PLON,PVALUE,HTYPE) 00003 ! ####################################################### 00004 ! 00005 !!**** *AVERAGE1_LDB* 00006 !! 00007 !! PURPOSE 00008 !! ------- 00009 !! 00010 !! METHOD 00011 !! ------ 00012 !! 00013 !! EXTERNAL 00014 !! -------- 00015 !! 00016 !! IMPLICIT ARGUMENTS 00017 !! ------------------ 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_PGDWORK, ONLY : XTNG, NSIZE 00039 USE MODD_DATA_LAKE, ONLY : XBOUNDGRADDEPTH_LDB, XBOUNDGRADSTATUS_LDB 00040 ! 00041 USE MODD_POINT_OVERLAY 00042 ! 00043 USE MODI_GET_MESH_INDEX 00044 USE MODI_ABOR1_SFX 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 CHARACTER(LEN=1), INTENT(IN) :: HTYPE 00059 ! 00060 !* 0.2 Declaration of other local variables 00061 ! ------------------------------------ 00062 ! 00063 REAL, DIMENSION(:), ALLOCATABLE :: ZBOUND 00064 ! 00065 INTEGER, DIMENSION(SIZE(PLAT)) :: IINDEX ! mesh index of all input points 00066 ! 0 indicates the point is out of the domain 00067 ! 00068 REAL :: ZCUT 00069 INTEGER :: JLOOP, JGRAD ! loop index on input arrays 00070 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00071 !---------------------------------------------------------------------------- 00072 ! 00073 ! 00074 !* 1. Get position 00075 ! ------------ 00076 ! 00077 IF (LHOOK) CALL DR_HOOK('AVERAGE1_LDB',0,ZHOOK_HANDLE) 00078 ! 00079 SELECT CASE (HTYPE) 00080 ! 00081 CASE('D') 00082 ALLOCATE(ZBOUND(SIZE(XBOUNDGRADDEPTH_LDB))) 00083 ZBOUND(:) = XBOUNDGRADDEPTH_LDB(:) 00084 ! 00085 CASE('S') 00086 ALLOCATE(ZBOUND(SIZE(XBOUNDGRADSTATUS_LDB))) 00087 ZBOUND(:) = XBOUNDGRADSTATUS_LDB(:) 00088 ! 00089 CASE DEFAULT 00090 CALL ABOR1_SFX("AVERAGE1_LDB: HTYPE NOT SUPPORTED") 00091 ! 00092 END SELECT 00093 ! 00094 IF (ALLOCATED(XNUM)) DEALLOCATE(XNUM) 00095 ALLOCATE(XNUM(SIZE(PLAT))) 00096 ! 00097 XNUM(:)=1 00098 ! 00099 DO WHILE(MAXVAL(XNUM).NE.0) 00100 ! 00101 CALL GET_MESH_INDEX(KLUOUT,PLAT,PLON,IINDEX) 00102 ! 00103 !* 2. Loop on all input data points 00104 ! ----------------------------- 00105 ! 00106 DO JLOOP = 1 , SIZE(PLAT) 00107 ! 00108 !* 3. Tests on position 00109 ! ----------------- 00110 ! 00111 IF (IINDEX(JLOOP)==0) CYCLE 00112 ! 00113 !* 4. Test on value meaning 00114 ! --------------------- 00115 ! 00116 ZCUT = PVALUE(JLOOP) 00117 ! 00118 DO JGRAD = 1, SIZE(ZBOUND)-1 00119 IF (ZCUT.GT.ZBOUND(JGRAD) .AND. ZCUT.LE.ZBOUND(JGRAD+1)) THEN 00120 XTNG(IINDEX(JLOOP),JGRAD) = XTNG(IINDEX(JLOOP),JGRAD) + 1 00121 EXIT 00122 ENDIF 00123 ENDDO 00124 ! 00125 !* 5. Summation 00126 ! --------- 00127 ! 00128 NSIZE(IINDEX(JLOOP))=NSIZE(IINDEX(JLOOP))+1 00129 ! 00130 END DO 00131 ENDDO 00132 ! 00133 DEALLOCATE(ZBOUND) 00134 ! 00135 IF (LHOOK) CALL DR_HOOK('AVERAGE1_LDB',1,ZHOOK_HANDLE) 00136 ! 00137 !------------------------------------------------------------------------------- 00138 ! 00139 END SUBROUTINE AVERAGE1_LDB
1.8.0
