Back to home page

MITgcm
 
 

    

File indexing completed on 2022-04-14 05:09:28 UTC

view on githubraw file Latest commit 3d93c0a0 on 2022-04-13 15:21:38 UTC
d7fbd5d0c9 Gael*0001 #include "MDSIO_OPTIONS.h"
                0002 
                0003 CBOP
9f5240b52a Jean*0004 C     !ROUTINE: MDS_READ_WHALOS
d7fbd5d0c9 Gael*0005 C     !INTERFACE:
9f5240b52a Jean*0006       SUBROUTINE MDS_READ_WHALOS(
d7fbd5d0c9 Gael*0007      I                   fName,
                0008      I                   len,
                0009      I                   filePrec,
                0010      I                   fid,
                0011      I                   n2d,
                0012      O                   fldRL,
                0013      I                   irec,
9231496966 Gael*0014      I                   locSingleCPUIO,
ab63ca39fb Gael*0015      I                   locBufferIO,
9f5240b52a Jean*0016      I                   myThid )
d7fbd5d0c9 Gael*0017 
                0018 C     !DESCRIPTION: \bv
9f5240b52a Jean*0019 C     ==================================================================
                0020 C     SUBROUTINE MDS_READ_WHALOS
                0021 C     o Read file that includes halos. The main purpose is for
                0022 C       adjoint related "tape I/O". The secondary purpose is debugging.
                0023 C     ==================================================================
d7fbd5d0c9 Gael*0024 C     \ev
                0025 
                0026 C     !USES:
9f5240b52a Jean*0027       IMPLICIT NONE
d7fbd5d0c9 Gael*0028 
9f5240b52a Jean*0029 C     == global variables ==
d7fbd5d0c9 Gael*0030 #include "EEPARAMS.h"
                0031 #include "SIZE.h"
                0032 #include "PARAMS.h"
                0033 #ifdef ALLOW_WHIO
                0034 #include "MDSIO_BUFF_WH.h"
                0035 #endif
                0036 
                0037 C     !INPUT/OUTPUT PARAMETERS:
9f5240b52a Jean*0038 C     fName    ::  extended tape fName.
                0039 C     len      ::  number of characters in fName.
                0040 C     filePrec ::  number of bits per word in file (32 or 64).
                0041 C     fid      ::  file unit (its use is not implemented yet).
                0042 C     n2d      ::  size of the fldRL third dimension.
                0043 C     fldRL    ::  array to read.
                0044 C     irec     ::  record number to be written.
                0045 C     myThid   ::  my Thread Id number
                0046       CHARACTER*(*) fName
                0047       INTEGER len
                0048       INTEGER filePrec
                0049       INTEGER fid
                0050       INTEGER n2d
                0051       _RL     fldRL(1-OLx:sNx+OLx,1-OLy:sNy+OLy,n2d,nSx,nSy)
                0052       INTEGER irec
                0053       LOGICAL locSingleCPUIO, locBufferIO
                0054       INTEGER myThid
d7fbd5d0c9 Gael*0055 
                0056 #ifdef ALLOW_WHIO
9f5240b52a Jean*0057 C     !FUNCTIONS:
                0058       INTEGER  ILNBLNK
                0059       INTEGER  MDS_RECLEN
                0060       EXTERNAL ILNBLNK
                0061       EXTERNAL MDS_RECLEN
d7fbd5d0c9 Gael*0062 
9f5240b52a Jean*0063 C     !LOCAL VARIABLES:
                0064 C     == local parameters ==
                0065 C     sNxWh   :: x tile size with halo included
                0066 C     sNyWh   :: y tile size with halo included
d7fbd5d0c9 Gael*0067 C     pocNyWh :: processor sum of sNyWh
                0068 C     gloNyWh :: global sum of sNyWh
                0069       INTEGER sNxWh
                0070       INTEGER sNyWh
                0071       INTEGER procNyWh
                0072       INTEGER gloNyWh
