SURFEX v7.3: /home/dasprezs/EXPORT_v7_3/src/LIB/FM/fmlook.F90 Source File

Go to the documentation of this file.
00001 !     ######spl
00002       SUBROUTINE FMLOOK(HFILEM,HFIPRI,KNUMBR,KRESP)
00003       USE PARKIND1, ONLY : JPRB
00004       USE YOMHOOK , ONLY : LHOOK, DR_HOOK
00005 !     #############################################
00006 !
00007 !!****  *FMLOOK* - routine to look for the logical unit attributed to a file
00008 !!
00009 !!    PURPOSE
00010 !!    -------
00011 !
00012 !       The purpose of FMLOOK is to look for the logical unit (Fortran)
00013 !     that is associated to the file named HFILEM. This unit was attributed
00014 !     previously to HFILEM by FMATTR.
00015 !
00016 !!**  METHOD
00017 !!    ------
00018 !!
00019 !!      The string HFILEM is searched in array CNAMFI which contains the
00020 !!    names of all files that have been opened for the FM-routines.
00021 !!    The place in array CNAMFI of HFILEM corresponds exactly to
00022 !!    its logical unit.
00023 !!
00024 !!    EXTERNAL
00025 !!    --------
00026 !!
00027 !!      NONE
00028 !!
00029 !!    IMPLICIT ARGUMENTS
00030 !!    ------------------
00031 !!
00032 !!      MODULE: MODD_FMDECLAR contains management parameters and
00033 !!              storage arrays to move information around at the
00034 !!              level of all "FM"-routines.
00035 !!
00036 !!    REFERENCE
00037 !!    ---------
00038 !!
00039 !!      see the Technical Specifications Report for the Meso-nh project
00040 !!      (in French)
00041 !!
00042 !!    AUTHOR
00043 !!    ------
00044 !!
00045 !!      C. FISCHER      *METEO-FRANCE*
00046 !!
00047 !!    MODIFICATIONS
00048 !!    -------------
00049 !!
00050 !!      original                                                        04/94
00051 !!
00052 !----------------------------------------------------------------------------
00053 !
00054 !*      0.    DECLARATIONS
00055 !             ------------
00056 !
00057 USE MODD_FMDECLAR
00058 
00059 IMPLICIT NONE
00060 !
00061 !*      0.1   Declarations of arguments
00062 !
00063 CHARACTER(LEN=*),     INTENT(IN) ::HFILEM  ! file name
00064 
00065 CHARACTER(LEN=*),     INTENT(IN) ::HFIPRI  ! file for prints in FM
00066 
00067 INTEGER,              INTENT(OUT)::KNUMBR  ! logical unit number
00068 INTEGER,              INTENT(OUT)::KRESP   ! return-code if problems araised
00069 
00070 !
00071 !*      0.2   Declarations of local variables
00072 !
00073 INTEGER::J,ILOGIQ=0,IRESP=0,ILUPRI
00074 CHARACTER(LEN=JPFINL)::YLOCFN
00075 !
00076 !*      0.3   Taskcommon for logical units
00077 !
00078 COMMON/TASKLOOK/ILUPRI
00079 !DIR$ TASKCOMMON TASKLOOK
00080 !
00081 !----------------------------------------------------------------------------
00082 !
00083 !*      1.    WE LOOK FOR THE FILE NAME IN ARRAY CNAMFI
00084 !
00085 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00086 IF (LHOOK) CALL DR_HOOK('FMLOOK',0,ZHOOK_HANDLE)
00087 ILOGIQ = 0 ; IRESP = 0 ; ILUPRI = 6
00088 IF (NOPEFI.LT.1) THEN
00089      IRESP=-53
00090      GOTO 1000
00091 ENDIF
00092 YLOCFN=HFILEM ; YLOCFN=ADJUSTL(YLOCFN)
00093 DO J=1,JPNXLU
00094      IF (YLOCFN.EQ.CNAMFI(J)) THEN
00095         ILOGIQ=J
00096         EXIT
00097      ENDIF
00098 ENDDO
00099 IF (ILOGIQ.EQ.0) THEN
00100      IRESP=-54
00101      GOTO 1000
00102 ENDIF
00103 
00104 KNUMBR=ILOGIQ
00105 !
00106 !*      2.     MESSAGE PRINTING WHATEVER THE ISSUE WAS
00107 !
00108 1000    CONTINUE
00109 
00110 IF (IRESP.NE.0) THEN
00111 YLOCFN=ADJUSTL(HFIPRI)
00112 DO J=1,JPNXLU
00113     IF (CNAMFI(J).EQ.YLOCFN) THEN
00114        ILUPRI=J
00115        EXIT
00116     ENDIF
00117 ENDDO
00118 WRITE (ILUPRI,*) ' exit from FMLOOK with IRESP:',IRESP
00119 WRITE (ILUPRI,*) '   | HFILEM = ',HFILEM
00120 ENDIF
00121 KRESP=IRESP
00122 
00123 IF (LHOOK) CALL DR_HOOK('FMLOOK',1,ZHOOK_HANDLE)
00124 RETURN
00125       IF (LHOOK) CALL DR_HOOK('FMLOOK',1,ZHOOK_HANDLE)
00126       END SUBROUTINE FMLOOK