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

Go to the documentation of this file.
00001 !     ######spl
00002       SUBROUTINE FMATTR(HFILEM,HFIPRI,KNUMBR,KRESP)
00003       USE PARKIND1, ONLY : JPRB
00004       USE YOMHOOK , ONLY : LHOOK, DR_HOOK
00005 !     #############################################
00006 !
00007 !!****  *FMATTR* - routine to attribute a logical unit to a file name
00008 !!
00009 !!    PURPOSE
00010 !!    -------
00011 !
00012 !       The purpose of FMATTR is to attribute to the file named HFILEM
00013 !     the logical unit number KNUMBR chosen among the free logical units
00014 !
00015 !!**  METHOD
00016 !!    ------
00017 !!
00018 !!      If FMATTR is called for the very first time, then all the management
00019 !!    arrays used by the FM-routines are initialized in FMINIT. 
00020 !!    Otherwise, the name HFILEM is searched in the array CNAMFI, where
00021 !!    it should not exist ! Finally, a logical unit number is searched
00022 !!    in array CNAMFI. As soon as a free place is found (CNAMFI=CPUDFN),
00023 !!    this place becomes the logical unit number for HFILEM and CNAMFI is
00024 !!    set to HFILEM.
00025 !!
00026 !!    EXTERNAL
00027 !!    --------
00028 !!
00029 !!
00030 !!    IMPLICIT ARGUMENTS
00031 !!    ------------------
00032 !!
00033 !!      MODULE: MODD_FMDECLAR contains management parameters and
00034 !!              storage arrays to move information around at the
00035 !!              level of all "FM"-routines.
00036 !!              MODD_FMMULTI contains variables for multitasking
00037 !!
00038 !!    REFERENCE
00039 !!    ---------
00040 !!
00041 !!      see the Technical Specifications Report for the Meso-nh project
00042 !!      (in French)
00043 !!
00044 !!    AUTHOR
00045 !!    ------
00046 !!
00047 !!      C. FISCHER      *METEO-FRANCE*
00048 !!
00049 !!    MODIFICATIONS
00050 !!    -------------
00051 !!
00052 !!      original                                                        04/94
00053 !!      modified by C. Fischer                5/7/95 (locks for multitasking)
00054 !!      modified by V. Masson               16/09/96 (prints if error occurs)
00055 !!
00056 !----------------------------------------------------------------------------
00057 !
00058 !*      0.    DECLARATIONS
00059 !             ------------
00060 !
00061 USE MODD_FMDECLAR
00062 USE MODD_FMMULTI
00063 
00064 IMPLICIT NONE
00065 !
00066 !*      0.1   Declarations of arguments
00067 !
00068 CHARACTER(LEN=*),     INTENT(IN) ::HFILEM  ! file name
00069 
00070 CHARACTER(LEN=*),     INTENT(IN) ::HFIPRI  ! file for prints in FM
00071 
00072 INTEGER,              INTENT(OUT)::KNUMBR  ! logical unit number
00073 INTEGER,              INTENT(OUT)::KRESP   ! return-code if problems araised
00074 !
00075 !*      0.2   Declarations of local variables
00076 !
00077 INTEGER::IRESP=0,J,ILOGIQ=0,ILUPRI
00078 CHARACTER(LEN=JPFINL)::YLOCFN,YLOCFN2
00079 !
00080 !*      0.3   Taskcommon for logical units
00081 !
00082 COMMON/TASKATTR/ILUPRI
00083 !DIR$ TASKCOMMON TASKATTR
00084 !
00085 !----------------------------------------------------------------------------
00086 !
00087 !*      1.    INITIALISATION AND TEST THAT FILE DOES NOT ALREADY EXIST
00088 !
00089 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00090 IF (LHOOK) CALL DR_HOOK('FMATTR',0,ZHOOK_HANDLE)
00091 IRESP = 0 ; ILOGIQ = 0 ; ILUPRI = 6
00092 YLOCFN=HFILEM ; YLOCFN=ADJUSTL(YLOCFN)
00093 
00094 
00095 IF (LFCATT) THEN
00096     CALL FMINIT
00097     LFCATT=.FALSE.
00098 ELSE
00099     IF (NOPEFI.LT.0) THEN
00100        IRESP=-50
00101        GOTO 1000
00102     ELSE
00103        DO J=1,JPNXLU
00104          IF (YLOCFN.EQ.CNAMFI(J)) THEN
00105            IRESP=-51
00106            GOTO 1000
00107          ENDIF
00108        ENDDO
00109     ENDIF
00110 ENDIF
00111 !
00112 !*     2.     WE LOOK FOR A FREE PLACE IN ARRAY CNAMFI
00113 !
00114 !   That place will become the number for the logical unit attributed to HFILEM
00115 !
00116 DO J=1,JPNXLU
00117     IF (CNAMFI(J).EQ.CPUDFN) THEN
00118        ILOGIQ=J
00119        CNAMFI(J)=YLOCFN
00120        EXIT
00121     ENDIF
00122 ENDDO
00123 IF (ILOGIQ.EQ.0) THEN
00124     IRESP=-52
00125     GOTO 1000
00126 ENDIF
00127 
00128 KNUMBR=ILOGIQ ; NOPEFI=NOPEFI+1
00129 !
00130 !*     3.     MESSAGE PRINTING WHATEVER THE ISSUE WAS
00131 !
00132 1000   CONTINUE
00133 
00134 IF (IRESP.NE.0) THEN
00135    YLOCFN2=ADJUSTL(HFIPRI)
00136 !
00137 ! in the special case where FMATTR is called to reserve a logical unit
00138 ! for the output file itself (i.e. HFILEM=HFIPRI),
00139 ! no print is performed because we do not know
00140 ! whether this file was actually opened or not.
00141 !
00142    IF (YLOCFN2.EQ.YLOCFN) THEN
00143       ILUPRI=ILOGIQ
00144    ELSE
00145       DO J=1,JPNXLU
00146          IF (CNAMFI(J).EQ.YLOCFN2) THEN
00147             ILUPRI=J
00148             EXIT
00149          ENDIF
00150       ENDDO
00151       WRITE (ILUPRI,*) ' exit from FMATTR with IRESP:',IRESP
00152       WRITE (ILUPRI,*) '   | HFILEM = ',HFILEM
00153    ENDIF
00154 ENDIF
00155 KRESP=IRESP
00156 
00157 IF (LHOOK) CALL DR_HOOK('FMATTR',1,ZHOOK_HANDLE)
00158 RETURN
00159       IF (LHOOK) CALL DR_HOOK('FMATTR',1,ZHOOK_HANDLE)
00160       END SUBROUTINE FMATTR