pkg/smooth/smooth_diff2d.F

0c3d35c9cd Gael*0001 #include "SMOOTH_OPTIONS.h"
                0002
9f5240b52a Jean*0003       SUBROUTINE SMOOTH_DIFF2D(
                0004      &           fld_in, smooth2Dmask, nbt_in, myThid )
0c3d35c9cd Gael*0005
                0006 C     *==========================================================*
                0007 C     | SUBROUTINE smooth_diff2D
                0008 C     | o Routine that smoothes a 2D field, using diffusion
                0009 C     *==========================================================*
                0010
                0011       IMPLICIT NONE
                0012 #include "SIZE.h"
                0013 #include "EEPARAMS.h"
                0014 #include "GRID.h"
                0015 #include "PARAMS.h"
                0016 #include "SMOOTH.h"
                0017
9f5240b52a Jean*0018       _RL fld_in      (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
7b8b86ab99 Timo*0019       _RS smooth2Dmask(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
9f5240b52a Jean*0020       INTEGER nbt_in
                0021       INTEGER myThid
0c3d35c9cd Gael*0022
9f5240b52a Jean*0023       INTEGER i, j, bi, bj
                0024       INTEGER myIter(nSx,nSy), iloop
                0025       _RL ab15, ab05
7b8b86ab99 Timo*0026       _RL gt_tmp
9f5240b52a Jean*0027       _RL gt_in  (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0028       _RL gtm1_in(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
0c3d35c9cd Gael*0029
9f5240b52a Jean*0030       DO bj=myByLo(myThid),myByHi(myThid)
                0031        DO bi=myBxLo(myThid),myBxHi(myThid)
0c3d35c9cd Gael*0032         DO j = 1,sNy
                0033          DO i = 1,sNx
                0034            gt_in(i,j,bi,bj)   = 0. _d 0
9f5240b52a Jean*0035            gtm1_in(i,j,bi,bj) = 0. _d 0
0c3d35c9cd Gael*0036          ENDDO
                0037         ENDDO
                0038        ENDDO
                0039       ENDDO
                0040
9f5240b52a Jean*0041       CALL EXCH_XY_RL( fld_in,  myThid )
                0042       CALL EXCH_XY_RL( gt_in,   myThid )
                0043       CALL EXCH_XY_RL( gtm1_in, myThid )
0c3d35c9cd Gael*0044
9f5240b52a Jean*0045       DO iloop=1,nbt_in
0c3d35c9cd Gael*0046
9f5240b52a Jean*0047         DO bj=myByLo(myThid),myByHi(myThid)
                0048          DO bi=myBxLo(myThid),myBxHi(myThid)
                0049           DO j = 1,sNy
                0050            DO i = 1,sNx
0c3d35c9cd Gael*0051
9f5240b52a Jean*0052             gt_in(i,j,bi,bj)=0.
0c3d35c9cd Gael*0053
9f5240b52a Jean*0054             IF (smooth2Dmask(i,j,bi,bj).NE.0.) THEN
950129bbe3 Gael*0055
9f5240b52a Jean*0056              gt_in(i,j,bi,bj) = gt_in(i,j,bi,bj)
                0057      &         + smooth2D_Kux(i,j,bi,bj)*dyG(i,j,bi,bj)
                0058      &          *smooth2Dmask(i,j,bi,bj)*smooth2Dmask(i-1,j,bi,bj)
                0059      &          *( fld_in(i,j,bi,bj) - fld_in(i-1,j,bi,bj) )
                0060      &          *recip_dxC(i,j,bi,bj)
0c3d35c9cd Gael*0061
9f5240b52a Jean*0062              gt_in(i,j,bi,bj) = gt_in(i,j,bi,bj)
                0063      &         + smooth2D_Kux(i+1,j,bi,bj)*dyG(i+1,j,bi,bj)
                0064      &          *smooth2Dmask(i,j,bi,bj)*smooth2Dmask(i+1,j,bi,bj)
                0065      &          *( fld_in(i,j,bi,bj) - fld_in(i+1,j,bi,bj) )
                0066      &          *recip_dxC(i+1,j,bi,bj)
0c3d35c9cd Gael*0067
9f5240b52a Jean*0068              gt_in(i,j,bi,bj) = gt_in(i,j,bi,bj)
                0069      &         + smooth2D_Kvy(i,j,bi,bj)*dxG(i,j,bi,bj)
                0070      &          *smooth2Dmask(i,j,bi,bj)*smooth2Dmask(i,j-1,bi,bj)
                0071      &          *( fld_in(i,j,bi,bj) - fld_in(i,j-1,bi,bj) )
                0072      &          *recip_dyC(i,j,bi,bj)
0c3d35c9cd Gael*0073
9f5240b52a Jean*0074              gt_in(i,j,bi,bj) = gt_in(i,j,bi,bj)
                0075      &         + smooth2D_Kvy(i,j+1,bi,bj)*dxG(i,j+1,bi,bj)
                0076      &          *smooth2Dmask(i,j,bi,bj)*smooth2Dmask(i,j+1,bi,bj)
                0077      &          *( fld_in(i,j,bi,bj) - fld_in(i,j+1,bi,bj) )
                0078      &          *recip_dyC(i,j+1,bi,bj)
0c3d35c9cd Gael*0079
9f5240b52a Jean*0080             ENDIF
950129bbe3 Gael*0081
0c3d35c9cd Gael*0082            ENDDO
                0083           ENDDO
                0084          ENDDO
                0085         ENDDO
                0086
9f5240b52a Jean*0087         DO bj=myByLo(myThid),myByHi(myThid)
                0088          DO bi=myBxLo(myThid),myBxHi(myThid)
7b8b86ab99 Timo*0089 c Adams-Bashforth timestepping
9f5240b52a Jean*0090           myIter(bi,bj)=iloop-1
                0091           IF ( myIter(bi,bj).EQ.0 ) THEN
                0092            ab15 = 1.0
                0093            ab05 = 0.0
                0094           ELSE
                0095            ab15 =   1.5 + abEps
                0096            ab05 = -(0.5 + abEps)
                0097           ENDIF
                0098           DO j = 1,sNy
                0099            DO i = 1,sNx
0c3d35c9cd Gael*0100 c Compute effective G-term with Adams-Bashforth
9f5240b52a Jean*0101             gt_tmp = ab15*gt_in(i,j,bi,bj) + ab05*gtm1_in(i,j,bi,bj)
                0102             gtm1_in(i,j,bi,bj) = gt_in(i,j,bi,bj)
                0103             gt_in(i,j,bi,bj) = gt_tmp
0c3d35c9cd Gael*0104 c time step:
9f5240b52a Jean*0105             fld_in(i,j,bi,bj) = fld_in(i,j,bi,bj)
                0106      &        - gt_in(i,j,bi,bj)*recip_rA(i,j,bi,bj)*smooth2DdelTime
                0107             gt_in(i,j,bi,bj) = 0.
0c3d35c9cd Gael*0108            ENDDO
                0109           ENDDO
                0110          ENDDO
                0111         ENDDO
                0112
9f5240b52a Jean*0113         CALL EXCH_XY_RL( gt_in,   myThid )
                0114         CALL EXCH_XY_RL( fld_in,  myThid )
                0115         CALL EXCH_XY_RL( gtm1_in, myThid )
0c3d35c9cd Gael*0116
9f5240b52a Jean*0117       ENDDO
0c3d35c9cd Gael*0118
9f5240b52a Jean*0119       RETURN
                0120       END