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