pkg/mdsio/mdsio_gl_slice.F

6d54cf9ca1 Ed H*0001 #include "MDSIO_OPTIONS.h"
de416ebcde Patr*0002
db322dbd40 Jean*0003 C--  File mdsio_gl_slice.F: Routines to handle mid-level I/O interface.
                0004 C--   Contents
                0005 C--   o MDSREADFIELD_XZ_GL
                0006 C--   o MDSREADFIELD_YZ_GL
                0007 C--   o MDSWRITEFIELD_XZ_GL
                0008 C--   o MDSWRITEFIELD_YZ_GL
                0009
                0010 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
de416ebcde Patr*0011
                0012       SUBROUTINE MDSREADFIELD_XZ_GL(
                0013      I   fName,
                0014      I   filePrec,
                0015      I   arrType,
                0016      I   nNz,
                0017      O   arr_gl,
                0018      I   irecord,
                0019      I   myThid )
                0020 C
                0021 C Arguments:
                0022 C
db322dbd40 Jean*0023 C fName      string  :: base name for file to read
                0024 C filePrec   integer :: number of bits per word in file (32 or 64)
                0025 C arrType    char(2) :: declaration of "arr": either "RS" or "RL"
                0026 C nNz        integer :: size of third dimension: normally either 1 or Nr
                0027 C arr         RS/RL  :: array to read into, arr(:,:,nNz,:,:)
                0028 C irecord    integer :: record number to read
                0029 C myThid     integer :: thread identifier
de416ebcde Patr*0030 C
                0031 C MDSREADFIELD first checks to see if the file "fName" exists, then
                0032 C if the file "fName.data" exists and finally the tiled files of the
                0033 C form "fName.xxx.yyy.data" exist. Currently, the meta-files are not
                0034 C read because it is difficult to parse files in fortran.
                0035 C The precision of the file is decsribed by filePrec, set either
                0036 C to floatPrec32 or floatPrec64. The precision or declaration of
                0037 C the array argument must be consistently described by the char*(2)
                0038 C string arrType, either "RS" or "RL". nNz allows for both 2-D and
                0039 C 3-D arrays to be handled. nNz=1 implies a 2-D model field and
                0040 C nNz=Nr implies a 3-D model field. irecord is the record number
                0041 C to be read and must be >= 1. The file data is stored in
                0042 C arr *but* the overlaps are *not* updated. ie. An exchange must
                0043 C be called. This is because the routine is sometimes called from
                0044 C within a MASTER_THID region.
                0045 C
                0046 C Created: 03/16/99 adcroft@mit.edu
                0047
                0048       implicit none
                0049 C Global variables / common blocks
                0050 #include "SIZE.h"
                0051 #include "EEPARAMS.h"
                0052 #include "PARAMS.h"
                0053
                0054 C Routine arguments
                0055       character*(*) fName
                0056       integer filePrec
                0057       character*(2) arrType
                0058       integer nNz
                0059       _RL arr_gl(sNx,nSx,nPx,nSy,nPy,Nr)
                0060       integer irecord
                0061       integer myThid
db322dbd40 Jean*0062
                0063 #ifdef ALLOW_AUTODIFF
de416ebcde Patr*0064 C Functions
                0065       integer ILNBLNK
                0066       integer MDS_RECLEN
                0067 C Local variables
47c8a35ff3 Jean*0068       character*(MAX_LEN_FNAM) dataFName
989416fbdf Patr*0069       integer ip,jp,iG,jG,irec,bi,bj,ii,k,dUnit,IL
de416ebcde Patr*0070       logical exst
                0071       _RL arr(1-oLx:sNx+oLx,Nr,nSx,nSy)
                0072       Real*4 r4seg(sNx)
                0073       Real*8 r8seg(sNx)
                0074       logical globalFile,fileIsOpen
                0075       integer length_of_rec
                0076       character*(max_len_mbuf) msgbuf
                0077 C     ------------------------------------------------------------------
                0078
                0079 C Only do I/O if I am the master thread
                0080       _BEGIN_MASTER( myThid )
                0081
b2fffc7e1a Jean*0082 #ifndef REAL4_IS_SLOW
                0083       if (arrType .eq. 'RS') then
                0084        write(msgbuf,'(a)')
                0085      &   ' MDSREADFIELD_XZ_GL is wrong for arrType="RS" (=real*4)'
                0086        call print_error( msgbuf, mythid )
                0087        stop 'ABNORMAL END: S/R MDSREADFIELD_XZ_GL'
                0088       endif
                0089 #endif
                0090
de416ebcde Patr*0091 C Record number must be >= 1
                0092       if (irecord .LT. 1) then
                0093        write(msgbuf,'(a,i9.8)')
b2fffc7e1a Jean*0094      &   ' MDSREADFIELD_XZ_GL: argument irecord = ',irecord
de416ebcde Patr*0095        call print_message( msgbuf, standardmessageunit,
                0096      &                     SQUEEZE_RIGHT , mythid)
                0097        write(msgbuf,'(a)')
b2fffc7e1a Jean*0098      &   ' MDSREADFIELD_XZ_GL: Invalid value for irecord'
de416ebcde Patr*0099        call print_error( msgbuf, mythid )
b2fffc7e1a Jean*0100        stop 'ABNORMAL END: S/R MDSREADFIELD_XZ_GL'
de416ebcde Patr*0101       endif
                0102
                0103 C Assume nothing
                0104       globalFile = .FALSE.
                0105       fileIsOpen = .FALSE.
                0106       IL=ILNBLNK( fName )
                0107
                0108 C Assign a free unit number as the I/O channel for this routine
                0109       call MDSFINDUNIT( dUnit, mythid )
                0110
                0111 C Check first for global file with simple name (ie. fName)
                0112       dataFName = fName
                0113       inquire( file=dataFname, exist=exst )
                0114       if (exst) then
                0115        write(msgbuf,'(a,a)')
47c8a35ff3 Jean*0116      &   ' MDSREADFIELD: opening global file: ',dataFName(1:IL)
de416ebcde Patr*0117        call print_message( msgbuf, standardmessageunit,
                0118      &                     SQUEEZE_RIGHT , mythid)
                0119       endif
                0120
                0121 C If negative check for global file with MDS name (ie. fName.data)
                0122       if (.NOT. globalFile) then
47c8a35ff3 Jean*0123        write(dataFname,'(2a)') fName(1:IL),'.data'
de416ebcde Patr*0124        inquire( file=dataFname, exist=exst )
                0125        if (exst) then
                0126         write(msgbuf,'(a,a)')
