| 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 |