C $Header: /u/gcmpack/MITgcm/pkg/exch2/w2_readparms.F,v 1.6 2017/08/09 15:23:38 mlosch Exp $
C $Name:  $

#include "CPP_EEOPTIONS.h"
#include "W2_OPTIONS.h"

C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
CBOP 0
C !ROUTINE: W2_READPARMS

C !INTERFACE:
      SUBROUTINE W2_READPARMS( myThid )

C     !DESCRIPTION:
C     Initialize W2_EXCH2 variables and constants.

C     !USES:
      IMPLICIT NONE
#include "SIZE.h"
#include "EEPARAMS.h"
#include "W2_EXCH2_SIZE.h"
#include "W2_EXCH2_TOPOLOGY.h"
#include "W2_EXCH2_PARAMS.h"

C     !INPUT PARAMETERS:
C     myThid  :: my Thread Id number
C               (Note: not relevant since threading has not yet started)
      INTEGER myThid
CEOP

C     !LOCAL VARIABLES:
C     === Local variables ===
C     msgBuf     :: Informational/error message buffer
C     iUnit      :: Work variable for IO unit number
      CHARACTER*(MAX_LEN_MBUF) msgBuf
      LOGICAL fileExist, errFlag
      INTEGER i, j, iUnit, stdUnit, errCnt
C--   Note: To avoid error in reading the namelist,
C     use larger local array to read-in lists dimsFacets & facetEdgeLink,
C     store only W2_maxNbFacets values, and stop if more values are found.
      INTEGER namList_NbFacets
      PARAMETER ( namList_NbFacets = W2_maxNbFacets*2 )
      INTEGER dimsFacets( 2*namList_NbFacets )
      Real*4  facetEdgeLink( 4, namList_NbFacets )

C--   topology defined from processing "data.exch2" (selectTopol=0):
C     dimsFacets    :: facet pair of dimensions (n1x,n1y,n2x,n2y ...)
C     facetEdgeLink :: Face-Edge connectivity map:
C       facetEdgeLink(i,j)=XX.1 : face(j)-edge(i) (i=1,2,3,4 <==> N,S,E,W)
C       is connected to Northern edge of face "XX" ; similarly,
C       = XX.2 : to Southern.E, XX.3 = Eastern.E, XX.4 = Western.E of face "XX".
C--
C     edges order: N,S,E,W <==> 1,2,3,4

      NAMELIST //W2_EXCH2_PARM01
     &       preDefTopol,
     &       dimsFacets, facetEdgeLink,
     &       blankList,
     &       W2_mapIO,
     &       W2_printMsg,
     &       W2_useE2ioLayOut

      stdUnit  = standardMessageUnit

C--   Default values for W2_EXCH2
      W2_printMsg = -1
      W2_mapIO = -1
      W2_useE2ioLayOut = .TRUE.
      IF ( useCubedSphereExchange ) THEN
        preDefTopol = 3
      ELSE
        preDefTopol = 1
      ENDIF
      DO i=1,W2_maxNbTiles
        blankList(i) = 0
      ENDDO

C--   Initialise other params in namelist
      DO j=1,W2_maxNbFacets*2
        dimsFacets(2*j-1) = 0
        dimsFacets( 2*j ) = 0
        DO i=1,4
          facetEdgeLink(i,j) = 0.
        ENDDO
      ENDDO

C-    Initialise other parameters:
      nFacets = 0
      nBlankTiles = 0
      DO j=1,W2_maxNbFacets
        facet_dims(2*j-1) = 0
        facet_dims( 2*j ) = 0
        DO i=1,4
          facet_link(i,j) = 0.
        ENDDO
      ENDDO

C     Set filling value for face-corner halo regions
      e2FillValue_RL = 0. _d 0
      e2FillValue_RS = 0. _d 0
      e2FillValue_R4 = 0.e0
      e2FillValue_R8 = 0.d0
C-    for testing only: put a large value (should not affects the results)
c     e2FillValue_RL = 1. _d+20
c     e2FillValue_RS = 1. _d+20
c     e2FillValue_R4 = 1.e+20
c     e2FillValue_R8 = 1.d+20

C-    Check for file "data.ech2":
      fileExist = .FALSE.
      INQUIRE( FILE='data.exch2', EXIST=fileExist )

      IF ( fileExist ) THEN
        WRITE(msgBuf,'(A)') 'W2_READPARMS: opening data.exch2'
        CALL PRINT_MESSAGE( msgBuf, stdUnit, SQUEEZE_RIGHT , myThid )
        CALL OPEN_COPY_DATA_FILE(
     I                      'data.exch2', 'W2_READPARMS',
     O                      iUnit,
     I                      myThid )

