C $Header: /home/ubuntu/mnt/e9_copy/MITgcm_contrib/eh3_spgr/hs94.cs-32x32x5/code_v2/w2_write_atopo.F,v 1.3 2005/09/28 20:52:22 edhill Exp $
C $Name:  $

#include "PACKAGES_CONFIG.h"
#include "CPP_EEOPTIONS.h"

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

C     !INTERFACE:
      SUBROUTINE W2_WRITE_ATOPO

C     !DESCRIPTION:
C     Write in the EXCH2 tile topology information to a "flat" ascii
C     text file compatible with the format used by W2_READ_ATOPO

C     !USES:
      IMPLICIT NONE
#include "SIZE.h"
#include "EEPARAMS.h"
#include "EESUPPORT.h"
#include "W2_EXCH2_TOPOLOGY.h"
#include "W2_EXCH2_PARAMS.h"
      INTEGER  IFNBLNK
      EXTERNAL IFNBLNK
      INTEGER  ILNBLNK
      EXTERNAL ILNBLNK
CEOP

C     !LOCAL VARIABLES:
C     iUnit  :: Work variable for IO unit number
C     errIO  :: IO unit error flag
C     IL     :: Temp. for index strings
C     msgBuf :: Temp. for textual I/O
C     line   :: Temp. for textual I/O
      INTEGER IL, errIO, iUnit
      CHARACTER*(MAX_LEN_MBUF) msgBuf
      INTEGER ii, jj, k, ic, nneigh


      IL = ILNBLNK(W2_ATOPO_ONAME)
      iUnit = eeDataUnit
      OPEN(UNIT=iUnit,FILE=W2_ATOPO_ONAME(1:IL),
     &     status='unknown',err=100,IOSTAT=errIO)
      IF ( errIO .GE. 0 ) GOTO 200
 100  CONTINUE
      WRITE(msgBuf,'(A)')
     &     'S/R W2_WRITE_ATOPO'
      CALL PRINT_ERROR( msgBuf , 1)
      WRITE(msgBuf,'(3A)')
     &     'Unable to open file "',W2_ATOPO_FNAME(1:IL),'"'
      CALL PRINT_ERROR( msgBuf , 1)
      STOP 'ABNORMAL END: S/R W2_WRITE_ATOPO'
      
 200  CONTINUE

C     ========  ASCII FORMAT  ========
 300  FORMAT(10i12)
C     The above format is not an efficient way to pack the topology
C     data.  But it does NOT matter!  Considering a hypothetical system
C     with 10,000 tiles (one full order of magnitude larger than any
C     MITgcm run performed through 2005), the file size would still be
C     less than 10MB:
C
C     (10000 tiles) * (~5500 bytes / 6 tiles) = 9.2 MB
C     
C     and this is orders of magnitude smaller than any binary data files
C     that would be needed by such a run.
C
C     Write the topo-file version string :
C     =           0         0
C     =  123456789 123456789 
C     =  EXCH2TOPO ver 001
C     =                ===
C
C     ========  ASCII FORMAT  ========

      IF ( W2_atopo_o_ver(1:3) .EQ. '001' 
     &     .OR. W2_atopo_o_ver(1:3) .EQ. '002' ) THEN

        WRITE(iUnit,'(a)') '#'
        WRITE(iUnit,'(a)') '#  MODEL GENERATED'
        WRITE(iUnit,'(a)') '#'
        WRITE(iUnit,'(a)') 'EXCH2TOPO ver 001'
        WRITE(iUnit,300) NTILES
        DO k = 1,NTILES
          
          WRITE(iUnit,300) k
C         exch2_myFace = 1 ;
C         exch2_isNedge = 1 ;
C         exch2_isSedge = 1 ;
C         exch2_isEedge = 1 ;
C         exch2_isWedge = 1 ;
          WRITE(iUnit,300) exch2_myFace(k),
     &         exch2_isNedge(k), exch2_isSedge(k), 
     &         exch2_isEedge(k), exch2_isWedge(k)
