pkg/exch2/w2_eeboot.F

046fd16d1c Andr*0001 #include "CPP_EEOPTIONS.h"
                0002
241c2ac3c0 Jean*0003 CBOP
046fd16d1c Andr*0004 C     !ROUTINE: W2_EEBOOT
                0005
                0006 C     !INTERFACE:
                0007       SUBROUTINE W2_EEBOOT
                0008
                0009 C     !DESCRIPTION:
                0010 C     *==========================================================*
241c2ac3c0 Jean*0011 C     | SUBROUTINE W2_EEBOOT
                0012 C     | o Setup execution "environment" for WRAPPER2
046fd16d1c Andr*0013 C     *==========================================================*
                0014 C     | WRAPPER2 provides complex topology support. In this routine
                0015 C     | we setup the base topology for the default halo operations.
                0016 C     *==========================================================*
241c2ac3c0 Jean*0017
                0018 C     !USES:
                0019       IMPLICIT NONE
                0020
046fd16d1c Andr*0021 #include "SIZE.h"
                0022 #include "EEPARAMS.h"
017b6b2289 Jean*0023 #include "W2_EXCH2_SIZE.h"
046fd16d1c Andr*0024 #include "W2_EXCH2_TOPOLOGY.h"
                0025 #include "W2_EXCH2_PARAMS.h"
241c2ac3c0 Jean*0026 CEOP
046fd16d1c Andr*0027
55ed3c7ce6 Jean*0028 C     !FUNCTIONS:
                0029       INTEGER  ILNBLNK
                0030       EXTERNAL ILNBLNK
                0031
0acd686861 Jean*0032 C     !LOCAL VARIABLES:
241c2ac3c0 Jean*0033       CHARACTER*(MAX_LEN_MBUF) msgBuf
55ed3c7ce6 Jean*0034       CHARACTER*(MAX_LEN_FNAM) fName
02c8ab205e Jean*0035       INTEGER stdUnit, iLen
0acd686861 Jean*0036       INTEGER myThid
                0037       INTEGER ii, I, J
b9dadda204 Mart*0038       CHARACTER*(10) fmtStr
                0039       INTEGER iTmp
046fd16d1c Andr*0040
f0385691ef Ed H*0041 C     Set dummy myThid value (we are not multi-threaded here)
046fd16d1c Andr*0042       myThid = 1
241c2ac3c0 Jean*0043
                0044 C     Initialise to zero EXCH2_TOPOLOGY common blocks
220a2d2887 Jean*0045       exch2_nTiles = 0
017b6b2289 Jean*0046       DO I = 1,W2_maxNbTiles
241c2ac3c0 Jean*0047         exch2_tNx(I)    = 0
                0048         exch2_tNy(I)    = 0
                0049         exch2_tBasex(I) = 0
                0050         exch2_tBasey(I) = 0
                0051         exch2_txGlobalo(I) = 0
                0052         exch2_tyGlobalo(I) = 0
                0053         exch2_isWedge(I) = 0
                0054         exch2_isNedge(I) = 0
                0055         exch2_isEedge(I) = 0
                0056         exch2_isSedge(I) = 0
                0057         exch2_myFace(I)  = 0
                0058         exch2_mydNx(I)   = 0
                0059         exch2_mydNy(I)   = 0
                0060         exch2_nNeighbours(I) = 0
017b6b2289 Jean*0061         DO J = 1,W2_maxNeighbours
241c2ac3c0 Jean*0062           exch2_neighbourId(J,I)  = 0
                0063           exch2_opposingSend(J,I) = 0
6968107dbf Jean*0064           DO ii = 1,4
                0065            exch2_pij(ii,J,I) = 0
241c2ac3c0 Jean*0066           ENDDO
                0067           exch2_oi(J,I)  = 0
                0068           exch2_oj(J,I)  = 0
                0069           exch2_iLo(J,I) = 0
                0070           exch2_iHi(J,I) = 0
                0071           exch2_jLo(J,I) = 0
                0072           exch2_jHi(J,I) = 0
                0073         ENDDO
                0074       ENDDO
55ed3c7ce6 Jean*0075       W2_oUnit = standardMessageUnit
                0076
                0077 C     Set W2-EXCH2 parameters
017b6b2289 Jean*0078       CALL W2_READPARMS( myThid )
55ed3c7ce6 Jean*0079
                0080       stdUnit = standardMessageUnit
                0081       WRITE(msgBuf,'(A)') '===== Start setting W2 TOPOLOGY:'
                0082       CALL PRINT_MESSAGE( msgBuf, stdUnit, SQUEEZE_RIGHT, myThid )
                0083
                0084 C     Open message output-file (if needed)
017b6b2289 Jean*0085       IF ( W2_printMsg .LT. 0 ) THEN
b9dadda204 Mart*0086         iTmp = MAX(4,1 + INT(LOG10(DFLOAT(nPx*nPy))))
                0087         WRITE(fmtStr,'(2(A,I1),A)') '(A,I',iTmp,'.',iTmp,',A)'
                0088         WRITE(fName,fmtStr) 'w2_tile_topology.',myProcId,'.log'
55ed3c7ce6 Jean*0089         iLen = ILNBLNK(fName)
                0090         CALL MDSFINDUNIT( W2_oUnit, myThid )
                0091         OPEN( W2_oUnit, file=fName(1:iLen),
                0092      &                  status='unknown', form='formatted')
98412d2c05 Jean*0093         WRITE(msgBuf,'(2A)') ' write to log-file: ', fName(1:iLen)
55ed3c7ce6 Jean*0094         CALL PRINT_MESSAGE( msgBuf, stdUnit, SQUEEZE_RIGHT, myThid )
                0095       ENDIF
241c2ac3c0 Jean*0096
                0097 C     Define topology for every tile
017b6b2289 Jean*0098       CALL W2_E2SETUP( myThid )
046fd16d1c Andr*0099
0acd686861 Jean*0100 C--   Decide which tiles this process handles;
                0101 C     fill also W2_procTileList for Single-CPU-IO and check also tile-size;
                0102 C     print tiles connection for this process and set myCommonFlag :
                0103       CALL W2_MAP_PROCS( myThid )
a269055ce3 Jean*0104
046fd16d1c Andr*0105 C     Print out the topology communication schedule
017b6b2289 Jean*0106       IF ( W2_printMsg .NE. 0 ) THEN
                0107         CALL W2_PRINT_COMM_SEQUENCE( myThid )
                0108       ENDIF
55ed3c7ce6 Jean*0109
                0110 C     Close message output-file (if needed)
                0111       IF ( W2_oUnit.NE.standardMessageUnit ) THEN
                0112         WRITE(msgBuf,'(A)') '===  End TOPOLOGY report ==='
                0113         CALL PRINT_MESSAGE( msgBuf, W2_oUnit, SQUEEZE_BOTH, myThid )
                0114         CLOSE( W2_oUnit )
                0115       ENDIF
                0116       WRITE(msgBuf,'(A)') '=====       setting W2 TOPOLOGY: Done'
                0117       CALL PRINT_MESSAGE( msgBuf, stdUnit, SQUEEZE_RIGHT, myThid )
                0118       WRITE(msgBuf,'(A)') ' '
                0119       CALL PRINT_MESSAGE( msgBuf, stdUnit, SQUEEZE_RIGHT, myThid )
241c2ac3c0 Jean*0120
046fd16d1c Andr*0121       RETURN
                0122       END