pkg/atm_compon_interf/cpl_register.F

3fd4b811ee Jean*0001 #include "ATM_CPL_OPTIONS.h"
a9cdd26a43 Jean*0002
30541227a6 Jean*0003 CBOP 0
                0004 C !ROUTINE: CPL_REGISTER
                0005
                0006 C !INTERFACE:
a9cdd26a43 Jean*0007       SUBROUTINE CPL_REGISTER
30541227a6 Jean*0008
                0009 C !DESCRIPTION:
a9cdd26a43 Jean*0010 C     *==========================================================*
30541227a6 Jean*0011 C     | SUBROUTINE CPL_REGISTER
                0012 C     | o Routine controlling registration with MIT coupler.
                0013 C     | - Atmospheric version -
a9cdd26a43 Jean*0014 C     *==========================================================*
30541227a6 Jean*0015 C     | This version talks to the MIT Coupler. It uses the MIT
                0016 C     | Coupler "checkpoint1" library calls.
a9cdd26a43 Jean*0017 C     *==========================================================*
                0018
30541227a6 Jean*0019 C !USES:
                0020       IMPLICIT NONE
a9cdd26a43 Jean*0021 C     == Global variables ==
                0022 #include "SIZE.h"
                0023 #include "EEPARAMS.h"
43b2661424 Jean*0024 #ifdef ALLOW_EXCH2
                0025 # include "W2_EXCH2_SIZE.h"
                0026 # include "W2_EXCH2_TOPOLOGY.h"
                0027 # include "W2_EXCH2_PARAMS.h"
                0028 #endif /* ALLOW_EXCH2 */
a9cdd26a43 Jean*0029
30541227a6 Jean*0030 C !INPUT/OUTPUT PARAMETERS:
a9cdd26a43 Jean*0031 C     == Routine arguments ==
30541227a6 Jean*0032 C     myThid    :: Thread number for this instance of the routine
                0033 c     INTEGER myThid
                0034 CEOP
a9cdd26a43 Jean*0035
                0036 #ifdef COMPONENT_MODULE
30541227a6 Jean*0037 C !LOCAL VARIABLES:
                0038 C     == Local variables ==
                0039 C     bi, bj    :: Tile indices
                0040 C     j         :: Loop counter
                0041 C     iG0, jG0  :: Base coordinates of a tile on the global grid.
43b2661424 Jean*0042 C     iReg      :: Array for passing attributes to the coupler
6269465120 Jean*0043 C     x,ySize   :: expected size of the coupler 2-D maps
30541227a6 Jean*0044       INTEGER iG0, jG0
                0045       INTEGER bi, bj
43b2661424 Jean*0046       INTEGER j, nTiles
                0047       INTEGER iReg(6,nSx*nSy)
6269465120 Jean*0048 c     INTEGER xSize, ySize
43b2661424 Jean*0049 #ifdef ALLOW_EXCH2
                0050       INTEGER tN
6269465120 Jean*0051       LOGICAL useExch2LayOut
                0052 #endif /* ALLOW_EXCH2 */
                0053
                0054 C--   Set dimensions of coupler 2-D maps:
                0055 c     xSize = Nx
                0056 c     ySize = Ny
                0057
                0058 #ifdef ALLOW_EXCH2
                0059 C-- Note: current coupler mapping relies only on i0,j0,nx,ny ; this prevent to
                0060 C     map tiles to Exch-2 global map when faces do not fit in global-IO-array
                0061 C     (see, e.g., gather/scatter_2d routines in eesupp/src, case where
                0062 C      iGjLoc <> 0 or jGjLoc <> 1 ).
                0063       useExch2LayOut = .FALSE.
                0064       IF ( W2_useE2ioLayOut ) THEN
                0065         useExch2LayOut = .TRUE.
                0066         DO tN=1,exch2_nTiles
                0067           IF   ( exch2_mydNx(tN) .GT. exch2_global_Nx ) THEN
                0068            useExch2LayOut = .FALSE.
                0069 C-         face x-size larger than glob-size : fold it
                0070 c              iGjLoc = 0
                0071 c              jGjLoc = exch2_mydNx(tN) / xSize
                0072           ELSEIF ( exch2_tNy(tN) .GT. exch2_global_Ny ) THEN
                0073            useExch2LayOut = .FALSE.
                0074 C-         tile y-size larger than glob-size : make a long line
                0075 c              iGjLoc = exch2_mydNx(tN)
                0076 c              jGjLoc = 0
                0077           ELSE
                0078 C-          default (face fit into global-IO-array)
                0079 c             iGjLoc = 0
                0080 c             jGjLoc = 1
                0081           ENDIF
                0082         ENDDO
                0083       ENDIF
                0084 c     IF ( useExch2LayOut ) THEN
                0085 c       xSize = exch2_global_Nx
                0086 c       ySize = exch2_global_Ny
                0087 c     ENDIF
                0088 C-- Note: should check that xSize,ySize match with coupler Nx_atm,Ny_atm
43b2661424 Jean*0089 #endif /* ALLOW_EXCH2 */
a9cdd26a43 Jean*0090
                0091 C--   Register with the MIT coupler
43b2661424 Jean*0092       j = 0
a9cdd26a43 Jean*0093       DO bj=1,nSy
                0094        DO bi=1,nSx
43b2661424 Jean*0095         j = j+1
a9cdd26a43 Jean*0096         jG0 = myYGlobalLo+(bj-1)*sNy
                0097         iG0 = myXGlobalLo+(bi-1)*sNx
43b2661424 Jean*0098 #ifdef ALLOW_EXCH2
6269465120 Jean*0099         IF ( useExch2LayOut ) THEN
43b2661424 Jean*0100           tN = W2_myTileList(bi,bj)
                0101           iG0 = exch2_txGlobalo(tN)
                0102           jG0 = exch2_tyGlobalo(tN)
                0103         ENDIF
                0104 #endif /* ALLOW_EXCH2 */
                0105         iReg(1,j) = bi
                0106         iReg(2,j) = bj
                0107         iReg(3,j) = sNx
                0108         iReg(4,j) = sNy
                0109         iReg(5,j) = iG0
                0110         iReg(6,j) = jG0
a9cdd26a43 Jean*0111        ENDDO
                0112       ENDDO
43b2661424 Jean*0113       nTiles = nSx*nSy
                0114       CALL MITCOMPONENT_TILE_REGISTER( nTiles, iReg )
30541227a6 Jean*0115 #endif /* COMPONENT_MODULE */
a9cdd26a43 Jean*0116
                0117       RETURN
                0118       END