pkg/autodiff/adread_adwrite.F

6d54cf9ca1 Ed H*0001 #include "AUTODIFF_OPTIONS.h"
bead363026 Jean*0002 #ifdef ALLOW_CTRL
                0003 # include "CTRL_OPTIONS.h"
                0004 #endif
2dcaa8b9a5 Patr*0005
80818af392 Jean*0006 C     ==================================================================
                0007 C
3b6c79e4de Mart*0008 C     adread_adwrite.F: routines to handle the I/O of the TAF/TAMC
                0009 C                       generated code. All files are direct access files.
80818af392 Jean*0010 C     Routines:
3b6c79e4de Mart*0011 C     o  ADREAD    - Read  RL/RS data from file.
                0012 C     o  ADWRITE   - Write RL/RS data to   file.
80818af392 Jean*0013 C
3b6c79e4de Mart*0014 C     Note on short real variables (when _RS expands to real*4):
                0015 C     ADREAD/ADWRITE handles this case properly as in F77 only addresses
                0016 C     are passed to the subroutine. The size-parameter determines
                0017 C     correctly how the passed array var is passed to
                0018 C     MDS_READ/WRITE_TAPE. Some compiler/flag combinations that check
                0019 C     for subroutine argument consistency will complain about a real*4
                0020 C     array being passed to a real*8 array, but this can be avoided by
                0021 C     adding this file to the list of NOOPTFILES with appropriate
                0022 C     NOOPTFLAGS in the build-options file.
80818af392 Jean*0023 C
3b6c79e4de Mart*0024 C     The following input variables are used throughout in the argument
80818af392 Jean*0025 C     lists:
                0026 C
                0027 C     name   -  character
                0028 C                 On entry, name is the extended tape name.
                0029 C     len    -  integer
                0030 C                 On entry, len is the number of characters in name.
                0031 C     tid    -  integer
                0032 C                 On entry, tid identifies the tape.
                0033 C     vid    -  integer
                0034 C                 On entry, vid identifies the variable to be stored on
                0035 C                 the tape.
                0036 C     var    -  real array of dimension length
                0037 C                 On entry, var contains the values to be stored.
                0038 C                           var must not be changed.
                0039 C     size   -  integer
                0040 C                 On entry, size is the size in bytes of the type of
                0041 C                           variable var.
                0042 C     length -  integer
                0043 C                 On entry, length is the dimension of the variable
                0044 C                           stored on the tape.
                0045 C     irec   -  integer
                0046 C                 On entry, irec is the record number to be written.
                0047 C     myThid -  integer
                0048 C                 On entry, myThid is the number of the thread or
                0049 C                           instance of the program.
                0050 C
                0051 C     For further details on this see the TAMC Users Manual, Appendix B,
                0052 C     User defined Storage Subroutines.
                0053 C
7855a13227 Mart*0054 C     TAF does not provide the leading argument myThid when compiling
                0055 C     the MITgcmUV code. Instead there is a sed script available that
                0056 C     changes the TAF-generated adjoint code.
80818af392 Jean*0057 C
                0058 C     Only the master thread is allowed to write data and only gobal
                0059 C     model arrays are allowed to be written be the subsequent routines.
                0060 C     Tiled data are to be stored in common blocks. This implies that at
                0061 C     least a two level checkpointing for the adjoint code has to be
                0062 C     available.
                0063 C
                0064 C     ==================================================================
2dcaa8b9a5 Patr*0065
d151781088 Patr*0066 CBOP
7855a13227 Mart*0067 C     !ROUTINE: ADREAD
d151781088 Patr*0068 C     !INTERFACE:
80818af392 Jean*0069       SUBROUTINE ADREAD(
                0070      I                   myThid,
2dcaa8b9a5 Patr*0071      I                   name,
                0072      I                   len,
                0073      I                   tid,
                0074      I                   vid,
                0075      O                   var,
                0076      I                   size,
                0077      I                   length,
3b6c79e4de Mart*0078      I                   irec )
2dcaa8b9a5 Patr*0079
d151781088 Patr*0080 C     !DESCRIPTION: \bv
80818af392 Jean*0081 C     ==================================================================
                0082 C     SUBROUTINE adread
                0083 C     ==================================================================
                0084 C     o Read direct access file.
                0085 C     A call to this routine implies an open-read-close sequence
