fmopen.F90

Go to the documentation of this file.

!     ######spl
      SUBROUTINE fmopen(HFILEM,HSTATU,HFIPRI,KNPRAR,KFTYPE,KVERB,&
                        KNINAR,KRESP)
      USE parkind1, ONLY : jprb
      USE yomhook , ONLY : lhook, dr_hook
!     ############################################################
!
!!****  *FMOPEN* - routine to open a meso-nh file (DESFM+LFIFM)
!!
!!    PURPOSE
!!    -------
!
!       The purpose of FMOPEN is to open a meso-nh file for the "FM"-routines.
!     It is composed of two distinct fortran files: DESFM and LFIFM. DESFM is
!     a namelist formatted file. LFIFM is a LFI file, managed by the LFI-package.
!     LFIFM is a fortran unformatted, direct access file which is
!     manipulated by the FM-routines FMREAD and FMWRIT. 
!     The namelist file is a fortran 90 standard formatted file.
!
!!**  METHOD
!!    ------
!!
!!      The opening is performed in 4 main steps:
!!            1. a logical unit is reserved for DESFM (first call to FMATTR)
!!            2. the DESFM file is created by a
!!               formatted, fortran open. The name of the file is obtained by
!!               appending ".des" to HFILEM.
!!            3. a logical unit is reserved for LFIFM (second call to FMATTR)
!!            4. the LFIFM file is opened in the LFIOUV routine to
!!               which most of the explicit input arguments of FMOPEN are passed.
!!               The name of that file is obtained by appending ".lfi"
!!               to HFILEM.
!!
!!    EXTERNAL
!!    --------
!!
!!      FMATTR,LFIOUV,OPEN
!!
!!    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  ! name of the file
CHARACTER(LEN=*),     INTENT(IN) ::HSTATU  ! status of the file at opening
CHARACTER(LEN=*),     INTENT(IN) ::HFIPRI  ! file for prints in FM

INTEGER,          INTENT(IN) ::KNPRAR  ! number of predicted articles (not vital)
INTEGER,          INTENT(IN) ::KFTYPE  ! type of FM-file
INTEGER,          INTENT(IN) ::KVERB   ! level of verbose

INTEGER,          INTENT(OUT)::KNINAR  ! number of articles initially present in the file
INTEGER,          INTENT(OUT)::KRESP   ! return-code if a problem araised

!
!*      0.2   Declarations of local variables
!
INTEGER::IRESOU,INPRAR,IROWF,IRESP,J,INUMBR,IFMFNL,IMELEV,ILUPRI
CHARACTER(LEN=JPFINL)::YFNDES,YFNLFI
CHARACTER(LEN=LEN(HFILEM))::YINTFN
LOGICAL::GNEWFI,GNAMFI=.true.,gfater=.true.,gstats
!
!*      0.3   Taskcommon for logical units
!
COMMON/TASKOPEN/ILUPRI,INUMBR,IRESP,YFNDES,YFNLFI
!DIR$ TASKCOMMON TASKOPEN
!
!----------------------------------------------------------------------------
!
!*      1.    INITIALIZATION
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (lhook) CALL dr_hook('FMOPEN',0,zhook_handle)
inprar=knprar+0;kninar=0
iresou = 0 ; irowf = 0 ; iresp = 0 ; ilupri = 6
!
!* the model's verbose level is connected to the LFI verbose
!
SELECT CASE (kverb)
CASE(:2)
   gstats=.false. ; imelev=0
CASE(3:6)
   gstats=.false. ; imelev=1
CASE(7:9)
   gstats=.false. ; imelev=2
CASE(10:)
   gstats=.true. ; imelev=2
END SELECT

IF (nopefi.GE.jpnxfm) THEN
        iresp=-44
        GOTO 1000
ENDIF
!
!*      2.    LOGICAL UNIT FOR DESFM
!
!  the fortran name for DESFM
!
ifmfnl=jpfinl-4

irowf=len(hfilem)

IF (irowf.EQ.0) THEN
   iresp=-45
   GOTO 1000
ELSEIF (irowf.GT.ifmfnl) THEN
   iresp=-49
   GOTO 1000
ENDIF
yintfn=adjustr(hfilem)
yfndes=yintfn//'.des'
yfndes=adjustl(yfndes)

CALL FMATTR(YFNDES,HFIPRI,INUMBR,IRESP)
IF (iresp.NE.0) GOTO 1000

!
!*      3.    FILE OPENING FOR DESFM
!
!  case of a namelist: sequential, formatted fortran open
!
OPEN(unit=inumbr,file=yfndes,form='FORMATTED',delim='QUOTE',iostat=iresp)
IF (iresp.NE.0) GOTO 1000
!
!*      4.    LOGICAL UNIT FOR LFIFM
!
!  the fortran name for LFIFM
!
yfnlfi=yintfn//'.lfi'
yfnlfi=adjustl(yfnlfi)

CALL FMATTR(YFNLFI,HFIPRI,INUMBR,IRESP)
IF (iresp.NE.0) GOTO 1000
!
!*      5.    FILE OPENING FOR LFIFM
!
!  case of a LFI-file: direct access, unformatted open via LFIOUV
!
CALL LFIOUV(IRESOU,INUMBR,GNAMFI,YFNLFI,HSTATU,GFATER,GSTATS,IMELEV,INPRAR,&
            kninar)
IF (iresou.NE.0.AND.iresou.NE.-11) THEN
        iresp=iresou
        GOTO 1000
ENDIF

!
!*      6.    TEST IF FILE IS NEWLY DEFINED
!

gnewfi=(kninar.EQ.0).OR.(kverb.LT.7)
IF (.NOT.gnewfi) THEN
yfnlfi=adjustl(hfipri)
DO j=1,jpnxlu
    IF (cnamfi(j).EQ.yfnlfi) THEN
       ilupri=j
       EXIT
    ENDIF
ENDDO
WRITE (ilupri,*) ' file ',inumbr,'previously created with LFI'
ENDIF
!
!*      7.    UPDATE OF THE FILE TYPE ARRAY
!
nfityp(inumbr)=kftype
!
!*      8.    MESSAGE PRINTING WHATEVER THE ISSUE WAS
!
1000    CONTINUE

IF (iresp.NE.0) THEN
yfnlfi=adjustl(hfipri)
DO j=1,jpnxlu
    IF (cnamfi(j).EQ.yfnlfi) THEN
       ilupri=j
       EXIT
    ENDIF
ENDDO
WRITE (ilupri,*) ' exit from FMOPEN with IRESP:',iresp
WRITE (ilupri,*) '   | HFILEM = ',hfilem
WRITE (ilupri,*) '   | HSTATU = ',hstatu
WRITE (ilupri,*) '   | KNPRAR = ',knprar
WRITE (ilupri,*) '   | KFTYPE = ',kftype
ENDIF
kresp=iresp

IF (lhook) CALL dr_hook('FMOPEN',1,zhook_handle)
RETURN
      IF (lhook) CALL dr_hook('FMOPEN',1,zhook_handle)
      END SUBROUTINE fmopen