47c8a35ff3 Jean*0127      &   ' MDSREADFIELD_XZ_GL: opening global file: ',dataFName(1:IL+5)
de416ebcde Patr*0128         call print_message( msgbuf, standardmessageunit,
                0129      &                      SQUEEZE_RIGHT , mythid)
                0130         globalFile = .TRUE.
                0131        endif
                0132       endif
                0133
db322dbd40 Jean*0134 C Loop over all processors
de416ebcde Patr*0135       do jp=1,nPy
                0136       do ip=1,nPx
                0137 C Loop over all tiles
                0138       do bj=1,nSy
                0139       do bi=1,nSx
                0140 C If we are reading from a tiled MDS file then we open each one here
                0141         if (.NOT. globalFile) then
                0142          iG=bi+(ip-1)*nsx ! Kludge until unstructered tiles
                0143          jG=bj+(jp-1)*nsy ! Kludge until unstructered tiles
47c8a35ff3 Jean*0144          write(dataFname,'(2a,i3.3,a,i3.3,a)')
de416ebcde Patr*0145      &              fName(1:IL),'.',iG,'.',jG,'.data'
                0146          inquire( file=dataFname, exist=exst )
                0147 C Of course, we only open the file if the tile is "active"
                0148 C (This is a place-holder for the active/passive mechanism
                0149          if (exst) then
ae605e558b Jean*0150           if ( debugLevel .GE. debLevB ) then
494ad43bae Patr*0151            write(msgbuf,'(a,a)')
47c8a35ff3 Jean*0152      &      ' MDSREADFIELD_XZ_GL: opening file: ',dataFName(1:IL+13)
494ad43bae Patr*0153            call print_message( msgbuf, standardmessageunit,
de416ebcde Patr*0154      &                        SQUEEZE_RIGHT , mythid)
494ad43bae Patr*0155           endif
de416ebcde Patr*0156           length_of_rec=MDS_RECLEN( filePrec, sNx, mythid )
                0157           open( dUnit, file=dataFName, status='old',
                0158      &        access='direct', recl=length_of_rec )
                0159           fileIsOpen=.TRUE.
                0160          else
                0161           fileIsOpen=.FALSE.
                0162           write(msgbuf,'(a,a)')
47c8a35ff3 Jean*0163      &      ' MDSREADFIELD_XZ_GL: filename: ',dataFName(1:IL+13)
de416ebcde Patr*0164           call print_message( msgbuf, standardmessageunit,
                0165      &                        SQUEEZE_RIGHT , mythid)
                0166           write(msgbuf,'(a)')
                0167      &      ' MDSREADFIELD_XZ_GL: File does not exist'
                0168           call print_error( msgbuf, mythid )
                0169           stop 'ABNORMAL END: S/R MDSREADFIELD_GL'
                0170          endif
                0171         endif
                0172
                0173         if (fileIsOpen) then
                0174          do k=1,Nr
                0175             iG = 0
                0176             jG = 0
                0177             irec=k + Nr*(irecord-1)
                0178            if (filePrec .eq. precFloat32) then
                0179             read(dUnit,rec=irec) r4seg
                0180 #ifdef _BYTESWAPIO
                0181             call MDS_BYTESWAPR4( sNx, r4seg )
                0182 #endif
                0183             if (arrType .eq. 'RS') then
b2fffc7e1a Jean*0184 #ifdef REAL4_IS_SLOW
de416ebcde Patr*0185              call MDS_SEG4toRS_2D(sNx,oLx,nNz,bi,bj,k,.TRUE.,r4seg,arr)
b2fffc7e1a Jean*0186 #endif
de416ebcde Patr*0187             elseif (arrType .eq. 'RL') then
                0188              call MDS_SEG4toRL_2D(sNx,oLx,nNz,bi,bj,k,.TRUE.,r4seg,arr)
                0189             else
                0190              write(msgbuf,'(a)')
                0191      &         ' MDSREADFIELD_XZ_GL: illegal value for arrType'
                0192              call print_error( msgbuf, mythid )
                0193              stop 'ABNORMAL END: S/R MDSREADFIELD_XZ_GL'
                0194             endif
                0195            elseif (filePrec .eq. precFloat64) then
                0196             read(dUnit,rec=irec) r8seg
                0197 #ifdef _BYTESWAPIO
                0198             call MDS_BYTESWAPR8( sNx, r8seg )
                0199 #endif
                0200             if (arrType .eq. 'RS') then
b2fffc7e1a Jean*0201 #ifdef REAL4_IS_SLOW
de416ebcde Patr*0202              call MDS_SEG8toRS_2D(sNx,oLx,nNz,bi,bj,k,.TRUE.,r8seg,arr)
b2fffc7e1a Jean*0203 #endif
de416ebcde Patr*0204             elseif (arrType .eq. 'RL') then
                0205              call MDS_SEG8toRL_2D(sNx,oLx,nNz,bi,bj,k,.TRUE.,r8seg,arr)
                0206             else
                0207              write(msgbuf,'(a)')
                0208      &         ' MDSREADFIELD_XZ_GL: illegal value for arrType'
                0209              call print_error( msgbuf, mythid )
                0210              stop 'ABNORMAL END: S/R MDSREADFIELD_XZ_GL'
                0211             endif
                0212            else
                0213             write(msgbuf,'(a)')
                0214      &        ' MDSREADFIELD_XZ_GL: illegal value for filePrec'
                0215             call print_error( msgbuf, mythid )
                0216             stop 'ABNORMAL END: S/R MDSREADFIELD_XZ_GL'
                0217            endif
                0218        do ii=1,sNx
                0219         arr_gl(ii,bi,ip,bj,jp,k)=arr(ii,k,bi,bj)
                0220        enddo
                0221
                0222 C End of k loop
                0223          enddo
                0224          if (.NOT. globalFile) then
                0225           close( dUnit )
                0226           fileIsOpen = .FALSE.
                0227          endif
                0228         endif
                0229 C End of bi,bj loops
                0230        enddo
                0231       enddo
                0232 C End of ip,jp loops
                0233        enddo
                0234       enddo
                0235
                0236 C If global file was opened then close it
                0237       if (fileIsOpen .AND. globalFile) then
                0238        close( dUnit )
                0239        fileIsOpen = .FALSE.
                0240       endif
                0241
                0242       _END_MASTER( myThid )
                0243
db322dbd40 Jean*0244 #else /* ALLOW_AUTODIFF */
                0245       STOP 'ABNORMAL END: S/R MDSREADFIELD_XZ_GL is empty'
                0246 #endif /* ALLOW_AUTODIFF */
de416ebcde Patr*0247 C     ------------------------------------------------------------------
db322dbd40 Jean*0248       RETURN
                0249       END
                0250
                0251 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
de416ebcde Patr*0252
                0253       SUBROUTINE MDSREADFIELD_YZ_GL(
                0254      I   fName,
                0255      I   filePrec,
                0256      I   arrType,
                0257      I   nNz,
                0258      O   arr_gl,
                0259      I   irecord,
                0260      I   myThid )
db322dbd40 Jean*0261
de416ebcde Patr*0262 C Arguments:
                0263 C
db322dbd40 Jean*0264 C fName      string  :: base name for file to read
                0265 C filePrec   integer :: number of bits per word in file (32 or 64)
                0266 C arrType    char(2) :: declaration of "arr": either "RS" or "RL"
                0267 C nNz        integer :: size of third dimension: normally either 1 or Nr
                0268 C arr         RS/RL  :: array to read into, arr(:,:,nNz,:,:)
                0269 C irecord    integer :: record number to read
                0270 C myThid     integer :: thread identifier
de416ebcde Patr*0271 C
                0272 C MDSREADFIELD first checks to see if the file "fName" exists, then
                0273 C if the file "fName.data" exists and finally the tiled files of the
                0274 C form "fName.xxx.yyy.data" exist. Currently, the meta-files are not
                0275 C read because it is difficult to parse files in fortran.
                0276 C The precision of the file is decsribed by filePrec, set either
                0277 C to floatPrec32 or floatPrec64. The precision or declaration of
                0278 C the array argument must be consistently described by the char*(2)
                0279 C string arrType, either "RS" or "RL". nNz allows for both 2-D and
                0280 C 3-D arrays to be handled. nNz=1 implies a 2-D model field and
                0281 C nNz=Nr implies a 3-D model field. irecord is the record number
                0282 C to be read and must be >= 1. The file data is stored in
                0283 C arr *but* the overlaps are *not* updated. ie. An exchange must
                0284 C be called. This is because the routine is sometimes called from
                0285 C within a MASTER_THID region.
                0286 C
                0287 C Created: 03/16/99 adcroft@mit.edu
                0288
                0289       implicit none
                0290 C Global variables / common blocks
                0291 #include "SIZE.h"
                0292 #include "EEPARAMS.h"
                0293 #include "PARAMS.h"
                0294
                0295 C Routine arguments
                0296       character*(*) fName
                0297       integer filePrec
                0298       character*(2) arrType
                0299       integer nNz
                0300       _RL arr_gl(nSx,nPx,sNy,nSy,nPy,Nr)
                0301       integer irecord
                0302       integer myThid
db322dbd40 Jean*0303
                0304 #ifdef ALLOW_AUTODIFF
de416ebcde Patr*0305 C Functions
                0306       integer ILNBLNK
                0307       integer MDS_RECLEN
                0308 C Local variables
47c8a35ff3 Jean*0309       character*(MAX_LEN_FNAM) dataFName
989416fbdf Patr*0310       integer ip,jp,iG,jG,irec,bi,bj,jj,k,dUnit,IL
de416ebcde Patr*0311       logical exst
                0312       _RL arr(1-oLy:sNy+oLy,Nr,nSx,nSy)
                0313       Real*4 r4seg(sNy)
                0314       Real*8 r8seg(sNy)
                0315       logical globalFile,fileIsOpen
                0316       integer length_of_rec
                0317       character*(max_len_mbuf) msgbuf
                0318 C     ------------------------------------------------------------------
                0319
                0320 C Only do I/O if I am the master thread
                0321       _BEGIN_MASTER( myThid )
                0322
b2fffc7e1a Jean*0323 #ifndef REAL4_IS_SLOW
                0324       if (arrType .eq. 'RS') then
                0325        write(msgbuf,'(a)')
                0326      &   ' MDSREADFIELD_YZ_GL is wrong for arrType="RS" (=real*4)'
                0327        call print_error( msgbuf, mythid )
                0328        stop 'ABNORMAL END: S/R MDSREADFIELD_YZ_GL'
                0329       endif
                0330 #endif
                0331
de416ebcde Patr*0332 C Record number must be >= 1
                0333       if (irecord .LT. 1) then
                0334        write(msgbuf,'(a,i9.8)')
                0335      &   ' MDSREADFIELD_YZ_GL: argument irecord = ',irecord
                0336        call print_message( msgbuf, standardmessageunit,
                0337      &                     SQUEEZE_RIGHT , mythid)
                0338        write(msgbuf,'(a)')
                0339      &   ' MDSREADFIELD_YZ_GL: Invalid value for irecord'
                0340        call print_error( msgbuf, mythid )
                0341        stop 'ABNORMAL END: S/R MDSREADFIELD_YZ_GL'
                0342       endif
                0343
                0344 C Assume nothing
                0345       globalFile = .FALSE.
                0346       fileIsOpen = .FALSE.
                0347       IL=ILNBLNK( fName )
                0348
                0349 C Assign a free unit number as the I/O channel for this routine
                0350       call MDSFINDUNIT( dUnit, mythid )
                0351
                0352 C Check first for global file with simple name (ie. fName)
                0353       dataFName = fName
                0354       inquire( file=dataFname, exist=exst )
                0355       if (exst) then
                0356        write(msgbuf,'(a,a)')
47c8a35ff3 Jean*0357      &  ' MDSREADFIELD_YZ: opening global file: ',dataFName(1:IL)
de416ebcde Patr*0358        call print_message( msgbuf, standardmessageunit,
                0359      &                     SQUEEZE_RIGHT , mythid)
                0360       endif
                0361
                0362 C If negative check for global file with MDS name (ie. fName.data)
                0363       if (.NOT. globalFile) then
47c8a35ff3 Jean*0364        write(dataFname,'(2a)') fName(1:IL),'.data'
de416ebcde Patr*0365        inquire( file=dataFname, exist=exst )
                0366        if (exst) then
                0367         write(msgbuf,'(a,a)')
47c8a35ff3 Jean*0368      &   ' MDSREADFIELD_YZ_GL: opening global file: ',dataFName(1:IL+5)
de416ebcde Patr*0369         call print_message( msgbuf, standardmessageunit,
                0370      &                      SQUEEZE_RIGHT , mythid)
                0371         globalFile = .TRUE.
                0372        endif
                0373       endif
db322dbd40 Jean*0374 C Loop over all processors
de416ebcde Patr*0375       do jp=1,nPy
                0376       do ip=1,nPx
                0377 C Loop over all tiles
                0378       do bj=1,nSy
                0379       do bi=1,nSx
                0380 C If we are reading from a tiled MDS file then we open each one here
                0381         if (.NOT. globalFile) then
                0382          iG=bi+(ip-1)*nsx ! Kludge until unstructered tiles
                0383          jG=bj+(jp-1)*nsy ! Kludge until unstructered tiles
47c8a35ff3 Jean*0384          write(dataFname,'(2a,i3.3,a,i3.3,a)')
de416ebcde Patr*0385      &              fName(1:IL),'.',iG,'.',jG,'.data'
                0386          inquire( file=dataFname, exist=exst )
                0387 C Of course, we only open the file if the tile is "active"
                0388 C (This is a place-holder for the active/passive mechanism
                0389          if (exst) then
ae605e558b Jean*0390           if ( debugLevel .GE. debLevB ) then
494ad43bae Patr*0391            write(msgbuf,'(a,a)')
47c8a35ff3 Jean*0392      &      ' MDSREADFIELD_YZ_GL: opening file: ',dataFName(1:IL+13)
494ad43bae Patr*0393            call print_message( msgbuf, standardmessageunit,
de416ebcde Patr*0394      &                        SQUEEZE_RIGHT , mythid)
494ad43bae Patr*0395           endif
de416ebcde Patr*0396           length_of_rec=MDS_RECLEN( filePrec, sNy, mythid )
                0397           open( dUnit, file=dataFName, status='old',
                0398      &        access='direct', recl=length_of_rec )
                0399           fileIsOpen=.TRUE.
                0400          else
                0401           fileIsOpen=.FALSE.
                0402           write(msgbuf,'(a,a)')
47c8a35ff3 Jean*0403      &      ' MDSREADFIELD_YZ_GL: filename: ',dataFName(1:IL+13)
de416ebcde Patr*0404           call print_message( msgbuf, standardmessageunit,
                0405      &                        SQUEEZE_RIGHT , mythid)
                0406           write(msgbuf,'(a)')
                0407      &      ' MDSREADFIELD_YZ_GL: File does not exist'
                0408           call print_error( msgbuf, mythid )
                0409           stop 'ABNORMAL END: S/R MDSREADFIELD_YZ_GL'
                0410          endif
                0411         endif
                0412
                0413         if (fileIsOpen) then
                0414          do k=1,Nr
                0415             iG = 0
                0416             jG = 0
                0417             irec=k + Nr*(irecord-1)
                0418            if (filePrec .eq. precFloat32) then
                0419             read(dUnit,rec=irec) r4seg
                0420 #ifdef _BYTESWAPIO
                0421             call MDS_BYTESWAPR4( sNy, r4seg )
                0422 #endif
                0423             if (arrType .eq. 'RS') then
b2fffc7e1a Jean*0424 #ifdef REAL4_IS_SLOW
de416ebcde Patr*0425              call MDS_SEG4toRS_2D(sNy,oLy,nNz,bi,bj,k,.TRUE.,r4seg,arr)
b2fffc7e1a Jean*0426 #endif
de416ebcde Patr*0427             elseif (arrType .eq. 'RL') then
                0428              call MDS_SEG4toRL_2D(sNy,oLy,nNz,bi,bj,k,.TRUE.,r4seg,arr)
                0429             else
                0430              write(msgbuf,'(a)')
                0431      &         ' MDSREADFIELD_YZ_GL: illegal value for arrType'
                0432              call print_error( msgbuf, mythid )
                0433              stop 'ABNORMAL END: S/R MDSREADFIELD_YZ_GL'
                0434             endif
                0435            elseif (filePrec .eq. precFloat64) then
                0436             read(dUnit,rec=irec) r8seg
                0437 #ifdef _BYTESWAPIO
                0438             call MDS_BYTESWAPR8( sNy, r8seg )
                0439 #endif
                0440             if (arrType .eq. 'RS') then
b2fffc7e1a Jean*0441 #ifdef REAL4_IS_SLOW
de416ebcde Patr*0442              call MDS_SEG8toRS_2D(sNy,oLy,nNz,bi,bj,k,.TRUE.,r8seg,arr)
b2fffc7e1a Jean*0443 #endif
de416ebcde Patr*0444             elseif (arrType .eq. 'RL') then
                0445              call MDS_SEG8toRL_2D(sNy,oLy,nNz,bi,bj,k,.TRUE.,r8seg,arr)
                0446             else
                0447              write(msgbuf,'(a)')
                0448      &         ' MDSREADFIELD_YZ_GL: illegal value for arrType'
                0449              call print_error( msgbuf, mythid )
                0450              stop 'ABNORMAL END: S/R MDSREADFIELD_YZ_GL'
                0451             endif
                0452            else
                0453             write(msgbuf,'(a)')
                0454      &        ' MDSREADFIELD_YZ_GL: illegal value for filePrec'
                0455             call print_error( msgbuf, mythid )
                0456             stop 'ABNORMAL END: S/R MDSREADFIELD_YZ_GL'
                0457            endif
                0458        do jj=1,sNy
                0459         arr_gl(bi,ip,jj,bj,jp,k)=arr(jj,k,bi,bj)
                0460        enddo
                0461
                0462 C End of k loop
                0463          enddo
                0464          if (.NOT. globalFile) then
                0465           close( dUnit )
                0466           fileIsOpen = .FALSE.
                0467          endif
                0468         endif
                0469 C End of bi,bj loops
                0470        enddo
                0471       enddo
                0472 C End of ip,jp loops
                0473        enddo
                0474       enddo
                0475
                0476 C If global file was opened then close it
                0477       if (fileIsOpen .AND. globalFile) then
                0478        close( dUnit )
                0479        fileIsOpen = .FALSE.
                0480       endif
                0481
                0482       _END_MASTER( myThid )
                0483
db322dbd40 Jean*0484 #else /* ALLOW_AUTODIFF */
                0485       STOP 'ABNORMAL END: S/R MDSREADFIELD_YZ_GL is empty'
                0486 #endif /* ALLOW_AUTODIFF */
de416ebcde Patr*0487 C     ------------------------------------------------------------------
db322dbd40 Jean*0488       RETURN
                0489       END
                0490
                0491 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
de416ebcde Patr*0492
                0493       SUBROUTINE MDSWRITEFIELD_XZ_GL(
                0494      I   fName,
                0495      I   filePrec,
                0496      I   arrType,
                0497      I   nNz,
                0498      I   arr_gl,
                0499      I   irecord,
                0500      I   myIter,
                0501      I   myThid )
                0502 C
                0503 C Arguments:
                0504 C
db322dbd40 Jean*0505 C fName      string  :: base name for file to write
                0506 C filePrec   integer :: number of bits per word in file (32 or 64)
                0507 C arrType    char(2) :: declaration of "arr": either "RS" or "RL"
                0508 C nNz        integer :: size of third dimension: normally either 1 or Nr
                0509 C arr         RS/RL  :: array to write, arr(:,:,nNz,:,:)
                0510 C irecord    integer :: record number to write
                0511 C myIter     integer :: time step number
                0512 C myThid     integer :: thread identifier
de416ebcde Patr*0513 C
                0514 C MDSWRITEFIELD creates either a file of the form "fName.data" and
                0515 C "fName.meta" if the logical flag "globalFile" is set true. Otherwise
                0516 C it creates MDS tiled files of the form "fName.xxx.yyy.data" and
                0517 C "fName.xxx.yyy.meta". A meta-file is always created.
                0518 C Currently, the meta-files are not read because it is difficult
                0519 C to parse files in fortran. We should read meta information before
                0520 C adding records to an existing multi-record file.
                0521 C The precision of the file is decsribed by filePrec, set either
                0522 C to floatPrec32 or floatPrec64. The precision or declaration of
                0523 C the array argument must be consistently described by the char*(2)
                0524 C string arrType, either "RS" or "RL". nNz allows for both 2-D and
                0525 C 3-D arrays to be handled. nNz=1 implies a 2-D model field and
                0526 C nNz=Nr implies a 3-D model field. irecord is the record number
                0527 C to be read and must be >= 1. NOTE: It is currently assumed that
                0528 C the highest record number in the file was the last record written.
                0529 C Nor is there a consistency check between the routine arguments and file.
                0530 C ie. if your write record 2 after record 4 the meta information
                0531 C will record the number of records to be 2. This, again, is because
                0532 C we have read the meta information. To be fixed.
                0533 C
                0534 C Created: 03/16/99 adcroft@mit.edu
                0535 C
                0536 C Changed: 05/31/00 heimbach@mit.edu
                0537 C          open(dUnit, ..., status='old', ... -> status='unknown'
                0538
                0539       implicit none
                0540 C Global variables / common blocks
                0541 #include "SIZE.h"
                0542 #include "EEPARAMS.h"
                0543 #include "PARAMS.h"
                0544
                0545 C Routine arguments
                0546       character*(*) fName
                0547       integer filePrec
                0548       character*(2) arrType
                0549       integer nNz
                0550 cph(
                0551 cph      Real arr(*)
                0552       _RL arr_gl(sNx,nSx,nPx,nSy,nPy,Nr)
                0553 cph)
                0554       integer irecord
                0555       integer myIter
                0556       integer myThid
db322dbd40 Jean*0557
                0558 #ifdef ALLOW_AUTODIFF
de416ebcde Patr*0559 C Functions
                0560       integer ILNBLNK
                0561       integer MDS_RECLEN
                0562 C Local variables
47c8a35ff3 Jean*0563       character*(MAX_LEN_FNAM) dataFName,metaFName
989416fbdf Patr*0564       integer ip,jp,iG,jG,irec,bi,bj,ii,k,dUnit,IL
de416ebcde Patr*0565       Real*4 r4seg(sNx)
                0566       Real*8 r8seg(sNx)
                0567       _RL arr(1-oLx:sNx+oLx,Nr,nSx,nSy)
b714306922 Jean*0568       INTEGER dimList(3,3), nDims, map2gl(2)
                0569       _RL dummyRL(1)
                0570       CHARACTER*8 blank8c
de416ebcde Patr*0571       integer length_of_rec
                0572       logical fileIsOpen
                0573       character*(max_len_mbuf) msgbuf
                0574 C     ------------------------------------------------------------------
                0575
b714306922 Jean*0576       DATA dummyRL(1) / 0. _d 0 /
                0577       DATA blank8c / '        ' /
                0578
de416ebcde Patr*0579 C Only do I/O if I am the master thread
                0580       _BEGIN_MASTER( myThid )
                0581
b2fffc7e1a Jean*0582 #ifndef REAL4_IS_SLOW
                0583       if (arrType .eq. 'RS') then
                0584        write(msgbuf,'(a)')
                0585      &   ' MDSWRITEFIELD_XZ_GL is wrong for arrType="RS" (=real*4)'
                0586        call print_error( msgbuf, mythid )
                0587        stop 'ABNORMAL END: S/R MDSWRITEFIELD_XZ_GL'
                0588       endif
                0589 #endif
                0590
de416ebcde Patr*0591 C Record number must be >= 1
                0592       if (irecord .LT. 1) then
                0593        write(msgbuf,'(a,i9.8)')
                0594      &   ' MDSWRITEFIELD_XZ_GL: argument irecord = ',irecord
                0595        call print_message( msgbuf, standardmessageunit,
                0596      &                     SQUEEZE_RIGHT , mythid)
                0597        write(msgbuf,'(a)')
                0598      &   ' MDSWRITEFIELD_XZ_GL: invalid value for irecord'
                0599        call print_error( msgbuf, mythid )
                0600        stop 'ABNORMAL END: S/R MDSWRITEFIELD_XZ_GL'
                0601       endif
                0602
                0603 C Assume nothing
                0604       fileIsOpen=.FALSE.
                0605       IL=ILNBLNK( fName )
                0606
                0607 C Assign a free unit number as the I/O channel for this routine
                0608       call MDSFINDUNIT( dUnit, mythid )
                0609
                0610
db322dbd40 Jean*0611 C Loop over all processors
de416ebcde Patr*0612       do jp=1,nPy
                0613       do ip=1,nPx
                0614 C Loop over all tiles
                0615       do bj=1,nSy
                0616        do bi=1,nSx
                0617 C If we are writing to a tiled MDS file then we open each one here
                0618          iG=bi+(ip-1)*nsx ! Kludge until unstructered tiles
                0619          jG=bj+(jp-1)*nsy ! Kludge until unstructered tiles
47c8a35ff3 Jean*0620          write(dataFname,'(2a,i3.3,a,i3.3,a)')
de416ebcde Patr*0621      &              fName(1:IL),'.',iG,'.',jG,'.data'
                0622          if (irecord .EQ. 1) then
                0623           length_of_rec=MDS_RECLEN( filePrec, sNx, mythid )
                0624           open( dUnit, file=dataFName, status=_NEW_STATUS,
                0625      &       access='direct', recl=length_of_rec )
                0626           fileIsOpen=.TRUE.
                0627          else
                0628           length_of_rec=MDS_RECLEN( filePrec, sNx, mythid )
                0629           open( dUnit, file=dataFName, status=_OLD_STATUS,
                0630      &       access='direct', recl=length_of_rec )
                0631           fileIsOpen=.TRUE.
                0632          endif
                0633         if (fileIsOpen) then
                0634          do k=1,Nr
                0635             do ii=1,sNx
                0636                arr(ii,k,bi,bj)=arr_gl(ii,bi,ip,bj,jp,k)
                0637             enddo
                0638             iG = 0
                0639             jG = 0
                0640             irec=k + Nr*(irecord-1)
                0641            if (filePrec .eq. precFloat32) then
                0642             if (arrType .eq. 'RS') then
b2fffc7e1a Jean*0643 #ifdef REAL4_IS_SLOW
de416ebcde Patr*0644              call MDS_SEG4toRS_2D(sNx,oLx,nNz,bi,bj,k,.FALSE.,r4seg,arr)
b2fffc7e1a Jean*0645 #endif
de416ebcde Patr*0646             elseif (arrType .eq. 'RL') then
                0647              call MDS_SEG4toRL_2D(sNx,oLx,nNz,bi,bj,k,.FALSE.,r4seg,arr)
                0648             else
                0649              write(msgbuf,'(a)')
                0650      &         ' MDSWRITEFIELD_XZ_GL: illegal value for arrType'
                0651              call print_error( msgbuf, mythid )
                0652              stop 'ABNORMAL END: S/R MDSWRITEFIELD_XZ_GL'
                0653             endif
                0654 #ifdef _BYTESWAPIO
                0655             call MDS_BYTESWAPR4( sNx, r4seg )
                0656 #endif
                0657             write(dUnit,rec=irec) r4seg
                0658            elseif (filePrec .eq. precFloat64) then
                0659             if (arrType .eq. 'RS') then
b2fffc7e1a Jean*0660 #ifdef REAL4_IS_SLOW
de416ebcde Patr*0661              call MDS_SEG8toRS_2D(sNx,oLx,nNz,bi,bj,k,.FALSE.,r8seg,arr)
b2fffc7e1a Jean*0662 #endif
de416ebcde Patr*0663             elseif (arrType .eq. 'RL') then
                0664              call MDS_SEG8toRL_2D(sNx,oLx,nNz,bi,bj,k,.FALSE.,r8seg,arr)
                0665             else
                0666              write(msgbuf,'(a)')
                0667      &         ' MDSWRITEFIELD_XZ_GL: illegal value for arrType'
                0668              call print_error( msgbuf, mythid )
                0669              stop 'ABNORMAL END: S/R MDSWRITEFIELD_XZ_GL'
                0670             endif
                0671 #ifdef _BYTESWAPIO
                0672             call MDS_BYTESWAPR8( sNx, r8seg )
                0673 #endif
                0674             write(dUnit,rec=irec) r8seg
                0675            else
                0676             write(msgbuf,'(a)')
                0677      &        ' MDSWRITEFIELD_XZ_GL: illegal value for filePrec'
                0678             call print_error( msgbuf, mythid )
                0679             stop 'ABNORMAL END: S/R MDSWRITEFIELD_XZ_GL'
                0680            endif
                0681 C End of k loop
                0682          enddo
                0683         else
                0684          write(msgbuf,'(a)')
                0685      &     ' MDSWRITEFIELD_XZ_GL: I should never get to this point'
                0686          call print_error( msgbuf, mythid )
                0687          stop 'ABNORMAL END: S/R MDSWRITEFIELD_XZ_GL'
                0688         endif
                0689 C If we were writing to a tiled MDS file then we close it here
                0690         if (fileIsOpen) then
                0691          close( dUnit )
                0692          fileIsOpen = .FALSE.
                0693         endif
                0694 C Create meta-file for each tile if we are tiling
                0695          iG=bi+(ip-1)*nsx ! Kludge until unstructered tiles
                0696          jG=bj+(jp-1)*nsy ! Kludge until unstructered tiles
47c8a35ff3 Jean*0697          write(metaFname,'(2a,i3.3,a,i3.3,a)')
de416ebcde Patr*0698      &              fName(1:IL),'.',iG,'.',jG,'.meta'
                0699          dimList(1,1)=Nx
                0700          dimList(2,1)=((ip-1)*nSx+(bi-1))*sNx+1
                0701          dimList(3,1)=((ip-1)*nSx+bi)*sNx
                0702          dimList(1,2)=nSy*nPy
                0703          dimList(2,2)=(jp-1)*nSy+bj
                0704          dimList(3,2)= jp*nSy+bj
                0705          dimList(1,3)=Nr
                0706          dimList(2,3)=1
                0707          dimList(3,3)=Nr
b714306922 Jean*0708          nDims=3
                0709          if (Nr .EQ. 1) nDims=2
                0710          map2gl(1) = 0
                0711          map2gl(2) = 1
                0712          CALL MDS_WRITE_META(
                0713      I              metaFName, dataFName, the_run_name, ' ',
                0714      I              filePrec, nDims, dimList, map2gl, 0, blank8c,
a50692f9cd Jean*0715      I              0, dummyRL, oneRL, irecord, myIter, myThid )
de416ebcde Patr*0716 C End of bi,bj loops
                0717        enddo
                0718       enddo
                0719 C End of ip,jp loops
                0720        enddo
                0721       enddo
                0722
989416fbdf Patr*0723       _END_MASTER( myThid )
716f92c745 Patr*0724
db322dbd40 Jean*0725 #else /* ALLOW_AUTODIFF */
                0726       STOP 'ABNORMAL END: S/R MDSWRITEFIELD_XZ_GL is empty'
                0727 #endif /* ALLOW_AUTODIFF */
de416ebcde Patr*0728 C     ------------------------------------------------------------------
db322dbd40 Jean*0729       RETURN
                0730       END
                0731
                0732 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
de416ebcde Patr*0733
                0734       SUBROUTINE MDSWRITEFIELD_YZ_GL(
                0735      I   fName,
                0736      I   filePrec,
                0737      I   arrType,
                0738      I   nNz,
                0739      I   arr_gl,
                0740      I   irecord,
                0741      I   myIter,
                0742      I   myThid )
                0743 C
                0744 C Arguments:
                0745 C
db322dbd40 Jean*0746 C fName      string  :: base name for file to write
                0747 C filePrec   integer :: number of bits per word in file (32 or 64)
                0748 C arrType    char(2) :: declaration of "arr": either "RS" or "RL"
                0749 C nNz        integer :: size of third dimension: normally either 1 or Nr
                0750 C arr         RS/RL  :: array to write, arr(:,:,nNz,:,:)
                0751 C irecord    integer :: record number to write
                0752 C myIter     integer :: time step number
                0753 C myThid     integer :: thread identifier
de416ebcde Patr*0754 C
                0755 C MDSWRITEFIELD creates either a file of the form "fName.data" and
                0756 C "fName.meta" if the logical flag "globalFile" is set true. Otherwise
                0757 C it creates MDS tiled files of the form "fName.xxx.yyy.data" and
                0758 C "fName.xxx.yyy.meta". A meta-file is always created.
                0759 C Currently, the meta-files are not read because it is difficult
                0760 C to parse files in fortran. We should read meta information before
                0761 C adding records to an existing multi-record file.
                0762 C The precision of the file is decsribed by filePrec, set either
                0763 C to floatPrec32 or floatPrec64. The precision or declaration of
                0764 C the array argument must be consistently described by the char*(2)
                0765 C string arrType, either "RS" or "RL". nNz allows for both 2-D and
                0766 C 3-D arrays to be handled. nNz=1 implies a 2-D model field and
                0767 C nNz=Nr implies a 3-D model field. irecord is the record number
                0768 C to be read and must be >= 1. NOTE: It is currently assumed that
                0769 C the highest record number in the file was the last record written.
                0770 C Nor is there a consistency check between the routine arguments and file.
                0771 C ie. if your write record 2 after record 4 the meta information
                0772 C will record the number of records to be 2. This, again, is because
                0773 C we have read the meta information. To be fixed.
                0774 C
                0775 C Created: 03/16/99 adcroft@mit.edu
                0776 C
                0777 C Changed: 05/31/00 heimbach@mit.edu
                0778 C          open(dUnit, ..., status='old', ... -> status='unknown'
                0779
                0780       implicit none
                0781 C Global variables / common blocks
                0782 #include "SIZE.h"
                0783 #include "EEPARAMS.h"
                0784 #include "PARAMS.h"
                0785
                0786 C Routine arguments
                0787       character*(*) fName
                0788       integer filePrec
                0789       character*(2) arrType
                0790       integer nNz
                0791 cph(
                0792 cph      Real arr(*)
                0793       _RL arr_gl(nSx,nPx,sNy,nSy,nPy,Nr)
                0794 cph)
                0795       integer irecord
                0796       integer myIter
                0797       integer myThid
db322dbd40 Jean*0798
                0799 #ifdef ALLOW_AUTODIFF
de416ebcde Patr*0800 C Functions
                0801       integer ILNBLNK
                0802       integer MDS_RECLEN
                0803 C Local variables
47c8a35ff3 Jean*0804       character*(MAX_LEN_FNAM) dataFName,metaFName
989416fbdf Patr*0805       integer ip,jp,iG,jG,irec,bi,bj,jj,k,dUnit,IL
de416ebcde Patr*0806       Real*4 r4seg(sNy)
                0807       Real*8 r8seg(sNy)
                0808       _RL arr(1-oLy:sNy+oLy,Nr,nSx,nSy)
b714306922 Jean*0809       INTEGER dimList(3,3), nDims, map2gl(2)
                0810       _RL dummyRL(1)
                0811       CHARACTER*8 blank8c
de416ebcde Patr*0812       integer length_of_rec
                0813       logical fileIsOpen
                0814       character*(max_len_mbuf) msgbuf
                0815 C     ------------------------------------------------------------------
                0816
b714306922 Jean*0817       DATA dummyRL(1) / 0. _d 0 /
                0818       DATA blank8c / '        ' /
                0819
de416ebcde Patr*0820 C Only do I/O if I am the master thread
                0821       _BEGIN_MASTER( myThid )
                0822
b2fffc7e1a Jean*0823 #ifndef REAL4_IS_SLOW
                0824       if (arrType .eq. 'RS') then
                0825        write(msgbuf,'(a)')
                0826      &   ' MDSWRITEFIELD_YZ_GL is wrong for arrType="RS" (=real*4)'
                0827        call print_error( msgbuf, mythid )
                0828        stop 'ABNORMAL END: S/R MDSWRITEFIELD_YZ_GL'
                0829       endif
                0830 #endif
                0831
de416ebcde Patr*0832 C Record number must be >= 1
                0833       if (irecord .LT. 1) then
                0834        write(msgbuf,'(a,i9.8)')
                0835      &   ' MDSWRITEFIELD_YZ_GL: argument irecord = ',irecord
                0836        call print_message( msgbuf, standardmessageunit,
                0837      &                     SQUEEZE_RIGHT , mythid)
                0838        write(msgbuf,'(a)')
                0839      &   ' MDSWRITEFIELD_YZ_GL: invalid value for irecord'
                0840        call print_error( msgbuf, mythid )
                0841        stop 'ABNORMAL END: S/R MDSWRITEFIELD_YZ_GL'
                0842       endif
                0843
                0844 C Assume nothing
                0845       fileIsOpen=.FALSE.
                0846       IL=ILNBLNK( fName )
                0847
                0848 C Assign a free unit number as the I/O channel for this routine
                0849       call MDSFINDUNIT( dUnit, mythid )
                0850
                0851
db322dbd40 Jean*0852 C Loop over all processors
de416ebcde Patr*0853       do jp=1,nPy
                0854       do ip=1,nPx
                0855 C Loop over all tiles
                0856       do bj=1,nSy
                0857        do bi=1,nSx
                0858 C If we are writing to a tiled MDS file then we open each one here
                0859          iG=bi+(ip-1)*nsx ! Kludge until unstructered tiles
                0860          jG=bj+(jp-1)*nsy ! Kludge until unstructered tiles
47c8a35ff3 Jean*0861          write(dataFname,'(2a,i3.3,a,i3.3,a)')
de416ebcde Patr*0862      &              fName(1:IL),'.',iG,'.',jG,'.data'
                0863          if (irecord .EQ. 1) then
                0864           length_of_rec=MDS_RECLEN( filePrec, sNy, mythid )
                0865           open( dUnit, file=dataFName, status=_NEW_STATUS,
                0866      &       access='direct', recl=length_of_rec )
                0867           fileIsOpen=.TRUE.
                0868          else
                0869           length_of_rec=MDS_RECLEN( filePrec, sNy, mythid )
                0870           open( dUnit, file=dataFName, status=_OLD_STATUS,
                0871      &       access='direct', recl=length_of_rec )
                0872           fileIsOpen=.TRUE.
                0873          endif
                0874         if (fileIsOpen) then
                0875          do k=1,Nr
                0876             do jj=1,sNy
                0877                arr(jj,k,bi,bj)=arr_gl(bi,ip,jj,bj,jp,k)
                0878             enddo
                0879             iG = 0
                0880             jG = 0
                0881             irec=k + Nr*(irecord-1)
                0882            if (filePrec .eq. precFloat32) then
                0883             if (arrType .eq. 'RS') then
b2fffc7e1a Jean*0884 #ifdef REAL4_IS_SLOW
de416ebcde Patr*0885              call MDS_SEG4toRS_2D(sNy,oLy,nNz,bi,bj,k,.FALSE.,r4seg,arr)
b2fffc7e1a Jean*0886 #endif
de416ebcde Patr*0887             elseif (arrType .eq. 'RL') then
                0888              call MDS_SEG4toRL_2D(sNy,oLy,nNz,bi,bj,k,.FALSE.,r4seg,arr)
                0889             else
                0890              write(msgbuf,'(a)')
                0891      &         ' MDSWRITEFIELD_YZ_GL: illegal value for arrType'
                0892              call print_error( msgbuf, mythid )
                0893              stop 'ABNORMAL END: S/R MDSWRITEFIELD_YZ_GL'
                0894             endif
                0895 #ifdef _BYTESWAPIO
                0896             call MDS_BYTESWAPR4( sNy, r4seg )
                0897 #endif
                0898             write(dUnit,rec=irec) r4seg
                0899            elseif (filePrec .eq. precFloat64) then
                0900             if (arrType .eq. 'RS') then
b2fffc7e1a Jean*0901 #ifdef REAL4_IS_SLOW
de416ebcde Patr*0902              call MDS_SEG8toRS_2D(sNy,oLy,nNz,bi,bj,k,.FALSE.,r8seg,arr)
b2fffc7e1a Jean*0903 #endif
de416ebcde Patr*0904             elseif (arrType .eq. 'RL') then
                0905              call MDS_SEG8toRL_2D(sNy,oLy,nNz,bi,bj,k,.FALSE.,r8seg,arr)
                0906             else
                0907              write(msgbuf,'(a)')
                0908      &         ' MDSWRITEFIELD_YZ_GL: illegal value for arrType'
                0909              call print_error( msgbuf, mythid )
                0910              stop 'ABNORMAL END: S/R MDSWRITEFIELD_YZ_GL'
                0911             endif
                0912 #ifdef _BYTESWAPIO
                0913             call MDS_BYTESWAPR8( sNy, r8seg )
                0914 #endif
                0915             write(dUnit,rec=irec) r8seg
                0916            else
                0917             write(msgbuf,'(a)')
                0918      &        ' MDSWRITEFIELD_YZ_GL: illegal value for filePrec'
                0919             call print_error( msgbuf, mythid )
                0920             stop 'ABNORMAL END: S/R MDSWRITEFIELD_YZ_GL'
                0921            endif
                0922 C End of k loop
                0923          enddo
                0924         else
                0925          write(msgbuf,'(a)')
                0926      &     ' MDSWRITEFIELD_YZ_GL: I should never get to this point'
                0927          call print_error( msgbuf, mythid )
                0928          stop 'ABNORMAL END: S/R MDSWRITEFIELD_YZ_GL'
                0929         endif
                0930 C If we were writing to a tiled MDS file then we close it here
                0931         if (fileIsOpen) then
                0932          close( dUnit )
                0933          fileIsOpen = .FALSE.
                0934         endif
                0935 C Create meta-file for each tile if we are tiling
                0936          iG=bi+(ip-1)*nsx ! Kludge until unstructered tiles
                0937          jG=bj+(jp-1)*nsy ! Kludge until unstructered tiles
47c8a35ff3 Jean*0938          write(metaFname,'(2a,i3.3,a,i3.3,a)')
de416ebcde Patr*0939      &              fName(1:IL),'.',iG,'.',jG,'.meta'
                0940          dimList(1,1)=Nx
                0941          dimList(2,1)=(ip-1)*nSx+bi
                0942          dimList(3,1)=ip*nSx+bi
                0943          dimList(1,2)=Ny
                0944          dimList(2,2)=((jp-1)*nSy+(bj-1))*sNy+1
                0945          dimList(3,2)=((jp-1)*nSy+bj)*sNy
                0946          dimList(1,3)=Nr
                0947          dimList(2,3)=1
                0948          dimList(3,3)=Nr
b714306922 Jean*0949          nDims=3
                0950          if (Nr .EQ. 1) nDims=2
                0951          map2gl(1) = 0
                0952          map2gl(2) = 1
                0953          CALL MDS_WRITE_META(
                0954      I              metaFName, dataFName, the_run_name, ' ',
                0955      I              filePrec, nDims, dimList, map2gl, 0, blank8c,
a50692f9cd Jean*0956      I              0, dummyRL, oneRL, irecord, myIter, myThid )
de416ebcde Patr*0957 C End of bi,bj loops
                0958        enddo
                0959       enddo
                0960 C End of ip,jp loops
                0961        enddo
                0962       enddo
                0963
                0964       _END_MASTER( myThid )
                0965
db322dbd40 Jean*0966 #else /* ALLOW_AUTODIFF */
                0967       STOP 'ABNORMAL END: S/R MDSWRITEFIELD_YZ_GL is empty'
                0968 #endif /* ALLOW_AUTODIFF */
de416ebcde Patr*0969 C     ------------------------------------------------------------------
db322dbd40 Jean*0970       RETURN
                0971       END