source: LMDZ5/trunk/libf/phylmd/inistats.F90 @ 2237

Last change on this file since 2237 was 1992, checked in by lguez, 11 years ago

Converted to free source form files in libf/phylmd which were still in
fixed source form. The conversion was done using the polish mode of
the NAG Fortran Compiler.

In addition to converting to free source form, the processing of the
files also:

-- indented the code (including comments);

-- set Fortran keywords to uppercase, and set all other identifiers
to lower case;

-- added qualifiers to end statements (for example "end subroutine
conflx", instead of "end");

-- changed the terminating statements of all DO loops so that each
loop ends with an ENDDO statement (instead of a labeled continue).

-- replaced #include by include.

  • 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
[1992]3  IMPLICIT NONE
[1486]4
[1992]5  include "dimensions.h"
6  include "paramet.h"
7  include "comgeom.h"
8  include "comvert.h"
9  include "comconst.h"
10  include "statto.h"
11  include "netcdf.inc"
[1486]12
[1992]13  INTEGER, INTENT (OUT) :: ierr
14  INTEGER :: nid
15  INTEGER :: l, nsteppd
16  REAL, DIMENSION (llm) :: sig_s
17  INTEGER :: idim_lat, idim_lon, idim_llm, idim_llmp1, idim_time
18  REAL, DIMENSION (istime) :: lt
19  INTEGER :: nvarid
[1486]20
[1992]21  WRITE (*, *)
22  WRITE (*, *) '                        || STATS ||'
23  WRITE (*, *)
24  WRITE (*, *) 'daysec', daysec
25  WRITE (*, *) 'dtphys', dtphys
26  nsteppd = nint(daysec/dtphys)
27  WRITE (*, *) 'nsteppd=', nsteppd
28  IF (abs(float(nsteppd)-daysec/dtphys)>1.E-8*daysec) &
29    STOP 'Dans Instat:  1jour .ne. n pas physiques'
[1486]30
[1992]31  IF (mod(nsteppd,istime)/=0) STOP &
32    'Dans Instat:  1jour .ne. n*istime pas physiques'
[1486]33
[1992]34  istats = nsteppd/istime
35  WRITE (*, *) 'istats=', istats
36  WRITE (*, *) 'Storing ', istime, 'times per day'
37  WRITE (*, *) 'thus every ', istats, 'physical timestep '
38  WRITE (*, *)
[1486]39
[1992]40  DO l = 1, llm
41    sig_s(l) = ((ap(l)+ap(l+1))/preff+bp(l)+bp(l+1))/2.
42    pseudoalt(l) = log(preff/presnivs(l))*8.
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.