Line data    Source code

       1             : #ifdef ESMF_
       2             : ! We only need to refer to this include file if we are connecting
       3             : ! to the GEOS-5 GCM via the ESMF/MAPL framework (bmy, 8/3/12)
       4             : #include "MAPL_Generic.h"
       5             : #endif
       6             : !------------------------------------------------------------------------
       7             : !     NASA/GSFC, Global Modeling and Assimilation Office, Code 910.1    !
       8             : !------------------------------------------------------------------------
       9             : !BOP
      10             : !
      11             : ! !MODULE: HCO_inquireMod
      12             : !
      13             : ! !DESCRIPTION: Module inquireMod contains functions to find free and
      14             : !  unopened logical file units (LUNs) for Fortran I/O.
      15             : !
      16             : ! !INTERFACE:
      17             : !
      18             : MODULE HCO_inquireMod
      19             : !
      20             : ! !USES:
      21             : !
      22             : #ifdef ESMF_
      23             :   ! We only need to refer to these modules if we are connecting
      24             :   ! to the GEOS-5 GCM via the ESMF/MAPL framework (bmy, 8/3/12)
      25             :   USE ESMF
      26             :   USE MAPLBase_Mod
      27             : #endif
      28             : 
      29             :   IMPLICIT NONE
      30             :   PRIVATE
      31             : !
      32             : ! !PUBLIC MEMBER FUNCTIONS:
      33             : !
      34             :   PUBLIC  :: findFreeLUN
      35             : !
      36             : ! !REVI<SION HISTORY:
      37             : !  14 Jun 2012 - E. Nielsen  - Initial version
      38             : !  See https://github.com/geoschem/hemco for complete history
      39             : !EOP
      40             : !------------------------------------------------------------------------------
      41             : !BOC
      42             :   CONTAINS
      43             : !EOC
      44             : !------------------------------------------------------------------------
      45             : !     NASA/GSFC, Global Modeling and Assimilation Office, Code 910.1    !
      46             : !------------------------------------------------------------------------
      47             : !BOP
      48             : !
      49             : ! !IROUTINE: findFreeLUN
      50             : !
      51             : ! !DESCRIPTION: Inquire for an existing, but unopened, logical unit number
      52             : !\\
      53             : !\\
      54             : ! !INTERFACE:
      55             : !
      56           0 :   FUNCTION findFreeLUN( b ) RESULT( lun )
      57             : !
      58             : ! !USES:
      59             : !
      60             :     IMPLICIT NONE
      61             : !
      62             : ! !INPUT PARAMETERS:
      63             : !
      64             :     INTEGER, INTENT(IN), OPTIONAL :: b   ! Not really used here
      65             : !
      66             : ! !RETURN VALUE:
      67             : !
      68             :     INTEGER :: lun
      69             : !
      70             : ! !REVISION HISTORY:
      71             : !  14 Jun 2012 - E. Nielsen  - Initial version
      72             : !  See https://github.com/geoschem/hemco for complete history
      73             : !EOP
      74             : !------------------------------------------------------------------------------
      75             : !BOC
      76             : !
      77             : ! !LOCAL VARIABLES:
      78             : !
      79             :     INTEGER                    :: i, rc, status
      80             :     LOGICAL                    :: exists        ! File existence
      81             :     LOGICAL                    :: found         ! Detect unused logical unit
      82             :     LOGICAL                    :: open          ! Is open?
      83             : 
      84             : #ifdef ESMF_
      85             :     CHARACTER(LEN=ESMF_MAXSTR) :: Iam
      86             : #else
      87             :     CHARACTER(LEN=255)         :: Iam
      88             : #endif
      89             : !
      90             : ! !DEFINED PARAMETERS
      91             : !
      92             :     INTEGER, PARAMETER         :: iTop = 199     ! Maximum LUN limit
      93             : 
      94             :     !======================================================================
      95             :     ! Initialization
      96             :     !======================================================================
      97           0 :     Iam = "GEOSCHEMCHEM::findFreeLUN"
      98           0 :     status = 0
      99           0 :     rc     = 0
     100             : 
     101             :     !======================================================================
     102             :     ! Find an available logical unit
     103             :     !======================================================================
     104           0 :     found = .FALSE.
     105           0 :     i     = 11
     106             : 
     107           0 :     DO WHILE ( .NOT. found .AND. i <= iTop )
     108           0 :        INQUIRE( UNIT=i, EXIST=exists, OPENED=open )
     109           0 :        IF ( exists .AND. .NOT. open ) THEN
     110           0 :           found = .TRUE.
     111           0 :           lun = i
     112             :        ENDIF
     113           0 :        i = i + 1
     114             :     ENDDO
     115             : 
     116           0 :     IF ( .NOT. found ) THEN
     117           0 :        status = 1
     118           0 :        PRINT *,TRIM( Iam ) // ": No available logical units"
     119             :     ENDIF
     120             : 
     121             : #ifdef ESMF_
     122             :     VERIFY_(status)
     123             : #endif
     124             : 
     125           0 :   END FUNCTION findFreeLUN
     126             : !EOC
     127             : END MODULE HCO_inquireMod