/[MITgcm]/MITgcm_contrib/eh3_spgr/hs94.cs-32x32x5/code/w2_aread_setup.F
ViewVC logotype

Annotation of /MITgcm_contrib/eh3_spgr/hs94.cs-32x32x5/code/w2_aread_setup.F

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


Revision 1.1 - (hide annotations) (download)
Sun Aug 28 18:18:09 2005 UTC (20 years, 3 months ago) by edhill
Branch: MAIN
CVS Tags: HEAD
 o initial check-in of an example to test some new exch2 bits

1 edhill 1.1 C $Header: $
2     C $Name: $
3    
4     #include "CPP_EEOPTIONS.h"
5    
6     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
7     CBOP 0
8     C !ROUTINE: W2_AREAD_SETUP
9    
10     C !INTERFACE:
11     SUBROUTINE W2_AREAD_SETUP()
12    
13     C !DESCRIPTION:
14     C Read the wrapper2 exch2 tile (and face) topology information from
15     C a single flat ASCII text file.
16    
17     C !USES:
18     IMPLICIT NONE
19     #include "SIZE.h"
20     #include "EEPARAMS.h"
21     #include "EESUPPORT.h"
22     #include "W2_EXCH2_TOPOLOGY.h"
23     INTEGER ILNBLNK
24     EXTERNAL ILNBLNK
25     CEOP
26    
27     C !LOCAL VARIABLES:
28     C iUnit :: Work variable for IO unit number
29     C errIO :: IO unit error flag
30     C IL :: Temp. for index strings
31     C msgBuf :: Temp. for textual I/O
32     C record :: Temp. for textual I/O
33     INTEGER IL, errIO, iUnit
34     CHARACTER*(MAX_LEN_MBUF) msgBuf
35     CHARACTER*(MAX_LEN_PREC) record
36     CHARACTER*(80) cbuf
37     INTEGER iver, ntile, it, in, ic, ncn, ii
38    
39     C Make scratch copies of input data file with and without comments
40     #ifdef TARGET_BGL
41     OPEN(UNIT=scrUnit1,FILE='scratch1',STATUS='UNKNOWN')
42     OPEN(UNIT=scrUnit2,FILE='scratch2',STATUS='UNKNOWN')
43     #else
44     OPEN(UNIT=scrUnit1,STATUS='SCRATCH')
45     OPEN(UNIT=scrUnit2,STATUS='SCRATCH')
46     #endif
47     OPEN(UNIT=eeDataUnit,FILE='exch2topology',STATUS='OLD',
48     & err=1,IOSTAT=errIO)
49     IF ( errIO .GE. 0 ) GOTO 2
50     1 CONTINUE
51     WRITE(msgBuf,'(A)') 'S/R W2_AREAD_SETUP'
52     CALL PRINT_ERROR( msgBuf , 1)
53     WRITE(msgBuf,'(A)') 'Unable to open W2_EXCH2 topology data'
54     CALL PRINT_ERROR( msgBuf , 1)
55     WRITE(msgBuf,'(A)') 'file "exch2topology"'
56     CALL PRINT_ERROR( msgBuf , 1)
57     STOP 'ABNORMAL END: S/R W2_AREAD_SETUP'
58     2 CONTINUE
59     READ(eeDataUnit,FMT='(A)',END=3) RECORD
60     IL = MAX(ILNBLNK(RECORD),1)
61     IF ( RECORD(1:1) .NE. commentCharacter ) THEN
62     WRITE(UNIT=scrUnit1,FMT='(A)') RECORD(:IL)
63     ENDIF
64     GOTO 2
65     3 CONTINUE
66     CLOSE(eeDataUnit)
67    
68     iUnit = scrUnit1
69     REWIND(iUnit)
70    
71     C Read the EXCH2 information, first checking the file version
72     READ(UNIT=iUnit,FMT=100,END=900) cbuf, iver
73     100 FORMAT(a20,i10)
74     IF ( (iver .LT. 1) .OR. (iver .GT. 2) ) THEN
75     WRITE(msgBuf,'(A)') 'S/R W2_AREAD_SETUP'
76     CALL PRINT_ERROR( msgBuf , 1)
77     WRITE(msgBuf,'(A)') 'ERROR: wrong exch2topology ver number'
78     CALL PRINT_ERROR( msgBuf , 1)
79     WRITE(msgBuf,'(A)') 'please convert to formats "1" or "2"'
80     CALL PRINT_ERROR( msgBuf , 1)
81     STOP 'ABNORMAL END: S/R W2_AREAD_SETUP'
82     ENDIF
83     READ(UNIT=iUnit,FMT=105,END=910) cbuf, ntile
84     105 FORMAT(a10,i10)
85     107 FORMAT(10i10)
86     110 FORMAT(2i10)
87     115 FORMAT(4i10)
88    
89     DO it = 1,ntile
90     READ(UNIT=iUnit,FMT=105,END=910) exch2_tnx (it)
91     READ(UNIT=iUnit,FMT=105,END=910) exch2_tny (it)
92     READ(UNIT=iUnit,FMT=105,END=910) exch2_tbasex (it)
93     READ(UNIT=iUnit,FMT=105,END=910) exch2_tbasey (it)
94     READ(UNIT=iUnit,FMT=105,END=910) exch2_txglobalo (it)
95     READ(UNIT=iUnit,FMT=105,END=910) exch2_tyglobalo (it)
96     READ(UNIT=iUnit,FMT=105,END=910) exch2_isWedge (it)
97     READ(UNIT=iUnit,FMT=105,END=910) exch2_isNedge (it)
98     READ(UNIT=iUnit,FMT=105,END=910) exch2_isEedge (it)
99     READ(UNIT=iUnit,FMT=105,END=910) exch2_isSedge (it)
100     READ(UNIT=iUnit,FMT=105,END=910) exch2_myFace (it)
101     READ(UNIT=iUnit,FMT=105,END=910) exch2_mydnx (it)
102     READ(UNIT=iUnit,FMT=105,END=910) exch2_mydny (it)
103     READ(UNIT=iUnit,FMT=105,END=910) exch2_nNeighbours (it)
104    
105     #ifdef W2_EXCH2_USE_CORNERS
106    
107     C Read the corner information
108     DO ic = 1,4
109    
110     READ(UNIT=iUnit,FMT=107,END=910)
111     & ncn, (exch2_cNeighIDs(ii,ic,it),ii=1,ncn)
112     exch2_ncNeigh(ic,it) = ncn
113    
114     ENDDO
115     #endif
116    
117     C Read the per-neighbor data
118     DO in = 1,exch2_nNeighbours(it)
119    
120     READ(UNIT=iUnit,FMT=110,END=910)
121     & exch2_neighbourId(in,it),
122     & exch2_opposingSend_record(in,it)
123     READ(UNIT=iUnit,FMT=115,END=910)
124     & exch2_pi(1,in,it), exch2_pi(2,in,it),
125     & exch2_pj(1,in,it), exch2_pj(2,in,it)
126     READ(UNIT=iUnit,FMT=115,END=910)
127     & exch2_oi(in,it), exch2_oi_f(in,it),
128     & exch2_oj(in,it), exch2_oj_f(in,it)
129     READ(UNIT=iUnit,FMT=115,END=910)
130     & exch2_itlo_c(in,it), exch2_ithi_c(in,it),
131     & exch2_jtlo_c(in,it), exch2_jthi_c(in,it)
132    
133     ENDDO
134    
135     ENDDO
136    
137     GOTO 999
138    
139     900 CONTINUE
140     WRITE(msgBuf,'(A)') 'S/R W2_AREAD_SETUP'
141     CALL PRINT_ERROR( msgBuf , 1)
142     WRITE(msgBuf,'(A)') 'ERROR: wrong exch2topology ver number'
143     CALL PRINT_ERROR( msgBuf , 1)
144     WRITE(msgBuf,'(A)') 'please convert to file format "v1"'
145     CALL PRINT_ERROR( msgBuf , 1)
146     STOP 'ABNORMAL END: S/R W2_AREAD_SETUP'
147    
148     910 CONTINUE
149     WRITE(msgBuf,'(A)') 'S/R W2_AREAD_SETUP'
150     CALL PRINT_ERROR( msgBuf , 1)
151     WRITE(msgBuf,'(A)') 'ERROR: problem reading "exch2topology"'
152     CALL PRINT_ERROR( msgBuf , 1)
153     WRITE(msgBuf,'(A)') 'please check the file format'
154     CALL PRINT_ERROR( msgBuf , 1)
155     STOP 'ABNORMAL END: S/R W2_AREAD_SETUP'
156    
157     999 CLOSE(iUnit)
158    
159     RETURN
160     END
161    
162     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
163    

  ViewVC Help
Powered by ViewVC 1.1.22