pkg/ctrl/ctrl_set_globfld_xz.F

7bfe6112e8 Jean*0001 #include "CTRL_OPTIONS.h"
5d5c0b0d52 Patr*0002
5cf4364659 Mart*0003       SUBROUTINE CTRL_SET_GLOBFLD_XZ(
                0004      I                fname, nRecArg, filePrec, myThid )
5d5c0b0d52 Patr*0005
19ca09a97c Jean*0006 C     ==================================================================
                0007 C     SUBROUTINE ctrl_set_globfld_xz
                0008 C     ==================================================================
                0009 C
                0010 C     o initialise field
                0011 C
                0012 C     started: heimbach@mit.edu, 16-Aug-2001
                0013 C
                0014 C     changed: heimbach@mit.edu 17-Jun-2003
                0015 C              merged changes from Armin to replace write of
                0016 C              nr * globfld2d by 1 * globfld3d
                0017 C              (ad hoc fix to speed up global I/O)
                0018 C
                0019 C     ==================================================================
5d5c0b0d52 Patr*0020
19ca09a97c Jean*0021       IMPLICIT NONE
5d5c0b0d52 Patr*0022
19ca09a97c Jean*0023 C     == global variables ==
5d5c0b0d52 Patr*0024 #include "EEPARAMS.h"
                0025 #include "SIZE.h"
5cf4364659 Mart*0026 c#include "PARAMS.h"
                0027 c#include "CTRL_SIZE.h"
                0028 c#include "CTRL.h"
65754df434 Mart*0029 #include "OPTIMCYCLE.h"
5d5c0b0d52 Patr*0030
19ca09a97c Jean*0031 C     == routine arguments ==
de57a2ec4b Mart*0032       CHARACTER*(MAX_LEN_FNAM) fname
5cf4364659 Mart*0033       INTEGER nRecArg
                0034       INTEGER filePrec
19ca09a97c Jean*0035       INTEGER myThid
                0036
                0037 C     == local variables ==
                0038       INTEGER bi, bj
                0039       INTEGER i, j, k
                0040       INTEGER irec, nrec_nl
                0041 c     _RS dummyRS(1)
                0042       _RL globfld3d(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
                0043       _RL globfldxz(1-OLx:sNx+OLx,Nr,nSx,nSy)
                0044
                0045 C     == end of interface ==
                0046
                0047       DO bj = myByLo(myThid), myByHi(myThid)
                0048         DO bi = myBxLo(myThid), myBxHi(myThid)
                0049 C     Initialise temporary file
                0050           DO k = 1,Nr
                0051              DO i = 1-OLx,sNx+OLx
edf8adef61 Jean*0052                 globfldxz(i,k,bi,bj) = 0. _d 0
19ca09a97c Jean*0053              ENDDO
                0054           ENDDO
                0055 C     Initialise temporary file
                0056           DO k = 1,Nr
                0057             DO j = 1-OLy,sNy+OLy
                0058               DO i = 1-OLx,sNx+OLx
edf8adef61 Jean*0059                 globfld3d(i,j,k,bi,bj) = 0. _d 0
19ca09a97c Jean*0060               ENDDO
                0061             ENDDO
                0062           ENDDO
                0063         ENDDO
                0064       ENDDO
5d5c0b0d52 Patr*0065
19ca09a97c Jean*0066       IF ( useSingleCPUio ) THEN
b94917e7bd Mart*0067 C     MDSWRITEFIELDXZ does not know about useSingleCPUio, so the faster
                0068 C     method that works for .not.useSingleCPUio cannot be used
edf8adef61 Jean*0069         nrec_nl = 0
19ca09a97c Jean*0070       ELSE
5cf4364659 Mart*0071         nrec_nl = INT(nRecArg/Ny)
19ca09a97c Jean*0072       ENDIF
b94917e7bd Mart*0073
19ca09a97c Jean*0074       DO irec = 1, nrec_nl
5cf4364659 Mart*0075         CALL WRITE_REC_3D_RL( fname, filePrec, Nr,
edf8adef61 Jean*0076      &                        globfld3d,
                0077      &                        irec, optimcycle, myThid )
19ca09a97c Jean*0078       ENDDO
                0079
5cf4364659 Mart*0080       DO irec = nrec_nl*Ny+1, nRecArg
19ca09a97c Jean*0081 C--   Call directly MDS_WRITE_SEC_XZ (instead of indirectly via MDSWRITEFIELDXZ)
                0082 C     --> expect zero difference.
                0083 C     In this call, value "False" is passed to 3rd arg "globalFile"
                0084 C             and   value "False" is passed to 4th arg "useCurrentDir,"
5cf4364659 Mart*0085 c       CALL MDS_WRITE_SEC_XZ( fname, filePrec, .FALSE., .FALSE.,
57622776fd Jean*0086 c    I                         'RL', Nr, 1, Nr, globfldxz, dummyRS,
19ca09a97c Jean*0087 c    I                         irec, optimcycle, myThid )
                0088
                0089 C--   The only difference here (vs initial MDSWRITEFIELDXZ call) is that,
57622776fd Jean*0090 C     in WRITE_REC_XZ_RL, argument "globalFile" is not set to FALSE but is
                0091 C     instead taken from RD_WR_SEC common block (but currently set to FALSE
                0092 C     in ini_model_io.F if using OBCS)
5cf4364659 Mart*0093         CALL WRITE_REC_XZ_RL( fname, filePrec,
19ca09a97c Jean*0094      I                        Nr, globfldxz,
                0095      I                        irec, optimcycle, myThid )
                0096       ENDDO
5d5c0b0d52 Patr*0097
edf8adef61 Jean*0098       RETURN
                0099       END