7855a13227 Mart*0086 C     since it uses the MITgcmUV i/o routine MDS_READ_TAPE. Only
80818af392 Jean*0087 C     the master thread reads the data. Otherwise each thread would
                0088 C     read from file.
                0089 C     started: Christian Eckert eckert@mit.edu 30-Jun-1999
                0090 C     ==================================================================
                0091 C     SUBROUTINE adread
                0092 C     ==================================================================
d151781088 Patr*0093 C     \ev
2dcaa8b9a5 Patr*0094
d151781088 Patr*0095 C     !USES:
80818af392 Jean*0096       IMPLICIT NONE
2dcaa8b9a5 Patr*0097
80818af392 Jean*0098 C     == global variables ==
2dcaa8b9a5 Patr*0099 #include "EEPARAMS.h"
                0100 #include "SIZE.h"
b76df2dc75 Patr*0101 #include "PARAMS.h"
7855a13227 Mart*0102 #ifdef ALLOW_CTRL
5cf4364659 Mart*0103 # include "CTRL_SIZE.h"
4d72283393 Mart*0104 # include "CTRL.h"
65754df434 Mart*0105 # include "OPTIMCYCLE.h"
7855a13227 Mart*0106 #endif
                0107 C- OpenAD: this header is not converted to a module --> go after the others
2f58e54336 Gael*0108 #include "AUTODIFF.h"
2dcaa8b9a5 Patr*0109
d151781088 Patr*0110 C     !INPUT/OUTPUT PARAMETERS:
3b6c79e4de Mart*0111 C     myThid :: number of the thread or instance of the program.
c55bfc268c Jean*0112 C     name   :: extended tape name.
                0113 C     len    :: number of characters in name.
                0114 C     tid    :: tape identifier.
                0115 C     vid    :: identifies the variable to be stored on tape.
                0116 C     var    :: values to be stored.
                0117 C     size   :: size in bytes of the type of variable var.
                0118 C     length :: dimension of the variable stored on the tape.
                0119 C     irec   :: record number to be written.
80818af392 Jean*0120       INTEGER myThid
                0121       CHARACTER*(*) name
                0122       INTEGER len
                0123       INTEGER tid
                0124       INTEGER vid
3b6c79e4de Mart*0125       real*8  var(*)
80818af392 Jean*0126       INTEGER size
                0127       INTEGER length
                0128       INTEGER irec
2dcaa8b9a5 Patr*0129
c55bfc268c Jean*0130 C     !FUNCTIONS:
                0131       INTEGER  ILNBLNK
                0132       EXTERNAL ILNBLNK
                0133
d151781088 Patr*0134 C     !LOCAL VARIABLES:
80818af392 Jean*0135       CHARACTER*(MAX_LEN_FNAM) fname
                0136       CHARACTER*(MAX_LEN_MBUF) msgBuf
                0137       INTEGER filePrec
                0138       INTEGER il, jl, lenLoc
c55bfc268c Jean*0139       real*8  dummyR8(1)
                0140       real*4  dummyR4(1)
9105dbec95 Jean*0141       LOGICAL useWHTapeIO
d151e07a73 Mart*0142 #ifdef ALLOW_AUTODIFF_WHTAPEIO
80818af392 Jean*0143       INTEGER n2d,length2d, jrec, i2d, j2d
d151e07a73 Mart*0144 #endif
d151781088 Patr*0145 CEOP
2dcaa8b9a5 Patr*0146
b90aba42f8 Patr*0147 #ifdef ALLOW_DEBUG
862d160a2f Jean*0148       IF ( debugMode ) CALL DEBUG_ENTER('ADREAD',myThid)
b90aba42f8 Patr*0149 #endif
516917913e Patr*0150
80818af392 Jean*0151 C--   default is to write tape-files of same precision as array:
                0152 C     convert bytes to file-prec
                0153       filePrec = 8*size
