My Project
Main Page
Data Types List
Files
File List
File Members
All
Classes
Files
Functions
Variables
Macros
histo_o500_pctau.F
Go to the documentation of this file.
1
!
2
! $Header$
3
!
4
SUBROUTINE
histo_o500_pctau
(nbreg,pct_ocean,w,histo,histoW,nhisto)
5
USE
dimphy
6
IMPLICIT none
7
8
INTEGER
::
ij
,
k
,
l
, nw
9
INTEGER
:: nreg, nbreg
10
cym#include "dimensions.h"
11
cym#include "dimphy.h"
12
INTEGER
,
PARAMETER
:: kmax=8, lmax=8
13
INTEGER
,
PARAMETER
:: kmaxm1=kmax-1,
lmaxm1
=lmax-1
14
INTEGER
,
PARAMETER
:: iwmax=40
15
16
INTEGER
,
dimension(klon)
::
iw
17
REAL
,
dimension(klon)
:: w
18
REAL
,
PARAMETER
:: wmin=-200., pas_w=10.
19
REAL
,
dimension(kmaxm1,lmaxm1,iwmax,nbreg)
:: histow, nhisto
20
REAL
,
dimension(klon,kmaxm1,lmaxm1)
:: histo
21
22
! LOGICAL, dimension(klon,nbreg) :: pct_ocean
23
INTEGER
,
dimension(klon,nbreg)
:: pct_ocean
24
25
! initialisation
26
histow(:,:,:,:)=0.
27
nhisto(:,:,:,:)=0.
28
!
29
!calcul de l'histogramme de chaque regime dynamique
30
DO
nreg=1, nbreg
31
DO
ij
=1, klon
32
iw
(
ij
) = int((w(
ij
)-wmin)/pas_w) +1
33
c IF(pct_ocean(ij,nreg)) THEN
34
c IF(pct_ocean(ij,nreg).EQ.1) THEN
35
IF
(
iw
(
ij
).GE.1.AND.
iw
(
ij
).LE.iwmax)
THEN
36
DO
l
=1,
lmaxm1
37
DO
k
=1, kmaxm1
38
IF
(histo(
ij
,
k
,
l
).GT.0.)
THEN
39
histow(
k
,
l
,
iw
(
ij
),nreg) = histow(
k
,
l
,
iw
(
ij
),nreg)
40
& + histo(
ij
,
k
,
l
)*pct_ocean(
ij
,nreg)
41
nhisto(
k
,
l
,
iw
(
ij
),nreg)= nhisto(
k
,
l
,
iw
(
ij
),nreg) +
42
& pct_ocean(
ij
,nreg)
43
ENDIF
44
ENDDO
!k
45
ENDDO
!l
46
c ELSE IF (iw(ij).LE.0.OR.iw(ij).GT.iwmax) THEN !iw
47
c PRINT*,'ij,iw=',ij,iw(ij)
48
ENDIF
!iw
49
c ENDIF !pct_ocean
50
ENDDO
!ij
51
!normalisation
52
DO
nw=1, iwmax
53
DO
l
=1,
lmaxm1
54
DO
k
=1, kmaxm1
55
IF
(nhisto(
k
,
l
,nw,nreg).NE.0.)
THEN
56
histow(
k
,
l
,nw,nreg) = 100.*histow(
k
,
l
,nw,nreg)
57
& /nhisto(
k
,
l
,nw,nreg)
58
c PRINT*,'k,l,nw,nreg,histoW',k,l,nw,nreg,
59
c & histoW(k,l,nw,nreg)
60
ENDIF
61
ENDDO
!k
62
ENDDO
!l
63
ENDDO
!nw
64
ENDDO
!nreg
65
66
RETURN
67
END
libf
phylmd
histo_o500_pctau.F
Generated on Fri Jun 28 2013 15:59:21 for My Project by
1.8.1.2