rien.F90

Go to the documentation of this file.

SUBROUTINE rien(CDNAMC,KTYPTR,PSLAPO,PLOCEN,&
 & PCODIL,KTRONC,KDGL,KNXLON,KNLOPA,KNOZPA,PSINLA,&
 & KHTYP,KFLEV,PREF,PVALH,PVBH,KQUAD,&
 & KDGSA,KDGEN,PEPS,LDFICP,KULOUT)  

!**** *RIEN*  - Read Input ENvironment

!     Purpose.
!     --------
!           It extracts geometry information from ARPEGE file. 


!**   Interface.
!     ----------
!        *CALL* *RIEN(CDNAMC,KTYPTR,PSLAPO,PLOCEN,
!    &           PCODIL,KTRONC,KDGL,KNXLON,KNLOPA,KNOZPA,PSINLA,
!    &           KHTYP,KFLEV,PREF,PVALH,PVBH,KQUAD,
!    &           KDGSA,KDGEN,PEPS,LDFICP,KULOUT)

!        Explicit arguments :
!        --------------------

!        Input-Output:
!        ----------------------------

!        CDNAMC        ...   Name of the cadre

!        Determination of reference geometry:

!        KTYPTR        ...   Type of Schmidt transform
!                            1  ===>  Pole is at geog. North Pole
!                            and stretching is equal to 1
!                            2  ===>  General case
!        PSLAPO        ...   Sinus latitude of pole of dilatation
!        PLOCEN        ...   Longitude of pole of dilatation
!        PCODIL        ...   Stretching factor
!        KTRONC        ...   Truncation
!        KDGL          ...   Number of latitudes without poles
!        KNXLON        ...   Max. number of longitudes at a parallel
!        KNLOPA        ...   Number of longitudes at a parallel
!        KNOZPA        ...   Max. wave number at a parallel
!        KHTYP         ...   Type of collocation grid
!                            0 ==>   regular grid
!                            2 ==>   reduced grid towards the poles
!        KFLEV         ...   Number of vertical levels
!        PREF          ...   Reference pressure
!        PVALH         ...   "A" coefficients of vertical system
!        PVBH          ...   "B" coefficients of vertical system
!        KQUAD         ...   Quadrature ( 1 : Gauss ; 2 : Lobatto)
!        LDFICP        ...   .TRUE.  if file contains the poles
!   -----------------------------------------------------------------
!        Input :
!        -------

!        KDGSA         ...   First row of arrays KNLOPA and KNOZPA
!        KDGEN         ...   Last row of arrays KNLOPA and KNOZPA
!        PEPS          ...   Precision of the tests on real variables
!        KULOUT        ...   Output file unit
!   -----------------------------------------------------------------

!        Output:
!        ----------------------------

!        PSINLA        ...   Sinus of latitudes

!   -----------------------------------------------------------------

!        Implicit arguments :
!        --------------------
!        None.

!     Method.
!     -------
!        See documentation

!     Externals.
!     ----------

!     Reference.
!     ----------
!        ARPEGE/ALADIN Documentation.
!        Document 'Control of coherence between namelist and Arpege File'
!        by R. El Khatib

!     Original CHIEN Author
!     -------
!        Radmila Bubnova *GMAP/COMPAS - stage MICECO*


!     Modifications.
!     --------------
!        Original : 91-12-10
!        O. Marsden : May 2016 Extracted the KINF==1 case from CHIEN, to clean up GEOMETRY intents
!     ------------------------------------------------------------------

USE parkind1  ,ONLY : jpim     ,jprb
USE yomhook   ,ONLY : lhook,   dr_hook

