|
SURFEX v7.3
General documentation of Surfex
|
|
SURFEX v7.3
General documentation of Surfex
|
00001 ! ######spl 00002 SUBROUTINE FMFREE(HFILEM,HFIPRI,KRESP) 00003 USE PARKIND1, ONLY : JPRB 00004 USE YOMHOOK , ONLY : LHOOK, DR_HOOK 00005 ! ###################################### 00006 ! 00007 !!**** *FMFREE* - routine to release a logical unit for FM 00008 !! 00009 !! PURPOSE 00010 !! ------- 00011 ! 00012 ! The purpose of FMFREE is to free the logical unit attributed to 00013 ! the file named HFILEM. 00014 ! 00015 !!** METHOD 00016 !! ------ 00017 !! 00018 !! The association between the file named HFILEM and its logical unit 00019 !! (ILOGIQ, say) was performed by a previous call to FMATTR. This link 00020 !! is broken by setting the value CNAMFI(ILOGIQ) back to CPUDFN, so that 00021 !! HFILEM does not appear anymore in CNAMFI. 00022 !! 00023 !! EXTERNAL 00024 !! -------- 00025 !! 00026 !! 00027 !! IMPLICIT ARGUMENTS 00028 !! ------------------ 00029 !! 00030 !! MODULE: MODD_FMDECLAR contains management parameters and 00031 !! storage arrays to move information around at the 00032 !! level of all "FM"-routines. 00033 !! MODD_FMMULTI contains variables for multitasking 00034 !! 00035 !! REFERENCE 00036 !! --------- 00037 !! 00038 !! see the Technical Specifications Report for the Meso-nh project 00039 !! (in French) 00040 !! 00041 !! AUTHOR 00042 !! ------ 00043 !! 00044 !! C. FISCHER *METEO-FRANCE* 00045 !! 00046 !! MODIFICATIONS 00047 !! ------------- 00048 !! 00049 !! original 06/94 00050 !! modified by C. Fischer 5/7/95 (locks for multitasking) 00051 !! modified by V. Masson 16/09/96 (prints if error occurs) 00052 !! 00053 !---------------------------------------------------------------------------- 00054 ! 00055 !* 0. DECLARATIONS 00056 ! ------------ 00057 ! 00058 USE MODD_FMDECLAR 00059 USE MODD_FMMULTI 00060 00061 IMPLICIT NONE 00062 ! 00063 !* 0.1 Declarations of arguments 00064 ! 00065 CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! file name 00066 00067 CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! file for prints in FM 00068 00069 INTEGER, INTENT(OUT)::KRESP ! return-code if problems araised 00070 00071 ! 00072 !* 0.2 Declarations of local variables 00073 ! 00074 INTEGER::IRESP=0,J,ILOGIQ=0,ILUPRI 00075 CHARACTER(LEN=JPFINL)::YLOCFN,YLOCFN2 00076 ! 00077 !* 0.3 Taskcommon for logical units 00078 ! 00079 COMMON/TASKFREE/ILUPRI 00080 !DIR$ TASKCOMMON TASKFREE 00081 ! 00082 !---------------------------------------------------------------------------- 00083 ! 00084 !* 1. THE NAME IS SEARCHED IN CNAMFI AND ERASED 00085 ! 00086 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00087 IF (LHOOK) CALL DR_HOOK('FMFREE',0,ZHOOK_HANDLE) 00088 IRESP = 0 ; ILOGIQ = 0 ; ILUPRI = 6 00089 YLOCFN=HFILEM ; YLOCFN=ADJUSTL(YLOCFN) 00090 00091 00092 DO J=1,JPNXLU 00093 IF (YLOCFN.EQ.CNAMFI(J)) THEN 00094 ILOGIQ=J 00095 CNAMFI(J)=CPUDFN 00096 EXIT 00097 ENDIF 00098 ENDDO 00099 IF (ILOGIQ.EQ.0) THEN 00100 IRESP=-42 00101 GOTO 1000 00102 ENDIF 00103 00104 NOPEFI=NOPEFI-1 00105 00106 00107 ! 00108 !* 2. MESSAGE PRINTING WHATEVER THE ISSUE WAS 00109 ! 00110 1000 CONTINUE 00111 00112 IF (IRESP.NE.0) THEN 00113 YLOCFN2=ADJUSTL(HFIPRI) 00114 IF (YLOCFN2.EQ.YLOCFN) THEN 00115 ! special case where HFILEM is the output listing itself: no print in this case 00116 ! because we do not know whether this file has already been closed or not 00117 ILUPRI=ILOGIQ 00118 ELSE 00119 ! most common case is this one 00120 DO J=1,JPNXLU 00121 IF (CNAMFI(J).EQ.YLOCFN2) THEN 00122 ILUPRI=J 00123 EXIT 00124 ENDIF 00125 ENDDO 00126 WRITE (ILUPRI,*) ' exit from FMFREE with IRESP:',IRESP 00127 WRITE (ILUPRI,*) ' | HFILEM = ',HFILEM 00128 ENDIF 00129 ENDIF 00130 KRESP=IRESP 00131 00132 IF (LHOOK) CALL DR_HOOK('FMFREE',1,ZHOOK_HANDLE) 00133 RETURN 00134 IF (LHOOK) CALL DR_HOOK('FMFREE',1,ZHOOK_HANDLE) 00135 END SUBROUTINE FMFREE
1.8.0