9f5240b52a Jean*0073       PARAMETER ( sNxWh = sNx+2*OLx )
                0074       PARAMETER ( sNyWh = sNy+2*OLy )
d7fbd5d0c9 Gael*0075       PARAMETER ( procNyWh = sNyWh*nSy*nSx )
                0076       PARAMETER ( gloNyWh = procNyWh*nPy*nPx )
9f5240b52a Jean*0077 C     == local variables ==
                0078       CHARACTER*(MAX_LEN_FNAM) pfName
                0079       INTEGER IL
                0080       INTEGER lengthBuff, length_of_rec
                0081       INTEGER i, j, i2d
                0082       INTEGER dUnit, irec2d
d7fbd5d0c9 Gael*0083       LOGICAL iAmDoingIO
01e0ec14d7 Jean*0084 #ifdef ALLOW_WHIO_3D
                0085       INTEGER js
                0086 #endif
8cec14c3de Patr*0087 #ifdef INTEL_COMMITQQ
9f5240b52a Jean*0088 Cph   Fix on Pleiades following model crashes on disk /nobackupnfs2/
                0089 Cph   reported by Yoshihiro.Nakayama@jpl.nasa.gov
                0090 Cph forrtl: Device or resource busy
                0091 Cph forrtl: severe (39): error during read, unit 1001, file
                0092 Cph   Workaround by NAS engineer Sherry.Chang@nasa.gov
                0093       LOGICAL results, commitqq
8cec14c3de Patr*0094 #endif
9f5240b52a Jean*0095 CEOP
d7fbd5d0c9 Gael*0096 
ab63ca39fb Gael*0097 #ifdef ALLOW_WHIO_3D
                0098       writeWh=.FALSE.
                0099 #endif
d7fbd5d0c9 Gael*0100 
9f5240b52a Jean*0101       IF ( .NOT.locSingleCpuIO ) THEN
ab63ca39fb Gael*0102         lengthBuff=sNxWh*procNyWh
                0103       ELSE
                0104         lengthBuff=sNxWh*gloNyWh
                0105       ENDIF
1d8c557c39 Jean*0106 
9231496966 Gael*0107 C Only do I/O if I am the master thread (and mpi process 0 IF locSingleCpuIO):
                0108       iAmDoingIO = .FALSE.
                0109       IF ( .NOT.locSingleCpuIO .OR. myProcId.EQ.0 ) THEN
                0110         _BEGIN_MASTER( myThid )
                0111         iAmDoingIO = .TRUE.
                0112         _END_MASTER( myThid )
1d8c557c39 Jean*0113       ENDIF
9231496966 Gael*0114 
d7fbd5d0c9 Gael*0115       IF ( iAmDoingIO ) THEN
9f5240b52a Jean*0116 C get the unit and open file
d7fbd5d0c9 Gael*0117       IL  = ILNBLNK( fName )
9231496966 Gael*0118       IF ( .NOT.locSingleCpuIO ) THEN
                0119         WRITE(pfName,'(2A,I3.3,A)') fName(1:IL),'.',myProcId,'.data'
d7fbd5d0c9 Gael*0120         length_of_rec = MDS_RECLEN( filePrec,sNxWh*procNyWh, myThid )
                0121       ELSE
9231496966 Gael*0122         WRITE(pfName,'(2A)') fName(1:IL),'.data'
d7fbd5d0c9 Gael*0123         length_of_rec = MDS_RECLEN( filePrec,sNxWh*gloNyWh,myThid)
                0124       ENDIF
9231496966 Gael*0125       IF (fid.EQ.0) THEN
                0126         CALL MDSFINDUNIT( dUnit, myThid )
3d93c0a01e Ou W*0127         OPEN( dUnit, file=pfName, status='old', _READONLY_ACTION
                0128      &        access='direct', recl=length_of_rec )
