pkg/seaice/diffus.F

809c36b928 Patr*0001 #include "SEAICE_OPTIONS.h"
7bb5a8a109 Jean*0002 #ifdef ALLOW_GENERIC_ADVDIFF
                0003 # include "GAD_OPTIONS.h"
                0004 #endif
37e58bbaf7 Jean*0005
b7e868d5f4 Jean*0006 CBOP
                0007 C     !ROUTINE: DIFFUS
                0008 C     !INTERFACE:
                0009       SUBROUTINE DIFFUS(
                0010      U                   fld,
                0011      I                   DIFFA, iceMsk, myThid )
                0012
                0013 C     !DESCRIPTION: \bv
37e58bbaf7 Jean*0014 C     *==========================================================*
b7e868d5f4 Jean*0015 C     | S/R DIFFUS
                0016 C     | o Calculate laplacian of input field
                0017 C     |   and return the result in the same array
37e58bbaf7 Jean*0018 C     *==========================================================*
b7e868d5f4 Jean*0019 C     \ev
                0020
                0021 C     !USES:
809c36b928 Patr*0022       IMPLICIT NONE
37e58bbaf7 Jean*0023
b7e868d5f4 Jean*0024 C     == Global variables ===
809c36b928 Patr*0025 #include "SIZE.h"
                0026 #include "EEPARAMS.h"
4366d31d92 Mart*0027 #include "GRID.h"
7303eab4f2 Patr*0028 #include "SEAICE_SIZE.h"
9cf7ff39d8 Mart*0029 #include "SEAICE_PARAMS.h"
37e58bbaf7 Jean*0030
b7e868d5f4 Jean*0031 C     !INPUT/OUTPUT PARAMETERS:
                0032 C     == Routine Arguments ==
                0033 C     fld        :: In: input ice-field ; Out: laplacian of input field
                0034 C     DIFFA      :: grid length scale
                0035 C     iceMsk     :: Ocean/Land mask
                0036 C     myThid     :: my Thread Id. number
