source: trunk/LMDZ.GENERIC/libf/phystd/wstats.F90 @ 848

Last change on this file since 848 was 135, checked in by aslmd, 14 years ago

CHANGEMENT ARBORESCENCE ETAPE 2 -- NON COMPLET
File size: 6.0 KB
Line 
1subroutine wstats(ngrid,nom,titre,unite,dim,px)
2
3implicit none
4
5#include "dimensions.h"
6#include "dimphys.h"
7#include "statto.h"
8#include "netcdf.inc"
9
10integer,intent(in) :: ngrid
11character (len=*) :: nom,titre,unite
12integer,intent(in) :: dim
13integer,parameter :: iip1=iim+1
14integer,parameter :: jjp1=jjm+1
15real, dimension(ngrid,llm) :: px
16real, dimension(iip1,jjp1,llm) :: mean3d,sd3d,dx3
17real, dimension(iip1,jjp1) :: mean2d,sd2d,dx2
18character (len=50) :: namebis
19character (len=50), save :: firstvar
20integer :: ierr,varid,nbdim,nid
21integer :: meanid,sdid
22integer, dimension(4)  :: id,start,size
23logical, save :: firstcall=.TRUE.
24integer :: l,i,j,ig0
25integer,save :: index
26
27integer, save :: step=0
28
29
30if (firstcall) then
31   firstcall=.false.
32   firstvar=trim((nom))
33   call inistats(ierr)
34endif
35
36if (firstvar==nom) then ! If we're back to the first variable
37      step = step + 1
38endif
39
40if (mod(step,istats).ne.0) then
41   RETURN
42endif
43
44ierr = NF_OPEN("stats.nc",NF_WRITE,nid)
45
46namebis=trim(nom)
47ierr= NF_INQ_VARID(nid,namebis,meanid)
48
49if (ierr.ne.NF_NOERR) then
50
51   if (firstvar==nom) then
52      index=1
53      count=0
54   endif
55
56
57!declaration de la variable
58
59! choix du nom des coordonnees
60   ierr= NF_INQ_DIMID(nid,"longitude",id(1))
61   ierr= NF_INQ_DIMID(nid,"latitude",id(2))
62   if (dim.eq.3) then
63      ierr= NF_INQ_DIMID(nid,"altitude",id(3))
64      ierr= NF_INQ_DIMID(nid,"Time",id(4))
65      nbdim=4
66   else if (dim==2) then
67      ierr= NF_INQ_DIMID(nid,"Time",id(3))
68      nbdim=3
69   endif
70
71   write (*,*) "====================="
72   write (*,*) "STATS: creation de ",nom
73   namebis=trim(nom)
74   call def_var(nid,namebis,titre,unite,nbdim,id,meanid,ierr)
75   call inivar(nid,meanid,ngrid,dim,index,px,ierr)
76   namebis=trim(nom)//"_sd"
77   call def_var(nid,namebis,trim(titre)//" total standard deviation over the season",unite,nbdim,id,sdid,ierr)
78   call inivar(nid,sdid,ngrid,dim,index,px,ierr)
79
80   ierr= NF_CLOSE(nid)
81   return
82
83else
84   namebis=trim(nom)//"_sd"
85   ierr= NF_INQ_VARID(nid,namebis,sdid)
86
87endif
88
89if (firstvar==nom) then
90   count(index)=count(int(index))+1
91   index=index+1
92   if (index>istime) then
93      index=1
94   endif
95endif
96
97if (count(index)==0) then
98   if (dim.eq.3) then
99      start=(/1,1,1,index/)
100      size=(/iip1,jjp1,llm,1/)
101      mean3d=0
102      sd3d=0
103   else if (dim.eq.2) then
104      start=(/1,1,index,0/)
105      size=(/iip1,jjp1,1,0/)
106      mean2d=0
107      sd2d=0
108   endif
109else
110   if (dim.eq.3) then
111      start=(/1,1,1,index/)
112      size=(/iip1,jjp1,llm,1/)
113#ifdef NC_DOUBLE
114      ierr = NF_GET_VARA_DOUBLE(nid,meanid,start,size,mean3d)
115      ierr = NF_GET_VARA_DOUBLE(nid,sdid,start,size,sd3d)
116#else
117      ierr = NF_GET_VARA_REAL(nid,meanid,start,size,mean3d)
118      ierr = NF_GET_VARA_REAL(nid,sdid,start,size,sd3d)
119#endif
120      if (ierr.ne.NF_NOERR) then
121         write (*,*) NF_STRERROR(ierr)
122         stop ""
123      endif
124
125   else if (dim.eq.2) then
126      start=(/1,1,index,0/)
127      size=(/iip1,jjp1,1,0/)
128#ifdef NC_DOUBLE
129      ierr = NF_GET_VARA_DOUBLE(nid,meanid,start,size,mean2d)
130      ierr = NF_GET_VARA_DOUBLE(nid,sdid,start,size,sd2d)
131#else
132      ierr = NF_GET_VARA_REAL(nid,meanid,start,size,mean2d)
133      ierr = NF_GET_VARA_REAL(nid,sdid,start,size,sd2d)
134#endif
135      if (ierr.ne.NF_NOERR) then
136         write (*,*) NF_STRERROR(ierr)
137         stop ""
138      endif
139   endif
140endif
141
142if (dim.eq.3) then
143
144!  Passage variable physique -->  variable dynamique
145
146   DO l=1,llm
147      DO i=1,iip1
148         dx3(i,1,l)=px(1,l)
149         dx3(i,jjp1,l)=px(ngrid,l)
150      ENDDO
151      DO j=2,jjm
152         ig0= 1+(j-2)*iim
153         DO i=1,iim
154            dx3(i,j,l)=px(ig0+i,l)
155         ENDDO
156         dx3(iip1,j,l)=dx3(1,j,l)
157      ENDDO
158   ENDDO
159
160   mean3d= mean3d+dx3
161   sd3d= sd3d+dx3**2
162
163#ifdef NC_DOUBLE
164   ierr = NF_PUT_VARA_DOUBLE(nid,meanid,start,size,mean3d)
165   ierr = NF_PUT_VARA_DOUBLE(nid,sdid,start,size,sd3d)
166#else
167   ierr = NF_PUT_VARA_REAL(nid,meanid,start,size,mean3d)
168   ierr = NF_PUT_VARA_REAL(nid,sdid,start,size,sd3d)
169#endif
170
171else if (dim.eq.2) then
172
173!    Passage variable physique -->  physique dynamique
174
175  DO i=1,iip1
176     dx2(i,1)=px(1,1)
177     dx2(i,jjp1)=px(ngrid,1)
178  ENDDO
179  DO j=2,jjm
180     ig0= 1+(j-2)*iim
181     DO i=1,iim
182        dx2(i,j)=px(ig0+i,1)
183     ENDDO
184     dx2(iip1,j)=dx2(1,j)
185  ENDDO
186
187   mean2d= mean2d+dx2
188   sd2d= sd2d+dx2**2
189
190#ifdef NC_DOUBLE
191   ierr = NF_PUT_VARA_DOUBLE(nid,meanid,start,size,mean2d)
192   ierr = NF_PUT_VARA_DOUBLE(nid,sdid,start,size,sd2d)
193#else
194   ierr = NF_PUT_VARA_REAL(nid,meanid,start,size,mean2d)
195   ierr = NF_PUT_VARA_REAL(nid,sdid,start,size,sd2d)
196#endif
197
198endif
199
200ierr= NF_CLOSE(nid)
201
202end
203
204!======================================================
205subroutine inivar(nid,varid,ngrid,dim,index,px,ierr)
206
207implicit none
208
209include "dimensions.h"
210include "dimphys.h"
211include "netcdf.inc"
212
213integer, intent(in) :: nid,varid,dim,index,ngrid
214real, dimension(ngrid,llm), intent(in) :: px
215integer, intent(out) :: ierr
216
217integer,parameter :: iip1=iim+1
218integer,parameter :: jjp1=jjm+1
219
220integer :: l,i,j,ig0
221integer, dimension(4) :: start,size
222real, dimension(iip1,jjp1,llm) :: dx3
223real, dimension(iip1,jjp1) :: dx2
224
225if (dim.eq.3) then
226
227   start=(/1,1,1,index/)
228   size=(/iip1,jjp1,llm,1/)
229
230!  Passage variable physique -->  variable dynamique
231
232   DO l=1,llm
233      DO i=1,iip1
234         dx3(i,1,l)=px(1,l)
235         dx3(i,jjp1,l)=px(ngrid,l)
236      ENDDO
237      DO j=2,jjm
238         ig0= 1+(j-2)*iim
239         DO i=1,iim
240            dx3(i,j,l)=px(ig0+i,l)
241         ENDDO
242         dx3(iip1,j,l)=dx3(1,j,l)
243      ENDDO
244   ENDDO
245
246#ifdef NC_DOUBLE
247   ierr = NF_PUT_VARA_DOUBLE(nid,varid,start,size,dx3)
248#else
249   ierr = NF_PUT_VARA_REAL(nid,varid,start,size,dx3)
250#endif
251
252else if (dim.eq.2) then
253
254      start=(/1,1,index,0/)
255      size=(/iip1,jjp1,1,0/)
256
257!    Passage variable physique -->  physique dynamique
258
259  DO i=1,iip1
260     dx2(i,1)=px(1,1)
261     dx2(i,jjp1)=px(ngrid,1)
262  ENDDO
263  DO j=2,jjm
264     ig0= 1+(j-2)*iim
265     DO i=1,iim
266        dx2(i,j)=px(ig0+i,1)
267     ENDDO
268     dx2(iip1,j)=dx2(1,j)
269  ENDDO
270
271#ifdef NC_DOUBLE
272   ierr = NF_PUT_VARA_DOUBLE(nid,varid,start,size,dx2)
273#else
274   ierr = NF_PUT_VARA_REAL(nid,varid,start,size,dx2)
275#endif
276
277endif
278
279end
Note: See TracBrowser for help on using the repository browser.