readhead.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 readhead(KGLB,PGLBLATMIN,PGLBLATMAX,PGLBLONMIN,PGLBLONMAX,&
                           KNBLAT,KNBLON,PCUTVAL,PDLAT,PDLON,PLAT,PLON,KERR,KFACT,&
                           OCOMPRESS)  
!     ################################################################
!
!!**** *READHEAD* writes the head a the local 'latlon' file.
!!
!!    PURPOSE
!!    -------
!!
!!    METHOD
!!    ------
!!
!!     A header of a data set is of the form:
!!
!!     1 line of comment
!!     nodata: -999
!!     north: 90N             (or S or nothing)
!!     south: 50N             (or S or nothing)    
!!     east: 90W              (or E or nothing)
!!     west: 110W             (or E or nothing)
!!     rows: 180
!!     cols: 60
!!   
!!    EXTERNAL
!!    --------
!!
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!
!!    REFERENCE
!!    ---------
!!
!!    AUTHOR
!!    ------
!!
!!    V. Masson              Meteo-France
!!
!!    MODIFICATION
!!    ------------
!!
!!    Original    29/08/95
!!      J.Escobar     06/2013  for REAL4/8 add EPSILON management
!!
!----------------------------------------------------------------------------
!
!*    0.     DECLARATION
!            -----------
!
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
USE modd_csts ,ONLY : xsurf_epsilon
!
IMPLICIT NONE
!
!*    0.1    Declaration of arguments
!            ------------------------
!
INTEGER,           INTENT(IN)  :: KGLB        ! logical unit of the file
REAL,              INTENT(OUT) :: PGLBLATMIN  ! min latitude  of the file.
REAL,              INTENT(OUT) :: PGLBLATMAX  ! max latitude  of the file.
REAL,              INTENT(OUT) :: PGLBLONMIN  ! min longitude of the file.
REAL,              INTENT(OUT) :: PGLBLONMAX  ! min longitude of the file.
INTEGER,           INTENT(OUT) :: KNBLAT      ! number of latitude  rows in file
INTEGER,           INTENT(OUT) :: KNBLON      ! number of longitude rows in file
REAL,              INTENT(OUT) :: PCUTVAL     ! special value in data file
REAL,              INTENT(OUT) :: PDLAT       ! latitude  mesh in the data file
REAL,              INTENT(OUT) :: PDLON       ! longitude mesh in the data file
REAL, DIMENSION(:), POINTER    :: PLAT        ! latitude  of data points
REAL, DIMENSION(:), POINTER    :: PLON        ! longitude of data points
INTEGER,           INTENT(OUT) :: KERR        ! return code
LOGICAL, INTENT(OUT) :: OCOMPRESS
INTEGER, INTENT(OUT) :: KFACT
!
!*    0.2    Declaration of local variables
!            ------------------------------
!
INTEGER                    :: JLAT       ! loop control
INTEGER                    :: JLON       ! loop control
INTEGER                    :: JHEAD      ! loop control
INTEGER                    :: ININDEX    ! index of character 'N' in YSTRING1
INTEGER                    :: ISINDEX    ! index of character 'S' in YSTRING1
INTEGER                    :: IEINDEX    ! index of character 'E' in YSTRING1
INTEGER                    :: IWINDEX    ! index of character 'W' in YSTRING1
REAL, DIMENSION(9)         :: ZVAL       ! values of the head data
INTEGER                    :: IHEAD      ! index of the data in the array ZVAL
 CHARACTER(LEN=100)         :: YSTRING    ! total string in the head
 CHARACTER(LEN=100)         :: YSTRING1   ! string less the begining line descriptor
 CHARACTER(LEN=100)         :: YVAL       ! absolute value of the data of the line
