SURFEX v7.3: /home/dasprezs/EXPORT_v7_3/src/SURFEX/mode_pos

Go to the documentation of this file.
00001 !!    ###############
00002       MODULE MODE_POS_SURF
00003 !!    ###############
00004 !!
00005 USE MODI_ABOR1_SFX
00006 !
00007 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00008 USE PARKIND1  ,ONLY : JPRB
00009 !
00010 INTERFACE POS
00011 !!
00012 MODULE PROCEDURE POSNAM
00013 MODULE PROCEDURE POSKEY
00014 !!
00015 END INTERFACE
00016 !!
00017 !!
00018 CONTAINS
00019 !!
00020 !!    ##############################################
00021       SUBROUTINE POSNAM(KULNAM,HDNAML,OFOUND,KLUOUT)
00022 !!    ##############################################
00023 !!
00024 !!*** *POSNAM*
00025 !!
00026 !!    PURPOSE
00027 !!    -------
00028 !     To position namelist file at correct place for reading
00029 !     namelist CDNAML.
00030 !!
00031 !!**  METHOD
00032 !!    ------
00033 !!
00034 !!    EXTERNAL
00035 !!    --------
00036 !!
00037 !!    IMPLICIT ARGUMENT
00038 !!    -----------------
00039 !!
00040 !!    REFERENCE
00041 !!    ----------
00042 !!       ECMWF Research Department documentation of the IFS (Hamrud)
00043 !!
00044 !!    AUTHOR
00045 !!    -------
00046 !!    I. Mallet  15/10/01 
00047 !!
00048 !!    MODIFICATIONS
00049 !!    --------------
00050 !!       I. Mallet  15/10/01     adaptation to MesoNH (F90 norm)
00051 !------------------------------------------------------------------------------
00052 !
00053 IMPLICIT NONE
00054 !
00055 !*       0.    DECLARATIONS
00056 !              ------------
00057 !
00058 !*       0.1   Declarations of arguments
00059 !
00060 INTEGER,          INTENT(IN) :: KULNAM
00061  CHARACTER(LEN=*), INTENT(IN) :: HDNAML
00062 LOGICAL,          INTENT(OUT):: OFOUND
00063 INTEGER, OPTIONAL,INTENT(IN) :: KLUOUT
00064 !
00065 !*       0.2   Declarations of local variables
00066 !
00067  CHARACTER(LEN=120) :: YLINE
00068  CHARACTER(LEN=1)   :: YLTEST
00069 INTEGER            :: ILEN,ILEY,INDL,IND1,IRET
00070 INTEGER            :: J,JA, JFILE
00071 LOGICAL            :: LLOPENED
00072 !
00073  CHARACTER(LEN=1),DIMENSION(26) :: YLO=(/'a','b','c','d','e','f','g','h', 
00074      'i','j','k','l','m','n','o','p','q','r','s','t','u','v','w','x','y','z'/)
00075  CHARACTER(LEN=1),DIMENSION(26) :: YUP=(/'A','B','C','D','E','F','G','H', 
00076      'I','J','K','L','M','N','O','P','Q','R','S','T','U','V','W','X','Y','Z'/)
00077 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00078 !
00079 !*       1.    POSITION FILE
00080 !              -------------
00081 !
00082 IF (LHOOK) CALL DR_HOOK('MODE_POS_SURF:POSNAM',0,ZHOOK_HANDLE)
00083 OFOUND=.FALSE.
00084 ILEN=LEN(HDNAML)
00085 !
00086 !      CONTINUE READING THE FILE, THEN REWIND IF NOT FOUND
00087 DO JFILE=1,2
00088   search_nam : DO
00089     YLINE=' '
00090     READ(UNIT=KULNAM,FMT='(A)',IOSTAT=IRET,END=100) YLINE
00091 !   If file does not exist, most compilers would just create it and jump 
00092 !   to the END label ; but a few of them would report an error:         
00093     IF (IRET /=0 ) THEN                 
00094       INQUIRE(KULNAM,OPENED=LLOPENED)
00095       IF (LLOPENED) THEN
00096         IF (PRESENT(KLUOUT)) &
00097           WRITE(KLUOUT,FMT=*) 'MODE_POS_SURF : error reading from unit ',&
00098                                KULNAM,' file ',HDNAML,' line ',YLINE
00099         CALL ABOR1_SFX('MODE_POS_SURF: read error in namelist file') 
00100       ELSE
00101         EXIT search_nam
00102       END IF
00103     ELSE   
00104 !     FIRST SEARCH for "&" IN THE LINE, THEN CORRECT LINE AND TEST :
00105       INDL=INDEX(YLINE,'&')
00106       IF (INDL .NE. 0 ) THEN
00107         ILEY=LEN(YLINE)
00108         DO J=1,ILEY
00109           DO JA=1,26
00110             IF (YLINE(J:J)==YLO(JA)) YLINE(J:J)=YUP(JA) 
00111           END DO
00112         END DO
00113         IND1=INDEX(YLINE,'&'//HDNAML)
00114         IF(IND1.NE.0) THEN
00115           YLTEST=YLINE(IND1+ILEN+1:IND1+ILEN+1)
00116           IF(YLTEST == ' ') THEN
00117 !           NAMELIST FOUND : RETURN
00118             BACKSPACE(KULNAM)
00119             OFOUND=.TRUE.
00120             IF (PRESENT(KLUOUT)) WRITE(KLUOUT,FMT=*) '-- namelist ',HDNAML,' read'
00121             IF (LHOOK) CALL DR_HOOK('MODE_POS_SURF:POSNAM',1,ZHOOK_HANDLE)
00122             RETURN
00123           ENDIF
00124         ENDIF
00125       ENDIF
00126     ENDIF
00127   ENDDO search_nam
00128   100  CONTINUE
00129   IF(JFILE == 1) REWIND(KULNAM)
00130 ENDDO
00131 
00132 BACKSPACE(KULNAM)
00133 ! end of file: namelist name not found
00134 IF (PRESENT(KLUOUT)) &
00135 WRITE(KLUOUT,FMT=*)  &
00136 '-- namelist ',HDNAML,' not found: default values used if required'
00137 IF (LHOOK) CALL DR_HOOK('MODE_POS_SURF:POSNAM',1,ZHOOK_HANDLE)
00138 !------------------------------------------------------------------
00139 END SUBROUTINE POSNAM
00140 !!
00141 !!
00142 !!    ################################################
00143       SUBROUTINE POSKEY(KULNAM,KLUOUT,HKEYWD1,HKEYWD2)
00144 !!    ################################################
00145 !!
00146 !!*** *POSKEY*
00147 !!
00148 !!    PURPOSE
00149 !!    -------
00150 !     To position namelist file at correct place after reading
00151 !     keyword HKEYWD
00152 !!
00153 !!**  METHOD
00154 !!    ------
00155 !!
00156 !!    EXTERNAL
00157 !!    --------
00158 !!
00159 !!    IMPLICIT ARGUMENT
00160 !!    -----------------
00161 !!
00162 !!    REFERENCE
00163 !!    ----------
00164 !!
00165 !!    AUTHOR
00166 !!    -------
00167 !!       I. Mallet *Meteo-France*
00168 !!
00169 !!    MODIFICATIONS
00170 !!    --------------
00171 !!       Original : 15/10/01
00172 !------------------------------------------------------------------------------
00173 !
00174 IMPLICIT NONE
00175 !
00176 !*       0.    DECLARATIONS
00177 !              ------------
00178 !
00179 !*       0.1   Declarations of arguments
00180 !
00181 INTEGER,                    INTENT(IN) :: KULNAM
00182 INTEGER,                    INTENT(IN) :: KLUOUT
00183  CHARACTER(LEN=*),           INTENT(IN) :: HKEYWD1
00184  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: HKEYWD2
00185 !
00186 !*       0.2   Declarations of local variables
00187 !
00188  CHARACTER(LEN=120) :: YLINE
00189 INTEGER            :: ILEN1,ILEN2,IRET
00190 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00191 !
00192 !*       1.    POSITION FILE
00193 !              -------------
00194 !
00195 IF (LHOOK) CALL DR_HOOK('MODE_POS_SURF:POSKEY',0,ZHOOK_HANDLE)
00196 REWIND(KULNAM)
00197 ILEN1=LEN(HKEYWD1)
00198 IF (PRESENT(HKEYWD2)) ILEN2=LEN(HKEYWD2)
00199 !
00200 search_key : DO
00201       YLINE=' '
00202       READ(UNIT=KULNAM,FMT='(A)',IOSTAT=IRET,END=100) YLINE
00203       IF (IRET /=0 ) THEN
00204          WRITE(KLUOUT,FMT=*) '-> error when reading line from unit ',KULNAM
00205       ELSE
00206         YLINE=ADJUSTL(YLINE)
00207         IF (YLINE(1:ILEN1) .EQ. HKEYWD1(1:ILEN1)) EXIT search_key
00208       ENDIF
00209 ENDDO search_key
00210 !
00211 WRITE(KLUOUT,FMT=*) '-- keyword ',HKEYWD1,' found'
00212 !
00213 IF (LHOOK) CALL DR_HOOK('MODE_POS_SURF:POSKEY',1,ZHOOK_HANDLE)
00214 RETURN
00215 !
00216 ! end of file: keyword not found
00217 100  CONTINUE
00218 IF (.NOT.PRESENT(HKEYWD2)) THEN
00219   CALL ABOR1_SFX('MODE_POS_SURF: KEYWORD NOT FOUND: '//HKEYWD1)
00220 ELSE
00221 !
00222 !*       2.    SECOND KEYWORD: POSITION FILE
00223 !              -----------------------------
00224 !
00225   REWIND(KULNAM)
00226   search_key2 : DO
00227       YLINE=' '
00228       READ(UNIT=KULNAM,FMT='(A)',IOSTAT=IRET,END=101) YLINE
00229       IF (IRET /=0 ) THEN
00230         WRITE(KLUOUT,FMT=*) '-> error when reading line from unit ',KULNAM
00231       ELSE
00232         YLINE=ADJUSTL(YLINE)
00233         IF (YLINE(1:ILEN2) .EQ. HKEYWD2(1:ILEN2)) EXIT search_key2
00234       ENDIF
00235   ENDDO search_key2
00236   WRITE(KLUOUT,FMT=*) '-- keyword ',HKEYWD2,' found'
00237   IF (LHOOK) CALL DR_HOOK('MODE_POS_SURF:POSKEY',1,ZHOOK_HANDLE)
00238   RETURN
00239 END IF
00240 ! end of file: scd keyword not found
00241 101  CONTINUE
00242  CALL ABOR1_SFX('MODE_POS_SURF: KEYWORD NOT FOUND: '//HKEYWD2)
00243 IF (LHOOK) CALL DR_HOOK('MODE_POS_SURF:POSKEY',1,ZHOOK_HANDLE)
00244 !------------------------------------------------------------------
00245 END SUBROUTINE POSKEY
00246 !
00247 END MODULE MODE_POS_SURF