9231496966 Gael*0129       ELSE
                0130         dUnit=fid
1d8c557c39 Jean*0131       ENDIF
d7fbd5d0c9 Gael*0132       ENDIF
                0133 
8cec14c3de Patr*0134 #ifdef INTEL_COMMITQQ
01e0ec14d7 Jean*0135 Cph   NAS Pleiades fix here:
8cec14c3de Patr*0136       results = commitqq(dUnit)
                0137 #endif
d7fbd5d0c9 Gael*0138 
9f5240b52a Jean*0139       DO i2d=1,n2d
d7fbd5d0c9 Gael*0140 
                0141         _BARRIER
ab63ca39fb Gael*0142 #ifdef ALLOW_WHIO_3D
                0143         IF ( iAmDoingIO.AND.locBufferIO.AND.(fid.NE.0) ) THEN
9f5240b52a Jean*0144 C reset counter if needed
ab63ca39fb Gael*0145           IF (jWh.EQ.nWh) jWh=0
9f5240b52a Jean*0146 C increment counter
ab63ca39fb Gael*0147           jWh=jWh+1
9f5240b52a Jean*0148 C determine current file record
ab63ca39fb Gael*0149           irec2d=i2d+n2d*(irec-1)
                0150           iWh=(irec2d-1)/nWh+1
9f5240b52a Jean*0151 C read new chunk if needed
ab63ca39fb Gael*0152           IF (jWh.EQ.1) THEN
9f5240b52a Jean*0153             IF ( .NOT.locSingleCpuIO ) THEN
ab63ca39fb Gael*0154               IF (filePrec .EQ. precFloat32) THEN
                0155                 READ(dUnit,rec=iWh) fld3d_procbuff_r4
                0156               ELSE
                0157                 READ(dUnit,rec=iWh) fld3d_procbuff_r8
                0158               ENDIF
                0159             ELSE
                0160 #  ifdef INCLUDE_WHIO_GLOBUFF_3D
                0161               IF (filePrec .EQ. precFloat32) THEN
                0162                 READ(dUnit,rec=iWh) fld3d_globuff_r4
                0163               ELSE
                0164                 READ(dUnit,rec=iWh) fld3d_globuff_r8
                0165               ENDIF
                0166 #  endif
                0167             ENDIF
                0168           ENDIF
9f5240b52a Jean*0169 C copy
01e0ec14d7 Jean*0170           js = (jWh-1)*lengthBuff
                0171           IF ( .NOT.locSingleCpuIO ) THEN
                0172             IF (filePrec .EQ. precFloat32) THEN
                0173               DO i=1,lengthBuff
                0174                 j = js + i
                0175                 fld2d_procbuff_r4(i) = fld3d_procbuff_r4(j)
                0176               ENDDO
ab63ca39fb Gael*0177             ELSE
01e0ec14d7 Jean*0178               DO i=1,lengthBuff
                0179                 j = js + i
                0180                 fld2d_procbuff_r8(i) = fld3d_procbuff_r8(j)
                0181               ENDDO
                0182             ENDIF
                0183           ELSE
ab63ca39fb Gael*0184 #  ifdef INCLUDE_WHIO_GLOBUFF_3D
01e0ec14d7 Jean*0185             IF (filePrec .EQ. precFloat32) THEN
                0186               DO i=1,lengthBuff
                0187                 j = js + i
                0188                 fld2d_globuff_r4(i) = fld3d_globuff_r4(j)
                0189               ENDDO
                0190             ELSE
                0191               DO i=1,lengthBuff
                0192                 j = js + i
                0193                 fld2d_globuff_r8(i) = fld3d_globuff_r8(j)
                0194               ENDDO
ab63ca39fb Gael*0195             ENDIF
01e0ec14d7 Jean*0196 #  endif
                0197           ENDIF
ab63ca39fb Gael*0198 
                0199         ELSEIF ( iAmDoingIO ) THEN
