source: dynamico_lmdz/aquaplanet/LMDZ5/libf/moved/inistats.F90 @ 3927

Last change on this file since 3927 was 3815, checked in by ymipsl, 10 years ago

moved directories dyn1d and moved was empty.
YM

File size: 3.8 KB
Line 
1SUBROUTINE inistats(ierr)
2  USE comconst_phy_mod
3  USE comvert_phy_mod
4  IMPLICIT NONE
5 
6  include "dimensions.h"
7!  include "paramet.h"
8!  include "comgeom.h"
9!  include "comvert.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    pseudoalt(l) = log(preff/presnivs(l))*8.
44  END DO
45
46  ierr = nf_create('stats.nc', nf_clobber, nid)
47  IF (ierr/=nf_noerr) THEN
48    WRITE (*, *) nf_strerror(ierr)
49    STOP ''
50  END IF
51
52  ierr = nf_def_dim(nid, 'latitude', jjp1, idim_lat)
53  ierr = nf_def_dim(nid, 'longitude', iip1, idim_lon)
54  ierr = nf_def_dim(nid, 'altitude', llm, idim_llm)
55  ierr = nf_def_dim(nid, 'llmp1', llm+1, idim_llmp1)
56  ierr = nf_def_dim(nid, 'Time', nf_unlimited, idim_time)
57
58  ierr = nf_enddef(nid)
59  CALL def_var_stats(nid, 'Time', 'Time', 'hours since 0000-00-0 00:00:00', &
60    1, idim_time, nvarid, ierr)
61  ! Time is initialised later by mkstats subroutine
62
63  CALL def_var_stats(nid, 'latitude', 'latitude', 'degrees_north', 1, &
64    idim_lat, nvarid, ierr)
65#ifdef NC_DOUBLE
66  ierr = nf_put_var_double(nid, nvarid, rlatu/pi*180)
67#else
68  ierr = nf_put_var_real(nid, nvarid, rlatu/pi*180)
69#endif
70  CALL def_var_stats(nid, 'longitude', 'East longitude', 'degrees_east', 1, &
71    idim_lon, nvarid, ierr)
72#ifdef NC_DOUBLE
73  ierr = nf_put_var_double(nid, nvarid, rlonv/pi*180)
74#else
75  ierr = nf_put_var_real(nid, nvarid, rlonv/pi*180)
76#endif
77
78  ! Niveaux verticaux, aps et bps
79  ierr = nf_redef(nid)
80  ! presnivs
81#ifdef NC_DOUBLE
82  ierr = nf_def_var(nid, 'presnivs', nf_double, 1, idim_llm, nvarid)
83#else
84  ierr = nf_def_var(nid, 'presnivs', nf_float, 1, idim_llm, nvarid)
85#endif
86  ierr = nf_put_att_text(nid, nvarid, 'long_name', 15, 'Vertical levels')
87  ierr = nf_put_att_text(nid, nvarid, 'units', 2, 'Pa')
88  ierr = nf_put_att_text(nid, nvarid, 'positive', 4, 'down')
89  ierr = nf_enddef(nid)
90#ifdef NC_DOUBLE
91  ierr = nf_put_var_double(nid, nvarid, presnivs(1:llm))
92#else
93  ierr = nf_put_var_real(nid, nvarid, presnivs(1:llm))
94#endif
95  ! Pseudo alts
96#ifdef NC_DOUBLE
97  ierr = nf_def_var(nid, 'altitude', nf_double, 1, idim_llm, nvarid)
98#else
99  ierr = nf_def_var(nid, 'altitude', nf_float, 1, idim_llm, nvarid)
100#endif
101  ierr = nf_put_att_text(nid, nvarid, 'long_name', 8, 'altitude')
102  ierr = nf_put_att_text(nid, nvarid, 'units', 2, 'km')
103  ierr = nf_put_att_text(nid, nvarid, 'positive', 2, 'up')
104  ierr = nf_enddef(nid)
105#ifdef NC_DOUBLE
106  ierr = nf_put_var_double(nid, nvarid, pseudoalt)
107#else
108  ierr = nf_put_var_real(nid, nvarid, pseudoalt)
109#endif
110  ! call def_var_stats(nid,"aps","hybrid pressure at midlayers"," ",
111  ! &            1,idim_llm,nvarid,ierr)
112  ! #ifdef NC_DOUBLE
113  ! ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,aps)
114  ! #else
115  ! ierr = NF_PUT_VAR_REAL (nid,nvarid,aps)
116  ! #endif
117
118  ! call def_var_stats(nid,"bps","hybrid sigma at midlayers"," ",
119  ! &            1,idim_llm,nvarid,ierr)
120  ! #ifdef NC_DOUBLE
121  ! ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,bps)
122  ! #else
123  ! ierr = NF_PUT_VAR_REAL (nid,nvarid,bps)
124  ! #endif
125
126  ierr = nf_close(nid)
127
128END SUBROUTINE inistats
129
Note: See TracBrowser for help on using the repository browser.