prep_grid_extern.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_grid_extern (GCP,HFILETYPE,KLUOUT,HGRIDTYPE,HINTERP_TYPE,KNI)
!     ##########################################################################
!
!!****  *PREP_GRID_EXTERN* - reads EXTERNALIZED Surface grid.
!!
!!    PURPOSE
!!    -------
!!
!!**  METHOD
!!    ------
!!
!!    EXTERNAL
!!    --------
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!
!!    REFERENCE
!!    ---------
!!
!!
!!    AUTHOR
!!    ------
!!
!!      V. Masson
!!
!!    MODIFICATIONS
!!    -------------
!!      Original   06/2003
!-------------------------------------------------------------------------------
!
!*      0. DECLARATIONS
!          ------------
!
USE modd_grid_conf_proj_n, ONLY : grid_conf_proj_t, xx, xy, xcx, xcy, ncij
!
USE modd_surfex_mpi, ONLY : wlog_mpi, nrank, npio, nproc, ncomm
USE modd_horibl, ONLY : lgloblon, lglobs, lglobn, xilo1h, xilo2h, ninloh, &
                        xla, xola, xolo, np, xloph, no
USE modd_prep,       ONLY : xlat_out, xlon_out, linterp, xx_out, xy_out
!
USE modd_grid_gauss, ONLY : xila1, xilo1, xila2, xilo2, ninla, ninlo, nilen, lrotpole, &
                            xlap, xlop, xcoef, xlat, xlon, xilatarray_g=>xilatarray        
USE modd_grid_latlonregul, ONLY : xilat1,xilon1,xilat2,xilon2,ninlat,ninlon,nilength,&
                                xilatarray_l=>xilatarray  
USE modd_grid_cartesian, ONLY : xx_ca=>xx, xy_ca=>xy, ncij_ca=>ncij, xcx_ca=>xcx, xcy_ca=>xcy
!
USE mode_gridtype_conf_proj
!
USE modi_bilin_coef
USE modi_read_surf
USE modi_prep_grid_conf_proj
USE modi_prep_grid_cartesian
USE modi_prep_grid_gauss
USE modi_prep_grid_lonlat_reg
USE modi_horibl_surf_init
USE modi_horibl_surf_coef
USE modi_arpege_stretch_a
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
USE modi_abor1_sfx
!
IMPLICIT NONE
!
!* 0.1. Declaration of arguments
!       ------------------------
!
TYPE(grid_conf_proj_t),INTENT(INOUT) :: GCP
!
 CHARACTER(LEN=6),  INTENT(IN)    :: HFILETYPE    ! file type
INTEGER,           INTENT(IN)    :: KLUOUT       ! logical unit of output listing
 CHARACTER(LEN=10),  INTENT(OUT)  :: HGRIDTYPE    ! Grid type
 CHARACTER(LEN=6),  INTENT(OUT)   :: HINTERP_TYPE ! Grid type
INTEGER,           INTENT(OUT)   :: KNI          ! number of points
!
!* 0.2 Declaration of local variables
!      ------------------------------
!
INTEGER :: IINLA, INO
INTEGER :: IRESP
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!-----------------------------------------------------------------------
!
!*   1 Type of grid
!      ------------
!
IF (lhook) CALL dr_hook('PREP_GRID_EXTERN',0,zhook_handle)
 CALL read_surf(hfiletype,'GRID_TYPE',hgridtype,iresp,hdir='-')
!
!-----------------------------------------------------------------------
!
!*   2 Reading of grid
!      ---------------
!
IF (hgridtype=='CONF PROJ ') THEN
  CALL prep_grid_conf_proj(gcp,hfiletype,hinterp_type,kni)
ELSE IF (hgridtype=='CARTESIAN ') THEN
  CALL prep_grid_cartesian(hfiletype,hinterp_type,kni)
ELSE IF (hgridtype=='GAUSS     ') THEN
  CALL prep_grid_gauss(hfiletype,hinterp_type,kni)
ELSE IF (hgridtype=='LONLAT REG') THEN
  hgridtype = 'LATLON    '
  CALL prep_grid_lonlat_reg(hfiletype,hinterp_type,kni)