INTEGER                    :: IPOINT     ! index of '.' in the string YVAL
INTEGER                    :: ILENGTH    ! length of the string YVAL
INTEGER                    :: IFRACLENGTH! length of the fractional part in string YVAL
 CHARACTER(LEN=2)           :: YLENGTH    ! length of the string YVAL
 CHARACTER(LEN=2)           :: YFRACLENGTH! length of the fractional part in string YVAL
 CHARACTER(LEN=10)          :: YINTERNALFORMAT ! format to read YVAL in real ZVAL
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------
!
IF (lhook) CALL dr_hook('READHEAD',0,zhook_handle)
kerr=0
!
!*         1.    Line of comments
!                ----------------
!
zval(1:8) = 1.
zval(9)   = 0.
!
READ (kglb,'(A100)',end=99) ystring
!
!-------------------------------------------------------------------------------
!
!*         2.    Other lines
!                -----------
!
DO jhead=1,9
  READ (kglb,'(A100)',end=99) ystring
  ystring=adjustl(ystring)
!
!*         2.1   Selection of the line
!                ---------------------
!
  SELECT CASE (ystring(1:5))
         CASE('cutva')
           ihead=1
           ystring1=ystring(10:100)
         CASE('nodat')
           ihead=1
           ystring1=ystring(8:100)
         CASE('north')
           ihead=2
           ystring1=ystring(7:100)           
         CASE('south')
           ihead=3
           ystring1=ystring(7:100) 
         CASE('east:')
           ihead=4
           ystring1=ystring(6:100)  
         CASE('west:')
           ihead=5
           ystring1=ystring(6:100)  
         CASE('rows:')
           ihead=6
           ystring1=ystring(6:100) 
         CASE('cols:')
           ihead=7
           ystring1=ystring(6:100)
         CASE('fact:')
           ihead=8
           ystring1=ystring(6:100)
         CASE('compr')
           ihead=9
           ystring1=ystring(10:100)          
  END SELECT
!
!*         2.2   Test on presence of geographical descritor (N, E, S or W)
!                ---------------------------------------------------------
!
  inindex=index(ystring1,'N')
  isindex=index(ystring1,'S')
  ieindex=index(ystring1,'E')
  iwindex=index(ystring1,'W')
  yval=adjustl(ystring1)
  IF (inindex/=0) yval=adjustl(ystring1(1:inindex-1))
  IF (isindex/=0) yval='-'//adjustl(ystring1(1:isindex-1))
  IF (ieindex/=0) yval=adjustl(ystring1(1:ieindex-1))
  IF (iwindex/=0) yval='-'//adjustl(ystring1(1:iwindex-1))
!
!*         2.3   Transformation of the data in real
!                ----------------------------------
!
  ipoint=index(yval,'.')
  IF (ipoint==0) yval=adjustl(adjustr(yval)//'.')
!
!*         2.4   Definition of the format of the data
!                ------------------------------------
!
  ilength=len_trim(adjustl(adjustr(yval)))
  ifraclength=ilength-index(yval,'.')
  WRITE(ylength,'(I2)') ilength
  WRITE(yfraclength,'(I2)') ifraclength
  yinternalformat='(F'//ylength//'.'//yfraclength//')'
!
!*         2.5   Data definition
!                ---------------
!
  READ(yval,adjustl(yinternalformat)) zval(ihead)
!
ENDDO
!
99 CONTINUE
!-------------------------------------------------------------------------------
!
!*         3.    Initialization of arguments, longitudes and latitudes
!                -----------------------------------------------------
!
pcutval=zval(1)
pglblatmax=zval(2)
pglblatmin=zval(3)
pglblonmin=zval(5)
pglblonmax=zval(4)+nint((zval(5)-zval(4)+180.*(1.0+xsurf_epsilon))/360.)*360.
knblat=nint(zval(6))
knblon=nint(zval(7))
kfact=nint(zval(8))
ocompress = .false.
IF (zval(9)==1.) ocompress = .true.
!
pdlat=(pglblatmax-pglblatmin)/knblat
pdlon=(pglblonmax-pglblonmin)/knblon
ALLOCATE(plat(knblat))
ALLOCATE(plon(knblon))
plat(:)=(/ (pglblatmax-(jlat-0.5)*pdlat, jlat=1,knblat) /)
plon(:)=(/ (pglblonmin+(jlon-0.5)*pdlon, jlon=1,knblon) /)
!
!IF (LHOOK) CALL DR_HOOK('READHEAD',1,ZHOOK_HANDLE)
!RETURN
!KERR=-1
IF (lhook) CALL dr_hook('READHEAD',1,zhook_handle)
!-------------------------------------------------------------------------------
END SUBROUTINE readhead