!-------------------------------------- LICENCE BEGIN ------------------------------------
!Environment Canada - Atmospheric Science and Technology License/Disclaimer, 
!                     version 3; Last Modified: May 7, 2008.
!This is free but copyrighted software; you can use/redistribute/modify it under the terms 
!of the Environment Canada - Atmospheric Science and Technology License/Disclaimer 
!version 3 or (at your option) any later version that should be found at: 
!http://collaboration.cmc.ec.gc.ca/science/rpn.comm/license.html 
!
!This software is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; 
!without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. 
!See the above mentioned License/Disclaimer for more details.
!You should have received a copy of the License/Disclaimer along with this software; 
!if not, you can write to: EC-RPN COMM Group, 2121 TransCanada, suite 500, Dorval (Quebec), 
!CANADA, H9P 1J3; or send e-mail to service.rpn@ec.gc.ca
!-------------------------------------- LICENCE END --------------------------------------
copyright (C) 2001  MSC-RPN COMM  %%%MC2%%%
***s/r out_sfile_3df - to open 3DF format file for cascade mode
*
#include "model_macros_f.h"
*

      subroutine out_sfile_3df (datev,unf,msg,gid, gif, gjd, gjf, 4,1
     $                                             nvar,ntr,mode)
      implicit none
*
      character* (*) datev, msg
      integer unf, gid, gif, gjd, gjf, nvar, ntr, mode
*
*author Michel Desgagne (MC2 2001)
*
*revision
* v3_30 - Lee V. - initial version for GEM LAM 
*
#include "glb_ld.cdk"
#include "geomg.cdk"
#include "out.cdk"
#include "ptopo.cdk"
*
      integer  longueur
      external longueur
      character*2  md
      character*15 startindx
      character*512 filen
*
*------------------------------------------------------------------
*
      unf = 201
*
      write (md,'(i2.2)') mode
      write (startindx,'((i7.7),a1,(i7.7))') out_idg,'-',out_jdg
      filen= '3df'//md//'_'//datev//'_'//startindx
      filen= '../../output/casc/'//filen(1:longueur(filen))
      open (unf,file=filen,access='SEQUENTIAL',form='UNFORMATTED',
     $                                          position='APPEND')
      if (Ptopo_myproc.eq.0)
     $print *,'out_sfile_3df: opened ',filen(1:longueur(filen))
c     print *,'out_sfile_3df:,gid,out_nisg,gjd,out_njsg='
c     print *,'out_sfile_3df:',gid,out_nisg,gjd,out_njsg,'wrgeo_3df'
      call wrgeo_3df (G_xg_8(gid),out_nisg,G_yg_8(gjd),out_njsg,
     $                Geomg_z_8,Geomg_pia,Geomg_pibb,G_nk,nvar,ntr,unf)
c     print *,'out_sfile_3df: writes',msg,nvar+ntr,mode
      write (unf) msg,nvar+ntr,mode
*
*------------------------------------------------------------------
      return
      end
*

      subroutine wrgeo_3df ( xp,ni,yp,nj,z,pia,pib,nk,nvar,ntr,unf ) 2
      implicit none
*
      integer ni,nj,nk,nvar,ntr,unf
      real pia(nk), pib(nk)
      real*8 xp(ni),yp(nj),z(nk)
*
*------------------------------------------------------------------
      write (unf) '>>^^',ni,nj,nk,nvar,ntr
c     print *,'wrgeo_3df:',xp(1)
      write (unf) xp,yp
      write (unf) 'ZAB '
      write (unf) z,pia,pib
*------------------------------------------------------------------
*
      return
      end