C         XXX  exch2_tnx = 32 ;
C         XXX  exch2_tny = 32 ;
C         XXX  exch2_mydnx = 32 ;
C         XXX  exch2_mydny = 32 ;
          WRITE(iUnit,300)
     &         exch2_tnx(k), exch2_tny(k),
     &         exch2_mydnx(k), exch2_mydny(k)
C         exch2_txglobalo = 1 ;
C         exch2_tyglobalo = 1 ;
C         exch2_tbasex = 0 ;
C         exch2_tbasey = 0 ;
C         exch2_nNeighbours = 4 ;
          WRITE(iUnit,300) 
     &         exch2_txglobalo(k), exch2_tyglobalo(k),
     &         exch2_tbasex(k), exch2_tbasey(k), 
     &         exch2_nNeighbours(k)
          nneigh = exch2_nNeighbours(k)
C         exch2_neighbourId = 3, 6, 2, 5 ;
          WRITE(iUnit,300)
     &         (exch2_neighbourId(ii,k), ii=1,nneigh)
C         exch2_pi = 0, -1, 1, 0, 1, 0, 0, 1 ;
          WRITE(iUnit,300)
     &         ((exch2_pi(jj,ii,k), jj=1,2), ii=1,nneigh)
C         exch2_pj = 1, 0, 0, 1, 0, 1, -1, 0 ;
          WRITE(iUnit,300)
     &         ((exch2_pj(jj,ii,k), jj=1,2), ii=1,nneigh)
C         exch2_oi = 33, 0, 32, -32 ;
          WRITE(iUnit,300)
     &         (exch2_oi(ii,k), ii=1,nneigh)
C         exch2_oj = 32, -32, 0, 33 ;
          WRITE(iUnit,300)
     &         (exch2_oj(ii,k), ii=1,nneigh)
C         exch2_oi_f = 34, 0, 32, -32 ;
          WRITE(iUnit,300)
     &         (exch2_oi_f(ii,k), ii=1,nneigh)
C         exch2_oj_f = 32, -32, 0, 34 ;
          WRITE(iUnit,300)
     &         (exch2_oj_f(ii,k), ii=1,nneigh)
C         XXX  exch2_itlo_c = 0, 33 ;
          WRITE(iUnit,300)
     &         (exch2_itlo_c(ii,k), ii=1,nneigh)
C         XXX  exch2_ithi_c = 0, 0 ;
          WRITE(iUnit,300)
     &         (exch2_ithi_c(ii,k), ii=1,nneigh)
C         XXX  exch2_jtlo_c = 0, 33 ;
          WRITE(iUnit,300)
     &         (exch2_jtlo_c(ii,k), ii=1,nneigh)
C         XXX  exch2_jthi_c = 0, 0 ;
          WRITE(iUnit,300)
     &         (exch2_jthi_c(ii,k), ii=1,nneigh)
C         XXX  exch2_opposingSend_record = 4, 1, 4, 1 ;
          WRITE(iUnit,300)
     &         (exch2_opposingSend_record(ii,k), ii=1,nneigh)

C         Add the corners, if necessary
          IF ( W2_atopo_o_ver(1:3) .EQ. '002' ) THEN
            WRITE(iUnit,300)
     &           (GEx_ncor(ii,k), ii=1,4)
            DO ii = 1,4
              DO jj = 1,2
                WRITE(iUnit,300)
     &               (GEx_cInfo(ic,jj,ii,k), ic=1,GEx_ncor(ii,k))
              ENDDO
            ENDDO
          ENDIF

        ENDDO

      ELSE

        WRITE(msgBuf,'(A)')
     &       'S/R W2_WRITE_ATOPO'
        CALL PRINT_ERROR( msgBuf , 1)
        WRITE(msgBuf,'(3A)')
     &       'Unknown topology version "',W2_atopo_o_ver(1:3),'"'
        CALL PRINT_ERROR( msgBuf , 1)
        WRITE(msgBuf,'(3A)')
     &       'Currently, valid values are "001" or "002"'
        CALL PRINT_ERROR( msgBuf , 1)
        STOP 'ABNORMAL END: S/R W2_WRITE_ATOPO'

      ENDIF

      CLOSE(iUnit)

      RETURN
      END