write_file_vecmap.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 write_file_vecmap(PVAR,HVAR,KCAT)
!     ##########################
!
!!
!!    PURPOSE
!!    -------
!        
!     
!!**  METHOD
!!    ------
!
!!    EXTERNAL
!!    --------
!!
!!    none
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------ 
!!      
!!    REFERENCE
!!    ---------
!!     
!!    AUTHOR
!!    ------
!!
!!      K. Chancibault  * Meteo-France *
!!
!!    MODIFICATIONS
!!    -------------
!!
!!      Original   25/01/2005
!-------------------------------------------------------------------------------
!
!*       0.     DECLARATIONS
!               ------------
!
USE modd_topd_par, ONLY : nunit
USE modd_topodyn
!
USE modd_surf_par, ONLY:xundef
USE modi_open_file
USE modi_close_file
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!*      0.1    declarations of arguments
!
REAL, DIMENSION(:),INTENT(IN) :: pvar   ! variable to write in the file
 CHARACTER(LEN=30), INTENT(IN) :: hvar   ! end name of the file
INTEGER,           INTENT(IN) :: kcat   ! catchment number
!
!*      0.2    declarations of local variables
!
 CHARACTER(LEN=50)          :: cname
 CHARACTER(LEN=40)          :: cfmt
INTEGER                    :: jj,ji,jk
INTEGER                    :: iindex ! reference number of the pixel
REAL                       :: zout ! pixel not included in the catchment
REAL                       :: zmin,zmax
REAL(KIND=JPRB) :: zhook_handle
!-------------------------------------------------------------------------------
IF (lhook) CALL dr_hook('WRITE_FILE_VECMAP',0,zhook_handle)
!
!*       0.     Initialization:
!               ---------------
!
zout = xundef
zmin = minval(pvar)
zmax = maxval(pvar)
!
 cname = trim(ccat(kcat))//trim(hvar)
!
 CALL open_file('ASCII ',nunit,hfile=cname,hform='FORMATTED')
!
DO ji=1,5
  WRITE(nunit,*)
ENDDO
!
WRITE(nunit,*) xx0(kcat)
WRITE(nunit,*) xy0(kcat)
WRITE(nunit,*) nnxc(kcat) 
WRITE(nunit,*) nnyc(kcat)
WRITE(nunit,*) zout
WRITE(nunit,*) xdxt(kcat)
WRITE(nunit,*) zmin
WRITE(nunit,*) zmax
!
DO ji=1,nnyc(kcat)
  DO jk=1,nnxc(kcat)
    iindex = (ji - 1) * nnxc(kcat) + jk
    IF (xtopd(kcat,iindex).EQ.xnul(kcat)) THEN
      WRITE(nunit,*) zout
    ELSE
      WRITE(nunit,*) pvar(nline(kcat,iindex))
    ENDIF
  ENDDO
ENDDO
! 
 CALL close_file('ASCII ',nunit)
!
IF (lhook) CALL dr_hook('WRITE_FILE_VECMAP',1,zhook_handle)
!
END SUBROUTINE write_file_vecmap