inistats.F90

Go to the documentation of this file.

SUBROUTINE inistats(ierr)

  USE vertical_layers_mod, ONLY: ap,bp,preff,presnivs,pseudoalt

  IMPLICIT NONE

  include "dimensions.h"
  include "paramet.h"
  include "comgeom.h"
  include "comconst.h"
  include "statto.h"
  include "netcdf.inc"

  INTEGER, INTENT (OUT) :: ierr
  INTEGER :: nid
  INTEGER :: l, nsteppd
  REAL, DIMENSION (llm) :: sig_s
  INTEGER :: idim_lat, idim_lon, idim_llm, idim_llmp1, idim_time
  REAL, DIMENSION (istime) :: lt
  INTEGER :: nvarid

  WRITE (*, *)
  WRITE (*, *) '                        || STATS ||'
  WRITE (*, *)
  WRITE (*, *) 'daysec', daysec
  WRITE (*, *) 'dtphys', dtphys
  nsteppd = nint(daysec/dtphys)
  WRITE (*, *) 'nsteppd=', nsteppd
  IF (abs(float(nsteppd)-daysec/dtphys)>1.e-8*daysec) &
    stop .ne.'Dans Instat:  1jour  n pas physiques'

  IF (mod(nsteppd,istime)/=0) stop &
    .ne.'Dans Instat:  1jour  n*istime pas physiques'

  istats = nsteppd/istime
  WRITE (*, *) 'istats=', istats
  WRITE (*, *) 'Storing ', istime, 'times per day'
  WRITE (*, *) 'thus every ', istats, 'physical timestep '
  WRITE (*, *)

  DO l = 1, llm
    sig_s(l) = ((ap(l)+ap(l+1))/preff+bp(l)+bp(l+1))/2.
  END DO

  ierr = nf_create('stats.nc', nf_clobber, nid)
  IF (ierr/=nf_noerr) THEN
    WRITE (*, *) nf_strerror(ierr)
    stop ''
  END IF

  ierr = nf_def_dim(nid, 'latitude', jjp1, idim_lat)
  ierr = nf_def_dim(nid, 'longitude', iip1, idim_lon)
  ierr = nf_def_dim(nid, 'altitude', llm, idim_llm)
  ierr = nf_def_dim(nid, 'llmp1', llm+1, idim_llmp1)
  ierr = nf_def_dim(nid, 'Time', nf_unlimited, idim_time)

  ierr = nf_enddef(nid)
  CALL def_var_stats(nid, 'Time', 'Time', 'hours since 0000-00-0 00:00:00', &
    1, idim_time, nvarid, ierr)
  ! Time is initialised later by mkstats subroutine

  CALL def_var_stats(nid, 'latitude', 'latitude', 'degrees_north', 1, &
    idim_lat, nvarid, ierr)
#ifdef NC_DOUBLE
  ierr = nf_put_var_double(nid, nvarid, rlatu/pi*180)
#else
  ierr = nf_put_var_real(nid, nvarid, rlatu/pi*180)
#endif
  CALL def_var_stats(nid, 'longitude', 'East longitude', 'degrees_east', 1, &
    idim_lon, nvarid, ierr)
#ifdef NC_DOUBLE
  ierr = nf_put_var_double(nid, nvarid, rlonv/pi*180)
#else
  ierr = nf_put_var_real(nid, nvarid, rlonv/pi*180)
#endif

  ! Niveaux verticaux, aps et bps
  ierr = nf_redef(nid)
  ! presnivs
#ifdef NC_DOUBLE
  ierr = nf_def_var(nid, 'presnivs', nf_double, 1, idim_llm, nvarid)
#else
  ierr = nf_def_var(nid, 'presnivs', nf_float, 1, idim_llm, nvarid)
#endif
  ierr = nf_put_att_text(nid, nvarid, 'long_name', 15, 'Vertical levels')
  ierr = nf_put_att_text(nid, nvarid, 'units', 2, 'Pa')
  ierr = nf_put_att_text(nid, nvarid, 'positive', 4, 'down')
  ierr = nf_enddef(nid)
#ifdef NC_DOUBLE
  ierr = nf_put_var_double(nid, nvarid, presnivs(1:llm))
#else
  ierr = nf_put_var_real(nid, nvarid, presnivs(1:llm))
#endif
  ! Pseudo alts
#ifdef NC_DOUBLE
  ierr = nf_def_var(nid, 'altitude', nf_double, 1, idim_llm, nvarid)
#else
  ierr = nf_def_var(nid, 'altitude', nf_float, 1, idim_llm, nvarid)
#endif
  ierr = nf_put_att_text(nid, nvarid, 'long_name', 8, 'altitude')
  ierr = nf_put_att_text(nid, nvarid, 'units', 2, 'km')
  ierr = nf_put_att_text(nid, nvarid, 'positive', 2, 'up')
  ierr = nf_enddef(nid)
#ifdef NC_DOUBLE
  ierr = nf_put_var_double(nid, nvarid, pseudoalt)
#else
  ierr = nf_put_var_real(nid, nvarid, pseudoalt)
#endif
  ! call def_var_stats(nid,"aps","hybrid pressure at midlayers"," ",
  ! &            1,idim_llm,nvarid,ierr)
  ! #ifdef NC_DOUBLE
  ! ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,aps)
  ! #else
  ! ierr = NF_PUT_VAR_REAL (nid,nvarid,aps)
  ! #endif

  ! call def_var_stats(nid,"bps","hybrid sigma at midlayers"," ",
  ! &            1,idim_llm,nvarid,ierr)
  ! #ifdef NC_DOUBLE
  ! ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,bps)
  ! #else
  ! ierr = NF_PUT_VAR_REAL (nid,nvarid,bps)
  ! #endif

  ierr = nf_close(nid)

END SUBROUTINE inistats