pkg/exch2/w2_set_single_facet.F

017b6b2289 Jean*0001 #include "CPP_EEOPTIONS.h"
                0002 #include "W2_OPTIONS.h"
                0003
                0004 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0005 CBOP 0
                0006 C !ROUTINE: W2_SET_SINGLE_FACET
                0007
                0008 C !INTERFACE:
                0009       SUBROUTINE W2_SET_SINGLE_FACET( myThid )
                0010
                0011 C     !DESCRIPTION:
                0012 C     Set-up simple single facet (domain in 1 piece) topology
                0013
                0014 C     !USES:
                0015       IMPLICIT NONE
                0016
e626d69252 Jean*0017 C      Tile topology settings data structures
017b6b2289 Jean*0018 #include "SIZE.h"
                0019 #include "EEPARAMS.h"
                0020 #include "W2_EXCH2_SIZE.h"
                0021 #include "W2_EXCH2_PARAMS.h"
                0022 #include "W2_EXCH2_TOPOLOGY.h"
                0023
                0024 C     !INPUT PARAMETERS:
                0025 C     myThid  :: my Thread Id number
                0026 C               (Note: not relevant since threading has not yet started)
                0027       INTEGER myThid
                0028
                0029 C     !LOCAL VARIABLES:
                0030 C     === Local variables ===
d6ea3164dc Jean*0031 C     msgBuf     :: Informational/error message buffer
e626d69252 Jean*0032       CHARACTER*(MAX_LEN_MBUF) msgBuf
                0033       INTEGER j
017b6b2289 Jean*0034 CEOP
                0035
e626d69252 Jean*0036       WRITE(msgBuf,'(2A,I3,A)') 'W2_SET_SINGLE_FACET:',
                0037      &              ' preDefTopol=', preDefTopol, ' selected'
                0038       CALL PRINT_MESSAGE( msgBuf, W2_oUnit,SQUEEZE_RIGHT,myThid )
                0039
                0040 C--   Number of facets:
017b6b2289 Jean*0041       nFacets = 1
                0042
e626d69252 Jean*0043 C--   Set Facet Edge connections (topology graph) ignoring any previous
                0044 C     setting from data.exch2 (Edges order: N,S,E,W <==> 1,2,3,4 )
                0045 C     face 1 N(=1) edge connects to face 1 S(=2) edge:
                0046       facet_link(1,1) = 1.2
                0047 C     face 1 S(=2) edge connects to face 1 N(=1) edge:
                0048       facet_link(2,1) = 1.1
                0049 C     face 1 E(=3) edge connects to face 1 W(=4) edge:
                0050       facet_link(3,1) = 1.4
                0051 C     face 1 W(=4) edge connects to face 1 E(=3) edge:
                0052       facet_link(4,1) = 1.3
                0053
                0054 C--   Facet dimension: take the 1rst 2 numbers from facet_dims (if correct)
                0055       IF ( facet_dims(1).EQ.0 .AND. facet_dims(2).EQ.0 ) THEN
                0056 C-    Default: take global dimension from SIZE.h (will fail with blank tiles)
                0057         facet_dims(1) = Nx
                0058         facet_dims(2) = Ny
                0059       ENDIF
                0060       IF ( facet_dims(1).LE.0 .OR. facet_dims(2).LE.0 ) THEN
                0061          WRITE(msgBuf,'(2A,2I5)') 'W2_SET_SINGLE_FACET:',
                0062      &     ' unvalid 1rst 2 dimensions:', facet_dims(1), facet_dims(2)
                0063          CALL PRINT_MESSAGE( msgBuf, W2_oUnit,SQUEEZE_RIGHT,myThid )
                0064          CALL PRINT_ERROR( msgBuf, myThid )
d39305b879 Jean*0065          CALL ALL_PROC_DIE( 0 )
e626d69252 Jean*0066          STOP 'ABNORMAL END: S/R W2_SET_SINGLE_FACET: unvalid dims'
                0067       ENDIF
                0068       DO j=3,W2_maxNbFacets*2
                0069        IF ( facet_dims(j).NE.0 ) THEN
                0070          WRITE(msgBuf,'(2A,I5)') 'W2_SET_SINGLE_FACET:',
                0071      &     ' no more than 2 dims (X,Y) expected for single facet'
                0072          CALL PRINT_MESSAGE( msgBuf, W2_oUnit,SQUEEZE_RIGHT,myThid )
                0073          CALL PRINT_ERROR( msgBuf, myThid )
d39305b879 Jean*0074          CALL ALL_PROC_DIE( 0 )
e626d69252 Jean*0075          STOP 'ABNORMAL END: S/R W2_SET_SINGLE_FACET: unexpected dims'
                0076        ENDIF
                0077       ENDDO
017b6b2289 Jean*0078
                0079       RETURN
                0080       END