Changeset 6004 for branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/NST_SRC/agrif_top_sponge.F90
- Timestamp:
- 2015-12-04T17:05:58+01:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/NST_SRC/agrif_top_sponge.F90
r5845 r6004 2 2 3 3 MODULE agrif_top_sponge 4 !!====================================================================== 5 !! *** MODULE agrif_top_sponge *** 6 !! AGRIF : define in memory AGRIF variables for sea-ice 7 !!====================================================================== 8 !! History : 2.0 ! 2006-08 (R. Benshila, L. Debreu) Original code 9 !!---------------------------------------------------------------------- 10 11 !!---------------------------------------------------------------------- 12 !! Agrif_Sponge_trc : 13 !! interptrn_sponge : 14 !!---------------------------------------------------------------------- 4 15 #if defined key_agrif && defined key_top 5 16 USE par_oce 6 17 USE par_trc 7 18 USE oce 19 USE trc 8 20 USE dom_oce 9 USE in_out_manager10 21 USE agrif_oce 11 22 USE agrif_opa_sponge 12 USE trc 23 ! 24 USE in_out_manager 13 25 USE lib_mpp 14 26 USE wrk_nemo … … 20 32 21 33 !!---------------------------------------------------------------------- 22 !! NEMO/NST 3. 6 , NEMO Consortium (2010)34 !! NEMO/NST 3.7 , NEMO Consortium (2015) 23 35 !! $Id$ 24 36 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 25 37 !!---------------------------------------------------------------------- 26 27 38 CONTAINS 28 39 29 40 SUBROUTINE Agrif_Sponge_trc 30 !!--------------------------------------------- 31 !! *** ROUTINE Agrif_Sponge_Trc ***32 !!--------------------------------------------- 33 !!34 REAL(wp) :: timecoeff35 41 !!---------------------------------------------------------------------- 42 !! *** ROUTINE Agrif_Sponge_Trc *** 43 !!---------------------------------------------------------------------- 44 REAL(wp) :: timecoeff 45 !!---------------------------------------------------------------------- 46 ! 36 47 #if defined SPONGE_TOP 37 timecoeff = REAL( Agrif_NbStepint(),wp)/Agrif_rhot()48 timecoeff = REAL( Agrif_NbStepint(), wp ) / Agrif_rhot() 38 49 CALL Agrif_sponge 39 Agrif_SpecialValue =0.50 Agrif_SpecialValue = 0._wp 40 51 Agrif_UseSpecialValue = .TRUE. 41 tabspongedone_trn = .FALSE.42 CALL Agrif_Bc_Variable( trn_sponge_id,calledweight=timecoeff,procname=interptrn_sponge)52 tabspongedone_trn = .FALSE. 53 CALL Agrif_Bc_Variable( trn_sponge_id, calledweight=timecoeff, procname=interptrn_sponge ) 43 54 Agrif_UseSpecialValue = .FALSE. 44 45 55 #endif 46 56 ! 47 57 END SUBROUTINE Agrif_Sponge_Trc 48 58 49 SUBROUTINE interptrn_sponge(tabres,i1,i2,j1,j2,k1,k2,n1,n2,before)50 !!---------------------------------------------51 !! *** ROUTINE interptrn_sponge ***52 !!---------------------------------------------53 INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n254 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres55 LOGICAL, INTENT(in) :: before56 59 57 60 SUBROUTINE interptrn_sponge( tabres, i1, i2, j1, j2, k1, k2, n1, n2, before ) 61 !!---------------------------------------------------------------------- 62 !! *** ROUTINE interptrn_sponge *** 63 !!---------------------------------------------------------------------- 64 INTEGER , INTENT(in ) :: i1, i2, j1, j2, k1, k2, n1, n2 65 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres 66 LOGICAL , INTENT(in ) :: before 67 ! 58 68 INTEGER :: ji, jj, jk, jn ! dummy loop indices 59 60 REAL(wp) :: ztra, zabe1, zabe2, zbtr61 REAL(wp), DIMENSION(i1:i2,j1:j2 ) :: ztu, ztv62 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2) ::trbdiff69 REAL(wp) :: zabe1, zabe2 70 REAL(wp), DIMENSION(i1:i2,j1:j2) :: ztu, ztv 71 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2) :: trbdiff 72 !!---------------------------------------------------------------------- 63 73 ! 64 IF (before) THEN74 IF( before ) THEN 65 75 tabres(i1:i2,j1:j2,k1:k2,n1:n2) = trn(i1:i2,j1:j2,k1:k2,n1:n2) 66 76 ELSE 67 77 !!gm line below use of :,: versus i1:i2,j1:j2 .... strange, not wrong. ===>> to be corrected 68 78 trbdiff(:,:,:,:) = trb(i1:i2,j1:j2,:,:) - tabres(:,:,:,:) 69 79 DO jn = 1, jptra 70 80 DO jk = 1, jpkm1 71 72 81 DO jj = j1,j2-1 73 82 DO ji = i1,i2-1 74 zabe1 = fsaht_spu(ji,jj) * umask(ji,jj,jk) * e2_e1u(ji,jj) * e3u_n(ji,jj,jk)75 zabe2 = fsaht_spv(ji,jj) * vmask(ji,jj,jk) * e1_e2v(ji,jj) * e3v_n(ji,jj,jk)83 zabe1 = fsaht_spu(ji,jj) * e2_e1u(ji,jj) * e3u_n(ji,jj,jk) * umask(ji,jj,jk) 84 zabe2 = fsaht_spv(ji,jj) * e1_e2v(ji,jj) * e3v_n(ji,jj,jk) * vmask(ji,jj,jk) 76 85 ztu(ji,jj) = zabe1 * ( trbdiff(ji+1,jj ,jk,jn) - trbdiff(ji,jj,jk,jn) ) 77 86 ztv(ji,jj) = zabe2 * ( trbdiff(ji ,jj+1,jk,jn) - trbdiff(ji,jj,jk,jn) ) 78 END DO79 END DO80 87 END DO 88 END DO 89 ! 81 90 DO jj = j1+1,j2-1 82 91 DO ji = i1+1,i2-1 83 84 IF (.NOT. tabspongedone_trn(ji,jj)) THEN 85 zbtr = r1_e1e2t(ji,jj) / e3t(ji,jj,jk) 86 ! horizontal diffusive trends 87 ztra = zbtr * ( ztu(ji,jj) - ztu(ji-1,jj ) + ztv(ji,jj) - ztv(ji ,jj-1) ) 88 ! add it to the general tracer trends 89 tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + ztra 92 IF( .NOT. tabspongedone_trn(ji,jj) ) THEN 93 tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + ( ztu(ji,jj) - ztu(ji-1,jj ) & 94 & + ztv(ji,jj) - ztv(ji ,jj-1) ) & 95 & * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk) 90 96 ENDIF 91 92 ENDDO 93 ENDDO 94 95 ENDDO 96 ENDDO 97 97 END DO 98 END DO 99 END DO 100 ! 101 END DO 102 ! 98 103 tabspongedone_trn(i1+1:i2-1,j1+1:j2-1) = .TRUE. 99 104 ENDIF … … 102 107 103 108 #else 109 104 110 CONTAINS 105 106 111 SUBROUTINE agrif_top_sponge_empty 107 !!---------------------------------------------108 !! *** ROUTINE agrif_top_sponge_empty ***109 !!---------------------------------------------110 112 WRITE(*,*) 'agrif_top_sponge : You should not have seen this print! error?' 111 113 END SUBROUTINE agrif_top_sponge_empty 112 114 #endif 113 115 116 !!====================================================================== 114 117 END MODULE agrif_top_sponge
Note: See TracChangeset
for help on using the changeset viewer.
