pkg/ctrl/ctrl_set_globfld_xy.F

7bfe6112e8 Jean*0001 #include "CTRL_OPTIONS.h"
5d5c0b0d52 Patr*0002
5cf4364659 Mart*0003       SUBROUTINE CTRL_SET_GLOBFLD_XY(
                0004      I                fname, nRecArg, filePrec, myThid )
5d5c0b0d52 Patr*0005
5cf4364659 Mart*0006 C     ==================================================================
                0007 C     SUBROUTINE ctrl_set_globfld_xy
                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
5cf4364659 Mart*0021       IMPLICIT NONE
5d5c0b0d52 Patr*0022
5cf4364659 Mart*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
5cf4364659 Mart*0031 C     == routine arguments ==
                0032       CHARACTER*(MAX_LEN_FNAM)   fname
                0033       INTEGER nRecArg
                0034       INTEGER filePrec
                0035       INTEGER myThid
5d5c0b0d52 Patr*0036
5cf4364659 Mart*0037 C     == local variables ==
                0038       INTEGER bi, bj
                0039       INTEGER i, j, k
                0040       INTEGER irec, nrec_nl
edf8adef61 Jean*0041       _RL globfld2d(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
de57a2ec4b Mart*0042       _RL globfld3d(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
5d5c0b0d52 Patr*0043
5cf4364659 Mart*0044 C     == end of interface ==
5d5c0b0d52 Patr*0045
5cf4364659 Mart*0046 C     Initialise temporary file
                0047       DO bj = myByLo(myThid), myByHi(myThid)
                0048         DO bi = myBxLo(myThid), myBxHi(myThid)
                0049           DO j = 1-OLy,sNy+OLy
                0050              DO i = 1-OLx,sNx+OLx
edf8adef61 Jean*0051                 globfld2d(i,j,bi,bj) = 0. _d 0
5cf4364659 Mart*0052              ENDDO
                0053           ENDDO
                0054           DO k = 1,Nr
                0055             DO j = 1-OLy,sNy+OLy
                0056               DO i = 1-OLx,sNx+OLx
edf8adef61 Jean*0057                 globfld3d(i,j,k,bi,bj) = 0. _d 0
5cf4364659 Mart*0058               ENDDO
                0059             ENDDO
                0060           ENDDO
                0061         ENDDO
                0062       ENDDO
                0063
                0064       nrec_nl = INT(nRecArg/Nr)
                0065       DO irec = 1,  nrec_nl
                0066         CALL WRITE_REC_3D_RL( fname, filePrec, Nr,
edf8adef61 Jean*0067      &                        globfld3d,
                0068      &                        irec, optimcycle, myThid )
5cf4364659 Mart*0069       ENDDO
7109a141b2 Patr*0070
5cf4364659 Mart*0071       DO irec = nrec_nl*Nr+1, nRecArg
                0072         CALL WRITE_REC_3D_RL( fname, filePrec, 1,
edf8adef61 Jean*0073      &                        globfld2d,
                0074      &                        irec, optimcycle, myThid )
5cf4364659 Mart*0075       ENDDO
5d5c0b0d52 Patr*0076
edf8adef61 Jean*0077       RETURN
                0078       END