Philippe 23/02/2016: lfi2cdf: modif for JPHEXT/=1
[MNH-git_open_source-lfs.git] / LIBTOOLS / tools / diachro / src / FM / fmopen.f90
1 !     ######spl
2       SUBROUTINE FMOPEN(HFILEM,HSTATU,HFIPRI,KNPRAR,KFTYPE,KVERB,&
3                         KNINAR,KRESP)
4 !     ############################################################
5 !
6 !!****  *FMOPEN* - routine to open a meso-nh file (DESFM+LFIFM)
7 !!
8 !!    PURPOSE
9 !!    -------
10 !
11 !       The purpose of FMOPEN is to open a meso-nh file for the "FM"-routines.
12 !     It is composed of two distinct fortran files: DESFM and LFIFM. DESFM is
13 !     a namelist formatted file. LFIFM is a LFI file, managed by the LFI-package.
14 !     LFIFM is a fortran unformatted, direct access file which is
15 !     manipulated by the FM-routines FMREAD and FMWRIT. 
16 !     The namelist file is a fortran 90 standard formatted file.
17 !
18 !!**  METHOD
19 !!    ------
20 !!
21 !!      The opening is performed in 4 main steps:
22 !!            1. a logical unit is reserved for DESFM (first call to FMATTR)
23 !!            2. the DESFM file is created by a
24 !!               formatted, fortran open. The name of the file is obtained by
25 !!               appending ".des" to HFILEM.
26 !!            3. a logical unit is reserved for LFIFM (second call to FMATTR)
27 !!            4. the LFIFM file is opened in the LFIOUV routine to
28 !!               which most of the explicit input arguments of FMOPEN are passed.
29 !!               The name of that file is obtained by appending ".lfi"
30 !!               to HFILEM.
31 !!
32 !!    EXTERNAL
33 !!    --------
34 !!
35 !!      FMATTR,LFIOUV,OPEN,LOCKON,LOCKOFF
36 !!
37 !!    IMPLICIT ARGUMENTS
38 !!    ------------------
39 !!
40 !!      MODULE: MODD_FMDECLAR contains management parameters and
41 !!              storage arrays to move information around at the
42 !!              level of all "FM"-routines.
43 !!              MODD_FMMULTI contains variables for multitasking
44 !!
45 !!    REFERENCE
46 !!    ---------
47 !!
48 !!      see the Technical Specifications Report for the Meso-nh project
49 !!      (in French)
50 !!
51 !!    AUTHOR
52 !!    ------
53 !!
54 !!      C. FISCHER      *METEO-FRANCE*
55 !!
56 !!    MODIFICATIONS
57 !!    -------------
58 !!
59 !!      original                                                        06/94
60 !!      modified by C. Fischer                5/7/95 (locks for multitasking)
61 !!      modified by V. Masson               16/09/96 (prints if error occurs)
62 !!
63 !----------------------------------------------------------------------------
64 !
65 !*      0.    DECLARATIONS
66 !             ------------
67 !
68 USE MODD_FMDECLAR
69 USE MODD_FMMULTI
70
71 IMPLICIT NONE
72 !
73 !*      0.1   Declarations of arguments
74 !
75 CHARACTER(LEN=*),     INTENT(IN) ::HFILEM  ! name of the file
76 CHARACTER(LEN=*),     INTENT(IN) ::HSTATU  ! status of the file at opening
77 CHARACTER(LEN=*),     INTENT(IN) ::HFIPRI  ! file for prints in FM
78
79 INTEGER,          INTENT(IN) ::KNPRAR  ! number of predicted articles (not vital)
80 INTEGER,          INTENT(IN) ::KFTYPE  ! type of FM-file
81 INTEGER,          INTENT(IN) ::KVERB   ! level of verbose
82
83 INTEGER,          INTENT(OUT)::KNINAR  ! number of articles initially present in the file
84 INTEGER,          INTENT(OUT)::KRESP   ! return-code if a problem araised
85
86 !
87 !*      0.2   Declarations of local variables
88 !
89 INTEGER::IRESOU,INPRAR,IROWF,IRESP,J,INUMBR,IFMFNL,IMELEV,ILUPRI
90 CHARACTER(LEN=JPFINL)::YFNDES,YFNLFI
91 CHARACTER(LEN=LEN(HFILEM))::YINTFN
92 LOGICAL::GNEWFI,GNAMFI=.TRUE.,GFATER=.TRUE.,GSTATS
93 !
94 !*      0.3   Taskcommon for logical units
95 !
96 COMMON/TASKOPEN/ILUPRI,INUMBR,IRESP,YFNDES,YFNLFI
97 !DIR$ TASKCOMMON TASKOPEN
98 !
99 !----------------------------------------------------------------------------
100 !
101 !*      1.    INITIALIZATION
102 !
103 INPRAR=KNPRAR+0;KNINAR=0
104 IRESOU = 0 ; IROWF = 0 ; IRESP = 0 ; ILUPRI = 6
105 !
106 !* the model's verbose level is connected to the LFI verbose
107 !
108 SELECT CASE (KVERB)
109 CASE(:2)
110    GSTATS=.FALSE. ; IMELEV=0
111 CASE(3:6)
112    GSTATS=.FALSE. ; IMELEV=1
113 CASE(7:9)
114    GSTATS=.FALSE. ; IMELEV=2
115 CASE(10:)
116    GSTATS=.TRUE. ; IMELEV=2
117 END SELECT
118
119 IF (NOPEFI.GE.JPNXFM) THEN
120         IRESP=-44
121         GOTO 1000
122 ENDIF
123 !
124 !*      2.    LOGICAL UNIT FOR DESFM
125 !
126 !  the fortran name for DESFM
127 !
128 IFMFNL=JPFINL-4
129
130 IROWF=LEN(HFILEM)
131
132 IF (IROWF.EQ.0) THEN
133    IRESP=-45
134    GOTO 1000
135 ELSEIF (IROWF.GT.IFMFNL) THEN
136    IRESP=-49
137    GOTO 1000
138 ENDIF
139 YINTFN=ADJUSTR(HFILEM)
140 YFNDES=YINTFN//'.des'
141 YFNDES=ADJUSTL(YFNDES)
142
143 CALL FMATTR(YFNDES,HFIPRI,INUMBR,IRESP)
144 IF (IRESP.NE.0) GOTO 1000
145
146 !
147 !*      3.    FILE OPENING FOR DESFM
148 !
149 !  case of a namelist: sequential, formatted fortran open
150 !
151 OPEN(UNIT=INUMBR,FILE=YFNDES,FORM='FORMATTED',DELIM='QUOTE',IOSTAT=IRESP)
152 IF (IRESP.NE.0) GOTO 1000
153 !
154 !*      4.    LOGICAL UNIT FOR LFIFM
155 !
156 !  the fortran name for LFIFM
157 !
158 YFNLFI=YINTFN//'.lfi'
159 YFNLFI=ADJUSTL(YFNLFI)
160
161 CALL FMATTR(YFNLFI,HFIPRI,INUMBR,IRESP)
162 IF (IRESP.NE.0) GOTO 1000
163 !
164 !*      5.    FILE OPENING FOR LFIFM
165 !
166 !  case of a LFI-file: direct access, unformatted open via LFIOUV
167 !
168 CALL LFIOUV(IRESOU,INUMBR,GNAMFI,YFNLFI,HSTATU,GFATER,GSTATS,IMELEV,INPRAR,&
169             KNINAR)
170 IF (IRESOU.NE.0.AND.IRESOU.NE.-11) THEN
171         IRESP=IRESOU
172         GOTO 1000
173 ENDIF
174
175 !
176 !*      6.    TEST IF FILE IS NEWLY DEFINED
177 !
178
179 GNEWFI=(KNINAR.EQ.0).OR.(KVERB.LT.7)
180 IF (.NOT.GNEWFI) THEN
181 YFNLFI=ADJUSTL(HFIPRI)
182 DO J=1,JPNXLU
183     IF (CNAMFI(J).EQ.YFNLFI) THEN
184        ILUPRI=J
185        EXIT
186     ENDIF
187 ENDDO
188 WRITE (ILUPRI,*) ' file ',INUMBR,'previously created with LFI'
189 ENDIF
190 !
191 !*      7.    UPDATE OF THE FILE TYPE ARRAY
192 !
193 !dino IF (LFMMUL) CALL LOCKON(NFMLOC)
194 NFITYP(INUMBR)=KFTYPE
195 !dino IF (LFMMUL) CALL LOCKOFF(NFMLOC)
196 !
197 !*      8.    MESSAGE PRINTING WHATEVER THE ISSUE WAS
198 !
199 1000    CONTINUE
200
201 IF (IRESP.NE.0) THEN
202 YFNLFI=ADJUSTL(HFIPRI)
203 DO J=1,JPNXLU
204     IF (CNAMFI(J).EQ.YFNLFI) THEN
205        ILUPRI=J
206        EXIT
207     ENDIF
208 ENDDO
209 WRITE (ILUPRI,*) ' exit from FMOPEN with IRESP:',IRESP
210 WRITE (ILUPRI,*) '   | HFILEM = ',HFILEM
211 WRITE (ILUPRI,*) '   | HSTATU = ',HSTATU
212 WRITE (ILUPRI,*) '   | KNPRAR = ',KNPRAR
213 WRITE (ILUPRI,*) '   | KFTYPE = ',KFTYPE
214 ENDIF
215 KRESP=IRESP
216
217 RETURN
218       END SUBROUTINE FMOPEN