- Timestamp:
- 2012-11-27T15:42:24+01:00 (12 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2012/dev_MERGE_2012/NEMOGCM/NEMO/NST_SRC/agrif_top_sponge.F90
r3294 r3680 8 8 USE in_out_manager 9 9 USE agrif_oce 10 USE agrif_opa_sponge 10 11 USE trc 11 12 USE lib_mpp … … 17 18 PUBLIC Agrif_Sponge_Trc, interptrn 18 19 20 !! * Substitutions 21 # include "domzgr_substitute.h90" 19 22 !!---------------------------------------------------------------------- 20 23 !! NEMO/NST 3.3 , NEMO Consortium (2010) … … 29 32 !! *** ROUTINE Agrif_Sponge_Trc *** 30 33 !!--------------------------------------------- 31 #include "domzgr_substitute.h90"32 34 !! 33 INTEGER :: ji,jj,jk,jl 34 INTEGER :: spongearea 35 INTEGER :: ji,jj,jk,jn 35 36 REAL(wp) :: timecoeff 36 37 REAL(wp) :: ztra, zabe1, zabe2, zbtr 37 REAL(wp), POINTER, DIMENSION(:,:) :: localviscsponge 38 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: trbdiff, ztru, ztrv, ztab 38 REAL(wp), POINTER, DIMENSION(:,:) :: ztru, ztrv 39 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztabr 40 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: trbdiff 39 41 40 42 #if defined SPONGE_TOP 41 CALL wrk_alloc( jpi, jpj, localviscsponge)42 CALL wrk_alloc( jpi, jpj, jpk, jptra, trbdiff, ztru, ztrv, ztab)43 CALL wrk_alloc( jpi, jpj, ztru, ztrv ) 44 CALL wrk_alloc( jpi, jpj, jpk, jptra, ztabr, trbdiff ) 43 45 44 46 timecoeff = REAL(Agrif_NbStepint(),wp)/Agrif_rhot() … … 46 48 Agrif_SpecialValue=0. 47 49 Agrif_UseSpecialValue = .TRUE. 48 ztab = 0.e049 CALL Agrif_Bc_Variable(ztab , tra_id,calledweight=timecoeff,procname=interptrn)50 ztabr = 0.e0 51 CALL Agrif_Bc_Variable(ztabr, tra_id,calledweight=timecoeff,procname=interptrn) 50 52 Agrif_UseSpecialValue = .FALSE. 51 53 52 trbdiff(:,:,:,:) = trb(:,:,:,:) - ztab (:,:,:,:)54 trbdiff(:,:,:,:) = trb(:,:,:,:) - ztabr(:,:,:,:) 53 55 54 spongearea = 2 + 2 * Agrif_irhox()56 CALL Agrif_sponge 55 57 56 localviscsponge = 0. 57 58 IF (.NOT. spongedoneT) THEN 59 spe1ur(:,:) = 0. 60 spe2vr(:,:) = 0. 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 61 69 62 IF ((nbondi == -1).OR.(nbondi == 2)) THEN 63 DO ji = 2, spongearea 64 localviscsponge(ji,:) = visc_tra * (spongearea-ji)/real(spongearea-2) 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 ! 65 80 ENDDO 66 67 spe1ur(2:spongearea-1,:)=0.5 * (localviscsponge(2:spongearea-1,:) + localviscsponge(3:spongearea,:)) &68 * e2u(2:spongearea-1,:) / e1u(2:spongearea-1,:)69 70 spe2vr(2:spongearea,1:jpjm1) = 0.5 * (localviscsponge(2:spongearea,1:jpjm1) + &71 localviscsponge(2:spongearea,2:jpj)) &72 * e1v(2:spongearea,1:jpjm1) / e2v(2:spongearea,1:jpjm1)73 ENDIF74 75 IF ((nbondi == 1).OR.(nbondi == 2)) THEN76 DO ji = nlci-spongearea + 1,nlci-177 localviscsponge(ji,:) = visc_tra * (ji - (nlci-spongearea+1))/real(spongearea-2)78 ENDDO79 80 spe1ur(nlci-spongearea + 1:nlci-2,:)=0.5 * (localviscsponge(nlci-spongearea + 1:nlci-2,:) + &81 localviscsponge(nlci-spongearea + 2:nlci-1,:)) &82 * e2u(nlci-spongearea + 1:nlci-2,:) / e1u(nlci-spongearea + 1:nlci-2,:)83 84 spe2vr(nlci-spongearea + 1:nlci-1,1:jpjm1) = 0.5 * (localviscsponge(nlci-spongearea + 1:nlci-1,1:jpjm1) &85 + localviscsponge(nlci-spongearea + 1:nlci-1,2:jpj)) &86 * e1v(nlci-spongearea + 1:nlci-1,1:jpjm1) / e2v(nlci-spongearea + 1:nlci-1,1:jpjm1)87 ENDIF88 89 90 IF ((nbondj == -1).OR.(nbondj == 2)) THEN91 DO jj = 2, spongearea92 localviscsponge(:,jj) = visc_tra * (spongearea-jj)/real(spongearea-2)93 ENDDO94 95 spe1ur(1:jpim1,2:spongearea)=0.5 * (localviscsponge(1:jpim1,2:spongearea) + &96 localviscsponge(2:jpi,2:spongearea)) &97 * e2u(1:jpim1,2:spongearea) / e1u(1:jpim1,2:spongearea)98 99 spe2vr(:,2:spongearea-1) = 0.5 * (localviscsponge(:,2:spongearea-1) + &100 localviscsponge(:,3:spongearea)) &101 * e1v(:,2:spongearea-1) / e2v(:,2:spongearea-1)102 ENDIF103 104 IF ((nbondj == 1).OR.(nbondj == 2)) THEN105 DO jj = nlcj-spongearea + 1,nlcj-1106 localviscsponge(:,jj) = visc_tra * (jj - (nlcj-spongearea+1))/real(spongearea-2)107 ENDDO108 109 spe1ur(1:jpim1,nlcj-spongearea + 1:nlcj-1)=0.5 * (localviscsponge(1:jpim1,nlcj-spongearea + 1:nlcj-1) + &110 localviscsponge(2:jpi,nlcj-spongearea + 1:nlcj-1)) &111 * e2u(1:jpim1,nlcj-spongearea + 1:nlcj-1) / e1u(1:jpim1,nlcj-spongearea + 1:nlcj-1)112 113 spe2vr(:,nlcj-spongearea + 1:nlcj-2) = 0.5 * (localviscsponge(:,nlcj-spongearea + 1:nlcj-2) + &114 localviscsponge(:,nlcj-spongearea + 2:nlcj-1)) &115 * e1v(:,nlcj-spongearea + 1:nlcj-2) / e2v(:,nlcj-spongearea + 1:nlcj-2)116 ENDIF117 118 spbtr2(:,:) = 1. / ( e1t(:,:) * e2t(:,:))119 120 spongedoneT = .TRUE.121 ENDIF122 123 DO jl = 1, jptra124 DO jk = 1, jpkm1125 DO jj = 1, jpjm1126 DO ji = 1, jpim1127 zabe1 = umask(ji,jj,jk) * spe1ur(ji,jj) * fse3u(ji,jj,jk)128 zabe2 = vmask(ji,jj,jk) * spe2vr(ji,jj) * fse3v(ji,jj,jk)129 ztru(ji,jj,jk,jl) = zabe1 * ( trbdiff(ji+1,jj ,jk,jl) - trbdiff(ji,jj,jk,jl) )130 ztrv(ji,jj,jk,jl) = zabe2 * ( trbdiff(ji ,jj+1,jk,jl) - trbdiff(ji,jj,jk,jl) )131 ENDDO132 ENDDO133 134 DO jj = 2,jpjm1135 DO ji = 2,jpim1136 zbtr = spbtr2(ji,jj) / fse3t(ji,jj,jk)137 ! horizontal diffusive trends138 ztra = zbtr * ( ztru(ji,jj,jk,jl) - ztru(ji-1,jj,jk,jl) &139 & + ztrv(ji,jj,jk,jl) - ztrv(ji,jj-1,jk,jl) )140 ! add it to the general tracer trends141 tra(ji,jj,jk,jl) = (tra(ji,jj,jk,jl) + ztra)142 END DO143 END DO144 145 ENDDO146 81 ENDDO 147 82 148 CALL wrk_dealloc( jpi, jpj, localviscsponge)149 CALL wrk_dealloc( jpi, jpj, jpk, jptra, trbdiff, zt ru, ztrv, ztab)83 CALL wrk_dealloc( jpi, jpj, ztru, ztrv ) 84 CALL wrk_dealloc( jpi, jpj, jpk, jptra, trbdiff, ztabr ) 150 85 151 86 #endif … … 153 88 END SUBROUTINE Agrif_Sponge_Trc 154 89 155 SUBROUTINE interptrn(tabres,i1,i2,j1,j2,k1,k2, l1,l2)90 SUBROUTINE interptrn(tabres,i1,i2,j1,j2,k1,k2,n1,n2) 156 91 !!--------------------------------------------- 157 92 !! *** ROUTINE interptn *** 158 93 !!--------------------------------------------- 159 # include "domzgr_substitute.h90" 160 161 INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,l1,l2 162 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,l1:l2), INTENT(inout) :: tabres 163 164 tabres(i1:i2,j1:j2,k1:k2,l1:l2) = trn(i1:i2,j1:j2,k1:k2,l1:l2) 94 INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n2 95 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres 96 ! 97 tabres(i1:i2,j1:j2,k1:k2,n1:n2) = trn(i1:i2,j1:j2,k1:k2,n1:n2) 165 98 166 99 END SUBROUTINE interptrn
Note: See TracChangeset
for help on using the changeset viewer.