write_file_map.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_map(PVAR,HVAR)
!     ##########################
!
!!
!!    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, ONLY : ccat, nncat, nnyc, nnxc, xx0, xy0, xdxt, nline, &
                         xtopd, xnul
!
USE modd_surf_par, ONLY : xundef
!
USE modi_get_luout
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
!
!*      0.2    declarations of local variables
 CHARACTER(LEN=50),DIMENSION(NNCAT) :: cname
 CHARACTER(LEN=40)                  :: cfmt
 CHARACTER(*),PARAMETER     :: ypfmt1="('(',I4,'(F10.3,')"
INTEGER                    :: jwrk1,jj,ji,jcat
INTEGER                    :: iindex ! reference number of the pixel
INTEGER                    :: iluout
REAL                       :: zout ! pixel not included in the catchment
REAL                       :: zmin,zmax
REAL                       :: zx1, zy1, zx2, zy2 ! left top and right bottom pixels coordinates
REAL(KIND=JPRB) :: zhook_handle
!-------------------------------------------------------------------------------
IF (lhook) CALL dr_hook('WRITE_FILE_MAP',0,zhook_handle)
!
!*       0.     Initialization:
!               ---------------
!
 CALL get_luout('OFFLIN',iluout)

zout = xundef
!
DO jcat=1,nncat
  !
  cname(jcat) = trim(ccat(jcat))//trim(hvar)
  !
  WRITE(iluout,*) cname(jcat)
  !
  CALL open_file('ASCII ',nunit,hfile=cname(jcat),hform='FORMATTED')
  !
  !*       1.0    writing header map file
  !               --------------------------------------
  !
  iindex = (nnyc(jcat)-1) * nnxc(jcat) + 1
  !
  zx1 = xx0(jcat)
  zy1 = xy0(jcat) + ( (nnyc(jcat)-1) * xdxt(jcat) )
  !
  zmin = minval(pvar(jcat,:))
  zmax = maxval(pvar(jcat,:),mask=pvar(jcat,:)/=xundef)
  !
  DO jj=1,5
    WRITE(nunit,*)
  ENDDO
  !
  WRITE(nunit,*) xx0(jcat)
  WRITE(nunit,*) xy0(jcat)
  WRITE(nunit,*) nnxc(jcat) 
  WRITE(nunit,*) nnyc(jcat)
  WRITE(nunit,*) zout
  WRITE(nunit,*) xdxt(jcat)
  WRITE(nunit,*) zmin
  WRITE(nunit,*) zmax
  !
  DO jj=1,nnyc(jcat)
    !
    DO ji=1,nnxc(jcat)
      !
      iindex = (jj - 1) * nnxc(jcat) + ji
      zx1 = xx0(jcat) + ((ji-1) * xdxt(jcat))
      zy1 = xy0(jcat) + ((jj-1) * xdxt(jcat))
      !
      IF ( xtopd(jcat,iindex).EQ.xnul(jcat) ) THEN
        !
        WRITE(nunit,*) zout
        !
      ELSEIF (nline(jcat,iindex)/=0) THEN
        !
        WRITE(nunit,*) pvar(jcat,nline(jcat,iindex))
        !
      ELSE
        !
        WRITE(nunit,*) zout
        !
      ENDIF
      !
    ENDDO
    !
  ENDDO
  !
  CALL close_file('ASCII ',nunit)
  !
ENDDO
!
IF (lhook) CALL dr_hook('WRITE_FILE_MAP',1,zhook_handle)
!
END SUBROUTINE write_file_map