516917913e Patr*0154       IF ( doSinglePrecTapelev ) THEN
c55bfc268c Jean*0155        filePrec = precFloat32
516917913e Patr*0156       ENDIF
b90aba42f8 Patr*0157
9105dbec95 Jean*0158       useWHTapeIO = .FALSE.
d151e07a73 Mart*0159 #ifdef ALLOW_AUTODIFF_WHTAPEIO
9105dbec95 Jean*0160 C    determine number of 2d fields
                0161       length2d = (sNx+2*OLx)*(sNy+2*OLy)*nSx*nSy
                0162       n2d = INT(length/length2d)
                0163       IF ( size.EQ.8 .AND. n2d*length2d.EQ.length ) THEN
                0164 C-    only use "WHTAPEIO" when type and length match
                0165         useWHTapeIO = .TRUE.
80818af392 Jean*0166       ENDIF
d151e07a73 Mart*0167 #endif /* ALLOW_AUTODIFF_WHTAPEIO */
9105dbec95 Jean*0168
                0169       il = ILNBLNK( name )
                0170       jl = ILNBLNK( adTapeDir )
                0171       IF ( useWHTapeIO ) THEN
                0172         lenLoc = il+jl
                0173         WRITE(fname,'(2A)') adTapeDir(1:jl),name(1:il)
                0174       ELSE
                0175         lenLoc = il+jl+7
                0176         WRITE(fname,'(3A,I4.4)')
                0177      &     adTapeDir(1:jl),name(1:il),'.it',optimcycle
                0178       ENDIF
c55bfc268c Jean*0179 #ifdef ALLOW_DEBUG
                0180       IF ( debugLevel.GE.debLevC ) THEN
                0181         WRITE(msgBuf,'(2A,3I6,I9,2I3,2A)') 'ADREAD: ',
                0182      &    ' tid,vid, irec, length, prec(x2)=', tid, vid, irec,
                0183      &      length, size, filePrec, ' fname=', fname(1:lenLoc)
                0184         CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0185      &                      SQUEEZE_RIGHT, myThid )
                0186       ENDIF
                0187 #endif
d151e07a73 Mart*0188
e33827a95a Gael*0189 #ifdef ALLOW_AUTODIFF_WHTAPEIO
9105dbec95 Jean*0190       IF ( useWHTapeIO ) THEN
80818af392 Jean*0191
7855a13227 Mart*0192 cc      IF (n2d*length2d.EQ.length) THEN
80818af392 Jean*0193         DO i2d=1,n2d
7855a13227 Mart*0194           IF (tapeFileUnit.EQ.0) THEN
2f58e54336 Gael*0195             jrec=irec
7855a13227 Mart*0196           ELSE
2f58e54336 Gael*0197             tapeFileCounter=tapeFileCounter+1
                0198             jrec=tapeFileCounter+tapeMaxCounter*(irec-1)
7855a13227 Mart*0199             IF (tapeFileCounter.GT.tapeMaxCounter) THEN
                0200               WRITE(msgBuf,'(A,2I5)')
                0201      &              'ADREAD: tapeFileCounter > tapeMaxCounter ',
                0202      &              tapeFileCounter, tapeMaxCounter
                0203               CALL PRINT_ERROR( msgBuf, myThid )
                0204               WRITE(msgBuf,'(2A)') 'for file ', fname(1:lenLoc)
                0205               CALL PRINT_ERROR( msgBuf, myThid )
                0206               STOP 'ABNORMAL END: S/R ADREAD'
                0207             ENDIF
                0208           ENDIF
