mode_pos_surf.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.
!!    ###############
      MODULE mode_pos_surf
!!    ###############
!!
USE modi_abor1_sfx
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
INTERFACE pos
!!
MODULE PROCEDURE posnam
MODULE PROCEDURE poskey
!!
END INTERFACE
!!
!!
 CONTAINS
!!
!!    ##############################################
      SUBROUTINE posnam(KULNAM,HDNAML,OFOUND,KLUOUT)
!!    ##############################################
!!
!!*** *POSNAM*
!!
!!    PURPOSE
!!    -------
!     To position namelist file at correct place for reading
!     namelist CDNAML.
!!
!!**  METHOD
!!    ------
!!
!!    EXTERNAL
!!    --------
!!
!!    IMPLICIT ARGUMENT
!!    -----------------
!!
!!    REFERENCE
!!    ----------
!!       ECMWF Research Department documentation of the IFS (Hamrud)
!!
!!    AUTHOR
!!    -------
!!    I. Mallet  15/10/01 
!!
!!    MODIFICATIONS
!!    --------------
!!       I. Mallet  15/10/01     adaptation to MesoNH (F90 norm)
!------------------------------------------------------------------------------
!
IMPLICIT NONE
!
!*       0.    DECLARATIONS
!              ------------
!
!*       0.1   Declarations of arguments
!
INTEGER,          INTENT(IN) :: kulnam
 CHARACTER(LEN=*), INTENT(IN) :: hdnaml
LOGICAL,          INTENT(OUT):: ofound
INTEGER, OPTIONAL,INTENT(IN) :: kluout
!
!*       0.2   Declarations of local variables
!
 CHARACTER(LEN=120) :: yline
 CHARACTER(LEN=1)   :: yltest
INTEGER            :: ilen,iley,indl,ind1,iret
INTEGER            :: j,ja, jfile
LOGICAL            :: llopened
!
 CHARACTER(LEN=1),DIMENSION(26) :: ylo=(/'a','b','c','d','e','f','g','h', &
     'i','j','k','l','m','n','o','p','q','r','s','t','u','v','w','x','y','z'/)
 CHARACTER(LEN=1),DIMENSION(26) :: yup=(/'A','B','C','D','E','F','G','H', &
     'I','J','K','L','M','N','O','P','Q','R','S','T','U','V','W','X','Y','Z'/)
REAL(KIND=JPRB) :: zhook_handle
!
!*       1.    POSITION FILE
!              -------------
!
IF (lhook) CALL dr_hook('MODE_POS_SURF:POSNAM',0,zhook_handle)
ofound=.false.
ilen=len(hdnaml)
!
!      CONTINUE READING THE FILE, THEN REWIND IF NOT FOUND
DO jfile=1,2
  search_nam : DO
    yline=' '
    READ(unit=kulnam,fmt='(A)',iostat=iret,end=100) yline
!   If file does not exist, most compilers would just create it and jump 
!   to the END label ; but a few of them would report an error:         
    IF (iret /=0 ) THEN                 
      INQUIRE(kulnam,opened=llopened)
      IF (llopened) THEN
        IF (present(kluout)) &
          WRITE(kluout,fmt=*) 'MODE_POS_SURF : error reading from unit ',&
                               kulnam,' file ',hdnaml,' line ',yline
        CALL abor1_sfx('MODE_POS_SURF: read error in namelist file') 
      ELSE
        EXIT search_nam
      END IF
    ELSE   
