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

      subroutine writecasc ( fa,lminx,lmaxx,lminy,lmaxy,nis,njs,nks, 9,1
     $                                         nomvar,con,ind_o,unf )
      implicit none
*
      character* (*) nomvar
      integer lminx,lmaxx,lminy,lmaxy,nis,njs,nks,ind_o(*),unf
      real fa(*),con
*
**
#include "grd.cdk"
#include "sor.cdk"
#include "partopo.cdk"
*
      integer k,n,nbits,nb
      real tr1(nis,njs,nks)
      real, dimension (:), allocatable :: wkc
*
*----------------------------------------------------------------------
*
*     Writing field 'nomvar' if fa to binary fortran file unit=unf
*
      call blkcol ( tr1,nis,njs,g_id,g_if,g_jd,g_jf,con,
     $              fa,lminx,lmaxx,lminy,lmaxy,nks,ind_o,nks )
*
      nb = 0
      nbits = Grdc_nbits
*
      if (blocme.eq.0) then
         write (unf) nomvar(1:4),nis,njs,nks,nbits
         if (nbits.ge.32) then
            write (unf) tr1
         else
            n = (nis*njs*nbits+120+32-1)/32
            allocate (wkc(n))
            do k=1,nks
               call xxpak (tr1(1,1,k), wkc, nis, njs, -nbits, nb, 1)
               write (unf) wkc
            end do
            deallocate (wkc)
         endif
      endif
*
*----------------------------------------------------------------------
      return
      end
*
***s/r writecasb

      subroutine writecasb (fa,lminx,lmaxx,lminy,lmaxy,is,nis,js,jn,njs, 8,4
     $                        iw,ie,niw,jw,njw,nks,nomvar,con,ind_o,unf)
      implicit none
*
      character* (*) nomvar
      integer lminx,lmaxx,lminy,lmaxy,nks,ind_o(*),unf
      integer is,nis,js,jn,njs,iw,ie,niw,jw,njw
      real fa(*),con
*
**
#include "grd.cdk"
#include "partopo.cdk"
*
      integer i,j,k,ns,nw,nbits,nb
      real wks(nis*njs*nks,2), wkw(niw*njw*nks,2)
      real fs (nis,njs*2,nks), fw (niw*2,njw,nks)
      real, dimension (:), allocatable :: wkc,wkd
*
*----------------------------------------------------------------------
*
      call glbcolc2 ( wks,is,is+nis-1,js,js+njs-1,fa,
     $                   lminx,lmaxx,lminy,lmaxy,nks,ind_o,nks )
      call glbcolc2 ( wks(1,2),is,is+nis-1,jn,jn+njs-1,fa,
     $                   lminx,lmaxx,lminy,lmaxy,nks,ind_o,nks )
*
      call glbcolc2 ( wkw,iw,iw+niw-1,jw,jw+njw-1,fa,
     $                   lminx,lmaxx,lminy,lmaxy,nks,ind_o,nks )
      call glbcolc2 ( wkw(1,2),ie,ie+niw-1,jw,jw+njw-1,fa,
     $                   lminx,lmaxx,lminy,lmaxy,nks,ind_o,nks )
*
      do k=1,nks
         do j=1,njs
         do i=1,nis
            fs(i,j,k)     = wks((k-1)*nis*njs+(j-1)*nis+i,1)
            fs(i,njs+j,k) = wks((k-1)*nis*njs+(j-1)*nis+i,2)
         end do 
         end do
         do j=1,njw
         do i=1,niw
            fw(i,j,k)     = wkw((k-1)*niw*njw+(j-1)*niw+i,1)
            fw(niw+i,j,k) = wkw((k-1)*niw*njw+(j-1)*niw+i,2)
         end do 
         end do
      end do
*
      nb = 0
      nbits = Grdc_nbits
*
      if (myproc.eq.0) then
         write (unf) nomvar(1:4),nis,njs,niw,njw,nks,nbits
         if (nbits.ge.32) then
            write (unf) fs,fw
         else
            ns = (nis*njs*2*nbits+120+32-1)/32
            allocate (wkc(ns))
            nw = (niw*njw*2*nbits+120+32-1)/32
            allocate (wkd(nw))
            do k=1,nks
               call xxpak (fs(1,1,k), wkc, nis,njs*2,-nbits,nb,1)
               call xxpak (fw(1,1,k), wkd, niw*2,njw,-nbits,nb,1)
               write (unf) wkc,wkd
            end do
            deallocate (wkc,wkd)
         endif
      endif
*
*----------------------------------------------------------------------
      return
      end
*

      subroutine minmaxf (fa,lminx,lmaxx,lminy,lmaxy,nks,nomvar)
      implicit none
*
      character* (*) nomvar
      integer lminx,lmaxx,lminy,lmaxy,nks
      real fa(lminx:lmaxx,lminy:lmaxy,nks)
*
      integer i,j,k
      real m1,m2
*
      m1 =  1.e20
      m2 = -1.e20
      do k=1,nks
      do j=lminy,lmaxy
      do i=lminx,lmaxx
         m1 = min(m1,fa(i,j,k))
         m2 = max(m2,fa(i,j,k))          
      end do
      end do
      end do
      print*, 'MINMAX: ',m1,m2,nomvar(1:4) 
*
      return
      end