2f58e54336 Gael*0209           j2d=(i2d-1)*length2d+1
7855a13227 Mart*0210           CALL MDS_READ_WHALOS(fname,lenLoc,filePrec,tapeFileUnit,
80818af392 Jean*0211      &      1,var(j2d),jrec,tapeSingleCpuIO,tapeBufferIO,myThid)
                0212         ENDDO
7855a13227 Mart*0213 cc      ELSE
                0214 C     The other case actually does not (and should not) occur within the
                0215 C     main loop, where we only store global arrays (i.e. with i,j,bi,bj
3b6c79e4de Mart*0216 C     indices) to disk. At init and final time it is always possible to
                0217 C     recompute or store in memory without much trouble or computational
                0218 C     cost.
6322f3ee50 Patr*0219 cc         WRITE(msgBuf,'(3A)')
3c775cbf98 Mart*0220 cc     &        'ADREAD: ', name, ' was not saved to tape.'
6322f3ee50 Patr*0221 cc         CALL PRINT_ERROR( msgBuf, myThid )
3c775cbf98 Mart*0222 cc         STOP 'ABNORMAL END: S/R ADREAD'
7855a13227 Mart*0223 cc      ENDIF
862d160a2f Jean*0224
9105dbec95 Jean*0225       ELSE
e33827a95a Gael*0226 #else
9105dbec95 Jean*0227       IF ( .TRUE. ) THEN
e33827a95a Gael*0228 #endif /* ALLOW_AUTODIFF_WHTAPEIO */
                0229
9105dbec95 Jean*0230         _BEGIN_MASTER( myThid )
                0231          IF ( size.EQ.4 ) THEN
                0232 c          CALL MDSREADVECTOR( fname, filePrec, 'RS',
                0233 c    &                         length, var, 1, 1, irec, myThid )
                0234            CALL MDS_READ_TAPE( fname, filePrec, 'R4',
                0235      &                         length, dummyR8, var,
                0236      &                         useSingleCpuIO, irec, myThid )
                0237          ELSE
                0238 c          CALL MDSREADVECTOR( fname, filePrec, 'RL',
                0239 c    &                         length, var, 1, 1, irec, myThid )
                0240            CALL MDS_READ_TAPE( fname, filePrec, 'R8',
                0241      &                         length,  var, dummyR4,
                0242      &                         useSingleCpuIO, irec, myThid )
                0243          ENDIF
                0244         _END_MASTER( myThid )
                0245
                0246 C     end if useWHTapeIO / else
                0247       ENDIF
                0248
80818af392 Jean*0249 C     Everyone must wait for the read operation to be completed.
c55bfc268c Jean*0250 c     _BARRIER
2dcaa8b9a5 Patr*0251
b90aba42f8 Patr*0252 #ifdef ALLOW_DEBUG
862d160a2f Jean*0253       IF ( debugMode ) CALL DEBUG_LEAVE('ADREAD',myThid)
b90aba42f8 Patr*0254 #endif
                0255
80818af392 Jean*0256       RETURN
                0257       END
2dcaa8b9a5 Patr*0258
80818af392 Jean*0259 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
d151781088 Patr*0260 CBOP
7855a13227 Mart*0261 C     !ROUTINE: ADWRITE
d151781088 Patr*0262 C     !INTERFACE:
80818af392 Jean*0263       SUBROUTINE ADWRITE(
                0264      I                    myThid,
2dcaa8b9a5 Patr*0265      I                    name,
                0266      I                    len,
                0267      I                    tid,
                0268      I                    vid,
                0269      I                    var,
                0270      I                    size,
                0271      I                    length,
3b6c79e4de Mart*0272      I                    irec )
2dcaa8b9a5 Patr*0273
d151781088 Patr*0274 C     !DESCRIPTION: \bv
80818af392 Jean*0275 C     ==================================================================
                0276 C     SUBROUTINE adwrite
                0277 C     ==================================================================
                0278 C     o Write to direct access file.
                0279 C     A call to this routine implies an open-read-close sequence
