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

      subroutine out_phy ( bus_o,fni,fnj,doni,donj,ni,nj,stepno ) 2,5
      implicit none
*
      integer fni,fnj,doni,donj,ni,nj,stepno
      real bus_o(*)
*
*AUTHOR     Michel Desgagne                Nov   1995
*
*REVISION
*
*OBJECT
*    Gather the index of physics variables to write on disk 
*    for the current timestep.
*
*ARGUMENTS
*    NAMES     I/O  TYPE  A/S        DESCRIPTION
*
*   fni         I    I    S    folded dimension along X
*   fnj         I    I    S    folded dimension along Y
*   doni        I    I    S    computational hor. dimension along X
*   donj        I    I    S    computational hor. dimension along Y
*   ni          I    I    S    regular dimension along X
*   nj          I    I    S    regular dimension along Y
*   stepno      I    I    S    step number
*
*IMPLICIT
#include "lesbus.cdk"
#include "partopo.cdk"
#include "sor.cdk"
#include "lcldim.cdk"
#include "grd.cdk"
*
**
      integer i,j,k,osetn,level_id,grid_id,ngth,gthid(bus_otop),nk_o
      integer, dimension (:), allocatable :: ind_o
*----------------------------------------------------------------------
*
*########## REGULAR OUTPUT #######################################
*
      do i=1,varp_nset
*
         osetn= varp_set(i)
         level_id= varoutp_p(1,osetn)
          grid_id= varoutp_p(2,osetn)
*
*** Variables
         ngth = 0
         do 88 j=1,varoutp_nvar(osetn)
            do k=1,bus_otop
               if (varoutp_S(j,osetn).eq.bus_oname(k,1)) then
                  ngth = ngth + 1
                  gthid(ngth) = k
                  goto 88
               endif
            end do
 88      continue
*
*** Levels
         nk_o = levout_nlvl(level_id)
         allocate (ind_o(nk_o+1))
         call out_slev (level_id,nk_o,ind_o,'p')
*
*** Grid
         g_id = min(gni,max(1,gridout(1,grid_id)))
         g_if = min(gni,max(1,gridout(2,grid_id)))
         g_jd = min(gnj,max(1,gridout(3,grid_id)))
         g_jf = min(gnj,max(1,gridout(4,grid_id)))
         g_reduc = gridout(5,grid_id)
         call out_sgrid
*
* producing the output
         if (ngth.gt.0) then
            if (myproc.eq.0) then
                write (6,900) osetn,level_id,grid_id,varoutp_p(3,osetn)
                print*, (bus_oname(gthid(j),2),j=1,ngth)
            endif
*
            call out_phyr ( bus_o,gthid,ngth,fni,fnj,doni,donj,
     $                      ni,nj,stepno,ind_o,nk_o,nstepsor_d,'N' )
         endif
         deallocate (ind_o)
*
      end do
*
*#################################################################
*
*########## SPECIAL OUTPUT FOR CASCADE ###########################
*
      if (out_ontimec) then
*
*** Variables
         ngth = 0
         do 89 j=1,nvp_casc
            do k=1,bus_otop
               if (upolistc(j).eq.bus_oname(k,1)) then
                  ngth = ngth + 1
                  gthid(ngth) = k
                  goto 89
               endif
            end do
 89      continue
*
*** Levels
         nk_o = gnk
         allocate (ind_o(nk_o+1))
         levtyp = 'G'
         do k=1,nk_o+1
            ind_o(k) = k
         end do
         out_kind = 4
         out_lt   = 'cm'
*
*** Grid
         g_id = min(gni,max(1,Grdc_gid))
         g_if = min(gni,max(1,Grdc_gif))
         g_jd = min(gnj,max(1,Grdc_gjd))
         g_jf = min(gnj,max(1,Grdc_gjf))
         g_reduc = 1
         call out_sgrid
*
* producing the output
         if (ngth.gt.0) then
            if (myproc.eq.0) then
                write (6,901)
                print*, (bus_oname(gthid(j),2),j=1,ngth)
            endif
*
            call out_phyr ( bus_o,gthid,ngth,fni,fnj,doni,donj,
     $                       ni,nj,stepno,ind_o,nk_o,Grdc_nsor,'C' )
c     $                       ni,nj,stepno,ind_o,nk_o,Grdc_nsor,'A' )
         endif
         deallocate (ind_o)
         out_ontimec = .false.
*
      endif
*
*#################################################################
 900  format (/' ### ===> PHY OUTPUT SET #',i4,', Levels=',i4,
     $                              ', Grid=',i4,', Step=',i4)
 901  format (/' ### ===> SPECIAL PHYSICS OUTPUT FOR CASCADE RUN:')
*----------------------------------------------------------------------
      return
      end