1 | SUBROUTINE POSNAM(KULNAM,CDNAML) |
---|
2 | |
---|
3 | !**** *POSNAM* - position namelist file for reading |
---|
4 | |
---|
5 | ! Purpose. |
---|
6 | ! -------- |
---|
7 | ! To position namelist file at correct place for reading |
---|
8 | ! namelist CDNAML. Replaces use of Cray specific ability |
---|
9 | ! to skip to the correct namelist. |
---|
10 | |
---|
11 | !** Interface. |
---|
12 | ! ---------- |
---|
13 | ! *CALL* *POSNAM*(..) |
---|
14 | |
---|
15 | ! Explicit arguments : KULNAM - file unit number (input) |
---|
16 | ! -------------------- CDNAML - namelist name (input) |
---|
17 | |
---|
18 | ! Implicit arguments : None |
---|
19 | ! -------------------- |
---|
20 | |
---|
21 | ! Method. |
---|
22 | ! ------- |
---|
23 | ! See documentation |
---|
24 | |
---|
25 | ! Externals. None |
---|
26 | ! ---------- |
---|
27 | |
---|
28 | ! Reference. |
---|
29 | ! ---------- |
---|
30 | ! ECMWF Research Department documentation of the IFS |
---|
31 | |
---|
32 | ! Author. |
---|
33 | ! ------- |
---|
34 | ! Mats Hamrud *ECMWF* |
---|
35 | |
---|
36 | ! Modifications. |
---|
37 | ! -------------- |
---|
38 | ! Original : 93-06-22 |
---|
39 | ! M.Hamrud 01-Oct-2003 CY28 Cleaning |
---|
40 | ! M.Hamrud 01-Dec-2003 CY28R1 Cleaning |
---|
41 | ! R. El Khatib 04-08-10 Apply norms + proper abort if namelist is missing |
---|
42 | ! -------------------------------------------------------------- |
---|
43 | |
---|
44 | USE PARKIND1 ,ONLY : JPIM ,JPRB |
---|
45 | USE YOMHOOK ,ONLY : LHOOK, DR_HOOK |
---|
46 | |
---|
47 | IMPLICIT NONE |
---|
48 | |
---|
49 | INTEGER(KIND=JPIM),INTENT(IN) :: KULNAM |
---|
50 | CHARACTER(LEN=*) ,INTENT(IN) :: CDNAML |
---|
51 | |
---|
52 | |
---|
53 | CHARACTER (LEN = 40) :: CLINE |
---|
54 | CHARACTER (LEN = 1) :: CLTEST |
---|
55 | |
---|
56 | INTEGER(KIND=JPIM) :: ILEN, IND1, ISTATUS, ISCAN |
---|
57 | REAL(KIND=JPRB) :: ZHOOK_HANDLE |
---|
58 | |
---|
59 | #include "abor1.intfb.h" |
---|
60 | |
---|
61 | ! ----------------------------------------------------------- |
---|
62 | |
---|
63 | !* 1. POSITION FILE |
---|
64 | ! ------------- |
---|
65 | |
---|
66 | IF (LHOOK) CALL DR_HOOK('POSNAM',0,ZHOOK_HANDLE) |
---|
67 | |
---|
68 | CLINE=' ' |
---|
69 | REWIND(KULNAM) |
---|
70 | ILEN=LEN(CDNAML) |
---|
71 | ISTATUS=0 |
---|
72 | ISCAN=0 |
---|
73 | PRINT *,'On cherche a lire:',CDNAML |
---|
74 | DO WHILE (ISTATUS==0 .AND. ISCAN==0) |
---|
75 | READ(KULNAM,'(A)',IOSTAT=ISTATUS) CLINE |
---|
76 | ! PRINT *,'CLINE,ISTATUS= ',CLINE,ISTATUS |
---|
77 | SELECT CASE (ISTATUS) |
---|
78 | CASE (:-1) |
---|
79 | CLINE='POSNAM:CANNOT LOCATE '//CDNAML//' ' |
---|
80 | CALL ABOR1(CLINE) |
---|
81 | CASE (0) |
---|
82 | IF (INDEX(CLINE(1:10),'&') == 0) THEN |
---|
83 | ISCAN=0 |
---|
84 | ELSE |
---|
85 | IND1=INDEX(CLINE,'&'//CDNAML) |
---|
86 | IF (IND1 == 0) THEN |
---|
87 | ISCAN=0 |
---|
88 | ELSE |
---|
89 | CLTEST=CLINE(IND1+ILEN+1:IND1+ILEN+1) |
---|
90 | IF ( (LGE(CLTEST,'0').AND.LLE(CLTEST,'9')) & |
---|
91 | & .OR.(LGE(CLTEST,'A').AND.LLE(CLTEST,'Z')) ) THEN |
---|
92 | ISCAN=0 |
---|
93 | ELSE |
---|
94 | ISCAN=1 |
---|
95 | ENDIF |
---|
96 | ENDIF |
---|
97 | ENDIF |
---|
98 | CASE (1:) |
---|
99 | CLINE='POSNAM:READ ERROR IN NAMELIST FILE' |
---|
100 | CALL ABOR1(CLINE) |
---|
101 | END SELECT |
---|
102 | ENDDO |
---|
103 | BACKSPACE(KULNAM) |
---|
104 | |
---|
105 | ! ------------------------------------------------------------------ |
---|
106 | |
---|
107 | IF (LHOOK) CALL DR_HOOK('POSNAM',1,ZHOOK_HANDLE) |
---|
108 | END SUBROUTINE POSNAM |
---|