7855a13227 Mart*0280 C     since it uses the MITgcmUV i/o routine MDS_WRITE_TAPE. Only
80818af392 Jean*0281 C     the master thread writes the data. Otherwise each thread would
                0282 C     write to file. This would result in an excessive waste of
                0283 C     disk space.
                0284 C     started: Christian Eckert eckert@mit.edu 30-Jun-1999
                0285 C     ==================================================================
                0286 C     SUBROUTINE adwrite
                0287 C     ==================================================================
d151781088 Patr*0288 C     \ev
2dcaa8b9a5 Patr*0289
d151781088 Patr*0290 C     !USES:
80818af392 Jean*0291       IMPLICIT NONE
2dcaa8b9a5 Patr*0292
80818af392 Jean*0293 C     == global variables ==
2dcaa8b9a5 Patr*0294 #include "EEPARAMS.h"
                0295 #include "SIZE.h"
b76df2dc75 Patr*0296 #include "PARAMS.h"
7855a13227 Mart*0297 #ifdef ALLOW_CTRL
5cf4364659 Mart*0298 # include "CTRL_SIZE.h"
4d72283393 Mart*0299 # include "CTRL.h"
65754df434 Mart*0300 # include "OPTIMCYCLE.h"
7855a13227 Mart*0301 #endif
                0302 C- OpenAD: this header is not converted to a module --> go after the others
2f58e54336 Gael*0303 #include "AUTODIFF.h"
2dcaa8b9a5 Patr*0304
d151781088 Patr*0305 C     !INPUT/OUTPUT PARAMETERS:
3b6c79e4de Mart*0306 C     myThid :: number of the thread or instance of the program.
c55bfc268c Jean*0307 C     name   :: extended tape name.
                0308 C     len    :: number of characters in name.
                0309 C     tid    :: tape identifier.
                0310 C     vid    :: identifies the variable to be stored on tape.
                0311 C     var    :: values to be stored.
                0312 C     size   :: size in bytes of the type of variable var.
                0313 C     length :: dimension of the variable stored on the tape.
                0314 C     irec   :: record number to be written.
80818af392 Jean*0315       INTEGER myThid
                0316       CHARACTER*(*) name
                0317       INTEGER len
                0318       INTEGER tid
                0319       INTEGER vid
3b6c79e4de Mart*0320       real*8  var(*)
80818af392 Jean*0321       INTEGER size
                0322       INTEGER length
                0323       INTEGER irec
2dcaa8b9a5 Patr*0324
c55bfc268c Jean*0325 C     !FUNCTIONS:
                0326       INTEGER ILNBLNK
                0327       EXTERNAL ILNBLNK
                0328
d151781088 Patr*0329 C     !LOCAL VARIABLES:
80818af392 Jean*0330       CHARACTER*(MAX_LEN_FNAM) fname
                0331       CHARACTER*(MAX_LEN_MBUF) msgBuf
                0332       INTEGER filePrec
                0333       INTEGER il,jl,lenLoc
c55bfc268c Jean*0334       real*8  dummyR8(1)
                0335       real*4  dummyR4(1)
9105dbec95 Jean*0336       LOGICAL useWHTapeIO
c55bfc268c Jean*0337       LOGICAL globalfile
d151e07a73 Mart*0338 #ifdef ALLOW_AUTODIFF_WHTAPEIO
80818af392 Jean*0339       INTEGER n2d,length2d, jrec, i2d, j2d
d151e07a73 Mart*0340 #endif
d151781088 Patr*0341 CEOP
2dcaa8b9a5 Patr*0342
b90aba42f8 Patr*0343 #ifdef ALLOW_DEBUG
862d160a2f Jean*0344       IF ( debugMode ) CALL DEBUG_ENTER('ADWRITE',myThid)
b90aba42f8 Patr*0345 #endif
                0346
80818af392 Jean*0347 C--   default is to write tape-files of same precision as array:
                0348 C     convert bytes to file-prec
                0349       filePrec = 8*size
