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

Last change on this file since 4668 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
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.