prep_restart_coupl_topd.F90

Go to the documentation of this file.

!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt  
!SFX_LIC for details. version 1.
!######
SUBROUTINE prep_restart_coupl_topd (UG, U, &
                                    hprogram,ki)
!###################################################################
!
!!****  * PREP_RESTART_COUPL_TOPD*  
!!
!!    PURPOSE
!!    -------
!!   
!!    Write all files needed in case of restart of a simulation coupling SURFEX
!!     and TOPODYN
!!      
!!    REFERENCE
!!    ---------
!!      
!!    AUTHOR
!!    ------
!!      B. Vincendon
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    07/06/11 
!-------------------------------------------------------------------------------
!
!*       0.     DECLARATIONS
!               ------------
!
!
!
USE modd_surf_atm_grid_n, ONLY : surf_atm_grid_t
USE modd_surf_atm_n, ONLY : surf_atm_t
!
USE modd_topd_par, ONLY : nunit
USE modd_topodyn,       ONLY : nncat, xqtot, nnb_topd_step,&
                                 xqb_run, xqb_dr
USE modd_coupling_topd, ONLY : xas_nature,&
                                 nnb_stp_restart, xwtopt,&
                                 xrun_torout, xdr_torout
!
!
USE modi_get_luout
USE modi_open_file
USE modi_close_file
!
USE modi_write_file_map
USE modi_unpack_same_rank
USE modi_write_file_isbamap
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!*      0.1    declarations of arguments
!
!
TYPE(surf_atm_grid_t), INTENT(INOUT) :: ug
TYPE(surf_atm_t), INTENT(INOUT) :: u
!
 CHARACTER(LEN=6), INTENT(IN)         :: hprogram ! program calling surf. schemes
INTEGER,          INTENT(IN)         :: ki       ! Surfex grid dimension
!
!*      0.2    declarations of local variables
!
INTEGER                        :: iluout      ! unit of output listing file
INTEGER                        :: jstp, jj    ! loop control indexes
REAL, DIMENSION(:),ALLOCATABLE :: zas         ! Saturated area fraction for each Isba meshes
 CHARACTER(LEN=30)              :: yvar        ! name of results file
REAL(KIND=JPRB) :: zhook_handle
!-------------------------------------------------------------------------------
IF (lhook) CALL dr_hook('PREP_RESTART_COUPL_TOPD',0,zhook_handle)
!
 CALL get_luout(hprogram,iluout)
!
! * 1. Write stock files
!          
WRITE(iluout,*) 'Write STOCK file'
!
 CALL open_file('ASCII ',nunit,hfile='stocks_sav.txt',hform='FORMATTED',haction='WRITE')
DO jstp = 1,nnb_stp_restart
  WRITE(nunit,*)  xrun_torout(1:nncat,jstp+nnb_topd_step), xdr_torout(1:nncat,jstp+nnb_topd_step)
ENDDO
 CALL close_file('ASCII ',nunit)
!  
! * 2. Write pixels water content
!
WRITE(iluout,*) 'Write pixels water content files'
!
yvar = '_xwtop_sav.map'
 CALL write_file_map(xwtopt,yvar)
! 
! * 3. Write Asat files
! 
WRITE(iluout,*) 'Write Asat files'
!
ALLOCATE(zas(ki))
 CALL unpack_same_rank(u%NR_NATURE,xas_nature,zas)
!
 CALL open_file('ASCII ',nunit,hfile='surfcont_sav.map',hform='FORMATTED',haction='WRITE')
 CALL write_file_isbamap(ug, &
                         nunit,zas,ki)
 CALL close_file('ASCII ',nunit)
!
IF (lhook) CALL dr_hook('PREP_RESTART_COUPL_TOPD',1,zhook_handle)
!-------------------------------------------------------------------------------
!
END SUBROUTINE prep_restart_coupl_topd