pkg/ctrl/ctrl_set_unpack_xyz.F

7bfe6112e8 Jean*0001 #include "CTRL_OPTIONS.h"
5d5c0b0d52 Patr*0002
                0003       subroutine ctrl_set_unpack_xyz(
5cf4364659 Mart*0004      &     lxxadxx, cunit, ivar, fname, masktype, weighttype,
4d72283393 Mart*0005      &     weightfld, nwetglobal, myThid )
5d5c0b0d52 Patr*0006
                0007 c     ==================================================================
                0008 c     SUBROUTINE ctrl_set_unpack_xyz
                0009 c     ==================================================================
                0010 c
7109a141b2 Patr*0011 c     o Unpack the control vector such that land points are filled in.
                0012 c
                0013 c     o Use a more precise nondimensionalization that depends on (x,y)
                0014 c       Added weighttype to the argument list so that I can geographically
                0015 c       vary the nondimensionalization.
                0016 c       gebbie@mit.edu, 18-Mar-2003
5d5c0b0d52 Patr*0017 c
                0018 c     ==================================================================
                0019
                0020       implicit none
                0021
                0022 c     == global variables ==
                0023
                0024 #include "EEPARAMS.h"
                0025 #include "SIZE.h"
                0026 #include "PARAMS.h"
                0027 #include "GRID.h"
                0028
5cf4364659 Mart*0029 #include "CTRL_SIZE.h"
4d72283393 Mart*0030 #include "CTRL.h"
65754df434 Mart*0031 #include "OPTIMCYCLE.h"
5d5c0b0d52 Patr*0032
                0033 c     == routine arguments ==
                0034
0ba65c94ff Patr*0035       logical lxxadxx
5d5c0b0d52 Patr*0036       integer cunit
5cf4364659 Mart*0037       integer ivar
de57a2ec4b Mart*0038       character*(MAX_LEN_FNAM)   fname
45913d6a59 Patr*0039       character*(  9) masktype
de57a2ec4b Mart*0040       character*(MAX_LEN_FNAM) weighttype
9f5240b52a Jean*0041       _RL     weightfld( Nr,nSx,nSy )
                0042       integer nwetglobal(Nr)
4d72283393 Mart*0043       integer myThid
5d5c0b0d52 Patr*0044
dac57cef35 Patr*0045 #ifndef EXCLUDE_CTRL_PACK
9f5240b52a Jean*0046 c     == external ==
                0047       integer  ilnblnk
                0048       external ilnblnk
5d5c0b0d52 Patr*0049
9f5240b52a Jean*0050 c     == local variables ==
5d5c0b0d52 Patr*0051       integer bi,bj
                0052       integer i,j,k
9f5240b52a Jean*0053       integer ii, irec
                0054       integer cbuffindex
                0055       real*4 cbuff( sNx*nSx*nPx*sNy*nSy*nPy )
de57a2ec4b Mart*0056       character*(MAX_LEN_FNAM) cfile2, cfile3
5cf4364659 Mart*0057 C     These variables are read-in from file, but not used much
                0058       integer loc_ncbuffindex
                0059       integer loc_i
                0060       integer loc_j
                0061       integer loc_k
                0062       integer loc_ncvarindex
9f5240b52a Jean*0063 C========================================================================
                0064 # ifndef ALLOW_PACKUNPACK_METHOD2
                0065       integer ip,jp
5d5c0b0d52 Patr*0066       integer itlo,ithi
                0067       integer jtlo,jthi
                0068       integer jmin,jmax
                0069       integer imin,imax
9f5240b52a Jean*0070       _RL     globmsk  ( sNx,nSx,nPx,sNy,nSy,nPy,Nr )
                0071       _RL     globfld3d( sNx,nSx,nPx,sNy,nSy,nPy,Nr )
7109a141b2 Patr*0072 #ifdef CTRL_UNPACK_PRECISE
5b7a03205a Mart*0073       integer il
de57a2ec4b Mart*0074       character*(MAX_LEN_FNAM) weightname
9f5240b52a Jean*0075       _RL   weightfld3d( sNx,nSx,nPx,sNy,nSy,nPy,Nr )
7109a141b2 Patr*0076 #endif
9f5240b52a Jean*0077       real*4 globfldtmp2( sNx,nSx,nPx,sNy,nSy,nPy )
                0078       real*4 globfldtmp3( sNx,nSx,nPx,sNy,nSy,nPy )
