- Timestamp:
- 2018-10-29T15:20:26+01:00 (5 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/NST_SRC/agrif_top_sponge.F90
r10248 r10251 1 1 #define SPONGE_TOP 2 2 3 M ODULEagrif_top_sponge3 Module agrif_top_sponge 4 4 #if defined key_agrif && defined key_top 5 5 USE par_oce 6 USE par_trc7 6 USE oce 8 7 USE dom_oce … … 17 16 PRIVATE 18 17 19 PUBLIC Agrif_Sponge_ trc, interptrn_sponge18 PUBLIC Agrif_Sponge_Trc, interptrn 20 19 21 20 !! * Substitutions 22 21 # include "domzgr_substitute.h90" 23 22 !!---------------------------------------------------------------------- 24 !! NEMO/NST 3. 6, NEMO Consortium (2010)23 !! NEMO/NST 3.3 , NEMO Consortium (2010) 25 24 !! $Id$ 26 25 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 27 26 !!---------------------------------------------------------------------- 28 27 29 CONTAINS28 CONTAINS 30 29 31 SUBROUTINE Agrif_Sponge_ trc30 SUBROUTINE Agrif_Sponge_Trc 32 31 !!--------------------------------------------- 33 32 !! *** ROUTINE Agrif_Sponge_Trc *** 34 33 !!--------------------------------------------- 35 34 !! 35 INTEGER :: ji,jj,jk,jn 36 36 REAL(wp) :: timecoeff 37 REAL(wp) :: ztra, zabe1, zabe2, zbtr 38 REAL(wp), POINTER, DIMENSION(:,:) :: ztru, ztrv 39 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztabr 40 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: trbdiff 37 41 38 42 #if defined SPONGE_TOP 43 CALL wrk_alloc( jpi, jpj, ztru, ztrv ) 44 CALL wrk_alloc( jpi, jpj, jpk, jptra, ztabr, trbdiff ) 45 39 46 timecoeff = REAL(Agrif_NbStepint(),wp)/Agrif_rhot() 40 CALL Agrif_sponge 47 41 48 Agrif_SpecialValue=0. 42 49 Agrif_UseSpecialValue = .TRUE. 43 tabspongedone_trn = .FALSE.44 CALL Agrif_Bc_Variable( trn_sponge_id,calledweight=timecoeff,procname=interptrn_sponge)50 ztabr = 0.e0 51 CALL Agrif_Bc_Variable(ztabr, tra_id,calledweight=timecoeff,procname=interptrn) 45 52 Agrif_UseSpecialValue = .FALSE. 53 54 trbdiff(:,:,:,:) = trb(:,:,:,:) - ztabr(:,:,:,:) 55 56 CALL Agrif_sponge 57 58 DO jn = 1, jptra 59 DO jk = 1, jpkm1 60 ! 61 DO jj = 1, jpjm1 62 DO ji = 1, jpim1 63 zabe1 = umask(ji,jj,jk) * spe1ur(ji,jj) * fse3u(ji,jj,jk) 64 zabe2 = vmask(ji,jj,jk) * spe2vr(ji,jj) * fse3v(ji,jj,jk) 65 ztru(ji,jj) = zabe1 * ( trbdiff(ji+1,jj ,jk,jn) - trbdiff(ji,jj,jk,jn) ) 66 ztrv(ji,jj) = zabe2 * ( trbdiff(ji ,jj+1,jk,jn) - trbdiff(ji,jj,jk,jn) ) 67 ENDDO 68 ENDDO 69 70 DO jj = 2,jpjm1 71 DO ji = 2,jpim1 72 zbtr = spbtr2(ji,jj) / fse3t(ji,jj,jk) 73 ! horizontal diffusive trends 74 ztra = zbtr * ( ztru(ji,jj) - ztru(ji-1,jj) + ztrv(ji,jj) - ztrv(ji,jj-1) ) 75 ! add it to the general tracer trends 76 tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + ztra 77 END DO 78 END DO 79 ! 80 ENDDO 81 ENDDO 82 83 CALL wrk_dealloc( jpi, jpj, ztru, ztrv ) 84 CALL wrk_dealloc( jpi, jpj, jpk, jptra, trbdiff, ztabr ) 46 85 47 86 #endif … … 49 88 END SUBROUTINE Agrif_Sponge_Trc 50 89 51 SUBROUTINE interptrn _sponge(tabres,i1,i2,j1,j2,k1,k2,n1,n2,before)90 SUBROUTINE interptrn(tabres,i1,i2,j1,j2,k1,k2,n1,n2) 52 91 !!--------------------------------------------- 53 !! *** ROUTINE interpt rn_sponge***92 !! *** ROUTINE interptn *** 54 93 !!--------------------------------------------- 55 94 INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n2 56 95 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres 57 LOGICAL, INTENT(in) :: before 96 ! 97 tabres(i1:i2,j1:j2,k1:k2,n1:n2) = trn(i1:i2,j1:j2,k1:k2,n1:n2) 58 98 59 60 INTEGER :: ji, jj, jk, jn ! dummy loop indices 61 62 REAL(wp) :: ztra, zabe1, zabe2, zbtr 63 REAL(wp), DIMENSION(i1:i2,j1:j2) :: ztu, ztv 64 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2) ::trbdiff 65 ! 66 IF (before) THEN 67 tabres(i1:i2,j1:j2,k1:k2,n1:n2) = trn(i1:i2,j1:j2,k1:k2,n1:n2) 68 ELSE 69 70 trbdiff(:,:,:,:) = trb(i1:i2,j1:j2,:,:) - tabres(:,:,:,:) 71 DO jn = 1, jptra 72 DO jk = 1, jpkm1 73 74 DO jj = j1,j2-1 75 DO ji = i1,i2-1 76 zabe1 = fsaht_spu(ji,jj) * umask(ji,jj,jk) * re2u_e1u(ji,jj) * fse3u_n(ji,jj,jk) 77 zabe2 = fsaht_spv(ji,jj) * vmask(ji,jj,jk) * re1v_e2v(ji,jj) * fse3v_n(ji,jj,jk) 78 ztu(ji,jj) = zabe1 * ( trbdiff(ji+1,jj ,jk,jn) - trbdiff(ji,jj,jk,jn) ) 79 ztv(ji,jj) = zabe2 * ( trbdiff(ji ,jj+1,jk,jn) - trbdiff(ji,jj,jk,jn) ) 80 ENDDO 81 ENDDO 82 83 DO jj = j1+1,j2-1 84 DO ji = i1+1,i2-1 85 86 IF (.NOT. tabspongedone_trn(ji,jj)) THEN 87 zbtr = r1_e12t(ji,jj) / fse3t(ji,jj,jk) 88 ! horizontal diffusive trends 89 ztra = zbtr * ( ztu(ji,jj) - ztu(ji-1,jj ) + ztv(ji,jj) - ztv(ji ,jj-1) ) 90 ! add it to the general tracer trends 91 tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + ztra 92 ENDIF 93 94 ENDDO 95 ENDDO 96 97 ENDDO 98 ENDDO 99 100 tabspongedone_trn(i1+1:i2-1,j1+1:j2-1) = .TRUE. 101 ENDIF 102 ! 103 END SUBROUTINE interptrn_sponge 99 END SUBROUTINE interptrn 104 100 105 101 #else
Note: See TracChangeset
for help on using the changeset viewer.