Changeset 8738 for branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/NST_SRC/agrif_opa_sponge.F90
- Timestamp:
- 2017-11-17T15:40:12+01:00 (6 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/NST_SRC/agrif_opa_sponge.F90
r8733 r8738 34 34 !! *** ROUTINE Agrif_Sponge_Tra *** 35 35 !!--------------------------------------------- 36 REAL(wp) :: timecoeff36 REAL(wp) :: zcoef 37 37 !!--------------------------------------------- 38 38 ! 39 39 #if defined SPONGE 40 timecoeff = REAL(Agrif_NbStepint(),wp)/Agrif_rhot()40 zcoef = REAL(Agrif_NbStepint(),wp)/Agrif_rhot() 41 41 42 42 CALL Agrif_Sponge … … 45 45 tabspongedone_tsn = .FALSE. 46 46 47 CALL Agrif_Bc_Variable(tsn_sponge_id,calledweight= timecoeff,procname=interptsn_sponge)47 CALL Agrif_Bc_Variable(tsn_sponge_id,calledweight=zcoef,procname=interptsn_sponge) 48 48 49 49 Agrif_UseSpecialValue = .FALSE. … … 57 57 !! *** ROUTINE Agrif_Sponge_dyn *** 58 58 !!--------------------------------------------- 59 REAL(wp) :: timecoeff59 REAL(wp) :: zcoef 60 60 !!--------------------------------------------- 61 61 62 62 #if defined SPONGE 63 timecoeff = REAL(Agrif_NbStepint(),wp)/Agrif_rhot()63 zcoef = REAL(Agrif_NbStepint(),wp)/Agrif_rhot() 64 64 65 65 Agrif_SpecialValue=0. … … 68 68 tabspongedone_u = .FALSE. 69 69 tabspongedone_v = .FALSE. 70 CALL Agrif_Bc_Variable(un_sponge_id,calledweight= timecoeff,procname=interpun_sponge)70 CALL Agrif_Bc_Variable(un_sponge_id,calledweight=zcoef,procname=interpun_sponge) 71 71 72 72 tabspongedone_u = .FALSE. 73 73 tabspongedone_v = .FALSE. 74 CALL Agrif_Bc_Variable(vn_sponge_id,calledweight= timecoeff,procname=interpvn_sponge)74 CALL Agrif_Bc_Variable(vn_sponge_id,calledweight=zcoef,procname=interpvn_sponge) 75 75 76 76 Agrif_UseSpecialValue = .FALSE. … … 84 84 !! *** ROUTINE Agrif_Sponge *** 85 85 !!--------------------------------------------- 86 INTEGER :: ji,jj,jk 87 INTEGER :: ispongearea, ilci, ilcj 88 LOGICAL :: ll_spdone 89 REAL(wp) :: z1spongearea, zramp 90 REAL(wp), POINTER, DIMENSION(:,:) :: ztabramp 86 REAL(wp), DIMENSION(jpi,jpj) :: ztabramp 87 ! 88 INTEGER :: ji, jj, ind1, ind2 89 INTEGER :: ispongearea 90 REAL(wp) :: z1_spongearea 91 !!--------------------------------------------- 91 92 92 93 #if defined SPONGE || defined SPONGE_TOP 93 ll_spdone=.TRUE.94 94 IF (( .NOT. spongedoneT ).OR.( .NOT. spongedoneU )) THEN 95 ! Define ramp from boundaries towards domain interior 96 ! at T-points 95 ! Define ramp from boundaries towards domain interior at T-points 97 96 ! Store it in ztabramp 98 ll_spdone=.FALSE.99 100 CALL wrk_alloc( jpi, jpj, ztabramp )101 97 102 98 ispongearea = 2 + nn_sponge_len * Agrif_irhox() 103 ilci = nlci - ispongearea 104 ilcj = nlcj - ispongearea 105 z1spongearea = 1._wp / REAL( ispongearea - 2 ) 106 99 z1_spongearea = 1._wp / REAL( ispongearea - 1 ) 100 107 101 ztabramp(:,:) = 0._wp 108 102 103 ! --- West --- ! 109 104 IF( (nbondi == -1) .OR. (nbondi == 2) ) THEN 105 ind1 = 1+nbghostcells 106 ind2 = 1+nbghostcells + (ispongearea-1) 110 107 DO jj = 1, jpj 111 IF ( umask(2,jj,1) == 1._wp ) THEN 112 DO ji = 2, ispongearea 113 ztabramp(ji,jj) = ( ispongearea-ji ) * z1spongearea 114 END DO 115 ENDIF 108 DO ji = ind1, ind2 109 ztabramp(ji,jj) = REAL( ind2 - ji ) * z1_spongearea * umask(ind1,jj,1) 110 END DO 116 111 ENDDO 117 112 ENDIF 118 113 114 ! --- East --- ! 119 115 IF( (nbondi == 1) .OR. (nbondi == 2) ) THEN 116 ind1 = nlci - (1+nbghostcells) - (ispongearea-1) 117 ind2 = nlci - (1+nbghostcells) 120 118 DO jj = 1, jpj 121 IF ( umask(nlci-2,jj,1) == 1._wp ) THEN 122 DO ji = ilci+1,nlci-1 123 zramp = (ji - (ilci+1) ) * z1spongearea 124 ztabramp(ji,jj) = MAX( ztabramp(ji,jj), zramp ) 125 ENDDO 126 ENDIF 119 DO ji = ind1, ind2 120 ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL( ji - ind2 ) * z1_spongearea * umask(ind2-1,jj,1) ) 121 ENDDO 127 122 ENDDO 128 123 ENDIF 129 124 125 ! --- South --- ! 130 126 IF( (nbondj == -1) .OR. (nbondj == 2) ) THEN 131 DO ji = 1, jpi 132 IF ( vmask(ji,2,1) == 1._wp ) THEN 133 DO jj = 2, ispongearea 134 zramp = ( ispongearea-jj ) * z1spongearea 135 ztabramp(ji,jj) = MAX( ztabramp(ji,jj), zramp ) 136 END DO 137 ENDIF 127 ind1 = 1+nbghostcells 128 ind2 = 1+nbghostcells + (ispongearea-1) 129 DO jj = ind1, ind2 130 DO ji = 1, jpi 131 ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL( ind2 - jj ) * z1_spongearea * vmask(ji,ind1,1) ) 132 END DO 138 133 ENDDO 139 134 ENDIF 140 135 136 ! --- North --- ! 141 137 IF( (nbondj == 1) .OR. (nbondj == 2) ) THEN 142 DO ji = 1, jpi 143 IF ( vmask(ji,nlcj-2,1) == 1._wp ) THEN 144 DO jj = ilcj+1,nlcj-1 145 zramp = (jj - (ilcj+1) ) * z1spongearea 146 ztabramp(ji,jj) = MAX( ztabramp(ji,jj), zramp ) 147 END DO 148 ENDIF 138 ind1 = nlcj - (1+nbghostcells) - (ispongearea-1) 139 ind2 = nlcj - (1+nbghostcells) 140 DO jj = ind1, ind2 141 DO ji = 1, jpi 142 ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL( jj - ind2 ) * z1_spongearea * vmask(ji,ind2-1,1) ) 143 END DO 149 144 ENDDO 150 145 ENDIF … … 158 153 DO jj = 2, jpjm1 159 154 DO ji = 2, jpim1 ! vector opt. 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 164 155 fsaht_spu(ji,jj) = 0.5_wp * visc_tra * ( ztabramp(ji,jj) + ztabramp(ji+1,jj ) ) 156 fsaht_spv(ji,jj) = 0.5_wp * visc_tra * ( ztabramp(ji,jj) + ztabramp(ji ,jj+1) ) 157 END DO 158 END DO 165 159 CALL lbc_lnk( fsaht_spu, 'U', 1. ) ! Lateral boundary conditions 166 160 CALL lbc_lnk( fsaht_spv, 'V', 1. ) 161 167 162 spongedoneT = .TRUE. 168 163 ENDIF … … 179 174 END DO 180 175 END DO 181 182 176 CALL lbc_lnk( fsahm_spt, 'T', 1. ) ! Lateral boundary conditions 183 177 CALL lbc_lnk( fsahm_spf, 'F', 1. ) 178 184 179 spongedoneU = .TRUE. 185 180 ENDIF 186 !187 IF (.NOT.ll_spdone) CALL wrk_dealloc( jpi, jpj, ztabramp )188 181 ! 189 182 #endif … … 205 198 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2) :: ztu, ztv 206 199 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2) ::tsbdiff 200 !!--------------------------------------------- 207 201 ! 208 202 IF( before ) THEN … … 327 321 328 322 jmax = j2-1 329 IF ((nbondj == 1).OR.(nbondj == 2)) jmax = MIN(jmax,nlcj- 3)323 IF ((nbondj == 1).OR.(nbondj == 2)) jmax = MIN(jmax,nlcj-nbghostcells-2) ! North 330 324 331 325 DO jj = j1+1, jmax … … 404 398 405 399 imax = i2-1 406 IF ((nbondi == 1).OR.(nbondi == 2)) imax = MIN(imax,nlci- 3)400 IF ((nbondi == 1).OR.(nbondi == 2)) imax = MIN(imax,nlci-nbghostcells-2) ! East 407 401 408 402 DO jj = j1+1, j2
Note: See TracChangeset
for help on using the changeset viewer.