MITgcm |
|
|
|
|||
File indexing completed on 2021-12-21 06:10:40 UTC
view on githubraw file Latest commit 3b6c79e4 on 2021-12-20 18:12:25 UTC3b6c79e4de Mart*0001 #include "AUTODIFF_OPTIONS.h" 0002 0003 C ================================================================== 0004 C 0005 C adread_adwrite_i.F: routines to handle the I/O of the TAF/TAMC 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 For further details on this see the TAMC Users Manual, Appendix B, 0043 C User defined Storage Subroutines. 0044 C 0045 C TAF does not provide the leading argument myThid when compiling 0046 C the MITgcmUV code. Instead there is a sed script available that 0047 C changes the TAF-generated adjoint code. 0048 C 0049 C Only the master thread is allowed to write data and only gobal 0050 C model arrays are allowed to be written be the subsequent routines. 0051 C Tiled data are to be stored in common blocks. This implies that at 0052 C least a two level checkpointing for the adjoint code has to be 0053 C available. 0054 C 0055 C ================================================================== 0056 0057 CBOP 0058 C !ROUTINE: ADREAD_I 0059 C !INTERFACE: 0060 SUBROUTINE ADREAD_I( 0061 I myThid, 0062 I name, 0063 I len, 0064 I tid, 0065 I vid, 0066 O ivar, 0067 I size, 0068 I length, 0069 I irec ) 0070 0071 C !DESCRIPTION: \bv 0072 C ================================================================== 0073 C SUBROUTINE ADREAD_I 0074 C ================================================================== 0075 C o read from direct access file, INTEGER version. 0076 C The strategy is to read an real*8 field with ADREAD resl*8 version 0077 C and convert to INTEGER 0078 C ================================================================== 0079 C SUBROUTINE ADREAD_I 0080 C ================================================================== 0081 C \ev 0082 0083 C !USES: 0084 IMPLICIT NONE 0085 0086 C == global variables == 0087 #include "EEPARAMS.h" 0088 #include "SIZE.h" 0089 0090 C !INPUT/OUTPUT PARAMETERS: 0091 C myThid :: number of the thread or instance of the program. 0092 C name :: extended tape name. 0093 C len :: number of characters in name. 0094 C tid :: tape identifier. 0095 C vid :: identifies the variable to be stored on tape. 0096 C ivar :: values to be stored. 0097 C size :: size in bytes of the type of variable var. 0098 C length :: dimension of the variable stored on the tape. 0099 C irec :: record number to be written. 0100 INTEGER myThid 0101 CHARACTER*(*) name 0102 INTEGER len 0103 INTEGER tid 0104 INTEGER vid 0105 INTEGER ivar(*) 0106 INTEGER size 0107 INTEGER length 0108 INTEGER irec 0109 0110 C !LOCAL VARIABLES: 0111 INTEGER k, lsize, length2d 0112 C 2D fields only 0113 PARAMETER ( length2d = (sNx+2*OLx)*(sNy+2*OLy)*nSx*nSy ) 0114 real*8 var(length2d) 0115 CHARACTER*(MAX_LEN_MBUF) msgBuf 0116 CEOP 0117 0118 #ifdef ALLOW_DEBUG 0119 IF ( debugMode ) CALL DEBUG_ENTER('ADREAD_I',myThid) 0120 #endif 0121 0122 IF ( length .GT. length2d ) THEN 0123 WRITE(msgBuf,'(A,I9,A,I9)') 0124 & 'ADREAD_I: length = ', length,' > length2d = ', length2d 0125 CALL PRINT_ERROR( msgBuf, myThid ) 0126 CALL ALL_PROC_DIE( myThid ) 0127 STOP 'ABNORMAL END: S/R ADREAD_I' 0128 ENDIF 0129 lsize = 8 0130 CALL ADREAD( 0131 I myThid, 0132 I name, 0133 I len, 0134 I tid, 0135 I vid, 0136 O var, 0137 I lsize, 0138 I length, 0139 I irec ) 0140 0141 DO k = 1,length 0142 ivar(k) = NINT(var(k)) 0143 ENDDO 0144 0145 #ifdef ALLOW_DEBUG 0146 IF ( debugMode ) CALL DEBUG_LEAVE('ADREAD_I',myThid) 0147 #endif 0148 0149 RETURN 0150 END 0151 0152 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| 0153 CBOP 0154 C !ROUTINE: ADWRITE_I 0155 C !INTERFACE: 0156 SUBROUTINE ADWRITE_I( 0157 I myThid, 0158 I name, 0159 I len, 0160 I tid, 0161 I vid, 0162 I ivar, 0163 I size, 0164 I length, 0165 I irec ) 0166 0167 C !DESCRIPTION: \bv 0168 C ================================================================== 0169 C SUBROUTINE ADWRITE_I 0170 C ================================================================== 0171 C o Write to direct access file, INTEGER version. 0172 C The strategy is to convert field to real*8 and use the 0173 C ADWRITE real*8 version. 0174 C ================================================================== 0175 C SUBROUTINE ADWRITE_I 0176 C ================================================================== 0177 C \ev 0178 0179 C !USES: 0180 IMPLICIT NONE 0181 0182 C == global variables == 0183 #include "EEPARAMS.h" 0184 #include "SIZE.h" 0185 0186 C !INPUT/OUTPUT PARAMETERS: 0187 C myThid :: number of the thread or instance of the program. 0188 C name :: extended tape name. 0189 C len :: number of characters in name. 0190 C tid :: tape identifier. 0191 C vid :: identifies the variable to be stored on tape. 0192 C ivar :: values to be stored. 0193 C size :: size in bytes of the type of variable var. 0194 C length :: dimension of the variable stored on the tape. 0195 C irec :: record number to be written. 0196 INTEGER myThid 0197 CHARACTER*(*) name 0198 INTEGER len 0199 INTEGER tid 0200 INTEGER vid 0201 INTEGER ivar(*) 0202 INTEGER size 0203 INTEGER length 0204 INTEGER irec 0205 0206 C !LOCAL VARIABLES: 0207 INTEGER k, lsize, length2d 0208 PARAMETER ( length2d = (sNx+2*OLx)*(sNy+2*OLy)*nSx*nSy ) 0209 real*8 var(length2d) 0210 CHARACTER*(MAX_LEN_MBUF) msgBuf 0211 CEOP 0212 0213 #ifdef ALLOW_DEBUG 0214 IF ( debugMode ) CALL DEBUG_ENTER('ADWRITE_I',myThid) 0215 #endif 0216 0217 IF ( length .GT. length2d ) THEN 0218 WRITE(msgBuf,'(A,I9,A,I9)') 0219 & 'ADWRITE_I: length = ',length,' > length2d = ',length2d 0220 CALL PRINT_ERROR( msgBuf, myThid ) 0221 CALL ALL_PROC_DIE( myThid ) 0222 STOP 'ABNORMAL END: S/R ADWRITE_I' 0223 ENDIF 0224 0225 DO k = 1,length 0226 C no automatic conversion 0227 c var(k) = DFLOAT(ivar(k)) 0228 C let compiler do the type conversion 0229 var(k) = ivar(k) 0230 ENDDO 0231 0232 lsize = 8 0233 CALL ADWRITE( 0234 I myThid, 0235 I name, 0236 I len, 0237 I tid, 0238 I vid, 0239 I var, 0240 I lsize, 0241 I length, 0242 I irec ) 0243 0244 #ifdef ALLOW_DEBUG 0245 IF ( debugMode ) CALL DEBUG_LEAVE('ADWRITE_I',myThid) 0246 #endif 0247 0248 RETURN 0249 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 |
|