source: LMDZ6/branches/LMDZ_DECOUPLE/libf/obsolete/inistats.F90 @ 4848

Last change on this file since 4848 was 2321, checked in by Ehouarn Millour, 9 years ago

Create the "obsolete" directory where old and unused stuff should go. And move some obsolete routines there.
Minor correction in "print_control_mod": use "opened" argument to inquire instead of "exist".
EM

  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
File size: 3.8 KB
Line 
1SUBROUTINE 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
127END SUBROUTINE inistats
128
Note: See TracBrowser for help on using the repository browser.