Philippe 23/02/2016: lfi2cdf: modif for JPHEXT/=1
[MNH-git_open_source-lfs.git] / LIBTOOLS / tools / diachro / src / FM / fmfree.f90
1 !     ######################################
2       SUBROUTINE FMFREE(HFILEM,HFIPRI,KRESP)
3 !     ######################################
4 !
5 !!****  *FMFREE* - routine to release a logical unit for FM
6 !!
7 !!    PURPOSE
8 !!    -------
9 !
10 !       The purpose of FMFREE is to free the logical unit attributed to
11 !     the file named HFILEM.
12 !
13 !!**  METHOD
14 !!    ------
15 !!
16 !!      The association between the file named HFILEM and its logical unit
17 !!    (ILOGIQ, say) was performed by a previous call to FMATTR. This link
18 !!    is broken by setting the value CNAMFI(ILOGIQ) back to CPUDFN, so that
19 !!    HFILEM does not appear anymore in CNAMFI.
20 !!
21 !!    EXTERNAL
22 !!    --------
23 !!
24 !!      LOCKON,LOCKOFF
25 !!
26 !!    IMPLICIT ARGUMENTS
27 !!    ------------------
28 !!
29 !!      MODULE: MODD_FMDECLAR contains management parameters and
30 !!              storage arrays to move information around at the
31 !!              level of all "FM"-routines.
32 !!              MODD_FMMULTI contains variables for multitasking
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                                                        06/94
49 !!      modified by C. Fischer                5/7/95 (locks for multitasking)
50 !!      modified by V. Masson               16/09/96 (prints if error occurs)
51 !!
52 !----------------------------------------------------------------------------
53 !
54 !*      0.    DECLARATIONS
55 !             ------------
56 !
57 USE MODD_FMDECLAR
58 USE MODD_FMMULTI
59
60 IMPLICIT NONE
61 !
62 !*      0.1   Declarations of arguments
63 !
64 CHARACTER(LEN=*),     INTENT(IN) ::HFILEM  ! file name
65
66 CHARACTER(LEN=*),     INTENT(IN) ::HFIPRI  ! file for prints in FM
67
68 INTEGER,              INTENT(OUT)::KRESP   ! return-code if problems araised
69
70 !
71 !*      0.2   Declarations of local variables
72 !
73 INTEGER::IRESP=0,J,ILOGIQ=0,ILUPRI
74 CHARACTER(LEN=JPFINL)::YLOCFN,YLOCFN2
75 !
76 !*      0.3   Taskcommon for logical units
77 !
78 COMMON/TASKFREE/ILUPRI
79 !DIR$ TASKCOMMON TASKFREE
80 !
81 !----------------------------------------------------------------------------
82 !
83 !*      1.    THE NAME IS SEARCHED IN CNAMFI AND ERASED
84 !
85 IRESP = 0 ; ILOGIQ = 0 ; ILUPRI = 6
86 YLOCFN=HFILEM ; YLOCFN=ADJUSTL(YLOCFN)
87
88 IF (LFMMUL) CALL LOCKON(NFMLOC)
89
90 DO J=1,JPNXLU
91    IF (YLOCFN.EQ.CNAMFI(J)) THEN
92       ILOGIQ=J
93       CNAMFI(J)=CPUDFN
94       EXIT
95    ENDIF
96 ENDDO
97 IF (ILOGIQ.EQ.0) THEN
98    IRESP=-42
99    GOTO 1000
100 ENDIF
101
102 NOPEFI=NOPEFI-1
103
104 IF (LFMMUL) CALL LOCKOFF(NFMLOC)
105
106 !
107 !*      2.    MESSAGE PRINTING WHATEVER THE ISSUE WAS
108 !
109 1000    CONTINUE
110
111 IF (IRESP.NE.0) THEN
112    YLOCFN2=ADJUSTL(HFIPRI)
113    IF (YLOCFN2.EQ.YLOCFN) THEN
114 ! special case where HFILEM is the output listing itself: no print in this case
115 ! because we do not know whether this file has already been closed or not
116       ILUPRI=ILOGIQ
117    ELSE
118 ! most common case is this one
119       DO J=1,JPNXLU
120          IF (CNAMFI(J).EQ.YLOCFN2) THEN
121             ILUPRI=J
122             EXIT
123          ENDIF
124       ENDDO
125    WRITE (ILUPRI,*) ' exit from FMFREE with IRESP:',IRESP
126    WRITE (ILUPRI,*) '   | HFILEM = ',HFILEM
127    ENDIF
128 ENDIF
129 KRESP=IRESP
130
131 RETURN
132       END SUBROUTINE FMFREE