!-------------------------------------- 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 --------------------------------------
***s/r glb_restart -
#include "model_macros_f.h"
*

      subroutine glb_restart (mode) 2,4
      implicit none
*
      character* (*) mode
*author
*    Michel Desgagne    --  Fall 2006
*
*revision
* v3_30 - Desgagne & Winger - initial version
*
*object
*	See above id.
*	
*arguments
*	none
*
*implicits
#include "glb_ld.cdk"
#include "vmmlist.cdk"
#include "ptopo.cdk"
*
*modules
*
#include "rstr.cdk"
*
      integer  vmmlod, vmmget, fnom, wkoffit
      external vmmlod, vmmget, fnom, wkoffit
*
      integer i,err,n2rstrt,G_nir,G_njr,G_nkr,hx,hy,unf,check_flag
      character*8, dimension(:), allocatable :: name_2rstrt
      real, dimension(:,:,:), allocatable :: tr1
      real wk1
      pointer (pawk1, wk1(*))
*
*     ---------------------------------------------------------------
*
      unf = 0
      err = vmmlod (vmm_token_2rstrt(1,1), vmm2rstrt)
*
      if (mode.eq.'W') then

         if (Ptopo_myproc.eq.0) then
            err  = fnom(unf,'../restart_glbdyn.bin','SEQ/UNF',0)
            write (unf) vmm2rstrt,G_ni,G_nj,G_nk
            write (unf) (vmm_name_2rstrt(i),i=1,vmm2rstrt)
         endif

         do i=1,vmm2rstrt
            err  = vmmget(vmm_token_2rstrt(i,1), pawk1, wk1 )
            if (Ptopo_myproc.eq.0) allocate (tr1(G_ni,G_nj,G_nk))
            call glbcolc (tr1, G_ni, G_nj, wk1, 
     $      vmm_token_2rstrt(i,2),vmm_token_2rstrt(i,3),
     $      vmm_token_2rstrt(i,4),vmm_token_2rstrt(i,5),
     $      vmm_token_2rstrt(i,7))
            if (Ptopo_myproc.eq.0) then
               write (unf) tr1
               deallocate (tr1)
            endif
         end do
         if (Ptopo_myproc.eq.0) call fclos (unf)

      else if (mode.eq.'R'.and.wkoffit('../restart_glbdyn.bin').eq.10) then

         check_flag = 0
         if (Ptopo_myproc.eq.0) then
            err  = fnom(unf,'../restart_glbdyn.bin','SEQ+UNF+OLD',0)
            if (err.eq.0) read (unf) n2rstrt,G_nir,G_njr,G_nkr
*
            if (n2rstrt.ne.vmm2rstrt) then
               write (6,1001) n2rstrt, vmm2rstrt
               check_flag = -1
            endif
            if (G_nir.ne.G_ni .or. G_njr.ne.G_nj .or. G_nkr.ne.G_nk) then
               write (6,1002) G_nir,G_njr,G_nkr,G_ni,G_nj,G_nk
               check_flag = -1
            endif
         endif
*
         call gem_stop ('GLB_RESTART - ABORT -',check_flag)
*
         if (Ptopo_myproc.eq.0) then
            allocate (name_2rstrt(vmm2rstrt))
            read (unf) (name_2rstrt(i),i=1,vmm2rstrt)
         endif
*
         do i=1,vmm2rstrt
            if (Ptopo_myproc.eq.0) then
               if (name_2rstrt(i).ne.vmm_name_2rstrt(i)) then
                  write (6,1003) name_2rstrt(i),vmm_name_2rstrt(i)
                  check_flag = -1
               endif
            endif
            call gem_stop ('GLB_RESTART - ABORT -',check_flag)
            if (Ptopo_myproc.eq.0) then
               allocate (tr1(G_ni,G_nj,G_nk))
               read (unf) tr1
            endif
            hx = 0
            hy = 0
            if (vmm_token_2rstrt(i,2).ne.1) hx = G_halox
            if (vmm_token_2rstrt(i,4).ne.1) hy = G_haloy
            err  = vmmget(vmm_token_2rstrt(i,1), pawk1, wk1 )
            call glbdist (tr1, G_ni, G_nj, wk1,
     $      vmm_token_2rstrt(i,2),vmm_token_2rstrt(i,3),
     $      vmm_token_2rstrt(i,4),vmm_token_2rstrt(i,5),
     $      vmm_token_2rstrt(i,7),hx,hy)
            if (Ptopo_myproc.eq.0) deallocate (tr1)
         end do
         vmm_read_done_L = .true.
         if (Ptopo_myproc.eq.0) call fclos (unf)
*
      endif
*
 1001 format (/' THE NUMBER OF VARIABLES READ IS DIFFERENT FROM THE \n',
     $         ' NUMBER OF VARIABLES EXPECTED: ',i8,' .ne. ',i8/)
 1002 format (/' THE GRID SIZE READ     (',i4,'x',i4,'x',i4,') IS DIFFERENT FROM '/,
     $         ' THE GRID SIZE EXPECTED (',i4,'x',i4,'x',i4,') '/)
 1003 format (/' THE VARIABLE NAME READ IS DIFFERENT FROM THE '/,
     $         ' VARIABLE NAME EXPECTED: "',a8,'" .ne. "',a8,'"'/)
*     ---------------------------------------------------------------
*
      return
      end