!     ------------------------------------------------------------------

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(INOUT) :: KFLEV 
INTEGER(KIND=JPIM),INTENT(IN)    :: KDGSA 
INTEGER(KIND=JPIM),INTENT(IN)    :: KDGEN 
CHARACTER(LEN=16) ,INTENT(IN)    :: CDNAMC
INTEGER(KIND=JPIM),INTENT(INOUT) :: KTYPTR 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PSLAPO 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PLOCEN 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PCODIL 
INTEGER(KIND=JPIM),INTENT(INOUT) :: KTRONC 
INTEGER(KIND=JPIM),INTENT(INOUT) :: KDGL 
INTEGER(KIND=JPIM),INTENT(INOUT) :: KNXLON 
INTEGER(KIND=JPIM),INTENT(INOUT) :: KNLOPA(kdgsa:kdgen) 
INTEGER(KIND=JPIM),INTENT(INOUT) :: KNOZPA(kdgsa:kdgen) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PSINLA(kdgsa:kdgen) 
INTEGER(KIND=JPIM),INTENT(INOUT) :: KHTYP 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PREF 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PVALH(0:kflev) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PVBH(0:kflev) 
INTEGER(KIND=JPIM),INTENT(INOUT) :: KQUAD 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PEPS 
LOGICAL           ,INTENT(OUT)   :: LDFICP 
INTEGER(KIND=JPIM),INTENT(IN)    :: KULOUT 

!     ------------------------------------------------------------------

INTEGER(KIND=JPIM), ALLOCATABLE :: INLOPA(:),INOZPA(:)
REAL(KIND=JPRB), ALLOCATABLE :: ZVALH(:),ZVBH(:)
REAL(KIND=JPRB), ALLOCATABLE :: ZSINLA(:)
LOGICAL :: LLGARD

INTEGER(KIND=JPIM) :: IDGL, IDGNH, IERR, IERRA, IHTYP, INIVER, INLATI, &
 & INXLON, IQUADF, ISTROW, ITRONC, ITYPTR, JFLEV, JL, JLAT, JLEV, IMAXLEV, &
 & IMAXGL, IMAXLON, IMAXTRUNC 

REAL(KIND=JPRB) :: ZCLOPO, ZCODIL, ZEPS, ZMUNPOL, ZREF, ZSLAPO, ZSLOPO, ZX1
REAL(KIND=JPRB) :: ZX2
REAL(KIND=JPRB) :: ZHOOK_HANDLE

!     ------------------------------------------------------------------

#include "abor1.intfb.h"

!     ------------------------------------------------------------------

IF (lhook) CALL dr_hook('RIEN',0,zhook_handle)

!     ------------------------------------------------------------------

!*       0.    Get software limits
!              -------------------

CALL falimu(imaxlev,imaxtrunc,imaxgl,imaxlon)
ALLOCATE(inlopa(imaxgl))
ALLOCATE(inozpa(imaxgl))
ALLOCATE(zsinla(imaxgl))
ALLOCATE(zvalh(0:imaxlev))
ALLOCATE(zvbh(0:imaxlev))

!*       1.    Read file characteristics
!              -------------------------

WRITE(kulout,*) ' HAF, HAF : CADRE : ',cdnamc
CALL facies(cdnamc,ityptr,zslapo,zclopo,zslopo,zcodil,itronc,&
 & inlati,inxlon,inlopa,inozpa,zsinla,iniver,zref,zvalh,zvbh,llgard)  

IF (inlati > kdgen-kdgsa+1) THEN
  CALL abor1('RIEN : MAX. NUMBER OF LATITUDE ROWS IN MODEL TOO SMALL !')
ENDIF
IF (iniver > kflev) THEN
  CALL abor1('RIEN : MAX. NUMBER OF LEVEL IN MODEL TOO SMALL !')
ENDIF

!*       2.    Preliminary tests
!              -----------------

!              Test - type of file

IF(ityptr < 0) THEN
  WRITE(kulout,*) 'YOU ARE USING A FILE ALADIN ',&
   & 'WHILE THE MODEL EXPECTS A FILE ARPEGE'  
  CALL abor1('RIEN: ABOR1 CALLED 2a')
ENDIF

!              Test - type of collocation grid

IF(inlopa(1) == inlopa(int(inlati/2))) THEN
  ihtyp = 0
  WRITE(kulout,*) 'FILE HAS REGULAR GRID '
ELSE
  ihtyp = 2
  WRITE(kulout,*) 'FILE HAS REDUCED GRID '
ENDIF

!              Poles story

zmunpol = 0.9999999999_jprb
IF(zsinla(1) >= zmunpol) THEN
  WRITE(kulout,*) ' FILE CONTAINS THE POLES '
  ldficp = .true.
  idgl = inlati - 2
  idgnh = (idgl+1)/2
