/[MITgcm]/MITgcm_contrib/exch3/ex3_atopo_read.F
ViewVC logotype

Annotation of /MITgcm_contrib/exch3/ex3_atopo_read.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph


Revision 1.1 - (hide annotations) (download)
Thu Apr 6 20:36:26 2006 UTC (19 years, 3 months ago) by edhill
Branch: MAIN
CVS Tags: HEAD
move out of the model and into MITgcm_contrib

1 edhill 1.1 C $Header: /u/gcmpack/MITgcm/pkg/ex3/ex3_atopo_read.F,v 1.3 2006/02/06 21:09:54 edhill Exp $
2     C $Name: $
3    
4     #include "EX3_OPTIONS.h"
5    
6     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
7     CBOP
8     C !ROUTINE: EX3_ATOPO_READ
9    
10     C !INTERFACE:
11     SUBROUTINE EX3_ATOPO_READ
12    
13     C !DESCRIPTION:
14     C Read in the EX3 tile topology information from a "flat" ASCII text
15     C file that contains a version string.
16    
17     C !USES:
18     IMPLICIT NONE
19     #include "SIZE.h"
20     #include "EEPARAMS.h"
21     #include "EESUPPORT.h"
22     #include "EX3_SIZE.h"
23     #include "EX3_PARAMS.h"
24     #include "EX3_TOPOLOGY.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     CHARACTER*(MAX_LEN_PREC) line
40     INTEGER ii, jj, kk, k, it, ntile, nneigh
41    
42     C Intialize the affine transformation matrix
43     DO ii = 1,8
44     DO jj = 1,4
45     ex3_affm(jj,ii) = 0
46     ENDDO
47     ENDDO
48     C ------------------- 1 : I
49     ex3_affm(1,1) = 1
50     ex3_affm(4,1) = 1
51     C ------------------- 2 : Iu-
52     ex3_affm(1,2) = -1
53     ex3_affm(4,2) = 1
54     C ------------------- 3 : Iv-
55     ex3_affm(1,3) = 1
56     ex3_affm(4,3) = -1
57     C ------------------- 4 : -I
58     ex3_affm(1,4) = -1
59     ex3_affm(4,4) = -1
60     C ------------------- 5 : P
61     ex3_affm(2,5) = 1
62     ex3_affm(3,5) = 1
63     C ------------------- 6 : Pu-
64     ex3_affm(2,6) = -1
65     ex3_affm(3,6) = 1
66     C ------------------- 7 : Pv-
67     ex3_affm(2,7) = 1
68     ex3_affm(3,7) = -1
69     C ------------------- 8 : -P
70     ex3_affm(2,8) = -1
71     ex3_affm(3,8) = -1
72    
73     C Make scratch copies of input data file with and without comments
74     #ifdef TARGET_BGL
75     OPEN(UNIT=scrUnit1,FILE='scratch1',STATUS='UNKNOWN')
76     #else
77     OPEN(UNIT=scrUnit1,STATUS='SCRATCH')
78     #endif
79     IL = ILNBLNK(EX3_ATOPO_INAME)
80     OPEN(UNIT=eeDataUnit,FILE=EX3_ATOPO_INAME(1:IL),
81     & STATUS='OLD',err=100,IOSTAT=errIO)
82     IF ( errIO .GE. 0 ) GOTO 200
83     100 CONTINUE
84     WRITE(msgBuf,'(A)')
85     & 'S/R EX3_ATOPO_READ'
86     CALL PRINT_ERROR( msgBuf , 1)
87     WRITE(msgBuf,'(A)')
88     & 'Unable to open EX3 ASCII topology'
89     CALL PRINT_ERROR( msgBuf , 1)
90     WRITE(msgBuf,'(3A)')
91     & 'file ''',EX3_ATOPO_INAME(1:IL),''''
92     CALL PRINT_ERROR( msgBuf , 1)
93     STOP 'ABNORMAL END: S/R EX3_ATOPO_READ'
94     200 CONTINUE
95     300 CONTINUE
96     READ(eeDataUnit,FMT='(A)',END=400) LINE
97     IL = MAX(ILNBLNK(LINE),1)
98     IF ( LINE(1:1) .NE. commentCharacter ) THEN
99     WRITE(UNIT=scrUnit1,FMT='(A)') LINE(:IL)
100     ENDIF
101     GOTO 300
102     400 CONTINUE
103     CLOSE(eeDataUnit)
104    
105     iUnit = scrUnit1
106     REWIND(iUnit)
107     450 READ(UNIT=iUnit,FMT='(A)',END=500) LINE
108     IF ( LINE(1:7) .EQ. 'EX3TOPO' ) GOTO 600
109     GOTO 450
110     500 CONTINUE
111     #ifndef TARGET_PWR3
112     WRITE(msgBuf,'(A)')
113     & 'S/R EX3_ATOPO_READ'
114     CALL PRINT_ERROR( msgBuf , 1)
115     WRITE(msgBuf,'(A)')
116     & 'Error reading EX3 ASCII topology'
117     CALL PRINT_ERROR( msgBuf , 1)
118     WRITE(msgBuf,'(3A)')
119     & 'file "',EX3_ATOPO_INAME(1:IL),'"'
120     CALL PRINT_ERROR( msgBuf , 1)
121     WRITE(msgBuf,'(A)')
122     & 'Cannot locate the ''EX3TOPO'' header string'
123     CALL PRINT_ERROR( msgBuf , 1)
124     STOP 'ABNORMAL END: S/R EX3_ATOPO_READ'
125     #endif
126    
127     600 CONTINUE
128     C Parse the topo-file version string :
129     C = 0 0
130     C = 123456789 123456789
131     C = EXCH2TOPO ver 001
132     C = EX3TOPO ver 001
133     C = ===
134    
135     650 FORMAT(10i12)
136    
137     IF ( LINE(13:15) .EQ. '001' ) GOTO 700
138     C Other versions go here...
139    
140     GOTO 900
141    
142     700 CONTINUE
143     C VERSION : "001"
144     READ(iUnit,650) ntile
145     DO k = 1,ntile
146    
147     READ(iUnit,650) it
148     READ(iUnit,650)
149     & ex3_t_iproc(it), ex3_t_ori(it),
150     & (ex3_t_nxy(ii,it), ii=1,2)
151     READ(iUnit,650) ex3_f_ind(it),
152     & (ex3_f_nxy(ii,it), ii=1,2), (ex3_f_oij(ii,it), ii=1,2)
153     READ(iUnit,650) ex3_e_n(it)
154     READ(iUnit,650) (ex3_e_iam(ii,it), ii=1,ex3_e_n(it))
155     READ(iUnit,650) (ex3_e_iopt(ii,it), ii=1,ex3_e_n(it))
156     READ(iUnit,650) (ex3_e_iope(ii,it), ii=1,ex3_e_n(it))
157     DO ii = 1,ex3_e_n(it)
158     READ(iUnit,650)
159     & ((ex3_e_dat(kk,jj,ii,it), kk=1,3), jj=1,2)
160     ENDDO
161     READ(iUnit,650) (ex3_c_n(ii,it), ii=1,4)
162     DO ii = 1,4
163     READ(iUnit,650)
164     & (ex3_c_ind(jj,ii,it), jj=1,ex3_c_n(ii,it))
165     READ(iUnit,650)
166     & (ex3_c_num(jj,ii,it), jj=1,ex3_c_n(ii,it))
167     READ(iUnit,650)
168     & (ex3_c_ori(jj,ii,it), jj=1,ex3_c_n(ii,it))
169     ENDDO
170    
171    
172     ENDDO
173    
174     GOTO 999
175    
176     900 CONTINUE
177     C Unknown version string
178     WRITE(msgBuf,'(A)')
179     & 'S/R EX3_ATOPO_READ'
180     CALL PRINT_ERROR( msgBuf , 1)
181     WRITE(msgBuf,'(3A)')
182     & ' Error: EXCH2TOPO version string "', LINE(1:9), '"'
183     CALL PRINT_ERROR( msgBuf , 1)
184     WRITE(msgBuf,'(A)')
185     & ' is not understood'
186     CALL PRINT_ERROR( msgBuf , 1)
187     STOP 'ABNORMAL END: S/R EX3_ATOPO_READ'
188    
189     999 CONTINUE
190     CLOSE(iUnit)
191    
192     RETURN
193     END

  ViewVC Help
Powered by ViewVC 1.1.22