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

      subroutine out_wrphyoc ( outbus,wrponm,wrpopar,ngth,stepno,ind_o ) 2,2
      implicit none
*
      character*8 wrponm(*)
      integer wrpopar(3,*),ngth,stepno,ind_o(*)
      real outbus(*)
*
*AUTHOR     Michel Desgagne                January   2004
*
*IMPLICIT
#include "lcldim.cdk"
#include "sor.cdk"
#include "partopo.cdk"
*
**
      integer i,id,nkk,offset,nis,njs
*
*----------------------------------------------------------------------
*
      if ((out_nisl.le.0).or.(out_njsl.le.0)) return
*
      nis = out_ifg - out_idg + 1
      njs = out_jfg - out_jdg + 1
*
      call out_sfilec (stepno)
*
      do id=1,ngth
         if (wrponm(id)(1:2).eq.'I1') then
            wrponm(id) = 'HS'
            wrpopar(3,id) = 1
         endif
      end do
*
      if (blocme.eq.0) then
         write (out_unfc) 'PHYSICSS',ngth
         write (out_unfc) (wrponm(id),wrpopar(2,id),wrpopar(3,id),
     $                                                 id=1,ngth)
      endif
      do id=1,ngth
         offset = wrpopar(1,id) 
         nkk = wrpopar(3,id)
         if (wrpopar(2,id).ge.2) nkk = gnk
         if (wrponm(id)(1:2).eq.'HS') then
            do i=1,ldni*ldnj
               outbus(offset+i-1)=outbus(offset+i-1)/0.3
            end do
         endif
         call writecasc ( outbus(offset),1,ldni,1,ldnj,nis,njs,nkk,
     $                               wrponm(id),1.0,ind_o,out_unfc )
      end do
*
      do id=1,ngth
         if (wrponm(id)(1:2).eq.'HS') then
            wrponm(id) = 'I1'
            wrpopar(3,id) = 2
         endif
      end do
*
      if (stepno.eq.0) then
         close (out_unfc)
         out_unfc = 0
      endif
*
*----------------------------------------------------------------------
      return
      end