copyright (C) 2001  MSC-RPN COMM  %%%MC2%%%
***s/r out_casc

      subroutine out_casc ( ppmod,bbmod,humod,uumod,vvmod,wwmod,trmod,,9
     $                                       msf,trname,ng,lnk,ip2,unf )
      implicit none
*
      character* (*) trname(*)
      integer ng,lnk,ip2,unf
      real ppmod(ng,*), bbmod(ng,*), humod(ng,*), uumod(ng,*), vvmod(ng,*),
     $     wwmod(ng,*), trmod(ng,lnk,*), msf(ng)
*
**
#include "lcldim.cdk"
#include "levels.cdk"
#include "grd.cdk"
#include "rec.cdk"
#include "sor.cdk"
*
      integer i,k,kk,nkp,ind_o(gnk+1)
      real u(ng,lnk+1),v(ng,lnk+1),zmq(lnk+1),m
*
*------------------------------------------------------------------
*
      nkp = lnk + 1
      do k=2,nkp
      do i=1,ng
         m = sqrt(msf(i))
         u(i,k) = uumod(i,k-1) * m
         v(i,k) = vvmod(i,k-1) * m
      end do
      end do
      do i=1,ng
         u(i,1) = u(i,2)
         v(i,1) = v(i,2)
      end do
      call out_stguv ( u,v,minx,maxx,miny,maxy,nkp )
*
      do k=1,lnk
         zmq(k+1) = zm(k)
         ind_o(k) = k
      end do
      zmq(1) = zt(1)
      ind_o(nkp) = nkp
*
      call ecris_fst2 (bbmod,minx,maxx,miny,maxy,ztr,'BUOY',1.0,
     $                         ip2,gnstepno,0,lnk,ind_o,lnk,unf )
      call ecris_fst2 (humod,minx,maxx,miny,maxy,ztr,'HU  ',1.0,
     $                         ip2,gnstepno,0,lnk,ind_o,lnk,unf )      
      call ecris_fst2 (wwmod,minx,maxx,miny,maxy,zt ,'WZ  ',1.0,
     $                         ip2,gnstepno,0,lnk,ind_o,lnk,unf )
*
      if (Grdc_trnm_S(1).eq.'@#$%') then
         do k=1,ntr
            call ecris_fst2 ( trmod(1,1,k),minx,maxx,miny,maxy,ztr,
     $              trname(k),1.0,ip2,gnstepno,0,lnk,ind_o,lnk,unf )
         end do
      else
         do kk=1,max_trnm
            if (Grdc_trnm_S(kk).eq.'@#$%') goto 87
            do k=1,ntr
               if (Grdc_trnm_S(kk).eq.trname(k))
     $           call ecris_fst2 ( trmod(1,1,k),minx,maxx,miny,maxy,ztr,
     $                  trname(k),1.0,ip2,gnstepno,0,lnk,ind_o,lnk,unf )
            end do
         end do
      endif
*
 87   call ecris_fst2 (    u,minx,maxx,miny,maxy,zmq,'UU  ',1.0,
     $                         ip2,gnstepno,0,nkp,ind_o,nkp,unf )   
      call ecris_fst2 (    v,minx,maxx,miny,maxy,zmq,'VV  ',1.0,
     $                         ip2,gnstepno,0,nkp,ind_o,nkp,unf )   
      call ecris_fst2 (ppmod,minx,maxx,miny,maxy,zmq,'PREG',1.0,
     $                         ip2,gnstepno,0,nkp,ind_o,nkp,unf )
*
*------------------------------------------------------------------
      return
      end