!-------------------------------------- LICENCE BEGIN ------------------------------------ !Environment Canada - Atmospheric Science and Technology License/Disclaimer, ! version 3; Last Modified: May 7, 2008. !This is free but copyrighted software; you can use/redistribute/modify it under the terms !of the Environment Canada - Atmospheric Science and Technology License/Disclaimer !version 3 or (at your option) any later version that should be found at: !http://collaboration.cmc.ec.gc.ca/science/rpn.comm/license.html ! !This software is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; !without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. !See the above mentioned License/Disclaimer for more details. !You should have received a copy of the License/Disclaimer along with this software; !if not, you can write to: EC-RPN COMM Group, 2121 TransCanada, suite 500, Dorval (Quebec), !CANADA, H9P 1J3; or send e-mail to service.rpn@ec.gc.ca !-------------------------------------- LICENCE END -------------------------------------- !subroutine stat_avhrr(avhrr) 1,1 ! calcul de statistiques ! sur l'information sous-pixel AVHRR use avhrr_var_mod
implicit none type (avhrr_var) ,intent(inout) :: avhrr !ping integer ,parameter :: NVIS=3,NIR=3 integer :: ICL,ICH Real (8) :: SUMFRAC(NVIS+NIR),TBMIN(NVIS+1:NVIS+NIR),TBMAX(NVIS+1:NVIS+NIR),SUMTB(NVIS+1:NVIS+NIR),SUMTB2(NVIS+1:NVIS+NIR) Real (8) :: SUMALB(1:NVIS),SUMALB2(1:NVIS) !INTEGER :: POSMIN(NVIS+1:NVIS+NIR),POSMAX(NVIS+1:NVIS+NIR) !****************************************** SUMFRAC(:)=0.d0 SUMTB(:)=0.d0 SUMTB2(:)=0.d0 SUMALB(:)=0.d0 SUMALB2(:)=0.d0 !POSMIN(:)=-1 !POSMAX(:)=-1 !TBMIN(:)=999.d0 !TBMAX(:)=-999.d0 DO ICL=1,NCLASSAVHRR IF (avhrr%CFRAC(ICL) > 0.d0 ) THEN DO ICH=1,NVIS IF (avhrr%ALBEDMOY(ICL,ICH) >=0.d0 ) THEN SUMFRAC(ICH)=SUMFRAC(ICH)+avhrr%CFRAC(ICL) SUMALB(ICH) = SUMALB(ICH) + avhrr%CFRAC(ICL) * avhrr%ALBEDMOY(ICL,ICH) SUMALB2(ICH) = SUMALB2(ICH) + avhrr%CFRAC(ICL) * ( avhrr%ALBEDMOY(ICL,ICH)**2 + avhrr%ALBEDSTD(ICL,ICH)**2) ENDIF ENDDO DO ICH=1+NVIS,NVIS+NIR IF (avhrr%TBMOY(ICL,ICH) > 0.d0 ) THEN ! IF (avhrr%TBMOY(ICL,ICH) > TBMAX (ICH) ) THEN ! TBMAX (ICH) = avhrr%TBMOY(ICL,ICH) ! POSMAX(ICH) = ICL ! ENDIF ! IF (avhrr%TBMOY(ICL,ICH) < TBMIN (ICH) ) THEN ! TBMIN (ICH) = avhrr%TBMOY(ICL,ICH) ! POSMIN(ICH) = ICL ! ENDIF SUMFRAC(ICH) = SUMFRAC(ICH) + avhrr%CFRAC(ICL) SUMTB(ICH) = SUMTB(ICH) + avhrr%CFRAC(ICL) * avhrr%TBMOY(ICL,ICH) SUMTB2(ICH) = SUMTB2(ICH) + avhrr%CFRAC(ICL) * (avhrr%TBMOY(ICL,ICH)**2 + avhrr%TBSTD(ICL,ICH)**2 ) ENDIF ENDDO ENDIF ENDDO DO ICH=1,NVIS IF (SUMFRAC(ICH) >0.d0 ) THEN SUMALB(ICH) = SUMALB(ICH) / SUMFRAC(ICH) SUMALB2(ICH) = SUMALB2(ICH)/SUMFRAC(ICH) - SUMALB(ICH)**2 IF (SUMALB2(ICH)>0.d0) THEN SUMALB2(ICH)=SQRT( SUMALB2(ICH) ) ELSE SUMALB2(ICH)=0.d0 ENDIF ENDIF ENDDO DO ICH=NVIS+1,NVIS+NIR IF (SUMFRAC(ICH) >0.d0 ) THEN SUMTB(ICH) = SUMTB(ICH) / SUMFRAC(ICH) SUMTB2(ICH) = SUMTB2(ICH)/SUMFRAC(ICH) - SUMTB(ICH)**2 IF (SUMTB2(ICH)>0.d0) THEN SUMTB2(ICH)=SQRT ( SUMTB2(ICH) ) ELSE SUMTB2(ICH)=0.d0 ENDIF ENDIF ENDDO !avhrr%POSTBMIN=POSMIN !avhrr%POSTBMAX=POSMAX !avhrr%TBMOY_PIXELIASI=SUMTB !avhrr%ALBMOY_PIXELIASI=SUMALB avhrr%TBSTD_PIXELIASI=SUMTB2 avhrr%ALBSTD_PIXELIASI=SUMALB2 end subroutine stat_avhrr