1 |
edhill |
1.2 |
C $Header: /u/gcmpack/MITgcm_contrib/eh3_spgr/hs94.cs-32x32x5/code_v2/w2_write_atopo.F,v 1.1 2005/09/24 19:38:18 edhill Exp $ |
2 |
edhill |
1.1 |
C $Name: $ |
3 |
|
|
|
4 |
|
|
#include "PACKAGES_CONFIG.h" |
5 |
|
|
#include "CPP_EEOPTIONS.h" |
6 |
|
|
|
7 |
|
|
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| |
8 |
|
|
CBOP |
9 |
|
|
C !ROUTINE: W2_WRITE_ATOPO |
10 |
|
|
|
11 |
|
|
C !INTERFACE: |
12 |
|
|
SUBROUTINE W2_WRITE_ATOPO |
13 |
|
|
|
14 |
|
|
C !DESCRIPTION: |
15 |
|
|
C Write in the EXCH2 tile topology information to a "flat" ascii |
16 |
|
|
C text file compatible with the format used by W2_READ_ATOPO |
17 |
|
|
|
18 |
|
|
C !USES: |
19 |
|
|
IMPLICIT NONE |
20 |
|
|
#include "SIZE.h" |
21 |
|
|
#include "EEPARAMS.h" |
22 |
|
|
#include "EESUPPORT.h" |
23 |
|
|
#include "W2_EXCH2_TOPOLOGY.h" |
24 |
|
|
#include "W2_EXCH2_PARAMS.h" |
25 |
|
|
INTEGER IFNBLNK |
26 |
|
|
EXTERNAL IFNBLNK |
27 |
|
|
INTEGER ILNBLNK |
28 |
|
|
EXTERNAL ILNBLNK |
29 |
|
|
CEOP |
30 |
|
|
|
31 |
|
|
C !LOCAL VARIABLES: |
32 |
|
|
C iUnit :: Work variable for IO unit number |
33 |
|
|
C errIO :: IO unit error flag |
34 |
|
|
C IL :: Temp. for index strings |
35 |
|
|
C msgBuf :: Temp. for textual I/O |
36 |
|
|
C line :: Temp. for textual I/O |
37 |
|
|
INTEGER IL, errIO, iUnit |
38 |
|
|
CHARACTER*(MAX_LEN_MBUF) msgBuf |
39 |
|
|
INTEGER ii, jj, k, nneigh |
40 |
|
|
|
41 |
|
|
|
42 |
|
|
IL = ILNBLNK(W2_ATOPO_ONAME) |
43 |
|
|
iUnit = eeDataUnit |
44 |
|
|
OPEN(UNIT=iUnit,FILE=W2_ATOPO_ONAME(1:IL), |
45 |
|
|
& status='unknown',err=100,IOSTAT=errIO) |
46 |
|
|
IF ( errIO .GE. 0 ) GOTO 200 |
47 |
|
|
100 CONTINUE |
48 |
|
|
WRITE(msgBuf,'(A)') |
49 |
|
|
& 'S/R W2_WRITE_ATOPO' |
50 |
|
|
CALL PRINT_ERROR( msgBuf , 1) |
51 |
|
|
WRITE(msgBuf,'(3A)') |
52 |
|
|
& 'Unable to open file "',W2_ATOPO_FNAME(1:IL),'"' |
53 |
|
|
CALL PRINT_ERROR( msgBuf , 1) |
54 |
|
|
STOP 'ABNORMAL END: S/R W2_WRITE_ATOPO' |
55 |
|
|
|
56 |
|
|
200 CONTINUE |
57 |
|
|
|
58 |
|
|
300 FORMAT(10i12) |
59 |
|
|
C The above format is not an efficient way to pack the topology |
60 |
|
|
C data. But it does NOT matter! Considering a system with 10,000 |
61 |
|
|
C tiles (one full order of magnitude larger than any MITgcm run |
62 |
|
|
C performed up and including to 2005) and the file size is still |
63 |
|
|
C less than 7MB: |
64 |
|
|
C |
65 |
|
|
C (10000 tiles) * (~4000 bytes / 6 tiles) = 6.4 MB |
66 |
|
|
|
67 |
|
|
C Write the topo-file version string : |
68 |
|
|
C = 0 0 |
69 |
|
|
C = 123456789 123456789 |
70 |
|
|
C = EXCH2TOPO ver 001 |
71 |
|
|
C = === |
72 |
|
|
|
73 |
|
|
C VERSION : "001" |
74 |
|
|
WRITE(iUnit,'(a)') '#' |
75 |
|
|
WRITE(iUnit,'(a)') '# MODEL GENERATED' |
76 |
|
|
WRITE(iUnit,'(a)') '#' |
77 |
|
|
WRITE(iUnit,'(a)') 'EXCH2TOPO ver 001' |
78 |
|
|
|
79 |
|
|
WRITE(iUnit,300) NTILES |
80 |
|
|
DO k = 1,NTILES |
81 |
|
|
|
82 |
|
|
WRITE(iUnit,300) k |
83 |
|
|
C exch2_myFace = 1 ; |
84 |
|
|
C exch2_isNedge = 1 ; |
85 |
|
|
C exch2_isSedge = 1 ; |
86 |
|
|
C exch2_isEedge = 1 ; |
87 |
|
|
C exch2_isWedge = 1 ; |
88 |
|
|
WRITE(iUnit,300) exch2_myFace(k), |
89 |
|
|
& exch2_isNedge(k), exch2_isSedge(k), |
90 |
|
|
& exch2_isEedge(k), exch2_isWedge(k) |
91 |
edhill |
1.2 |
C XXX exch2_tnx = 32 ; |
92 |
|
|
C XXX exch2_tny = 32 ; |
93 |
|
|
C XXX exch2_mydnx = 32 ; |
94 |
|
|
C XXX exch2_mydny = 32 ; |
95 |
|
|
WRITE(iUnit,300) |
96 |
|
|
& exch2_tnx(k), exch2_tny(k), |
97 |
|
|
& exch2_mydnx(k), exch2_mydny(k) |
98 |
edhill |
1.1 |
C exch2_txglobalo = 1 ; |
99 |
|
|
C exch2_tyglobalo = 1 ; |
100 |
|
|
C exch2_tbasex = 0 ; |
101 |
|
|
C exch2_tbasey = 0 ; |
102 |
|
|
C exch2_nNeighbours = 4 ; |
103 |
|
|
WRITE(iUnit,300) |
104 |
|
|
& exch2_txglobalo(k), exch2_tyglobalo(k), |
105 |
|
|
& exch2_tbasex(k), exch2_tbasey(k), |
106 |
|
|
& exch2_nNeighbours(k) |
107 |
|
|
nneigh = exch2_nNeighbours(k) |
108 |
|
|
C exch2_neighbourId = 3, 6, 2, 5 ; |
109 |
|
|
WRITE(iUnit,300) |
110 |
|
|
& (exch2_neighbourId(ii,k), ii=1,nneigh) |
111 |
|
|
C exch2_pi = 0, -1, 1, 0, 1, 0, 0, 1 ; |
112 |
|
|
WRITE(iUnit,300) |
113 |
|
|
& ((exch2_pi(jj,ii,k), jj=1,2), ii=1,nneigh) |
114 |
|
|
C exch2_pj = 1, 0, 0, 1, 0, 1, -1, 0 ; |
115 |
|
|
WRITE(iUnit,300) |
116 |
|
|
& ((exch2_pj(jj,ii,k), jj=1,2), ii=1,nneigh) |
117 |
|
|
C exch2_oi = 33, 0, 32, -32 ; |
118 |
|
|
WRITE(iUnit,300) |
119 |
|
|
& (exch2_oi(ii,k), ii=1,nneigh) |
120 |
|
|
C exch2_oj = 32, -32, 0, 33 ; |
121 |
|
|
WRITE(iUnit,300) |
122 |
|
|
& (exch2_oj(ii,k), ii=1,nneigh) |
123 |
|
|
C exch2_oi_f = 34, 0, 32, -32 ; |
124 |
|
|
WRITE(iUnit,300) |
125 |
|
|
& (exch2_oi_f(ii,k), ii=1,nneigh) |
126 |
|
|
C exch2_oj_f = 32, -32, 0, 34 ; |
127 |
|
|
WRITE(iUnit,300) |
128 |
|
|
& (exch2_oj_f(ii,k), ii=1,nneigh) |
129 |
edhill |
1.2 |
C XXX exch2_itlo_c = 0, 33 ; |
130 |
|
|
WRITE(iUnit,300) |
131 |
|
|
& (exch2_itlo_c(ii,k), ii=1,nneigh) |
132 |
|
|
C XXX exch2_ithi_c = 0, 0 ; |
133 |
|
|
WRITE(iUnit,300) |
134 |
|
|
& (exch2_ithi_c(ii,k), ii=1,nneigh) |
135 |
|
|
C XXX exch2_jtlo_c = 0, 33 ; |
136 |
|
|
WRITE(iUnit,300) |
137 |
|
|
& (exch2_jtlo_c(ii,k), ii=1,nneigh) |
138 |
|
|
C XXX exch2_jthi_c = 0, 0 ; |
139 |
|
|
WRITE(iUnit,300) |
140 |
|
|
& (exch2_jthi_c(ii,k), ii=1,nneigh) |
141 |
|
|
C XXX exch2_opposingSend_record = 4, 1, 4, 1 ; |
142 |
|
|
WRITE(iUnit,300) |
143 |
|
|
& (exch2_opposingSend_record(ii,k), ii=1,nneigh) |
144 |
|
|
|
145 |
edhill |
1.1 |
ENDDO |
146 |
|
|
|
147 |
|
|
CLOSE(iUnit) |
148 |
|
|
|
149 |
|
|
RETURN |
150 |
|
|
END |