01e0ec14d7 Jean*0200 #else /* ALLOW_WHIO_3D */
d7fbd5d0c9 Gael*0201         IF ( iAmDoingIO ) THEN
01e0ec14d7 Jean*0202 #endif /* ALLOW_WHIO_3D */
9231496966 Gael*0203           irec2d=i2d+n2d*(irec-1)
9f5240b52a Jean*0204           IF ( .NOT.locSingleCpuIO ) THEN
d7fbd5d0c9 Gael*0205             IF (filePrec .EQ. precFloat32) THEN
                0206               READ(dUnit,rec=irec2d) fld2d_procbuff_r4
                0207             ELSE
                0208               READ(dUnit,rec=irec2d) fld2d_procbuff_r8
                0209             ENDIF
f6d7c45cef Jean*0210           ELSE
ab63ca39fb Gael*0211 #  ifndef EXCLUDE_WHIO_GLOBUFF_2D
d7fbd5d0c9 Gael*0212             IF (filePrec .EQ. precFloat32) THEN
                0213               READ(dUnit,rec=irec2d) fld2d_globuff_r4
                0214             ELSE
                0215               READ(dUnit,rec=irec2d) fld2d_globuff_r8
f6d7c45cef Jean*0216             ENDIF
ab63ca39fb Gael*0217 #  endif
f6d7c45cef Jean*0218           ENDIF
d7fbd5d0c9 Gael*0219         ENDIF
                0220         _BARRIER
                0221 
                0222         IF (filePrec .EQ. precFloat32) THEN
9f5240b52a Jean*0223           IF ( locSingleCpuIO ) THEN
ab63ca39fb Gael*0224 #  ifndef EXCLUDE_WHIO_GLOBUFF_2D
f6d7c45cef Jean*0225             CALL SCATTER_2D_WH_R4 ( fld2d_globuff_r4,
d7fbd5d0c9 Gael*0226      &                              fld2d_procbuff_r4,myThid)
ab63ca39fb Gael*0227 #  endif
d7fbd5d0c9 Gael*0228             CALL BAR2( myThid )
                0229           ENDIF
1cfc927d8c Jean*0230           CALL MDS_PASS_R4toRL( fld2d_procbuff_r4, fldRL,
                0231      &             OLx, OLy, 1, i2d, n2d, 0, 0, .TRUE., myThid )
d7fbd5d0c9 Gael*0232         ELSE
9f5240b52a Jean*0233           IF ( locSingleCpuIO ) THEN
ab63ca39fb Gael*0234 #  ifndef EXCLUDE_WHIO_GLOBUFF_2D
f6d7c45cef Jean*0235             CALL SCATTER_2D_WH_R8 ( fld2d_globuff_r8,
d7fbd5d0c9 Gael*0236      &                              fld2d_procbuff_r8,myThid)
ab63ca39fb Gael*0237 #  endif
d7fbd5d0c9 Gael*0238             CALL BAR2( myThid )
                0239           ENDIF
1cfc927d8c Jean*0240           CALL MDS_PASS_R8toRL( fld2d_procbuff_r8, fldRL,
                0241      &             OLx, OLy, 1, i2d, n2d, 0, 0, .TRUE., myThid )
d7fbd5d0c9 Gael*0242         ENDIF
                0243 
9f5240b52a Jean*0244       ENDDO
f6d7c45cef Jean*0245 
9231496966 Gael*0246        IF ( iAmDoingIO.AND.(fid.EQ.0) ) THEN
d7fbd5d0c9 Gael*0247          CLOSE( dUnit )
                0248        ENDIF
                0249 
01e0ec14d7 Jean*0250 #endif /* ALLOW_WHIO */
d7fbd5d0c9 Gael*0251 
1d8c557c39 Jean*0252       RETURN
                0253       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
Valid CSS 2.1! Valid HTML 4.01!