MITgcm |
|
|
|
|||
File indexing completed on 2025-03-03 06:10:58 UTC
view on githubraw file Latest commit b7b61e61 on 2025-03-02 15:55:22 UTC3b6c79e4de Mart*0001 #include "AUTODIFF_OPTIONS.h" 0002 0003 C ================================================================== 0004 C b7b61e618a Mart*0005 C adread_adwrite_i.F: routines to handle the I/O of the TAF 3b6c79e4de Mart*0006 C code for integer fields. All files are direct 0007 C generated code or integer fields. All files 0008 C are direct access files. 0009 C Routines: 0010 C o ADREAD_I - Read INT data from file. 0011 C o ADWRITE_I - Write INT data to file. 0012 C 0013 C see adread_adwrite.F for more explanation. 0014 C 0015 C The following input variables are used throughout in the argument 0016 C lists: 0017 C 0018 C name - character 0019 C On entry, name is the extended tape name. 0020 C len - integer 0021 C On entry, len is the number of characters in name. 0022 C tid - integer 0023 C On entry, tid identifies the tape. 0024 C vid - integer 0025 C On entry, vid identifies the variable to be stored on 0026 C the tape. 0027 C var - real array of dimension length 0028 C On entry, var contains the values to be stored. 0029 C var must not be changed. 0030 C size - integer 0031 C On entry, size is the size in bytes of the type of 0032 C variable var. 0033 C length - integer 0034 C On entry, length is the dimension of the variable 0035 C stored on the tape. 0036 C irec - integer 0037 C On entry, irec is the record number to be written. 0038 C myThid - integer 0039 C On entry, myThid is the number of the thread or 0040 C instance of the program. 0041 C 0042 C TAF does not provide the leading argument myThid when compiling 0043 C the MITgcmUV code. Instead there is a sed script available that 0044 C changes the TAF-generated adjoint code. 0045 C 0046 C Only the master thread is allowed to write data and only gobal 0047 C model arrays are allowed to be written be the subsequent routines. 0048 C Tiled data are to be stored in common blocks. This implies that at 0049 C least a two level checkpointing for the adjoint code has to be 0050 C available. 0051 C 0052 C ================================================================== 0053 0054 CBOP 0055 C !ROUTINE: ADREAD_I 0056 C !INTERFACE: 0057 SUBROUTINE ADREAD_I( 0058 I myThid, 0059 I name, 0060 I len, 0061 I tid, 0062 I vid, 0063 O ivar, 0064 I size, 0065 I length, 0066 I irec ) 0067 0068 C !DESCRIPTION: \bv 0069 C ================================================================== 0070 C SUBROUTINE ADREAD_I 0071 C ================================================================== 0072 C o read from direct access file, INTEGER version. 0073 C The strategy is to read an real*8 field with ADREAD resl*8 version 0074 C and convert to INTEGER 0075 C ================================================================== 0076 C SUBROUTINE ADREAD_I 0077 C ================================================================== 0078 C \ev 0079 0080 C !USES: 0081 IMPLICIT NONE 0082 0083 C == global variables == 0084 #include "EEPARAMS.h" 0085 #include "SIZE.h" 0086 0087 C !INPUT/OUTPUT PARAMETERS: 0088 C myThid :: number of the thread or instance of the program. 0089 C name :: extended tape name. 0090 C len :: number of characters in name. 0091 C tid :: tape identifier. 0092 C vid :: identifies the variable to be stored on tape. 0093 C ivar :: values to be stored. 0094 C size :: size in bytes of the type of variable var. 0095 C length :: dimension of the variable stored on the tape. 0096 C irec :: record number to be written. 0097 INTEGER myThid 0098 CHARACTER*(*) name 0099 INTEGER len 0100 INTEGER tid 0101 INTEGER vid 0102 INTEGER ivar(*) 0103 INTEGER size 0104 INTEGER length 0105 INTEGER irec 0106 0107 C !LOCAL VARIABLES: 0108 INTEGER k, lsize, length2d 0109 C 2D fields only 0110 PARAMETER ( length2d = (sNx+2*OLx)*(sNy+2*OLy)*nSx*nSy ) 0111 real*8 var(length2d) 0112 CHARACTER*(MAX_LEN_MBUF) msgBuf 0113 CEOP 0114 0115 #ifdef ALLOW_DEBUG 0116 IF ( debugMode ) CALL DEBUG_ENTER('ADREAD_I',myThid) 0117 #endif 0118 0119 IF ( length .GT. length2d ) THEN 0120 WRITE(msgBuf,'(A,I9,A,I9)') 0121 & 'ADREAD_I: length = ', length,' > length2d = ', length2d 0122 CALL PRINT_ERROR( msgBuf, myThid ) 0123 CALL ALL_PROC_DIE( myThid ) 0124 STOP 'ABNORMAL END: S/R ADREAD_I' 0125 ENDIF 0126 lsize = 8 0127 CALL ADREAD( 0128 I myThid, 0129 I name, 0130 I len, 0131 I tid, 0132 I vid, 0133 O var, 0134 I lsize, 0135 I length, 0136 I irec ) 0137 0138 DO k = 1,length 0139 ivar(k) = NINT(var(k)) 0140 ENDDO 0141 0142 #ifdef ALLOW_DEBUG 0143 IF ( debugMode ) CALL DEBUG_LEAVE('ADREAD_I',myThid) 0144 #endif 0145 0146 RETURN 0147 END 0148 0149 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| 0150 CBOP 0151 C !ROUTINE: ADWRITE_I 0152 C !INTERFACE: 0153 SUBROUTINE ADWRITE_I( 0154 I myThid, 0155 I name, 0156 I len, 0157 I tid, 0158 I vid, 0159 I ivar, 0160 I size, 0161 I length, 0162 I irec ) 0163 0164 C !DESCRIPTION: \bv 0165 C ================================================================== 0166 C SUBROUTINE ADWRITE_I 0167 C ================================================================== 0168 C o Write to direct access file, INTEGER version. 0169 C The strategy is to convert field to real*8 and use the 0170 C ADWRITE real*8 version. 0171 C ================================================================== 0172 C SUBROUTINE ADWRITE_I 0173 C ================================================================== 0174 C \ev 0175 0176 C !USES: 0177 IMPLICIT NONE 0178 0179 C == global variables == 0180 #include "EEPARAMS.h" 0181 #include "SIZE.h" 0182 0183 C !INPUT/OUTPUT PARAMETERS: 0184 C myThid :: number of the thread or instance of the program. 0185 C name :: extended tape name. 0186 C len :: number of characters in name. 0187 C tid :: tape identifier. 0188 C vid :: identifies the variable to be stored on tape. 0189 C ivar :: values to be stored. 0190 C size :: size in bytes of the type of variable var. 0191 C length :: dimension of the variable stored on the tape. 0192 C irec :: record number to be written. 0193 INTEGER myThid 0194 CHARACTER*(*) name 0195 INTEGER len 0196 INTEGER tid 0197 INTEGER vid 0198 INTEGER ivar(*) 0199 INTEGER size 0200 INTEGER length 0201 INTEGER irec 0202 0203 C !LOCAL VARIABLES: 0204 INTEGER k, lsize, length2d 0205 PARAMETER ( length2d = (sNx+2*OLx)*(sNy+2*OLy)*nSx*nSy ) 0206 real*8 var(length2d) 0207 CHARACTER*(MAX_LEN_MBUF) msgBuf 0208 CEOP 0209 0210 #ifdef ALLOW_DEBUG 0211 IF ( debugMode ) CALL DEBUG_ENTER('ADWRITE_I',myThid) 0212 #endif 0213 0214 IF ( length .GT. length2d ) THEN 0215 WRITE(msgBuf,'(A,I9,A,I9)') 0216 & 'ADWRITE_I: length = ',length,' > length2d = ',length2d 0217 CALL PRINT_ERROR( msgBuf, myThid ) 0218 CALL ALL_PROC_DIE( myThid ) 0219 STOP 'ABNORMAL END: S/R ADWRITE_I' 0220 ENDIF 0221 0222 DO k = 1,length 0223 C no automatic conversion 0224 c var(k) = DFLOAT(ivar(k)) 0225 C let compiler do the type conversion 0226 var(k) = ivar(k) 0227 ENDDO 0228 0229 lsize = 8 0230 CALL ADWRITE( 0231 I myThid, 0232 I name, 0233 I len, 0234 I tid, 0235 I vid, 0236 I var, 0237 I lsize, 0238 I length, 0239 I irec ) 0240 0241 #ifdef ALLOW_DEBUG 0242 IF ( debugMode ) CALL DEBUG_LEAVE('ADWRITE_I',myThid) 0243 #endif 0244 0245 RETURN 0246 END
| [ Source navigation ] | [ Diff markup ] | [ Identifier search ] | [ general search ] |
|
This page was automatically generated from https://github.com/MITgcm/MITgcm by the 2.2.1-MITgcm-0.1 LXR engine. The LXR team |
|