- Timestamp:
- 2015-11-20T10:58:48+01:00 (8 years ago)
- Location:
- branches/2015/dev_r5847_MERCATOR9_solveur_simplification/NEMOGCM/NEMO
- Files:
-
- 1 deleted
- 32 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2015/dev_r5847_MERCATOR9_solveur_simplification/NEMOGCM/NEMO/NST_SRC/agrif_opa_interp.F90
r5868 r5902 28 28 USE lib_mpp 29 29 USE wrk_nemo 30 USE dynspg_oce31 30 USE zdf_oce 32 31 … … 79 78 !! 80 79 INTEGER :: ji,jj,jk, j1,j2, i1,i2 81 REAL(wp) :: timeref 82 REAL(wp) :: z2dt, znugdt 83 REAL(wp) :: zrhox, zrhoy 84 REAL(wp), POINTER, DIMENSION(:,:) :: spgv1, spgu1 80 REAL(wp), POINTER, DIMENSION(:,:) :: zub, zvb 85 81 !!---------------------------------------------------------------------- 86 82 87 83 IF( Agrif_Root() ) RETURN 88 84 89 CALL wrk_alloc( jpi, jpj, spgv1, spgu1)85 CALL wrk_alloc( jpi, jpj, zub, zvb ) 90 86 91 87 Agrif_SpecialValue=0. … … 96 92 97 93 Agrif_UseSpecialValue = .FALSE. 98 99 zrhox = Agrif_Rhox() 100 zrhoy = Agrif_Rhoy() 101 102 timeref = 1. 103 ! time step: leap-frog 104 z2dt = 2. * rdt 105 ! time step: Euler if restart from rest 106 IF( neuler == 0 .AND. kt == nit000 ) z2dt = rdt 107 ! coefficients 108 znugdt = grav * z2dt 109 94 110 95 ! prevent smoothing in ghost cells 111 96 i1=1 … … 120 105 121 106 IF((nbondi == -1).OR.(nbondi == 2)) THEN 122 spgu(2,:) = ua_b(2,:) 123 124 DO jk=1,jpkm1 107 108 ! Smoothing 109 ! --------- 110 IF ( .NOT.ln_dynspg_ts ) THEN ! Store transport 111 ua_b(2,:)=0._wp 112 DO jk=1,jpkm1 113 DO jj=1,jpj 114 ua_b(2,jj) = ua_b(2,jj) + fse3u_a(2,jj,jk) * ua(2,jj,jk) 115 END DO 116 END DO 117 DO jj=1,jpj 118 ua_b(2,jj) = ua_b(2,jj) * hur_a(2,jj) 119 END DO 120 ENDIF 121 122 DO jk=1,jpkm1 ! Smooth 125 123 DO jj=j1,j2 126 ua(2,jj,jk) = 0.25 *(ua(1,jj,jk)+2.*ua(2,jj,jk)+ua(3,jj,jk))124 ua(2,jj,jk) = 0.25_wp*(ua(1,jj,jk)+2._wp*ua(2,jj,jk)+ua(3,jj,jk)) 127 125 ua(2,jj,jk) = ua(2,jj,jk) * umask(2,jj,jk) 128 126 END DO 129 127 END DO 130 128 131 spgu1(2,:)=0. 132 129 zub(2,:)=0._wp ! Correct transport 133 130 DO jk=1,jpkm1 134 131 DO jj=1,jpj 135 spgu1(2,jj)=spgu1(2,jj)+fse3u(2,jj,jk)*ua(2,jj,jk) 136 END DO 137 END DO 138 132 zub(2,jj) = zub(2,jj) + fse3u_a(2,jj,jk) * ua(2,jj,jk) 133 END DO 134 END DO 139 135 DO jj=1,jpj 140 IF (umask(2,jj,1).NE.0.) THEN 141 spgu1(2,jj)=spgu1(2,jj)/hu(2,jj) 142 ENDIF 143 END DO 144 145 DO jk=1,jpkm1 136 zub(2,jj) = zub(2,jj) * hur_a(2,jj) 137 END DO 138 139 DO jk=1,jpkm1 140 DO jj=1,jpj 141 ua(2,jj,jk) = (ua(2,jj,jk)+ua_b(2,jj)-zub(2,jj))*umask(2,jj,jk) 142 END DO 143 END DO 144 145 ! Set tangential velocities to time splitting estimate 146 !----------------------------------------------------- 147 IF ( ln_dynspg_ts) THEN 148 zvb(2,:)=0._wp 149 DO jk=1,jpkm1 150 DO jj=1,jpj 151 zvb(2,jj) = zvb(2,jj) + fse3v_a(2,jj,jk) * va(2,jj,jk) 152 END DO 153 END DO 154 DO jj=1,jpj 155 zvb(2,jj) = zvb(2,jj) * hvr_a(2,jj) 156 END DO 157 DO jk=1,jpkm1 158 DO jj=1,jpj 159 va(2,jj,jk) = (va(2,jj,jk)+va_b(2,jj)-zvb(2,jj))*vmask(2,jj,jk) 160 END DO 161 END DO 162 ENDIF 163 164 ! Mask domain edges: 165 !------------------- 166 DO jk=1,jpkm1 167 DO jj=1,jpj 168 ua(1,jj,jk) = 0._wp 169 va(1,jj,jk) = 0._wp 170 END DO 171 END DO 172 173 ENDIF 174 175 IF((nbondi == 1).OR.(nbondi == 2)) THEN 176 177 ! Smoothing 178 ! --------- 179 IF ( .NOT.ln_dynspg_ts ) THEN ! Store transport 180 ua_b(nlci-2,:)=0._wp 181 DO jk=1,jpkm1 182 DO jj=1,jpj 183 ua_b(nlci-2,jj) = ua_b(nlci-2,jj) + fse3u_a(nlci-2,jj,jk) * ua(nlci-2,jj,jk) 184 END DO 185 END DO 186 DO jj=1,jpj 187 ua_b(nlci-2,jj) = ua_b(nlci-2,jj) * hur_a(nlci-2,jj) 188 END DO 189 ENDIF 190 191 DO jk=1,jpkm1 ! Smooth 146 192 DO jj=j1,j2 147 ua(2,jj,jk) = (ua(2,jj,jk)+spgu(2,jj)-spgu1(2,jj))*umask(2,jj,jk) 148 END DO 149 END DO 150 151 #if defined key_dynspg_ts 193 ua(nlci-2,jj,jk) = 0.25_wp*(ua(nlci-3,jj,jk)+2._wp*ua(nlci-2,jj,jk)+ua(nlci-1,jj,jk)) 194 ua(nlci-2,jj,jk) = ua(nlci-2,jj,jk) * umask(nlci-2,jj,jk) 195 END DO 196 END DO 197 198 zub(nlci-2,:)=0._wp ! Correct transport 199 DO jk=1,jpkm1 200 DO jj=1,jpj 201 zub(nlci-2,jj) = zub(nlci-2,jj) + fse3u_a(nlci-2,jj,jk) * ua(nlci-2,jj,jk) 202 END DO 203 END DO 204 DO jj=1,jpj 205 zub(nlci-2,jj) = zub(nlci-2,jj) * hur_a(nlci-2,jj) 206 END DO 207 208 DO jk=1,jpkm1 209 DO jj=1,jpj 210 ua(nlci-2,jj,jk) = (ua(nlci-2,jj,jk)+ua_b(nlci-2,jj)-zub(nlci-2,jj))*umask(nlci-2,jj,jk) 211 END DO 212 END DO 213 152 214 ! Set tangential velocities to time splitting estimate 153 spgv1(2,:)=0. 154 DO jk=1,jpkm1 215 !----------------------------------------------------- 216 IF ( ln_dynspg_ts) THEN 217 zvb(nlci-1,:)=0._wp 218 DO jk=1,jpkm1 219 DO jj=1,jpj 220 zvb(nlci-1,jj) = zvb(nlci-1,jj) + fse3v_a(nlci-1,jj,jk) * va(nlci-1,jj,jk) 221 END DO 222 END DO 155 223 DO jj=1,jpj 156 spgv1(2,jj)=spgv1(2,jj)+fse3v_a(2,jj,jk)*va(2,jj,jk) 157 END DO 158 END DO 159 DO jj=1,jpj 160 spgv1(2,jj)=spgv1(2,jj)*hvr_a(2,jj) 161 END DO 224 zvb(nlci-1,jj) = zvb(nlci-1,jj) * hvr_a(nlci-1,jj) 225 END DO 226 DO jk=1,jpkm1 227 DO jj=1,jpj 228 va(nlci-1,jj,jk) = (va(nlci-1,jj,jk)+va_b(nlci-1,jj)-zvb(nlci-1,jj))*vmask(nlci-1,jj,jk) 229 END DO 230 END DO 231 ENDIF 232 233 ! Mask domain edges: 234 !------------------- 162 235 DO jk=1,jpkm1 163 236 DO jj=1,jpj 164 va(2,jj,jk) = (va(2,jj,jk)+va_b(2,jj)-spgv1(2,jj))*vmask(2,jj,jk) 165 END DO 166 END DO 167 #endif 168 169 ENDIF 170 171 IF((nbondi == 1).OR.(nbondi == 2)) THEN 172 spgu(nlci-2,:) = ua_b(nlci-2,:) 173 174 DO jk=1,jpkm1 175 DO jj=j1,j2 176 ua(nlci-2,jj,jk) = 0.25*(ua(nlci-3,jj,jk)+2.*ua(nlci-2,jj,jk)+ua(nlci-1,jj,jk)) 177 178 ua(nlci-2,jj,jk) = ua(nlci-2,jj,jk) * umask(nlci-2,jj,jk) 179 180 END DO 181 END DO 182 spgu1(nlci-2,:)=0. 183 DO jk=1,jpkm1 184 DO jj=1,jpj 185 spgu1(nlci-2,jj)=spgu1(nlci-2,jj)+fse3u(nlci-2,jj,jk)*ua(nlci-2,jj,jk)*umask(nlci-2,jj,jk) 186 END DO 187 END DO 188 DO jj=1,jpj 189 IF (umask(nlci-2,jj,1).NE.0.) THEN 190 spgu1(nlci-2,jj)=spgu1(nlci-2,jj)/hu(nlci-2,jj) 191 ENDIF 192 END DO 193 DO jk=1,jpkm1 194 DO jj=j1,j2 195 ua(nlci-2,jj,jk) = (ua(nlci-2,jj,jk)+spgu(nlci-2,jj)-spgu1(nlci-2,jj))*umask(nlci-2,jj,jk) 196 END DO 197 END DO 198 199 #if defined key_dynspg_ts 237 ua(nlci-1,jj,jk) = 0._wp 238 va(nlci ,jj,jk) = 0._wp 239 END DO 240 END DO 241 242 ENDIF 243 244 IF((nbondj == -1).OR.(nbondj == 2)) THEN 245 246 ! Smoothing 247 ! --------- 248 IF ( .NOT.ln_dynspg_ts ) THEN ! Store transport 249 va_b(:,2)=0._wp 250 DO jk=1,jpkm1 251 DO ji=1,jpi 252 va_b(ji,2) = va_b(ji,2) + fse3v_a(ji,2,jk) * va(ji,2,jk) 253 END DO 254 END DO 255 DO ji=1,jpi 256 va_b(ji,2) = va_b(ji,2) * hvr_a(ji,2) 257 END DO 258 ENDIF 259 260 DO jk=1,jpkm1 ! Smooth 261 DO ji=i1,i2 262 va(ji,2,jk)=0.25_wp*(va(ji,1,jk)+2._wp*va(ji,2,jk)+va(ji,3,jk)) 263 va(ji,2,jk)=va(ji,2,jk)*vmask(ji,2,jk) 264 END DO 265 END DO 266 267 zvb(:,2)=0._wp ! Correct transport 268 DO jk=1,jpkm1 269 DO ji=1,jpi 270 zvb(ji,2) = zvb(ji,2) + fse3v_a(ji,2,jk) * va(ji,2,jk) * vmask(ji,2,jk) 271 END DO 272 END DO 273 DO ji=1,jpi 274 zvb(ji,2) = zvb(ji,2) * hvr_a(ji,2) 275 END DO 276 DO jk=1,jpkm1 277 DO ji=1,jpi 278 va(ji,2,jk) = (va(ji,2,jk)+va_b(ji,2)-zvb(ji,2))*vmask(ji,2,jk) 279 END DO 280 END DO 281 200 282 ! Set tangential velocities to time splitting estimate 201 spgv1(nlci-1,:)=0._wp 202 DO jk=1,jpkm1 203 DO jj=1,jpj 204 spgv1(nlci-1,jj)=spgv1(nlci-1,jj)+fse3v_a(nlci-1,jj,jk)*va(nlci-1,jj,jk)*vmask(nlci-1,jj,jk) 205 END DO 206 END DO 207 208 DO jj=1,jpj 209 spgv1(nlci-1,jj)=spgv1(nlci-1,jj)*hvr_a(nlci-1,jj) 210 END DO 211 212 DO jk=1,jpkm1 213 DO jj=1,jpj 214 va(nlci-1,jj,jk) = (va(nlci-1,jj,jk)+va_b(nlci-1,jj)-spgv1(nlci-1,jj))*vmask(nlci-1,jj,jk) 215 END DO 216 END DO 217 #endif 218 219 ENDIF 220 221 IF((nbondj == -1).OR.(nbondj == 2)) THEN 222 spgv(:,2)=va_b(:,2) 223 224 DO jk=1,jpkm1 283 !----------------------------------------------------- 284 IF ( ln_dynspg_ts ) THEN 285 zub(:,2)=0._wp 286 DO jk=1,jpkm1 287 DO ji=1,jpi 288 zub(ji,2) = zub(ji,2) + fse3u_a(ji,2,jk) * ua(ji,2,jk) * umask(ji,2,jk) 289 END DO 290 END DO 291 DO ji=1,jpi 292 zub(ji,2) = zub(ji,2) * hur_a(ji,2) 293 END DO 294 295 DO jk=1,jpkm1 296 DO ji=1,jpi 297 ua(ji,2,jk) = (ua(ji,2,jk)+ua_b(ji,2)-zub(ji,2))*umask(ji,2,jk) 298 END DO 299 END DO 300 ENDIF 301 302 ! Mask domain edges: 303 !------------------- 304 DO jk=1,jpkm1 305 DO ji=1,jpi 306 ua(ji,1,jk) = 0._wp 307 va(ji,1,jk) = 0._wp 308 END DO 309 END DO 310 311 ENDIF 312 313 IF((nbondj == 1).OR.(nbondj == 2)) THEN 314 ! Smoothing 315 ! --------- 316 IF ( .NOT.ln_dynspg_ts ) THEN ! Store transport 317 va_b(:,nlcj-2)=0._wp 318 DO jk=1,jpkm1 319 DO ji=1,jpi 320 va_b(ji,nlcj-2) = va_b(ji,nlcj-2) + fse3v_a(ji,nlcj-2,jk) * va(ji,nlcj-2,jk) 321 END DO 322 END DO 323 DO ji=1,jpi 324 va_b(ji,nlcj-2) = va_b(ji,nlcj-2) * hvr_a(ji,nlcj-2) 325 END DO 326 ENDIF 327 328 DO jk=1,jpkm1 ! Smooth 225 329 DO ji=i1,i2 226 va(ji,2,jk)=0.25*(va(ji,1,jk)+2.*va(ji,2,jk)+va(ji,3,jk)) 227 va(ji,2,jk)=va(ji,2,jk)*vmask(ji,2,jk) 228 END DO 229 END DO 230 231 spgv1(:,2)=0. 232 330 va(ji,nlcj-2,jk)=0.25_wp*(va(ji,nlcj-3,jk)+2._wp*va(ji,nlcj-2,jk)+va(ji,nlcj-1,jk)) 331 va(ji,nlcj-2,jk)=va(ji,nlcj-2,jk)*vmask(ji,nlcj-2,jk) 332 END DO 333 END DO 334 335 zvb(:,nlcj-2)=0._wp ! Correct transport 233 336 DO jk=1,jpkm1 234 337 DO ji=1,jpi 235 spgv1(ji,2)=spgv1(ji,2)+fse3v(ji,2,jk)*va(ji,2,jk)*vmask(ji,2,jk) 236 END DO 237 END DO 238 338 zvb(ji,nlcj-2) = zvb(ji,nlcj-2) + fse3v_a(ji,nlcj-2,jk) * va(ji,nlcj-2,jk) * vmask(ji,nlcj-2,jk) 339 END DO 340 END DO 239 341 DO ji=1,jpi 240 IF (vmask(ji,2,1).NE.0.) THEN 241 spgv1(ji,2)=spgv1(ji,2)/hv(ji,2) 242 ENDIF 243 END DO 244 342 zvb(ji,nlcj-2) = zvb(ji,nlcj-2) * hvr_a(ji,nlcj-2) 343 END DO 245 344 DO jk=1,jpkm1 246 345 DO ji=1,jpi 247 va(ji,2,jk) = (va(ji,2,jk)+spgv(ji,2)-spgv1(ji,2))*vmask(ji,2,jk) 248 END DO 249 END DO 250 251 #if defined key_dynspg_ts 346 va(ji,nlcj-2,jk) = (va(ji,nlcj-2,jk)+va_b(ji,nlcj-2)-zvb(ji,nlcj-2))*vmask(ji,nlcj-2,jk) 347 END DO 348 END DO 349 252 350 ! Set tangential velocities to time splitting estimate 253 spgu1(:,2)=0._wp 254 DO jk=1,jpkm1 351 !----------------------------------------------------- 352 IF ( ln_dynspg_ts ) THEN 353 zub(:,nlcj-1)=0._wp 354 DO jk=1,jpkm1 355 DO ji=1,jpi 356 zub(ji,nlcj-1) = zub(ji,nlcj-1) + fse3u_a(ji,nlcj-1,jk) * ua(ji,nlcj-1,jk) * umask(ji,nlcj-1,jk) 357 END DO 358 END DO 255 359 DO ji=1,jpi 256 spgu1(ji,2)=spgu1(ji,2)+fse3u_a(ji,2,jk)*ua(ji,2,jk)*umask(ji,2,jk) 257 END DO 258 END DO 259 260 DO ji=1,jpi 261 spgu1(ji,2)=spgu1(ji,2)*hur_a(ji,2) 262 END DO 263 360 zub(ji,nlcj-1) = zub(ji,nlcj-1) * hur_a(ji,nlcj-1) 361 END DO 362 363 DO jk=1,jpkm1 364 DO ji=1,jpi 365 ua(ji,nlcj-1,jk) = (ua(ji,nlcj-1,jk)+ua_b(ji,nlcj-1)-zub(ji,nlcj-1))*umask(ji,nlcj-1,jk) 366 END DO 367 END DO 368 ENDIF 369 370 ! Mask domain edges: 371 !------------------- 264 372 DO jk=1,jpkm1 265 373 DO ji=1,jpi 266 ua(ji,2,jk) = (ua(ji,2,jk)+ua_b(ji,2)-spgu1(ji,2))*umask(ji,2,jk) 267 END DO 268 END DO 269 #endif 270 ENDIF 271 272 IF((nbondj == 1).OR.(nbondj == 2)) THEN 273 274 spgv(:,nlcj-2)=va_b(:,nlcj-2) 275 276 DO jk=1,jpkm1 277 DO ji=i1,i2 278 va(ji,nlcj-2,jk)=0.25*(va(ji,nlcj-3,jk)+2.*va(ji,nlcj-2,jk)+va(ji,nlcj-1,jk)) 279 va(ji,nlcj-2,jk) = va(ji,nlcj-2,jk) * vmask(ji,nlcj-2,jk) 280 END DO 281 END DO 282 283 spgv1(:,nlcj-2)=0. 284 285 DO jk=1,jpkm1 286 DO ji=1,jpi 287 spgv1(ji,nlcj-2)=spgv1(ji,nlcj-2)+fse3v(ji,nlcj-2,jk)*va(ji,nlcj-2,jk) 288 END DO 289 END DO 290 291 DO ji=1,jpi 292 IF (vmask(ji,nlcj-2,1).NE.0.) THEN 293 spgv1(ji,nlcj-2)=spgv1(ji,nlcj-2)/hv(ji,nlcj-2) 294 ENDIF 295 END DO 296 297 DO jk=1,jpkm1 298 DO ji=1,jpi 299 va(ji,nlcj-2,jk) = (va(ji,nlcj-2,jk)+spgv(ji,nlcj-2)-spgv1(ji,nlcj-2))*vmask(ji,nlcj-2,jk) 300 END DO 301 END DO 302 303 #if defined key_dynspg_ts 304 ! Set tangential velocities to time splitting estimate 305 spgu1(:,nlcj-1)=0._wp 306 DO jk=1,jpkm1 307 DO ji=1,jpi 308 spgu1(ji,nlcj-1)=spgu1(ji,nlcj-1)+fse3u_a(ji,nlcj-1,jk)*ua(ji,nlcj-1,jk) 309 END DO 310 END DO 311 312 DO ji=1,jpi 313 spgu1(ji,nlcj-1)=spgu1(ji,nlcj-1)*hur_a(ji,nlcj-1) 314 END DO 315 316 DO jk=1,jpkm1 317 DO ji=1,jpi 318 ua(ji,nlcj-1,jk) = (ua(ji,nlcj-1,jk)+ua_b(ji,nlcj-1)-spgu1(ji,nlcj-1))*umask(ji,nlcj-1,jk) 319 END DO 320 END DO 321 #endif 322 323 ENDIF 324 ! 325 CALL wrk_dealloc( jpi, jpj, spgv1, spgu1 ) 374 ua(ji,nlcj ,jk) = 0._wp 375 va(ji,nlcj-1,jk) = 0._wp 376 END DO 377 END DO 378 379 ENDIF 380 ! 381 CALL wrk_dealloc( jpi, jpj, zub, zvb ) 326 382 ! 327 383 END SUBROUTINE Agrif_dyn … … 594 650 END DO 595 651 END DO 652 tsa(nlci,j1:j2,k1:k2,jn) = 0._wp 596 653 ENDDO 597 654 ENDIF … … 613 670 END DO 614 671 END DO 672 tsa(i1:i2,nlcj,k1:k2,jn) = 0._wp 615 673 ENDDO 616 674 ENDIF … … 631 689 END DO 632 690 END DO 691 tsa(1,j1:j2,k1:k2,jn) = 0._wp 633 692 END DO 634 693 ENDIF … … 649 708 END DO 650 709 END DO 710 tsa(i1:i2,1,k1:k2,jn) = 0._wp 651 711 ENDDO 652 712 ENDIF -
branches/2015/dev_r5847_MERCATOR9_solveur_simplification/NEMOGCM/NEMO/NST_SRC/agrif_opa_update.F90
r5656 r5902 11 11 USE lib_mpp 12 12 USE wrk_nemo 13 USE dynspg_oce14 13 USE zdf_oce ! vertical physics: ocean variables 15 14 … … 107 106 # endif 108 107 109 # if defined key_dynspg_ts 110 IF (ln_bt_fw) THEN 108 IF ( ln_dynspg_ts.AND.ln_bt_fw ) THEN 111 109 ! Update time integrated transports 112 110 IF (mod(nbcline,nbclineupdate) == 0) THEN … … 128 126 ENDIF 129 127 END IF 130 # endif131 128 ! 132 129 nbcline = nbcline + 1 … … 360 357 ! 361 358 ! Update barotropic velocities: 362 #if defined key_dynspg_ts 363 IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN ! Add asselin part364 zcorr = tabres(ji,jj) - un_b(ji,jj)365 ub_b(ji,jj) = ub_b(ji,jj) + atfp * zcorr * umask(ji,jj,1)366 END IF367 #endif359 IF ( .NOT.ln_dynspg_ts .OR. (ln_dynspg_ts.AND.(.NOT.ln_bt_fw)) ) THEN 360 IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN ! Add asselin part 361 zcorr = tabres(ji,jj) - un_b(ji,jj) 362 ub_b(ji,jj) = ub_b(ji,jj) + atfp * zcorr * umask(ji,jj,1) 363 END IF 364 ENDIF 368 365 un_b(ji,jj) = tabres(ji,jj) * umask(ji,jj,1) 369 366 ! … … 425 422 ! 426 423 ! Update barotropic velocities: 427 #if defined key_dynspg_ts 428 IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN ! Add asselin part429 zcorr = tabres(ji,jj) - vn_b(ji,jj)430 vb_b(ji,jj) = vb_b(ji,jj) + atfp * zcorr * vmask(ji,jj,1)431 END IF432 #endif424 IF ( .NOT.ln_dynspg_ts .OR. (ln_dynspg_ts.AND.(.NOT.ln_bt_fw)) ) THEN 425 IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN ! Add asselin part 426 zcorr = tabres(ji,jj) - vn_b(ji,jj) 427 vb_b(ji,jj) = vb_b(ji,jj) + atfp * zcorr * vmask(ji,jj,1) 428 END IF 429 ENDIF 433 430 vn_b(ji,jj) = tabres(ji,jj) * vmask(ji,jj,1) 434 431 ! … … 470 467 END DO 471 468 ELSE 472 #if ! defined key_dynspg_ts 473 IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN 474 DO jj=j1,j2 475 DO ji=i1,i2 476 sshb(ji,jj) = sshb(ji,jj) & 477 & + atfp * ( tabres(ji,jj) - sshn(ji,jj) ) * tmask(ji,jj,1) 478 END DO 479 END DO 469 IF ( .NOT.ln_dynspg_ts .OR. (ln_dynspg_ts.AND.(.NOT.ln_bt_fw)) ) THEN 470 IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN 471 DO jj=j1,j2 472 DO ji=i1,i2 473 sshb(ji,jj) = sshb(ji,jj) & 474 & + atfp * ( tabres(ji,jj) - sshn(ji,jj) ) * tmask(ji,jj,1) 475 END DO 476 END DO 477 ENDIF 480 478 ENDIF 481 #endif 479 482 480 DO jj=j1,j2 483 481 DO ji=i1,i2 -
branches/2015/dev_r5847_MERCATOR9_solveur_simplification/NEMOGCM/NEMO/NST_SRC/agrif_user.F90
r5868 r5902 208 208 CALL Agrif_Bc_variable(vn_sponge_id,calledweight=1.,procname=interpvn_sponge) 209 209 210 #if defined key_dynspg_ts211 210 Agrif_UseSpecialValue = .TRUE. 212 211 CALL Agrif_Bc_variable(sshn_id,calledweight=1., procname=interpsshn ) 213 212 214 Agrif_UseSpecialValue = ln_spc_dyn 215 CALL Agrif_Bc_variable(unb_id,calledweight=1.,procname=interpunb) 216 CALL Agrif_Bc_variable(vnb_id,calledweight=1.,procname=interpvnb) 217 CALL Agrif_Bc_variable(ub2b_interp_id,calledweight=1.,procname=interpub2b) 218 CALL Agrif_Bc_variable(vb2b_interp_id,calledweight=1.,procname=interpvb2b) 219 ubdy_w(:) = 0.e0 ; vbdy_w(:) = 0.e0 ; hbdy_w(:) =0.e0 220 ubdy_e(:) = 0.e0 ; vbdy_e(:) = 0.e0 ; hbdy_e(:) =0.e0 221 ubdy_n(:) = 0.e0 ; vbdy_n(:) = 0.e0 ; hbdy_n(:) =0.e0 222 ubdy_s(:) = 0.e0 ; vbdy_s(:) = 0.e0 ; hbdy_s(:) =0.e0 223 #endif 213 IF ( ln_dynspg_ts ) THEN 214 Agrif_UseSpecialValue = ln_spc_dyn 215 CALL Agrif_Bc_variable(unb_id,calledweight=1.,procname=interpunb) 216 CALL Agrif_Bc_variable(vnb_id,calledweight=1.,procname=interpvnb) 217 CALL Agrif_Bc_variable(ub2b_interp_id,calledweight=1.,procname=interpub2b) 218 CALL Agrif_Bc_variable(vb2b_interp_id,calledweight=1.,procname=interpvb2b) 219 ubdy_w(:) = 0.e0 ; vbdy_w(:) = 0.e0 ; hbdy_w(:) =0.e0 220 ubdy_e(:) = 0.e0 ; vbdy_e(:) = 0.e0 ; hbdy_e(:) =0.e0 221 ubdy_n(:) = 0.e0 ; vbdy_n(:) = 0.e0 ; hbdy_n(:) =0.e0 222 ubdy_s(:) = 0.e0 ; vbdy_s(:) = 0.e0 ; hbdy_s(:) =0.e0 223 ENDIF 224 224 225 225 Agrif_UseSpecialValue = .FALSE. … … 276 276 ENDIF 277 277 ENDIF 278 279 ! Check free surface scheme 280 IF ( ( Agrif_Parent(ln_dynspg_ts ).AND.ln_dynspg_exp ).OR.& 281 & ( Agrif_Parent(ln_dynspg_exp).AND.ln_dynspg_ts ) ) THEN 282 WRITE(*,*) 'incompatible free surface scheme between grids' 283 WRITE(*,*) 'parent grid ln_dynspg_ts :', Agrif_Parent(ln_dynspg_ts ) 284 WRITE(*,*) 'parent grid ln_dynspg_exp :', Agrif_Parent(ln_dynspg_exp) 285 WRITE(*,*) 'child grid ln_dynspg_ts :', ln_dynspg_ts 286 WRITE(*,*) 'child grid ln_dynspg_exp :', ln_dynspg_exp 287 WRITE(*,*) 'those logicals should be identical' 288 STOP 289 ENDIF 290 278 291 ! check if masks and bathymetries match 279 292 IF(ln_chk_bathy) THEN … … 317 330 ! 318 331 Agrif_UseSpecialValueInUpdate = .FALSE. 319 nbcline = 0 332 nbcline = 0 320 333 lk_agrif_doupd = .FALSE. 321 334 ! -
branches/2015/dev_r5847_MERCATOR9_solveur_simplification/NEMOGCM/NEMO/OFF_SRC/dtadyn.F90
r5836 r5902 107 107 USE oce, ONLY: zts => tsa 108 108 USE oce, ONLY: zuslp => ua , zvslp => va 109 USE oce, ONLY: zwslpi => ua_sv , zwslpj => va_sv109 USE zdf_oce, ONLY: zwslpi => avmu , zwslpj => avmv 110 110 USE oce, ONLY: zu => ub , zv => vb, zw => rke 111 111 ! -
branches/2015/dev_r5847_MERCATOR9_solveur_simplification/NEMOGCM/NEMO/OPA_SRC/BDY/bdydta.F90
r5132 r5902 29 29 USE iom ! IOM library 30 30 USE in_out_manager ! I/O logical units 31 USE dynspg_oce, ONLY: lk_dynspg_ts ! Split-explicit free surface flag32 31 #if defined key_lim2 33 32 USE ice_2 … … 391 390 #if defined key_tide 392 391 ! Add tides if not split-explicit free surface else this is done in ts loop 393 IF (.NOT.l k_dynspg_ts) CALL bdy_dta_tides( kt=kt, time_offset=time_offset )392 IF (.NOT.ln_dynspg_ts) CALL bdy_dta_tides( kt=kt, time_offset=time_offset ) 394 393 #endif 395 394 ! end jchanut tschanges … … 423 422 !! 424 423 !!---------------------------------------------------------------------- 425 USE dynspg_oce, ONLY: lk_dynspg_ts426 424 !! 427 425 INTEGER :: ib_bdy, jfld, jstart, jend, ierror ! local indices -
branches/2015/dev_r5847_MERCATOR9_solveur_simplification/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn.F90
r5868 r5902 24 24 USE oce ! ocean dynamics and tracers 25 25 USE dom_oce ! ocean space and time domain 26 USE dynspg_oce27 26 USE bdy_oce ! ocean open boundary conditions 28 27 USE bdydyn2d ! open boundary conditions for barotropic solution -
branches/2015/dev_r5847_MERCATOR9_solveur_simplification/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn2d.F90
r5215 r5902 23 23 USE bdy_oce ! ocean open boundary conditions 24 24 USE bdylib ! BDY library routines 25 USE dynspg_oce ! for barotropic variables26 25 USE phycst ! physical constants 27 26 USE lbclnk ! ocean lateral boundary conditions (or mpp link) -
branches/2015/dev_r5847_MERCATOR9_solveur_simplification/NEMOGCM/NEMO/OPA_SRC/BDY/bdytides.F90
r5132 r5902 33 33 ! USE tide_mod ! Useless ?? 34 34 USE fldread 35 USE dynspg_oce, ONLY: lk_dynspg_ts36 35 37 36 IMPLICIT NONE … … 270 269 ENDIF 271 270 ! 272 IF ( l k_dynspg_ts ) THEN ! Allocate arrays to save slowly varying boundary data during271 IF ( ln_dynspg_ts ) THEN ! Allocate arrays to save slowly varying boundary data during 273 272 ! time splitting integration 274 273 ALLOCATE( dta_bdy_s(ib_bdy)%ssh ( ilen0(1) ) ) -
branches/2015/dev_r5847_MERCATOR9_solveur_simplification/NEMOGCM/NEMO/OPA_SRC/DIA/diaharm.F90
r5586 r5902 14 14 USE dom_oce ! ocean space and time domain 15 15 USE phycst 16 USE dynspg_oce17 USE dynspg_ts18 16 USE daymod 19 17 USE tide_mod -
branches/2015/dev_r5847_MERCATOR9_solveur_simplification/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90
r5868 r5902 45 45 USE iom 46 46 USE ioipsl 47 USE dynspg_oce, ONLY: un_adv, vn_adv ! barotropic velocities48 47 49 48 #if defined key_lim2 … … 205 204 CALL iom_put( "sbu", z2d ) ! bottom i-current 206 205 ENDIF 207 #if defined key_dynspg_ts 208 CALL iom_put( "ubar", un_adv(:,:) ) ! barotropic i-current 209 #else 210 CALL iom_put( "ubar", un_b(:,:) ) ! barotropic i-current 211 #endif 206 207 IF ( ln_dynspg_ts ) THEN 208 CALL iom_put( "ubar", un_adv(:,:) ) ! barotropic i-current 209 ELSE 210 CALL iom_put( "ubar", un_b(:,:) ) ! barotropic i-current 211 ENDIF 212 212 213 213 CALL iom_put( "voce", vn(:,:,:) ) ! 3D j-current … … 222 222 CALL iom_put( "sbv", z2d ) ! bottom j-current 223 223 ENDIF 224 #if defined key_dynspg_ts 225 CALL iom_put( "vbar", vn_adv(:,:) ) ! barotropic j-current 226 #else 227 CALL iom_put( "vbar", vn_b(:,:) ) ! barotropic j-current 228 #endif 224 225 IF ( ln_dynspg_ts ) THEN 226 CALL iom_put( "vbar", vn_adv(:,:) ) ! barotropic j-current 227 ELSE 228 CALL iom_put( "vbar", vn_b(:,:) ) ! barotropic j-current 229 ENDIF 229 230 230 231 CALL iom_put( "woce", wn ) ! vertical velocity -
branches/2015/dev_r5847_MERCATOR9_solveur_simplification/NEMOGCM/NEMO/OPA_SRC/DOM/dom_oce.F90
r5836 r5902 44 44 INTEGER , PUBLIC :: nn_euler !: =0 start with forward time step or not (=1) 45 45 LOGICAL , PUBLIC :: ln_crs !: Apply grid coarsening to dynamical model output or online passive tracers 46 47 !! Free surface parameters 48 !! ======================= 49 LOGICAL, PUBLIC :: ln_dynspg_exp !: Explicit free surface flag 50 LOGICAL, PUBLIC :: ln_dynspg_ts !: Split-Explicit free surface flag 46 51 47 52 !! Time splitting parameters -
branches/2015/dev_r5847_MERCATOR9_solveur_simplification/NEMOGCM/NEMO/OPA_SRC/DOM/dommsk.F90
r5836 r5902 28 28 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 29 29 USE lib_mpp 30 USE dynspg_oce ! choice/control of key cpp for surface pressure gradient31 30 USE wrk_nemo ! Memory allocation 32 31 USE timing ! Timing -
branches/2015/dev_r5847_MERCATOR9_solveur_simplification/NEMOGCM/NEMO/OPA_SRC/DYN/dynnxt.F90
r5868 r5902 19 19 !! 3.5 ! 2013-07 (J. Chanut) Compliant with time splitting changes 20 20 !! 3.7 ! 2014-04 (G. Madec) add the diagnostic of the time filter trends 21 !! 3.7 ! 2015-11 (J. Chanut) Free surface simplification 21 22 !!------------------------------------------------------------------------- 22 23 … … 28 29 USE sbc_oce ! Surface boundary condition: ocean fields 29 30 USE phycst ! physical constants 30 USE dynspg_oce ! type of surface pressure gradient31 31 USE dynadv ! dynamics: vector invariant versus flux form 32 32 USE domvvl ! variable volume … … 68 68 !! *** ROUTINE dyn_nxt *** 69 69 !! 70 !! ** Purpose : Compute the after horizontal velocity. Apply the boundary71 !! condition on the after velocity, achieve dthe time stepping70 !! ** Purpose : Finalize after horizontal velocity. Apply the boundary 71 !! condition on the after velocity, achieve the time stepping 72 72 !! by applying the Asselin filter on now fields and swapping 73 73 !! the fields. 74 74 !! 75 !! ** Method : * After velocity is compute using a leap-frog scheme: 76 !! (ua,va) = (ub,vb) + 2 rdt (ua,va) 77 !! Note that with flux form advection and variable volume layer 78 !! (lk_vvl=T), the leap-frog is applied on thickness weighted 79 !! velocity. 75 !! ** Method : * Ensure after velocities transport matches time splitting 76 !! estimate (ln_dynspg_ts=T) 80 77 !! 81 78 !! * Apply lateral boundary conditions on after velocity … … 99 96 INTEGER :: ji, jj, jk ! dummy loop indices 100 97 INTEGER :: iku, ikv ! local integers 101 REAL(wp) :: z2dt ! temporary scalar 102 REAL(wp) :: zue3a, zue3n, zue3b, zuf, zec ! local scalars 98 REAL(wp) :: zue3a, zue3n, zue3b, zuf ! local scalars 103 99 REAL(wp) :: zve3a, zve3n, zve3b, zvf, z1_2dt ! - - 104 100 REAL(wp), POINTER, DIMENSION(:,:) :: zue, zve … … 108 104 IF( nn_timing == 1 ) CALL timing_start('dyn_nxt') 109 105 ! 110 CALL wrk_alloc( jpi,jpj,jpk, ze3u_f, ze3v_f, zua, zva ) 111 IF( lk_dynspg_ts ) CALL wrk_alloc( jpi,jpj, zue, zve ) 106 IF( ln_dynspg_ts ) CALL wrk_alloc( jpi,jpj, zue, zve ) 107 IF( lk_vvl.AND.(.NOT.ln_dynadv_vec ) ) CALL wrk_alloc( jpi,jpj,jpk, ze3u_f, ze3v_f ) 108 IF( l_trddyn ) CALL wrk_alloc( jpi,jpj,jpk, zua, zva ) 112 109 ! 113 110 IF( kt == nit000 ) THEN … … 117 114 ENDIF 118 115 119 # if defined key_dynspg_exp 120 ! Next velocity : Leap-frog time stepping 121 ! ------------- 122 z2dt = 2. * rdt ! Euler or leap-frog time step 123 IF( neuler == 0 .AND. kt == nit000 ) z2dt = rdt 124 ! 125 IF( ln_dynadv_vec .OR. .NOT. lk_vvl ) THEN ! applied on velocity 116 IF ( ln_dynspg_ts ) THEN 117 ! Ensure below that barotropic velocities match time splitting estimate 118 ! Compute actual transport and replace it with ts estimate at "after" time step 119 zue(:,:) = fse3u_a(:,:,1) * ua(:,:,1) * umask(:,:,1) 120 zve(:,:) = fse3v_a(:,:,1) * va(:,:,1) * vmask(:,:,1) 121 DO jk = 2, jpkm1 122 zue(:,:) = zue(:,:) + fse3u_a(:,:,jk) * ua(:,:,jk) * umask(:,:,jk) 123 zve(:,:) = zve(:,:) + fse3v_a(:,:,jk) * va(:,:,jk) * vmask(:,:,jk) 124 END DO 126 125 DO jk = 1, jpkm1 127 ua(:,:,jk) = ( ub(:,:,jk) + z2dt * ua(:,:,jk) ) * umask(:,:,jk) 128 va(:,:,jk) = ( vb(:,:,jk) + z2dt * va(:,:,jk) ) * vmask(:,:,jk) 129 END DO 130 ELSE ! applied on thickness weighted velocity 131 DO jk = 1, jpkm1 132 ua(:,:,jk) = ( ub(:,:,jk) * fse3u_b(:,:,jk) & 133 & + z2dt * ua(:,:,jk) * fse3u_n(:,:,jk) ) & 134 & / fse3u_a(:,:,jk) * umask(:,:,jk) 135 va(:,:,jk) = ( vb(:,:,jk) * fse3v_b(:,:,jk) & 136 & + z2dt * va(:,:,jk) * fse3v_n(:,:,jk) ) & 137 & / fse3v_a(:,:,jk) * vmask(:,:,jk) 138 END DO 139 ENDIF 140 # endif 141 142 # if defined key_dynspg_ts 143 !!gm IF ( lk_dynspg_ts ) THEN .... 144 ! Ensure below that barotropic velocities match time splitting estimate 145 ! Compute actual transport and replace it with ts estimate at "after" time step 146 zue(:,:) = fse3u_a(:,:,1) * ua(:,:,1) * umask(:,:,1) 147 zve(:,:) = fse3v_a(:,:,1) * va(:,:,1) * vmask(:,:,1) 148 DO jk = 2, jpkm1 149 zue(:,:) = zue(:,:) + fse3u_a(:,:,jk) * ua(:,:,jk) * umask(:,:,jk) 150 zve(:,:) = zve(:,:) + fse3v_a(:,:,jk) * va(:,:,jk) * vmask(:,:,jk) 151 END DO 152 DO jk = 1, jpkm1 153 ua(:,:,jk) = ( ua(:,:,jk) - zue(:,:) * hur_a(:,:) + ua_b(:,:) ) * umask(:,:,jk) 154 va(:,:,jk) = ( va(:,:,jk) - zve(:,:) * hvr_a(:,:) + va_b(:,:) ) * vmask(:,:,jk) 155 END DO 156 157 IF (lk_dynspg_ts.AND.(.NOT.ln_bt_fw)) THEN 158 ! Remove advective velocity from "now velocities" 159 ! prior to asselin filtering 160 ! In the forward case, this is done below after asselin filtering 161 ! so that asselin contribution is removed at the same time 162 DO jk = 1, jpkm1 163 un(:,:,jk) = ( un(:,:,jk) - un_adv(:,:) + un_b(:,:) )*umask(:,:,jk) 164 vn(:,:,jk) = ( vn(:,:,jk) - vn_adv(:,:) + vn_b(:,:) )*vmask(:,:,jk) 165 END DO 166 ENDIF 167 !!gm ENDIF 168 # endif 126 ua(:,:,jk) = ( ua(:,:,jk) - zue(:,:) * hur_a(:,:) + ua_b(:,:) ) * umask(:,:,jk) 127 va(:,:,jk) = ( va(:,:,jk) - zve(:,:) * hvr_a(:,:) + va_b(:,:) ) * vmask(:,:,jk) 128 END DO 129 130 IF ( .NOT.ln_bt_fw ) THEN 131 ! Remove advective velocity from "now velocities" 132 ! prior to asselin filtering 133 ! In the forward case, this is done below after asselin filtering 134 ! so that asselin contribution is removed at the same time 135 DO jk = 1, jpkm1 136 un(:,:,jk) = ( un(:,:,jk) - un_adv(:,:) + un_b(:,:) )*umask(:,:,jk) 137 vn(:,:,jk) = ( vn(:,:,jk) - vn_adv(:,:) + vn_b(:,:) )*vmask(:,:,jk) 138 END DO 139 ENDIF 140 ENDIF 169 141 170 142 ! Update after velocity on domain lateral boundaries 171 143 ! -------------------------------------------------- 172 CALL lbc_lnk( ua, 'U', -1. ) !* local domain boundaries173 CALL lbc_lnk( va, 'V', -1. )174 !175 # if defined key_bdy176 ! !* BDY open boundaries177 IF( lk_bdy .AND. lk_dynspg_exp ) CALL bdy_dyn( kt )178 IF( lk_bdy .AND. lk_dynspg_ts ) CALL bdy_dyn( kt, dyn3d_only=.true. )179 180 !!$ Do we need a call to bdy_vol here??181 !182 # endif183 !184 144 # if defined key_agrif 185 145 CALL Agrif_dyn( kt ) !* AGRIF zoom boundaries 186 146 # endif 187 147 ! 148 CALL lbc_lnk( ua, 'U', -1. ) !* local domain boundaries 149 CALL lbc_lnk( va, 'V', -1. ) 150 ! 151 # if defined key_bdy 152 ! !* BDY open boundaries 153 IF( lk_bdy .AND. ln_dynspg_exp ) CALL bdy_dyn( kt ) 154 IF( lk_bdy .AND. ln_dynspg_ts ) CALL bdy_dyn( kt, dyn3d_only=.true. ) 155 156 !!$ Do we need a call to bdy_vol here?? 157 ! 158 # endif 159 ! 188 160 IF( l_trddyn ) THEN ! prepare the atf trend computation + some diagnostics 189 161 z1_2dt = 1._wp / (2. * rdt) ! Euler or leap-frog time step … … 242 214 ! (used as a now filtered scale factor until the swap) 243 215 ! ---------------------------------------------------- 244 IF (l k_dynspg_ts.AND.ln_bt_fw) THEN216 IF (ln_dynspg_ts.AND.ln_bt_fw) THEN 245 217 ! No asselin filtering on thicknesses if forward time splitting 246 218 fse3t_b(:,:,:) = fse3t_n(:,:,:) 247 219 ELSE 248 220 fse3t_b(:,:,:) = fse3t_n(:,:,:) + atfp * ( fse3t_b(:,:,:) - 2._wp * fse3t_n(:,:,:) + fse3t_a(:,:,:) ) … … 319 291 ENDIF 320 292 ! 321 IF (l k_dynspg_ts.AND.ln_bt_fw) THEN293 IF (ln_dynspg_ts.AND.ln_bt_fw) THEN 322 294 ! Revert "before" velocities to time split estimate 323 295 ! Doing it here also means that asselin filter contribution is removed … … 383 355 IF(ln_ctl) CALL prt_ctl( tab3d_1=un, clinfo1=' nxt - Un: ', mask1=umask, & 384 356 & tab3d_2=vn, clinfo2=' Vn: ' , mask2=vmask ) 385 ! 386 CALL wrk_dealloc( jpi,jpj,jpk, ze3u_f, ze3v_f, zua, zva ) 387 IF( lk_dynspg_ts ) CALL wrk_dealloc( jpi,jpj, zue, zve ) 357 ! 358 IF( ln_dynspg_ts ) CALL wrk_dealloc( jpi,jpj, zue, zve ) 359 IF( lk_vvl.AND.(.NOT.ln_dynadv_vec ) ) CALL wrk_dealloc( jpi,jpj,jpk, ze3u_f, ze3v_f ) 360 IF( l_trddyn ) CALL wrk_dealloc( jpi,jpj,jpk, zua, zva ) 388 361 ! 389 362 IF( nn_timing == 1 ) CALL timing_stop('dyn_nxt') -
branches/2015/dev_r5847_MERCATOR9_solveur_simplification/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg.F90
r5869 r5902 6 6 !! History : 1.0 ! 2005-12 (C. Talandier, G. Madec, V. Garnier) Original code 7 7 !! 3.2 ! 2009-07 (R. Benshila) Suppression of rigid-lid option 8 !!---------------------------------------------------------------------- 9 10 !!---------------------------------------------------------------------- 11 !! dyn_spg : update the dynamics trend with the lateral diffusion 12 !! dyn_spg_ctl : initialization, namelist read, and parameters control 8 !! 3.7 ! 2015-11 (J. Chanut) Suppression of filtered free surface 9 !!---------------------------------------------------------------------- 10 11 !!---------------------------------------------------------------------- 12 !! dyn_spg : update the dynamics trend with surface pressure gradient 13 !! dyn_spg_init: initialization, namelist read, and parameters control 13 14 !!---------------------------------------------------------------------- 14 15 USE oce ! ocean dynamics and tracers variables … … 18 19 USE sbc_oce ! surface boundary condition: ocean 19 20 USE sbcapr ! surface boundary condition: atmospheric pressure 20 USE dynspg_oce ! surface pressure gradient variables21 21 USE dynspg_exp ! surface pressure gradient (dyn_spg_exp routine) 22 22 USE dynspg_ts ! surface pressure gradient (dyn_spg_ts routine) 23 USE dynadv ! dynamics: vector invariant versus flux form24 23 USE sbctide 25 24 USE updtide … … 40 39 PUBLIC dyn_spg_init ! routine called by opa module 41 40 42 INTEGER :: nspg = 0 ! type of surface pressure gradient scheme defined from l k_dynspg_...41 INTEGER :: nspg = 0 ! type of surface pressure gradient scheme defined from ln_dynspg_... 43 42 44 43 !! * Substitutions … … 63 62 !!gm the after velocity, in the 2 other (ua,va) are still the trends 64 63 !! 65 !! ** Method : T hreeschemes:64 !! ** Method : Two schemes: 66 65 !! - explicit computation : the spg is evaluated at now 67 !! - filtered computation : the Roulet & madec (2000) technique is used68 66 !! - split-explicit computation: a time splitting technique is used 69 67 !! … … 99 97 100 98 IF( ln_apr_dyn & ! atmos. pressure 101 .OR. ( .NOT.l k_dynspg_ts .AND. (ln_tide_pot .AND. lk_tide) ) & ! tide potential (no time slitting)99 .OR. ( .NOT.ln_dynspg_ts .AND. (ln_tide_pot .AND. lk_tide) ) & ! tide potential (no time slitting) 102 100 .OR. nn_ice_embd == 2 ) THEN ! embedded sea-ice 103 101 ! … … 109 107 END DO 110 108 ! 111 IF( ln_apr_dyn .AND. (.NOT. l k_dynspg_ts) ) THEN !== Atmospheric pressure gradient (added later in time-split case) ==!109 IF( ln_apr_dyn .AND. (.NOT. ln_dynspg_ts) ) THEN !== Atmospheric pressure gradient (added later in time-split case) ==! 112 110 zg_2 = grav * 0.5 113 111 DO jj = 2, jpjm1 ! gradient of Patm using inverse barometer ssh … … 122 120 ! 123 121 ! !== tide potential forcing term ==! 124 IF( .NOT.l k_dynspg_ts .AND. ( ln_tide_pot .AND. lk_tide ) ) THEN ! N.B. added directly at sub-time-step in ts-case122 IF( .NOT.ln_dynspg_ts .AND. ( ln_tide_pot .AND. lk_tide ) ) THEN ! N.B. added directly at sub-time-step in ts-case 125 123 ! 126 124 CALL upd_tide( kt ) ! update tide potential … … 190 188 !! *** ROUTINE dyn_spg_init *** 191 189 !! 192 !! ** Purpose : Control the consistency between cppoptions for190 !! ** Purpose : Control the consistency between namelist options for 193 191 !! surface pressure gradient schemes 194 192 !!---------------------------------------------------------------------- 195 INTEGER :: ioptio 193 INTEGER :: ioptio, ios 194 ! 195 NAMELIST/namdyn_spg/ ln_dynspg_exp, ln_dynspg_ts 196 196 !!---------------------------------------------------------------------- 197 197 ! 198 198 IF( nn_timing == 1 ) CALL timing_start('dyn_spg_init') 199 199 ! 200 IF(lwp) THEN ! Control print 200 REWIND( numnam_ref ) ! Namelist namdyn_spg in reference namelist : Free surface 201 READ ( numnam_ref, namdyn_spg, IOSTAT = ios, ERR = 901) 202 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdyn_spg in reference namelist', lwp ) 203 204 REWIND( numnam_cfg ) ! Namelist namdyn_spg in configuration namelist : Free surface 205 READ ( numnam_cfg, namdyn_spg, IOSTAT = ios, ERR = 902 ) 206 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdyn_spg in configuration namelist', lwp ) 207 IF(lwm) WRITE ( numond, namdyn_spg ) 208 ! 209 IF(lwp) THEN ! Namelist print 201 210 WRITE(numout,*) 202 211 WRITE(numout,*) 'dyn_spg_init : choice of the surface pressure gradient scheme' 203 212 WRITE(numout,*) '~~~~~~~~~~~' 204 WRITE(numout,*) ' Explicit free surface lk_dynspg_exp = ', lk_dynspg_exp 205 WRITE(numout,*) ' Free surface with time splitting lk_dynspg_ts = ', lk_dynspg_ts 206 ENDIF 207 208 IF( lk_dynspg_ts ) CALL dyn_spg_ts_init( nit000 ) 209 ! (do it now, to set nn_baro, used to allocate some arrays later on) 210 ! ! allocate dyn_spg arrays 211 IF( lk_dynspg_ts ) THEN 212 IF( dynspg_oce_alloc() /= 0 ) CALL ctl_stop('STOP', 'dyn_spg_init: failed to allocate dynspg_oce arrays') 213 WRITE(numout,*) ' Explicit free surface ln_dynspg_exp = ', ln_dynspg_exp 214 WRITE(numout,*) ' Free surface with time splitting ln_dynspg_ts = ', ln_dynspg_ts 215 ENDIF 216 217 IF( ln_dynspg_ts ) THEN 218 CALL dyn_spg_ts_init( nit000 ) ! do it first, to set nn_baro, used to allocate some arrays later on 219 ! ! allocate dyn_spg arrays 213 220 IF( dyn_spg_ts_alloc() /= 0 ) CALL ctl_stop('STOP', 'dyn_spg_init: failed to allocate dynspg_ts arrays') 214 221 IF ((neuler/=0).AND.(ln_bt_fw)) CALL ts_rst( nit000, 'READ' ) … … 217 224 ! ! Control of surface pressure gradient scheme options 218 225 ioptio = 0 219 IF(l k_dynspg_exp) ioptio = ioptio + 1220 IF(l k_dynspg_ts ) ioptio = ioptio + 1226 IF(ln_dynspg_exp) ioptio = ioptio + 1 227 IF(ln_dynspg_ts ) ioptio = ioptio + 1 221 228 ! 222 229 IF( ioptio > 1 .OR. ( ioptio == 0 .AND. .NOT. lk_c1d ) ) & 223 & CALL ctl_stop( ' Choose only one surface pressure gradient scheme with a key cpp' ) 224 IF( ( lk_dynspg_ts .OR. lk_dynspg_exp ) .AND. ln_isfcav ) & 225 & CALL ctl_stop( ' dynspg_ts and dynspg_exp not tested with ice shelf cavity ' ) 226 ! 227 IF( lk_dynspg_exp) nspg = 0 228 IF( lk_dynspg_ts ) nspg = 1 229 230 & CALL ctl_stop( ' Choose only one surface pressure gradient scheme' ) 231 IF( ln_dynspg_ts .AND. ln_isfcav ) & 232 & CALL ctl_stop( ' dynspg_ts not tested with ice shelf cavity ' ) 233 ! 234 IF( ln_dynspg_exp) nspg = 0 235 IF( ln_dynspg_ts ) nspg = 1 230 236 ! 231 237 IF(lwp) THEN -
branches/2015/dev_r5847_MERCATOR9_solveur_simplification/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_exp.F90
r5836 r5902 7 7 !! 3.2 ! 2009-06 (G. Madec, M. Leclair, R. Benshila) introduce sshwzv module 8 8 !!---------------------------------------------------------------------- 9 #if defined key_dynspg_exp10 9 !!---------------------------------------------------------------------- 11 !! 'key_dynspg_exp'explicit free surface10 !! explicit free surface 12 11 !!---------------------------------------------------------------------- 13 12 !! dyn_spg_exp : update the momentum trend with the surface … … 31 30 PRIVATE 32 31 33 PUBLIC dyn_spg_exp ! routine called by step.F9032 PUBLIC dyn_spg_exp ! routine called by dyn_spg 34 33 35 34 !! * Substitutions … … 101 100 END SUBROUTINE dyn_spg_exp 102 101 103 #else104 !!----------------------------------------------------------------------105 !! Default case : Empty module No standart explicit free surface106 !!----------------------------------------------------------------------107 CONTAINS108 SUBROUTINE dyn_spg_exp( kt ) ! Empty routine109 WRITE(*,*) 'dyn_spg_exp: You should not have seen this print! error?', kt110 END SUBROUTINE dyn_spg_exp111 #endif112 113 102 !!====================================================================== 114 103 END MODULE dynspg_exp -
branches/2015/dev_r5847_MERCATOR9_solveur_simplification/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90
r5836 r5902 11 11 !! 3.5 ! 2013-07 (J. Chanut) Switch to Forward-backward time stepping 12 12 !! 3.6 ! 2013-11 (A. Coward) Update for z-tilde compatibility 13 !! 3.7 ! 2015-11 (J. Chanut) free surface simplification 13 14 !!--------------------------------------------------------------------- 14 #if defined key_dynspg_ts15 15 !!---------------------------------------------------------------------- 16 !! 'key_dynspg_ts'split explicit free surface16 !! split explicit free surface 17 17 !!---------------------------------------------------------------------- 18 18 !! dyn_spg_ts : compute surface pressure gradient trend using a time- … … 23 23 USE sbc_oce ! surface boundary condition: ocean 24 24 USE sbcisf ! ice shelf variable (fwfisf) 25 USE dynspg_oce ! surface pressure gradient variables26 25 USE phycst ! physical constants 27 26 USE dynvor ! vorticity term 28 27 USE bdy_par ! for lk_bdy 29 USE bdytides ! open boundary condition data30 28 USE bdydyn2d ! open boundary conditions on barotropic variables 31 29 USE sbctide ! tides … … 42 40 USE sbcapr ! surface boundary condition: atmospheric pressure 43 41 USE dynadv, ONLY: ln_dynadv_vec 42 USE bdytides 44 43 #if defined key_agrif 45 44 USE agrif_opa_interp ! agrif … … 67 66 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: ftnw, ftne ! triad of coriolis parameter 68 67 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: ftsw, ftse ! (only used with een vorticity scheme) 69 70 ! Arrays below are saved to allow testing of the "no time averaging" option71 ! If this option is not retained, these could be replaced by temporary arrays72 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: sshbb_e, sshb_e, & ! Instantaneous barotropic arrays73 ubb_e, ub_e, &74 vbb_e, vb_e75 68 76 69 !! * Substitutions … … 88 81 !! *** routine dyn_spg_ts_alloc *** 89 82 !!---------------------------------------------------------------------- 90 INTEGER :: ierr( 3)83 INTEGER :: ierr(4) 91 84 !!---------------------------------------------------------------------- 92 85 ierr(:) = 0 93 86 94 ALLOCATE( sshb_e(jpi,jpj), sshbb_e(jpi,jpj), & 95 & ub_e(jpi,jpj) , vb_e(jpi,jpj) , & 96 & ubb_e(jpi,jpj) , vbb_e(jpi,jpj) , STAT= ierr(1) ) 87 ALLOCATE( ssha_e(jpi,jpj), sshn_e(jpi,jpj), sshb_e(jpi,jpj), sshbb_e(jpi,jpj), & 88 & ua_e(jpi,jpj), ub_e(jpi,jpj), ubb_e(jpi,jpj), & 89 & va_e(jpi,jpj), vb_e(jpi,jpj), vbb_e(jpi,jpj), & 90 & hu_e(jpi,jpj), hur_e(jpi,jpj), hv_e(jpi,jpj), hvr_e(jpi,jpj), STAT= ierr(1) ) 97 91 98 92 ALLOCATE( wgtbtp1(3*nn_baro), wgtbtp2(3*nn_baro), zwz(jpi,jpj), STAT= ierr(2) ) … … 101 95 & ftsw(jpi,jpj) , ftse(jpi,jpj) , STAT=ierr(3) ) 102 96 97 ALLOCATE( ub2_b(jpi,jpj), vb2_b(jpi,jpj), un_adv(jpi,jpj), vn_adv(jpi,jpj), & 98 #if defined key_agrif 99 & ub2_i_b(jpi,jpj), vb2_i_b(jpi,jpj) , & 100 #endif 101 & STAT= ierr(4)) 102 103 103 dyn_spg_ts_alloc = MAXVAL(ierr(:)) 104 104 105 105 IF( lk_mpp ) CALL mpp_sum( dyn_spg_ts_alloc ) 106 IF( dyn_spg_ts_alloc /= 0 ) CALL ctl_warn('dyn spg_oce_alloc: failed to allocate arrays')106 IF( dyn_spg_ts_alloc /= 0 ) CALL ctl_warn('dyn_spg_ts_alloc: failed to allocate arrays') 107 107 ! 108 108 END FUNCTION dyn_spg_ts_alloc … … 1164 1164 END SUBROUTINE dyn_spg_ts_init 1165 1165 1166 #else1167 !!---------------------------------------------------------------------------1168 !! Default case : Empty module No split explicit free surface1169 !!---------------------------------------------------------------------------1170 CONTAINS1171 INTEGER FUNCTION dyn_spg_ts_alloc() ! Dummy function1172 dyn_spg_ts_alloc = 01173 END FUNCTION dyn_spg_ts_alloc1174 SUBROUTINE dyn_spg_ts( kt ) ! Empty routine1175 INTEGER, INTENT(in) :: kt1176 WRITE(*,*) 'dyn_spg_ts: You should not have seen this print! error?', kt1177 END SUBROUTINE dyn_spg_ts1178 SUBROUTINE ts_rst( kt, cdrw ) ! Empty routine1179 INTEGER , INTENT(in) :: kt ! ocean time-step1180 CHARACTER(len=*), INTENT(in) :: cdrw ! "READ"/"WRITE" flag1181 WRITE(*,*) 'ts_rst : You should not have seen this print! error?', kt, cdrw1182 END SUBROUTINE ts_rst1183 SUBROUTINE dyn_spg_ts_init( kt ) ! Empty routine1184 INTEGER , INTENT(in) :: kt ! ocean time-step1185 WRITE(*,*) 'dyn_spg_ts_init : You should not have seen this print! error?', kt1186 END SUBROUTINE dyn_spg_ts_init1187 #endif1188 1189 1166 !!====================================================================== 1190 1167 END MODULE dynspg_ts -
branches/2015/dev_r5847_MERCATOR9_solveur_simplification/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf_exp.F90
r3625 r5902 8 8 !! NEMO 0.5 ! 2002-08 (G. Madec) F90: Free form and module 9 9 !! 3.3 ! 2010-04 (M. Leclair, G. Madec) Forcing averaged over 2 time steps 10 !! 3.7 ! 2015-11 (J. Chanut) output velocities instead of trends 10 11 !!---------------------------------------------------------------------- 11 12 … … 18 19 USE phycst ! physical constants 19 20 USE zdf_oce ! ocean vertical physics 21 USE dynadv, ONLY: ln_dynadv_vec ! Momentum advection form 20 22 USE sbc_oce ! surface boundary condition: ocean 21 23 USE lib_mpp ! MPP library … … 118 120 ! 119 121 END DO ! End of time splitting 122 123 ! Time step momentum here to be compliant with what is done in the implicit case 124 ! 125 IF( ln_dynadv_vec .OR. .NOT. lk_vvl ) THEN ! applied on velocity 126 DO jk = 1, jpkm1 127 ua(:,:,jk) = ( ub(:,:,jk) + p2dt * ua(:,:,jk) ) * umask(:,:,jk) 128 va(:,:,jk) = ( vb(:,:,jk) + p2dt * va(:,:,jk) ) * vmask(:,:,jk) 129 END DO 130 ELSE ! applied on thickness weighted velocity 131 DO jk = 1, jpkm1 132 ua(:,:,jk) = ( ub(:,:,jk) * fse3u_b(:,:,jk) & 133 & + p2dt * ua(:,:,jk) * fse3u_n(:,:,jk) ) & 134 & / fse3u_a(:,:,jk) * umask(:,:,jk) 135 va(:,:,jk) = ( vb(:,:,jk) * fse3v_b(:,:,jk) & 136 & + p2dt * va(:,:,jk) * fse3v_n(:,:,jk) ) & 137 & / fse3v_a(:,:,jk) * vmask(:,:,jk) 138 END DO 139 ENDIF 120 140 ! 121 141 CALL wrk_dealloc( jpi,jpj,jpk, zwx, zwy, zwz, zww ) -
branches/2015/dev_r5847_MERCATOR9_solveur_simplification/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf_imp.F90
r5836 r5902 25 25 USE wrk_nemo ! Memory Allocation 26 26 USE timing ! Timing 27 USE dynadv ! dynamics: vector invariant versus flux form 28 USE dynspg_oce, ONLY: lk_dynspg_ts 27 USE dynadv, ONLY: ln_dynadv_vec ! Momentum advection form 29 28 30 29 IMPLICIT NONE … … 87 86 ENDIF 88 87 89 ! 0. Local constant initialization 90 ! -------------------------------- 91 z1_p2dt = 1._wp / p2dt ! inverse of the timestep 92 93 ! 1. Apply semi-implicit bottom friction 88 ! 1. Time step dynamics 89 ! --------------------- 90 91 IF( ln_dynadv_vec .OR. .NOT. lk_vvl ) THEN ! applied on velocity 92 DO jk = 1, jpkm1 93 ua(:,:,jk) = ( ub(:,:,jk) + p2dt * ua(:,:,jk) ) * umask(:,:,jk) 94 va(:,:,jk) = ( vb(:,:,jk) + p2dt * va(:,:,jk) ) * vmask(:,:,jk) 95 END DO 96 ELSE ! applied on thickness weighted velocity 97 DO jk = 1, jpkm1 98 ua(:,:,jk) = ( ub(:,:,jk) * fse3u_b(:,:,jk) & 99 & + p2dt * ua(:,:,jk) * fse3u_n(:,:,jk) ) & 100 & / fse3u_a(:,:,jk) * umask(:,:,jk) 101 va(:,:,jk) = ( vb(:,:,jk) * fse3v_b(:,:,jk) & 102 & + p2dt * va(:,:,jk) * fse3v_n(:,:,jk) ) & 103 & / fse3v_a(:,:,jk) * vmask(:,:,jk) 104 END DO 105 ENDIF 106 107 ! 2. Apply semi-implicit bottom friction 94 108 ! -------------------------------------- 95 109 ! Only needed for semi-implicit bottom friction setup. The explicit … … 97 111 ! column vector of the tri-diagonal matrix equation 98 112 ! 99 100 113 IF( ln_bfrimp ) THEN 101 114 DO jj = 2, jpjm1 … … 119 132 ENDIF 120 133 121 #if defined key_dynspg_ts 122 IF( ln_dynadv_vec .OR. .NOT. lk_vvl ) THEN ! applied on velocity 123 DO jk = 1, jpkm1 124 ua(:,:,jk) = ( ub(:,:,jk) + p2dt * ua(:,:,jk) ) * umask(:,:,jk) 125 va(:,:,jk) = ( vb(:,:,jk) + p2dt * va(:,:,jk) ) * vmask(:,:,jk) 126 END DO 127 ELSE ! applied on thickness weighted velocity 128 DO jk = 1, jpkm1 129 ua(:,:,jk) = ( ub(:,:,jk) * fse3u_b(:,:,jk) & 130 & + p2dt * ua(:,:,jk) * fse3u_n(:,:,jk) ) & 131 & / fse3u_a(:,:,jk) * umask(:,:,jk) 132 va(:,:,jk) = ( vb(:,:,jk) * fse3v_b(:,:,jk) & 133 & + p2dt * va(:,:,jk) * fse3v_n(:,:,jk) ) & 134 & / fse3v_a(:,:,jk) * vmask(:,:,jk) 135 END DO 136 ENDIF 137 138 IF ( ln_bfrimp .AND.lk_dynspg_ts ) THEN 134 ! With split-explicit free surface, barotropic stress is treated explicitly 135 ! Update velocities at the bottom. 136 ! J. Chanut: The bottom stress is computed considering after barotropic velocities, which does 137 ! not lead to the effective stress seen over the whole barotropic loop. 138 IF ( ln_bfrimp .AND.ln_dynspg_ts ) THEN 139 139 ! remove barotropic velocities: 140 140 DO jk = 1, jpkm1 … … 166 166 END IF 167 167 ENDIF 168 #endif 169 170 ! 2. Vertical diffusion on u 168 169 ! 3. Vertical diffusion on u 171 170 ! --------------------------- 172 171 ! Matrix and second member construction … … 219 218 DO jj = 2, jpjm1 !== second recurrence: SOLk = RHSk - Lk / Dk-1 Lk-1 == 220 219 DO ji = fs_2, fs_jpim1 ! vector opt. 221 #if defined key_dynspg_ts222 220 ze3ua = ( 1._wp - r_vvl ) * fse3u_n(ji,jj,1) + r_vvl * fse3u_a(ji,jj,1) 223 221 ua(ji,jj,1) = ua(ji,jj,1) + p2dt * 0.5_wp * ( utau_b(ji,jj) + utau(ji,jj) ) & 224 222 & / ( ze3ua * rau0 ) * umask(ji,jj,1) 225 #else226 ua(ji,jj,1) = ub(ji,jj,1) &227 & + p2dt *(ua(ji,jj,1) + 0.5_wp * ( utau_b(ji,jj) + utau(ji,jj) ) &228 & / ( fse3u(ji,jj,1) * rau0 ) * umask(ji,jj,1) )229 #endif230 223 END DO 231 224 END DO … … 233 226 DO jj = 2, jpjm1 234 227 DO ji = fs_2, fs_jpim1 235 #if defined key_dynspg_ts236 228 zrhs = ua(ji,jj,jk) ! zrhs=right hand side 237 #else238 zrhs = ub(ji,jj,jk) + p2dt * ua(ji,jj,jk)239 #endif240 229 ua(ji,jj,jk) = zrhs - zwi(ji,jj,jk) / zwd(ji,jj,jk-1) * ua(ji,jj,jk-1) 241 230 END DO … … 256 245 END DO 257 246 258 #if ! defined key_dynspg_ts 259 ! Normalization to obtain the general momentum trend ua 260 DO jk = 1, jpkm1 261 DO jj = 2, jpjm1 262 DO ji = fs_2, fs_jpim1 ! vector opt. 263 ua(ji,jj,jk) = ( ua(ji,jj,jk) - ub(ji,jj,jk) ) * z1_p2dt 264 END DO 265 END DO 266 END DO 267 #endif 268 269 ! 3. Vertical diffusion on v 247 ! 4. Vertical diffusion on v 270 248 ! --------------------------- 271 249 ! Matrix and second member construction … … 317 295 ! 318 296 DO jj = 2, jpjm1 !== second recurrence: SOLk = RHSk - Lk / Dk-1 Lk-1 == 319 DO ji = fs_2, fs_jpim1 ! vector opt. 320 #if defined key_dynspg_ts 297 DO ji = fs_2, fs_jpim1 ! vector opt. 321 298 ze3va = ( 1._wp - r_vvl ) * fse3v_n(ji,jj,1) + r_vvl * fse3v_a(ji,jj,1) 322 299 va(ji,jj,1) = va(ji,jj,1) + p2dt * 0.5_wp * ( vtau_b(ji,jj) + vtau(ji,jj) ) & 323 300 & / ( ze3va * rau0 ) 324 #else325 va(ji,jj,1) = vb(ji,jj,1) &326 & + p2dt *(va(ji,jj,1) + 0.5_wp * ( vtau_b(ji,jj) + vtau(ji,jj) ) &327 & / ( fse3v(ji,jj,1) * rau0 ) )328 #endif329 301 END DO 330 302 END DO … … 332 304 DO jj = 2, jpjm1 333 305 DO ji = fs_2, fs_jpim1 ! vector opt. 334 #if defined key_dynspg_ts335 306 zrhs = va(ji,jj,jk) ! zrhs=right hand side 336 #else337 zrhs = vb(ji,jj,jk) + p2dt * va(ji,jj,jk)338 #endif339 307 va(ji,jj,jk) = zrhs - zwi(ji,jj,jk) / zwd(ji,jj,jk-1) * va(ji,jj,jk-1) 340 308 END DO … … 355 323 END DO 356 324 357 ! Normalization to obtain the general momentum trend va358 #if ! defined key_dynspg_ts359 DO jk = 1, jpkm1360 DO jj = 2, jpjm1361 DO ji = fs_2, fs_jpim1 ! vector opt.362 va(ji,jj,jk) = ( va(ji,jj,jk) - vb(ji,jj,jk) ) * z1_p2dt363 END DO364 END DO365 END DO366 #endif367 368 325 ! J. Chanut: Lines below are useless ? 369 !! restore bottom layer avmu(v)326 !! restore avmu(v)=0. at bottom (and top if ln_isfcav=T interfaces) 370 327 IF( ln_bfrimp ) THEN 371 328 DO jj = 2, jpjm1 -
branches/2015/dev_r5847_MERCATOR9_solveur_simplification/NEMOGCM/NEMO/OPA_SRC/DYN/sshwzv.F90
r5836 r5902 106 106 ssha(:,:) = ( sshb(:,:) - z2dt * ( zcoef * ( emp_b(:,:) + emp(:,:) ) + zhdiv(:,:) ) ) * ssmask(:,:) 107 107 108 #if ! defined key_dynspg_ts 109 ! These lines are not necessary with time splitting since110 ! boundary condition on sea level is set during ts loop108 IF ( .NOT.ln_dynspg_ts ) THEN 109 ! These lines are not necessary with time splitting since 110 ! boundary condition on sea level is set during ts loop 111 111 # if defined key_agrif 112 CALL agrif_ssh( kt )112 CALL agrif_ssh( kt ) 113 113 # endif 114 114 # if defined key_bdy 115 IF( lk_bdy ) THEN116 CALL lbc_lnk( ssha, 'T', 1. ) ! Not sure that's necessary117 CALL bdy_ssh( ssha ) ! Duplicate sea level across open boundaries118 ENDIF115 IF( lk_bdy ) THEN 116 CALL lbc_lnk( ssha, 'T', 1. ) ! Not sure that's necessary 117 CALL bdy_ssh( ssha ) ! Duplicate sea level across open boundaries 118 ENDIF 119 119 # endif 120 #endif 120 ENDIF 121 121 122 122 #if defined key_asminc … … 250 250 ENDIF 251 251 252 # if defined key_dynspg_ts 253 IF( ( neuler == 0 .AND. kt == nit000 ) .OR. ln_bt_fw ) THEN !** Euler time-stepping: no filter 254 # else 255 IF ( neuler == 0 .AND. kt == nit000 ) THEN !** Euler time-stepping at first time-step : no filter 256 #endif 252 IF( ( neuler == 0 .AND. kt == nit000 ) .OR. ( ln_bt_fw .AND. ln_dynspg_ts ) ) THEN 253 !** Euler time-stepping: no filter 257 254 sshb(:,:) = sshn(:,:) ! before <-- now 258 255 sshn(:,:) = ssha(:,:) ! now <-- after (before already = now) -
branches/2015/dev_r5847_MERCATOR9_solveur_simplification/NEMOGCM/NEMO/OPA_SRC/SBC/sbcapr.F90
r5836 r5902 12 12 USE dom_oce ! ocean space and time domain 13 13 USE sbc_oce ! surface boundary condition 14 USE dynspg_oce ! surface pressure gradient variables15 14 USE phycst ! physical constants 16 15 USE fldread ! read input fields … … 112 111 IF(lwp) WRITE(numout,*) ' Inverse barometer added to OBC ssh data' 113 112 ENDIF 114 IF( ( ln_apr_obc ) .AND. .NOT. lk_dynspg_ts ) & 115 CALL ctl_stop( 'sbc_apr: use inverse barometer ssh at open boundary ONLY possible with time-splitting' ) 113 !jc: stop below should rather be a warning 116 114 IF( ( ln_apr_obc ) .AND. .NOT. ln_apr_dyn ) & 117 115 CALL ctl_stop( 'sbc_apr: use inverse barometer ssh at open boundary ONLY requires ln_apr_dyn=T' ) -
branches/2015/dev_r5847_MERCATOR9_solveur_simplification/NEMOGCM/NEMO/OPA_SRC/SBC/sbctide.F90
r5215 r5902 10 10 USE phycst 11 11 USE daymod 12 USE dynspg_oce13 12 USE tideini 14 13 ! -
branches/2015/dev_r5847_MERCATOR9_solveur_simplification/NEMOGCM/NEMO/OPA_SRC/SBC/tideini.F90
r5215 r5902 10 10 USE phycst 11 11 USE daymod 12 USE dynspg_oce13 12 USE tide_mod 14 13 ! … … 96 95 & CALL ctl_stop('rdttideramp must be positive') 97 96 ! 98 IF( .NOT. lk_dynspg_ts ) CALL ctl_warn( 'sbc_tide : use of time splitting is recommended' )99 97 ! 100 98 ALLOCATE( ntide(nb_harmo) ) -
branches/2015/dev_r5847_MERCATOR9_solveur_simplification/NEMOGCM/NEMO/OPA_SRC/SBC/updtide.F90
r5215 r5902 42 42 !!---------------------------------------------------------------------- 43 43 INTEGER, INTENT(in) :: kt ! ocean time-step index 44 INTEGER, INTENT(in), OPTIONAL :: kit ! external mode sub-time-step index ( lk_dynspg_ts=Tonly)45 INTEGER, INTENT(in), OPTIONAL :: kbaro ! number of sub-time-step ( lk_dynspg_ts=Tonly)44 INTEGER, INTENT(in), OPTIONAL :: kit ! external mode sub-time-step index (time split only) 45 INTEGER, INTENT(in), OPTIONAL :: kbaro ! number of sub-time-step (time split only) 46 46 INTEGER, INTENT(in), OPTIONAL :: koffset ! time offset in number 47 ! of sub-time-steps ( lk_dynspg_ts=Tonly)47 ! of sub-time-steps (time split only) 48 48 ! 49 49 INTEGER :: joffset ! local integer -
branches/2015/dev_r5847_MERCATOR9_solveur_simplification/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_fct.F90
r5836 r5902 19 19 USE trd_oce ! trends: ocean variables 20 20 USE trdtra ! tracers trends 21 USE dynspg_oce ! choice/control of key cpp for surface pressure gradient22 21 USE diaptr ! poleward transport diagnostics 23 22 ! -
branches/2015/dev_r5847_MERCATOR9_solveur_simplification/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_mus.F90
r5836 r5902 21 21 USE trd_oce ! trends: ocean variables 22 22 USE trdtra ! tracers trends manager 23 USE dynspg_oce ! choice/control of key cpp for surface pressure gradient24 23 USE sbcrnf ! river runoffs 25 24 USE diaptr ! poleward transport diagnostics -
branches/2015/dev_r5847_MERCATOR9_solveur_simplification/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_qck.F90
r5836 r5902 20 20 USE trd_oce ! trends: ocean variables 21 21 USE trdtra ! trends manager: tracers 22 USE dynspg_oce ! surface pressure gradient variables23 22 USE diaptr ! poleward transport diagnostics 24 23 ! -
branches/2015/dev_r5847_MERCATOR9_solveur_simplification/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_ubs.F90
r5836 r5902 18 18 USE traadv_fct ! acces to routine interp_4th_cpt 19 19 USE trdtra ! trends manager: tracers 20 USE dynspg_oce ! choice/control of key cpp for surface pressure gradient21 20 USE diaptr ! poleward transport diagnostics 22 21 ! -
branches/2015/dev_r5847_MERCATOR9_solveur_simplification/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90
r5869 r5902 31 31 USE zdf_oce ! ocean vertical mixing 32 32 USE domvvl ! variable volume 33 USE dynspg_oce ! surface pressure gradient variables34 33 USE trd_oce ! trends: ocean variables 35 34 USE trdtra ! trends manager: tracers … … 107 106 ! Update after tracer on domain lateral boundaries 108 107 ! 108 ! 109 109 #if defined key_agrif 110 110 CALL Agrif_tra ! AGRIF zoom boundaries -
branches/2015/dev_r5847_MERCATOR9_solveur_simplification/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf.F90
r5836 r5902 18 18 USE zdf_oce ! ocean vertical physics variables 19 19 USE sbc_oce ! surface boundary condition: ocean 20 USE dynspg_oce21 20 ! 22 21 USE ldftra ! lateral diffusion: eddy diffusivity -
branches/2015/dev_r5847_MERCATOR9_solveur_simplification/NEMOGCM/NEMO/OPA_SRC/oce.F90
r5836 r5902 21 21 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ub , un , ua !: i-horizontal velocity [m/s] 22 22 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: vb , vn , va !: j-horizontal velocity [m/s] 23 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ua_sv, va_sv !: Saved trends (time spliting) [m/s2]24 23 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: wn !: vertical velocity [m/s] 25 24 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: hdivn !: horizontal divergence [s-1] … … 38 37 ! 39 38 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: spgu, spgv !: horizontal surface pressure gradient 39 40 !! Specific to split explicit free surface (allocated in dynspg_ts module): 41 ! 42 !! Time filtered arrays at baroclinic time step: 43 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: un_adv, vn_adv ! Advection vel. at "now" barocl. step 44 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ub2_b , vb2_b ! Half step fluxes (ln_bt_fw=T) 45 #if defined key_agrif 46 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ub2_i_b, vb2_i_b ! Half step time integrated fluxes 47 #endif 48 49 !! Arrays at barotropic time step: 50 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: & 51 sshbb_e, sshb_e, sshn_e, ssha_e, & 52 ubb_e, ub_e, ua_e, & 53 vbb_e, vb_e, va_e, & 54 hu_e, hur_e, hv_e, hvr_e 40 55 41 56 !! interpolated gradient (only used in zps case) … … 85 100 ! 86 101 ALLOCATE( ub (jpi,jpj,jpk) , un (jpi,jpj,jpk) , ua(jpi,jpj,jpk) , & 87 & vb (jpi,jpj,jpk) , vn (jpi,jpj,jpk) , va(jpi,jpj,jpk) , & 88 & ua_sv(jpi,jpj,jpk) , va_sv(jpi,jpj,jpk) , & 102 & vb (jpi,jpj,jpk) , vn (jpi,jpj,jpk) , va(jpi,jpj,jpk) , & 89 103 & wn (jpi,jpj,jpk) , hdivn(jpi,jpj,jpk) , & 90 104 & tsb (jpi,jpj,jpk,jpts) , tsn (jpi,jpj,jpk,jpts) , tsa(jpi,jpj,jpk,jpts) , & -
branches/2015/dev_r5847_MERCATOR9_solveur_simplification/NEMOGCM/NEMO/OPA_SRC/step.F90
r5869 r5902 179 179 180 180 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 181 ! Ocean dynamics : hdiv, ssh, e3, wn 182 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 181 ! Ocean dynamics : hdiv, ssh, e3, u, v, w 182 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 183 ua(:,:,:) = 0._wp ! set dynamics trends to zero 184 va(:,:,:) = 0._wp 185 183 186 CALL ssh_nxt ( kstp ) ! after ssh (includes call to div_hor) 184 187 IF( lk_vvl ) CALL dom_vvl_sf_nxt( kstp ) ! after vertical scale factors 185 188 CALL wzv ( kstp ) ! now cross-level velocity 186 189 187 IF( lk_dynspg_ts ) THEN188 ! In case the time splitting case, update almost all momentum trends here:189 ! Note that the computation of vertical velocity above, hence "after" sea level190 ! is necessary to compute momentum advection for the rhs of barotropic loop:191 190 !!gm : why also here ???? 192 IF(ln_sto_eos )CALL sto_pts( tsn ) ! Random T/S fluctuations191 IF(ln_sto_eos ) CALL sto_pts( tsn ) ! Random T/S fluctuations 193 192 !!gm 194 193 CALL eos ( tsn, rhd, rhop, fsdept_n(:,:,:) ) ! now in situ density for hpg computation 195 194 196 IF( ln_zps .AND. .NOT. ln_isfcav) &! Partial steps: bottom before horizontal gradient197 & 195 IF( ln_zps .AND. .NOT. ln_isfcav) & ! Partial steps: bottom before horizontal gradient 196 & CALL zps_hde ( kstp, jpts, tsn, gtsu, gtsv, & ! of t, s, rd at the last ocean level 198 197 & rhd, gru , grv ) 199 IF( ln_zps .AND. ln_isfcav) & ! Partial steps: top & bottom before horizontal gradient 200 & CALL zps_hde_isf( kstp, jpts, tsn, gtsu, gtsv, gtui, gtvi, & 201 & rhd, gru , grv , aru , arv , gzu , gzv , ge3ru , ge3rv , & 202 & grui, grvi, arui, arvi, gzui, gzvi, ge3rui, ge3rvi ) 203 204 ua(:,:,:) = 0._wp ! set dynamics trends to zero 205 va(:,:,:) = 0._wp 206 IF( lk_asminc .AND. ln_asmiau .AND. & 207 & ln_dyninc ) CALL dyn_asm_inc ( kstp ) ! apply dynamics assimilation increment 208 IF( lk_bdy ) CALL bdy_dyn3d_dmp( kstp ) ! bdy damping trends 209 CALL dyn_adv ( kstp ) ! advection (vector or flux form) 210 CALL dyn_vor ( kstp ) ! vorticity term including Coriolis 211 CALL dyn_ldf ( kstp ) ! lateral mixing 212 #if defined key_agrif 213 IF(.NOT. Agrif_Root()) CALL Agrif_Sponge_dyn ! momentum sponge 214 #endif 215 CALL dyn_hpg( kstp ) ! horizontal gradient of Hydrostatic pressure 216 CALL dyn_spg( kstp ) ! surface pressure gradient 217 218 ua_sv(:,:,:) = ua(:,:,:) ! Save trends (barotropic trend has been fully updated at this stage) 219 va_sv(:,:,:) = va(:,:,:) 220 221 CALL div_hor( kstp ) ! Horizontal divergence (2nd call in time-split case) 222 IF( lk_vvl ) CALL dom_vvl_sf_nxt( kstp, kcall=2 ) ! after vertical scale factors (update depth average component) 223 CALL wzv ( kstp ) ! now cross-level velocity 224 ENDIF 225 226 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 227 ! diagnostics and outputs (ua, va, tsa used as workspace) 228 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 229 IF( lk_floats ) CALL flo_stp( kstp ) ! drifting Floats 230 IF( lk_diahth ) CALL dia_hth( kstp ) ! Thermocline depth (20 degres isotherm depth) 231 IF(.NOT.ln_cpl ) CALL dia_fwb( kstp ) ! Fresh water budget diagnostics 232 IF( lk_diadct ) CALL dia_dct( kstp ) ! Transports 233 IF( lk_diaar5 ) CALL dia_ar5( kstp ) ! ar5 diag 234 IF( lk_diaharm ) CALL dia_harm( kstp ) ! Tidal harmonic analysis 235 CALL dia_wri( kstp ) ! ocean model: outputs 236 ! 237 IF( ln_crs ) CALL crs_fld( kstp ) ! ocean model: online field coarsening & output 198 IF( ln_zps .AND. ln_isfcav) & ! Partial steps: top & bottom before horizontal gradient 199 & CALL zps_hde_isf( kstp, jpts, tsn, gtsu, gtsv, gtui, gtvi, & 200 & rhd, gru , grv , aru , arv , gzu , gzv , ge3ru , ge3rv , & 201 & grui, grvi, arui, arvi, gzui, gzvi, ge3rui, ge3rvi ) 202 203 204 IF( lk_asminc .AND. ln_asmiau .AND. ln_dyninc ) & 205 CALL dyn_asm_inc ( kstp ) ! apply dynamics assimilation increment 206 IF( lk_bdy ) CALL bdy_dyn3d_dmp ( kstp ) ! bdy damping trends 207 #if defined key_agrif 208 IF(.NOT. Agrif_Root()) & 209 & CALL Agrif_Sponge_dyn ! momentum sponge 210 #endif 211 CALL dyn_adv ( kstp ) ! advection (vector or flux form) 212 CALL dyn_vor ( kstp ) ! vorticity term including Coriolis 213 CALL dyn_ldf ( kstp ) ! lateral mixing 214 CALL dyn_hpg ( kstp ) ! horizontal gradient of Hydrostatic pressure 215 CALL dyn_spg ( kstp ) ! surface pressure gradient 216 CALL dyn_bfr ( kstp ) ! bottom friction 217 CALL dyn_zdf ( kstp ) ! vertical diffusion 218 219 ! With split-explicit free surface, since now transports have been updated and ssha as well 220 IF( ln_dynspg_ts ) THEN ! vertical scale factors and vertical velocity need to be updated 221 CALL div_hor ( kstp ) ! Horizontal divergence (2nd call in time-split case) 222 IF( lk_vvl ) CALL dom_vvl_sf_nxt( kstp, kcall=2 ) ! after vertical scale factors (update depth average component) 223 CALL wzv ( kstp ) ! now cross-level velocity 224 ENDIF 225 226 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 227 ! diagnostics and outputs 228 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 229 IF( lk_floats ) CALL flo_stp ( kstp ) ! drifting Floats 230 IF( lk_diahth ) CALL dia_hth ( kstp ) ! Thermocline depth (20 degres isotherm depth) 231 IF(.NOT.ln_cpl ) CALL dia_fwb ( kstp ) ! Fresh water budget diagnostics 232 IF( lk_diadct ) CALL dia_dct ( kstp ) ! Transports 233 IF( lk_diaar5 ) CALL dia_ar5 ( kstp ) ! ar5 diag 234 IF( lk_diaharm ) CALL dia_harm ( kstp ) ! Tidal harmonic analysis 235 CALL dia_wri ( kstp ) ! ocean model: outputs 236 ! 237 IF( ln_crs ) CALL crs_fld ( kstp ) ! ocean model: online field coarsening & output 238 238 239 239 #if defined key_top … … 241 241 ! Passive Tracer Model 242 242 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 243 CALL trc_stp ( kstp )! time-stepping244 #endif 245 246 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 247 ! Active tracers (ua, va used as workspace)243 CALL trc_stp ( kstp ) ! time-stepping 244 #endif 245 246 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 247 ! Active tracers 248 248 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 249 249 tsa(:,:,:,:) = 0._wp ! set tracer trends to zero … … 257 257 IF( ln_tradmp ) CALL tra_dmp ( kstp ) ! internal damping trends 258 258 IF( lk_bdy ) CALL bdy_tra_dmp( kstp ) ! bdy damping trends 259 #if defined key_agrif 260 IF(.NOT. Agrif_Root()) CALL Agrif_Sponge_tra ! tracers sponge 261 #endif 259 262 CALL tra_adv ( kstp ) ! horizontal & vertical advection 260 263 CALL tra_ldf ( kstp ) ! lateral mixing … … 263 266 IF( ln_diaptr ) CALL dia_ptr ! Poleward adv/ldf TRansports diagnostics 264 267 !!gm 265 266 #if defined key_agrif267 IF(.NOT. Agrif_Root()) CALL Agrif_Sponge_tra ! tracers sponge268 #endif269 268 CALL tra_zdf ( kstp ) ! vertical mixing and after tracer fields 270 ! centered hpg (eos then time stepping) 271 IF ( .NOT. lk_dynspg_ts ) THEN ! eos already called in time-split case 272 !!gm : why again a call to sto_pts ??? 273 IF( ln_sto_eos ) CALL sto_pts( tsn ) ! Random T/S fluctuations 274 !!gm 275 CALL eos ( tsn, rhd, rhop, fsdept_n(:,:,:) ) ! now in situ density for hpg computation 276 IF( ln_zps .AND. .NOT. ln_isfcav) & 277 & CALL zps_hde ( kstp, jpts, tsn, gtsu, gtsv, & ! Partial steps: bottom before horizontal gradient 278 & rhd, gru , grv ) ! of t, s, rd at the last ocean level 279 IF( ln_zps .AND. ln_isfcav) & 280 & CALL zps_hde_isf( kstp, jpts, tsn, gtsu, gtsv, gtui, gtvi, & ! Partial steps for top/bottom cells 281 & rhd, gru , grv , aru , arv , gzu , gzv , ge3ru , ge3rv , & 282 & grui, grvi, arui, arvi, gzui, gzvi, ge3rui, ge3rvi ) ! of t, s, rd at the last ocean level 283 ENDIF 284 IF( ln_zdfnpc ) CALL tra_npc( kstp ) ! update after fields by non-penetrative convection 285 CALL tra_nxt( kstp ) ! tracer fields at next time step 286 287 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 288 ! Dynamics (tsa used as workspace) 289 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 290 IF( lk_dynspg_ts ) THEN 291 ! revert to previously computed momentum tendencies 292 ! (not using ua, va as temporary arrays during tracers' update could avoid that) 293 ua(:,:,:) = ua_sv(:,:,:) 294 va(:,:,:) = va_sv(:,:,:) 295 296 CALL dyn_bfr( kstp ) ! bottom friction 297 CALL dyn_zdf( kstp ) ! vertical diffusion 298 ELSE 299 ua(:,:,:) = 0._wp ! set dynamics trends to zero 300 va(:,:,:) = 0._wp 301 302 IF( lk_asminc .AND. ln_asmiau .AND. & 303 & ln_dyninc ) CALL dyn_asm_inc( kstp ) ! apply dynamics assimilation increment 304 IF( ln_bkgwri ) CALL asm_bkg_wri( kstp ) ! output background fields 305 IF( lk_bdy ) CALL bdy_dyn3d_dmp(kstp ) ! bdy damping trends 306 CALL dyn_adv( kstp ) ! advection (vector or flux form) 307 CALL dyn_vor( kstp ) ! vorticity term including Coriolis 308 CALL dyn_ldf( kstp ) ! lateral mixing 309 #if defined key_agrif 310 IF(.NOT. Agrif_Root()) CALL Agrif_Sponge_dyn ! momemtum sponge 311 #endif 312 CALL dyn_hpg( kstp ) ! horizontal gradient of Hydrostatic pressure 313 CALL dyn_bfr( kstp ) ! bottom friction 314 CALL dyn_zdf( kstp ) ! vertical diffusion 315 CALL dyn_spg( kstp ) ! surface pressure gradient 316 ENDIF 317 CALL dyn_nxt( kstp ) ! lateral velocity at next time step 318 319 CALL ssh_swp( kstp ) ! swap of sea surface height 320 IF( lk_vvl ) CALL dom_vvl_sf_swp( kstp ) ! swap of vertical scale factors 269 IF( ln_zdfnpc ) CALL tra_npc ( kstp ) ! update after fields by non-penetrative convection 270 271 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 272 ! Set boundary conditions and Swap 273 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 274 !!jc1: For agrif, it would be much better to finalize tracers/momentum here (e.g. bdy conditions) and move the swap 275 !! (and time filtering) after Agrif update. Then restart would be done after and would contain updated fields. 276 !! If so: 277 !! (i) no need to call agrif update at initialization time 278 !! (ii) no need to update "before" fields 279 !! 280 !! Apart from creating new tra_swp/dyn_swp routines, this however: 281 !! (i) makes boundary conditions at initialization time computed from updated fields which is not the case between 282 !! two restarts => restartability issue. One can circumvent this, maybe, by assuming "interface separation", 283 !! e.g. a shift of the feedback interface inside child domain. 284 !! (ii) requires that all restart outputs of updated variables by agrif (e.g. passive tracers/tke/barotropic arrays) are done at the same 285 !! place. 286 !! 287 !!jc2: dynnxt must be the latest call. fse3t_b are indeed updated in that routine 288 CALL tra_nxt ( kstp ) ! tracer fields at next time step 289 CALL dyn_nxt ( kstp ) ! lateral velocity at next time step 290 CALL ssh_swp ( kstp ) ! swap of sea surface height 291 IF( lk_vvl ) CALL dom_vvl_sf_swp( kstp ) ! swap of vertical scale factors 321 292 ! 322 293 323 294 !!gm : This does not only concern the dynamics ==>>> add a new title 324 295 !!gm2: why ouput restart before AGRIF update? 325 IF( lrst_oce ) CALL rst_write( kstp ) ! write output ocean restart file 296 !! 297 !!jc: That would be better, but see comment above 298 !! 299 IF( lrst_oce ) CALL rst_write( kstp ) ! write output ocean restart file 326 300 327 301 #if defined key_agrif -
branches/2015/dev_r5847_MERCATOR9_solveur_simplification/NEMOGCM/NEMO/OPA_SRC/step_oce.F90
r5836 r5902 40 40 USE dynldf ! lateral momentum diffusion (dyn_ldf routine) 41 41 USE dynzdf ! vertical diffusion (dyn_zdf routine) 42 USE dynspg_oce ! surface pressure gradient (dyn_spg routine)43 42 USE dynspg ! surface pressure gradient (dyn_spg routine) 44 43
Note: See TracChangeset
for help on using the changeset viewer.