- Timestamp:
- 2014-09-25T18:26:34+02:00 (10 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2014/dev_r4765_CNRS_agrif/NEMOGCM/NEMO/NST_SRC/agrif_top_sponge.F90
r3680 r4789 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 … … 16 16 PRIVATE 17 17 18 PUBLIC Agrif_Sponge_ Trc, interptrn18 PUBLIC Agrif_Sponge_trc, interptrn 19 19 20 !! * Substitutions20 !! * Substitutions 21 21 # include "domzgr_substitute.h90" 22 22 !!---------------------------------------------------------------------- 23 !! NEMO/NST 3. 3, NEMO Consortium (2010)23 !! NEMO/NST 3.6 , NEMO Consortium (2010) 24 24 !! $Id$ 25 25 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 26 26 !!---------------------------------------------------------------------- 27 27 28 28 CONTAINS 29 29 30 SUBROUTINE Agrif_Sponge_ Trc30 SUBROUTINE Agrif_Sponge_trc 31 31 !!--------------------------------------------- 32 32 !! *** ROUTINE Agrif_Sponge_Trc *** 33 33 !!--------------------------------------------- 34 34 !! 35 INTEGER :: ji,jj,jk,jn36 35 REAL(wp) :: timecoeff 37 REAL(wp) :: ztra, zabe1, zabe2, zbtr38 REAL(wp), POINTER, DIMENSION(:,:) :: ztru, ztrv39 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztabr40 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: trbdiff41 36 42 37 #if defined SPONGE_TOP 43 CALL wrk_alloc( jpi, jpj, ztru, ztrv )44 CALL wrk_alloc( jpi, jpj, jpk, jptra, ztabr, trbdiff )45 46 38 timecoeff = REAL(Agrif_NbStepint(),wp)/Agrif_rhot() 47 39 CALL Agrif_sponge 48 40 Agrif_SpecialValue=0. 49 41 Agrif_UseSpecialValue = .TRUE. 50 ztabr = 0.e051 CALL Agrif_Bc_Variable( ztabr, tra_id,calledweight=timecoeff,procname=interptrn)42 tabspongetrn = .FALSE. 43 CALL Agrif_Bc_Variable(trn_sponge_id,calledweight=timecoeff,procname=interptrn_sponge) 52 44 Agrif_UseSpecialValue = .FALSE. 53 54 trbdiff(:,:,:,:) = trb(:,:,:,:) - ztabr(:,:,:,:)55 56 CALL Agrif_sponge57 58 DO jn = 1, jptra59 DO jk = 1, jpkm160 !61 DO jj = 1, jpjm162 DO ji = 1, jpim163 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 ENDDO68 ENDDO69 70 DO jj = 2,jpjm171 DO ji = 2,jpim172 zbtr = spbtr2(ji,jj) / fse3t(ji,jj,jk)73 ! horizontal diffusive trends74 ztra = zbtr * ( ztru(ji,jj) - ztru(ji-1,jj) + ztrv(ji,jj) - ztrv(ji,jj-1) )75 ! add it to the general tracer trends76 tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + ztra77 END DO78 END DO79 !80 ENDDO81 ENDDO82 83 CALL wrk_dealloc( jpi, jpj, ztru, ztrv )84 CALL wrk_dealloc( jpi, jpj, jpk, jptra, trbdiff, ztabr )85 45 86 46 #endif … … 88 48 END SUBROUTINE Agrif_Sponge_Trc 89 49 90 SUBROUTINE interptrn (tabres,i1,i2,j1,j2,k1,k2,n1,n2)50 SUBROUTINE interptrn_sponge(tabres,i1,i2,j1,j2,k1,k2,n1,n2,before) 91 51 !!--------------------------------------------- 92 !! *** ROUTINE interpt n***52 !! *** ROUTINE interptrn_sponge *** 93 53 !!--------------------------------------------- 94 54 INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n2 95 55 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres 56 LOGICAL, INTENT(in) :: before 57 58 59 INTEGER :: ji, jj, jk, jn ! dummy loop indices 60 61 REAL(wp) :: ztra, zabe1, zabe2, zbtr 62 REAL(wp), DIMENSION(i1:i2,j1:j2) :: ztu, ztv 63 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2) ::trbdiff 96 64 ! 97 tabres(i1:i2,j1:j2,k1:k2,n1:n2) = trn(i1:i2,j1:j2,k1:k2,n1:n2) 65 IF (before) THEN 66 tabres(i1:i2,j1:j2,k1:k2,n1:n2) = trn(i1:i2,j1:j2,k1:k2,n1:n2) 67 ELSE 98 68 99 END SUBROUTINE interptrn 69 trbdiff(:,:,:,:) = trb(i1:i2,j1:j2,:,:) - tabres(:,:,:,:) 70 DO jn = 1, jptra 71 DO jk = 1, jpkm1 72 73 DO jj = j1,j2-1 74 DO ji = i1,i2-1 75 zabe1 = umask(ji,jj,jk) * spe1ur(ji,jj) * fse3u(ji,jj,jk) 76 zabe2 = vmask(ji,jj,jk) * spe2vr(ji,jj) * fse3v(ji,jj,jk) 77 ztu(ji,jj) = zabe1 * ( trbdiff(ji+1,jj ,jk,jn) - trbdiff(ji,jj,jk,jn) ) 78 ztv(ji,jj) = zabe2 * ( trbdiff(ji ,jj+1,jk,jn) - trbdiff(ji,jj,jk,jn) ) 79 ENDDO 80 ENDDO 81 82 DO jj = j1+1,j2-1 83 DO ji = i1+1,i2-1 84 85 IF (.NOT. tabspongedone_trn(ji,jj)) THEN 86 zbtr = spbtr2(ji,jj) / fse3t(ji,jj,jk) 87 ! horizontal diffusive trends 88 ztra = zbtr * ( ztu(ji,jj) - ztu(ji-1,jj ) + ztv(ji,jj) - ztv(ji ,jj-1) ) 89 ! add it to the general tracer trends 90 tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + ztra 91 ENDIF 92 93 ENDDO 94 ENDDO 95 96 ENDDO 97 ENDDO 98 99 tabspongedone_trn(i1+1:i2-1,j1+1:j2-1) = .TRUE. 100 ENDIF 101 ! 102 END SUBROUTINE interptrn_sponge 100 103 101 104 #else
Note: See TracChangeset
for help on using the changeset viewer.