!     FIRST SEARCH for "&" IN THE LINE, THEN CORRECT LINE AND TEST :
      indl=index(yline,'&')
      IF (indl .NE. 0 ) THEN
        iley=len(yline)
        DO j=1,iley
          DO ja=1,26
            IF (yline(j:j)==ylo(ja)) yline(j:j)=yup(ja) 
          END DO
        END DO
        ind1=index(yline,'&'//hdnaml)
        IF(ind1.NE.0) THEN
          yltest=yline(ind1+ilen+1:ind1+ilen+1)
          IF(yltest == ' ') THEN
!           NAMELIST FOUND : RETURN
            backspace(kulnam)
            ofound=.true.
            IF (present(kluout)) WRITE(kluout,fmt=*) '-- namelist ',hdnaml,' read'
            IF (lhook) CALL dr_hook('MODE_POS_SURF:POSNAM',1,zhook_handle)
            RETURN
          ENDIF
        ENDIF
      ENDIF
    ENDIF
  ENDDO search_nam
  100  CONTINUE
  IF(jfile == 1) rewind(kulnam)
ENDDO

backspace(kulnam)
! end of file: namelist name not found
IF (present(kluout)) &
WRITE(kluout,fmt=*)  &
'-- namelist ',hdnaml,' not found: default values used if required'
IF (lhook) CALL dr_hook('MODE_POS_SURF:POSNAM',1,zhook_handle)
!------------------------------------------------------------------
END SUBROUTINE posnam
!!
!!
!!    ################################################
      SUBROUTINE poskey(KULNAM,KLUOUT,HKEYWD1,HKEYWD2)
!!    ################################################
!!
!!*** *POSKEY*
!!
!!    PURPOSE
!!    -------
!     To position namelist file at correct place after reading
!     keyword HKEYWD
!!
!!**  METHOD
!!    ------
!!
!!    EXTERNAL
!!    --------
!!
!!    IMPLICIT ARGUMENT
!!    -----------------
!!
!!    REFERENCE
!!    ----------
!!
!!    AUTHOR
!!    -------
!!       I. Mallet *Meteo-France*
!!
!!    MODIFICATIONS
!!    --------------
!!       Original : 15/10/01
!------------------------------------------------------------------------------
!
IMPLICIT NONE
!
!*       0.    DECLARATIONS
!              ------------
!
!*       0.1   Declarations of arguments
!
INTEGER,                    INTENT(IN) :: kulnam
INTEGER,                    INTENT(IN) :: kluout
 CHARACTER(LEN=*),           INTENT(IN) :: hkeywd1
 CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: hkeywd2
!
!*       0.2   Declarations of local variables
!
 CHARACTER(LEN=120) :: yline
INTEGER            :: ilen1,ilen2,iret
REAL(KIND=JPRB) :: zhook_handle
!
!*       1.    POSITION FILE
!              -------------
!
IF (lhook) CALL dr_hook('MODE_POS_SURF:POSKEY',0,zhook_handle)
rewind(kulnam)
ilen1=len(hkeywd1)
IF (present(hkeywd2)) ilen2=len(hkeywd2)
!
search_key : DO
      yline=' '
      READ(unit=kulnam,fmt='(A)',iostat=iret,end=100) yline
      IF (iret /=0 ) THEN
         WRITE(kluout,fmt=*) '-> error when reading line from unit ',kulnam
      ELSE
        yline=adjustl(yline)
        IF (yline(1:ilen1) .EQ. hkeywd1(1:ilen1)) EXIT search_key
      ENDIF
ENDDO search_key
!
WRITE(kluout,fmt=*) '-- keyword ',hkeywd1,' found'
!
IF (lhook) CALL dr_hook('MODE_POS_SURF:POSKEY',1,zhook_handle)
RETURN
!
! end of file: keyword not found
100  CONTINUE
IF (.NOT.present(hkeywd2)) THEN
  CALL abor1_sfx('MODE_POS_SURF: KEYWORD NOT FOUND: '//hkeywd1)
ELSE
!
!*       2.    SECOND KEYWORD: POSITION FILE
!              -----------------------------
!
  rewind(kulnam)
  search_key2 : DO
      yline=' '
      READ(unit=kulnam,fmt='(A)',iostat=iret,end=101) yline
      IF (iret /=0 ) THEN
        WRITE(kluout,fmt=*) '-> error when reading line from unit ',kulnam
      ELSE
        yline=adjustl(yline)
        IF (yline(1:ilen2) .EQ. hkeywd2(1:ilen2)) EXIT search_key2
      ENDIF
  ENDDO search_key2
  WRITE(kluout,fmt=*) '-- keyword ',hkeywd2,' found'
  IF (lhook) CALL dr_hook('MODE_POS_SURF:POSKEY',1,zhook_handle)
  RETURN
END IF
! end of file: scd keyword not found
101  CONTINUE
 CALL abor1_sfx('MODE_POS_SURF: KEYWORD NOT FOUND: '//hkeywd2)
IF (lhook) CALL dr_hook('MODE_POS_SURF:POSKEY',1,zhook_handle)
!------------------------------------------------------------------
END SUBROUTINE poskey
!
END MODULE mode_pos_surf