Changeset 7761
- Timestamp:
- 2017-03-06T18:58:35+01:00 (7 years ago)
- Location:
- trunk/NEMOGCM/NEMO
- Files:
-
- 15 edited
-
LIM_SRC_3/limistate.F90 (modified) (1 diff)
-
NST_SRC/agrif_lim3_interp.F90 (modified) (3 diffs)
-
NST_SRC/agrif_lim3_update.F90 (modified) (3 diffs)
-
NST_SRC/agrif_user.F90 (modified) (8 diffs)
-
OFF_SRC/nemogcm.F90 (modified) (1 diff)
-
OPA_SRC/DOM/phycst.F90 (modified) (1 diff)
-
OPA_SRC/DYN/dynhpg.F90 (modified) (1 diff)
-
OPA_SRC/SBC/sbccpl.F90 (modified) (2 diffs)
-
OPA_SRC/SBC/sbcice_lim.F90 (modified) (4 diffs)
-
OPA_SRC/nemogcm.F90 (modified) (1 diff)
-
SAS_SRC/daymod.F90 (modified) (1 diff)
-
SAS_SRC/diawri.F90 (modified) (4 diffs)
-
SAS_SRC/nemogcm.F90 (modified) (2 diffs)
-
SAS_SRC/sbcssm.F90 (modified) (4 diffs)
-
SAS_SRC/step.F90 (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/LIM_SRC_3/limistate.F90
r7753 r7761 445 445 sxyage (:,:,:) = 0._wp 446 446 447 !------------------------------------ 448 ! 6) store fields at before time-step 449 !------------------------------------ 450 ! it is only necessary for the 1st interpolation by Agrif 451 a_i_b (:,:,:) = a_i (:,:,:) 452 e_i_b (:,:,:,:) = e_i (:,:,:,:) 453 v_i_b (:,:,:) = v_i (:,:,:) 454 v_s_b (:,:,:) = v_s (:,:,:) 455 e_s_b (:,:,:,:) = e_s (:,:,:,:) 456 smv_i_b(:,:,:) = smv_i(:,:,:) 457 oa_i_b (:,:,:) = oa_i (:,:,:) 458 u_ice_b(:,:) = u_ice(:,:) 459 v_ice_b(:,:) = v_ice(:,:) 460 447 461 !!!clem 448 462 !! ! Output the initial state and forcings -
trunk/NEMOGCM/NEMO/NST_SRC/agrif_lim3_interp.F90
r7646 r7761 54 54 IF( Agrif_Root() ) RETURN 55 55 ! 56 IF( PRESENT( kiter ) ) THEN ! interpolation at the child sub-time step (for ice rheology) 57 zbeta = ( REAL(lim_nbstep) - REAL(kitermax - kiter) / REAL(kitermax) ) / & 58 & ( Agrif_Rhot() * REAL(Agrif_Parent(nn_fsbc)) / REAL(nn_fsbc) ) 59 ELSE ! interpolation at the child time step 60 zbeta = REAL(lim_nbstep) / ( Agrif_Rhot() * REAL(Agrif_Parent(nn_fsbc)) / REAL(nn_fsbc) ) 61 ENDIF 56 SELECT CASE(cd_type) 57 CASE('U','V') 58 IF( PRESENT( kiter ) ) THEN ! interpolation at the child sub-time step (only for ice rheology) 59 zbeta = ( REAL(lim_nbstep) - REAL(kitermax - kiter) / REAL(kitermax) ) / & 60 & ( Agrif_Rhot() * REAL(Agrif_Parent(nn_fsbc)) / REAL(nn_fsbc) ) 61 ELSE ! interpolation at the child time step 62 zbeta = REAL(lim_nbstep) / ( Agrif_Rhot() * REAL(Agrif_Parent(nn_fsbc)) / REAL(nn_fsbc) ) 63 ENDIF 64 CASE('T') 65 zbeta = REAL(lim_nbstep-1) / ( Agrif_Rhot() * REAL(Agrif_Parent(nn_fsbc)) / REAL(nn_fsbc) ) 66 END SELECT 62 67 ! 63 68 Agrif_SpecialValue=-9999. … … 151 156 152 157 !!----------------------------------------------------------------------- 153 ! clem: pkoi on n'utilise pas les quantités intégrées ici => before: * e1e2t ; after: * r1_e1e2t / rhox / rhoy154 ! a priori c'est ok comme ca (cf ce qui est fait dans l'ocean). Je ne sais pas pkoi ceci dit158 ! tracers are not multiplied by grid cell here => before: * e12t ; after: * r1_e12t / rhox / rhoy 159 ! and it is ok since we conserve tracers (same as in the ocean). 155 160 ALLOCATE( ztab(SIZE(a_i_b,1),SIZE(a_i_b,2),SIZE(ptab,3)) ) 156 161 … … 177 182 ELSE ! child grid 178 183 !! ==> The easiest interpolation is the following commented lines 179 !!jm = 1180 !!DO jl = 1, jpl181 !!a_i (i1:i2,j1:j2,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1182 !!v_i (i1:i2,j1:j2,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1183 !!v_s (i1:i2,j1:j2,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1184 !!smv_i(i1:i2,j1:j2,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1185 !!oa_i (i1:i2,j1:j2,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1186 !!DO jk = 1, nlay_s187 !!e_s(i1:i2,j1:j2,jk,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1188 !!ENDDO189 !!DO jk = 1, nlay_i190 !!e_i(i1:i2,j1:j2,jk,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1191 !!ENDDO192 !!ENDDO184 jm = 1 185 DO jl = 1, jpl 186 a_i (i1:i2,j1:j2,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 187 v_i (i1:i2,j1:j2,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 188 v_s (i1:i2,j1:j2,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 189 smv_i(i1:i2,j1:j2,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 190 oa_i (i1:i2,j1:j2,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 191 DO jk = 1, nlay_s 192 e_s(i1:i2,j1:j2,jk,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 193 ENDDO 194 DO jk = 1, nlay_i 195 e_i(i1:i2,j1:j2,jk,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 196 ENDDO 197 ENDDO 193 198 194 199 !! ==> this is a more complex interpolation since we mix solutions over a couple of grid points 195 200 !! it is advised to use it for fields modified by high order schemes (e.g. advection UM5...) 196 ! record ztab 197 jm = 1 198 DO jl = 1, jpl 199 ztab(:,:,jm) = a_i_b (:,:,jl) ; jm = jm + 1 200 ztab(:,:,jm) = v_i_b (:,:,jl) ; jm = jm + 1 201 ztab(:,:,jm) = v_s_b (:,:,jl) ; jm = jm + 1 202 ztab(:,:,jm) = smv_i_b(:,:,jl) ; jm = jm + 1 203 ztab(:,:,jm) = oa_i_b (:,:,jl) ; jm = jm + 1 204 DO jk = 1, nlay_s 205 ztab(:,:,jm) = e_s_b(:,:,jk,jl) ; jm = jm + 1 206 ENDDO 207 DO jk = 1, nlay_i 208 ztab(:,:,jm) = e_i_b(:,:,jk,jl) ; jm = jm + 1 209 ENDDO 210 ENDDO 211 ! 212 ! borders of the domain 213 western_side = (nb == 1).AND.(ndir == 1) ; eastern_side = (nb == 1).AND.(ndir == 2) 214 southern_side = (nb == 2).AND.(ndir == 1) ; northern_side = (nb == 2).AND.(ndir == 2) 215 ! 216 ! spatial smoothing 217 zrhox = Agrif_Rhox() 218 z1 = ( zrhox - 1. ) * 0.5 219 z3 = ( zrhox - 1. ) / ( zrhox + 1. ) 220 z6 = 2. * ( zrhox - 1. ) / ( zrhox + 1. ) 221 z7 = - ( zrhox - 1. ) / ( zrhox + 3. ) 222 z2 = 1. - z1 223 z4 = 1. - z3 224 z5 = 1. - z6 - z7 225 ! 226 ! Remove corners 227 imin = i1 ; imax = i2 ; jmin = j1 ; jmax = j2 228 IF( (nbondj == -1) .OR. (nbondj == 2) ) jmin = 3 229 IF( (nbondj == +1) .OR. (nbondj == 2) ) jmax = nlcj-2 230 IF( (nbondi == -1) .OR. (nbondi == 2) ) imin = 3 231 IF( (nbondi == +1) .OR. (nbondi == 2) ) imax = nlci-2 232 233 ! smoothed fields 234 IF( eastern_side ) THEN 235 ztab(nlci,j1:j2,:) = z1 * ptab(nlci,j1:j2,:) + z2 * ptab(nlci-1,j1:j2,:) 236 DO jj = jmin, jmax 237 rswitch = 0. 238 IF( u_ice(nlci-2,jj) > 0._wp ) rswitch = 1. 239 ztab(nlci-1,jj,:) = ( 1. - umask(nlci-2,jj,1) ) * ztab(nlci,jj,:) & 240 & + umask(nlci-2,jj,1) * & 241 & ( ( 1. - rswitch ) * ( z4 * ztab(nlci,jj,:) + z3 * ztab(nlci-2,jj,:) ) & 242 & + rswitch * ( z6 * ztab(nlci-2,jj,:) + z5 * ztab(nlci,jj,:) + z7 * ztab(nlci-3,jj,:) ) ) 243 ztab(nlci-1,jj,:) = ztab(nlci-1,jj,:) * tmask(nlci-1,jj,1) 244 END DO 245 ENDIF 246 ! 247 IF( northern_side ) THEN 248 ztab(i1:i2,nlcj,:) = z1 * ptab(i1:i2,nlcj,:) + z2 * ptab(i1:i2,nlcj-1,:) 249 DO ji = imin, imax 250 rswitch = 0. 251 IF( v_ice(ji,nlcj-2) > 0._wp ) rswitch = 1. 252 ztab(ji,nlcj-1,:) = ( 1. - vmask(ji,nlcj-2,1) ) * ztab(ji,nlcj,:) & 253 & + vmask(ji,nlcj-2,1) * & 254 & ( ( 1. - rswitch ) * ( z4 * ztab(ji,nlcj,:) + z3 * ztab(ji,nlcj-2,:) ) & 255 & + rswitch * ( z6 * ztab(ji,nlcj-2,:) + z5 * ztab(ji,nlcj,:) + z7 * ztab(ji,nlcj-3,:) ) ) 256 ztab(ji,nlcj-1,:) = ztab(ji,nlcj-1,:) * tmask(ji,nlcj-1,1) 257 END DO 258 END IF 259 ! 260 IF( western_side) THEN 261 ztab(1,j1:j2,:) = z1 * ptab(1,j1:j2,:) + z2 * ptab(2,j1:j2,:) 262 DO jj = jmin, jmax 263 rswitch = 0. 264 IF( u_ice(2,jj) > 0._wp ) rswitch = 1. 265 ztab(2,jj,:) = ( 1. - umask(2,jj,1) ) * ztab(1,jj,:) & 266 & + umask(2,jj,1) * & 267 & ( ( 1. - rswitch ) * ( z4 * ztab(1,jj,:) + z3 * ztab(3,jj,:) ) & 268 & + rswitch * ( z6 * ztab(3,jj,:) + z5 * ztab(1,jj,:) + z7 * ztab(4,jj,:) ) ) 269 ztab(2,jj,:) = ztab(2,jj,:) * tmask(2,jj,1) 270 END DO 271 ENDIF 272 ! 273 IF( southern_side ) THEN 274 ztab(i1:i2,1,:) = z1 * ptab(i1:i2,1,:) + z2 * ptab(i1:i2,2,:) 275 DO ji = imin, imax 276 rswitch = 0. 277 IF( v_ice(ji,2) > 0._wp ) rswitch = 1. 278 ztab(ji,2,:) = ( 1. - vmask(ji,2,1) ) * ztab(ji,1,:) & 279 & + vmask(ji,2,1) * & 280 & ( ( 1. - rswitch ) * ( z4 * ztab(ji,1,:) + z3 * ztab(ji,3,:) ) & 281 & + rswitch * ( z6 * ztab(ji,3,:) + z5 * ztab(ji,1,:) + z7 * ztab(ji,4,:) ) ) 282 ztab(ji,2,:) = ztab(ji,2,:) * tmask(ji,2,1) 283 END DO 284 END IF 285 ! 286 ! Treatment of corners 287 IF( (eastern_side) .AND. ((nbondj == -1).OR.(nbondj == 2)) ) ztab(nlci-1,2,:) = ptab(nlci-1,2,:) ! East south 288 IF( (eastern_side) .AND. ((nbondj == 1).OR.(nbondj == 2)) ) ztab(nlci-1,nlcj-1,:) = ptab(nlci-1,nlcj-1,:) ! East north 289 IF( (western_side) .AND. ((nbondj == -1).OR.(nbondj == 2)) ) ztab(2,2,:) = ptab(2,2,:) ! West south 290 IF( (western_side) .AND. ((nbondj == 1).OR.(nbondj == 2)) ) ztab(2,nlcj-1,:) = ptab(2,nlcj-1,:) ! West north 291 292 ! retrieve ice tracers 293 jm = 1 294 DO jl = 1, jpl 295 a_i (i1:i2,j1:j2,jl) = ztab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 296 v_i (i1:i2,j1:j2,jl) = ztab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 297 v_s (i1:i2,j1:j2,jl) = ztab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 298 smv_i(i1:i2,j1:j2,jl) = ztab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 299 oa_i (i1:i2,j1:j2,jl) = ztab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 300 DO jk = 1, nlay_s 301 e_s(i1:i2,j1:j2,jk,jl) = ztab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 302 ENDDO 303 DO jk = 1, nlay_i 304 e_i(i1:i2,j1:j2,jk,jl) = ztab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 305 ENDDO 306 ENDDO 307 201 !! clem: for some reason (I don't know why), the following lines do not work 202 !! with mpp (or in realistic configurations?). It makes the model crash 203 ! ! record ztab 204 ! jm = 1 205 ! DO jl = 1, jpl 206 ! ztab(:,:,jm) = a_i (:,:,jl) ; jm = jm + 1 207 ! ztab(:,:,jm) = v_i (:,:,jl) ; jm = jm + 1 208 ! ztab(:,:,jm) = v_s (:,:,jl) ; jm = jm + 1 209 ! ztab(:,:,jm) = smv_i(:,:,jl) ; jm = jm + 1 210 ! ztab(:,:,jm) = oa_i (:,:,jl) ; jm = jm + 1 211 ! DO jk = 1, nlay_s 212 ! ztab(:,:,jm) = e_s(:,:,jk,jl) ; jm = jm + 1 213 ! ENDDO 214 ! DO jk = 1, nlay_i 215 ! ztab(:,:,jm) = e_i(:,:,jk,jl) ; jm = jm + 1 216 ! ENDDO 217 ! ENDDO 218 ! ! 219 ! ! borders of the domain 220 ! western_side = (nb == 1).AND.(ndir == 1) ; eastern_side = (nb == 1).AND.(ndir == 2) 221 ! southern_side = (nb == 2).AND.(ndir == 1) ; northern_side = (nb == 2).AND.(ndir == 2) 222 ! ! 223 ! ! spatial smoothing 224 ! zrhox = Agrif_Rhox() 225 ! z1 = ( zrhox - 1. ) * 0.5 226 ! z3 = ( zrhox - 1. ) / ( zrhox + 1. ) 227 ! z6 = 2. * ( zrhox - 1. ) / ( zrhox + 1. ) 228 ! z7 = - ( zrhox - 1. ) / ( zrhox + 3. ) 229 ! z2 = 1. - z1 230 ! z4 = 1. - z3 231 ! z5 = 1. - z6 - z7 232 ! ! 233 ! ! Remove corners 234 ! imin = i1 ; imax = i2 ; jmin = j1 ; jmax = j2 235 ! IF( (nbondj == -1) .OR. (nbondj == 2) ) jmin = 3 236 ! IF( (nbondj == +1) .OR. (nbondj == 2) ) jmax = nlcj-2 237 ! IF( (nbondi == -1) .OR. (nbondi == 2) ) imin = 3 238 ! IF( (nbondi == +1) .OR. (nbondi == 2) ) imax = nlci-2 239 ! 240 ! ! smoothed fields 241 ! IF( eastern_side ) THEN 242 ! ztab(nlci,j1:j2,:) = z1 * ptab(nlci,j1:j2,:) + z2 * ptab(nlci-1,j1:j2,:) 243 ! DO jj = jmin, jmax 244 ! rswitch = 0. 245 ! IF( u_ice(nlci-2,jj) > 0._wp ) rswitch = 1. 246 ! ztab(nlci-1,jj,:) = ( 1. - umask(nlci-2,jj,1) ) * ztab(nlci,jj,:) & 247 ! & + umask(nlci-2,jj,1) * & 248 ! & ( ( 1. - rswitch ) * ( z4 * ztab(nlci,jj,:) + z3 * ztab(nlci-2,jj,:) ) & 249 ! & + rswitch * ( z6 * ztab(nlci-2,jj,:) + z5 * ztab(nlci,jj,:) + z7 * ztab(nlci-3,jj,:) ) ) 250 ! ztab(nlci-1,jj,:) = ztab(nlci-1,jj,:) * tmask(nlci-1,jj,1) 251 ! END DO 252 ! ENDIF 253 ! ! 254 ! IF( northern_side ) THEN 255 ! ztab(i1:i2,nlcj,:) = z1 * ptab(i1:i2,nlcj,:) + z2 * ptab(i1:i2,nlcj-1,:) 256 ! DO ji = imin, imax 257 ! rswitch = 0. 258 ! IF( v_ice(ji,nlcj-2) > 0._wp ) rswitch = 1. 259 ! ztab(ji,nlcj-1,:) = ( 1. - vmask(ji,nlcj-2,1) ) * ztab(ji,nlcj,:) & 260 ! & + vmask(ji,nlcj-2,1) * & 261 ! & ( ( 1. - rswitch ) * ( z4 * ztab(ji,nlcj,:) + z3 * ztab(ji,nlcj-2,:) ) & 262 ! & + rswitch * ( z6 * ztab(ji,nlcj-2,:) + z5 * ztab(ji,nlcj,:) + z7 * ztab(ji,nlcj-3,:) ) ) 263 ! ztab(ji,nlcj-1,:) = ztab(ji,nlcj-1,:) * tmask(ji,nlcj-1,1) 264 ! END DO 265 ! END IF 266 ! ! 267 ! IF( western_side) THEN 268 ! ztab(1,j1:j2,:) = z1 * ptab(1,j1:j2,:) + z2 * ptab(2,j1:j2,:) 269 ! DO jj = jmin, jmax 270 ! rswitch = 0. 271 ! IF( u_ice(2,jj) < 0._wp ) rswitch = 1. 272 ! ztab(2,jj,:) = ( 1. - umask(2,jj,1) ) * ztab(1,jj,:) & 273 ! & + umask(2,jj,1) * & 274 ! & ( ( 1. - rswitch ) * ( z4 * ztab(1,jj,:) + z3 * ztab(3,jj,:) ) & 275 ! & + rswitch * ( z6 * ztab(3,jj,:) + z5 * ztab(1,jj,:) + z7 * ztab(4,jj,:) ) ) 276 ! ztab(2,jj,:) = ztab(2,jj,:) * tmask(2,jj,1) 277 ! END DO 278 ! ENDIF 279 ! ! 280 ! IF( southern_side ) THEN 281 ! ztab(i1:i2,1,:) = z1 * ptab(i1:i2,1,:) + z2 * ptab(i1:i2,2,:) 282 ! DO ji = imin, imax 283 ! rswitch = 0. 284 ! IF( v_ice(ji,2) < 0._wp ) rswitch = 1. 285 ! ztab(ji,2,:) = ( 1. - vmask(ji,2,1) ) * ztab(ji,1,:) & 286 ! & + vmask(ji,2,1) * & 287 ! & ( ( 1. - rswitch ) * ( z4 * ztab(ji,1,:) + z3 * ztab(ji,3,:) ) & 288 ! & + rswitch * ( z6 * ztab(ji,3,:) + z5 * ztab(ji,1,:) + z7 * ztab(ji,4,:) ) ) 289 ! ztab(ji,2,:) = ztab(ji,2,:) * tmask(ji,2,1) 290 ! END DO 291 ! END IF 292 ! ! 293 ! ! Treatment of corners 294 ! IF( (eastern_side) .AND. ((nbondj == -1).OR.(nbondj == 2)) ) ztab(nlci-1,2,:) = ptab(nlci-1,2,:) ! East south 295 ! IF( (eastern_side) .AND. ((nbondj == 1).OR.(nbondj == 2)) ) ztab(nlci-1,nlcj-1,:) = ptab(nlci-1,nlcj-1,:) ! East north 296 ! IF( (western_side) .AND. ((nbondj == -1).OR.(nbondj == 2)) ) ztab(2,2,:) = ptab(2,2,:) ! West south 297 ! IF( (western_side) .AND. ((nbondj == 1).OR.(nbondj == 2)) ) ztab(2,nlcj-1,:) = ptab(2,nlcj-1,:) ! West north 298 ! 299 ! ! retrieve ice tracers 300 ! jm = 1 301 ! DO jl = 1, jpl 302 ! a_i (i1:i2,j1:j2,jl) = ztab(i1:i2,j1:j2,jm) ; jm = jm + 1 303 ! v_i (i1:i2,j1:j2,jl) = ztab(i1:i2,j1:j2,jm) ; jm = jm + 1 304 ! v_s (i1:i2,j1:j2,jl) = ztab(i1:i2,j1:j2,jm) ; jm = jm + 1 305 ! smv_i(i1:i2,j1:j2,jl) = ztab(i1:i2,j1:j2,jm) ; jm = jm + 1 306 ! oa_i (i1:i2,j1:j2,jl) = ztab(i1:i2,j1:j2,jm) ; jm = jm + 1 307 ! DO jk = 1, nlay_s 308 ! e_s(i1:i2,j1:j2,jk,jl) = ztab(i1:i2,j1:j2,jm) ; jm = jm + 1 309 ! ENDDO 310 ! DO jk = 1, nlay_i 311 ! e_i(i1:i2,j1:j2,jk,jl) = ztab(i1:i2,j1:j2,jm) ; jm = jm + 1 312 ! ENDDO 313 ! ENDDO 314 315 ! integrated values 316 vt_i (i1:i2,j1:j2) = SUM( v_i(i1:i2,j1:j2,:), dim=3 ) 317 vt_s (i1:i2,j1:j2) = SUM( v_s(i1:i2,j1:j2,:), dim=3 ) 318 at_i (i1:i2,j1:j2) = SUM( a_i(i1:i2,j1:j2,:), dim=3 ) 319 et_s(i1:i2,j1:j2) = SUM( SUM( e_s(i1:i2,j1:j2,:,:), dim=4 ), dim=3 ) 320 et_i(i1:i2,j1:j2) = SUM( SUM( e_i(i1:i2,j1:j2,:,:), dim=4 ), dim=3 ) 321 308 322 ENDIF 309 323 -
trunk/NEMOGCM/NEMO/NST_SRC/agrif_lim3_update.F90
r7646 r7761 52 52 !!---------------------------------------------------------------------- 53 53 ! 54 ! IF( ( MOD( kt-nit000, Agrif_irhot() * Agrif_Parent(nn_fsbc) ) /=0 ) .AND. (kt /= 0) ) THEN 55 ! PRINT *, 'clem NOT udpate, kt=',kt,Agrif_NbStepint() 56 ! ELSE 57 ! PRINT *, 'clem UPDATE, kt=',kt,Agrif_NbStepint() 58 ! ENDIF 59 60 !! clem: I think the update should take place each time the ocean sees the surface forcings (but maybe I am wrong and we should update every rhot time steps) 61 IF( ( MOD( kt-nit000, Agrif_irhot() * Agrif_Parent(nn_fsbc) ) /=0 ) .AND. (kt /= 0) ) RETURN ! do not update if nb of child time steps differ from time refinement 62 ! i.e. update only at the parent time step 63 !! clem: this condition is clearly wrong if nn_fsbc/=1 (==> Agrif_NbStepint /= (Agrif_irhot()-1) all the time) 64 !!IF( ( Agrif_NbStepint() .NE. (Agrif_irhot()-1) ) .AND. (kt /= 0) ) RETURN 65 54 !! clem: I think the update should take place each time the ocean sees the surface forcings 55 !! (but maybe I am wrong and we should update every rhot time steps) 56 IF( ( MOD( (kt-nit000)/nn_fsbc + 1, Agrif_irhot() * Agrif_Parent(nn_fsbc) / nn_fsbc ) /=0 ) .AND. (kt /= 0) ) RETURN ! do not update if nb of child time steps differ from time refinement 57 ! i.e. update only at the parent time step 66 58 Agrif_UseSpecialValueInUpdate = .TRUE. 67 59 Agrif_SpecialValueFineGrid = -9999. … … 98 90 INTEGER :: jk, jl, jm 99 91 !!----------------------------------------------------------------------- 100 ! clem: it is ok not to multiply by e1 e2 since we conserve tracers here (cf ce qui est fait dans opa).92 ! it is ok not to multiply by e1*e2 since we conserve tracers here (same as in the ocean). 101 93 IF( before ) THEN 102 94 jm = 1 … … 135 127 ENDDO 136 128 129 ! integrated values 130 vt_i (i1:i2,j1:j2) = SUM( v_i(i1:i2,j1:j2,:), dim=3 ) 131 vt_s (i1:i2,j1:j2) = SUM( v_s(i1:i2,j1:j2,:), dim=3 ) 132 at_i (i1:i2,j1:j2) = SUM( a_i(i1:i2,j1:j2,:), dim=3 ) 133 et_s(i1:i2,j1:j2) = SUM( SUM( e_s(i1:i2,j1:j2,:,:), dim=4 ), dim=3 ) 134 et_i(i1:i2,j1:j2) = SUM( SUM( e_i(i1:i2,j1:j2,:,:), dim=4 ), dim=3 ) 135 137 136 ENDIF 138 137 ! -
trunk/NEMOGCM/NEMO/NST_SRC/agrif_user.F90
r7646 r7761 37 37 jpim1 = jpi-1 38 38 jpjm1 = jpj-1 39 jpkm1 = jpk-139 jpkm1 = MAX( 1, jpk-1 ) 40 40 jpij = jpi*jpj 41 41 nperio = 0 … … 83 83 # if defined key_top 84 84 CALL Agrif_InitValues_cont_top 85 # endif 86 # if defined key_lim3 87 CALL Agrif_InitValues_cont_lim3 85 88 # endif 86 89 ! … … 290 293 ! check if vmask agree with parent along northern and southern boundaries: 291 294 CALL Agrif_Bc_variable(vmsk_id,calledweight=1.,procname=interpvmsk) 292 295 ! check if tmask and vertical scale factors agree with parent over first two coarse grid points: 293 296 CALL Agrif_Bc_variable(e3t_id,calledweight=1.,procname=interpe3t) 294 297 ! 295 298 IF (lk_mpp) CALL mpp_sum( kindic_agr ) 296 IF( kindic_agr /= 0 ) THEN 299 IF( kindic_agr /= 0 ) THEN 297 300 CALL ctl_stop('Child Bathymetry is not correct near boundaries.') 298 301 ELSE … … 457 460 ! CALL Agrif_Set_Updatetype(vb2b_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average) 458 461 ! CALL Agrif_Set_Updatetype(sshn_id, update = Agrif_Update_Full_Weighting) 459 462 460 463 ! 461 464 END SUBROUTINE agrif_declare_var … … 579 582 CALL agrif_declare_var_lim3 580 583 581 ! Controls (clem) 584 ! Controls 585 586 ! clem: For some reason, nn_fsbc(child)/=1 does not work properly (signal is largely degraded by the agrif zoom) 587 ! the run must satisfy CFL=Uice/(dx/dt) < 0.6/nn_fsbc(child) 588 ! therefore, if nn_fsbc(child)>1 one must reduce the time-step in proportion to nn_fsbc(child), which is not acceptable 589 ! If a solution is found, the following stop could be removed 590 IF( nn_fsbc > 1 ) CALL ctl_stop('nn_fsbc(child) must be set to 1 otherwise agrif and lim3 do not work properly') 591 582 592 ! stop if rhot * nn_fsbc(parent) /= N * nn_fsbc(child) with N being integer 583 593 IF( MOD( Agrif_irhot() * Agrif_Parent(nn_fsbc), nn_fsbc ) /= 0 ) THEN … … 591 601 ! First Interpolations (using "after" ice subtime step => lim_nbstep=1) 592 602 !---------------------------------------------------------------------- 593 lim_nbstep = 1 603 !! lim_nbstep = 1 604 lim_nbstep = ( Agrif_irhot() * Agrif_Parent(nn_fsbc) / nn_fsbc ) ! clem: to have calledweight=1 in interp (otherwise the western border of the zoom is wrong) 594 605 CALL agrif_interp_lim3('U') ! interpolation of ice velocities 595 606 CALL agrif_interp_lim3('V') ! interpolation of ice velocities … … 618 629 ! 1. Declaration of the type of variable which have to be interpolated (parent=>child) 619 630 ! agrif_declare_variable(position,1st point index,--,--,dimensions,name) 631 ! ex.: position=> 1,1 = not-centered (in i and j) 632 ! 2,2 = centered ( - ) 633 ! index => 1,1 = one ghost line 634 ! 2,2 = two ghost lines 620 635 !------------------------------------------------------------------------------------- 621 636 CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpl*(5+nlay_s+nlay_i)/),tra_ice_id ) … … 637 652 ! 4. Set update type in case 2 ways (child=>parent) (normal & tangent to the grid cell for velocities) 638 653 !-------------------------------------------------- 639 CALL Agrif_Set_Updatetype(tra_ice_id, update = AGRIF_Update_Average) ! clem je comprends pas average/copy654 CALL Agrif_Set_Updatetype(tra_ice_id, update = AGRIF_Update_Average) 640 655 CALL Agrif_Set_Updatetype(u_ice_id ,update1 = Agrif_Update_Copy , update2 = Agrif_Update_Average) 641 656 CALL Agrif_Set_Updatetype(v_ice_id ,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy ) -
trunk/NEMOGCM/NEMO/OFF_SRC/nemogcm.F90
r7646 r7761 540 540 ! 541 541 ! lfax contains the set of allowed factors. 542 data (ilfax(jl),jl=1,ntest) / 16384, 8192, 4096, 2048, 1024, 512, 256, & 543 & 128, 64, 32, 16, 8, 4, 2 / 544 !!---------------------------------------------------------------------- 542 ilfax(:) = (/(2**jl,jl=ntest,1,-1)/) 545 543 546 544 ! Clear the error flag and initialise output vars -
trunk/NEMOGCM/NEMO/OPA_SRC/DOM/phycst.F90
r7646 r7761 40 40 REAL(wp), PUBLIC :: rtt = 273.16_wp !: triple point of temperature [Kelvin] 41 41 REAL(wp), PUBLIC :: rt0 = 273.15_wp !: freezing point of fresh water [Kelvin] 42 REAL(wp), PUBLIC :: rt0_snow = 273.15_wp !: melting point of snow [Kelvin] 42 43 #if defined key_lim3 43 REAL(wp), PUBLIC :: rt0_snow = 273.15_wp !: melting point of snow [Kelvin]44 44 REAL(wp), PUBLIC :: rt0_ice = 273.15_wp !: melting point of ice [Kelvin] 45 45 #else 46 REAL(wp), PUBLIC :: rt0_snow = 273.15_wp !: melting point of snow [Kelvin]47 46 REAL(wp), PUBLIC :: rt0_ice = 273.05_wp !: melting point of ice [Kelvin] 48 47 #endif -
trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynhpg.F90
r7753 r7761 1330 1330 jpi = size(fsp,1) 1331 1331 jpj = size(fsp,2) 1332 jpkm1 = size(fsp,3) - 11332 jpkm1 = MAX( 1, size(fsp,3) - 1 ) 1333 1333 ! 1334 1334 IF (polynomial_type == 1) THEN ! Constrained Cubic Spline -
trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90
r7646 r7761 1590 1590 zemp_tot(:,:) = frcv(jpr_tevp)%z3(:,:,1) - ztprecip(:,:) 1591 1591 zemp_ice(:,:) = ( frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_snow)%z3(:,:,1) ) * zicefr(:,:) 1592 CALL iom_put( 'rain' , frcv(jpr_rain)%z3(:,:,1) ) ! liquid precipitation 1592 IF( iom_use('precip') ) & 1593 & CALL iom_put( 'precip' , frcv(jpr_rain)%z3(:,:,1) + frcv(jpr_snow)%z3(:,:,1) ) ! total precipitation 1594 IF( iom_use('rain') ) & 1595 & CALL iom_put( 'rain' , frcv(jpr_rain)%z3(:,:,1) ) ! liquid precipitation 1596 IF( iom_use('rain_ao_cea') ) & 1597 & CALL iom_put( 'rain_ao_cea' , frcv(jpr_rain)%z3(:,:,1)* p_frld(:,:) * tmask(:,:,1) ) ! liquid precipitation 1593 1598 IF( iom_use('hflx_rain_cea') ) & 1594 & CALL iom_put( 'hflx_rain_cea', frcv(jpr_rain)%z3(:,:,1) * zcptn(:,:) ) ! heat flux from liq. precip. 1599 CALL iom_put( 'hflx_rain_cea', frcv(jpr_rain)%z3(:,:,1) * zcptn(:,:) * tmask(:,:,1)) ! heat flux from liq. precip. 1600 IF( iom_use('hflx_prec_cea') ) & 1601 CALL iom_put( 'hflx_prec_cea', ztprecip * zcptn(:,:) * tmask(:,:,1) * p_frld(:,:) ) ! heat content flux from all precip (cell avg) 1602 IF( iom_use('evap_ao_cea') .OR. iom_use('hflx_evap_cea') ) & 1603 ztmp(:,:) = frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) 1595 1604 IF( iom_use('evap_ao_cea' ) ) & 1596 & CALL iom_put( 'evap_ao_cea' , frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) )! ice-free oce evap (cell average)1605 CALL iom_put( 'evap_ao_cea' , ztmp * tmask(:,:,1) ) ! ice-free oce evap (cell average) 1597 1606 IF( iom_use('hflx_evap_cea') ) & 1598 & CALL iom_put( 'hflx_evap_cea', ( frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) ) * zcptn(:,:) )! heat flux from from evap (cell average)1599 CASE( 'oce and ice' ) ! received fields: jpr_sbpr, jpr_semp, jpr_oemp, jpr_ievp1607 CALL iom_put( 'hflx_evap_cea', ztmp(:,:) * zcptn(:,:) * tmask(:,:,1) ) ! heat flux from from evap (cell average) 1608 CASE( 'oce and ice' ) ! received fields: jpr_sbpr, jpr_semp, jpr_oemp, jpr_ievp 1600 1609 zemp_tot(:,:) = p_frld(:,:) * frcv(jpr_oemp)%z3(:,:,1) + zicefr(:,:) * frcv(jpr_sbpr)%z3(:,:,1) 1601 1610 zemp_ice(:,:) = frcv(jpr_semp)%z3(:,:,1) * zicefr(:,:) … … 1660 1669 ! runoffs and calving (put in emp_tot) 1661 1670 IF( srcv(jpr_rnf)%laction ) rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1) 1671 IF( iom_use('hflx_rnf_cea') ) & 1672 CALL iom_put( 'hflx_rnf_cea' , rnf(:,:) * zcptn(:,:) ) 1662 1673 IF( srcv(jpr_cal)%laction ) THEN 1663 1674 zemp_tot(:,:) = zemp_tot(:,:) - frcv(jpr_cal)%z3(:,:,1) -
trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim.F90
r7753 r7761 116 116 IF( nn_timing == 1 ) CALL timing_start('sbc_ice_lim') 117 117 118 ! clem: it is important to initialize agrif_lim3 variables here and not in sbc_lim_init119 # if defined key_agrif120 IF( kt == nit000 ) THEN121 IF( .NOT. Agrif_Root() ) CALL Agrif_InitValues_cont_lim3122 ENDIF123 # endif124 125 118 !-----------------------! 126 119 ! --- Ice time step --- ! … … 194 187 IF( .NOT. Agrif_Root() ) CALL agrif_interp_lim3('T') 195 188 #endif 196 IF( ln_limthd .AND. ln_bdy ) 189 IF( ln_limthd .AND. ln_bdy ) CALL bdy_ice_lim( kt ) ! -- bdy ice thermo 197 190 ! previous lead fraction and ice volume for flux calculations 198 191 CALL sbc_lim_bef … … 246 239 CALL lim_var_agg( 2 ) ! necessary calls (at least for coupling) 247 240 ! 248 # if defined key_agrif 249 !! IF( .NOT. Agrif_Root() ) CALL Agrif_ChildGrid_To_ParentGrid() ! clem: should be called at the update frequency only (cf agrif_lim3_update) 250 # endif 241 !! clem: one should switch the calculation of the fluxes onto the parent grid but the following calls do not work 242 !! moreover it should only be called at the update frequency (as in agrif_lim3_update.F90) 243 !!# if defined key_agrif 244 !! IF( .NOT. Agrif_Root() ) CALL Agrif_ChildGrid_To_ParentGrid() 245 !!# endif 251 246 CALL lim_sbc_flx( kt ) ! -- Update surface ocean mass, heat and salt fluxes 252 # if defined key_agrif253 !! IF( .NOT. Agrif_Root() ) CALL Agrif_ParentGrid_To_ChildGrid() ! clem: should be called at the update frequency only (cf agrif_lim3_update)254 # endif247 !!# if defined key_agrif 248 !! IF( .NOT. Agrif_Root() ) CALL Agrif_ParentGrid_To_ChildGrid() 249 !!# endif 255 250 IF( ln_limdiahsb ) CALL lim_diahsb( kt ) ! -- Diagnostics and outputs 256 251 ! … … 425 420 ! 426 421 IF( lwp .AND. ln_bdy .AND. ln_limdiachk ) & 427 & CALL ctl_warn('online conservation check activated but it does not work with BDY')422 & CALL ctl_warn('online conservation check activated but it does not work with BDY') 428 423 ! 429 424 IF( lwp ) WRITE(numout,*) ' ice timestep rdt_ice = ', rdt_ice -
trunk/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90
r7646 r7761 376 376 jpim1 = jpi-1 ! inner domain indices 377 377 jpjm1 = jpj-1 ! " " 378 jpkm1 = jpk-1! " "378 jpkm1 = MAX( 1, jpk-1 ) ! " " 379 379 jpij = jpi*jpj ! jpi x j 380 380 -
trunk/NEMOGCM/NEMO/SAS_SRC/daymod.F90
r7646 r7761 80 80 IF( MOD( rday , 2. ) /= 0. ) CALL ctl_stop( 'the number of second of in a day must be an even number' ) 81 81 IF( MOD( rdt , 2. ) /= 0. ) CALL ctl_stop( 'the time step (in second) must be an even number' ) 82 nsecd = NINT(rday 83 nsecd05 = NINT(0.5 * rday 84 ndt = NINT( rdt 85 ndt05 = NINT(0.5 * rdt 82 nsecd = NINT(rday ) 83 nsecd05 = NINT(0.5 * rday ) 84 ndt = NINT( rdt ) 85 ndt05 = NINT(0.5 * rdt ) 86 86 87 87 ! ==> clem: here we read the ocean restart for the date (only if it exists) -
trunk/NEMOGCM/NEMO/SAS_SRC/diawri.F90
r7646 r7761 40 40 #if defined key_lim2 41 41 USE limwri_2 42 #elif defined key_lim3 43 USE limwri 42 44 #endif 43 45 USE lib_mpp ! MPP library … … 80 82 !! Default option NetCDF output file 81 83 !!---------------------------------------------------------------------- 82 # if defined key_iomput84 # if defined key_iomput 83 85 !!---------------------------------------------------------------------- 84 86 !! 'key_iomput' use IOM library … … 95 97 !! ** Method : use iom_put 96 98 !!---------------------------------------------------------------------- 97 INTEGER, INTENT(in) :: kt ! ocean time-step index 99 !! 100 INTEGER, INTENT( in ) :: kt ! ocean time-step index 98 101 !!---------------------------------------------------------------------- 99 102 ! 100 !! no relevant 2D arrays to write in iomput case 103 ! Output the initial state and forcings 104 IF( ninist == 1 ) THEN 105 CALL dia_wri_state( 'output.init', kt ) 106 ninist = 0 107 ENDIF 101 108 ! 102 109 END SUBROUTINE dia_wri … … 392 399 #if defined key_lim2 393 400 CALL lim_wri_state_2( kt, id_i, nh_i ) 401 #elif defined key_lim3 402 CALL lim_wri_state( kt, id_i, nh_i ) 394 403 #else 395 404 CALL histend( id_i, snc4chunks=snc4set ) -
trunk/NEMOGCM/NEMO/SAS_SRC/nemogcm.F90
r7646 r7761 308 308 jpim1 = jpi-1 ! inner domain indices 309 309 jpjm1 = jpj-1 ! " " 310 jpkm1 = jpk-1! " "310 jpkm1 = MAX( 1, jpk-1 ) ! " " 311 311 jpij = jpi*jpj ! jpi x j 312 312 … … 370 370 ! the environment of ocean BDY. Therefore bdy is called in both OPA and SAS modules. 371 371 ! This is not clean and should be changed in the future. 372 CALL 372 CALL bdy_init 373 373 ! ==> 374 374 CALL icb_init( rdt, nit000) ! initialise icebergs instance -
trunk/NEMOGCM/NEMO/SAS_SRC/sbcssm.F90
r7646 r7761 88 88 ! 89 89 IF( ln_3d_uve ) THEN 90 IF( .NOT. ln_linssh ) e3t_m(:,:) = sf_ssm_3d(jf_e3t)%fnow(:,:,1) * tmask(:,:,1) ! v-velocity 91 ssu_m(:,:) = sf_ssm_3d(jf_usp)%fnow(:,:,1) * umask(:,:,1) ! u-velocity 92 ssv_m(:,:) = sf_ssm_3d(jf_vsp)%fnow(:,:,1) * vmask(:,:,1) ! v-velocity 90 IF( .NOT. ln_linssh ) THEN 91 e3t_m(:,:) = sf_ssm_3d(jf_e3t)%fnow(:,:,1) * tmask(:,:,1) ! vertical scale factor 92 ELSE 93 e3t_m(:,:) = e3t_0(:,:,1) ! vertical scale factor 94 ENDIF 95 ssu_m(:,:) = sf_ssm_3d(jf_usp)%fnow(:,:,1) * umask(:,:,1) ! u-velocity 96 ssv_m(:,:) = sf_ssm_3d(jf_vsp)%fnow(:,:,1) * vmask(:,:,1) ! v-velocity 93 97 ELSE 94 IF( .NOT. ln_linssh ) e3t_m(:,:) = sf_ssm_2d(jf_e3t)%fnow(:,:,1) * tmask(:,:,1) ! v-velocity 95 ssu_m(:,:) = sf_ssm_2d(jf_usp)%fnow(:,:,1) * umask(:,:,1) ! u-velocity 96 ssv_m(:,:) = sf_ssm_2d(jf_vsp)%fnow(:,:,1) * vmask(:,:,1) ! v-velocity 98 IF( .NOT. ln_linssh ) THEN 99 e3t_m(:,:) = sf_ssm_2d(jf_e3t)%fnow(:,:,1) * tmask(:,:,1) ! vertical scale factor 100 ELSE 101 e3t_m(:,:) = e3t_0(:,:,1) ! vertical scale factor 102 ENDIF 103 ssu_m(:,:) = sf_ssm_2d(jf_usp)%fnow(:,:,1) * umask(:,:,1) ! u-velocity 104 ssv_m(:,:) = sf_ssm_2d(jf_vsp)%fnow(:,:,1) * vmask(:,:,1) ! v-velocity 97 105 ENDIF 98 106 ! … … 111 119 ssv_m(:,:) = 0._wp 112 120 ssh_m(:,:) = 0._wp 113 e3t_m(:,:) = e3t_0(:,:,1) !clem: necessary at least for sas2D114 frq_m(:,:) = 1._wp ! - -115 sshn (:,:) = 0._wp ! - -121 IF( .NOT. ln_linssh ) e3t_m(:,:) = e3t_0(:,:,1) !clem: necessary at least for sas2D 122 frq_m(:,:) = 1._wp ! - - 123 sshn (:,:) = 0._wp ! - - 116 124 ENDIF 117 125 … … 173 181 NAMELIST/namsbc_sas/l_sasread, cn_dir, ln_3d_uve, ln_read_frq, sn_tem, sn_sal, sn_usp, sn_vsp, sn_ssh, sn_e3t, sn_frq 174 182 !!---------------------------------------------------------------------- 175 183 176 184 IF( ln_rstart .AND. nn_components == jp_iam_sas ) RETURN 177 185 … … 306 314 307 315 CALL sbc_ssm( nit000 ) ! need to define ss?_m arrays used in limistate 308 IF( .NOT. ln_read_frq ) frq_m(:,:) = 1.309 316 l_initdone = .TRUE. 310 317 ! -
trunk/NEMOGCM/NEMO/SAS_SRC/step.F90
r7646 r7761 53 53 54 54 #if defined key_agrif 55 SUBROUTINE stp( )55 RECURSIVE SUBROUTINE stp( ) 56 56 INTEGER :: kstp ! ocean time-step index 57 57 #else
Note: See TracChangeset
for help on using the changeset viewer.
