copyright (C) 2001  MSC-RPN COMM  %%%MC2%%%
*

      subroutine out_dynr (trname,ind_o,nk_o,nsor) 3,19
      implicit none
*
      character*8 trname(*)
      integer ind_o(*),nk_o,nsor
*
#include "dynmem.cdk"
#include "partopo.cdk"
#include "rec.cdk"
#include "topo.cdk"
#include "yomdyn1.cdk"
#include "vinterpo.cdk"
#include "sor.cdk"
*
      integer pnprog,i,j,k,nl,nkk,err,cnt,glmx
      real tmod(dim3d), prw(dim3d), prt(dim3d), prm(dim3d+dim2d),
     $     intlev(nkout)
*
*------------------------------------------------------------------
*
      call out_sfile (nsor,gnstepno)
*
      pnprog = int (dble(gnstepno) * grdt / 3600. + 1.e-12)
*
      glmx = -1
      do i=1,nvardyn
         if (udolist(i).eq.'MX') glmx = i
      end do      
      if ((out_lt.eq.'cm').or.(glmx.gt.0)) then
         call ecris_fst2 (hh0,minx,maxx,miny,maxy,1.,'MX  ',1.0,pnprog,
     $                                        gnstepno,3,1,1,1,out_unf)
         call ecris_fst2 (hh0(minx,miny,2),minx,maxx,miny,maxy,2.,
     $                 'MX  ',1.0,pnprog,gnstepno,3,1,1,1,out_unf)
      else
         call ecris_fst2 (hh0,minx,maxx,miny,maxy,0.,'ME  ',1.0,pnprog,
     $                                       gnstepno,-1,1,1,1,out_unf)
      endif
*
      if (gnstepno.eq.0) call hauteurs
*
      call padbuf ( ppp,minx,maxx,miny,maxy,gnk+1 )
      call padbuf ( uup,minx,maxx,miny,maxy,gnk   )
      call padbuf ( vvp,minx,maxx,miny,maxy,gnk   )
      call padbuf ( wwp,minx,maxx,miny,maxy,gnk   )
      call padbuf ( bbp,minx,maxx,miny,maxy,gnk   )
      call padbuf ( hup,minx,maxx,miny,maxy,gnk   )
*
      call fullpr ( prw,prt,prm,ppp,ht,hm,dim2d,gnk )
*
      if (levtyp.ne.'G') then
         call out_lev (intlev,nl,pres_o,prw,height_o,dim2d,gnk,nkout)
         nkk = nl
         nk_o= nkk
      else
         nl  = 0
         nkk = gnk
      endif
*
      if (levtyp.ne.'G') then
         call hpalloc (papositd, dim2d*     nkk*6  , err,1)
         call hpalloc (pahuvd  , dim2d* (gnk+4)*2  , err,1)
         call hpalloc (pahttd  , dim2d* (gnk+3)*2  , err,1)
         call hpalloc (pahwwd  , dim2d* (gnk+3)*2  , err,1)
      endif
*
      if (myproc.eq.0) print 
     $   '(/" PROG ",i3,"HR",10x,"TIME STEP NO: ",i5)',pnprog,gnstepno
*
*        Geopotential, Temperature and PNM.
*
      call out_tgz (bbp,hup,tmod,prw,prt,prm,hw,ht,hm,intlev,dim2d,
     $                           gnk,nkk,ind_o,nk_o,pnprog,out_unf)
*
*        Horizontal Winds and pressure (QX)
*
      call out_uv (uup,vvp,prm,ppp,ht,hm,sbx,sby,sbxy,intlev,dim2d,gnk+1,
     $                                   nkk,ind_o,nk_o,pnprog,out_unf)
*
*        Humidity, Vertical motion and surface pressure (P0,PN)
*
      call out_eshw(wwp,tmod,hup,prw,prt,intlev,dim2d,gnk,nkk,
     $                              ind_o,nk_o,pnprog,out_unf)
*
*        Tracers
*
      if (ntr.gt.0) then
         call padbuf (trp,minx,maxx,miny,maxy,gnk*ntr)
         call out_tr (trp,prt,intlev,trname,dim2d,gnk,nkk,
     $                          ind_o,nk_o,pnprog,out_unf)
      endif
*
      if (levtyp.ne.'G') then
         call hpdeallc (papositd,err,1)
         call hpdeallc (pahuvd  ,err,1)
         call hpdeallc (pahttd  ,err,1)
         call hpdeallc (pahwwd  ,err,1)
         papositd = 0
         pahuvd   = 0
         pahttd   = 0
         pahwwd   = 0
      endif
*
      call out_cfile
*
*------------------------------------------------------------------
      return
      end