Philippe 02/05/2016: moved all LIBTOOLS files in LIBTOOLS directory
[MNH-git_open_source-lfs.git] / LIBTOOLS / tools / diachro / src / FM / fmlook.f90
1 !     ######spl
2       SUBROUTINE FMLOOK(HFILEM,HFIPRI,KNUMBR,KRESP)
3 !     #############################################
4 !
5 !!****  *FMLOOK* - routine to look for the logical unit attributed to a file
6 !!
7 !!    PURPOSE
8 !!    -------
9 !
10 !       The purpose of FMLOOK is to look for the logical unit (Fortran)
11 !     that is associated to the file named HFILEM. This unit was attributed
12 !     previously to HFILEM by FMATTR.
13 !
14 !!**  METHOD
15 !!    ------
16 !!
17 !!      The string HFILEM is searched in array CNAMFI which contains the
18 !!    names of all files that have been opened for the FM-routines.
19 !!    The place in array CNAMFI of HFILEM corresponds exactly to
20 !!    its logical unit.
21 !!
22 !!    EXTERNAL
23 !!    --------
24 !!
25 !!      NONE
26 !!
27 !!    IMPLICIT ARGUMENTS
28 !!    ------------------
29 !!
30 !!      MODULE: MODD_FMDECLAR contains management parameters and
31 !!              storage arrays to move information around at the
32 !!              level of all "FM"-routines.
33 !!
34 !!    REFERENCE
35 !!    ---------
36 !!
37 !!      see the Technical Specifications Report for the Meso-nh project
38 !!      (in French)
39 !!
40 !!    AUTHOR
41 !!    ------
42 !!
43 !!      C. FISCHER      *METEO-FRANCE*
44 !!
45 !!    MODIFICATIONS
46 !!    -------------
47 !!
48 !!      original                                                        04/94
49 !!
50 !----------------------------------------------------------------------------
51 !
52 !*      0.    DECLARATIONS
53 !             ------------
54 !
55 USE MODD_FMDECLAR
56
57 IMPLICIT NONE
58 !
59 !*      0.1   Declarations of arguments
60 !
61 CHARACTER(LEN=*),     INTENT(IN) ::HFILEM  ! file name
62
63 CHARACTER(LEN=*),     INTENT(IN) ::HFIPRI  ! file for prints in FM
64
65 INTEGER,              INTENT(OUT)::KNUMBR  ! logical unit number
66 INTEGER,              INTENT(OUT)::KRESP   ! return-code if problems araised
67
68 !
69 !*      0.2   Declarations of local variables
70 !
71 INTEGER::J,ILOGIQ=0,IRESP=0,ILUPRI
72 CHARACTER(LEN=JPFINL)::YLOCFN
73 !
74 !*      0.3   Taskcommon for logical units
75 !
76 COMMON/TASKLOOK/ILUPRI
77 !DIR$ TASKCOMMON TASKLOOK
78 !
79 !----------------------------------------------------------------------------
80 !
81 !*      1.    WE LOOK FOR THE FILE NAME IN ARRAY CNAMFI
82 !
83 ILOGIQ = 0 ; IRESP = 0 ; ILUPRI = 6
84 IF (NOPEFI.LT.1) THEN
85      IRESP=-53
86      GOTO 1000
87 ENDIF
88 YLOCFN=HFILEM ; YLOCFN=ADJUSTL(YLOCFN)
89 DO J=1,JPNXLU
90      IF (YLOCFN.EQ.CNAMFI(J)) THEN
91         ILOGIQ=J
92         EXIT
93      ENDIF
94 ENDDO
95 IF (ILOGIQ.EQ.0) THEN
96      IRESP=-54
97      GOTO 1000
98 ENDIF
99
100 KNUMBR=ILOGIQ
101 !
102 !*      2.     MESSAGE PRINTING WHATEVER THE ISSUE WAS
103 !
104 1000    CONTINUE
105
106 IF (IRESP.NE.0) THEN
107 YLOCFN=ADJUSTL(HFIPRI)
108 DO J=1,JPNXLU
109     IF (CNAMFI(J).EQ.YLOCFN) THEN
110        ILUPRI=J
111        EXIT
112     ENDIF
113 ENDDO
114 WRITE (ILUPRI,*) ' exit from FMLOOK with IRESP:',IRESP
115 WRITE (ILUPRI,*) '   | HFILEM = ',HFILEM
116 ENDIF
117 KRESP=IRESP
118
119 RETURN
120       END SUBROUTINE FMLOOK