C $Header: /home/ubuntu/mnt/e9_copy/MITgcm_contrib/eh3_spgr/hs94.cs-32x32x5/code_v2/w2_read_atopo.F,v 1.3 2005/10/02 15:06:02 edhill Exp $ C $Name: $ #include "PACKAGES_CONFIG.h" #include "CPP_EEOPTIONS.h" C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| CBOP C !ROUTINE: W2_READ_ATOPO C !INTERFACE: SUBROUTINE W2_READ_ATOPO C !DESCRIPTION: C Read in the EXCH2 tile topology information from a "flat" ascii C text file that contains a version string to make the addition of C topology data much easier and more flexible. 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 CHARACTER*(MAX_LEN_PREC) line INTEGER ii, jj, k, it, ntile, nneigh C Intialize GEx affine transformation matrix DO ii = 1,8 DO jj = 1,4 GEx_affm(jj,ii) = 0 ENDDO ENDDO C ------------------- 1 : I GEx_affm(1,1) = 1 GEx_affm(4,1) = 1 C ------------------- 2 : Iu- GEx_affm(1,2) = -1 GEx_affm(4,2) = 1 C ------------------- 3 : Iv- GEx_affm(1,3) = 1 GEx_affm(4,3) = -1 C ------------------- 4 : -I GEx_affm(1,4) = -1 GEx_affm(4,4) = -1 C ------------------- 5 : P GEx_affm(2,5) = 1 GEx_affm(3,5) = 1 C ------------------- 6 : Pu- GEx_affm(2,6) = -1 GEx_affm(3,6) = 1 C ------------------- 7 : Pv- GEx_affm(2,7) = 1 GEx_affm(3,7) = -1 C ------------------- 8 : -P GEx_affm(2,8) = -1 GEx_affm(3,8) = -1 C Make scratch copies of input data file with and without comments #ifdef TARGET_BGL OPEN(UNIT=scrUnit1,FILE='scratch1',STATUS='UNKNOWN') #else OPEN(UNIT=scrUnit1,STATUS='SCRATCH') #endif IL = ILNBLNK(W2_ATOPO_FNAME) OPEN(UNIT=eeDataUnit,FILE=W2_ATOPO_FNAME(1:IL), & STATUS='OLD',err=100,IOSTAT=errIO) IF ( errIO .GE. 0 ) GOTO 200 100 CONTINUE WRITE(msgBuf,'(A)') & 'S/R W2_READ_ATOPO' CALL PRINT_ERROR( msgBuf , 1) WRITE(msgBuf,'(A)') & 'Unable to open execution environment ASCII topology' CALL PRINT_ERROR( msgBuf , 1) WRITE(msgBuf,'(3A)') & 'file "',W2_ATOPO_FNAME(1:IL),'"' CALL PRINT_ERROR( msgBuf , 1) STOP 'ABNORMAL END: S/R W2_READ_ATOPO' 200 CONTINUE 300 CONTINUE READ(eeDataUnit,FMT='(A)',END=400) LINE IL = MAX(ILNBLNK(LINE),1) IF ( LINE(1:1) .NE. commentCharacter ) THEN WRITE(UNIT=scrUnit1,FMT='(A)') LINE(:IL) ENDIF GOTO 300 400 CONTINUE CLOSE(eeDataUnit) iUnit = scrUnit1 REWIND(iUnit) 450 READ(UNIT=iUnit,FMT='(A)',END=500) LINE IF ( LINE(1:9) .EQ. 'EXCH2TOPO' ) GOTO 600 GOTO 450 500 CONTINUE #ifndef TARGET_PWR3 WRITE(msgBuf,'(A)') & 'S/R W2_READ_ATOPO' CALL PRINT_ERROR( msgBuf , 1) WRITE(msgBuf,'(A)') & 'Error reading execution environment ASCII topology' CALL PRINT_ERROR( msgBuf , 1) WRITE(msgBuf,'(3A)') & 'file "',W2_ATOPO_FNAME(1:IL),'"' CALL PRINT_ERROR( msgBuf , 1) WRITE(msgBuf,'(A)') & 'Cannot locate the topology header string' CALL PRINT_ERROR( msgBuf , 1) STOP 'ABNORMAL END: S/R W2_READ_ATOPO' #endif 600 CONTINUE C Parse the topo-file version string : C = 0 0 C = 123456789 123456789 C = EXCH2TOPO ver 001 C = === 650 FORMAT(10i12) IF ( LINE(15:17) .EQ. '001' ) GOTO 700 C Other versions go here... GOTO 900 700 CONTINUE C VERSION : "001" READ(iUnit,650) ntile DO k = 1,ntile READ(iUnit,650) it C exch2_myFace = 1 ; C exch2_isNedge = 1 ; C exch2_isSedge = 1 ; C exch2_isEedge = 1 ; C exch2_isWedge = 1 ; READ(iUnit,650) exch2_myFace(it), & exch2_isNedge(it), exch2_isSedge(it), & exch2_isEedge(it), exch2_isWedge(it) C XXX exch2_tnx = 32 ; C XXX exch2_tny = 32 ; C XXX exch2_mydnx = 32 ; C XXX exch2_mydny = 32 ; READ(iUnit,650) & exch2_tnx(it), exch2_tny(it), & exch2_mydnx(it), exch2_mydny(it) C exch2_txglobalo = 1 ; C exch2_tyglobalo = 1 ; C exch2_tbasex = 0 ; C exch2_tbasey = 0 ; C exch2_nNeighbours = 4 ; READ(iUnit,650) & exch2_txglobalo(it), exch2_tyglobalo(it), & exch2_tbasex(it), exch2_tbasey(it), & exch2_nNeighbours(it) nneigh = exch2_nNeighbours(it) C exch2_neighbourId = 3, 6, 2, 5 ; READ(iUnit,650) & (exch2_neighbourId(ii,it), ii=1,nneigh) C exch2_pi = 0, -1, 1, 0, 1, 0, 0, 1 ; READ(iUnit,650) & ((exch2_pi(jj,ii,it), jj=1,2), ii=1,nneigh) C exch2_pj = 1, 0, 0, 1, 0, 1, -1, 0 ; READ(iUnit,650) & ((exch2_pj(jj,ii,it), jj=1,2), ii=1,nneigh) C exch2_oi = 33, 0, 32, -32 ; READ(iUnit,650) & (exch2_oi(ii,it), ii=1,nneigh) C exch2_oj = 32, -32, 0, 33 ; READ(iUnit,650) & (exch2_oj(ii,it), ii=1,nneigh) C exch2_oi_f = 34, 0, 32, -32 ; READ(iUnit,650) & (exch2_oi_f(ii,it), ii=1,nneigh) C exch2_oj_f = 32, -32, 0, 34 ; READ(iUnit,650) & (exch2_oj_f(ii,it), ii=1,nneigh) C XXX exch2_itlo_c = 0, 33 ; READ(iUnit,650) & (exch2_itlo_c(ii,it), ii=1,nneigh) C XXX exch2_ithi_c = 0, 0 ; READ(iUnit,650) & (exch2_ithi_c(ii,it), ii=1,nneigh) C XXX exch2_jtlo_c = 0, 33 ; READ(iUnit,650) & (exch2_jtlo_c(ii,it), ii=1,nneigh) C XXX exch2_jthi_c = 0, 0 ; READ(iUnit,650) & (exch2_jthi_c(ii,it), ii=1,nneigh) C XXX exch2_opposingSend_record = 4, 1, 4, 1 ; READ(iUnit,650) & (exch2_opposingSend_record(ii,it), ii=1,nneigh) ENDDO C CALL W2_WRITE_ATOPO GOTO 999 900 CONTINUE C Unknown version string WRITE(msgBuf,'(A)') & 'S/R W2_READ_ATOPO' CALL PRINT_ERROR( msgBuf , 1) WRITE(msgBuf,'(3A)') & ' Error: EXCH2TOPO version string "', LINE(1:9), '"' CALL PRINT_ERROR( msgBuf , 1) WRITE(msgBuf,'(A)') & ' is not understood' CALL PRINT_ERROR( msgBuf , 1) STOP 'ABNORMAL END: S/R W2_READ_ATOPO' 999 CONTINUE CLOSE(iUnit) RETURN END