516917913e Patr*0350       IF ( doSinglePrecTapelev ) THEN
c55bfc268c Jean*0351        filePrec = precFloat32
516917913e Patr*0352       ENDIF
                0353
9105dbec95 Jean*0354       useWHTapeIO = .FALSE.
d151e07a73 Mart*0355 #ifdef ALLOW_AUTODIFF_WHTAPEIO
9105dbec95 Jean*0356 C    determine number of 2d fields
                0357       length2d = (sNx+2*OLx)*(sNy+2*OLy)*nSx*nSy
                0358       n2d = INT(length/length2d)
                0359       IF ( size.EQ.8 .AND. n2d*length2d.EQ.length ) THEN
                0360 C-    only use "WHTAPEIO" when type and length match
                0361         useWHTapeIO = .TRUE.
80818af392 Jean*0362       ENDIF
d151e07a73 Mart*0363 #endif /* ALLOW_AUTODIFF_WHTAPEIO */
9105dbec95 Jean*0364
                0365       il = ILNBLNK( name )
                0366       jl = ILNBLNK( adTapeDir )
                0367       IF ( useWHTapeIO ) THEN
                0368         lenLoc = il+jl
                0369         WRITE(fname,'(2A)') adTapeDir(1:jl),name(1:il)
                0370       ELSE
                0371         lenLoc = il+jl+7
                0372         WRITE(fname,'(3A,I4.4)')
                0373      &     adTapeDir(1:jl),name(1:il),'.it',optimcycle
                0374       ENDIF
d151e07a73 Mart*0375 #ifdef ALLOW_DEBUG
c55bfc268c Jean*0376       IF ( debugLevel .GE. debLevC ) THEN
                0377         WRITE(msgBuf,'(2A,3I6,I9,2I3,2A)') 'ADWRITE:',
                0378      &    ' tid,vid, irec, length, prec(x2)=', tid, vid, irec,
                0379      &      length, size, filePrec, ' fname=', fname(1:lenLoc)
                0380         CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0381      &                      SQUEEZE_RIGHT, myThid )
                0382       ENDIF
d151e07a73 Mart*0383 #endif
                0384
e33827a95a Gael*0385 #ifdef ALLOW_AUTODIFF_WHTAPEIO
9105dbec95 Jean*0386       IF ( useWHTapeIO ) THEN
80818af392 Jean*0387
7855a13227 Mart*0388 cc      IF (n2d*length2d.EQ.length) THEN
80818af392 Jean*0389         DO i2d=1,n2d
7855a13227 Mart*0390           IF (tapeFileUnit.EQ.0) THEN
2f58e54336 Gael*0391             jrec=irec
7855a13227 Mart*0392           ELSE
3c775cbf98 Mart*0393             tapeFileCounter = tapeFileCounter+1
                0394             jrec = tapeFileCounter+tapeMaxCounter*(irec-1)
                0395             IF ( tapeFileCounter.GT.tapeMaxCounter ) THEN
                0396               WRITE(msgBuf,'(2A,I6,A,I6,A)') 'ADWRITE: ',
                0397      &            'tapeFileCounter (=',tapeFileCounter,
                0398      &            ') > tapeMaxCounter (= nWh =', tapeMaxCounter, ')'
7855a13227 Mart*0399               CALL PRINT_ERROR( msgBuf, myThid )
3c775cbf98 Mart*0400               WRITE(msgBuf,'(3A)') 'ADWRITE: ',
                0401      &            ' for file: ', fname(1:lenLoc)
7855a13227 Mart*0402               CALL PRINT_ERROR( msgBuf, myThid )
3c775cbf98 Mart*0403 C     Here, we cannot determine how many tapeFiles we need, so we print
                0404 C     this rather unspecific instruction.
                0405               WRITE(msgBuf,'(2A)') 'ADWRITE: ',
                0406      &             '==> Need to increase "nWh" in: MDSIO_BUFF_WH.h'
                0407               CALL PRINT_ERROR( msgBuf, myThid )
                0408               WRITE(msgBuf,'(2A)') 'ADWRITE: Tip to find lowest',
                0409      &             ' allowed "nWh": setting debugLevel >= 3'
                0410               CALL PRINT_ERROR( msgBuf , myThid )
                0411               WRITE(msgBuf,'(2A)') 'ADWRITE:  will report ',
                0412      &             '"tapeFileCounter" to STDOUT (can grep for)'
                0413               CALL PRINT_ERROR( msgBuf , myThid )
