source: LMDZ5/trunk/libf/obsolete/inistats.F90 @ 5414

Last change on this file since 5414 was 2321, checked in by Ehouarn Millour, 10 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
RevLine 
[1992]1SUBROUTINE inistats(ierr)
[1486]2
[2315]3  USE vertical_layers_mod, ONLY: ap,bp,preff,presnivs,pseudoalt
4
[1992]5  IMPLICIT NONE
[1486]6
[1992]7  include "dimensions.h"
8  include "paramet.h"
9  include "comgeom.h"
10  include "comconst.h"
11  include "statto.h"
12  include "netcdf.inc"
[1486]13
[1992]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
[1486]21
[1992]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'
[1486]31
[1992]32  IF (mod(nsteppd,istime)/=0) STOP &
33    'Dans Instat:  1jour .ne. n*istime pas physiques'
[1486]34
[1992]35  istats = nsteppd/istime
36  WRITE (*, *) 'istats=', istats
37  WRITE (*, *) 'Storing ', istime, 'times per day'
38  WRITE (*, *) 'thus every ', istats, 'physical timestep '
39  WRITE (*, *)
[1486]40
[1992]41  DO l = 1, llm
42    sig_s(l) = ((ap(l)+ap(l+1))/preff+bp(l)+bp(l+1))/2.
43  END DO
[1486]44
[1992]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
[1486]50
[1992]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)
[1486]56
[1992]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
[1486]61
[1992]62  CALL def_var_stats(nid, 'latitude', 'latitude', 'degrees_north', 1, &
63    idim_lat, nvarid, ierr)
[1486]64#ifdef NC_DOUBLE
[1992]65  ierr = nf_put_var_double(nid, nvarid, rlatu/pi*180)
[1486]66#else
[1992]67  ierr = nf_put_var_real(nid, nvarid, rlatu/pi*180)
[1486]68#endif
[1992]69  CALL def_var_stats(nid, 'longitude', 'East longitude', 'degrees_east', 1, &
70    idim_lon, nvarid, ierr)
[1486]71#ifdef NC_DOUBLE
[1992]72  ierr = nf_put_var_double(nid, nvarid, rlonv/pi*180)
[1486]73#else
[1992]74  ierr = nf_put_var_real(nid, nvarid, rlonv/pi*180)
[1486]75#endif
76
[1992]77  ! Niveaux verticaux, aps et bps
78  ierr = nf_redef(nid)
79  ! presnivs
[1486]80#ifdef NC_DOUBLE
[1992]81  ierr = nf_def_var(nid, 'presnivs', nf_double, 1, idim_llm, nvarid)
[1486]82#else
[1992]83  ierr = nf_def_var(nid, 'presnivs', nf_float, 1, idim_llm, nvarid)
[1486]84#endif
[1992]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)
[1486]89#ifdef NC_DOUBLE
[1992]90  ierr = nf_put_var_double(nid, nvarid, presnivs(1:llm))
[1486]91#else
[1992]92  ierr = nf_put_var_real(nid, nvarid, presnivs(1:llm))
93#endif
94  ! Pseudo alts
[1486]95#ifdef NC_DOUBLE
[1992]96  ierr = nf_def_var(nid, 'altitude', nf_double, 1, idim_llm, nvarid)
[1486]97#else
[1992]98  ierr = nf_def_var(nid, 'altitude', nf_float, 1, idim_llm, nvarid)
[1486]99#endif
[1992]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)
[1486]104#ifdef NC_DOUBLE
[1992]105  ierr = nf_put_var_double(nid, nvarid, pseudoalt)
[1486]106#else
[1992]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
[1486]116
[1992]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
[1486]124
[1992]125  ierr = nf_close(nid)
[1486]126
[1992]127END SUBROUTINE inistats
[1486]128
Note: See TracBrowser for help on using the repository browser.