- Timestamp:
- 2012-11-15T19:09:49+01:00 (12 years ago)
- Location:
- branches/2012/dev_r3387_LOCEAN6_AGRIF_LIM/NEMOGCM/NEMO/NST_SRC
- Files:
-
- 5 edited
-
agrif_opa_sponge.F90 (modified) (16 diffs)
-
agrif_top_interp.F90 (modified) (2 diffs)
-
agrif_top_sponge.F90 (modified) (5 diffs)
-
agrif_top_update.F90 (modified) (3 diffs)
-
agrif_user.F90 (modified) (3 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/2012/dev_r3387_LOCEAN6_AGRIF_LIM/NEMOGCM/NEMO/NST_SRC/agrif_opa_sponge.F90
r3294 r3566 1 #define SPONGE 1 #define SPONGE && define SPONGE_TOP 2 2 3 3 Module agrif_opa_sponge … … 13 13 PRIVATE 14 14 15 PUBLIC Agrif_Sponge_Tra, Agrif_Sponge_Dyn, interptsn, interpun, interpvn 16 15 PUBLIC Agrif_Sponge, Agrif_Sponge_Tra, Agrif_Sponge_Dyn, interptsn, interpun, interpvn 16 17 !! * Substitutions 18 # include "domzgr_substitute.h90" 17 19 !!---------------------------------------------------------------------- 18 20 !! NEMO/NST 3.3 , NEMO Consortium (2010) … … 27 29 !! *** ROUTINE Agrif_Sponge_Tra *** 28 30 !!--------------------------------------------- 29 #include "domzgr_substitute.h90"30 31 !! 31 32 INTEGER :: ji,jj,jk,jn 32 INTEGER :: spongearea33 33 REAL(wp) :: timecoeff 34 34 REAL(wp) :: ztsa, zabe1, zabe2, zbtr 35 REAL(wp), POINTER, DIMENSION(:,: ) :: localviscsponge36 35 REAL(wp), POINTER, DIMENSION(:,: ) :: ztu, ztv 37 36 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztab … … 39 38 40 39 #if defined SPONGE 41 CALL wrk_alloc( jpi, jpj, localviscsponge,ztu, ztv )40 CALL wrk_alloc( jpi, jpj, ztu, ztv ) 42 41 CALL wrk_alloc( jpi, jpj, jpk, jpts, ztab, tsbdiff ) 43 42 … … 52 51 tsbdiff(:,:,:,:) = tsb(:,:,:,:) - ztab(:,:,:,:) 53 52 54 spongearea = 2 + 2 * Agrif_irhox() 55 56 localviscsponge = 0. 57 58 IF (.NOT. spongedoneT) THEN 59 spe1ur(:,:) = 0. 60 spe2vr(:,:) = 0. 61 62 IF ((nbondi == -1).OR.(nbondi == 2)) THEN 63 DO ji = 2, spongearea 64 localviscsponge(ji,:) = visc_tra * (spongearea-ji)/real(spongearea-2) 65 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 ENDIF 74 75 IF ((nbondi == 1).OR.(nbondi == 2)) THEN 76 DO ji = nlci-spongearea + 1,nlci-1 77 localviscsponge(ji,:) = visc_tra * (ji - (nlci-spongearea+1))/real(spongearea-2) 78 ENDDO 79 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 ENDIF 88 89 90 IF ((nbondj == -1).OR.(nbondj == 2)) THEN 91 DO jj = 2, spongearea 92 localviscsponge(:,jj) = visc_tra * (spongearea-jj)/real(spongearea-2) 93 ENDDO 94 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 ENDIF 103 104 IF ((nbondj == 1).OR.(nbondj == 2)) THEN 105 DO jj = nlcj-spongearea + 1,nlcj-1 106 localviscsponge(:,jj) = visc_tra * (jj - (nlcj-spongearea+1))/real(spongearea-2) 107 ENDDO 108 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 ENDIF 117 118 spbtr2(:,:) = 1. / ( e1t(:,:) * e2t(:,:)) 119 120 spongedoneT = .TRUE. 121 ENDIF 53 CALL Agrif_Sponge 122 54 123 55 DO jn = 1, jpts … … 147 79 ENDDO 148 80 149 CALL wrk_dealloc( jpi, jpj, localviscsponge,ztu, ztv )81 CALL wrk_dealloc( jpi, jpj, ztu, ztv ) 150 82 CALL wrk_dealloc( jpi, jpj, jpk, jpts, ztab, tsbdiff ) 151 83 #endif … … 157 89 !! *** ROUTINE Agrif_Sponge_dyn *** 158 90 !!--------------------------------------------- 159 #include "domzgr_substitute.h90"160 91 !! 161 92 INTEGER :: ji,jj,jk 162 INTEGER :: spongearea163 93 REAL(wp) :: timecoeff 164 94 REAL(wp) :: ze2u, ze1v, zua, zva, zbtr 165 REAL(wp), POINTER, DIMENSION(:,:) :: localviscsponge166 95 REAL(wp), POINTER, DIMENSION(:,:,:) :: ubdiff, vbdiff 167 96 REAL(wp), POINTER, DIMENSION(:,:,:) :: rotdiff, hdivdiff … … 169 98 170 99 #if defined SPONGE 171 CALL wrk_alloc( jpi, jpj, localviscsponge )172 100 CALL wrk_alloc( jpi, jpj, jpk, ztab, ubdiff, vbdiff, rotdiff, hdivdiff ) 173 101 … … 180 108 Agrif_UseSpecialValue = .FALSE. 181 109 182 ubdiff(:,:,:) = ( ub(:,:,:) - ztab(:,:,:))*umask(:,:,:)110 ubdiff(:,:,:) = ( ub(:,:,:) - ztab(:,:,:) ) * umask(:,:,:) 183 111 184 112 ztab = 0.e0 … … 188 116 Agrif_UseSpecialValue = .FALSE. 189 117 190 vbdiff(:,:,:) = (vb(:,:,:) - ztab(:,:,:))*vmask(:,:,:) 191 192 spongearea = 2 + 2 * Agrif_irhox() 193 194 localviscsponge = 0. 195 196 IF (.NOT. spongedoneU) THEN 197 spe1ur2(:,:) = 0. 198 spe2vr2(:,:) = 0. 199 200 IF ((nbondi == -1).OR.(nbondi == 2)) THEN 201 DO ji = 2, spongearea 202 localviscsponge(ji,:) = visc_dyn * (spongearea-ji)/real(spongearea-2) 203 ENDDO 204 205 spe1ur2(2:spongearea-1,:)=0.5 * (localviscsponge(2:spongearea-1,:) + localviscsponge(3:spongearea,:)) 206 207 spe2vr2(2:spongearea,1:jpjm1) = 0.5 * (localviscsponge(2:spongearea,1:jpjm1) + & 208 localviscsponge(2:spongearea,2:jpj)) 209 ENDIF 210 211 IF ((nbondi == 1).OR.(nbondi == 2)) THEN 212 DO ji = nlci-spongearea + 1,nlci-1 213 localviscsponge(ji,:) = visc_dyn * (ji - (nlci-spongearea+1))/real(spongearea-2) 214 ENDDO 215 216 spe1ur2(nlci-spongearea + 1:nlci-2,:)=0.5 * (localviscsponge(nlci-spongearea + 1:nlci-2,:) + & 217 localviscsponge(nlci-spongearea + 2:nlci-1,:)) 218 219 spe2vr2(nlci-spongearea + 1:nlci-1,1:jpjm1) = 0.5 * (localviscsponge(nlci-spongearea + 1:nlci-1,1:jpjm1) & 220 + localviscsponge(nlci-spongearea + 1:nlci-1,2:jpj)) 221 ENDIF 222 223 224 IF ((nbondj == -1).OR.(nbondj == 2)) THEN 225 DO jj = 2, spongearea 226 localviscsponge(:,jj) = visc_dyn * (spongearea-jj)/real(spongearea-2) 227 ENDDO 228 229 spe1ur2(1:jpim1,2:spongearea)=0.5 * (localviscsponge(1:jpim1,2:spongearea) + & 230 localviscsponge(2:jpi,2:spongearea)) 231 232 spe2vr2(:,2:spongearea-1) = 0.5 * (localviscsponge(:,2:spongearea-1) + & 233 localviscsponge(:,3:spongearea)) 234 ENDIF 235 236 IF ((nbondj == 1).OR.(nbondj == 2)) THEN 237 DO jj = nlcj-spongearea + 1,nlcj-1 238 localviscsponge(:,jj) = visc_dyn * (jj - (nlcj-spongearea+1))/real(spongearea-2) 239 ENDDO 240 241 spe1ur2(1:jpim1,nlcj-spongearea + 1:nlcj-1)=0.5 * (localviscsponge(1:jpim1,nlcj-spongearea + 1:nlcj-1) + & 242 localviscsponge(2:jpi,nlcj-spongearea + 1:nlcj-1)) 243 244 spe2vr2(:,nlcj-spongearea + 1:nlcj-2) = 0.5 * (localviscsponge(:,nlcj-spongearea + 1:nlcj-2) + & 245 localviscsponge(:,nlcj-spongearea + 2:nlcj-1)) 246 ENDIF 247 248 spongedoneU = .TRUE. 249 250 spbtr3(:,:) = 1./( e1f(:,:) * e2f(:,:)) 251 ENDIF 252 253 IF (.NOT. spongedoneT) THEN 254 spbtr2(:,:) = 1. / ( e1t(:,:) * e2t(:,:)) 255 ENDIF 256 257 DO jk=1,jpkm1 258 ubdiff(:,:,jk) = ubdiff(:,:,jk) * spe1ur2(:,:) 259 vbdiff(:,:,jk) = vbdiff(:,:,jk) * spe2vr2(:,:) 118 vbdiff(:,:,:) = ( vb(:,:,:) - ztab(:,:,:) ) * vmask(:,:,:) 119 120 CALL Agrif_Sponge 121 122 DO jk = 1,jpkm1 123 ubdiff(:,:,jk) = ubdiff(:,:,jk) * spe1ur2(:,:) 124 vbdiff(:,:,jk) = vbdiff(:,:,jk) * spe2vr2(:,:) 260 125 ENDDO 261 126 … … 272 137 DO ji = 2, jpim1 ! vector opt. 273 138 zbtr = spbtr2(ji,jj) / fse3t(ji,jj,jk) 274 hdivdiff(ji,jj,jk) = & 275 ( e2u(ji,jj)*fse3u(ji,jj,jk) * & 276 ubdiff(ji,jj,jk) - e2u(ji-1,jj )* & 277 fse3u(ji-1,jj ,jk) * ubdiff(ji-1,jj ,jk) & 278 + e1v(ji,jj)*fse3v(ji,jj,jk) * & 279 vbdiff(ji,jj,jk) - e1v(ji ,jj-1)* & 280 fse3v(ji ,jj-1,jk) * vbdiff(ji ,jj-1,jk) ) * zbtr 139 hdivdiff(ji,jj,jk) = ( e2u(ji ,jj ) * fse3u(ji ,jj ,jk) * ubdiff(ji ,jj ,jk) & 140 & - e2u(ji-1,jj ) * fse3u(ji-1,jj ,jk) * ubdiff(ji-1,jj ,jk) & 141 & + e1v(ji ,jj ) * fse3v(ji ,jj ,jk) * vbdiff(ji ,jj ,jk) & 142 & - e1v(ji ,jj-1) * fse3v(ji ,jj-1,jk) * vbdiff(ji ,jj-1,jk) ) * zbtr 281 143 END DO 282 144 END DO … … 286 148 zbtr = spbtr3(ji,jj) * fse3f(ji,jj,jk) 287 149 rotdiff(ji,jj,jk) = ( e2v(ji+1,jj ) * vbdiff(ji+1,jj ,jk) - e2v(ji,jj) * vbdiff(ji,jj,jk) & 288 & - e1u(ji ,jj+1) * ubdiff(ji ,jj+1,jk) + e1u(ji,jj) * ubdiff(ji,jj,jk) ) &289 & * fmask(ji,jj,jk) * zbtr150 & - e1u(ji ,jj+1) * ubdiff(ji ,jj+1,jk) + e1u(ji,jj) * ubdiff(ji,jj,jk) ) & 151 & * fmask(ji,jj,jk) * zbtr 290 152 END DO 291 153 END DO … … 298 160 DO jj = 2, jpjm1 299 161 DO ji = 2, jpim1 ! vector opt. 300 ze2u = rotdiff (ji,jj,jk)301 ze1v = hdivdiff(ji,jj,jk)302 162 ! horizontal diffusive trends 303 zua = - ( ze2u - rotdiff (ji,jj-1,jk)) / ( e2u(ji,jj) * fse3u(ji,jj,jk) ) & 304 + ( hdivdiff(ji+1,jj,jk) - ze1v & 305 ) / e1u(ji,jj) 306 307 zva = + ( ze2u - rotdiff (ji-1,jj,jk)) / ( e1v(ji,jj) * fse3v(ji,jj,jk) ) & 308 + ( hdivdiff(ji,jj+1,jk) - ze1v & 309 ) / e2v(ji,jj) 310 163 zua = - ( rotdiff (ji ,jj,jk) - rotdiff (ji,jj-1,jk) ) / ( e2u(ji,jj) * fse3u(ji,jj,jk) ) & 164 + ( hdivdiff(ji+1,jj,jk) - hdivdiff(ji,jj ,jk) ) / e1u(ji,jj) 165 166 zva = + ( rotdiff (ji,jj ,jk) - rotdiff (ji-1,jj,jk) ) / ( e1v(ji,jj) * fse3v(ji,jj,jk) ) & 167 + ( hdivdiff(ji,jj+1,jk) - hdivdiff(ji ,jj,jk) ) / e2v(ji,jj) 311 168 ! add it to the general momentum trends 312 169 ua(ji,jj,jk) = ua(ji,jj,jk) + zua … … 317 174 END DO ! End of slab 318 175 ! ! =============== 319 CALL wrk_dealloc( jpi, jpj, localviscsponge )320 176 CALL wrk_dealloc( jpi, jpj, jpk, ztab, ubdiff, vbdiff, rotdiff, hdivdiff ) 321 322 177 #endif 323 178 324 179 END SUBROUTINE Agrif_Sponge_dyn 325 180 181 SUBROUTINE Agrif_Sponge 182 !!--------------------------------------------- 183 !! *** ROUTINE Agrif_Sponge *** 184 !!--------------------------------------------- 185 INTEGER :: ji,jj,jk 186 INTEGER :: ispongearea, ilci, ilcj 187 REAL(wp) :: z1spongearea 188 REAL(wp), POINTER, DIMENSION(:,:) :: zlocalviscsponge 189 190 #if defined SPONGE || defined SPONGE_TOP 191 192 CALL wrk_alloc( jpi, jpj, zlocalviscsponge ) 193 194 ispongearea = 2 + 2 * Agrif_irhox() 195 ilci = nlci - ispongearea 196 ilcj = nlcj - ispongearea 197 z1spongearea = 1._wp / REAL( ispongearea - 2 ) 198 spbtr2(:,:) = 1. / ( e1t(:,:) * e2t(:,:) ) 199 200 ! Tracers 201 IF( .NOT. spongedoneT ) THEN 202 zlocalviscsponge(:,:) = 0. 203 spe1ur(:,:) = 0. 204 spe2vr(:,:) = 0. 205 206 IF( (nbondi == -1) .OR. (nbondi == 2) ) THEN 207 DO ji = 2, ispongearea 208 zlocalviscsponge(ji,:) = visc_tra * ( ispongearea-ji ) * z1spongearea 209 ENDDO 210 spe1ur(2:ispongearea-1,: ) = 0.5 * ( zlocalviscsponge(2:ispongearea-1,: ) + zlocalviscsponge(3:ispongearea,: ) ) & 211 & * e2u(2:ispongearea-1,: ) / e1u(2:ispongearea-1,: ) 212 spe2vr(2:ispongearea ,1:jpjm1) = 0.5 * ( zlocalviscsponge(2:ispongearea ,1:jpjm1) + zlocalviscsponge(2:ispongearea,2:jpj) ) & 213 & * e1v(2:ispongearea ,1:jpjm1) / e2v(2:ispongearea ,1:jpjm1) 214 ENDIF 215 216 IF( (nbondi == 1) .OR. (nbondi == 2) ) THEN 217 DO ji = ilci+1,nlci-1 218 zlocalviscsponge(ji,:) = visc_tra * (ji - (ilci+1) ) * z1spongearea 219 ENDDO 220 221 spe1ur(ilci+1:nlci-2,: ) = 0.5 * ( zlocalviscsponge(ilci+1:nlci-2,:) + zlocalviscsponge(ilci+2:nlci-1,:) ) & 222 & * e2u(ilci+1:nlci-2,:) / e1u(ilci+1:nlci-2,:) 223 224 spe2vr(ilci+1:nlci-1,1:jpjm1) = 0.5 * ( zlocalviscsponge(ilci+1:nlci-1,1:jpjm1) + zlocalviscsponge(ilci+1:nlci-1,2:jpj ) ) & 225 & * e1v(ilci+1:nlci-1,1:jpjm1) / e2v(ilci+1:nlci-1,1:jpjm1) 226 ENDIF 227 228 IF( (nbondj == -1) .OR. (nbondj == 2) ) THEN 229 DO jj = 2, ispongearea 230 zlocalviscsponge(:,jj) = visc_tra * ( ispongearea-jj ) * z1spongearea 231 ENDDO 232 spe1ur(1:jpim1,2:ispongearea ) = 0.5 * ( zlocalviscsponge(1:jpim1,2:ispongearea) + zlocalviscsponge(2:jpi,2:ispongearea) ) & 233 & * e2u(1:jpim1,2:ispongearea) / e1u(1:jpim1,2:ispongearea) 234 235 spe2vr(: ,2:ispongearea-1) = 0.5 * ( zlocalviscsponge(:,2:ispongearea-1) + zlocalviscsponge(:,3:ispongearea) ) & 236 & * e1v(:,2:ispongearea-1) / e2v(:,2:ispongearea-1) 237 ENDIF 238 239 IF( (nbondj == 1) .OR. (nbondj == 2) ) THEN 240 DO jj = ilcj+1,nlcj-1 241 zlocalviscsponge(:,jj) = visc_tra * (jj - (ilcj+1) ) * z1spongearea 242 ENDDO 243 spe1ur(1:jpim1,ilcj+1:nlcj-1) = 0.5 * ( zlocalviscsponge(1:jpim1,ilcj+1:nlcj-1) + zlocalviscsponge(2:jpi,ilcj+1:nlcj-1) ) & 244 & * e2u(1:jpim1,ilcj+1:nlcj-1) / e1u(1:jpim1,ilcj+1:nlcj-1) 245 spe2vr(: ,ilcj+1:nlcj-2) = 0.5 * ( zlocalviscsponge(:,ilcj+1:nlcj-2 ) + zlocalviscsponge(:,ilcj+2:nlcj-1) ) & 246 & * e1v(:,ilcj+1:nlcj-2) / e2v(:,ilcj+1:nlcj-2) 247 ENDIF 248 spongedoneT = .TRUE. 249 ENDIF 250 251 ! Dynamics 252 IF( .NOT. spongedoneU ) THEN 253 zlocalviscsponge(:,:) = 0. 254 spe1ur2(:,:) = 0. 255 spe2vr2(:,:) = 0. 256 257 IF( (nbondi == -1) .OR. (nbondi == 2) ) THEN 258 DO ji = 2, ispongearea 259 zlocalviscsponge(ji,:) = visc_dyn * ( ispongearea-ji ) * z1spongearea 260 ENDDO 261 spe1ur2(2:ispongearea-1,: ) = 0.5 * ( zlocalviscsponge(2:ispongearea-1,: ) + zlocalviscsponge(3:ispongearea,: ) ) 262 spe2vr2(2:ispongearea ,1:jpjm1) = 0.5 * ( zlocalviscsponge(2:ispongearea ,1:jpjm1) + zlocalviscsponge(2:ispongearea,2:jpj) ) 263 ENDIF 264 265 IF( (nbondi == 1) .OR. (nbondi == 2) ) THEN 266 DO ji = ilci+1,nlci-1 267 zlocalviscsponge(ji,:) = visc_dyn * (ji - (ilci+1) ) * z1spongearea 268 ENDDO 269 spe1ur2(ilci+1:nlci-2,: ) = 0.5 * ( zlocalviscsponge(ilci+1:nlci-2,:) + zlocalviscsponge(ilci+2:nlci-1,:) ) 270 spe2vr2(ilci+1:nlci-1,1:jpjm1) = 0.5 * ( zlocalviscsponge(ilci+1:nlci-1,1:jpjm1) + zlocalviscsponge(ilci+1:nlci-1,2:jpj ) ) 271 ENDIF 272 273 IF( (nbondj == -1) .OR. (nbondj == 2) ) THEN 274 DO jj = 2, ispongearea 275 zlocalviscsponge(:,jj) = visc_dyn * ( ispongearea-jj ) * z1spongearea 276 ENDDO 277 spe1ur2(1:jpim1,2:ispongearea ) = 0.5 * ( zlocalviscsponge(1:jpim1,2:ispongearea) + zlocalviscsponge(2:jpi,2:ispongearea) ) 278 spe2vr2(: ,2:ispongearea-1) = 0.5 * ( zlocalviscsponge(:,2:ispongearea-1) + zlocalviscsponge(:,3:ispongearea) ) 279 ENDIF 280 281 IF( (nbondj == 1) .OR. (nbondj == 2) ) THEN 282 DO jj = ilcj+1,nlcj-1 283 zlocalviscsponge(:,jj) = visc_dyn * (jj - (ilcj+1) ) * z1spongearea 284 ENDDO 285 spe1ur2(1:jpim1,ilcj+1:nlcj-1) = 0.5 * ( zlocalviscsponge(1:jpim1,ilcj+1:nlcj-1) + zlocalviscsponge(2:jpi,ilcj+1:nlcj-1) ) 286 spe2vr2(: ,ilcj+1:nlcj-2) = 0.5 * ( zlocalviscsponge(:,ilcj+1:nlcj-2 ) + zlocalviscsponge(:,ilcj+2:nlcj-1) ) 287 ENDIF 288 spongedoneU = .TRUE. 289 spbtr3(:,:) = 1. / ( e1f(:,:) * e2f(:,:) ) 290 ENDIF 291 ! 292 CALL wrk_dealloc( jpi, jpj, zlocalviscsponge ) 293 ! 294 #endif 295 296 END SUBROUTINE Agrif_Sponge 297 326 298 SUBROUTINE interptsn(tabres,i1,i2,j1,j2,k1,k2,n1,n2) 327 299 !!--------------------------------------------- 328 300 !! *** ROUTINE interptsn *** 329 301 !!--------------------------------------------- 330 # include "domzgr_substitute.h90"331 332 302 INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n2 333 303 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres … … 341 311 !! *** ROUTINE interpun *** 342 312 !!--------------------------------------------- 343 # include "domzgr_substitute.h90"344 345 313 INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2 346 314 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres … … 354 322 !! *** ROUTINE interpvn *** 355 323 !!--------------------------------------------- 356 # include "domzgr_substitute.h90"357 358 324 INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2 359 325 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres -
branches/2012/dev_r3387_LOCEAN6_AGRIF_LIM/NEMOGCM/NEMO/NST_SRC/agrif_top_interp.F90
r3294 r3566 27 27 28 28 SUBROUTINE Agrif_trc 29 !!--------------------------------------------- 30 !! *** ROUTINE Agrif_trc *** 31 !!--------------------------------------------- 32 33 INTEGER :: ji,jj,jk,jn 34 REAL(wp) :: zrhox 35 REAL(wp) :: alpha1, alpha2, alpha3, alpha4 36 REAL(wp) :: alpha5, alpha6, alpha7 29 !!---------------------------------------------------------------------- 30 !! *** ROUTINE Agrif_Tra *** 31 !!---------------------------------------------------------------------- 32 !! 33 INTEGER :: ji, jj, jk, jn ! dummy loop indices 34 REAL(wp) :: zrhox , alpha1, alpha2, alpha3 35 REAL(wp) :: alpha4, alpha5, alpha6, alpha7 37 36 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztra 38 39 IF (Agrif_Root()) RETURN 37 !!---------------------------------------------------------------------- 38 ! 39 IF( Agrif_Root() ) RETURN 40 40 41 41 CALL wrk_alloc( jpi, jpj, jpk, jptra, ztra ) 42 42 43 Agrif_SpecialValue =0.43 Agrif_SpecialValue = 0.e0 44 44 Agrif_UseSpecialValue = .TRUE. 45 ztra = 0.e045 ztra(:,:,:,:) = 0.e0 46 46 47 CALL Agrif_Bc_variable( ztra,trn_id, procname =interptrn )47 CALL Agrif_Bc_variable( ztra, trn_id, procname=interptrn ) 48 48 Agrif_UseSpecialValue = .FALSE. 49 49 50 50 zrhox = Agrif_Rhox() 51 51 52 alpha1 = ( zrhox-1.)/2.53 alpha2 = 1. -alpha152 alpha1 = ( zrhox - 1. ) * 0.5 53 alpha2 = 1. - alpha1 54 54 55 alpha3 = ( zrhox-1)/(zrhox+1)56 alpha4 = 1. -alpha355 alpha3 = ( zrhox - 1. ) / ( zrhox + 1. ) 56 alpha4 = 1. - alpha3 57 57 58 alpha6 = 2. *(zrhox-1.)/(zrhox+1.)59 alpha7 = -(zrhox-1)/(zrhox+3)58 alpha6 = 2. * ( zrhox - 1. ) / ( zrhox + 1. ) 59 alpha7 = - ( zrhox - 1. ) / ( zrhox + 3. ) 60 60 alpha5 = 1. - alpha6 - alpha7 61 IF( nbondi == 1 .OR. nbondi == 2 ) THEN 61 62 62 IF ((nbondi == 1).OR.(nbondi == 2)) THEN 63 tra(nlci,:,:,:) = alpha1 * ztra(nlci,:,:,:) + alpha2 * ztra(nlci-1,:,:,:) 64 DO jn=1,jptra 65 DO jk=1,jpk 66 DO jj=1,jpj 67 IF (umask(nlci-2,jj,jk).EQ.0.) THEN 63 DO jn = 1, jptra 64 tra(nlci,:,:,jn) = alpha1 * ztra(nlci,:,:,jn) + alpha2 * ztra(nlci-1,:,:,jn) 65 DO jk = 1, jpkm1 66 DO jj = 1, jpj 67 IF( umask(nlci-2,jj,jk) == 0.e0 ) THEN 68 68 tra(nlci-1,jj,jk,jn) = tra(nlci,jj,jk,jn) * tmask(nlci-1,jj,jk) 69 69 ELSE 70 70 tra(nlci-1,jj,jk,jn)=(alpha4*tra(nlci,jj,jk,jn)+alpha3*tra(nlci-2,jj,jk,jn))*tmask(nlci-1,jj,jk) 71 IF (un(nlci-2,jj,jk).GT.0.) THEN 72 tra(nlci-1,jj,jk,jn)=(alpha6*tra(nlci-2,jj,jk,jn)+alpha5*tra(nlci,jj,jk,jn) & 73 +alpha7*tra(nlci-3,jj,jk,jn))*tmask(nlci-1,jj,jk) 71 IF( un(nlci-2,jj,jk) > 0.e0 ) THEN 72 tra(nlci-1,jj,jk,jn)=( alpha6*tra(nlci-2,jj,jk,jn)+alpha5*tra(nlci,jj,jk,jn) & 73 & + alpha7*tra(nlci-3,jj,jk,jn) ) * tmask(nlci-1,jj,jk) 74 ENDIF 75 ENDIF 76 END DO 77 END DO 78 ENDDO 79 ENDIF 80 81 IF( nbondj == 1 .OR. nbondj == 2 ) THEN 82 83 DO jn = 1, jptra 84 tra(:,nlcj,:,jn) = alpha1 * ztra(:,nlcj,:,jn) + alpha2 * ztra(:,nlcj-1,:,jn) 85 DO jk = 1, jpkm1 86 DO ji = 1, jpi 87 IF( vmask(ji,nlcj-2,jk) == 0.e0 ) THEN 88 tra(ji,nlcj-1,jk,jn) = tra(ji,nlcj,jk,jn) * tmask(ji,nlcj-1,jk) 89 ELSE 90 tra(ji,nlcj-1,jk,jn)=(alpha4*tra(ji,nlcj,jk,jn)+alpha3*tra(ji,nlcj-2,jk,jn))*tmask(ji,nlcj-1,jk) 91 IF (vn(ji,nlcj-2,jk) > 0.e0 ) THEN 92 tra(ji,nlcj-1,jk,jn)=( alpha6*tra(ji,nlcj-2,jk,jn)+alpha5*tra(ji,nlcj,jk,jn) & 93 & + alpha7*tra(ji,nlcj-3,jk,jn) ) * tmask(ji,nlcj-1,jk) 94 ENDIF 95 ENDIF 96 END DO 97 END DO 98 ENDDO 99 ENDIF 100 IF( nbondi == -1 .OR. nbondi == 2 ) THEN 101 DO jn = 1, jptra 102 tra(1,:,:,jn) = alpha1 * ztra(1,:,:,jn) + alpha2 * ztra(2,:,:,jn) 103 DO jk = 1, jpkm1 104 DO jj = 1, jpj 105 IF( umask(2,jj,jk) == 0.e0 ) THEN 106 tra(2,jj,jk,jn) = tra(1,jj,jk,jn) * tmask(2,jj,jk) 107 ELSE 108 tra(2,jj,jk,jn)=(alpha4*tra(1,jj,jk,jn)+alpha3*tra(3,jj,jk,jn))*tmask(2,jj,jk) 109 IF( un(2,jj,jk) < 0.e0 ) THEN 110 tra(2,jj,jk,jn)=(alpha6*tra(3,jj,jk,jn)+alpha5*tra(1,jj,jk,jn)+alpha7*tra(4,jj,jk,jn))*tmask(2,jj,jk) 74 111 ENDIF 75 112 ENDIF … … 79 116 ENDIF 80 117 81 IF ((nbondj == 1).OR.(nbondj == 2)) THEN82 tra(:,nlcj,:,:) = alpha1 * ztra(:,nlcj,:,:) + alpha2 * ztra(:,nlcj-1,:,:)83 DO jn=1, jptra84 DO jk=1,jpk 118 IF( nbondj == -1 .OR. nbondj == 2 ) THEN 119 DO jn = 1, jptra 120 tra(:,1,:,jn) = alpha1 * ztra(:,1,:,jn) + alpha2 * ztra(:,2,:,jn) 121 DO jk=1,jpk 85 122 DO ji=1,jpi 86 IF (vmask(ji,nlcj-2,jk).EQ.0.) THEN87 tra(ji, nlcj-1,jk,jn) = tra(ji,nlcj,jk,jn) * tmask(ji,nlcj-1,jk)123 IF( vmask(ji,2,jk) == 0.e0 ) THEN 124 tra(ji,2,jk,jn)=tra(ji,1,jk,jn) * tmask(ji,2,jk) 88 125 ELSE 89 tra(ji,nlcj-1,jk,jn)=(alpha4*tra(ji,nlcj,jk,jn)+alpha3*tra(ji,nlcj-2,jk,jn))*tmask(ji,nlcj-1,jk) 90 IF (vn(ji,nlcj-2,jk) .GT. 0.) THEN 91 tra(ji,nlcj-1,jk,jn)=(alpha6*tra(ji,nlcj-2,jk,jn)+alpha5*tra(ji,nlcj,jk,jn) & 92 +alpha7*tra(ji,nlcj-3,jk,jn))*tmask(ji,nlcj-1,jk) 126 tra(ji,2,jk,jn)=(alpha4*tra(ji,1,jk,jn)+alpha3*tra(ji,3,jk,jn))*tmask(ji,2,jk) 127 IF( vn(ji,2,jk) < 0.e0 ) THEN 128 tra(ji,2,jk,jn)=(alpha6*tra(ji,3,jk,jn)+alpha5*tra(ji,1,jk,jn)+alpha7*tra(ji,4,jk,jn))*tmask(ji,2,jk) 93 129 ENDIF 94 130 ENDIF 95 131 END DO 96 132 END DO 97 END 133 ENDDO 98 134 ENDIF 99 100 IF ((nbondi == -1).OR.(nbondi == 2)) THEN 101 tra(1,:,:,:) = alpha1 * ztra(1,:,:,:) + alpha2 * ztra(2,:,:,:) 102 DO jn=1, jptra 103 DO jk=1,jpk 104 DO jj=1,jpj 105 IF (umask(2,jj,jk).EQ.0.) THEN 106 tra(2,jj,jk,jn) = tra(1,jj,jk,jn) * tmask(2,jj,jk) 107 ELSE 108 tra(2,jj,jk,jn)=(alpha4*tra(1,jj,jk,jn)+alpha3*tra(3,jj,jk,jn))*tmask(2,jj,jk) 109 IF (un(2,jj,jk).LT.0.) THEN 110 tra(2,jj,jk,jn)=(alpha6*tra(3,jj,jk,jn)+alpha5*tra(1,jj,jk,jn) & 111 +alpha7*tra(4,jj,jk,jn))*tmask(2,jj,jk) 112 ENDIF 113 ENDIF 114 END DO 115 END DO 116 END DO 117 ENDIF 118 119 IF ((nbondj == -1).OR.(nbondj == 2)) THEN 120 tra(:,1,:,:) = alpha1 * ztra(:,1,:,:) + alpha2 * ztra(:,2,:,:) 121 DO jn=1, jptra 122 DO jk=1,jpk 123 DO ji=1,jpi 124 IF (vmask(ji,2,jk).EQ.0.) THEN 125 tra(ji,2,jk,jn)=tra(ji,1,jk,jn) * tmask(ji,2,jk) 126 ELSE 127 tra(ji,2,jk,jn)=(alpha4*tra(ji,1,jk,jn)+alpha3*tra(ji,3,jk,jn))*tmask(ji,2,jk) 128 IF (vn(ji,2,jk) .LT. 0.) THEN 129 tra(ji,2,jk,jn)=(alpha6*tra(ji,3,jk,jn)+alpha5*tra(ji,1,jk,jn)& 130 +alpha7*tra(ji,4,jk,jn))*tmask(ji,2,jk) 131 ENDIF 132 ENDIF 133 END DO 134 END DO 135 END DO 136 ENDIF 137 135 ! 138 136 CALL wrk_dealloc( jpi, jpj, jpk, jptra, ztra ) 137 ! 139 138 140 139 END SUBROUTINE Agrif_trc -
branches/2012/dev_r3387_LOCEAN6_AGRIF_LIM/NEMOGCM/NEMO/NST_SRC/agrif_top_sponge.F90
r3294 r3566 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 -
branches/2012/dev_r3387_LOCEAN6_AGRIF_LIM/NEMOGCM/NEMO/NST_SRC/agrif_top_update.F90
r3294 r3566 38 38 39 39 #if defined TWO_WAY 40 CALL wrk_alloc( jpi, jpj, jpk, jpt s, ztra )40 CALL wrk_alloc( jpi, jpj, jpk, jptra, ztra ) 41 41 42 42 Agrif_UseSpecialValueInUpdate = .TRUE. … … 52 52 nbcline_trc = nbcline_trc + 1 53 53 54 CALL wrk_dealloc( jpi, jpj, jpk, jpt s, ztra )54 CALL wrk_dealloc( jpi, jpj, jpk, jptra, ztra ) 55 55 #endif 56 56 57 57 END SUBROUTINE Agrif_Update_Trc 58 58 59 SUBROUTINE updateTRC(tabres,i1,i2,j1,j2,k1,k2, l1,l2,before)59 SUBROUTINE updateTRC(tabres,i1,i2,j1,j2,k1,k2,n1,n2,before) 60 60 !!--------------------------------------------- 61 61 !! *** ROUTINE UpdateTrc *** 62 62 !!--------------------------------------------- 63 # include "domzgr_substitute.h90" 64 65 INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,l1,l2 66 REAL, DIMENSION(i1:i2,j1:j2,k1:k2,l1:l2), INTENT(inout) :: tabres 63 INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n2 64 REAL, DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres 67 65 LOGICAL, INTENT(in) :: before 68 66 69 INTEGER :: ji,jj,jk,j l67 INTEGER :: ji,jj,jk,jn 70 68 71 IF (before) THEN72 DO j l=l1,l273 DO jk =k1,k274 DO jj =j1,j275 DO ji =i1,i276 tabres(ji,jj,jk,j l) = trn(ji,jj,jk,jl)69 IF( before ) THEN 70 DO jn = n1, n2 71 DO jk = k1, k2 72 DO jj = j1, j2 73 DO ji = i1, i2 74 tabres(ji,jj,jk,jn) = trn(ji,jj,jk,jn) 77 75 ENDDO 78 76 ENDDO … … 80 78 ENDDO 81 79 ELSE 82 DO j l=l1,l283 DO jk =k1,k284 DO jj =j1,j285 DO ji =i1,i286 IF (tabres(ji,jj,jk,jl).NE.0.) THEN87 trn(ji,jj,jk,j l) = tabres(ji,jj,jk,jl) * tmask(ji,jj,jk)80 DO jn = n1, n2 81 DO jk = k1, k2 82 DO jj = j1, j2 83 DO ji = i1, i2 84 IF( tabres(ji,jj,jk,jn) .NE. 0. ) THEN 85 trn(ji,jj,jk,jn) = tabres(ji,jj,jk,jn) * tmask(ji,jj,jk) 88 86 ENDIF 89 87 ENDDO -
branches/2012/dev_r3387_LOCEAN6_AGRIF_LIM/NEMOGCM/NEMO/NST_SRC/agrif_user.F90
r3454 r3566 434 434 USE dom_oce 435 435 USE nemogcm 436 USE par_trc 436 437 USE trc 437 438 USE in_out_manager … … 457 458 Agrif_SpecialValue=0. 458 459 Agrif_UseSpecialValue = .TRUE. 459 Call Agrif_Bc_variable(tabtrtemp,trn_id,calledweight=1. )460 Call Agrif_Bc_variable(tabtrtemp,trn_id,calledweight=1.,procname=interptrn) 460 461 Call Agrif_Bc_variable(tabtrtemp,tra_id,calledweight=1.,procname=interptrn) 461 462 Agrif_UseSpecialValue = .FALSE. … … 515 516 ENDIF 516 517 517 CALL Agrif_Update_trc(0)518 !ch CALL Agrif_Update_trc(0) 518 519 nbcline_trc = 0 519 520 !
Note: See TracChangeset
for help on using the changeset viewer.
