posnam.F90

Go to the documentation of this file.

SUBROUTINE posnam(KULNAM,CDNAML)

!**** *POSNAM* - position namelist file for reading

!     Purpose.
!     --------
!     To position namelist file at correct place for reading
!     namelist CDNAML. Replaces use of Cray specific ability
!     to skip to the correct namelist.

!**   Interface.
!     ----------
!        *CALL* *POSNAM*(..)

!        Explicit arguments :     KULNAM - file unit number (input)
!        --------------------     CDNAML - namelist name    (input)

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

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

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

!     Reference.
!     ----------
!        ECMWF Research Department documentation of the IFS

!     Author.
!     -------
!        Mats Hamrud *ECMWF*

!     Modifications.
!     --------------
!        Original : 93-06-22
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!        M.Hamrud      01-Dec-2003 CY28R1 Cleaning
!      R. El Khatib 04-08-10 Apply norms + proper abort if namelist is missing
!     --------------------------------------------------------------

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

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KULNAM 
CHARACTER(LEN=*)  ,INTENT(IN)    :: CDNAML 


CHARACTER (LEN = 40) ::  CLINE
CHARACTER (LEN =  1) ::  CLTEST

INTEGER(KIND=JPIM) :: ILEN, IND1, ISTATUS, ISCAN
REAL(KIND=JPRB)    :: ZHOOK_HANDLE

#include "abor1.intfb.h"

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

!*       1.    POSITION FILE
!              -------------

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

cline='                                        '
rewind(kulnam)
ilen=len(cdnaml)
istatus=0
iscan=0
print *,'On cherche a lire:',cdnaml
DO WHILE (istatus==0 .AND. iscan==0)
  READ(kulnam,'(A)',iostat=istatus) cline
! print *,'CLINE,ISTATUS= ',CLINE,ISTATUS
  SELECT CASE (istatus)
  CASE (:-1)
    cline='POSNAM:CANNOT LOCATE '//cdnaml//' '
    CALL abor1(cline)
  CASE (0)
    IF (index(cline(1:10),'&') == 0) THEN
      iscan=0
    ELSE
      ind1=index(cline,'&'//cdnaml)
      IF (ind1 == 0) THEN
        iscan=0
      ELSE
        cltest=cline(ind1+ilen+1:ind1+ilen+1)
        IF (   (lge(cltest,'0').AND.lle(cltest,'9')) &
         & .OR.(lge(cltest,'A').AND.lle(cltest,'Z')) ) THEN
          iscan=0
        ELSE
          iscan=1
        ENDIF
      ENDIF
    ENDIF
  CASE (1:)
    cline='POSNAM:READ ERROR IN NAMELIST FILE'
    CALL abor1(cline)
  END SELECT
ENDDO
backspace(kulnam)

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

IF (lhook) CALL dr_hook('POSNAM',1,zhook_handle)
END SUBROUTINE posnam