7855a13227 Mart*0414               STOP 'ABNORMAL END: S/R ADWRITE'
                0415             ENDIF
3c775cbf98 Mart*0416 #ifdef ALLOW_DEBUG
                0417             IF ( debugLevel.GE.debLevC ) THEN
                0418 C     Print tapeFileCounter to help find minimum tapeMaxCounter=nWh value
                0419               WRITE(msgBuf,'(A,I6)') 'ADWRITE:  tapeFileCounter =',
                0420      &            tapeFileCounter
                0421               CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0422      &                      SQUEEZE_RIGHT, myThid )
                0423             ENDIF
                0424 #endif
7855a13227 Mart*0425           ENDIF
2f58e54336 Gael*0426           j2d=(i2d-1)*length2d+1
7855a13227 Mart*0427           CALL MDS_WRITE_WHALOS(fname,lenLoc,filePrec,tapeFileUnit,
80818af392 Jean*0428      &      1,var(j2d),jrec,tapeSingleCpuIO,tapeBufferIO,myThid)
                0429         ENDDO
7855a13227 Mart*0430 cc      ELSE
                0431 cc       WRITE(msgBuf,'(3A)')
6322f3ee50 Patr*0432 cc     &      'ADWRITE: ',fname(1:lenLoc),'was not read from tape.'
7855a13227 Mart*0433 cc       CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
6322f3ee50 Patr*0434 cc     &                     SQUEEZE_RIGHT , myThid)
7855a13227 Mart*0435 cc      ENDIF
e33827a95a Gael*0436
9105dbec95 Jean*0437       ELSE
e33827a95a Gael*0438 #else
9105dbec95 Jean*0439       IF ( .TRUE. ) THEN
e33827a95a Gael*0440 #endif /* ALLOW_AUTODIFF_WHTAPEIO */
                0441
9105dbec95 Jean*0442         globalfile = globalFiles
                0443 c       globalfile = .FALSE.
                0444
                0445         _BEGIN_MASTER( myThid )
                0446         IF ( size.EQ.4 ) THEN
                0447 c         CALL MDSWRITEVECTOR( fname, filePrec, globalfile, 'RS',
                0448 c    &                         length, var, 1, 1, irec, 0, myThid )
                0449           CALL MDS_WRITE_TAPE( fname, filePrec, globalfile, 'R4',
                0450      &                         length, dummyR8, var,
                0451      &                         useSingleCpuIO, irec, 0, myThid )
                0452         ELSE
                0453 c         CALL MDSWRITEVECTOR( fname, filePrec, globalfile, 'RL',
                0454 c    &                         length, var, 1, 1, irec, 0, myThid )
                0455           CALL MDS_WRITE_TAPE( fname, filePrec, globalfile, 'R8',
                0456      &                         length, var, dummyR4,
                0457      &                         useSingleCpuIO, irec, 0, myThid )
                0458         ENDIF
                0459         _END_MASTER( myThid )
                0460
                0461 C     end if useWHTapeIO / else
                0462       ENDIF
                0463
80818af392 Jean*0464 C     Everyone must wait for the write operation to be completed.
c55bfc268c Jean*0465 c     _BARRIER
2dcaa8b9a5 Patr*0466
b90aba42f8 Patr*0467 #ifdef ALLOW_DEBUG
862d160a2f Jean*0468       IF ( debugMode ) CALL DEBUG_LEAVE('ADWRITE',myThid)
b90aba42f8 Patr*0469 #endif
                0470
80818af392 Jean*0471       RETURN
                0472       END