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

      subroutine out_dync (trname) 2,9
      implicit none
*
      character*8 trname(*)
*
#include "consdyn_8.cdk"
#include "dynmem.cdk"
#include "rec.cdk"
#include "topo.cdk"
#include "yomdyn.cdk"
#include "sor.cdk"
#include "partopo.cdk"
*
      integer i,j,k,nis,njs,ind_o(gnk+1),cnt
      real us(minx:maxx,miny:maxy,gnk),vs(minx:maxx,miny:maxy,gnk)
*
*------------------------------------------------------------------
*
      if ((out_nisl.le.0).or.(out_njsl.le.0)) return
*
      call out_sfilec (gnstepno)
*
      nis = out_ifg - out_idg + 1
      njs = out_jfg - out_jdg + 1
      do k=1,gnk+1
         ind_o(k) = k
      end do
*
      do k=1,gnk
      do j=1,ldnj
      do i=1,ldni
         us(i,j,k) = uup(i,j,k) * sqrt(sby(i,j))
         vs(i,j,k) = vvp(i,j,k) * sqrt(sbx(i,j))
      end do
      end do
      end do
*
      cnt = 0
      do 10 i=1,nvardyn
      do k=1,ntr
         if (udolist(i).eq.trname(k)) then
            cnt = cnt + 1
            goto 10
         endif
      end do   
 10   continue
*
      if (blocme.eq.0) write (out_unfc) 'DYNAMICS',cnt + 7
      call writecasc ( hh0,minx,maxx,miny,maxy,nis,njs,2    ,'MX  ',
     $                                          1.0,ind_o,out_unfc )
      call writecasc (  us,minx,maxx,miny,maxy,nis,njs,gnk,'UU  ',
     $                                          1.0,ind_o,out_unfc )
      call writecasc (  vs,minx,maxx,miny,maxy,nis,njs,gnk,'VV  ',
     $                                          1.0,ind_o,out_unfc )
      call writecasc ( wwp,minx,maxx,miny,maxy,nis,njs,gnk  ,'WZ  ',
     $                                          1.0,ind_o,out_unfc )
      call writecasc ( bbp,minx,maxx,miny,maxy,nis,njs,gnk  ,'BUOY',
     $                                          1.0,ind_o,out_unfc )
      call writecasc ( ppp,minx,maxx,miny,maxy,nis,njs,gnk+1,'PREG',
     $                                          1.0,ind_o,out_unfc )
      call writecasc ( hup,minx,maxx,miny,maxy,nis,njs,gnk  ,'HU  ',
     $                                          1.0,ind_o,out_unfc )
      do 20 i=1,nvardyn
      do k=1,ntr
         if (udolist(i).eq.trname(k)) then
            call writecasc ( trp(minx,miny,1,k),minx,maxx,miny,maxy,
     $                       nis,njs,gnk,trname(k),1.0,ind_o,out_unfc )
            goto 20
         endif
      end do   
 20   continue
*
      if ((gnstepno.ne.0).or.(gnmaphy.eq.0)) then
         close (out_unfc)
         out_unfc = 0
      endif
*
*------------------------------------------------------------------
      return
      end
*