fmfree.F90

Go to the documentation of this file.

!     ######spl
      SUBROUTINE fmfree(HFILEM,HFIPRI,KRESP)
      USE parkind1, ONLY : jprb
      USE yomhook , ONLY : lhook, dr_hook
!     ######################################
!
!!****  *FMFREE* - routine to release a logical unit for FM
!!
!!    PURPOSE
!!    -------
!
!       The purpose of FMFREE is to free the logical unit attributed to
!     the file named HFILEM.
!
!!**  METHOD
!!    ------
!!
!!      The association between the file named HFILEM and its logical unit
!!    (ILOGIQ, say) was performed by a previous call to FMATTR. This link
!!    is broken by setting the value CNAMFI(ILOGIQ) back to CPUDFN, so that
!!    HFILEM does not appear anymore in CNAMFI.
!!
!!    EXTERNAL
!!    --------
!!
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!      MODULE: MODD_FMDECLAR contains management parameters and
!!              storage arrays to move information around at the
!!              level of all "FM"-routines.
!!              MODD_FMMULTI contains variables for multitasking
!!
!!    REFERENCE
!!    ---------
!!
!!      see the Technical Specifications Report for the Meso-nh project
!!      (in French)
!!
!!    AUTHOR
!!    ------
!!
!!      C. FISCHER      *METEO-FRANCE*
!!
!!    MODIFICATIONS
!!    -------------
!!
!!      original                                                        06/94
!!      modified by C. Fischer                5/7/95 (locks for multitasking)
!!      modified by V. Masson               16/09/96 (prints if error occurs)
!!
!----------------------------------------------------------------------------
!
!*      0.    DECLARATIONS
!             ------------
!
USE modd_fmdeclar
USE modd_fmmulti

IMPLICIT NONE
!
!*      0.1   Declarations of arguments
!
CHARACTER(LEN=*),     INTENT(IN) ::HFILEM  ! file name

CHARACTER(LEN=*),     INTENT(IN) ::HFIPRI  ! file for prints in FM

INTEGER,              INTENT(OUT)::KRESP   ! return-code if problems araised

!
!*      0.2   Declarations of local variables
!
INTEGER::IRESP=0,j,ilogiq=0,ilupri
CHARACTER(LEN=JPFINL)::YLOCFN,YLOCFN2
!
!*      0.3   Taskcommon for logical units
!
COMMON/TASKFREE/ILUPRI
!DIR$ TASKCOMMON TASKFREE
!
!----------------------------------------------------------------------------
!
!*      1.    THE NAME IS SEARCHED IN CNAMFI AND ERASED
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (lhook) CALL dr_hook('FMFREE',0,zhook_handle)
iresp = 0 ; ilogiq = 0 ; ilupri = 6
ylocfn=hfilem ; ylocfn=adjustl(ylocfn)


DO j=1,jpnxlu
   IF (ylocfn.EQ.cnamfi(j)) THEN
      ilogiq=j
      cnamfi(j)=cpudfn
      EXIT
   ENDIF
ENDDO
IF (ilogiq.EQ.0) THEN
   iresp=-42
   GOTO 1000
ENDIF

nopefi=nopefi-1


!
!*      2.    MESSAGE PRINTING WHATEVER THE ISSUE WAS
!
1000    CONTINUE

IF (iresp.NE.0) THEN
   ylocfn2=adjustl(hfipri)
   IF (ylocfn2.EQ.ylocfn) THEN
! special case where HFILEM is the output listing itself: no print in this case
! because we do not know whether this file has already been closed or not
      ilupri=ilogiq
   ELSE
! most common case is this one
      DO j=1,jpnxlu
         IF (cnamfi(j).EQ.ylocfn2) THEN
            ilupri=j
            EXIT
         ENDIF
      ENDDO
   WRITE (ilupri,*) ' exit from FMFREE with IRESP:',iresp
   WRITE (ilupri,*) '   | HFILEM = ',hfilem
   ENDIF
ENDIF
kresp=iresp

IF (lhook) CALL dr_hook('FMFREE',1,zhook_handle)
RETURN
      IF (lhook) CALL dr_hook('FMFREE',1,zhook_handle)
      END SUBROUTINE fmfree