1a11ffcc11 Mart*0037       _RL fld    (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0038       _RL DIFFA  (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
b7e868d5f4 Jean*0039       _RL iceMsk (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
809c36b928 Patr*0040       INTEGER myThid
b7e868d5f4 Jean*0041 CEOP
809c36b928 Patr*0042
b7e868d5f4 Jean*0043 C     !LOCAL VARIABLES:
                0044 C     == Local variables ==
                0045 C     i,j,bi,bj :: Loop counters
cee16b76ae Dimi*0046       INTEGER i, j, bi, bj
b7e868d5f4 Jean*0047       _RL DELTXX, DELTYY
                0048       _RL tmpFld  (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
04a836ae4f Mart*0049       _RL dfx     (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0050       _RL dfy     (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
809c36b928 Patr*0051
b7e868d5f4 Jean*0052 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0053
809c36b928 Patr*0054       DO bj=myByLo(myThid),myByHi(myThid)
                0055        DO bi=myBxLo(myThid),myBxHi(myThid)
b7e868d5f4 Jean*0056         IF ( SEAICEuseFluxForm ) THEN
                0057 C--   Use flux form for MITgcm compliance, unfortunately changes results
809c36b928 Patr*0058
7bb5a8a109 Jean*0059           DO j=1-OLy,sNy+OLy
                0060            DO i=1-OLx,sNx+OLx
b7e868d5f4 Jean*0061             dfx(i,j) = 0. _d 0
                0062             dfy(i,j) = 0. _d 0
                0063            ENDDO
                0064           ENDDO
                0065 C--   first compute fluxes across cell faces
                0066           DO j=1,sNy+1
                0067            DO i=1,sNx+1
                0068             dfx(i,j) = _dyG(i,j,bi,bj) * _recip_dxC(i,j,bi,bj)
                0069      &         * (fld(i,j,bi,bj)-fld(i-1,j,bi,bj))
                0070      &         * cosFacU(j,bi,bj)
                0071      &         * iceMsk(i,j,bi,bj)*iceMsk(i-1,j,bi,bj)
                0072      &         * ( DIFFA(i,j,bi,bj)+DIFFA(i-1,j,bi,bj) )*HALF
036cdc98c8 Jean*0073 #ifdef ALLOW_OBCS
b7e868d5f4 Jean*0074      &         * maskInW(i,j,bi,bj)
036cdc98c8 Jean*0075 #endif
b7e868d5f4 Jean*0076             dfy(i,j) = _dxG(i,j,bi,bj) * _recip_dyC(i,j,bi,bj)
                0077      &         * (fld(i,j,bi,bj)-fld(i,j-1,bi,bj))
                0078 #ifdef ISOTROPIC_COS_SCALING
                0079      &         * cosFacV(j,bi,bj)
036cdc98c8 Jean*0080 #endif
b7e868d5f4 Jean*0081      &         * iceMsk(i,j,bi,bj)*iceMsk(i,j-1,bi,bj)
                0082      &         * ( DIFFA(i,j,bi,bj)+DIFFA(i,j-1,bi,bj) )*HALF
036cdc98c8 Jean*0083 #ifdef ALLOW_OBCS
b7e868d5f4 Jean*0084      &         * maskInS(i,j,bi,bj)
036cdc98c8 Jean*0085 #endif
b7e868d5f4 Jean*0086            ENDDO
                0087           ENDDO
                0088           DO j=1-OLy,sNy+OLy
                0089            DO i=1-OLx,sNx+OLx
                0090             fld(i,j,bi,bj) = 0. _d 0
                0091            ENDDO
                0092           ENDDO
                0093 C--   compute Laplacian as flux divergence
                0094           DO j=1,sNy
                0095            DO i=1,sNx
                0096             fld(i,j,bi,bj) = (
                0097      &                         ( dfx(i+1,j) - dfx(i,j) )
                0098      &                       + ( dfy(i,j+1) - dfy(i,j) )
                0099      &                       ) * recip_rA(i,j,bi,bj)
                0100            ENDDO
                0101           ENDDO
                0102
                0103         ELSE
                0104 C NOW DO DIFFUSION WITH NUIT CONVERSION
                0105
                0106           DO j=1-OLy,sNy+OLy
                0107            DO i=1-OLx,sNx+OLx
                0108             tmpFld(i,j) = 0.0 _d 0
                0109            ENDDO
                0110           ENDDO
                0111
                0112           DO j=1,sNy
                0113            DO i=1,sNx
                0114             DELTXX = DIFFA(i,j,bi,bj)
                0115      &             * _recip_dxF(i,j,bi,bj)*_recip_dxF(i,j,bi,bj)
                0116             DELTYY = DIFFA(i,j,bi,bj)
                0117      &             * _recip_dyF(i,j,bi,bj)*_recip_dyF(i,j,bi,bj)
                0118      &             * _recip_dxF(i,j,bi,bj)
                0119             tmpFld(i,j) =
                0120      &        DELTXX*(
                0121      &                 (fld(i+1,j,bi,bj)-fld(i,  j,bi,bj))
                0122      &                 *iceMsk(i+1,j,bi,bj)
036cdc98c8 Jean*0123 #ifdef ALLOW_OBCS
b7e868d5f4 Jean*0124      &                 *maskInW(i+1,j,bi,bj)
036cdc98c8 Jean*0125 #endif
b7e868d5f4 Jean*0126      &                -(fld(i,  j,bi,bj)-fld(i-1,j,bi,bj))
                0127      &                 *iceMsk(i-1,j,bi,bj)
036cdc98c8 Jean*0128 #ifdef ALLOW_OBCS
b7e868d5f4 Jean*0129      &                 *maskInW(i,j,bi,bj)
036cdc98c8 Jean*0130 #endif
b7e868d5f4 Jean*0131      &               )
                0132      &       +DELTYY*(
                0133      &                 (fld(i,j+1,bi,bj)-fld(i,j,  bi,bj))
                0134      &                 * _dxG(i,j+1,bi,bj)*iceMsk(i,j+1,bi,bj)
                0135 #ifdef ALLOW_OBCS
                0136      &                 *maskInS(i,j+1,bi,bj)
37e58bbaf7 Jean*0137 #endif
b7e868d5f4 Jean*0138      &                -(fld(i,j,  bi,bj)-fld(i,j-1,bi,bj))
                0139      &                 * _dxG(i,j,  bi,bj)*iceMsk(i,j-1,bi,bj)
036cdc98c8 Jean*0140 #ifdef ALLOW_OBCS
b7e868d5f4 Jean*0141      &                 *maskInS(i,j,bi,bj)
036cdc98c8 Jean*0142 #endif
b7e868d5f4 Jean*0143      &               )
                0144            ENDDO
                0145           ENDDO
                0146           DO j=1-OLy,sNy+OLy
                0147            DO i=1-OLx,sNx+OLx
                0148             fld(i,j,bi,bj) = tmpFld(i,j)
                0149            ENDDO
                0150           ENDDO
809c36b928 Patr*0151
b7e868d5f4 Jean*0152 C--  end flux-form / non flux-form
                0153         ENDIF
809c36b928 Patr*0154        ENDDO
                0155       ENDDO
                0156
                0157       RETURN
                0158       END