1 | SUBROUTINE inistats(ierr) |
---|
2 | |
---|
3 | USE vertical_layers_mod, ONLY: ap,bp,preff,presnivs,pseudoalt |
---|
4 | |
---|
5 | IMPLICIT NONE |
---|
6 | |
---|
7 | include "dimensions.h" |
---|
8 | include "paramet.h" |
---|
9 | include "comgeom.h" |
---|
10 | include "comconst.h" |
---|
11 | include "statto.h" |
---|
12 | include "netcdf.inc" |
---|
13 | |
---|
14 | INTEGER, INTENT (OUT) :: ierr |
---|
15 | INTEGER :: nid |
---|
16 | INTEGER :: l, nsteppd |
---|
17 | REAL, DIMENSION (llm) :: sig_s |
---|
18 | INTEGER :: idim_lat, idim_lon, idim_llm, idim_llmp1, idim_time |
---|
19 | REAL, DIMENSION (istime) :: lt |
---|
20 | INTEGER :: nvarid |
---|
21 | |
---|
22 | WRITE (*, *) |
---|
23 | WRITE (*, *) ' || STATS ||' |
---|
24 | WRITE (*, *) |
---|
25 | WRITE (*, *) 'daysec', daysec |
---|
26 | WRITE (*, *) 'dtphys', dtphys |
---|
27 | nsteppd = nint(daysec/dtphys) |
---|
28 | WRITE (*, *) 'nsteppd=', nsteppd |
---|
29 | IF (abs(float(nsteppd)-daysec/dtphys)>1.E-8*daysec) & |
---|
30 | STOP 'Dans Instat: 1jour .ne. n pas physiques' |
---|
31 | |
---|
32 | IF (mod(nsteppd,istime)/=0) STOP & |
---|
33 | 'Dans Instat: 1jour .ne. n*istime pas physiques' |
---|
34 | |
---|
35 | istats = nsteppd/istime |
---|
36 | WRITE (*, *) 'istats=', istats |
---|
37 | WRITE (*, *) 'Storing ', istime, 'times per day' |
---|
38 | WRITE (*, *) 'thus every ', istats, 'physical timestep ' |
---|
39 | WRITE (*, *) |
---|
40 | |
---|
41 | DO l = 1, llm |
---|
42 | sig_s(l) = ((ap(l)+ap(l+1))/preff+bp(l)+bp(l+1))/2. |
---|
43 | END DO |
---|
44 | |
---|
45 | ierr = nf_create('stats.nc', nf_clobber, nid) |
---|
46 | IF (ierr/=nf_noerr) THEN |
---|
47 | WRITE (*, *) nf_strerror(ierr) |
---|
48 | STOP '' |
---|
49 | END IF |
---|
50 | |
---|
51 | ierr = nf_def_dim(nid, 'latitude', jjp1, idim_lat) |
---|
52 | ierr = nf_def_dim(nid, 'longitude', iip1, idim_lon) |
---|
53 | ierr = nf_def_dim(nid, 'altitude', llm, idim_llm) |
---|
54 | ierr = nf_def_dim(nid, 'llmp1', llm+1, idim_llmp1) |
---|
55 | ierr = nf_def_dim(nid, 'Time', nf_unlimited, idim_time) |
---|
56 | |
---|
57 | ierr = nf_enddef(nid) |
---|
58 | CALL def_var_stats(nid, 'Time', 'Time', 'hours since 0000-00-0 00:00:00', & |
---|
59 | 1, idim_time, nvarid, ierr) |
---|
60 | ! Time is initialised later by mkstats subroutine |
---|
61 | |
---|
62 | CALL def_var_stats(nid, 'latitude', 'latitude', 'degrees_north', 1, & |
---|
63 | idim_lat, nvarid, ierr) |
---|
64 | #ifdef NC_DOUBLE |
---|
65 | ierr = nf_put_var_double(nid, nvarid, rlatu/pi*180) |
---|
66 | #else |
---|
67 | ierr = nf_put_var_real(nid, nvarid, rlatu/pi*180) |
---|
68 | #endif |
---|
69 | CALL def_var_stats(nid, 'longitude', 'East longitude', 'degrees_east', 1, & |
---|
70 | idim_lon, nvarid, ierr) |
---|
71 | #ifdef NC_DOUBLE |
---|
72 | ierr = nf_put_var_double(nid, nvarid, rlonv/pi*180) |
---|
73 | #else |
---|
74 | ierr = nf_put_var_real(nid, nvarid, rlonv/pi*180) |
---|
75 | #endif |
---|
76 | |
---|
77 | ! Niveaux verticaux, aps et bps |
---|
78 | ierr = nf_redef(nid) |
---|
79 | ! presnivs |
---|
80 | #ifdef NC_DOUBLE |
---|
81 | ierr = nf_def_var(nid, 'presnivs', nf_double, 1, idim_llm, nvarid) |
---|
82 | #else |
---|
83 | ierr = nf_def_var(nid, 'presnivs', nf_float, 1, idim_llm, nvarid) |
---|
84 | #endif |
---|
85 | ierr = nf_put_att_text(nid, nvarid, 'long_name', 15, 'Vertical levels') |
---|
86 | ierr = nf_put_att_text(nid, nvarid, 'units', 2, 'Pa') |
---|
87 | ierr = nf_put_att_text(nid, nvarid, 'positive', 4, 'down') |
---|
88 | ierr = nf_enddef(nid) |
---|
89 | #ifdef NC_DOUBLE |
---|
90 | ierr = nf_put_var_double(nid, nvarid, presnivs(1:llm)) |
---|
91 | #else |
---|
92 | ierr = nf_put_var_real(nid, nvarid, presnivs(1:llm)) |
---|
93 | #endif |
---|
94 | ! Pseudo alts |
---|
95 | #ifdef NC_DOUBLE |
---|
96 | ierr = nf_def_var(nid, 'altitude', nf_double, 1, idim_llm, nvarid) |
---|
97 | #else |
---|
98 | ierr = nf_def_var(nid, 'altitude', nf_float, 1, idim_llm, nvarid) |
---|
99 | #endif |
---|
100 | ierr = nf_put_att_text(nid, nvarid, 'long_name', 8, 'altitude') |
---|
101 | ierr = nf_put_att_text(nid, nvarid, 'units', 2, 'km') |
---|
102 | ierr = nf_put_att_text(nid, nvarid, 'positive', 2, 'up') |
---|
103 | ierr = nf_enddef(nid) |
---|
104 | #ifdef NC_DOUBLE |
---|
105 | ierr = nf_put_var_double(nid, nvarid, pseudoalt) |
---|
106 | #else |
---|
107 | ierr = nf_put_var_real(nid, nvarid, pseudoalt) |
---|
108 | #endif |
---|
109 | ! call def_var_stats(nid,"aps","hybrid pressure at midlayers"," ", |
---|
110 | ! & 1,idim_llm,nvarid,ierr) |
---|
111 | ! #ifdef NC_DOUBLE |
---|
112 | ! ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,aps) |
---|
113 | ! #else |
---|
114 | ! ierr = NF_PUT_VAR_REAL (nid,nvarid,aps) |
---|
115 | ! #endif |
---|
116 | |
---|
117 | ! call def_var_stats(nid,"bps","hybrid sigma at midlayers"," ", |
---|
118 | ! & 1,idim_llm,nvarid,ierr) |
---|
119 | ! #ifdef NC_DOUBLE |
---|
120 | ! ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,bps) |
---|
121 | ! #else |
---|
122 | ! ierr = NF_PUT_VAR_REAL (nid,nvarid,bps) |
---|
123 | ! #endif |
---|
124 | |
---|
125 | ierr = nf_close(nid) |
---|
126 | |
---|
127 | END SUBROUTINE inistats |
---|
128 | |
---|