!> @file !> @brief Contains module WMUNITMD. !> !> @author H. L. Tolman @date 29-May-2009 !> #include "w3macros.h" !/ ------------------------------------------------------------------- / !> !> @brief Dynamic assignement of unit numbers for the multi-grid wave !> model. !> !> @details Allowed range of unit numbers is set in parameter statements. !> !> @author H. L. Tolman @date 29-May-2009 !> MODULE WMUNITMD !/ !/ +-----------------------------------+ !/ | WAVEWATCH III NOAA/NCEP | !/ | H. L. Tolman | !/ | FORTRAN 90 | !/ | Last update : 29-May-2009 | !/ +-----------------------------------+ !/ !/ 29-Mar-2005 : Origination. ( version 3.07 ) !/ 29-May-2009 : Preparing distribution version. ( version 3.14 ) !/ !/ Copyright 2009 National Weather Service (NWS), !/ National Oceanic and Atmospheric Administration. All rights !/ reserved. WAVEWATCH III is a trademark of the NWS. !/ No unauthorized use without permission. !/ ! 1. Purpose : ! ! Dynamic assignement of unit numbers for the multi-grid wave ! model. ! ! Allowed range of unit numbers is set in parameter statements. ! ! 2. Variables and types : ! ! Name Type Scope Description ! ---------------------------------------------------------------- ! UNITLW I.P. Private Lowest unit number. ! UNITHG I.P. Private Highest unit number. ! INPLOW, INPHGH, OUTLOW, OUTHGH, SCRLOW, SCRHGH ! I.P. Private Low and high for input, output and ! scratch files. ! FLINIT Log. Private Flag for intialization. ! ! U_USED L.A. Private Flag for use/assignement. ! U_TYPE C.A. Private Type of unit. ! 'RES' : Reserved. ! 'INP' : Input file. ! 'OUT' : Output file. ! 'SCR' : Scratch file. ! U_NAME C.A. Private File name of unit. ! U_DESC C.A. Private Decription of file. ! ---------------------------------------------------------------- ! ! 3. Subroutines and functions : ! ! Name Type Scope Description ! ---------------------------------------------------------------- ! WMUINI Subr. Public Initialize data structures. ! WMUDMP Subr. Public Dump contents of data structures. ! WMUSET Subr. Public Put data directly in structure. ! WMUGET Subr. Public Get a unit number. ! WMUINQ Subr. Public Update ansilary info automatically. ! ---------------------------------------------------------------- ! ! 4. Subroutines and functions used : ! ! Name Type Module Description ! ---------------------------------------------------------------- ! STRACE Subr. W3SERVMD Subroutine tracing. ! EXTCDE Subr. Id. Program abort. ! ---------------------------------------------------------------- ! ! 5. Remarks : ! ! - All parameters are private. Dump data using WMUDMP routine. ! ! 6. Switches : ! ! !/S Enable subroutine tracing. ! !/T Enable test output ! ! 7. Source code : ! !/ ------------------------------------------------------------------- / PUBLIC !/ !/ Define acceptable ranges of unit numbers !/ INTEGER, PARAMETER, PRIVATE :: UNITLW = 1 !< UNITLW INTEGER, PARAMETER, PRIVATE :: UNITHG = 120 !< UNITHG INTEGER, PARAMETER, PRIVATE :: INPLOW = 10 !< INPLOW INTEGER, PARAMETER, PRIVATE :: INPHGH = 49 !< INPHGH INTEGER, PARAMETER, PRIVATE :: OUTLOW = 50 !< OUTLOW INTEGER, PARAMETER, PRIVATE :: OUTHGH = 98 !< OUTHGH INTEGER, PARAMETER, PRIVATE :: SCRLOW = 99 !< SCRLOW INTEGER, PARAMETER, PRIVATE :: SCRHGH = 100 !< SCRHGH ! LOGICAL, PRIVATE :: FLINIT = .FALSE. !< FLINIT LOGICAL, PRIVATE, ALLOCATABLE :: U_USED(:) !< U_USED CHARACTER(LEN= 3), PRIVATE, ALLOCATABLE :: U_TYPE(:) !< U_TYPE CHARACTER(LEN=30), PRIVATE, ALLOCATABLE :: U_NAME(:) !< U_NAME CHARACTER(LEN=30), PRIVATE, ALLOCATABLE :: U_DESC(:) !< U_DESC !/ CONTAINS !/ ------------------------------------------------------------------- / !> !> @brief Allocate and initialize arrays of module. !> !> @details Allocate and test parameter setting. !> !> @param[in] NDSE Unit number for error output. !> @param[in] NDST Unit number for test output. !> @author H. L. Tolman @date 25-Mar-2005 !> SUBROUTINE WMUINI ( NDSE, NDST ) !/ !/ +-----------------------------------+ !/ | WAVEWATCH III NOAA/NCEP | !/ | H. L. Tolman | !/ | FORTRAN 90 | !/ | Last update : 25-Mar-2005 ! !/ +-----------------------------------+ !/ !/ 25-Mar-2005 : Origination. ( version 3.07 ) !/ ! 1. Purpose : ! ! Allocate and initialize arrays of module. ! ! 2. Method : ! ! Allocate and test parameter setting. ! ! 3. Parameters : ! ! Parameter list ! ---------------------------------------------------------------- ! NDSE Int. I Unit number for error output. ! NDST Int. I Unit number for test output. ! ---------------------------------------------------------------- ! ! 4. Subroutines used : ! ! Name Type Module Description ! ---------------------------------------------------------------- ! STRACE Subr. W3SERVMD Subroutine tracing. ! EXTCDE Subr. Id. Program abort. ! ---------------------------------------------------------------- ! ! 5. Called by : ! ! 6. Error messages : ! ! See source code. ! ! 7. Remarks : ! ! 8. Structure : ! ! See source code. ! ! 9. Switches : ! ! !/S Enable subroutine tracing. ! !/T Enable test output ! ! 10. Source code : ! !/ ------------------------------------------------------------------- / USE W3SERVMD, ONLY: EXTCDE #ifdef W3_S USE W3SERVMD, ONLY: STRACE #endif ! IMPLICIT NONE !/ !/ ------------------------------------------------------------------- / !/ Parameter list !/ INTEGER, INTENT(IN) :: NDSE, NDST !/ !/ ------------------------------------------------------------------- / !/ Local parameters !/ INTEGER :: J, I1, IN, I #ifdef W3_S INTEGER, SAVE :: IENT = 0 #endif CHARACTER(LEN=3) :: STRING !/ #ifdef W3_S CALL STRACE (IENT, 'WMUINI') #endif ! ! -------------------------------------------------------------------- / ! 1. Test parameter settings ! #ifdef W3_T WRITE (NDST,9000) #endif ! IF ( UNITLW .GE. UNITHG ) THEN WRITE (NDSE,1000) UNITLW, UNITHG CALL EXTCDE ( 1000 ) END IF ! IF ( UNITLW .GT. INPLOW .OR. & UNITLW .GT. OUTLOW .OR. & UNITLW .GT. SCRLOW ) THEN WRITE (NDSE,1001) UNITLW, INPLOW, OUTLOW, SCRLOW CALL EXTCDE ( 1001 ) END IF ! IF ( UNITHG .LT. INPHGH .OR. & UNITHG .LT. OUTHGH .OR. & UNITHG .LT. SCRHGH ) THEN WRITE (NDSE,1002) UNITHG, INPHGH, OUTHGH, SCRHGH CALL EXTCDE ( 1002 ) END IF ! IF ( FLINIT ) THEN WRITE (NDSE,1003) CALL EXTCDE ( 1003 ) END IF ! ! -------------------------------------------------------------------- / ! 1. Allocate and initialize arrays ! #ifdef W3_T WRITE (NDST,9010) UNITLW, UNITHG #endif ! ALLOCATE ( U_USED(UNITLW:UNITHG) , U_TYPE(UNITLW:UNITHG) , & U_NAME(UNITLW:UNITHG) , U_DESC(UNITLW:UNITHG) ) ! U_USED = .FALSE. U_TYPE = 'RES' U_NAME = 'unknown' U_DESC = 'unknown' ! ! -------------------------------------------------------------------- / ! 2. Designate file types ! #ifdef W3_T WRITE (NDST,9020) #endif ! DO J=1, 3 ! SELECT CASE(J) CASE(1) STRING = 'INP' I1 = INPLOW IN = INPHGH CASE(2) STRING = 'OUT' I1 = OUTLOW IN = OUTHGH CASE DEFAULT STRING = 'SCR' I1 = SCRLOW IN = SCRHGH END SELECT ! DO I=I1, IN IF ( U_TYPE(I) .NE. 'RES' ) THEN WRITE (NDSE,1020) I, U_TYPE(I) END IF U_TYPE(I) = STRING END DO END DO ! ! -------------------------------------------------------------------- / ! 3. Set flags ! #ifdef W3_T WRITE (NDST,9030) #endif ! FLINIT = .TRUE. ! ! -------------------------------------------------------------------- / ! 4. Test output ! #ifdef W3_T WRITE (NDST,9040) DO I=UNITLW, UNITHG WRITE (NDST,9041) I,U_USED(I),U_TYPE(I),U_NAME(I),U_DESC(I) END DO #endif ! RETURN ! ! Formats ! 1000 FORMAT (/' *** ERROR WMUINI: ILLEGAL UNIT RANGE ***'/ & ' LOW - HIGH : ',2I10/) 1001 FORMAT (/' *** ERROR WMUINI: ILLEGAL LOWER LIMITS ***'/ & ' ',4I10/) 1002 FORMAT (/' *** ERROR WMUINI: ILLEGAL HIGHER LIMITS ***'/ & ' ',4I10/) 1003 FORMAT (/' *** ERROR WMUINI: DATA ALREADY INITIALIZED ***'/) 1020 FORMAT (/' *** WARNING WMUINI: UNIT',I4,' ALREADY ASSIGNED [', & A,'] ***') ! #ifdef W3_T 9000 FORMAT ( ' TEST WMUNINI: STARTING ROUTINE') 9010 FORMAT ( ' TEST WMUNINI: ALLOCATING ARRAYS ',2I6) 9020 FORMAT ( ' TEST WMUNINI: INITALIZING ARRAYS') 9030 FORMAT ( ' TEST WMUNINI: SETTING FLAGS') 9040 FORMAT ( ' TEST WMUNINI: DATA STRUCTURE AFTER INITIALIZATION') 9041 FORMAT ( 5X,I4,L4,3(2X,A)) #endif !/ !/ End of WMUINI ----------------------------------------------------- / !/ END SUBROUTINE WMUINI !/ ------------------------------------------------------------------- / !> !> @brief Display assigned unit number information from private data base. !> !> @param[in] NDS Unit number for output. !> @param[in] IREQ Request identifier. !> !> @author H. L. Tolman @date 25-Mar-2005 !> SUBROUTINE WMUDMP ( NDS, IREQ ) !/ !/ +-----------------------------------+ !/ | WAVEWATCH III NOAA/NCEP | !/ | H. L. Tolman | !/ | FORTRAN 90 | !/ | Last update : 25-Mar-2005 ! !/ +-----------------------------------+ !/ !/ 25-Mar-2005 : Origination. ( version 3.07 ) !/ ! 1. Purpose : ! ! Display assigned unit number information from private data base. ! ! 2. Method : ! ! 3. Parameters : ! ! Parameter list ! ---------------------------------------------------------------- ! NDS Int. I Unit number for output. ! IREQ Int. I Request identifier. ! < 0 : Dump all data. ! 0 : Dump assigned units only. ! > 0 : Dump this unit only. ! ---------------------------------------------------------------- ! ! 4. Subroutines used : ! ! Name Type Module Description ! ---------------------------------------------------------------- ! STRACE Subr. W3SERVMD Subroutine tracing. ! EXTCDE Subr. Id. Program abort. ! ---------------------------------------------------------------- ! ! 5. Called by : ! ! 6. Error messages : ! ! 7. Remarks : ! ! 8. Structure : ! ! 9. Switches : ! ! !/S Enable subroutine tracing. ! !/T Enable test output ! ! 10. Source code : ! !/ ------------------------------------------------------------------- / USE W3SERVMD, ONLY: EXTCDE #ifdef W3_S USE W3SERVMD, ONLY: STRACE #endif ! IMPLICIT NONE !/ !/ ------------------------------------------------------------------- / !/ Parameter list !/ INTEGER, INTENT(IN) :: NDS, IREQ !/ !/ ------------------------------------------------------------------- / !/ Local parameters !/ INTEGER :: I #ifdef W3_S INTEGER, SAVE :: IENT = 0 #endif !/ #ifdef W3_S CALL STRACE (IENT, 'WMUDMP') #endif ! ! -------------------------------------------------------------------- / ! 1. Test request and intialization ! IF ( .NOT. FLINIT ) THEN WRITE (NDS,1000) CALL EXTCDE ( 1000 ) END IF ! IF ( IREQ.GT.0 .AND. ( IREQ.LT.UNITLW .OR. IREQ.GT.UNITHG) ) THEN WRITE (NDS,1001) IREQ, UNITLW, UNITHG CALL EXTCDE ( 1001 ) END IF ! ! -------------------------------------------------------------------- / ! 2. Single unit request ! IF ( IREQ .GT. 0 ) THEN WRITE (NDS,920) IREQ, U_USED(IREQ), U_TYPE(IREQ), & U_NAME(IREQ), U_DESC(IREQ) ! ! -------------------------------------------------------------------- / ! 3. Multiple unit request ! ELSE ! IF ( IREQ .LT. 0 ) THEN WRITE (NDS,930) ELSE WRITE (NDS,931) END IF ! DO I=UNITLW, UNITHG IF ( IREQ.LT.0 .OR. U_USED(I) ) & WRITE (NDS,932) I, U_USED(I), U_TYPE(I), & U_NAME(I), U_DESC(I) END DO WRITE (NDS,*) ! END IF ! RETURN ! ! Formats ! 920 FORMAT (/' WMUDMP: Unit number : ',I6/ & ' Assigned : ',L6/ & ' Type : ',A/ & ' Name : ',A/ & ' Description : ',A/) ! 930 FORMAT (/' WMUDMP: Unit information '// & ' Nr Flg Type Name Description '/ & ' -------------------------------------------------', & '---------------------') 931 FORMAT (/' WMUDMP: Unit information (assigned only)'// & ' Nr Flg Type Name Description '/ & ' -------------------------------------------------', & '---------------------') 932 FORMAT ( 2X,I4,L4,2X,A3,2X,A20,2X,A) ! 1000 FORMAT (/' *** ERROR WMUDMP: DATA STRUCTURE READY ***'/ & /' RUN WMUINI FIRST '/) 1001 FORMAT (/' *** ERROR WMUDMP: UNIT NUMBER OUT OF RANGE ***' & /' REQ/RANG :',3I6/) !/ !/ End of WMUDMP ----------------------------------------------------- / !/ END SUBROUTINE WMUDMP !/ ------------------------------------------------------------------- / !> !> @brief Directly set information for a unit number in the data structure. !> !> @param[in] NDSE Unit number for error output. !> @param[in] NDST Unit number for test output. !> @param[in] NDS Unit number to be assigned. !> @param[in] FLAG Flag for assigning unit. !> @param[in] TYPE Type identifier to be used. !> @param[in] NAME Name of file. !> @param[in] DESC Description of file. !> !> @author H. L. Tolman @date 25-Mar-2005 !> SUBROUTINE WMUSET ( NDSE, NDST, NDS, FLAG, TYPE, NAME, DESC ) !/ !/ +-----------------------------------+ !/ | WAVEWATCH III NOAA/NCEP | !/ | H. L. Tolman | !/ | FORTRAN 90 | !/ | Last update : 25-Mar-2005 ! !/ +-----------------------------------+ !/ !/ 25-Mar-2005 : Origination. ( version 3.07 ) !/ ! 1. Purpose : ! ! Directly set information for a unit number in the data structure. ! ! 2. Method : ! ! 3. Parameters : ! ! Parameter list ! ---------------------------------------------------------------- ! NDSE Int. I Unit number for error output. ! NDST Int. I Unit number for test output. ! NDS Int. I Unit number to be assigned. ! FLAG Log. I Flag for assigning unit. ! TYPE C*3 I Type identifier to be used. ! NAME C* I Name of file. ! DESC C* I Description of file. ! ---------------------------------------------------------------- ! ! 4. Subroutines used : ! ! Name Type Module Description ! ---------------------------------------------------------------- ! STRACE Sur. W3SERVMD Subroutine tracing. ! EXCTDE Sur. Id. Program abort. ! ---------------------------------------------------------------- ! ! 5. Called by : ! ! 6. Error messages : ! ! 7. Remarks : ! ! 8. Structure : ! ! 9. Switches : ! ! !/S Enable subroutine tracing. ! !/T Enable test output ! ! 10. Source code : ! !/ ------------------------------------------------------------------- / USE W3SERVMD, ONLY: EXTCDE #ifdef W3_S USE W3SERVMD, ONLY: STRACE #endif ! IMPLICIT NONE !/ !/ ------------------------------------------------------------------- / !/ Parameter list !/ INTEGER, INTENT(IN) :: NDSE, NDST, NDS LOGICAL, INTENT(IN) :: FLAG CHARACTER(LEN=3), INTENT(IN), OPTIONAL :: & TYPE CHARACTER*(*), INTENT(IN), OPTIONAL :: & NAME, DESC !/ !/ ------------------------------------------------------------------- / !/ Local parameters !/ #ifdef W3_S INTEGER, SAVE :: IENT = 0 #endif !/ #ifdef W3_S CALL STRACE (IENT, 'WMUSET') #endif ! ! -------------------------------------------------------------------- / ! 1. Test input ! IF ( .NOT. FLINIT ) THEN WRITE (NDSE,1000) CALL EXTCDE ( 1000 ) END IF ! IF ( NDS.LT.UNITLW .OR. NDS.GT.UNITHG ) THEN WRITE (NDSE,1001) NDS, UNITLW, UNITHG CALL EXTCDE ( 1001 ) END IF ! #ifdef W3_T WRITE (NDST,9000) NDS, U_USED(NDS), U_TYPE(NDS), & U_NAME(NDS), U_DESC(NDS) #endif ! ! -------------------------------------------------------------------- / ! 2. Set data ! 2.a Flag ! U_USED(NDS) = FLAG ! ! 2.b Type ! IF ( PRESENT(TYPE) ) U_TYPE(NDS) = TYPE ! ! 2.c Name ! IF ( PRESENT(NAME) ) THEN U_NAME(NDS) = NAME ELSE IF ( .NOT. FLAG ) THEN U_NAME(NDS) = 'unknown' END IF ! ! 2.d Description ! IF ( PRESENT(DESC) ) THEN U_DESC(NDS) = DESC ELSE IF ( .NOT. FLAG ) THEN U_DESC(NDS) = 'unknown' END IF ! #ifdef W3_T WRITE (NDST,9001) NDS, U_USED(NDS), U_TYPE(NDS), & U_NAME(NDS), U_DESC(NDS) #endif ! RETURN ! ! Formats ! 1000 FORMAT (/' *** ERROR WMUSET: INITIALIZE FIRST !!! ***') 1001 FORMAT (/' *** ERROR WMUSET: UNIT NUMBER OUT OF RANGE ***' & /' REQ/RANG :',3I6/) ! #ifdef W3_T 9000 FORMAT ( ' TEST WMUSET: UNIT ',I4', ON SUBROUTINE ENTRY :'/ & ' FLAG : ',L4/ & ' TYPE : ',A/ & ' NAME : ',A/ & ' DESC : ' A) 9001 FORMAT ( ' TEST WMUSET: UNIT ',I4', ON SUBROUTINE EXIT :'/ & ' FLAG : ',L4/ & ' TYPE : ',A/ & ' NAME : ',A/ & ' DESC : ' A) #endif !/ !/ End of WMUSET ----------------------------------------------------- / !/ END SUBROUTINE WMUSET !/ ------------------------------------------------------------------- / !> !> @brief Find a free unit number for a given file type. !> !> @details Search the data base. !> !> @param[in] NDSE Unit number for error output. !> @param[in] NDST Unit number for test output. !> @param[out] NDS Unit number to be assigned. !> @param[in] TYPE Type identifier to be used. !> @param[in] NR Number of consecutive units needed for output !> bounday data files. !> !> @author H. L. Tolman @date 20-Jan-2017 !> SUBROUTINE WMUGET ( NDSE, NDST, NDS, TYPE, NR ) !/ !/ +-----------------------------------+ !/ | WAVEWATCH III NOAA/NCEP | !/ | H. L. Tolman | !/ | FORTRAN 90 | !/ | Last update : 20-Jan-2017 ! !/ +-----------------------------------+ !/ !/ 28-Mar-2005 : Origination. ( version 3.07 ) !/ 20-Jan-2017 : Add INQUIRE OPENED check. ( version 6.02 ) !/ (T. J. Campbell, NRL) !/ ! 1. Purpose : ! ! Find a free unit number for a given file type. ! ! 2. Method : ! ! Search the data base. ! ! 3. Parameters : ! ! Parameter list ! ---------------------------------------------------------------- ! NDSE Int. I Unit number for error output. ! NDST Int. I Unit number for test output. ! NDS Int. O Unit number to be assigned. ! TYPE C*3 I Type identifier to be used. ! NR Int. I Number of consecutive units needed. ! Needed for output bounday data files. ! ---------------------------------------------------------------- ! ! 4. Subroutines used : ! ! Name Type Module Description ! ---------------------------------------------------------------- ! STRACE Sur. W3SERVMD Subroutine tracing. ! EXCTDE Sur. Id. Program abort. ! ---------------------------------------------------------------- ! ! 5. Called by : ! ! 6. Error messages : ! ! 7. Remarks : ! ! 8. Structure : ! ! 9. Switches : ! ! !/S Enable subroutine tracing. ! !/T Enable test output ! ! 10. Source code : ! !/ ------------------------------------------------------------------- / USE W3SERVMD, ONLY: EXTCDE #ifdef W3_S USE W3SERVMD, ONLY: STRACE #endif ! IMPLICIT NONE !/ !/ ------------------------------------------------------------------- / !/ Parameter list !/ INTEGER, INTENT(IN) :: NDSE, NDST INTEGER, INTENT(OUT) :: NDS CHARACTER(LEN=3), INTENT(IN) :: TYPE INTEGER, INTENT(IN), OPTIONAL :: NR !/ !/ ------------------------------------------------------------------- / !/ Local parameters !/ INTEGER :: NRC, I, J #ifdef W3_S INTEGER, SAVE :: IENT = 0 #endif LOGICAL :: OK LOGICAL :: OPND !/ #ifdef W3_S CALL STRACE (IENT, 'WMUGET') #endif ! ! -------------------------------------------------------------------- / ! 1. Test input / output ! IF ( .NOT. FLINIT ) THEN WRITE (NDSE,1010) CALL EXTCDE ( 1010 ) END IF ! IF ( PRESENT(NR) ) THEN NRC = MAX ( 1 , NR ) ELSE NRC = 1 END IF ! #ifdef W3_T WRITE (NDST,9010) TYPE, NRC #endif ! ! -------------------------------------------------------------------- / ! 2. Find first free unit number and reset flag ! NDS = -1 ! DO I=UNITLW, UNITHG - NRC + 1 ! new: We do not allow I=NDST (unit number for test output). ! NDST (aka MDST or IDST) is set to 10 in call to WMINIT ! (4th argument) OK = .NOT.U_USED(I) .AND. U_TYPE(I).EQ.TYPE & .AND. I.NE.NDST INQUIRE ( I, OPENED=OPND ) OK = OK .AND. .NOT.OPND IF ( OK ) THEN DO J=1, NRC-1 OK = OK .AND. (.NOT.U_USED(I+J) .AND. & U_TYPE(I+J).EQ.TYPE ) INQUIRE ( I+J, OPENED=OPND ) OK = OK .AND. .NOT.OPND END DO END IF IF ( OK ) THEN NDS = I DO J=0, NRC-1 U_USED(I+J) = .TRUE. END DO EXIT END IF END DO ! IF ( NDS .EQ. -1 ) THEN WRITE (NDSE,1020) TYPE CALL EXTCDE ( 1020 ) END IF ! #ifdef W3_T WRITE (NDST,9020) NDS #endif ! RETURN ! ! Formats ! 1010 FORMAT (/' *** ERROR WMUGET: INITIALIZE FIRST !!! ***') 1020 FORMAT (/' *** ERROR WMUGET: CANNOT FIND FREE UNIT FOR TYPE ', & A,' ***'/) ! #ifdef W3_T 9010 FORMAT ( ' TEST WMUGET: LOOKING FOR UNIT FOR TYPE ',A,' [', & I2,']') 9020 FORMAT ( ' TEST WMUGET: UNIT NUMBER SET TO',I4) #endif !/ !/ End of WMUGET ----------------------------------------------------- / !/ END SUBROUTINE WMUGET !/ ------------------------------------------------------------------- / !> !> @brief Update data base information for a given unit number. !> !> @details FORTRAN INQUIRE statement. !> !> @param[in] NDSE Unit number for error output. !> @param[in] NDST Unit number for test output. !> @param[in] NDS Unit number to be assigned. !> !> @author H. L. Tolman @date 29-Mar-2005 !> SUBROUTINE WMUINQ ( NDSE, NDST, NDS ) !/ !/ +-----------------------------------+ !/ | WAVEWATCH III NOAA/NCEP | !/ | H. L. Tolman | !/ | FORTRAN 90 | !/ | Last update : 29-Mar-2005 ! !/ +-----------------------------------+ !/ !/ 29-Mar-2005 : Origination. ( version 3.07 ) !/ ! 1. Purpose : ! ! Update data base information for a given unit number. ! ! 2. Method : ! ! FORTRAN INQUIRE statement. ! ! 3. Parameters : ! ! Parameter list ! ---------------------------------------------------------------- ! NDSE Int. I Unit number for error output. ! NDST Int. I Unit number for test output. ! NDS Int. I Unit number to be assigned. ! ---------------------------------------------------------------- ! ! 4. Subroutines used : ! ! Name Type Module Description ! ---------------------------------------------------------------- ! STRACE Sur. W3SERVMD Subroutine tracing. ! EXCTDE Sur. Id. Program abort. ! ---------------------------------------------------------------- ! ! 5. Called by : ! ! 6. Error messages : ! ! 7. Remarks : ! ! 8. Structure : ! ! 9. Switches : ! ! !/S Enable subroutine tracing. ! !/T Enable test output ! ! 10. Source code : ! !/ ------------------------------------------------------------------- / USE W3SERVMD, ONLY: EXTCDE #ifdef W3_S USE W3SERVMD, ONLY: STRACE #endif ! IMPLICIT NONE !/ !/ ------------------------------------------------------------------- / !/ Parameter list !/ INTEGER, INTENT(IN) :: NDSE, NDST, NDS !/ !/ ------------------------------------------------------------------- / !/ Local parameters !/ #ifdef W3_S INTEGER, SAVE :: IENT = 0 #endif LOGICAL :: CHECK !/ #ifdef W3_S CALL STRACE (IENT, 'WMUINQ') #endif ! ! -------------------------------------------------------------------- / ! 1. Test input / output ! IF ( .NOT. FLINIT ) THEN WRITE (NDSE,1010) CALL EXTCDE ( 1010 ) END IF ! IF ( NDS.LT.UNITLW .OR. NDS.GT.UNITHG ) THEN WRITE (NDSE,1011) NDS, UNITLW, UNITHG CALL EXTCDE ( 1011 ) END IF ! #ifdef W3_T WRITE (NDST,9010) NDS #endif ! ! -------------------------------------------------------------------- / ! 2. Check out file ! 2.a Check if opened : ! INQUIRE (NDS,OPENED=CHECK) ! #ifdef W3_T WRITE (NDST,9020) CHECK #endif ! ! 2.b File not opened, release to pool ! IF ( .NOT. CHECK ) THEN CALL WMUSET ( NDSE, NDST, NDS, .FALSE. ) ELSE ! ! 2.c File is opened, get the name ! INQUIRE (NDS,NAME=U_NAME(NDS)) ! #ifdef W3_T WRITE (NDST,9021) U_NAME(NDS) #endif ! END IF ! RETURN ! ! Escape locations read errors --------------------------------------- * ! ! ! Formats ! 1010 FORMAT (/' *** ERROR WMUINQ: INITIALIZE FIRST !!! ***') 1011 FORMAT (/' *** ERROR WMUINQ: UNIT NUMBER OUT OF RANGE ***' & /' REQ/RANG :',3I6/) ! #ifdef W3_T 9010 FORMAT ( ' TEST WMUINQ: TESTING UNIT NUMBER',I4) 9020 FORMAT ( ' INQUIRE ON OPENED : ',L2) 9021 FORMAT ( ' NAME OF FILE : ',A) #endif !/ !/ End of WMUINQ ----------------------------------------------------- / !/ END SUBROUTINE WMUINQ !/ !/ End of module WMUNITMD -------------------------------------------- / !/ END MODULE WMUNITMD