!       The following test ensures that the fields of the file
!       will be read properly :
  IF(inlopa(1) /= inlopa(2)) THEN
    WRITE(kulout,*) ' FILE ROWS #1 AND #2 DO NOT HAVE THE ',&
     & 'SAME NUMBER OF LONGITUDES'  
    WRITE(kulout,*) ' THIS MAKES THE MODEL UNABLE TO READ THE '&
     & ,'FILE PROPERLY'  
    CALL abor1('RIEN: ABOR1 CALLED 2b')
  ENDIF
ELSE
  WRITE(kulout,*) ' FILE DOES NOT CONTAINS THE POLES '
  ldficp = .false.
  idgl = inlati
  idgnh = (idgl+1)/2
ENDIF

!              Test - Gaussian or Lobatto truncation

IF(ldficp) THEN
  zx1 = 1.0_jprb - zsinla(2)
  zx2 = zsinla(2) - zsinla(3)
  IF (zx1 > zx2) THEN
    iquadf = 2
    WRITE(kulout,*) 'FILE HAS LOBATTO QUADRATURE'
    IF(mod(inlati,2) == 0) THEN
      WRITE(kulout,*) ' WARNING ! INLATI IS EVEN !'
    ENDIF
  ELSE
    iquadf = 1
    WRITE(kulout,*) 'FILE HAS GAUSSIAN QUADRATURE'
    IF(mod(inlati,2) == 1) THEN
      WRITE(kulout,*) ' WARNING ! INLATI IS ODD !'
    ENDIF
  ENDIF
ELSE
  iquadf = 1
  WRITE(kulout,*) 'FILE HAS GAUSSIAN QUADRATURE'
  IF(mod(inlati,2) == 1) THEN
    WRITE(kulout,*) ' WARNING ! INLATI IS ODD !'
  ENDIF
ENDIF



!*       4.    Read information from file (extracted from CHIEN) 

!*      4.1  Pole of dilatation, stretching, truncation, coef. A, B

  khtyp  = ihtyp
  kquad  = iquadf
  ktyptr = ityptr
  pcodil = zcodil
  pslapo = zslapo
  plocen = sign(1.0_jprb,zslopo)*acos(zclopo)
  ktronc = itronc
  kflev  = iniver
  pref   = zref
  DO jlev = 0,kflev
    pvalh(jlev) = zvalh(jlev)
    pvbh(jlev)  = zvbh(jlev)
  ENDDO

!*      4.2  Latitudes and longitudes.

  knxlon = inxlon
  IF(ldficp) THEN
    kdgl = idgl
    DO jl= 0, idgnh
      psinla(jl) = zsinla(jl+1)
      knlopa(jl) = inlopa(jl+1)
      knozpa(jl) = inozpa(jl+1)
    ENDDO
    DO jl=0, idgnh
      psinla(kdgl+1 - jl) =  - zsinla(jl+1)
      knlopa(kdgl+1 - jl) = inlopa(jl+1)
      knozpa(kdgl+1 - jl) = inozpa(jl+1)
    ENDDO
  ELSE
    kdgl = idgl
    DO jl= 1, idgnh
      psinla(jl) = zsinla(jl)
      knlopa(jl) = inlopa(jl)
      knozpa(jl) = inozpa(jl)
    ENDDO
    DO jl=1, idgnh
      psinla(kdgl - jl + 1) =  - zsinla(jl)
      knlopa(kdgl - jl + 1) = inlopa(jl)
      knozpa(kdgl - jl + 1) = inozpa(jl)
    ENDDO
    IF (kdgsa < 1) THEN
      psinla(0) = 1.0_jprb
      knlopa(0) = inlopa(1)
      knozpa(0) = inozpa(1)
    ENDIF
    IF (kdgen > kdgl) THEN
      psinla(kdgl+1) =  - 1.0_jprb
      knlopa(kdgl+1) = inlopa(1)
      knozpa(kdgl+1) = inozpa(1)
    ENDIF
  ENDIF



DEALLOCATE(inlopa)
DEALLOCATE(inozpa)
DEALLOCATE(zsinla)
DEALLOCATE(zvalh)
DEALLOCATE(zvbh)

!     ------------------------------------------------------------------

IF (lhook) CALL dr_hook('RIEN',1,zhook_handle)
END SUBROUTINE rien