C     Read parameters from open data file
        READ(UNIT=iUnit,NML=W2_EXCH2_PARM01)
        WRITE(msgBuf,'(A)')
     &    'W2_READPARMS: finished reading data.exch2'
        CALL PRINT_MESSAGE( msgBuf, stdUnit, SQUEEZE_RIGHT , myThid )
C     Close the open data file
#ifdef SINGLE_DISK_IO
        CLOSE(iUnit)
#else
        CLOSE(iUnit,STATUS='DELETE')
#endif /* SINGLE_DISK_IO */
      ELSE
        WRITE(msgBuf,'(A)') 'W2_READPARMS: file data.exch2 not found'
        CALL PRINT_MESSAGE( msgBuf, stdUnit, SQUEEZE_RIGHT , myThid )
        IF ( preDefTopol.EQ.1 ) THEN
          WRITE(msgBuf,'(2A,I3)') '=> use W2_EXCH2 default:',
     &      ' Single sub-domain (nFacets=1)'
        ELSEIF ( preDefTopol .EQ. 3 ) THEN
          WRITE(msgBuf,'(2A,I3)') '=> use W2_EXCH2 default:',
     &      ' regular 6-facets Cube'
        ELSE
          WRITE(msgBuf,'(2A,I3)') '=> use W2_EXCH2 default:',
     &      ' preDefTopol=', preDefTopol
        ENDIF
        CALL PRINT_MESSAGE( msgBuf, stdUnit, SQUEEZE_RIGHT , myThid )
      ENDIF

C--   copy local arrays dimsFacets & facetEdgeLink to var in common block
      DO j=1,2*W2_maxNbFacets
c       write(0,*) j, dimsFacets(j)
        facet_dims(j) = dimsFacets(j)
      ENDDO
      DO j=1,W2_maxNbFacets
       DO i=1,4
        facet_link(i,j) = facetEdgeLink(i,j)
       ENDDO
      ENDDO

C--   Check if too many values are specified in data.exch2:
      errCnt = 0
      DO j=W2_maxNbFacets+1,namList_NbFacets
       errFlag = .FALSE.
       DO i=1,4
        IF ( facetEdgeLink(i,j).NE.0. ) errFlag = .TRUE.
       ENDDO
       IF ( errFlag ) errCnt = errCnt + 1
      ENDDO
      IF ( errCnt.GT.0 ) THEN
        WRITE(msgBuf,'(2A)') ' W2_READPARMS:',
     &    ' Number of "facetEdgeLink" list in "data.exch2"'
        CALL PRINT_ERROR( msgBuf, myThid )
        WRITE(msgBuf,'(A,2(A,I3))') ' W2_READPARMS:',
     &    ' exceeds maxNbFacets(=',W2_maxNbFacets,') by', errCnt
        CALL PRINT_ERROR( msgBuf, myThid )
        errFlag = .TRUE.
      ELSE
        errFlag = .FALSE.
      ENDIF

      errCnt = 0
      DO j=2*W2_maxNbFacets+1,2*namList_NbFacets
        IF ( dimsFacets(j).NE.0 ) errCnt = errCnt + 1
      ENDDO
      IF ( errCnt.GT.0 ) THEN
        WRITE(msgBuf,'(2A)') ' W2_READPARMS:',
     &    ' Number of "dimsFacets" in "data.exch2"'
        CALL PRINT_ERROR( msgBuf, myThid )
        WRITE(msgBuf,'(A,2(A,I3))') ' W2_READPARMS:',
     &    ' exceeds 2*maxNbFacets(=',W2_maxNbFacets*2,') by', errCnt
        CALL PRINT_ERROR( msgBuf, myThid )
      ENDIF
      IF ( errFlag .OR. errCnt.GT.0 ) THEN
        STOP 'ABNORMAL END: S/R W2_READPARMS'
      ENDIF

C--   Print some Exch2 parameters:
      WRITE(msgBuf,'(A,L5,A)') 'W2_useE2ioLayOut=', W2_useE2ioLayOut,
     &  ' ;/* T: use Exch2 glob IO map; F: use model default */'
      CALL PRINT_MESSAGE( msgBuf, stdUnit, SQUEEZE_RIGHT , myThid )
      WRITE(msgBuf,'(A,I4,A)') 'W2_mapIO        =', W2_mapIO,
     & ' ; /* select option for Exch2 global-IO map */'
      CALL PRINT_MESSAGE( msgBuf, stdUnit, SQUEEZE_RIGHT , myThid )
      WRITE(msgBuf,'(A,I4,A)') 'W2_printMsg     =', W2_printMsg,
     & ' ; /* select option for printing information */'
      CALL PRINT_MESSAGE( msgBuf, stdUnit, SQUEEZE_RIGHT , myThid )

      RETURN
      END