1 | subroutine mkstats(ierr) |
---|
2 | |
---|
3 | |
---|
4 | ! |
---|
5 | ! This program writes a stats.nc file from sums and sums of squares |
---|
6 | ! to means and standard deviations and also writes netcdf style |
---|
7 | ! file so that the data can be viewed easily. The data file is |
---|
8 | ! overwritten in place. |
---|
9 | ! SRL 21 May 1996 |
---|
10 | ! Yann W. july 2003 |
---|
11 | |
---|
12 | use netcdf |
---|
13 | |
---|
14 | implicit none |
---|
15 | |
---|
16 | INCLUDE 'netcdf.inc' |
---|
17 | |
---|
18 | #include "dimensions.h" |
---|
19 | #include "statto.h" |
---|
20 | |
---|
21 | integer,parameter :: iip1=iim+1 |
---|
22 | integer,parameter :: jjp1=jjm+1 |
---|
23 | integer :: ierr,nid,nbvar,i,ndims,lt,nvarid |
---|
24 | integer, dimension(4) :: id,varid,start,size |
---|
25 | integer, dimension(5) :: dimids |
---|
26 | character (len=50) :: name,nameout,units,title |
---|
27 | real, dimension(iip1,jjp1,llm) :: sum3d,square3d,mean3d,sd3d |
---|
28 | real, dimension(iip1,jjp1) :: sum2d,square2d,mean2d,sd2d |
---|
29 | real, dimension(istime) :: time |
---|
30 | real, dimension(jjp1) :: lat |
---|
31 | real, dimension(iip1) :: lon |
---|
32 | real, dimension(llm) :: alt |
---|
33 | logical :: lcopy=.true. |
---|
34 | !integer :: latid,lonid,altid,timeid |
---|
35 | integer :: meanid,sdid |
---|
36 | !integer, dimension(4) :: dimout |
---|
37 | |
---|
38 | ! Incrementation of count for the last step, which is not done in wstats |
---|
39 | count(istime)=count(istime)+1 |
---|
40 | |
---|
41 | ierr = NF_OPEN("stats.nc",NF_WRITE,nid) |
---|
42 | |
---|
43 | ! We catch the id of dimensions of the stats file |
---|
44 | |
---|
45 | ierr= NF_INQ_DIMID(nid,"latitude",id(1)) |
---|
46 | ierr= NF_INQ_DIMID(nid,"longitude",id(2)) |
---|
47 | ierr= NF_INQ_DIMID(nid,"altitude",id(3)) |
---|
48 | ierr= NF_INQ_DIMID(nid,"Time",id(4)) |
---|
49 | |
---|
50 | ierr= NF_INQ_VARID(nid,"latitude",varid(1)) |
---|
51 | ierr= NF_INQ_VARID(nid,"longitude",varid(2)) |
---|
52 | ierr= NF_INQ_VARID(nid,"altitude",varid(3)) |
---|
53 | ierr= NF_INQ_VARID(nid,"Time",varid(4)) |
---|
54 | |
---|
55 | ! Time initialisation |
---|
56 | |
---|
57 | do i=1,istime |
---|
58 | time(i)=i*24./istime |
---|
59 | #ifdef NC_DOUBLE |
---|
60 | ierr= NF_PUT_VARA_DOUBLE(nid,varid(4),i,1,time(i)) |
---|
61 | #else |
---|
62 | ierr= NF_PUT_VARA_REAL(nid,varid(4),i,1,time(i)) |
---|
63 | #endif |
---|
64 | enddo |
---|
65 | |
---|
66 | ! We catche the values of the variables |
---|
67 | |
---|
68 | #ifdef NC_DOUBLE |
---|
69 | ierr = NF_GET_VAR_DOUBLE(nid,varid(1),lat) |
---|
70 | ierr = NF_GET_VAR_DOUBLE(nid,varid(2),lon) |
---|
71 | ierr = NF_GET_VAR_DOUBLE(nid,varid(3),alt) |
---|
72 | #else |
---|
73 | ierr = NF_GET_VAR_REAL(nid,varid(1),lat) |
---|
74 | ierr = NF_GET_VAR_REAL(nid,varid(2),lon) |
---|
75 | ierr = NF_GET_VAR_REAL(nid,varid(3),alt) |
---|
76 | #endif |
---|
77 | |
---|
78 | ! We catch the number of variables in the stats file |
---|
79 | ierr = NF_INQ_NVARS(nid,nbvar) |
---|
80 | |
---|
81 | ! to catche the "real" number of variables (without the "additionnal variables") |
---|
82 | nbvar=(nbvar-4)/2 |
---|
83 | |
---|
84 | do i=1,nbvar |
---|
85 | varid=(i-1)*2+5 |
---|
86 | |
---|
87 | ! What's the variable's name? |
---|
88 | ierr=NF_INQ_VARNAME(nid,varid,name) |
---|
89 | write(*,*) "OK variable ",name |
---|
90 | ! Its units? |
---|
91 | units=" " |
---|
92 | ierr=NF_GET_ATT_TEXT(nid,varid,"units",units) |
---|
93 | ! Its title? |
---|
94 | title=" " |
---|
95 | ierr=NF_GET_ATT_TEXT(nid,varid,"title",title) |
---|
96 | ! Its number of dimensions? |
---|
97 | ierr=NF_INQ_VARNDIMS(nid,varid,ndims) |
---|
98 | ! Its values? |
---|
99 | |
---|
100 | if(ndims==4) then ! lat, lon, alt & time |
---|
101 | |
---|
102 | ! dimout(1)=lonid |
---|
103 | ! dimout(2)=latid |
---|
104 | ! dimout(3)=altid |
---|
105 | ! dimout(4)=timeid |
---|
106 | |
---|
107 | size=(/iip1,jjp1,llm,1/) |
---|
108 | do lt=1,istime |
---|
109 | start=(/1,1,1,lt/) |
---|
110 | ! Extraction of the "source" variables |
---|
111 | #ifdef NC_DOUBLE |
---|
112 | ierr = NF_GET_VARA_DOUBLE(nid,varid,start,size,sum3d) |
---|
113 | ierr = NF_GET_VARA_DOUBLE(nid,varid+1,start,size,square3d) |
---|
114 | #else |
---|
115 | ierr = NF_GET_VARA_REAL(nid,varid,start,size,sum3d) |
---|
116 | ierr = NF_GET_VARA_REAL(nid,varid+1,start,size,square3d) |
---|
117 | #endif |
---|
118 | ! Calculation of these variables |
---|
119 | mean3d=sum3d/count(lt) |
---|
120 | sd3d=sqrt(max(0.,square3d/count(lt)-mean3d**2)) |
---|
121 | ! Writing of the variables |
---|
122 | #ifdef NC_DOUBLE |
---|
123 | ierr = NF_PUT_VARA_DOUBLE(nid,varid,start,size,mean3d) |
---|
124 | ierr = NF_PUT_VARA_DOUBLE(nid,varid+1,start,size,sd3d) |
---|
125 | #else |
---|
126 | ierr = NF_PUT_VARA_REAL(nid,varid,start,size,mean3d) |
---|
127 | ierr = NF_PUT_VARA_REAL(nid,varid+1,start,size,sd3d) |
---|
128 | #endif |
---|
129 | enddo |
---|
130 | |
---|
131 | else if (ndims.eq.3) then |
---|
132 | |
---|
133 | ! dimout(1)=lonid |
---|
134 | ! dimout(2)=latid |
---|
135 | ! dimout(3)=timeid |
---|
136 | |
---|
137 | size=(/iip1,jjp1,1,0/) |
---|
138 | do lt=1,istime |
---|
139 | start=(/1,1,lt,0/) |
---|
140 | ! Extraction of the "source" variables |
---|
141 | #ifdef NC_DOUBLE |
---|
142 | ierr = NF_GET_VARA_DOUBLE(nid,varid,start,size,sum2d) |
---|
143 | ierr = NF_GET_VARA_DOUBLE(nid,varid+1,start,size,square2d) |
---|
144 | #else |
---|
145 | ierr = NF_GET_VARA_REAL(nid,varid,start,size,sum2d) |
---|
146 | ierr = NF_GET_VARA_REAL(nid,varid+1,start,size,square2d) |
---|
147 | #endif |
---|
148 | ! Calculation of these variables |
---|
149 | mean2d=sum2d/count(lt) |
---|
150 | sd2d=sqrt(max(0.,square2d/count(lt)-mean2d**2)) |
---|
151 | ! Writing of the variables |
---|
152 | #ifdef NC_DOUBLE |
---|
153 | ierr = NF_PUT_VARA_DOUBLE(nid,varid,start,size,mean2d) |
---|
154 | ierr = NF_PUT_VARA_DOUBLE(nid,varid+1,start,size,sd2d) |
---|
155 | #else |
---|
156 | ierr = NF_PUT_VARA_REAL(nid,varid,start,size,mean2d) |
---|
157 | ierr = NF_PUT_VARA_REAL(nid,varid+1,start,size,sd2d) |
---|
158 | #endif |
---|
159 | enddo |
---|
160 | |
---|
161 | endif |
---|
162 | enddo |
---|
163 | |
---|
164 | ierr= NF_CLOSE(nid) |
---|
165 | |
---|
166 | end |
---|