| 1 | edhill | 1.1 | C $Header: /u/gcmpack/MITgcm/pkg/ex3/ex3_atopo_write.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_WRITE | 
| 9 |  |  |  | 
| 10 |  |  | C     !INTERFACE: | 
| 11 |  |  | SUBROUTINE EX3_ATOPO_WRITE | 
| 12 |  |  |  | 
| 13 |  |  | C     !DESCRIPTION: | 
| 14 |  |  | C     Write the EX3 tile topology information to 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 |  |  | INTEGER ii, jj, kk, k, ic, nneigh | 
| 40 |  |  |  | 
| 41 |  |  |  | 
| 42 |  |  | IL = ILNBLNK(EX3_ATOPO_ONAME) | 
| 43 |  |  | iUnit = eeDataUnit | 
| 44 |  |  | OPEN(UNIT=iUnit,FILE=EX3_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 EX3_ATOPO_WRITE' | 
| 50 |  |  | CALL PRINT_ERROR( msgBuf , 1) | 
| 51 |  |  | WRITE(msgBuf,'(3A)') | 
| 52 |  |  | &     'Unable to open file "',EX3_ATOPO_ONAME(1:IL),'"' | 
| 53 |  |  | CALL PRINT_ERROR( msgBuf , 1) | 
| 54 |  |  | STOP 'ABNORMAL END: S/R EX3_ATOPO_WRITE' | 
| 55 |  |  |  | 
| 56 |  |  | 200  CONTINUE | 
| 57 |  |  |  | 
| 58 |  |  | C     ========  ASCII FORMAT  ======== | 
| 59 |  |  | 650  FORMAT(10i12) | 
| 60 |  |  | C     The above format is not the most efficient way to pack the | 
| 61 |  |  | C     topology data.  But it does NOT matter!  Considering a | 
| 62 |  |  | C     hypothetical system with 10,000 tiles (one full order of magnitude | 
| 63 |  |  | C     larger than any MITgcm run performed through 2005), the file size | 
| 64 |  |  | C     would still be less than 10MB: | 
| 65 |  |  | C | 
| 66 |  |  | C     (10000 tiles) * (~5500 bytes / 6 tiles) = 9.2 MB | 
| 67 |  |  | C | 
| 68 |  |  | C     and this is orders of magnitude smaller than any binary data files | 
| 69 |  |  | C     that would be needed by such a run. | 
| 70 |  |  | C | 
| 71 |  |  | C     Write the topo-file version string : | 
| 72 |  |  | C     =           0         0 | 
| 73 |  |  | C     =  123456789 123456789 | 
| 74 |  |  | C     =  EXCH2TOPO ver 001 | 
| 75 |  |  | C     =  EX3TOPO ver 001 | 
| 76 |  |  | C     =              === | 
| 77 |  |  | C     ========  ASCII FORMAT  ======== | 
| 78 |  |  |  | 
| 79 |  |  | IF ( EX3_ATOPO_OVER(1:3) .EQ. '001' ) THEN | 
| 80 |  |  |  | 
| 81 |  |  | WRITE(iUnit,'(a)') '#' | 
| 82 |  |  | WRITE(iUnit,'(a)') '#  MODEL GENERATED' | 
| 83 |  |  | WRITE(iUnit,'(a)') '#' | 
| 84 |  |  | WRITE(iUnit,'(a)') 'EX3TOPO ver 001' | 
| 85 |  |  | WRITE(iUnit,650) ex3_t_num | 
| 86 |  |  | DO k = 1,ex3_t_num | 
| 87 |  |  |  | 
| 88 |  |  | WRITE(iUnit,650) k | 
| 89 |  |  | WRITE(iUnit,650) | 
| 90 |  |  | &         ex3_t_iproc(k), ex3_t_ori(k), | 
| 91 |  |  | &         (ex3_t_nxy(ii,k), ii=1,2) | 
| 92 |  |  | WRITE(iUnit,650) ex3_f_ind(k), | 
| 93 |  |  | &         (ex3_f_nxy(ii,k), ii=1,2), (ex3_f_oij(ii,k), ii=1,2) | 
| 94 |  |  | WRITE(iUnit,650) ex3_e_n(k) | 
| 95 |  |  | WRITE(iUnit,650) (ex3_e_iam(ii,k), ii=1,ex3_e_n(k)) | 
| 96 |  |  | WRITE(iUnit,650) (ex3_e_iopt(ii,k), ii=1,ex3_e_n(k)) | 
| 97 |  |  | WRITE(iUnit,650) (ex3_e_iope(ii,k), ii=1,ex3_e_n(k)) | 
| 98 |  |  | DO ii = 1,ex3_e_n(k) | 
| 99 |  |  | WRITE(iUnit,650) | 
| 100 |  |  | &           ((ex3_e_dat(kk,jj,ii,k), kk=1,3), jj=1,2) | 
| 101 |  |  | ENDDO | 
| 102 |  |  | WRITE(iUnit,650) (ex3_c_n(ii,k), ii=1,4) | 
| 103 |  |  | DO ii = 1,4 | 
| 104 |  |  | WRITE(iUnit,650) | 
| 105 |  |  | &           (ex3_c_ind(jj,ii,k), jj=1,ex3_c_n(ii,k)) | 
| 106 |  |  | WRITE(iUnit,650) | 
| 107 |  |  | &           (ex3_c_num(jj,ii,k), jj=1,ex3_c_n(ii,k)) | 
| 108 |  |  | WRITE(iUnit,650) | 
| 109 |  |  | &           (ex3_c_ori(jj,ii,k), jj=1,ex3_c_n(ii,k)) | 
| 110 |  |  | ENDDO | 
| 111 |  |  |  | 
| 112 |  |  | ENDDO | 
| 113 |  |  |  | 
| 114 |  |  | ELSE | 
| 115 |  |  |  | 
| 116 |  |  | WRITE(msgBuf,'(A)') | 
| 117 |  |  | &       'S/R EX3_ATOPO_WRITE' | 
| 118 |  |  | CALL PRINT_ERROR( msgBuf , 1) | 
| 119 |  |  | WRITE(msgBuf,'(3A)') | 
| 120 |  |  | &       'Unknown topology version ''',EX3_ATOPO_OVER(1:3),'''' | 
| 121 |  |  | CALL PRINT_ERROR( msgBuf , 1) | 
| 122 |  |  | WRITE(msgBuf,'(3A)') | 
| 123 |  |  | &       'Currently, valid values are ''001''' | 
| 124 |  |  | CALL PRINT_ERROR( msgBuf , 1) | 
| 125 |  |  | STOP 'ABNORMAL END: S/R EX3_ATOPO_WRITE' | 
| 126 |  |  |  | 
| 127 |  |  | ENDIF | 
| 128 |  |  |  | 
| 129 |  |  | CLOSE(iUnit) | 
| 130 |  |  |  | 
| 131 |  |  | RETURN | 
| 132 |  |  | END |