|
SURFEX v7.3
General documentation of Surfex
|
|
SURFEX v7.3
General documentation of Surfex
|
00001 ! ######################### 00002 SUBROUTINE AVERAGE2_COVER 00003 ! ######################### 00004 ! 00005 !!**** *AVERAGE2_COVER* computes the cover fractions 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 !! V. Masson Meteo-France 00026 !! 00027 !! MODIFICATION 00028 !! ------------ 00029 !! 00030 !! Original 10/12/97 00031 !! 00032 !---------------------------------------------------------------------------- 00033 ! 00034 !* 0. DECLARATION 00035 ! ----------- 00036 ! 00037 USE MODD_PGDWORK, ONLY : NSIZE, XSUMCOVER 00038 USE MODD_SURF_ATM_n, ONLY : XCOVER 00039 ! 00040 ! 00041 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00042 USE PARKIND1 ,ONLY : JPRB 00043 ! 00044 IMPLICIT NONE 00045 ! 00046 !* 0.1 Declaration of arguments 00047 ! ------------------------ 00048 ! 00049 ! 00050 !* 0.2 Declaration of other local variables 00051 ! ------------------------------------ 00052 ! 00053 REAL, DIMENSION(:), ALLOCATABLE :: ZUNITY 00054 ! 00055 INTEGER :: JCOVER ! loop counter on cover classes 00056 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00057 !---------------------------------------------------------------------------- 00058 ! 00059 !* 1. Average values 00060 ! -------------- 00061 ! 00062 IF (LHOOK) CALL DR_HOOK('AVERAGE2_COVER',0,ZHOOK_HANDLE) 00063 ALLOCATE(ZUNITY(SIZE(NSIZE))) 00064 ZUNITY (:) = 0. 00065 ! 00066 DO JCOVER=1,SIZE(XCOVER,2) 00067 WHERE (NSIZE(:)/=0) 00068 XCOVER(:,JCOVER)=XSUMCOVER(:,JCOVER) /NSIZE(:) 00069 ZUNITY(:)=ZUNITY(:) + XCOVER(:,JCOVER) 00070 ENDWHERE 00071 END DO 00072 ! 00073 DO JCOVER=1,SIZE(XCOVER,2) 00074 WHERE (NSIZE(:) /=0 ) 00075 XCOVER(:,JCOVER)=XCOVER(:,JCOVER) / ZUNITY(:) 00076 END WHERE 00077 END DO 00078 ! 00079 !------------------------------------------------------------------------------- 00080 DEALLOCATE(ZUNITY) 00081 IF (LHOOK) CALL DR_HOOK('AVERAGE2_COVER',1,ZHOOK_HANDLE) 00082 !------------------------------------------------------------------------------- 00083 ! 00084 END SUBROUTINE AVERAGE2_COVER
1.8.0
