- Timestamp:
- 2017-10-04T09:19:23+02:00 (7 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/NST_SRC/agrif_opa_sponge.F90
r8215 r8586 4 4 !!====================================================================== 5 5 !! *** MODULE agrif_opa_interp *** 6 !! AGRIF: interpolation package6 !! AGRIF: sponge package for the ocean dynamics (OPA) 7 7 !!====================================================================== 8 8 !! History : 2.0 ! 2002-06 (XXX) Original cade … … 21 21 USE in_out_manager 22 22 USE agrif_oce 23 USE wrk_nemo24 23 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 25 24 … … 41 40 !! *** ROUTINE Agrif_Sponge_Tra *** 42 41 !!---------------------------------------------------------------------- 43 REAL(wp) :: timecoeff ! local scalar42 REAL(wp) :: zcoef ! local scalar 44 43 !!---------------------------------------------------------------------- 45 44 ! 46 45 #if defined SPONGE 47 timecoeff = REAL(Agrif_NbStepint(),wp)/Agrif_rhot()46 zcoef = REAL( Agrif_NbStepint(), wp ) / Agrif_rhot() 48 47 ! 49 48 CALL Agrif_Sponge … … 52 51 tabspongedone_tsn = .FALSE. 53 52 ! 54 CALL Agrif_Bc_Variable( tsn_sponge_id,calledweight=timecoeff,procname=interptsn_sponge)53 CALL Agrif_Bc_Variable( tsn_sponge_id, calledweight=zcoef, procname=interptsn_sponge ) 55 54 ! 56 55 Agrif_UseSpecialValue = .FALSE. … … 64 63 !! *** ROUTINE Agrif_Sponge_dyn *** 65 64 !!---------------------------------------------------------------------- 66 REAL(wp) :: timecoeff ! local scalar65 REAL(wp) :: zcoef ! local scalar 67 66 !!---------------------------------------------------------------------- 68 67 ! 69 68 #if defined SPONGE 70 timecoeff = REAL(Agrif_NbStepint(),wp)/Agrif_rhot()69 zcoef = REAL( Agrif_NbStepint(), wp ) / Agrif_rhot() 71 70 ! 72 71 Agrif_SpecialValue = 0._wp … … 75 74 tabspongedone_u = .FALSE. 76 75 tabspongedone_v = .FALSE. 77 CALL Agrif_Bc_Variable( un_sponge_id,calledweight=timecoeff,procname=interpun_sponge)76 CALL Agrif_Bc_Variable( un_sponge_id, calledweight=zcoef, procname=interpun_sponge ) 78 77 ! 79 78 tabspongedone_u = .FALSE. 80 79 tabspongedone_v = .FALSE. 81 CALL Agrif_Bc_Variable( vn_sponge_id,calledweight=timecoeff,procname=interpvn_sponge)80 CALL Agrif_Bc_Variable( vn_sponge_id, calledweight=zcoef, procname=interpvn_sponge ) 82 81 ! 83 82 Agrif_UseSpecialValue = .FALSE. … … 91 90 !! *** ROUTINE Agrif_Sponge *** 92 91 !!---------------------------------------------------------------------- 93 INTEGER :: ji,jj,jk 94 INTEGER :: ispongearea, ilci, ilcj 95 LOGICAL :: ll_spdone 96 REAL(wp) :: z1spongearea, zramp 97 REAL(wp), POINTER, DIMENSION(:,:) :: ztabramp 92 INTEGER :: ji, jj, ind1, ind2 93 INTEGER :: ispongearea 94 REAL(wp) :: z1_spongearea 95 REAL(wp), DIMENSION(jpi,jpj) :: ztabramp 98 96 !!---------------------------------------------------------------------- 99 97 ! 100 98 #if defined SPONGE || defined SPONGE_TOP 101 ll_spdone=.TRUE.102 99 IF (( .NOT. spongedoneT ).OR.( .NOT. spongedoneU )) THEN 103 ! Define ramp from boundaries towards domain interior 104 ! at T-points 100 ! Define ramp from boundaries towards domain interior at T-points 105 101 ! Store it in ztabramp 106 ll_spdone=.FALSE.107 108 CALL wrk_alloc( jpi, jpj, ztabramp )109 102 110 103 ispongearea = 2 + nn_sponge_len * Agrif_irhox() 111 ilci = nlci - ispongearea 112 ilcj = nlcj - ispongearea 113 z1spongearea = 1._wp / REAL( ispongearea - 2 ) 114 104 z1_spongearea = 1._wp / REAL( ispongearea - 1 ) 105 115 106 ztabramp(:,:) = 0._wp 116 107 108 ! --- West --- ! 117 109 IF( (nbondi == -1) .OR. (nbondi == 2) ) THEN 110 ind1 = 1+nbghostcells 111 ind2 = 1+nbghostcells + (ispongearea-1) 118 112 DO jj = 1, jpj 119 IF ( umask(2,jj,1) == 1._wp ) THEN 120 DO ji = 2, ispongearea 121 ztabramp(ji,jj) = ( ispongearea-ji ) * z1spongearea 122 END DO 123 ENDIF 113 DO ji = ind1, ind2 114 ztabramp(ji,jj) = REAL( ind2 - ji ) * z1_spongearea * umask(ind1,jj,1) 115 END DO 124 116 ENDDO 125 117 ENDIF 126 118 119 ! --- East --- ! 127 120 IF( (nbondi == 1) .OR. (nbondi == 2) ) THEN 121 ind1 = nlci - (1+nbghostcells) - (ispongearea-1) 122 ind2 = nlci - (1+nbghostcells) 128 123 DO jj = 1, jpj 129 IF ( umask(nlci-2,jj,1) == 1._wp ) THEN 130 DO ji = ilci+1,nlci-1 131 zramp = (ji - (ilci+1) ) * z1spongearea 132 ztabramp(ji,jj) = MAX( ztabramp(ji,jj), zramp ) 133 ENDDO 134 ENDIF 124 DO ji = ind1, ind2 125 ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL( ji - ind2 ) * z1_spongearea * umask(ind2-1,jj,1) ) 126 ENDDO 135 127 ENDDO 136 128 ENDIF 137 129 130 ! --- South --- ! 138 131 IF( (nbondj == -1) .OR. (nbondj == 2) ) THEN 139 DO ji = 1, jpi 140 IF ( vmask(ji,2,1) == 1._wp ) THEN 141 DO jj = 2, ispongearea 142 zramp = ( ispongearea-jj ) * z1spongearea 143 ztabramp(ji,jj) = MAX( ztabramp(ji,jj), zramp ) 144 END DO 145 ENDIF 132 ind1 = 1+nbghostcells 133 ind2 = 1+nbghostcells + (ispongearea-1) 134 DO jj = ind1, ind2 135 DO ji = 1, jpi 136 ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL( ind2 - jj ) * z1_spongearea * vmask(ji,ind1,1) ) 137 END DO 146 138 ENDDO 147 139 ENDIF 148 140 141 ! --- North --- ! 149 142 IF( (nbondj == 1) .OR. (nbondj == 2) ) THEN 150 DO ji = 1, jpi 151 IF ( vmask(ji,nlcj-2,1) == 1._wp ) THEN 152 DO jj = ilcj+1,nlcj-1 153 zramp = (jj - (ilcj+1) ) * z1spongearea 154 ztabramp(ji,jj) = MAX( ztabramp(ji,jj), zramp ) 155 END DO 156 ENDIF 143 ind1 = nlcj - (1+nbghostcells) - (ispongearea-1) 144 ind2 = nlcj - (1+nbghostcells) 145 DO jj = ind1, ind2 146 DO ji = 1, jpi 147 ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL( jj - ind2 ) * z1_spongearea * vmask(ji,ind2-1,1) ) 148 END DO 157 149 ENDDO 158 150 ENDIF … … 166 158 DO jj = 2, jpjm1 167 159 DO ji = 2, jpim1 ! vector opt. 168 fsaht_spu(ji,jj) = 0.5_wp * visc_tra * (ztabramp(ji,jj) + ztabramp(ji+1,jj )) 169 fsaht_spv(ji,jj) = 0.5_wp * visc_tra * (ztabramp(ji,jj) + ztabramp(ji ,jj+1)) 170 END DO 171 END DO 172 160 fsaht_spu(ji,jj) = 0.5_wp * visc_tra * ( ztabramp(ji,jj) + ztabramp(ji+1,jj ) ) 161 fsaht_spv(ji,jj) = 0.5_wp * visc_tra * ( ztabramp(ji,jj) + ztabramp(ji ,jj+1) ) 162 END DO 163 END DO 173 164 CALL lbc_lnk( fsaht_spu, 'U', 1. ) ! Lateral boundary conditions 174 165 CALL lbc_lnk( fsaht_spv, 'V', 1. ) 166 175 167 spongedoneT = .TRUE. 176 168 ENDIF … … 184 176 fsahm_spt(ji,jj) = visc_dyn * ztabramp(ji,jj) 185 177 fsahm_spf(ji,jj) = 0.25_wp * visc_dyn * ( ztabramp(ji,jj) + ztabramp(ji ,jj+1) & 186 & +ztabramp(ji,jj) + ztabramp(ji+1,jj ) ) 187 END DO 188 END DO 189 ! 178 & +ztabramp(ji,jj) + ztabramp(ji+1,jj ) ) 179 END DO 180 END DO 190 181 CALL lbc_lnk( fsahm_spt, 'T', 1. ) ! Lateral boundary conditions 191 182 CALL lbc_lnk( fsahm_spf, 'F', 1. ) 183 192 184 spongedoneU = .TRUE. 193 185 ENDIF 194 !195 IF (.NOT.ll_spdone) CALL wrk_dealloc( jpi, jpj, ztabramp )196 186 ! 197 187 #endif … … 275 265 LOGICAL , INTENT(in ) :: before 276 266 !! 277 INTEGER :: ji,jj,jk 267 INTEGER :: ji, jj, jk 268 ! sponge parameters 278 269 INTEGER :: jmax 279 270 REAL(wp) :: ze2u, ze1v, zua, zva, zbtr … … 333 324 334 325 jmax = j2-1 335 IF ((nbondj == 1).OR.(nbondj == 2)) jmax = MIN(jmax,nlcj- 3)326 IF ((nbondj == 1).OR.(nbondj == 2)) jmax = MIN(jmax,nlcj-nbghostcells-2) ! North 336 327 337 328 DO jj = j1+1, jmax … … 409 400 410 401 imax = i2 - 1 411 IF ((nbondi == 1).OR.(nbondi == 2)) imax = MIN(imax,nlci- 3)402 IF ((nbondi == 1).OR.(nbondi == 2)) imax = MIN(imax,nlci-nbghostcells-2) ! East 412 403 413 404 DO jj = j1+1, j2 … … 447 438 CONTAINS 448 439 SUBROUTINE agrif_opa_sponge_empty 449 !!----------------------------------------------------------------------450 !! *** ROUTINE agrif_OPA_sponge_empty ***451 !!----------------------------------------------------------------------452 440 WRITE(*,*) 'agrif_opa_sponge : You should not have seen this print! error?' 453 441 END SUBROUTINE agrif_opa_sponge_empty
Note: See TracChangeset
for help on using the changeset viewer.
