write_file_isbamap.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_isbamap (UG, KUNIT,PVAR,KI)
!     ##########################
!
!!
!!    PURPOSE
!!    -------
!        
!     
!!**  METHOD
!!    ------
!
!!    EXTERNAL
!!    --------
!!
!!    none
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------ 
!!      
!!    REFERENCE
!!    ---------
!!     
!!    AUTHOR
!!    ------
!!
!!      K. Chancibault  * Meteo-France *
!!
!!    MODIFICATIONS
!!    -------------
!!
!!      Original   25/01/2005
!!                 03/2014 (E. Artinian) manages the option CGRID='IGN'
!-------------------------------------------------------------------------------
!
!*       0.     DECLARATIONS
!               ------------
!
!
!
USE modd_surf_atm_grid_n, ONLY : surf_atm_grid_t
!
USE modd_topodyn
USE modd_surf_par,        ONLY : xundef
!
USE mode_gridtype_conf_proj
USE mode_gridtype_lonlat_reg
USE mode_gridtype_ign
!
USE modi_abor1_sfx
!
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
!
INTEGER, INTENT(IN)             :: KUNIT  ! file unit
REAL, DIMENSION(:), INTENT(IN)  :: PVAR   ! variable to write in the file
INTEGER, INTENT(IN)             :: KI    ! Grid dimensions
!
!
!*      0.2    declarations of local variables
INTEGER                    :: JJ,JI,IL
INTEGER                    :: INI,ILAMBERT
INTEGER                    :: JINDEX ! reference number of the pixel
REAL                       :: ZOUT
REAL                       :: ZMAX,ZMIN
REAL, DIMENSION(KI)        :: ZXI, ZYI     ! natural coordinates of ISBA grid (conformal projection)
REAL, DIMENSION(KI)        :: ZXN, ZYN     ! isba nodes coordinates in the Lambert II coordinates - Eram rajout
REAL, DIMENSION(KI)        :: ZDXI, ZDYI   ! Isba grid resolution in the conformal projection
REAL, DIMENSION(KI)        :: ZDX, ZDY
INTEGER                    :: IIMAX,IJMAX
REAL :: ZLONMIN,ZLONMAX,ZLATMIN,ZLATMAX
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------
IF (lhook) CALL dr_hook('WRITE_FILE_ISBAMAP',0,zhook_handle)
!
!*       0.     Initialization:
!               ---------------
!
IF(ug%G%CGRID.EQ.'CONF PROJ') THEN
 CALL get_gridtype_conf_proj(ug%G%XGRID_PAR,px=zxi,py=zyi,kimax=iimax,kjmax=ijmax,pdx=zdxi)
ELSE IF(ug%G%CGRID.EQ.'LONLAT REG') THEN
    CALL get_gridtype_lonlat_reg(ug%G%XGRID_PAR,plonmin=zlonmin,plonmax=zlonmax,             &
                                 platmin=zlatmin,platmax=zlatmax,klon=iimax,klat=ijmax, &
                                 kl=il,plon=zxi,plat=zyi)
    !
    zdxi(:)=(zlonmax-zlonmin)/(iimax-1)
    zdyi(:)=(zlatmax-zlatmin)/(ijmax-1)
ELSE IF (ug%G%CGRID=='IGN') THEN 
  CALL get_gridtype_ign(ug%G%XGRID_PAR,klambert=ilambert,kl=ini,px=zxn,py=zyn,pdx=zdx,pdy=zdy)
  ini=ki
  zdxi(:)=zdx(:)
  zdyi(:)=zdy(:)
ELSE
    CALL abor1_sfx("WRITE_FILE_ISBAMAP: TYPE DE GRILLE NON GERE PAR LE CODE")
ENDIF
!
zmax = maxval(pvar)
zmin = minval(pvar)
zout = xundef
!
DO jj=1,5
  WRITE(kunit,*)
ENDDO
!
IF(ug%G%CGRID.EQ.'IGN') THEN

    WRITE(kunit,*) zxn(1)
    WRITE(kunit,*) zyn(1)
    WRITE(kunit,*) ini
    WRITE(kunit,*) zout
    WRITE(kunit,*) zdxi(1)
    WRITE(kunit,*) zmin
    WRITE(kunit,*) zmax
    !
    DO jj = 1,ini
      WRITE(kunit,*) pvar(jj)
    ENDDO
ELSE
    WRITE(kunit,*) zxi(1)
    WRITE(kunit,*) zyi(1)
    WRITE(kunit,*) iimax
    WRITE(kunit,*) ijmax
    WRITE(kunit,*) zout
    WRITE(kunit,*) zdxi(1)
    WRITE(kunit,*) zmin
    WRITE(kunit,*) zmax
!
    DO jj = 1,ijmax
      DO ji = 1,iimax
        jindex = (jj-1) * iimax + ji
        WRITE(kunit,*) pvar(jindex)
      ENDDO
    ENDDO
ENDIF
!
IF (lhook) CALL dr_hook('WRITE_FILE_ISBAMAP',1,zhook_handle)
!
END SUBROUTINE write_file_isbamap