File indexing completed on 2024-03-02 06:10:11 UTC
view on githubraw file Latest commit 5cf43646 on 2024-03-01 18:50:49 UTC
2f58e54336 Gael*0001 #include "AUTODIFF_OPTIONS.h"
ab63ca39fb Gael*0002 #include "MDSIO_OPTIONS.h"
38322a9150 Jean*0003 #ifdef ALLOW_CTRL
0004 # include "CTRL_OPTIONS.h"
0005 #endif
2f58e54336 Gael*0006
910e5c3e29 Mart*0007
0008
0009
0010
0011 SUBROUTINE AUTODIFF_WHTAPEIO_SYNC(
0012 I myLev, myStep, myThid )
0013
0014
0015
0016
0017
0018
0019
0020
0021
2f58e54336 Gael*0022 IMPLICIT NONE
0023
0024 #include "SIZE.h"
0025 #include "EEPARAMS.h"
0026 #include "PARAMS.h"
5cf4364659 Mart*0027 #include "CTRL_SIZE.h"
4d72283393 Mart*0028 #include "CTRL.h"
38322a9150 Jean*0029 #ifndef ALLOW_OPENAD
df0255c333 Jean*0030 # include "AUTODIFF.h"
0031 #endif
ab63ca39fb Gael*0032 #ifdef ALLOW_WHIO_3D
7c50f07931 Mart*0033 # ifdef ALLOW_AUTODIFF_TAMC
0034 # include "tamc.h"
0035 # endif
df0255c333 Jean*0036 # include "MDSIO_BUFF_WH.h"
ab63ca39fb Gael*0037 #endif
2f58e54336 Gael*0038
910e5c3e29 Mart*0039
0040
0041
0042
0043
0044 INTEGER myLev
0045 INTEGER myStep
0046 INTEGER myThid
2f58e54336 Gael*0047
0048 #ifdef ALLOW_AUTODIFF_WHTAPEIO
0049
910e5c3e29 Mart*0050
0051 INTEGER ILNBLNK
0052 INTEGER MDS_RECLEN
0053 EXTERNAL ILNBLNK
0054 EXTERNAL MDS_RECLEN
0055
0056
0057 CHARACTER*(MAX_LEN_FNAM) fName
0058 INTEGER filePrec, IL, length_of_rec
2f58e54336 Gael*0059 LOGICAL iAmDoingIO
0060
0061
0062
0063
0064
0065 INTEGER sNxWh
0066 INTEGER sNyWh
0067 INTEGER procNyWh
0068 INTEGER gloNyWh
910e5c3e29 Mart*0069 PARAMETER ( sNxWh = sNx+2*OLx )
0070 PARAMETER ( sNyWh = sNy+2*OLy )
2f58e54336 Gael*0071 PARAMETER ( procNyWh = sNyWh*nSy*nSx )
0072 PARAMETER ( gloNyWh = procNyWh*nPy*nPx )
b486730967 Gael*0073 logical exst
0074 #ifdef ALLOW_WHIO_3D
910e5c3e29 Mart*0075 CHARACTER*(MAX_LEN_MBUF) msgBuf
b486730967 Gael*0076 #endif
910e5c3e29 Mart*0077
2f58e54336 Gael*0078
ec9dec43dc Gael*0079 IF ( .NOT.useAUTODIFF ) THEN
910e5c3e29 Mart*0080 RETURN
ec9dec43dc Gael*0081 ENDIF
0082
2f58e54336 Gael*0083 IF ( tapeConcatIO ) THEN
0084
910e5c3e29 Mart*0085 IF ( doSinglePrecTapelev ) THEN
0086 filePrec = 32
0087 ELSE
0088 filePrec = 64
0089 ENDIF
2f58e54336 Gael*0090
0091
910e5c3e29 Mart*0092 iAmDoingIO = .FALSE.
0093 IF ( .NOT.tapeSingleCpuIO .OR. myProcId.EQ.0 ) THEN
2f58e54336 Gael*0094 _BEGIN_MASTER( myThid )
0095 iAmDoingIO = .TRUE.
0096 _END_MASTER( myThid )
910e5c3e29 Mart*0097 ENDIF
59e0adf4a5 Gael*0098
910e5c3e29 Mart*0099 IF ( iAmDoingIO ) THEN
59e0adf4a5 Gael*0100 IL = ilnblnk( adTapeDir )
2f58e54336 Gael*0101 IF ( .NOT.tapeSingleCpuIO ) THEN
910e5c3e29 Mart*0102 WRITE(fName,'(2A,I1.1,A,I3.3,A)')
59e0adf4a5 Gael*0103 & adTapeDir(1:IL),'tapes',myLev,'.',myProcId,'.data'
910e5c3e29 Mart*0104 length_of_rec = MDS_RECLEN( filePrec,sNxWh*procNyWh,myThid )
2f58e54336 Gael*0105 ELSE
910e5c3e29 Mart*0106 WRITE(fName,'(2A,I1.1,A)')
59e0adf4a5 Gael*0107 & adTapeDir(1:IL),'tapes',myLev,'.data'
910e5c3e29 Mart*0108 length_of_rec = MDS_RECLEN( filePrec,sNxWh*gloNyWh,myThid)
2f58e54336 Gael*0109 ENDIF
910e5c3e29 Mart*0110 ENDIF
ab63ca39fb Gael*0111 #ifdef ALLOW_WHIO_3D
910e5c3e29 Mart*0112 length_of_rec=length_of_rec*nWh
ab63ca39fb Gael*0113 #endif
2f58e54336 Gael*0114
910e5c3e29 Mart*0115 tapeFileUnit=tapeFileUnitS(myLev)
0116 tapeFileCounter=0
2f58e54336 Gael*0117
910e5c3e29 Mart*0118 IF ( iAmDoingIO.AND.(myStep.EQ.0).AND.
0119 & (myLev.GT.0).AND.(tapeFileUnit.EQ.0) ) THEN
b486730967 Gael*0120 inquire( file=fName, exist=exst )
ddd663a9a8 Gael*0121 #ifdef AUTODIFF_USE_MDSFINDUNITS
abca2c0b86 Gael*0122 CALL MDSFINDUNIT( tapeFileUnit, myThid )
0123 #else
ddd663a9a8 Gael*0124 CALL AUTODIFF_FINDUNIT( tapeFileUnit, myThid )
abca2c0b86 Gael*0125 #endif
2f58e54336 Gael*0126 OPEN( tapeFileUnit, file=fName, status='unknown',
0127 & access='direct', recl=length_of_rec )
0128 tapeFileUnitS(myLev)=tapeFileUnit
98e3baf5ed Gael*0129 #if (defined (ALLOW_INIT_WHTAPEIO) && defined (ALLOW_WHIO_3D))
b486730967 Gael*0130
0131 IF (.NOT.exst) then
910e5c3e29 Mart*0132 iWh=tapeMaxCounter*MAX(nchklev_2,nchklev_3)/nWh+1
0133 WRITE(msgBuf,'(a,i1,a,i3)') 'whio : create lev ',
0134 & myLev,' rec ',iWh
0135 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
0136 & SQUEEZE_RIGHT, myThid )
0137 IF ( .NOT.tapeSingleCpuIO ) then
0138 IF (filePrec .EQ. precFloat32) THEN
0139 WRITE(tapeFileUnit,rec=iWh) fld3d_procbuff_r4
98e3baf5ed Gael*0140 ELSE
910e5c3e29 Mart*0141 WRITE(tapeFileUnit,rec=iWh) fld3d_procbuff_r8
0142 ENDIF
0143 ELSE
98e3baf5ed Gael*0144 # ifdef INCLUDE_WHIO_GLOBUFF_3D
910e5c3e29 Mart*0145 IF (filePrec .EQ. precFloat32) THEN
0146 WRITE(tapeFileUnit,rec=iWh) fld3d_globuff_r4
0147 ELSE
0148 WRITE(tapeFileUnit,rec=iWh) fld3d_globuff_r8
98e3baf5ed Gael*0149 ENDIF
910e5c3e29 Mart*0150 # endif
0151 ENDIF
0152 iWh=0
0153 ENDIF
38322a9150 Jean*0154 #endif
910e5c3e29 Mart*0155 ENDIF
2f58e54336 Gael*0156
ab63ca39fb Gael*0157 #ifdef ALLOW_WHIO_3D
910e5c3e29 Mart*0158 _BARRIER
0159 IF ((myStep.EQ.1).AND.iAmDoingIO.AND.
0160 & tapeBufferIO.AND.writeWh) THEN
0161 IF (iWh.LT.1) STOP 'S/R AUTODIFF_WHTAPEIO_SYNC: iWh<1'
0162 WRITE(msgBuf,'(a,i1,a,i3)') 'whio : write lev ',
0163 & myLev,' rec ',iWh
0164 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
0165 & SQUEEZE_RIGHT, myThid )
0166 IF ( .NOT.tapeSingleCpuIO ) then
0167 IF (filePrec .EQ. precFloat32) THEN
0168 WRITE(tapeFileUnit,rec=iWh) fld3d_procbuff_r4
0169 ELSE
0170 WRITE(tapeFileUnit,rec=iWh) fld3d_procbuff_r8
0171 ENDIF
0172 ELSE
ab63ca39fb Gael*0173 # ifdef INCLUDE_WHIO_GLOBUFF_3D
910e5c3e29 Mart*0174 IF (filePrec .EQ. precFloat32) THEN
0175 WRITE(tapeFileUnit,rec=iWh) fld3d_globuff_r4
0176 ELSE
0177 WRITE(tapeFileUnit,rec=iWh) fld3d_globuff_r8
0178 ENDIF
ab63ca39fb Gael*0179 # endif
910e5c3e29 Mart*0180 ENDIF
0181 ENDIF
0182 _BARRIER
ab63ca39fb Gael*0183
910e5c3e29 Mart*0184 IF (myStep.EQ.0) THEN
ab63ca39fb Gael*0185 tapeBufferIO=.TRUE.
910e5c3e29 Mart*0186 ELSE
ab63ca39fb Gael*0187 tapeBufferIO=.FALSE.
0188 writeWh=.FALSE.
910e5c3e29 Mart*0189 ENDIF
0190 iWh=0
0191 jWh=0
ab63ca39fb Gael*0192 #endif /* ALLOW_WHIO_3D */
0193
2f58e54336 Gael*0194 ENDIF
0195
0196 #endif /* ALLOW_AUTODIFF_WHTAPEIO */
0197
910e5c3e29 Mart*0198 RETURN
0199 END