Philippe 02/05/2016: moved all LIBTOOLS files in LIBTOOLS directory
[MNH-git_open_source-lfs.git] / LIBTOOLS / tools / vergrid / src / mode_pos.f90
1 !-----------------------------------------------------------------
2 !--------------- special set of characters for RCS information
3 !-----------------------------------------------------------------
4 ! $Source$ $Revision$ $Date$
5 !-----------------------------------------------------------------
6 !-----------------------------------------------------------------
7 !-----------------------------------------------------------------
8 !!    ###############
9       MODULE MODE_POS
10 !!    ###############
11 !!
12 INTERFACE POS
13 !!
14 MODULE PROCEDURE POSNAM
15 MODULE PROCEDURE POSKEY
16 !!
17 END INTERFACE
18 !!
19 !!
20 CONTAINS
21 !!
22 !!    ##############################################
23       SUBROUTINE POSNAM(KULNAM,HDNAML,OFOUND,KLUOUT)
24 !!    ##############################################
25 !!
26 !!*** *POSNAM*
27 !!
28 !!    PURPOSE
29 !!    -------
30 !     To position namelist file at correct place for reading
31 !     namelist CDNAML.
32 !!
33 !!**  METHOD
34 !!    ------
35 !!
36 !!    EXTERNAL
37 !!    --------
38 !!
39 !!    IMPLICIT ARGUMENT
40 !!    -----------------
41 !!
42 !!    REFERENCE
43 !!    ----------
44 !!       ECMWF Research Department documentation of the IFS
45 !!
46 !!    AUTHOR
47 !!    -------
48 !!       Mats Hamrud *ECMWF*
49 !!
50 !!    MODIFICATIONS
51 !!    --------------
52 !!       Original : 22/06/93
53 !!       I. Mallet  15/10/01     adaptation to MesoNH (F90 norm)
54 !------------------------------------------------------------------------------
55 !
56 !*       0.    DECLARATIONS
57 !              ------------
58 !
59 !*       0.1   Declarations of arguments
60 !
61 INTEGER,          INTENT(IN) :: KULNAM
62 CHARACTER(LEN=*), INTENT(IN) :: HDNAML
63 LOGICAL,          INTENT(OUT):: OFOUND
64 INTEGER, OPTIONAL,INTENT(IN) :: KLUOUT
65 !
66 !*       0.2   Declarations of local variables
67 !
68 CHARACTER(LEN=120) :: YLINE
69 CHARACTER(LEN=1)   :: YLTEST
70 INTEGER            :: ILEN,ILEY,IND1
71 INTEGER            :: J,JA
72 !
73 CHARACTER(LEN=1),DIMENSION(26) :: YLO=(/'a','b','c','d','e','f','g','h', &
74      'i','j','k','l','m','n','o','p','q','r','s','t','u','v','w','x','y','z'/)
75 CHARACTER(LEN=1),DIMENSION(26) :: YUP=(/'A','B','C','D','E','F','G','H', &
76      'I','J','K','L','M','N','O','P','Q','R','S','T','U','V','W','X','Y','Z'/)
77 !
78 !*       1.    POSITION FILE
79 !              -------------
80 !
81 REWIND(KULNAM)
82 ILEN=LEN(HDNAML)
83 !
84 search_nam : DO
85       YLINE=' '
86       READ(KULNAM,'(A)',END=100) YLINE
87       ILEY=LEN(YLINE)
88       DO J=1,ILEY
89         DO JA=1,26
90           IF (YLINE(J:J)==YLO(JA)) YLINE(J:J)=YUP(JA) 
91         END DO
92       END DO
93       IND1=INDEX(YLINE,'&'//HDNAML)
94       IF(IND1.NE.0) THEN
95         YLTEST=YLINE(IND1+ILEN+1:IND1+ILEN+1)
96         IF((LLT(YLTEST,'0').OR.LGT(YLTEST,'9')).AND. &
97            (LLT(YLTEST,'A').OR.LGT(YLTEST,'Z'))) EXIT search_nam
98       END IF
99 ENDDO search_nam
100 !
101 BACKSPACE(KULNAM)
102 OFOUND=.TRUE.
103 IF (PRESENT(KLUOUT)) WRITE(KLUOUT,FMT=*) '-- namelist ',HDNAML,' read'
104 !
105 RETURN
106 !
107 ! end of file: namelist name not found
108 100  CONTINUE
109 OFOUND=.FALSE.
110 IF (PRESENT(KLUOUT)) &
111 WRITE(KLUOUT,FMT=*)  &
112 '-- namelist ',HDNAML,' not found: default values used if required'
113 !------------------------------------------------------------------
114 END SUBROUTINE POSNAM
115 !!
116 !!
117 !!    ################################################
118       SUBROUTINE POSKEY(KULNAM,KLUOUT,HKEYWD1,HKEYWD2)
119 !!    ################################################
120 !!
121 !!*** *POSKEY*
122 !!
123 !!    PURPOSE
124 !!    -------
125 !     To position namelist file at correct place after reading
126 !     keyword HKEYWD
127 !!
128 !!**  METHOD
129 !!    ------
130 !!
131 !!    EXTERNAL
132 !!    --------
133 !!
134 !!    IMPLICIT ARGUMENT
135 !!    -----------------
136 !!
137 !!    REFERENCE
138 !!    ----------
139 !!
140 !!    AUTHOR
141 !!    -------
142 !!       I. Mallet *Meteo-France*
143 !!
144 !!    MODIFICATIONS
145 !!    --------------
146 !!       Original : 15/10/01
147 !------------------------------------------------------------------------------
148 !
149 !*       0.    DECLARATIONS
150 !              ------------
151 !
152 !*       0.1   Declarations of arguments
153 !
154 INTEGER,                    INTENT(IN) :: KULNAM
155 INTEGER,                    INTENT(IN) :: KLUOUT
156 CHARACTER(LEN=*),           INTENT(IN) :: HKEYWD1
157 CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: HKEYWD2
158 !
159 !*       0.2   Declarations of local variables
160 !
161 CHARACTER(LEN=120) :: YLINE
162 INTEGER            :: ILEN1
163 !
164 !
165 !*       1.    POSITION FILE
166 !              -------------
167 !
168 REWIND(KULNAM)
169 ILEN1=LEN(HKEYWD1)
170 IF (PRESENT(HKEYWD2)) ILEN2=LEN(HKEYWD2)
171 !
172 search_key : DO
173       YLINE=' '
174       READ(KULNAM,'(A)',END=100) YLINE
175       YLINE=ADJUSTL(YLINE)
176       IF (YLINE(1:ILEN1) .EQ. HKEYWD1(1:ILEN1)) EXIT search_key
177 ENDDO search_key
178 !
179 WRITE(KLUOUT,FMT=*) '-- keyword ',HKEYWD1,' found'
180 !
181 RETURN
182 !
183 ! end of file: keyword not found
184 100  CONTINUE
185 IF (.NOT.PRESENT(HKEYWD2)) THEN
186   WRITE(KLUOUT,FMT=*)  '-- keyword ',HKEYWD1,' not found: program stop'
187   STOP
188 ELSE
189 !
190 !*       2.    SECOND KEYWORD: POSITION FILE
191 !              -----------------------------
192 !
193   REWIND(KULNAM)
194   search_key2 : DO
195       YLINE=' '
196       READ(KULNAM,'(A)',END=101) YLINE
197       YLINE=ADJUSTL(YLINE)
198       IF (YLINE(1:ILEN2) .EQ. HKEYWD2(1:ILEN2)) EXIT search_key2
199   ENDDO search_key2
200   WRITE(KLUOUT,FMT=*) '-- keyword ',HKEYWD2,' found'
201   RETURN
202 END IF
203 ! end of file: scd keyword not found
204 101  CONTINUE
205 WRITE(KLUOUT,FMT=*)  '-- keyword ',HKEYWD2,' not found: program stop'
206 STOP
207 !------------------------------------------------------------------
208 END SUBROUTINE POSKEY
209 !
210 END MODULE MODE_POS