ELSE
  WRITE(kluout,*) 'GRIDTYPE "',hgridtype,'" NOT ACCEPTED AS INPUT FILE FOR FIELD PREPARATION'
  CALL abor1_sfx('GRIDTYPE NOT ACCEPTED AS INPUT FILE FOR FIELD PREPARATION, '//hgridtype)
END IF
!
IF (ALLOCATED(xlat_out)) THEN
  !
  ino = SIZE(xlat_out)
  !
  IF (hgridtype=='GAUSS     ' .OR. hgridtype=='LATLON    ') THEN
    !
    IF (hgridtype=='GAUSS     ') THEN
      IF (ALLOCATED(xlat)) DEALLOCATE(xlat)
      IF (ALLOCATED(xlon)) DEALLOCATE(xlon)
      ALLOCATE(xlat(ino))
      ALLOCATE(xlon(ino))   
      IF (lrotpole) THEN
!* transformation of output latitudes, longitudes into rotated coordinates
        CALL arpege_stretch_a(ino,xlap,xlop,xcoef,xlat_out,xlon_out,xlat,xlon)
      ELSE
        xlat = xlat_out 
        xlon = xlon_out 
      END IF
    ENDIF
!
    IF (ALLOCATED(no)) DEALLOCATE(no)
    IF (ALLOCATED(xla)) DEALLOCATE(xla)
    IF (ALLOCATED(xola)) DEALLOCATE(xola)
    IF (ALLOCATED(xolo)) DEALLOCATE(xolo)
    IF (ALLOCATED(ninloh)) DEALLOCATE(ninloh)

    ALLOCATE(no(ino,4))
    ALLOCATE(xola(ino),xolo(ino))
    ALLOCATE(xla(ino,4))
    !
    IF (hgridtype=='GAUSS     ') THEN
      iinla = ninla
      ALLOCATE(ninloh(iinla+4))
      CALL horibl_surf_init(xila1,xilo1,xila2,xilo2,ninla,ninlo,ino,xlon,xlat, &
                            linterp,lgloblon,lglobn,lglobs,no, &
                            ninloh,xola,xolo,xilo1h,xilo2h,xla,xilatarray_g)
    ELSEIF (hgridtype=='LATLON    ') THEN
      iinla = ninlat
      ALLOCATE(ninloh(iinla+4))
      CALL horibl_surf_init(xilat1,xilon1,xilat2,xilon2,ninlat,ninlon, &
                            ino,xlon_out,xlat_out,linterp,lgloblon,&
                            lglobn,lglobs,no,ninloh,xola,xolo,xilo1h,&
                            xilo2h,xla,xilatarray_l)
  
    ENDIF
    !
    IF (ALLOCATED(np)) DEALLOCATE(np)
    IF (ALLOCATED(xloph)) DEALLOCATE(xloph)
    ALLOCATE(np(ino,12))
    ALLOCATE(xloph(ino,12))
  
    IF (lglobs) iinla = iinla + 2
    IF (lglobn) iinla = iinla + 2
    CALL horibl_surf_coef(ino,linterp,lgloblon,xilo1h,xilo2h,xolo,&
                          no,ninloh(1:iinla),np,xloph)
    !
  ELSEIF (hgridtype=='CONF PROJ ') THEN
    !
    IF (ALLOCATED(xcx)) DEALLOCATE(xcx)
    IF (ALLOCATED(xcy)) DEALLOCATE(xcy)
    IF (ALLOCATED(ncij)) DEALLOCATE(ncij)
    ALLOCATE(xcx(ino,3),xcy(ino,3),ncij(ino,2))
    !
    !*      2.    Transformation of latitudes/longitudes into metric coordinates of output grid
    !
    CALL xy_conf_proj(gcp%XLAT0,gcp%XLON0,gcp%XRPK,gcp%XBETA,gcp%XLATORI,gcp%XLONORI, &
                        xx_out,xy_out,xlat_out,xlon_out )  
    !  
    !*      3.    Put input field on its squared grid
    !    
    CALL bilin_coef(kluout,xx,xy,xx_out,xy_out,xcx,xcy,ncij(:,1),ncij(:,2))
    !
  ELSEIF (hgridtype=='CARTESIAN ') THEN
    !
    IF (ALLOCATED(xcx_ca)) DEALLOCATE(xcx_ca)
    IF (ALLOCATED(xcy_ca)) DEALLOCATE(xcy_ca)
    IF (ALLOCATED(ncij_ca)) DEALLOCATE(ncij_ca)    
    ALLOCATE(xcx_ca(ino,3),xcy_ca(ino,3),ncij_ca(ino,2))
    !
    CALL bilin_coef(kluout,xx_ca,xy_ca,xx_out,xy_out,xcx_ca,xcy_ca,ncij_ca(:,1),ncij_ca(:,2))
    !
  ENDIF
  !
ENDIF
!
IF (lhook) CALL dr_hook('PREP_GRID_EXTERN',1,zhook_handle)
!
!-----------------------------------------------------------------------
!
END SUBROUTINE prep_grid_extern