inistats.F

Go to the documentation of this file.

      subroutine inistats(ierr)

      implicit none

#include "dimensions.h"
#include "paramet.h"
#include "comgeom.h"
#include "comvert.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).gt.1.e-8*daysec)
     &   stop.ne.'Dans Instat:  1jour  n pas physiques'

      if(mod(nsteppd,istime).ne.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.
         pseudoalt(l)=log(preff/presnivs(l))*8.  
      enddo

      ierr = nf_create("stats.nc",nf_clobber,nid)
      if (ierr.ne.nf_noerr) then
         write (*,*) nf_strerror(ierr)
         stop ""
      endif

      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