Newer
Older
!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
!!
!!
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
!!
!! ##############################################
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
WRITE(KLUOUT,FMT=*) 'MODE_POS_SURF : error reading from unit ',&
KULNAM,' file ',HDNAML,' line ',YLINE
CALL FLUSH(KLUOUT)
ENDIF
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
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