0ba65c94ff Patr*0079       _RL delZnorm
                0080       integer reclen, irectrue
                0081       integer cunit2, cunit3
9f5240b52a Jean*0082 # else /* ALLOW_PACKUNPACK_METHOD2 */
                0083       integer il
                0084       _RL msk3d(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
                0085       real*8 msk2d_buf(sNx,sNy,nSx,nSy)
                0086       real*8 msk2d_buf_glo(Nx,Ny)
                0087       real*8 fld2d_buf(sNx,sNy,nSx,nSy)
                0088       real*8 fld2d_buf_glo(Nx,Ny)
                0089       _RL fld3dDim(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
                0090       _RL fld3dNodim(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
                0091 #ifdef CTRL_UNPACK_PRECISE
                0092       _RL wei3d(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
                0093 #endif
                0094       _RL delZnorm
                0095       _RL dummy
                0096 # endif /* ALLOW_PACKUNPACK_METHOD2 */
                0097 c     == end of interface ==
5d5c0b0d52 Patr*0098
9f5240b52a Jean*0099 # ifndef ALLOW_PACKUNPACK_METHOD2
5d5c0b0d52 Patr*0100
                0101       jtlo = 1
9f5240b52a Jean*0102       jthi = nSy
5d5c0b0d52 Patr*0103       itlo = 1
9f5240b52a Jean*0104       ithi = nSx
5d5c0b0d52 Patr*0105       jmin = 1
9f5240b52a Jean*0106       jmax = sNy
5d5c0b0d52 Patr*0107       imin = 1
9f5240b52a Jean*0108       imax = sNx
5d5c0b0d52 Patr*0109
0ba65c94ff Patr*0110 #ifdef CTRL_DELZNORM
                0111       delZnorm = 0.
                0112       do k = 1, Nr
                0113          delZnorm = delZnorm + delR(k)/FLOAT(Nr)
                0114       enddo
                0115 #endif
                0116
5d5c0b0d52 Patr*0117 c     Initialise temporary file
9f5240b52a Jean*0118       do k = 1,Nr
3145d51f22 Patr*0119        do jp = 1,nPy
                0120         do bj = jtlo,jthi
                0121          do j = jmin,jmax
                0122           do ip = 1,nPx
                0123            do bi = itlo,ithi
                0124             do i = imin,imax
                0125              globfld3d  (i,bi,ip,j,bj,jp,k) = 0. _d 0
                0126              globmsk    (i,bi,ip,j,bj,jp,k) = 0. _d 0
                0127              globfldtmp2(i,bi,ip,j,bj,jp)   = 0. _d 0
                0128              globfldtmp3(i,bi,ip,j,bj,jp)   = 0. _d 0
5d5c0b0d52 Patr*0129             enddo
3145d51f22 Patr*0130            enddo
                0131           enddo
5d5c0b0d52 Patr*0132          enddo
3145d51f22 Patr*0133         enddo
                0134        enddo
5d5c0b0d52 Patr*0135       enddo
                0136
                0137 c--   Only the master thread will do I/O.
4d72283393 Mart*0138       _BEGIN_MASTER( myThid )
5d5c0b0d52 Patr*0139
0ba65c94ff Patr*0140 #ifdef CTRL_DELZNORM
9f5240b52a Jean*0141       do k = 1, Nr
cf705a6c8e Mart*0142        print *, 'ph-delznorm ', k, delZnorm, delR(k)
                0143        print *, 'ph-weight   ', weightfld(k,1,1)
0ba65c94ff Patr*0144       enddo
                0145 #endif
                0146
                0147       if ( doPackDiag ) then
cf705a6c8e Mart*0148        if ( lxxadxx ) then
de57a2ec4b Mart*0149         write(cfile2,'(a,I3.3,a,I4.4,a)')
951926fb9b Jean*0150      &           'diag_unpack_nondim_ctrl_',
5cf4364659 Mart*0151      &           ivar, '_', optimcycle, '.bin'
de57a2ec4b Mart*0152         write(cfile3,'(a,I3.3,a,I4.4,a)')
951926fb9b Jean*0153      &           'diag_unpack_dimens_ctrl_',
5cf4364659 Mart*0154      &           ivar, '_', optimcycle, '.bin'
cf705a6c8e Mart*0155        else
de57a2ec4b Mart*0156         write(cfile2,'(a,I3.3,a,I4.4,a)')
951926fb9b Jean*0157      &           'diag_unpack_nondim_grad_',
5cf4364659 Mart*0158      &           ivar, '_', optimcycle, '.bin'
de57a2ec4b Mart*0159         write(cfile3,'(a,I3.3,a,I4.4,a)')
951926fb9b Jean*0160      &           'diag_unpack_dimens_grad_',
5cf4364659 Mart*0161      &           ivar, '_', optimcycle, '.bin'
cf705a6c8e Mart*0162        endif
                0163
                0164        reclen = FLOAT(sNx*nSx*nPx*sNy*nSy*nPy*4)
4d72283393 Mart*0165        call mdsfindunit( cunit2, myThid )
cf705a6c8e Mart*0166        open( cunit2, file=cfile2, status='unknown',
                0167      &       access='direct', recl=reclen )
4d72283393 Mart*0168        call mdsfindunit( cunit3, myThid )
cf705a6c8e Mart*0169        open( cunit3, file=cfile3, status='unknown',
                0170      &       access='direct', recl=reclen )
0ba65c94ff Patr*0171       endif
                0172
7109a141b2 Patr*0173 #ifdef CTRL_UNPACK_PRECISE
3145d51f22 Patr*0174       if (weighttype.NE.' ') then
                0175        il=ilnblnk( weighttype)
de57a2ec4b Mart*0176        write(weightname,'(a)') weighttype(1:il)
3145d51f22 Patr*0177        call MDSREADFIELD_3D_GL(
7109a141b2 Patr*0178      &     weightname, ctrlprec, 'RL',
4d72283393 Mart*0179      &     Nr, weightfld3d, 1, myThid)
3145d51f22 Patr*0180       else
9f5240b52a Jean*0181        do k = 1,Nr
3145d51f22 Patr*0182         do jp = 1,nPy
                0183          do bj = jtlo,jthi
                0184           do j = jmin,jmax
                0185            do ip = 1,nPx
                0186             do bi = itlo,ithi
                0187              do i = imin,imax
                0188               weightfld3d(i,bi,ip,j,bj,jp,k) = 1. _d 0
                0189              enddo
                0190             enddo
                0191            enddo
                0192           enddo
                0193          enddo
                0194         enddo
                0195        enddo
                0196       endif
7109a141b2 Patr*0197 #endif
                0198
951926fb9b Jean*0199       call MDSREADFIELD_3D_GL(
5d5c0b0d52 Patr*0200      &     masktype, ctrlprec, 'RL',
4d72283393 Mart*0201      &     Nr, globmsk, 1, myThid)
5d5c0b0d52 Patr*0202
5cf4364659 Mart*0203       do irec = 1, ncvarrecs(ivar)
faf44775ba Patr*0204 #ifndef ALLOW_ADMTLM
5cf4364659 Mart*0205        read(cunit) loc_ncvarindex
                0206        if (loc_ncvarindex .NE. ncvarindex(ivar)) then
                0207         IF ( irec.EQ.1 )
                0208      &  print *, 'ctrl_set_unpack_xyz:WARNING: wrong ncvarindex ',
                0209      &           loc_ncvarindex, ncvarindex(ivar)
                0210 # ifndef READ_OLD_CTRL_PACK_FILE
cf705a6c8e Mart*0211         STOP 'in S/R ctrl_set_unpack_xyz'
5cf4364659 Mart*0212 # endif
cf705a6c8e Mart*0213        endif
5cf4364659 Mart*0214        read(cunit) loc_j
                0215        read(cunit) loc_i
faf44775ba Patr*0216 #endif /* ALLOW_ADMTLM */
cf705a6c8e Mart*0217        do k = 1, Nr
                0218         irectrue = (irec-1)*Nr + k
                0219         if ( doZscaleUnpack ) then
                0220          delZnorm = (delR(1)/delR(k))**delZexp
                0221         else
                0222          delZnorm = 1. _d 0
                0223         endif
                0224         cbuffindex = nwetglobal(k)
                0225         if ( cbuffindex .gt. 0 ) then
faf44775ba Patr*0226 #ifndef ALLOW_ADMTLM
5cf4364659 Mart*0227          read(cunit) loc_ncbuffindex
                0228          if (loc_ncbuffindex .NE. cbuffindex) then
cf705a6c8e Mart*0229           print *, 'WARNING: wrong cbuffindex ',
5cf4364659 Mart*0230      &             loc_ncbuffindex, cbuffindex
cf705a6c8e Mart*0231           STOP 'in S/R ctrl_set_unpack_xyz'
                0232          endif
5cf4364659 Mart*0233          read(cunit) loc_k
                0234          if (loc_k .NE. k) then
cf705a6c8e Mart*0235           print *, 'WARNING: wrong k ',
5cf4364659 Mart*0236      &             loc_k, k
cf705a6c8e Mart*0237           STOP 'in S/R ctrl_set_unpack_xyz'
                0238          endif
e324d8bc16 Patr*0239 cph#endif /* ALLOW_ADMTLM */
cf705a6c8e Mart*0240          read(cunit) (cbuff(ii), ii=1,cbuffindex)
e324d8bc16 Patr*0241 #endif /* ALLOW_ADMTLM */
cf705a6c8e Mart*0242         endif
faf44775ba Patr*0243 c
cf705a6c8e Mart*0244         cbuffindex = 0
                0245         do jp = 1,nPy
                0246          do bj = jtlo,jthi
                0247           do j = jmin,jmax
                0248            do ip = 1,nPx
                0249             do bi = itlo,ithi
                0250              do i = imin,imax
                0251               if ( globmsk(i,bi,ip,j,bj,jp,k) .ne. 0. ) then
                0252                cbuffindex = cbuffindex + 1
                0253                globfld3d(i,bi,ip,j,bj,jp,k) = cbuff(cbuffindex)
0ba65c94ff Patr*0254 cph(
cf705a6c8e Mart*0255                globfldtmp2(i,bi,ip,j,bj,jp) = cbuff(cbuffindex)
0ba65c94ff Patr*0256 cph)
faf44775ba Patr*0257 #ifdef ALLOW_ADMTLM
cf705a6c8e Mart*0258                nveccount = nveccount + 1
                0259                globfld3d(i,bi,ip,j,bj,jp,k) = phtmpadmtlm(nveccount)
85a8618ded Patr*0260 cph(
cf705a6c8e Mart*0261                globfldtmp2(i,bi,ip,j,bj,jp) = phtmpadmtlm(nveccount)
85a8618ded Patr*0262 cph)
faf44775ba Patr*0263 #endif
cf705a6c8e Mart*0264               else
                0265                globfld3d(i,bi,ip,j,bj,jp,k) = 0. _d 0
                0266               endif
0ba65c94ff Patr*0267 cph(
cf705a6c8e Mart*0268               globfldtmp3(i,bi,ip,j,bj,jp) =
                0269      &             globfld3d(i,bi,ip,j,bj,jp,k)
0ba65c94ff Patr*0270 cph)
5d5c0b0d52 Patr*0271              enddo
                0272             enddo
cf705a6c8e Mart*0273            enddo
                0274           enddo
                0275          enddo
                0276         enddo
5d5c0b0d52 Patr*0277 c
cf705a6c8e Mart*0278         if ( doPackDiag ) then
                0279          write(cunit2,rec=irectrue) globfldtmp2
                0280          write(cunit3,rec=irectrue) globfldtmp3
                0281         endif
0ba65c94ff Patr*0282 c
cf705a6c8e Mart*0283        enddo
951926fb9b Jean*0284
cf705a6c8e Mart*0285        call MDSWRITEFIELD_3D_GL( fname, ctrlprec, 'RL',
                0286      &                           Nr, globfld3d,
4d72283393 Mart*0287      &                           irec,  optimcycle, myThid)
5d5c0b0d52 Patr*0288
                0289       enddo
                0290
0ba65c94ff Patr*0291       if ( doPackDiag ) then
cf705a6c8e Mart*0292        close ( cunit2 )
                0293        close ( cunit3 )
0ba65c94ff Patr*0294       endif
                0295
4d72283393 Mart*0296       _END_MASTER( myThid )
5d5c0b0d52 Patr*0297
9f5240b52a Jean*0298 # else /* ALLOW_PACKUNPACK_METHOD2 */
23a37235f2 Gael*0299
                0300 c-- part 1: preliminary reads and definitions
                0301
4b499ecd0b Patr*0302 #ifdef CTRL_UNPACK_PRECISE
1c8d09be4c Gael*0303 #ifdef ALLOW_AUTODIFF
23a37235f2 Gael*0304       call active_read_xyz(weighttype, wei3d, 1,
4d72283393 Mart*0305      &    .FALSE., .FALSE., 0 , myThid, dummy)
1c8d09be4c Gael*0306 #else
                0307       CALL READ_REC_XYZ_RL( weighttype, wei3d, 1, 1, myThid )
                0308 #endif
23a37235f2 Gael*0309 #endif
                0310
1c8d09be4c Gael*0311 #ifdef ALLOW_AUTODIFF
cf2ce61250 Jean*0312       call active_read_xyz(masktype, msk3d, 1,
4d72283393 Mart*0313      &    .FALSE., .FALSE., 0 , myThid, dummy)
1c8d09be4c Gael*0314 #else
                0315       CALL READ_REC_XYZ_RL( masktype, msk3d, 1, 1, myThid )
                0316 #endif
23a37235f2 Gael*0317
                0318       if ( doPackDiag ) then
cf705a6c8e Mart*0319        il = ilnblnk( fname )
                0320        if ( lxxadxx ) then
de57a2ec4b Mart*0321         write(cfile2,'(2a)') fname(1:il),'.unpack_ctrl_adim'
                0322         write(cfile3,'(2a)') fname(1:il),'.unpack_ctrl_dim'
cf705a6c8e Mart*0323        else
de57a2ec4b Mart*0324         write(cfile2,'(2a)') fname(1:il),'.unpack_grad_adim'
                0325         write(cfile3,'(2a)') fname(1:il),'.unpack_grad_dim'
cf705a6c8e Mart*0326        endif
23a37235f2 Gael*0327       endif
                0328
                0329 c-- part 2: loop over records
                0330
5cf4364659 Mart*0331       do irec = 1, ncvarrecs(ivar)
23a37235f2 Gael*0332
                0333 c-- 2.1: array <- buffer <- global buffer <- global file
                0334
                0335 #ifndef ALLOW_ADMTLM
4d72283393 Mart*0336        _BEGIN_MASTER( myThid )
cf705a6c8e Mart*0337        IF ( myProcId .eq. 0 ) THEN
5cf4364659 Mart*0338         read(cunit) loc_ncvarindex
                0339         if (loc_ncvarindex .NE. ncvarindex(ivar)) then
                0340          IF ( irec.EQ.1 )
                0341      &   print *, 'ctrl_set_unpack_xyz:WARNING: wrong ncvarindex ',
                0342      &            loc_ncvarindex, ncvarindex(ivar)
                0343 # ifndef READ_OLD_CTRL_PACK_FILE
cf705a6c8e Mart*0344          STOP 'in S/R ctrl_set_unpack_xyz'
5cf4364659 Mart*0345 # endif
cf705a6c8e Mart*0346         endif
5cf4364659 Mart*0347         read(cunit) loc_j
                0348         read(cunit) loc_i
cf705a6c8e Mart*0349        ENDIF
4d72283393 Mart*0350        _END_MASTER( myThid )
cf705a6c8e Mart*0351        _BARRIER
23a37235f2 Gael*0352 #endif /* ALLOW_ADMTLM */
                0353
cf705a6c8e Mart*0354        do k = 1, Nr
23a37235f2 Gael*0355
                0356         CALL MDS_PASS_R8toRL( msk2d_buf, msk3d,
cf705a6c8e Mart*0357      &                        0, 0, 1, k, Nr, 0, 0, .FALSE., myThid )
23a37235f2 Gael*0358         CALL BAR2( myThid )
                0359         CALL GATHER_2D_R8( msk2d_buf_glo, msk2d_buf,
cf705a6c8e Mart*0360      &                     Nx,Ny,.FALSE.,.TRUE.,myThid)
23a37235f2 Gael*0361         CALL BAR2( myThid )
                0362
4d72283393 Mart*0363         _BEGIN_MASTER( myThid )
cf705a6c8e Mart*0364         cbuffindex = nwetglobal(k)
23a37235f2 Gael*0365         IF ( myProcId .eq. 0 ) THEN
                0366
                0367 #ifndef ALLOW_ADMTLM
cf705a6c8e Mart*0368          if ( cbuffindex .gt. 0) then
5cf4364659 Mart*0369           read(cunit) loc_ncbuffindex
                0370           read(cunit) loc_k
                0371           if (loc_ncbuffindex .NE. cbuffindex) then
cf705a6c8e Mart*0372            print *, 'WARNING: wrong cbuffindex ',
5cf4364659 Mart*0373      &              loc_ncbuffindex, cbuffindex
cf705a6c8e Mart*0374            STOP 'in S/R ctrl_set_unpack_xyz'
23a37235f2 Gael*0375           endif
5cf4364659 Mart*0376           if (loc_k .NE. k) then
                0377            print *, 'WARNING: wrong k ', loc_k, k
cf705a6c8e Mart*0378            STOP 'in S/R ctrl_set_unpack_xyz'
23a37235f2 Gael*0379           endif
                0380           read(cunit) (cbuff(ii), ii=1,cbuffindex)
cf705a6c8e Mart*0381          endif
23a37235f2 Gael*0382 #endif
                0383
cf705a6c8e Mart*0384          cbuffindex = 0
                0385          DO j=1,Ny
23a37235f2 Gael*0386           DO i=1,Nx
cf705a6c8e Mart*0387            if (msk2d_buf_glo(i,j) .ne. 0. ) then
                0388             cbuffindex = cbuffindex + 1
                0389             fld2d_buf_glo(i,j) = cbuff(cbuffindex)
                0390            endif
23a37235f2 Gael*0391           ENDDO
cf705a6c8e Mart*0392          ENDDO
23a37235f2 Gael*0393
                0394         ENDIF
4d72283393 Mart*0395         _END_MASTER( myThid )
23a37235f2 Gael*0396         _BARRIER
                0397
                0398         CALL BAR2( myThid )
                0399         CALL SCATTER_2D_R8( fld2d_buf_glo, fld2d_buf,
cf705a6c8e Mart*0400      &                      Nx,Ny,.FALSE.,.TRUE.,myThid)
23a37235f2 Gael*0401         CALL BAR2( myThid )
                0402         CALL MDS_PASS_R8toRL( fld2d_buf, fld3dNodim,
cf705a6c8e Mart*0403      &                        0, 0, 1, k, Nr, 0, 0, .TRUE., myThid )
23a37235f2 Gael*0404
cf705a6c8e Mart*0405        enddo !do k = 1, Nr
23a37235f2 Gael*0406
                0407 c-- 2.2: normalize field if needed
cf705a6c8e Mart*0408        DO bj = myByLo(myThid), myByHi(myThid)
                0409         DO bi = myBxLo(myThid), myBxHi(myThid)
                0410          DO k=1,Nr
                0411           if ( doZscalePack ) then
                0412            delZnorm = (delR(1)/delR(k))**delZexp
                0413           else
                0414            delZnorm = 1. _d 0
                0415           endif
                0416           DO j=1,sNy
                0417            DO i=1,sNx
                0418             if (msk3d(i,j,k,bi,bj).EQ.0. _d 0) then
                0419              fld3dDim(i,j,k,bi,bj)=0. _d 0
                0420              fld3dNodim(i,j,k,bi,bj)=0. _d 0
                0421             else
23a37235f2 Gael*0422 #ifdef ALLOW_ADMTLM
cf705a6c8e Mart*0423              nveccount = nveccount + 1
                0424              fld3dNodim(i,j,k,bi,bj)=phtmpadmtlm(nveccount)
cf2ce61250 Jean*0425 #endif
cf705a6c8e Mart*0426              fld3dDim(i,j,k,bi,bj)=fld3dNodim(i,j,k,bi,bj)
23a37235f2 Gael*0427             endif
cf705a6c8e Mart*0428            ENDDO
23a37235f2 Gael*0429           ENDDO
                0430          ENDDO
                0431         ENDDO
                0432        ENDDO
                0433
                0434 c-- 2.3:
cf705a6c8e Mart*0435        if ( doPackDiag ) then
                0436 c     error: twice the same one
                0437         call WRITE_REC_3D_RL( cfile2, ctrlprec,
4d72283393 Mart*0438      &       Nr, fld3dNodim, irec, 0, myThid)
cf705a6c8e Mart*0439         call WRITE_REC_3D_RL( cfile3, ctrlprec,
4d72283393 Mart*0440      &       Nr, fld3dDim, irec, 0, myThid)
cf705a6c8e Mart*0441        endif
23a37235f2 Gael*0442
cf2ce61250 Jean*0443 c-- 2.4:
cf705a6c8e Mart*0444        call WRITE_REC_3D_RL( fname, ctrlprec,
4d72283393 Mart*0445      &      Nr, fld3dDim, irec, 0, myThid)
23a37235f2 Gael*0446
5cf4364659 Mart*0447       enddo !do irec = 1, ncvarrecs(ivar)
23a37235f2 Gael*0448
cf2ce61250 Jean*0449 # endif /* ALLOW_PACKUNPACK_METHOD2 */
23a37235f2 Gael*0450 # endif /* EXCLUDE_CTRL_PACK */
                0451
5d5c0b0d52 Patr*0452       return
                0453       end