Changeset 6225 for branches/2014/dev_r4704_NOC5_MPP_BDY_UPDATE/NEMOGCM/NEMO/NST_SRC/agrif_top_sponge.F90
- Timestamp:
- 2016-01-08T10:35:19+01:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2014/dev_r4704_NOC5_MPP_BDY_UPDATE/NEMOGCM/NEMO/NST_SRC/agrif_top_sponge.F90
r3680 r6225 1 1 #define SPONGE_TOP 2 2 3 Module agrif_top_sponge 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 17 USE par_trc 6 18 USE oce 19 USE trc 7 20 USE dom_oce 8 USE in_out_manager9 21 USE agrif_oce 10 22 USE agrif_opa_sponge 11 USE trc 23 ! 24 USE in_out_manager 12 25 USE lib_mpp 13 26 USE wrk_nemo … … 16 29 PRIVATE 17 30 18 PUBLIC Agrif_Sponge_ Trc, interptrn31 PUBLIC Agrif_Sponge_trc, interptrn_sponge 19 32 20 !! * Substitutions21 # include "domzgr_substitute.h90"22 33 !!---------------------------------------------------------------------- 23 !! NEMO/NST 3. 3 , NEMO Consortium (2010)34 !! NEMO/NST 3.7 , NEMO Consortium (2015) 24 35 !! $Id$ 25 36 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 26 37 !!---------------------------------------------------------------------- 38 CONTAINS 27 39 28 CONTAINS 40 SUBROUTINE Agrif_Sponge_trc 41 !!---------------------------------------------------------------------- 42 !! *** ROUTINE Agrif_Sponge_Trc *** 43 !!---------------------------------------------------------------------- 44 REAL(wp) :: timecoeff 45 !!---------------------------------------------------------------------- 46 ! 47 #if defined SPONGE_TOP 48 timecoeff = REAL( Agrif_NbStepint(), wp ) / Agrif_rhot() 49 CALL Agrif_sponge 50 Agrif_SpecialValue = 0._wp 51 Agrif_UseSpecialValue = .TRUE. 52 tabspongedone_trn = .FALSE. 53 CALL Agrif_Bc_Variable( trn_sponge_id, calledweight=timecoeff, procname=interptrn_sponge ) 54 Agrif_UseSpecialValue = .FALSE. 55 #endif 56 ! 57 END SUBROUTINE Agrif_Sponge_Trc 29 58 30 SUBROUTINE Agrif_Sponge_Trc31 !!---------------------------------------------32 !! *** ROUTINE Agrif_Sponge_Trc ***33 !!---------------------------------------------34 !!35 INTEGER :: ji,jj,jk,jn36 REAL(wp) :: timecoeff37 REAL(wp) :: ztra, zabe1, zabe2, zbtr38 REAL(wp), POINTER, DIMENSION(:,:) :: ztru, ztrv39 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztabr40 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: trbdiff41 59 42 #if defined SPONGE_TOP 43 CALL wrk_alloc( jpi, jpj, ztru, ztrv ) 44 CALL wrk_alloc( jpi, jpj, jpk, jptra, ztabr, trbdiff ) 45 46 timecoeff = REAL(Agrif_NbStepint(),wp)/Agrif_rhot() 47 48 Agrif_SpecialValue=0. 49 Agrif_UseSpecialValue = .TRUE. 50 ztabr = 0.e0 51 CALL Agrif_Bc_Variable(ztabr, tra_id,calledweight=timecoeff,procname=interptrn) 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 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 ! 68 INTEGER :: ji, jj, jk, jn ! dummy loop indices 69 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 !!---------------------------------------------------------------------- 73 ! 74 IF( before ) THEN 75 tabres(i1:i2,j1:j2,k1:k2,n1:n2) = trn(i1:i2,j1:j2,k1:k2,n1:n2) 76 ELSE 77 !!gm line below use of :,: versus i1:i2,j1:j2 .... strange, not wrong. ===>> to be corrected 78 trbdiff(:,:,:,:) = trb(i1:i2,j1:j2,:,:) - tabres(:,:,:,:) 79 DO jn = 1, jptra 80 DO jk = 1, jpkm1 81 DO jj = j1,j2-1 82 DO ji = i1,i2-1 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) 85 ztu(ji,jj) = zabe1 * ( trbdiff(ji+1,jj ,jk,jn) - trbdiff(ji,jj,jk,jn) ) 86 ztv(ji,jj) = zabe2 * ( trbdiff(ji ,jj+1,jk,jn) - trbdiff(ji,jj,jk,jn) ) 87 END DO 88 END DO 89 ! 90 DO jj = j1+1,j2-1 91 DO ji = i1+1,i2-1 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) 96 ENDIF 97 END DO 77 98 END DO 78 99 END DO 79 100 ! 80 ENDDO 81 ENDDO 82 83 CALL wrk_dealloc( jpi, jpj, ztru, ztrv ) 84 CALL wrk_dealloc( jpi, jpj, jpk, jptra, trbdiff, ztabr ) 85 86 #endif 87 88 END SUBROUTINE Agrif_Sponge_Trc 89 90 SUBROUTINE interptrn(tabres,i1,i2,j1,j2,k1,k2,n1,n2) 91 !!--------------------------------------------- 92 !! *** ROUTINE interptn *** 93 !!--------------------------------------------- 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) 98 99 END SUBROUTINE interptrn 101 END DO 102 ! 103 tabspongedone_trn(i1+1:i2-1,j1+1:j2-1) = .TRUE. 104 ENDIF 105 ! 106 END SUBROUTINE interptrn_sponge 100 107 101 108 #else 109 102 110 CONTAINS 103 104 111 SUBROUTINE agrif_top_sponge_empty 105 !!---------------------------------------------106 !! *** ROUTINE agrif_top_sponge_empty ***107 !!---------------------------------------------108 112 WRITE(*,*) 'agrif_top_sponge : You should not have seen this print! error?' 109 113 END SUBROUTINE agrif_top_sponge_empty 110 114 #endif 111 115 116 !!====================================================================== 112 117 END MODULE agrif_top_sponge
Note: See TracChangeset
for help on using the changeset viewer.
