Skip to content

Commit 4606cc4

Browse files
AlexandreMaryAlexandreMary
authored
Introduce posnam* from IAL (#45)
* introduce namelist_mod from IAL * add test_namelist * add KULOUT arg to POSNAMEF and a bit of header doc * add test for POSNAM missing block * remove namelist example and write it on the fly * cosmetic renaming
1 parent 16ccac7 commit 4606cc4

3 files changed

Lines changed: 408 additions & 0 deletions

File tree

‎src/fiat/util/namelist_mod.F90‎

Lines changed: 278 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,278 @@
1+
MODULE NAMELIST_MOD
2+
3+
! This module contains namelist utilities, especially subroutines/function to
4+
! position on the requested namelist "block" to read variables.
5+
!
6+
! To the legacy POSNAM and POSNAME subroutines from IAL (IFS-ARPEGE-LAM),
7+
! a POSNAMEF function is added to enable a shorter syntax:
8+
! IF (POSNAMEF(KULNAM, CDNAML, ...) == 0) READ(KULNAM, NAML)
9+
10+
IMPLICIT NONE
11+
12+
PUBLIC :: POSNAME, POSNAM, POSNAMEF
13+
14+
CONTAINS
15+
! ------------------------------------------------------------------
16+
SUBROUTINE POSNAME(KULNAM,CDNAML,KSTAT,LDNOREWIND)
17+
18+
!**** *POSNAME* - position namelist file for reading; return error code
19+
! if namelist is not found
20+
21+
! Purpose.
22+
! --------
23+
! To position namelist file at correct place for reading
24+
! namelist CDNAML. Replaces use of Cray specific ability
25+
! to skip to the correct namelist.
26+
27+
!** Interface.
28+
! ----------
29+
! *CALL* *POSNAME*(..)
30+
31+
! Explicit arguments : KULNAM - file unit number (input)
32+
! -------------------- CDNAML - namelist name (input)
33+
! KSTAT - non-zero if namelist not found
34+
! 1 = namelist not found
35+
36+
! Author.
37+
! -------
38+
! P.Marguinaud 22-Nov-2010
39+
40+
! Modifications.
41+
! --------------
42+
! R.Hogan 20-Jan-2022 Added no-rewind optional argument
43+
44+
! --------------------------------------------------------------
45+
46+
USE EC_PARKIND ,ONLY : JPIM
47+
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK, JPHOOK
48+
49+
IMPLICIT NONE
50+
51+
INTEGER(KIND=JPIM),INTENT(IN) :: KULNAM
52+
CHARACTER(LEN=*) ,INTENT(IN) :: CDNAML
53+
INTEGER(KIND=JPIM),INTENT(OUT) :: KSTAT
54+
LOGICAL,OPTIONAL, INTENT(IN) :: LDNOREWIND
55+
56+
#include "abor1.intfb.h"
57+
58+
59+
CHARACTER (LEN = 40) :: CLINE
60+
CHARACTER (LEN = 1) :: CLTEST
61+
62+
INTEGER(KIND=JPIM) :: ILEN, IND1, ISTATUS, ISCAN
63+
REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
64+
65+
! -----------------------------------------------------------
66+
67+
!* 1. POSITION FILE
68+
! -------------
69+
70+
IF (LHOOK) CALL DR_HOOK('POSNAME',0,ZHOOK_HANDLE)
71+
72+
KSTAT = 0
73+
74+
CLINE=' '
75+
! Rewind by default, but not if LDNOREWIND is present and TRUE. This
76+
! is useful for reading an array of structures of arbitrary length
77+
! from a namelist, by repeated use of the same group name.
78+
IF (.NOT. PRESENT(LDNOREWIND)) THEN
79+
REWIND(KULNAM)
80+
ELSEIF (.NOT. LDNOREWIND) THEN
81+
REWIND(KULNAM)
82+
ENDIF
83+
84+
ILEN=LEN(CDNAML)
85+
ISTATUS=0
86+
ISCAN=0
87+
DO WHILE (ISTATUS==0 .AND. ISCAN==0)
88+
READ(KULNAM,'(A)',IOSTAT=ISTATUS) CLINE
89+
SELECT CASE (ISTATUS)
90+
CASE (:-1)
91+
KSTAT=1
92+
ISCAN=-1
93+
CASE (0)
94+
IF (INDEX(CLINE(1:10),'&') == 0) THEN
95+
ISCAN=0
96+
ELSE
97+
IND1=INDEX(CLINE,'&'//CDNAML)
98+
IF (IND1 == 0) THEN
99+
ISCAN=0
100+
ELSE
101+
CLTEST=CLINE(IND1+ILEN+1:IND1+ILEN+1)
102+
IF ( (LGE(CLTEST,'0').AND.LLE(CLTEST,'9')) &
103+
& .OR.(LGE(CLTEST,'A').AND.LLE(CLTEST,'Z')) ) THEN
104+
ISCAN=0
105+
ELSE
106+
ISCAN=1
107+
ENDIF
108+
ENDIF
109+
ENDIF
110+
CASE (1:)
111+
CALL ABOR1 ('POSNAME: AN ERROR OCCURRED WHILE READING THE NAMELIST')
112+
END SELECT
113+
ENDDO
114+
BACKSPACE(KULNAM)
115+
116+
! ------------------------------------------------------------------
117+
118+
IF (LHOOK) CALL DR_HOOK('POSNAME',1,ZHOOK_HANDLE)
119+
END SUBROUTINE POSNAME
120+
121+
122+
FUNCTION POSNAMEF(KULNAM, CDNAML, LDNOREWIND, LDFATAL, LDVERBOSE, KULOUT) RESULT(ISTAT)
123+
!**** *POSNAMEF* - function to position namelist file for reading and return error code
124+
! if namelist is not found
125+
126+
! Purpose.
127+
! --------
128+
! To position namelist file at correct place for reading namelist CDNAML.
129+
130+
!** Interface.
131+
! ----------
132+
! IF (POSNAMEF(KULNAM, CDNAML, ...) == 0) READ(KULNAM, NAML)
133+
134+
! Explicit arguments : KULNAM - file unit number (input)
135+
! -------------------- CDNAML - namelist name (input)
136+
! LDNOREWIND - no rewind; This is useful for
137+
! reading an array of structures of arbitrary
138+
! length from a namelist, by repeated use of
139+
! the same group name.
140+
! LDFATAL - to call ABOR1 in case of error
141+
! (other than NAMELIST not present in file)
142+
! LDVERBOSE - verbosity
143+
! KULOUT - output unit for verbosity
144+
145+
USE EC_PARKIND, ONLY : JPIM
146+
USE EC_LUN, ONLY : NULOUT
147+
USE YOMHOOK, ONLY : LHOOK, DR_HOOK, JPHOOK
148+
149+
IMPLICIT NONE
150+
151+
INTEGER(KIND=JPIM), INTENT(IN) :: KULNAM
152+
CHARACTER(LEN=*), INTENT(IN) :: CDNAML
153+
LOGICAL,OPTIONAL, INTENT(IN) :: LDNOREWIND
154+
LOGICAL,OPTIONAL, INTENT(IN) :: LDFATAL
155+
LOGICAL,OPTIONAL, INTENT(IN) :: LDVERBOSE
156+
INTEGER(KIND=JPIM),OPTIONAL, INTENT(IN) :: KULOUT
157+
158+
INTEGER(KIND=JPIM) :: ISTAT
159+
CHARACTER(LEN=256) :: CLFILE
160+
LOGICAL :: LLNOREWIND
161+
LOGICAL :: LLFATAL
162+
LOGICAL :: LLVERBOSE
163+
INTEGER :: ILULOUT
164+
165+
REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
166+
167+
#include "abor1.intfb.h"
168+
169+
IF (LHOOK) CALL DR_HOOK('POSNAMEF',0,ZHOOK_HANDLE)
170+
! defaults
171+
LLNOREWIND = .FALSE.
172+
LLFATAL = .TRUE.
173+
LLVERBOSE = .TRUE.
174+
ILULOUT = NULOUT
175+
! optional arguments
176+
IF (PRESENT(LDNOREWIND)) LLNOREWIND = LDNOREWIND
177+
IF (PRESENT(LDFATAL)) LLFATAL = LDFATAL
178+
IF (PRESENT(LDVERBOSE)) LLVERBOSE = LDVERBOSE
179+
IF (PRESENT(KULOUT)) ILULOUT = KULOUT
180+
181+
CLFILE=""
182+
183+
INQUIRE(KULNAM,NAME=CLFILE)
184+
IF (CLFILE == "") THEN
185+
! No file is explicitely connected to this logical unit number yet
186+
! (because the file is not yet opened)
187+
! then give it its standard name "fort.KULNAM" :
188+
IF (KULNAM <= 9) THEN
189+
WRITE(CLFILE,'(''fort.'',I1)') KULNAM
190+
ELSE
191+
WRITE(CLFILE,'(''fort.'',I2)') KULNAM
192+
ENDIF
193+
ENDIF
194+
IF (LLVERBOSE) WRITE(ILULOUT,"('Reading namelist ',A,' from ',A)") CDNAML,TRIM(CLFILE)
195+
196+
CALL POSNAME (KULNAM, CDNAML, ISTAT, LDNOREWIND=LLNOREWIND)
197+
198+
SELECT CASE (ISTAT)
199+
CASE (0)
200+
CASE (1)
201+
IF (LLFATAL) THEN
202+
CALL ABOR1 ('POSNAM:CANNOT LOCATE '//CDNAML//' ')
203+
ENDIF
204+
CASE DEFAULT
205+
CALL ABOR1 ('POSNAM:READ ERROR IN NAMELIST FILE')
206+
END SELECT
207+
208+
IF (LHOOK) CALL DR_HOOK('POSNAMEF',1,ZHOOK_HANDLE)
209+
END FUNCTION POSNAMEF
210+
211+
212+
SUBROUTINE POSNAM(KULNAM, CDNAML)
213+
214+
!**** *POSNAM* - position namelist file for reading
215+
216+
! Purpose.
217+
! --------
218+
! To position namelist file at correct place for reading
219+
! namelist CDNAML. Replaces use of Cray specific ability
220+
! to skip to the correct namelist.
221+
222+
!** Interface.
223+
! ----------
224+
! *CALL* *POSNAM*(..)
225+
226+
! Explicit arguments : KULNAM - file unit number (input)
227+
! -------------------- CDNAML - namelist name (input)
228+
229+
! Implicit arguments : None
230+
! --------------------
231+
232+
! Method.
233+
! -------
234+
! See documentation
235+
236+
! Externals. None
237+
! ----------
238+
239+
! Reference.
240+
! ----------
241+
! ECMWF Research Department documentation of the IFS
242+
243+
! Author.
244+
! -------
245+
! Mats Hamrud *ECMWF*
246+
247+
! Modifications.
248+
! --------------
249+
! Original : 93-06-22
250+
! M.Hamrud 01-Oct-2003 CY28 Cleaning
251+
! M.Hamrud 01-Dec-2003 CY28R1 Cleaning
252+
! R. El Khatib 04-08-10 Apply norms + proper abort if namelist is missing
253+
! P. Marguinaud Proxy to POSNAME
254+
! H Petithomme Sept 2023: some cleaning
255+
! R. El Khatib 11-Feb-2025 Fix uninitialized filename and arbitrary choice "fort.4"
256+
! A.Mary 22-05-2025: move contents to POSNAMEF
257+
! --------------------------------------------------------------
258+
259+
USE EC_PARKIND, ONLY : JPIM
260+
USE YOMHOOK, ONLY : LHOOK, DR_HOOK, JPHOOK
261+
262+
IMPLICIT NONE
263+
264+
INTEGER(KIND=JPIM),INTENT(IN) :: KULNAM
265+
CHARACTER(LEN=*) ,INTENT(IN) :: CDNAML
266+
267+
INTEGER(KIND=JPIM) :: ISTAT
268+
REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
269+
270+
IF (LHOOK) CALL DR_HOOK('POSNAM',0,ZHOOK_HANDLE)
271+
ISTAT = POSNAMEF(KULNAM, CDNAML, &
272+
& LDNOREWIND=.FALSE., &
273+
& LDFATAL=.TRUE., &
274+
& LDVERBOSE=.TRUE.)
275+
IF (LHOOK) CALL DR_HOOK('POSNAM',1,ZHOOK_HANDLE)
276+
END SUBROUTINE POSNAM
277+
278+
END MODULE NAMELIST_MOD

‎tests/CMakeLists.txt‎

Lines changed: 15 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -163,6 +163,21 @@ add_test(NAME fiat_test_abor1
163163
"-DPASS_REGULAR_EXPRESSION=ABOR1.*aborting from OpenMP parallel region"
164164
-P ${CMAKE_CURRENT_SOURCE_DIR}/test_program_output.cmake )
165165

166+
# ----------------------------------------------------------------------------------------
167+
# Tests: fiat_test_namelist
168+
169+
ecbuild_add_executable(
170+
TARGET fiat_test_namelist
171+
SOURCES test_namelist.F90
172+
LIBS fiat
173+
LINKER_LANGUAGE Fortran
174+
NOINSTALL )
175+
add_test(NAME fiat_test_namelist
176+
COMMAND ${CMAKE_COMMAND}
177+
"-DEXECUTABLE=$<TARGET_FILE:fiat_test_namelist>"
178+
"-DPASS_REGULAR_EXPRESSION=ABOR1.*POSNAM:CANNOT LOCATE NAM_NONPRESENT"
179+
-P ${CMAKE_CURRENT_SOURCE_DIR}/test_program_output.cmake )
180+
166181
# ----------------------------------------------------------------------------------------
167182
# Test installation of fiat is working
168183

0 commit comments

Comments
 (0)