Changeset 7158
- Timestamp:
- 2016-10-29T01:21:05+02:00 (8 years ago)
- Location:
- branches/2016/dev_v3_6_STABLE_r6506_AGRIF_LIM3/NEMOGCM/NEMO
- Files:
-
- 51 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2016/dev_v3_6_STABLE_r6506_AGRIF_LIM3/NEMOGCM/NEMO/LIM_SRC_2/iceini_2.F90
r5385 r7158 83 83 CALL ice_run_2 ! read in namelist some run parameters 84 84 ! 85 rdt_ice = nn_fsbc * rdt tra(1)! sea-ice time step85 rdt_ice = nn_fsbc * rdt ! sea-ice time step 86 86 numit = nit000 - 1 87 87 ! -
branches/2016/dev_v3_6_STABLE_r6506_AGRIF_LIM3/NEMOGCM/NEMO/LIM_SRC_3/limrhg.F90
r6994 r7158 157 157 158 158 #if defined key_agrif 159 CALL agrif_interp_lim3( 'U') ! First interpolation of coarse values160 CALL agrif_interp_lim3( 'V')159 CALL agrif_interp_lim3( 'U', 0, nn_nevp ) ! First interpolation of coarse values 160 CALL agrif_interp_lim3( 'V', 0, nn_nevp ) 161 161 #endif 162 162 ! … … 460 460 461 461 #if defined key_agrif 462 !! CALL agrif_interp_lim3( 'V', jter, nn_nevp ) 462 463 CALL agrif_interp_lim3( 'V' ) 463 464 #endif … … 504 505 505 506 #if defined key_agrif 507 !! CALL agrif_interp_lim3( 'U', jter, nn_nevp ) 506 508 CALL agrif_interp_lim3( 'U' ) 507 509 #endif … … 550 552 551 553 #if defined key_agrif 554 !! CALL agrif_interp_lim3( 'U', jter, nn_nevp ) 552 555 CALL agrif_interp_lim3( 'U' ) 553 556 #endif … … 594 597 595 598 #if defined key_agrif 599 !! CALL agrif_interp_lim3( 'V', jter, nn_nevp ) 596 600 CALL agrif_interp_lim3( 'V' ) 597 601 #endif -
branches/2016/dev_v3_6_STABLE_r6506_AGRIF_LIM3/NEMOGCM/NEMO/NST_SRC/agrif_lim3_interp.F90
r7069 r7158 24 24 USE ice 25 25 USE agrif_ice 26 26 27 27 IMPLICIT NONE 28 28 PRIVATE … … 38 38 CONTAINS 39 39 40 SUBROUTINE agrif_interp_lim3( cd_type )40 SUBROUTINE agrif_interp_lim3( cd_type, kiter, kitermax ) 41 41 !!----------------------------------------------------------------------- 42 42 !! *** ROUTINE agrif_rhg_lim3 *** 43 43 !! 44 44 !! ** Method : simple call to atomic routines using stored values to 45 !! fill the boundaries depending of the position of the point and 46 !! computing factor for time interpolation 47 !!----------------------------------------------------------------------- 48 CHARACTER(len=1), INTENT( in ) :: cd_type 49 !! 45 !! fill the boundaries depending of the position of the point and 46 !! computing factor for time interpolation 47 !!----------------------------------------------------------------------- 48 CHARACTER(len=1), INTENT( in ) :: cd_type 49 INTEGER , INTENT( in ), OPTIONAL :: kiter, kitermax 50 !! 50 51 REAL(wp) :: zbeta 51 52 !!----------------------------------------------------------------------- … … 53 54 IF( Agrif_Root() ) RETURN 54 55 ! 55 zbeta = REAL(lim_nbstep) / ( Agrif_Rhot() * REAL(Agrif_Parent(nn_fsbc)) / REAL(nn_fsbc) ) 56 ! 57 ! clem: calledweight = zbeta(1/3;2/3;1) => 2/3*var1+1/3*var2 puis 1/3;2/3 puis 0;1 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 62 ! 58 63 Agrif_SpecialValue=-9999. 59 64 Agrif_UseSpecialValue = .TRUE. … … 126 131 127 132 128 SUBROUTINE interp_tra_ice( ptab, i1, i2, j1, j2, k1, k2, before )133 SUBROUTINE interp_tra_ice( ptab, i1, i2, j1, j2, k1, k2, before, nb, ndir ) 129 134 !!----------------------------------------------------------------------- 130 135 !! *** ROUTINE interp_tra_ice *** … … 137 142 INTEGER , INTENT(in) :: i1, i2, j1, j2, k1, k2 138 143 LOGICAL , INTENT(in) :: before 139 !! 140 INTEGER :: jk, jl, jm 144 INTEGER , INTENT(in) :: nb, ndir 145 !! 146 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: ztab 147 INTEGER :: ji, jj, jk, jl, jm 148 INTEGER :: imin, imax, jmin, jmax 149 REAL(wp) :: zrhox, z1, z2, z3, z4, z5, z6, z7 150 LOGICAL :: western_side, eastern_side, northern_side, southern_side 151 141 152 !!----------------------------------------------------------------------- 142 153 ! clem: pkoi on n'utilise pas les quantités intégrées ici => before: * e12t ; after: * r1_e12t / rhox / rhoy 143 154 ! a priori c'est ok comme ca (cf ce qui est fait dans l'ocean). Je ne sais pas pkoi ceci dit 144 155 ALLOCATE( ztab(SIZE(a_i_b,1),SIZE(a_i_b,2),SIZE(ptab,3)) ) 156 145 157 IF( before ) THEN ! parent grid 146 158 jm = 1 147 159 DO jl = 1, jpl 148 ptab( :,:,jm) = a_i_b (i1:i2,j1:j2,jl) ; jm = jm + 1149 ptab( :,:,jm) = v_i_b (i1:i2,j1:j2,jl) ; jm = jm + 1150 ptab( :,:,jm) = v_s_b (i1:i2,j1:j2,jl) ; jm = jm + 1151 ptab( :,:,jm) = smv_i_b(i1:i2,j1:j2,jl) ; jm = jm + 1152 ptab( :,:,jm) = oa_i_b (i1:i2,j1:j2,jl) ; jm = jm + 1160 ptab(i1:i2,j1:j2,jm) = a_i_b (i1:i2,j1:j2,jl) ; jm = jm + 1 161 ptab(i1:i2,j1:j2,jm) = v_i_b (i1:i2,j1:j2,jl) ; jm = jm + 1 162 ptab(i1:i2,j1:j2,jm) = v_s_b (i1:i2,j1:j2,jl) ; jm = jm + 1 163 ptab(i1:i2,j1:j2,jm) = smv_i_b(i1:i2,j1:j2,jl) ; jm = jm + 1 164 ptab(i1:i2,j1:j2,jm) = oa_i_b (i1:i2,j1:j2,jl) ; jm = jm + 1 153 165 DO jk = 1, nlay_s 154 ptab( :,:,jm) = e_s_b(i1:i2,j1:j2,jk,jl) ; jm = jm + 1166 ptab(i1:i2,j1:j2,jm) = e_s_b(i1:i2,j1:j2,jk,jl) ; jm = jm + 1 155 167 ENDDO 156 168 DO jk = 1, nlay_i 157 ptab( :,:,jm) = e_i_b(i1:i2,j1:j2,jk,jl) ; jm = jm + 1169 ptab(i1:i2,j1:j2,jm) = e_i_b(i1:i2,j1:j2,jk,jl) ; jm = jm + 1 158 170 ENDDO 159 171 ENDDO 160 !!ptab(:,:,jm) = ato_i(i1:i2,j1:j2)161 172 162 173 DO jk = k1, k2 163 WHERE( tmask(i1:i2,j1:j2,1) == 0. ) ptab( :,:,jk) = -9999.174 WHERE( tmask(i1:i2,j1:j2,1) == 0. ) ptab(i1:i2,j1:j2,jk) = -9999. 164 175 ENDDO 165 176 166 177 ELSE ! child grid 178 !! ==> The easiest interpolation is the following commented lines 179 !! jm = 1 180 !! DO jl = 1, jpl 181 !! a_i (i1:i2,j1:j2,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 182 !! v_i (i1:i2,j1:j2,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 183 !! v_s (i1:i2,j1:j2,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 184 !! smv_i(i1:i2,j1:j2,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 185 !! oa_i (i1:i2,j1:j2,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 186 !! DO jk = 1, nlay_s 187 !! e_s(i1:i2,j1:j2,jk,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 188 !! ENDDO 189 !! DO jk = 1, nlay_i 190 !! e_i(i1:i2,j1:j2,jk,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 191 !! ENDDO 192 !! ENDDO 193 194 !! ==> this is a more complex interpolation since we mix solutions over a couple of grid points 195 !! it is advised to use it for fields modified by high order schemes (e.g. advection UM5...) 196 ! record ztab 167 197 jm = 1 168 198 DO jl = 1, jpl 169 a_i (i1:i2,j1:j2,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1170 v_i (i1:i2,j1:j2,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1171 v_s (i1:i2,j1:j2,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1172 smv_i(i1:i2,j1:j2,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1173 oa_i (i1:i2,j1:j2,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1199 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 174 204 DO jk = 1, nlay_s 175 e_s(i1:i2,j1:j2,jk,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1205 ztab(:,:,jm) = e_s_b(:,:,jk,jl) ; jm = jm + 1 176 206 ENDDO 177 207 DO jk = 1, nlay_i 178 e_i(i1:i2,j1:j2,jk,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1208 ztab(:,:,jm) = e_i_b(:,:,jk,jl) ; jm = jm + 1 179 209 ENDDO 180 210 ENDDO 181 !!ato_i(i1:i2,j1:j2) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1) 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 182 307 183 308 ENDIF 309 310 DEALLOCATE( ztab ) 184 311 ! 185 312 END SUBROUTINE interp_tra_ice -
branches/2016/dev_v3_6_STABLE_r6506_AGRIF_LIM3/NEMOGCM/NEMO/NST_SRC/agrif_lim3_update.F90
r6746 r7158 52 52 !!---------------------------------------------------------------------- 53 53 ! 54 IF( ( Agrif_NbStepint() .NE. (Agrif_irhot()-1) ) .AND. (kt /= 0) ) RETURN ! do not update if nb of child time steps differ from time refinement 55 ! i.e. update only at the parent time step 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 56 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 57 66 Agrif_UseSpecialValueInUpdate = .TRUE. 58 67 Agrif_SpecialValueFineGrid = -9999. … … 60 69 IF( MOD(nbcline,nbclineupdate) == 0) THEN ! update the whole basin at each nbclineupdate (=nn_cln_update) baroclinic parent time steps 61 70 ! nbcline is incremented (+1) at the end of each parent time step from 0 (1st time step) 62 ! clem: j'ai l'impression qu'il y a un decalage de 1 mais selon rachid c ok63 71 CALL Agrif_Update_Variable( tra_ice_id , procname = update_tra_ice ) 64 72 CALL Agrif_Update_Variable( u_ice_id , procname = update_u_ice ) 65 73 CALL Agrif_Update_Variable( v_ice_id , procname = update_v_ice ) 66 ELSE ! update only the boundaries 67 ! defined par locupdate 74 ELSE ! update only the boundaries defined par locupdate 68 75 CALL Agrif_Update_Variable( tra_ice_id , locupdate=(/0,2/), procname = update_tra_ice ) 69 76 CALL Agrif_Update_Variable( u_ice_id , locupdate=(/0,1/), procname = update_u_ice ) -
branches/2016/dev_v3_6_STABLE_r6506_AGRIF_LIM3/NEMOGCM/NEMO/NST_SRC/agrif_user.F90
r7060 r7158 241 241 WRITE(cl_check2,*) NINT(rdt) 242 242 WRITE(cl_check3,*) NINT(Agrif_Parent(rdt)/Agrif_Rhot()) 243 CALL ctl_ warn( 'incompatible time step between grids', &243 CALL ctl_stop( 'incompatible time step between ocean grids', & 244 244 & 'parent grid value : '//cl_check1 , & 245 245 & 'child grid value : '//cl_check2 , & 246 & 'value on child grid will be changed to : '//cl_check3 ) 247 rdt=Agrif_Parent(rdt)/Agrif_Rhot() 246 & 'value on child grid should be changed to : '//cl_check3 ) 248 247 ENDIF 249 248 … … 565 564 !!---------------------------------------------------------------------- 566 565 USE Agrif_Util 566 USE sbc_oce, ONLY : nn_fsbc ! clem: necessary otherwise Agrif_Parent(nn_fsbc) = nn_fsbc 567 567 USE ice 568 568 USE agrif_ice … … 579 579 CALL agrif_declare_var_lim3 580 580 581 ! clem: reset nn_fsbc(child) to rhot if rhot * nn_fsbc(parent) /= N * nn_fsbc(child) with N being integer 581 ! Controls (clem) 582 ! stop if rhot * nn_fsbc(parent) /= N * nn_fsbc(child) with N being integer 582 583 IF( MOD( Agrif_irhot() * Agrif_Parent(nn_fsbc), nn_fsbc ) /= 0 ) THEN 583 nn_fsbc = Agrif_irhot() 584 CALL ctl_warn ('rhot * nn_fsbc(parent) /= N * nn_fsbc(child), therefore nn_fsbc(child) is set to rhot') 585 WRITE(*,*) 'New nn_fsbc(child) = ', nn_fsbc 584 CALL ctl_stop('rhot * nn_fsbc(parent) /= N * nn_fsbc(child), therefore nn_fsbc(child) should be set to 1 or nn_fsbc(parent)') 586 585 ENDIF 587 586 588 ! clem: reset update frequency if different from nn_fsbc 589 IF( nbclineupdate /= nn_fsbc ) THEN 590 nbclineupdate = nn_fsbc 591 CALL ctl_warn ('With ice model on child grid, nc_cln_update is set to nn_fsbc') 592 ENDIF 587 ! stop if update frequency is different from nn_fsbc 588 IF( nbclineupdate > nn_fsbc ) CALL ctl_stop('With ice model on child grid, nn_cln_update should be set to 1 or nn_fsbc') 589 593 590 594 591 ! First Interpolations (using "after" ice subtime step => lim_nbstep=1) … … 603 600 !---------------------- 604 601 CALL agrif_update_lim3(0) 602 605 603 ! 606 604 END SUBROUTINE Agrif_InitValues_cont_lim3 … … 613 611 !!---------------------------------------------------------------------- 614 612 USE Agrif_Util 615 USE Agrif_ice !clem useless ?616 613 USE ice 617 614 … … 703 700 WRITE(cl_check2,*) rdt 704 701 WRITE(cl_check3,*) rdt*Agrif_Rhot() 705 CALL ctl_ warn( 'incompatible time step between grids', &702 CALL ctl_stop( 'incompatible time step between grids', & 706 703 & 'parent grid value : '//cl_check1 , & 707 704 & 'child grid value : '//cl_check2 , & 708 & 'value on child grid willbe changed to &705 & 'value on child grid should be changed to & 709 706 & :'//cl_check3 ) 710 rdt=rdt*Agrif_Rhot()711 707 ENDIF 712 708 -
branches/2016/dev_v3_6_STABLE_r6506_AGRIF_LIM3/NEMOGCM/NEMO/OFF_SRC/domrea.F90
r5504 r7158 124 124 & nn_write, ln_dimgnnn, ln_mskland , ln_cfmeta , ln_clobber, nn_chunksz, nn_euler 125 125 NAMELIST/namdom/ nn_bathy , rn_bathy, rn_e3zps_min, rn_e3zps_rat, nn_msh , rn_hmin, & 126 & nn_acc , rn_atfp , rn_rdt , rn_rdtmin , & 127 & rn_rdtmax, rn_rdth , nn_baro , nn_closea , ln_crs, & 126 & rn_atfp , rn_rdt , nn_baro , nn_closea , ln_crs, & 128 127 & jphgr_msh, & 129 128 & ppglam0, ppgphi0, ppe1_deg, ppe2_deg, ppe1_m, ppe2_m, & … … 194 193 ! parameters correspondting to nit000 - 1 (as we start the step loop with a call to day) 195 194 ndastp = ndate0 - 1 ! ndate0 read in the namelist in dom_nam, we assume that we start run at 00:00 196 adatrj = ( REAL( nit000-1, wp ) * rdt tra(1)) / rday195 adatrj = ( REAL( nit000-1, wp ) * rdt ) / rday 197 196 198 197 #if defined key_agrif … … 239 238 WRITE(numout,*) ' asselin time filter parameter rn_atfp = ', rn_atfp 240 239 WRITE(numout,*) ' time-splitting: nb of sub time-step nn_baro = ', nn_baro 241 WRITE(numout,*) ' acceleration of converge nn_acc = ', nn_acc242 WRITE(numout,*) ' nn_acc=1: surface tracer rdt rn_rdtmin = ', rn_rdtmin243 WRITE(numout,*) ' bottom tracer rdt rdtmax = ', rn_rdtmax244 WRITE(numout,*) ' depth of transition rn_rdth = ', rn_rdth245 240 WRITE(numout,*) ' suppression of closed seas (=0) nn_closea = ', nn_closea 246 241 WRITE(numout,*) ' type of horizontal mesh jphgr_msh = ', jphgr_msh … … 268 263 e3zps_rat = rn_e3zps_rat 269 264 nmsh = nn_msh 270 nacc = nn_acc271 265 atfp = rn_atfp 272 266 rdt = rn_rdt 273 rdtmin = rn_rdtmin274 rdtmax = rn_rdtmin275 rdth = rn_rdth276 267 277 268 REWIND( numnam_ref ) ! Namelist namcla in reference namelist : Cross land advection -
branches/2016/dev_v3_6_STABLE_r6506_AGRIF_LIM3/NEMOGCM/NEMO/OPA_SRC/ASM/asminc.F90
r5540 r7158 208 208 ENDIF 209 209 210 IF ( nacc /= 0 ) &211 & CALL ctl_stop( ' nacc /= 0 and key_asminc :', &212 & ' Assimilation increments have only been implemented', &213 & ' for synchronous time stepping' )214 215 210 IF ( ( ln_asmdin ).AND.( ln_asmiau ) ) & 216 211 & CALL ctl_stop( ' ln_asmdin and ln_asmiau :', & -
branches/2016/dev_v3_6_STABLE_r6506_AGRIF_LIM3/NEMOGCM/NEMO/OPA_SRC/BDY/bdytides.F90
r5912 r7158 325 325 ENDIF 326 326 327 IF ( nsec_day == NINT(0.5_wp * rdt tra(1)) .AND. zflag==1 ) THEN327 IF ( nsec_day == NINT(0.5_wp * rdt) .AND. zflag==1 ) THEN 328 328 ! 329 329 kt_tide = kt … … 440 440 ! We refresh nodal factors every day below 441 441 ! This should be done somewhere else 442 IF ( nsec_day == NINT(0.5_wp * rdt tra(1)) .AND. lk_first_btstp ) THEN442 IF ( nsec_day == NINT(0.5_wp * rdt) .AND. lk_first_btstp ) THEN 443 443 ! 444 444 kt_tide = kt -
branches/2016/dev_v3_6_STABLE_r6506_AGRIF_LIM3/NEMOGCM/NEMO/OPA_SRC/C1D/domc1d.F90
r5215 r7158 44 44 !!---------------------------------------------------------------------- 45 45 NAMELIST/namdom/ nn_bathy, rn_bathy , rn_e3zps_min, rn_e3zps_rat, nn_msh, rn_hmin, & 46 & nn_acc , rn_atfp , rn_rdt , rn_rdtmin , & 47 & rn_rdtmax, rn_rdth , nn_closea , ln_crs, & 46 & rn_atfp , rn_rdt , nn_closea , ln_crs, & 48 47 & jphgr_msh, & 49 48 & ppglam0, ppgphi0, ppe1_deg, ppe2_deg, ppe1_m, ppe2_m, & -
branches/2016/dev_v3_6_STABLE_r6506_AGRIF_LIM3/NEMOGCM/NEMO/OPA_SRC/DIA/diafwb.F90
r5506 r7158 116 116 117 117 ! Conversion in m3 118 a_fwf = a_fwf * rdt tra(1)* 1.e-3118 a_fwf = a_fwf * rdt * 1.e-3 119 119 120 120 ! fwf correction to bring back the mean ssh to zero … … 404 404 WRITE(inum,*) 405 405 WRITE(inum,*) 'Net freshwater budget ' 406 WRITE(inum,9010) ' fwf = ',a_fwf, ' m3 =', a_fwf /(FLOAT(nitend-nit000+1)*rdt tra(1)) * 1.e-6,' Sv'406 WRITE(inum,9010) ' fwf = ',a_fwf, ' m3 =', a_fwf /(FLOAT(nitend-nit000+1)*rdt) * 1.e-6,' Sv' 407 407 WRITE(inum,*) 408 408 WRITE(inum,9010) ' zarea =',zarea -
branches/2016/dev_v3_6_STABLE_r6506_AGRIF_LIM3/NEMOGCM/NEMO/OPA_SRC/DIA/dianam.F90
r2528 r7158 71 71 ENDIF 72 72 73 IF( llfsec .OR. kfreq < 0 ) THEN ; inbsec = kfreq 74 ELSE ; inbsec = kfreq * NINT( rdt tra(1)) ! from time-step to seconds73 IF( llfsec .OR. kfreq < 0 ) THEN ; inbsec = kfreq ! output frequency already in seconds 74 ELSE ; inbsec = kfreq * NINT( rdt ) ! from time-step to seconds 75 75 ENDIF 76 76 iddss = NINT( rday ) ! number of seconds in 1 day … … 116 116 ! date of the beginning and the end of the run 117 117 118 zdrun = rdt tra(1) / rday * REAL( nitend - nit000, wp )! length of the run in days119 zjul = fjulday - rdt tra(1)/ rday118 zdrun = rdt / rday * REAL( nitend - nit000, wp ) ! length of the run in days 119 zjul = fjulday - rdt / rday 120 120 CALL ju2ymds( zjul , iyear1, imonth1, iday1, zsec1 ) ! year/month/day of the beginning of run 121 121 CALL ju2ymds( zjul + zdrun, iyear2, imonth2, iday2, zsec2 ) ! year/month/day of the end of run -
branches/2016/dev_v3_6_STABLE_r6506_AGRIF_LIM3/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90
r6348 r7158 447 447 ! Define frequency of output and means 448 448 zdt = rdt 449 IF( nacc == 1 ) zdt = rdtmin450 449 clop = "x" ! no use of the mask value (require less cpu time, and otherwise the model crashes) 451 450 #if defined key_diainstant -
branches/2016/dev_v3_6_STABLE_r6506_AGRIF_LIM3/NEMOGCM/NEMO/OPA_SRC/DOM/daymod.F90
r5564 r7158 20 20 !! 21 21 !! we suppose that the time step is deviding the number of second of in a day 22 !! ---> MOD( rday, rdt tra(1)) == 022 !! ---> MOD( rday, rdt ) == 0 23 23 !! 24 24 !! ----------- WARNING ----------- … … 78 78 & 'You must do a restart at higher frequency (or remove this stop and recompile the code in I8)' ) 79 79 ENDIF 80 ! all calendar staff is based on the fact that MOD( rday, rdt tra(1)) == 081 IF( MOD( rday , rdt tra(1)) /= 0. ) CALL ctl_stop( 'the time step must devide the number of second of in a day' )82 IF( MOD( rday , 2. 83 IF( MOD( rdt tra(1), 2.) /= 0. ) CALL ctl_stop( 'the time step (in second) must be an even number' )84 nsecd = NINT(rday 85 nsecd05 = NINT(0.5 * rday 86 ndt = NINT( rdt tra(1))87 ndt05 = NINT(0.5 * rdt tra(1))80 ! all calendar staff is based on the fact that MOD( rday, rdt ) == 0 81 IF( MOD( rday , rdt ) /= 0. ) CALL ctl_stop( 'the time step must devide the number of second of in a day' ) 82 IF( MOD( rday , 2. ) /= 0. ) CALL ctl_stop( 'the number of second of in a day must be an even number' ) 83 IF( MOD( rdt , 2. ) /= 0. ) CALL ctl_stop( 'the time step (in second) must be an even number' ) 84 nsecd = NINT(rday ) 85 nsecd05 = NINT(0.5 * rday ) 86 ndt = NINT( rdt ) 87 ndt05 = NINT(0.5 * rdt ) 88 88 89 89 IF( .NOT. lk_offline ) CALL day_rst( nit000, 'READ' ) … … 223 223 nsec_week = nsec_week + ndt 224 224 nsec_day = nsec_day + ndt 225 adatrj = adatrj + rdt tra(1)/ rday226 fjulday = fjulday + rdt tra(1)/ rday225 adatrj = adatrj + rdt / rday 226 fjulday = fjulday + rdt / rday 227 227 IF( ABS(fjulday - REAL(NINT(fjulday),wp)) < zprec ) fjulday = REAL(NINT(fjulday),wp) ! avoid truncation error 228 228 IF( ABS(adatrj - REAL(NINT(adatrj ),wp)) < zprec ) adatrj = REAL(NINT(adatrj ),wp) ! avoid truncation error … … 334 334 ! parameters correspondting to nit000 - 1 (as we start the step loop with a call to day) 335 335 ndastp = ndate0 - 1 ! ndate0 read in the namelist in dom_nam, we assume that we start run at 00:00 336 adatrj = ( REAL( nit000-1, wp ) * rdt tra(1)) / rday336 adatrj = ( REAL( nit000-1, wp ) * rdt ) / rday 337 337 ! note this is wrong if time step has changed during run 338 338 ENDIF … … 340 340 ! parameters correspondting to nit000 - 1 (as we start the step loop with a call to day) 341 341 ndastp = ndate0 - 1 ! ndate0 read in the namelist in dom_nam, we assume that we start run at 00:00 342 adatrj = ( REAL( nit000-1, wp ) * rdt tra(1)) / rday342 adatrj = ( REAL( nit000-1, wp ) * rdt ) / rday 343 343 ENDIF 344 344 IF( ABS(adatrj - REAL(NINT(adatrj),wp)) < 0.1 / rday ) adatrj = REAL(NINT(adatrj),wp) ! avoid truncation error -
branches/2016/dev_v3_6_STABLE_r6506_AGRIF_LIM3/NEMOGCM/NEMO/OPA_SRC/DOM/dom_oce.F90
r6796 r7158 35 35 REAL(wp), PUBLIC :: rn_e3zps_rat !: minimum thickness ration for partial steps 36 36 INTEGER , PUBLIC :: nn_msh !: = 1 create a mesh-mask file 37 INTEGER , PUBLIC :: nn_acc !: = 0/1 use of the acceleration of convergence technique38 37 REAL(wp), PUBLIC :: rn_atfp !: asselin time filter parameter 39 38 REAL(wp), PUBLIC :: rn_rdt !: time step for the dynamics (and tracer if nacc=0) 40 REAL(wp), PUBLIC :: rn_rdtmin !: minimum time step on tracers41 REAL(wp), PUBLIC :: rn_rdtmax !: maximum time step on tracers42 REAL(wp), PUBLIC :: rn_rdth !: depth variation of tracer step43 39 INTEGER , PUBLIC :: nn_closea !: =0 suppress closed sea/lake from the ORCA domain or not (=1) 44 40 INTEGER , PUBLIC :: nn_euler !: =0 start with forward time step or not (=1) … … 94 90 REAL(wp), PUBLIC :: e3zps_rat !: minimum thickness ration for partial steps 95 91 INTEGER , PUBLIC :: nmsh !: = 1 create a mesh-mask file 96 INTEGER , PUBLIC :: nacc !: = 0/1 use of the acceleration of convergence technique97 92 REAL(wp), PUBLIC :: atfp !: asselin time filter parameter 98 93 REAL(wp), PUBLIC :: rdt !: time step for the dynamics (and tracer if nacc=0) 99 REAL(wp), PUBLIC :: rdtmin !: minimum time step on tracers100 REAL(wp), PUBLIC :: rdtmax !: maximum time step on tracers101 REAL(wp), PUBLIC :: rdth !: depth variation of tracer step102 94 103 95 ! !!! associated variables 104 96 INTEGER , PUBLIC :: neuler !: restart euler forward option (0=Euler) 105 97 REAL(wp), PUBLIC :: atfp1 !: asselin time filter coeff. (atfp1= 1-2*atfp) 106 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: rdttra !: vertical profile of tracer time step 107 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: r2dtra !: = 2*rdttra except at nit000 (=rdttra) if neuler=0 98 REAL(wp), PUBLIC :: r2dt !: = 2*rdt except at nit000 (=rdt) if neuler=0 108 99 109 100 ! !!* Namelist namcla : cross land advection … … 338 329 ierr(:) = 0 339 330 ! 340 ALLOCATE( rdttra(jpk), r2dtra(jpk),mig(jpi), mjg(jpj), nfiimpp(jpni,jpnj), &331 ALLOCATE( mig(jpi), mjg(jpj), nfiimpp(jpni,jpnj), & 341 332 & nfipproc(jpni,jpnj), nfilcit(jpni,jpnj), STAT=ierr(1) ) 342 333 ! -
branches/2016/dev_v3_6_STABLE_r6506_AGRIF_LIM3/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90
r5363 r7158 140 140 & nn_write, ln_dimgnnn, ln_mskland , ln_cfmeta , ln_clobber, nn_chunksz, nn_euler 141 141 NAMELIST/namdom/ nn_bathy, rn_bathy , rn_e3zps_min, rn_e3zps_rat, nn_msh, rn_hmin, & 142 & nn_acc , rn_atfp , rn_rdt , rn_rdtmin , & 143 & rn_rdtmax, rn_rdth , nn_closea , ln_crs, & 142 & rn_atfp , rn_rdt , nn_closea , ln_crs, & 144 143 & jphgr_msh, & 145 144 & ppglam0, ppgphi0, ppe1_deg, ppe2_deg, ppe1_m, ppe2_m, & … … 268 267 WRITE(numout,*) ' ocean time step rn_rdt = ', rn_rdt 269 268 WRITE(numout,*) ' asselin time filter parameter rn_atfp = ', rn_atfp 270 WRITE(numout,*) ' acceleration of converge nn_acc = ', nn_acc271 WRITE(numout,*) ' nn_acc=1: surface tracer rdt rn_rdtmin = ', rn_rdtmin272 WRITE(numout,*) ' bottom tracer rdt rdtmax = ', rn_rdtmax273 WRITE(numout,*) ' depth of transition rn_rdth = ', rn_rdth274 269 WRITE(numout,*) ' suppression of closed seas (=0) nn_closea = ', nn_closea 275 270 WRITE(numout,*) ' online coarsening of dynamical fields ln_crs = ', ln_crs … … 298 293 e3zps_rat = rn_e3zps_rat 299 294 nmsh = nn_msh 300 nacc = nn_acc301 295 atfp = rn_atfp 302 296 rdt = rn_rdt 303 rdtmin = rn_rdtmin304 rdtmax = rn_rdtmin305 rdth = rn_rdth306 297 307 298 REWIND( numnam_ref ) ! Namelist namcla in reference namelist : Cross land advection -
branches/2016/dev_v3_6_STABLE_r6506_AGRIF_LIM3/NEMOGCM/NEMO/OPA_SRC/DOM/domhgr.F90
r7069 r7158 463 463 gphi0 = 0._wp 464 464 465 #if defined key_agrif 466 IF( .NOT. Agrif_Root() ) THEN 467 glam0 = Agrif_Parent(glam0) + (Agrif_ix())*Agrif_Parent(ppe1_m) * 1.e-5 468 gphi0 = Agrif_Parent(gphi0) + (Agrif_iy())*Agrif_Parent(ppe2_m) * 1.e-5 469 ppe1_m = Agrif_Parent(ppe1_m)/Agrif_Rhox() 470 ppe2_m = Agrif_Parent(ppe2_m)/Agrif_Rhoy() 471 ENDIF 472 #endif 473 465 474 DO jj = 1, jpj 466 475 DO ji = 1, jpi … … 484 493 ! Horizontal scale factors (in meters) 485 494 ! ====== 495 !! ==> EITHER 1) variable scale factors 486 496 DO jj = 1, jpj 487 497 DO ji = 1, jpi 488 e1t(ji,jj) = ppe1_m * EXP(-0.8/REAL(jpiglo**2)*(mi0(ji)-REAL(jpiglo+1)*0.5)**2) 489 e2t(ji,jj) = ppe2_m * EXP(-0.8/REAL(jpjglo**2)*(mj0(jj)-REAL(jpjglo+1)*0.5)**2) 498 !!e1t(ji,jj) = ppe1_m * EXP( -0.8/REAL(jpiglo**2) * (mi0(ji)-REAL(jpiglo+1)*0.5)**2 ) ! gaussian shape 499 !!e2t(ji,jj) = ppe2_m * EXP( -0.8/REAL(jpjglo**2) * (mj0(jj)-REAL(jpjglo+1)*0.5)**2 ) ! gaussian shape 500 e1t(ji,jj) = ppe1_m * ( 1. -0.1 * ABS(REAL(mi0(ji))-REAL(jpiglo+1)*0.5) / (1.-REAL(jpiglo+1)*0.5) ) ! linear shape 501 e2t(ji,jj) = ppe2_m * ( 1. -0.1 * ABS(REAL(mj0(jj))-REAL(jpjglo+1)*0.5) / (1.-REAL(jpjglo+1)*0.5) ) ! linear shape 490 502 END DO 491 503 END DO 504 #if defined key_agrif 505 IF( .NOT. Agrif_Root() ) THEN ! only works if the zoom is positioned at the center of the parent grid 506 DO jj = 1, jpj 507 DO ji = 1, jpi 508 e1t(ji,jj) = ppe1_m * ( 1. -0.1 * ABS(REAL(mi0(ji))-REAL(jpiglo+1)*0.5) / (1.-REAL(jpiglo+1)*0.5) & 509 & * REAL(jpiglo) / REAL(Agrif_Parent(jpiglo) * Agrif_Rhox()) ) ! factor to match parent grid 510 e2t(ji,jj) = ppe2_m * ( 1. -0.1 * ABS(REAL(mj0(jj))-REAL(jpjglo+1)*0.5) / (1.-REAL(jpjglo+1)*0.5) & 511 & * REAL(jpjglo) / REAL(Agrif_Parent(jpjglo) * Agrif_Rhoy()) ) ! factor to match parent grid 512 END DO 513 END DO 514 ENDIF 515 #endif 516 !! ==> OR 2) constant scale factors 517 e1t(:,:) = ppe1_m 518 e2t(:,:) = ppe2_m 519 492 520 e1u(:,:) = e1t(:,:) ; e2u(:,:) = e2t(:,:) 493 521 e1v(:,:) = e1t(:,:) ; e2v(:,:) = e2t(:,:) -
branches/2016/dev_v3_6_STABLE_r6506_AGRIF_LIM3/NEMOGCM/NEMO/OPA_SRC/DOM/domstp.F90
r4292 r7158 34 34 !!---------------------------------------------------------------------- 35 35 !! *** ROUTINE dom_stp *** 36 !! 36 !! 37 37 !! ** Purpose : Intialize ocean time step for the run 38 38 !! … … 41 41 !! filter parameter read in namelist 42 42 !! - Model time step: 43 !! nacc = 0 : synchronous time intergration. 44 !! There is one time step only, defined by: rdt, rdttra(k)=rdt 45 !! nacc = 1 : accelerating the convergence. There is 2 different 46 !! time steps for dynamics and tracers: 47 !! rdt : dynamical part 48 !! rdttra(k): temperature and salinity 49 !! The tracer time step is a function of vertical level. the model 50 !! reference time step ( i.e. for wind stress, surface heat and 51 !! salt fluxes) is the surface tracer time step is rdttra(1). 52 !! N.B. depth dependent acceleration of convergence is not im- 53 !! plemented for s-coordinate. 43 !! synchronous time intergration. 44 !! There is one time step only, defined by: rdt for dynamics and 45 !! tracer,wind stress, surface heat and salt fluxes 54 46 !! 55 !! ** Action : - rdttra : vertical profile of tracer time step47 !! ** Action : [REMOVED - rdttra: vertical profile of tracer time step] 56 48 !! - atfp1 : = 1 - 2*atfp 57 49 !! … … 72 64 atfp1 = 1. - 2. * atfp 73 65 74 SELECT CASE ( nacc ) 66 IF(lwp) WRITE(numout,*)' synchronous time stepping' 67 IF(lwp) WRITE(numout,*)' dynamics and tracer time step = ',rdt/3600., ' hours' 75 68 76 CASE ( 0 ) ! Synchronous time stepping77 IF(lwp) WRITE(numout,*)' synchronous time stepping'78 IF(lwp) WRITE(numout,*)' dynamics and tracer time step = ', rdt/3600., ' hours'79 80 rdttra(:) = rdt81 82 CASE ( 1 ) ! Accelerating the convergence83 IF(lwp) WRITE(numout,*) ' no tracer damping in the turbocline'84 IF(lwp) WRITE(numout,*)' accelerating the convergence'85 IF(lwp) WRITE(numout,*)' dynamics time step = ', rdt/3600., ' hours'86 IF( ln_sco .AND. rdtmin /= rdtmax .AND. lk_vvl ) &87 & CALL ctl_stop ( ' depth dependent acceleration of convergence not implemented in s-coordinates &88 & nor in variable volume' )89 IF(lwp) WRITE(numout,*)' tracers time step : dt (hours) level'90 91 DO jk = 1, jpk92 IF( gdept_1d(jk) <= rdth ) rdttra(jk) = rdtmin93 IF( gdept_1d(jk) > rdth ) THEN94 rdttra(jk) = rdtmin + ( rdtmax - rdtmin ) &95 * ( EXP( ( gdept_1d(jk ) - rdth ) / rdth ) - 1. ) &96 / ( EXP( ( gdept_1d(jpk) - rdth ) / rdth ) - 1. )97 ENDIF98 IF(lwp) WRITE(numout,"(36x,f5.2,5x,i3)") rdttra(jk)/3600., jk99 END DO100 101 CASE DEFAULT ! E R R O R102 103 WRITE(ctmp1,*) ' nacc value e r r o r, nacc= ',nacc104 CALL ctl_stop( ctmp1 )105 106 END SELECT107 69 108 70 END SUBROUTINE dom_stp -
branches/2016/dev_v3_6_STABLE_r6506_AGRIF_LIM3/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf.F90
r4990 r7158 35 35 36 36 INTEGER :: nzdf = 0 ! type vertical diffusion algorithm used, defined from ln_zdf... namlist logicals 37 REAL(wp) :: r2dt ! time-step, = 2 rdttra except at nit000 (=rdttra) if neuler=038 37 39 38 !! * Substitutions … … 65 64 ! ! set time step 66 65 IF( neuler == 0 .AND. kt == nit000 ) THEN ; r2dt = rdt ! = rdtra (restart with Euler time stepping) 67 ELSEIF( kt <= nit000 + 1 ) THEN ; r2dt = 2. * rdt ! = 2 rdt tra(leapfrog)66 ELSEIF( kt <= nit000 + 1 ) THEN ; r2dt = 2. * rdt ! = 2 rdt (leapfrog) 68 67 ENDIF 69 68 -
branches/2016/dev_v3_6_STABLE_r6506_AGRIF_LIM3/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90
r7069 r7158 1813 1813 idx = INDEX(clname,'@startdate@') + INDEX(clname,'@STARTDATE@') 1814 1814 DO WHILE ( idx /= 0 ) 1815 cldate = iom_sdate( fjulday - rdt tra(1)/ rday )1815 cldate = iom_sdate( fjulday - rdt / rday ) 1816 1816 clname = clname(1:idx-1)//TRIM(cldate)//clname(idx+11:LEN_TRIM(clname)) 1817 1817 idx = INDEX(clname,'@startdate@') + INDEX(clname,'@STARTDATE@') … … 1820 1820 idx = INDEX(clname,'@startdatefull@') + INDEX(clname,'@STARTDATEFULL@') 1821 1821 DO WHILE ( idx /= 0 ) 1822 cldate = iom_sdate( fjulday - rdt tra(1)/ rday, ldfull = .TRUE. )1822 cldate = iom_sdate( fjulday - rdt / rday, ldfull = .TRUE. ) 1823 1823 clname = clname(1:idx-1)//TRIM(cldate)//clname(idx+15:LEN_TRIM(clname)) 1824 1824 idx = INDEX(clname,'@startdatefull@') + INDEX(clname,'@STARTDATEFULL@') … … 1827 1827 idx = INDEX(clname,'@enddate@') + INDEX(clname,'@ENDDATE@') 1828 1828 DO WHILE ( idx /= 0 ) 1829 cldate = iom_sdate( fjulday + rdt tra(1)/ rday * REAL( nitend - nit000, wp ), ld24 = .TRUE. )1829 cldate = iom_sdate( fjulday + rdt / rday * REAL( nitend - nit000, wp ), ld24 = .TRUE. ) 1830 1830 clname = clname(1:idx-1)//TRIM(cldate)//clname(idx+9:LEN_TRIM(clname)) 1831 1831 idx = INDEX(clname,'@enddate@') + INDEX(clname,'@ENDDATE@') … … 1834 1834 idx = INDEX(clname,'@enddatefull@') + INDEX(clname,'@ENDDATEFULL@') 1835 1835 DO WHILE ( idx /= 0 ) 1836 cldate = iom_sdate( fjulday + rdt tra(1)/ rday * REAL( nitend - nit000, wp ), ld24 = .TRUE., ldfull = .TRUE. )1836 cldate = iom_sdate( fjulday + rdt / rday * REAL( nitend - nit000, wp ), ld24 = .TRUE., ldfull = .TRUE. ) 1837 1837 clname = clname(1:idx-1)//TRIM(cldate)//clname(idx+13:LEN_TRIM(clname)) 1838 1838 idx = INDEX(clname,'@enddatefull@') + INDEX(clname,'@ENDDATEFULL@') -
branches/2016/dev_v3_6_STABLE_r6506_AGRIF_LIM3/NEMOGCM/NEMO/OPA_SRC/IOM/restart.F90
r5407 r7158 123 123 !!---------------------------------------------------------------------- 124 124 125 CALL iom_rstput( kt, nitrst, numrow, 'rdt' , rdt ) ! dynamics time step 126 CALL iom_rstput( kt, nitrst, numrow, 'rdttra1', rdttra(1) ) ! surface tracer time step 125 CALL iom_rstput( kt, nitrst, numrow, 'rdt' , rdt ) ! dynamics and tracer time step 127 126 128 127 CALL iom_rstput( kt, nitrst, numrow, 'ub' , ub ) ! before fields … … 205 204 !! ** Method : Read in restart.nc file fields which are necessary for restart 206 205 !!---------------------------------------------------------------------- 207 REAL(wp) :: zrdt , zrdttra1206 REAL(wp) :: zrdt 208 207 INTEGER :: jk 209 208 LOGICAL :: llok … … 216 215 CALL iom_get( numror, 'rdt', zrdt ) 217 216 IF( zrdt /= rdt ) neuler = 0 218 ENDIF219 IF( iom_varid( numror, 'rdttra1', ldstop = .FALSE. ) > 0 ) THEN220 CALL iom_get( numror, 'rdttra1', zrdttra1 )221 IF( zrdttra1 /= rdttra(1) ) neuler = 0222 217 ENDIF 223 218 ! -
branches/2016/dev_v3_6_STABLE_r6506_AGRIF_LIM3/NEMOGCM/NEMO/OPA_SRC/SBC/fldread.F90
r6204 r7158 166 166 isecsbc = nsec_year + nsec1jan000 + (kit+it_offset)*NINT( rdt/REAL(nn_baro,wp) ) 167 167 ELSE ! middle of sbc time step 168 isecsbc = nsec_year + nsec1jan000 + NINT(0.5 * REAL(kn_fsbc - 1,wp) * rdt tra(1)) + it_offset * NINT(rdttra(1))168 isecsbc = nsec_year + nsec1jan000 + NINT(0.5 * REAL(kn_fsbc - 1,wp) * rdt) + it_offset * NINT(rdt) 169 169 ENDIF 170 170 imf = SIZE( sd ) … … 193 193 CALL fld_rec( kn_fsbc, sd(jf), kt_offset = it_offset, kit = kit ) ! update after record informations 194 194 195 ! if kn_fsbc*rdt trais larger than nfreqh (which is kind of odd),195 ! if kn_fsbc*rdt is larger than nfreqh (which is kind of odd), 196 196 ! it is possible that the before value is no more the good one... we have to re-read it 197 197 ! if before is not the last record of the file currently opened and after is the first record to be read … … 214 214 IF( sd(jf)%ln_tint ) THEN 215 215 216 ! if kn_fsbc*rdt trais larger than nfreqh (which is kind of odd),216 ! if kn_fsbc*rdt is larger than nfreqh (which is kind of odd), 217 217 ! it is possible that the before value is no more the good one... we have to re-read it 218 218 ! if before record is not just just before the after record... … … 245 245 ! year/month/week/day file to be not present. If the run continue further than the current 246 246 ! year/month/week/day, next year/month/week/day file must exist 247 isecend = nsec_year + nsec1jan000 + (nitend - kt) * NINT(rdt tra(1)) ! second at the end of the run247 isecend = nsec_year + nsec1jan000 + (nitend - kt) * NINT(rdt) ! second at the end of the run 248 248 llstop = isecend > sd(jf)%nrec_a(2) ! read more than 1 record of next year 249 249 ! we suppose that the date of next file is next day (should be ok even for weekly files...) … … 460 460 IF( PRESENT(kt_offset) ) it_offset = kt_offset 461 461 IF( PRESENT(kit) ) THEN ; it_offset = ( kit + it_offset ) * NINT( rdt/REAL(nn_baro,wp) ) 462 ELSE ; it_offset = it_offset * NINT( rdt tra(1))462 ELSE ; it_offset = it_offset * NINT( rdt ) 463 463 ENDIF 464 464 ! … … 537 537 ELSE ; ztmp = REAL(nsec_year ,wp) ! since 00h on Jan 1 of the current year 538 538 ENDIF 539 ztmp = ztmp + 0.5 * REAL(kn_fsbc - 1, wp) * rdt tra(1)+ REAL( it_offset, wp ) ! centrered in the middle of sbc time step540 ztmp = ztmp + 0.01 * rdt tra(1)! avoid truncation error539 ztmp = ztmp + 0.5 * REAL(kn_fsbc - 1, wp) * rdt + REAL( it_offset, wp ) ! centrered in the middle of sbc time step 540 ztmp = ztmp + 0.01 * rdt ! avoid truncation error 541 541 IF( sdjf%ln_tint ) THEN ! time interpolation, shift by 1/2 record 542 542 ! -
branches/2016/dev_v3_6_STABLE_r6506_AGRIF_LIM3/NEMOGCM/NEMO/OPA_SRC/SBC/sbcana.F90
r7077 r7158 4 4 !! Ocean forcing: analytical momentum, heat and freshwater forcings 5 5 !!===================================================================== 6 !! History : 3.0 ! 2006-06 (G. Madec) Original code 7 !! 3.2 ! 2009-07 (G. Madec) Style only 6 !! History : 3.0 ! 2006-06 (G. Madec) Original code 7 !! 3.2 ! 2009-07 (G. Madec) Style only 8 !! 3.7 ! 2016-10 (C. Rousset) Add analytic for LIM3 (ana_ice) 8 9 !!---------------------------------------------------------------------- 9 10 … … 193 194 194 195 ! ice variables deduced from above 195 zsnw(:,:) = 0._wp196 CALL lim_thd_snwblow( pfrld, zsnw ) ! snow distribution over ice after wind blowing197 emp_ice (:,:) = SUM( a_i_b(:,:,:) * evap_ice(:,:,:), dim=3 ) - sprecip(:,:) * zsnw 198 emp_oce (:,:) = emp_oce(:,:) - sprecip(:,:) * (1._wp - zsnw )196 zsnw(:,:) = 1._wp 197 !!CALL lim_thd_snwblow( pfrld, zsnw ) ! snow distribution over ice after wind blowing 198 emp_ice (:,:) = SUM( a_i_b(:,:,:) * evap_ice(:,:,:), dim=3 ) - sprecip(:,:) * zsnw(:,:) 199 emp_oce (:,:) = emp_oce(:,:) - sprecip(:,:) * (1._wp - zsnw(:,:) ) 199 200 qevap_ice(:,:,:) = 0._wp 200 201 qprec_ice(:,:) = rhosn * ( sst_m(:,:) * cpic - lfus ) * tmask(:,:,1) ! in J/m3 -
branches/2016/dev_v3_6_STABLE_r6506_AGRIF_LIM3/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90
r6970 r7158 844 844 LOGICAL :: llnewtx, llnewtau ! update wind stress components and module?? 845 845 INTEGER :: ji, jj, jn ! dummy loop indices 846 INTEGER :: isec ! number of seconds since nit000 (assuming rdt tradid not change since nit000)846 INTEGER :: isec ! number of seconds since nit000 (assuming rdt did not change since nit000) 847 847 REAL(wp) :: zcumulneg, zcumulpos ! temporary scalars 848 848 REAL(wp) :: zcoef ! temporary scalar … … 862 862 ! ! Receive all the atmos. fields (including ice information) 863 863 ! ! ======================================================= ! 864 isec = ( kt - nit000 ) * NINT( rdt tra(1) )! date of exchanges864 isec = ( kt - nit000 ) * NINT( rdt ) ! date of exchanges 865 865 DO jn = 1, jprcv ! received fields sent by the atmosphere 866 866 IF( srcv(jn)%laction ) CALL cpl_rcv( jn, isec, frcv(jn)%z3, xcplmask(:,:,1:nn_cplmodel), nrcvinfo(jn) ) … … 1770 1770 CALL wrk_alloc( jpi,jpj,jpl, ztmp3, ztmp4 ) 1771 1771 1772 isec = ( kt - nit000 ) * NINT(rdt tra(1)) ! date of exchanges1772 isec = ( kt - nit000 ) * NINT(rdt) ! date of exchanges 1773 1773 1774 1774 zfr_l(:,:) = 1.- fr_i(:,:) -
branches/2016/dev_v3_6_STABLE_r6506_AGRIF_LIM3/NEMOGCM/NEMO/OPA_SRC/SBC/sbcdcy.F90
r3764 r7158 90 90 91 91 ! When are we during the day (from 0 to 1) 92 zlo = ( REAL(nsec_day, wp) - 0.5_wp * rdt tra(1)) / rday93 zup = zlo + ( REAL(nn_fsbc, wp) * rdt tra(1)) / rday92 zlo = ( REAL(nsec_day, wp) - 0.5_wp * rdt ) / rday 93 zup = zlo + ( REAL(nn_fsbc, wp) * rdt ) / rday 94 94 ! 95 95 IF( nday_qsr == -1 ) THEN ! first time step only … … 189 189 END DO 190 190 ! 191 ztmp = rday / ( rdt tra(1)* REAL(nn_fsbc, wp) )191 ztmp = rday / ( rdt * REAL(nn_fsbc, wp) ) 192 192 rscal(:,:) = rscal(:,:) * ztmp 193 193 ! -
branches/2016/dev_v3_6_STABLE_r6506_AGRIF_LIM3/NEMOGCM/NEMO/OPA_SRC/SBC/sbcfwb.F90
r5628 r7158 129 129 ENDIF 130 130 ! ! Update fwfold if new year start 131 ikty = 365 * 86400 / rdt tra(1)!!bug use of 365 days leap year or 360d year !!!!!!!131 ikty = 365 * 86400 / rdt !!bug use of 365 days leap year or 360d year !!!!!!! 132 132 IF( MOD( kt, ikty ) == 0 ) THEN 133 133 a_fwb_b = a_fwb ! mean sea level taking into account the ice+snow -
branches/2016/dev_v3_6_STABLE_r6506_AGRIF_LIM3/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim.F90
r7077 r7158 132 132 133 133 # if defined key_agrif 134 IF( .NOT. Agrif_Root() ) THEN 135 lim_nbstep = MOD( lim_nbstep, Agrif_irhot() * Agrif_Parent(nn_fsbc) / nn_fsbc ) + 1 136 ENDIF 134 IF( .NOT. Agrif_Root() ) lim_nbstep = MOD( lim_nbstep, Agrif_irhot() * Agrif_Parent(nn_fsbc) / nn_fsbc ) + 1 137 135 # endif 138 136 … … 180 178 CALL lim_rst_opn( kt ) ! Open Ice restart file 181 179 ! 182 #if defined key_agrif183 IF( .NOT. Agrif_Root() ) CALL agrif_interp_lim3('T')184 #endif185 180 ! --- zap this if no ice dynamics --- ! 186 181 IF( .NOT. lk_c1d .AND. ln_limdyn ) THEN … … 201 196 ! --- 202 197 #if defined key_agrif 203 IF( .NOT. Agrif_Root() )CALL agrif_interp_lim3('T')198 IF( .NOT. Agrif_Root() ) CALL agrif_interp_lim3('T') 204 199 #endif 205 200 #if defined key_bdy … … 270 265 CALL lim_var_agg( 2 ) ! necessary calls (at least for coupling) 271 266 ! 267 # if defined key_agrif 268 !! IF( .NOT. Agrif_Root() ) CALL Agrif_ChildGrid_To_ParentGrid() ! clem: should be called at the update frequency only (cf agrif_lim3_update) 269 # endif 272 270 CALL lim_sbc_flx( kt ) ! -- Update surface ocean mass, heat and salt fluxes 273 ! 271 # if defined key_agrif 272 !! IF( .NOT. Agrif_Root() ) CALL Agrif_ParentGrid_To_ChildGrid() ! clem: should be called at the update frequency only (cf agrif_lim3_update) 273 # endif 274 274 IF( ln_limdiahsb ) CALL lim_diahsb( kt ) ! -- Diagnostics and outputs 275 275 ! … … 438 438 ! 439 439 ! sea-ice timestep and inverse 440 rdt_ice = nn_fsbc * rdttra(1)440 rdt_ice = REAL(nn_fsbc) * rdt 441 441 r1_rdtice = 1._wp / rdt_ice 442 442 … … 448 448 IF( lwp .AND. ln_limdiachk ) CALL ctl_warn('online conservation check activated but it does not work with BDY') 449 449 #endif 450 ! 451 IF( lwp ) WRITE(numout,*) ' ice timestep rdt_ice = ', rdt_ice 450 452 ! 451 453 END SUBROUTINE ice_run -
branches/2016/dev_v3_6_STABLE_r6506_AGRIF_LIM3/NEMOGCM/NEMO/OPA_SRC/SBC/sbctide.F90
r5215 r7158 49 49 !!---------------------------------------------------------------------- 50 50 51 IF( nsec_day == NINT(0.5_wp * rdt tra(1)) ) THEN ! start a new day51 IF( nsec_day == NINT(0.5_wp * rdt) ) THEN ! start a new day 52 52 ! 53 53 IF( kt == nit000 ) THEN -
branches/2016/dev_v3_6_STABLE_r6506_AGRIF_LIM3/NEMOGCM/NEMO/OPA_SRC/TRA/traadv.F90
r5147 r7158 86 86 ! ! set time step 87 87 IF( neuler == 0 .AND. kt == nit000 ) THEN ! at nit000 88 r2dt ra(:) = rdttra(:) ! = rdtra(restarting with Euler time stepping)88 r2dt = rdt ! = rdt (restarting with Euler time stepping) 89 89 ELSEIF( kt <= nit000 + 1) THEN ! at nit000 or nit000+1 90 r2dt ra(:) = 2._wp * rdttra(:) ! = 2 rdttra(leapfrog)90 r2dt = 2._wp * rdt ! = 2 rdt (leapfrog) 91 91 ENDIF 92 92 ! … … 122 122 123 123 SELECT CASE ( nadv ) !== compute advection trend and add it to general trend ==! 124 CASE ( 1 ) ; CALL tra_adv_cen2 ( kt, nit000, 'TRA', 125 CASE ( 2 ) ; CALL tra_adv_tvd ( kt, nit000, 'TRA', r2dt ra, zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! TVD126 CASE ( 3 ) ; CALL tra_adv_muscl ( kt, nit000, 'TRA', r2dt ra, zun, zvn, zwn, tsb, tsa, jpts, ln_traadv_msc_ups ) ! MUSCL127 CASE ( 4 ) ; CALL tra_adv_muscl2 ( kt, nit000, 'TRA', r2dt ra, zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! MUSCL2128 CASE ( 5 ) ; CALL tra_adv_ubs ( kt, nit000, 'TRA', r2dt ra, zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! UBS129 CASE ( 6 ) ; CALL tra_adv_qck ( kt, nit000, 'TRA', r2dt ra, zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! QUICKEST130 CASE ( 7 ) ; CALL tra_adv_tvd_zts( kt, nit000, 'TRA', r2dt ra, zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! TVD ZTS124 CASE ( 1 ) ; CALL tra_adv_cen2 ( kt, nit000, 'TRA', zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! 2nd order centered 125 CASE ( 2 ) ; CALL tra_adv_tvd ( kt, nit000, 'TRA', r2dt, zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! TVD 126 CASE ( 3 ) ; CALL tra_adv_muscl ( kt, nit000, 'TRA', r2dt, zun, zvn, zwn, tsb, tsa, jpts, ln_traadv_msc_ups ) ! MUSCL 127 CASE ( 4 ) ; CALL tra_adv_muscl2 ( kt, nit000, 'TRA', r2dt, zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! MUSCL2 128 CASE ( 5 ) ; CALL tra_adv_ubs ( kt, nit000, 'TRA', r2dt, zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! UBS 129 CASE ( 6 ) ; CALL tra_adv_qck ( kt, nit000, 'TRA', r2dt, zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! QUICKEST 130 CASE ( 7 ) ; CALL tra_adv_tvd_zts( kt, nit000, 'TRA', r2dt, zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! TVD ZTS 131 131 ! 132 132 CASE (-1 ) !== esopa: test all possibility with control print ==! … … 134 134 CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv0 - Ta: ', mask1=tmask, & 135 135 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 136 CALL tra_adv_tvd ( kt, nit000, 'TRA', r2dt ra, zun, zvn, zwn, tsb, tsn, tsa, jpts )136 CALL tra_adv_tvd ( kt, nit000, 'TRA', r2dt, zun, zvn, zwn, tsb, tsn, tsa, jpts ) 137 137 CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv1 - Ta: ', mask1=tmask, & 138 138 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 139 CALL tra_adv_muscl ( kt, nit000, 'TRA', r2dt ra, zun, zvn, zwn, tsb, tsa, jpts, ln_traadv_msc_ups )139 CALL tra_adv_muscl ( kt, nit000, 'TRA', r2dt, zun, zvn, zwn, tsb, tsa, jpts, ln_traadv_msc_ups ) 140 140 CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv3 - Ta: ', mask1=tmask, & 141 141 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 142 CALL tra_adv_muscl2( kt, nit000, 'TRA', r2dt ra, zun, zvn, zwn, tsb, tsn, tsa, jpts )142 CALL tra_adv_muscl2( kt, nit000, 'TRA', r2dt, zun, zvn, zwn, tsb, tsn, tsa, jpts ) 143 143 CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv4 - Ta: ', mask1=tmask, & 144 144 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 145 CALL tra_adv_ubs ( kt, nit000, 'TRA', r2dt ra, zun, zvn, zwn, tsb, tsn, tsa, jpts )145 CALL tra_adv_ubs ( kt, nit000, 'TRA', r2dt, zun, zvn, zwn, tsb, tsn, tsa, jpts ) 146 146 CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv5 - Ta: ', mask1=tmask, & 147 147 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 148 CALL tra_adv_qck ( kt, nit000, 'TRA', r2dt ra, zun, zvn, zwn, tsb, tsn, tsa, jpts )148 CALL tra_adv_qck ( kt, nit000, 'TRA', r2dt, zun, zvn, zwn, tsb, tsn, tsa, jpts ) 149 149 CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv6 - Ta: ', mask1=tmask, & 150 150 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) -
branches/2016/dev_v3_6_STABLE_r6506_AGRIF_LIM3/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_muscl.F90
r5147 r7158 72 72 INTEGER , INTENT(in ) :: kjpt ! number of tracers 73 73 LOGICAL , INTENT(in ) :: ld_msc_ups ! use upstream scheme within muscl 74 REAL(wp) , DIMENSION( jpk ), INTENT(in ) :: p2dt ! vertical profile of tracer time-step74 REAL(wp) , INTENT(in ) :: p2dt ! vertical profile of tracer time-step 75 75 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pun, pvn, pwn ! 3 ocean velocity components 76 76 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: ptb ! before tracer field … … 176 176 ! !-- MUSCL horizontal advective fluxes 177 177 DO jk = 1, jpkm1 ! interior values 178 zdt = p2dt (jk)178 zdt = p2dt 179 179 DO jj = 2, jpjm1 180 180 DO ji = fs_2, fs_jpim1 ! vector opt. … … 259 259 ! 260 260 DO jk = 1, jpkm1 ! interior values 261 zdt = p2dt (jk)261 zdt = p2dt 262 262 DO jj = 2, jpjm1 263 263 DO ji = fs_2, fs_jpim1 ! vector opt. -
branches/2016/dev_v3_6_STABLE_r6506_AGRIF_LIM3/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_muscl2.F90
r5147 r7158 63 63 CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 64 64 INTEGER , INTENT(in ) :: kjpt ! number of tracers 65 REAL(wp) , DIMENSION( jpk ), INTENT(in ) :: p2dt ! vertical profile of tracer time-step65 REAL(wp) , INTENT(in ) :: p2dt ! vertical profile of tracer time-step 66 66 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pun, pvn, pwn ! 3 ocean velocity components 67 67 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: ptb, ptn ! before & now tracer fields … … 133 133 ! !-- MUSCL horizontal advective fluxes 134 134 DO jk = 1, jpkm1 ! interior values 135 zdt = p2dt (jk)135 zdt = p2dt 136 136 DO jj = 2, jpjm1 137 137 DO ji = fs_2, fs_jpim1 ! vector opt. … … 240 240 ! 241 241 DO jk = 1, jpkm1 ! interior values 242 zdt = p2dt (jk)242 zdt = p2dt 243 243 DO jj = 2, jpjm1 244 244 DO ji = fs_2, fs_jpim1 ! vector opt. -
branches/2016/dev_v3_6_STABLE_r6506_AGRIF_LIM3/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_qck.F90
r5147 r7158 88 88 CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 89 89 INTEGER , INTENT(in ) :: kjpt ! number of tracers 90 REAL(wp) , DIMENSION( jpk ), INTENT(in ) :: p2dt ! vertical profile of tracer time-step90 REAL(wp) , INTENT(in ) :: p2dt ! vertical profile of tracer time-step 91 91 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pun, pvn, pwn ! 3 ocean velocity components 92 92 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: ptb, ptn ! before and now tracer fields … … 125 125 CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 126 126 INTEGER , INTENT(in ) :: kjpt ! number of tracers 127 REAL(wp) , DIMENSION( jpk ), INTENT(in ) :: p2dt ! vertical profile of tracer time-step127 REAL(wp) , INTENT(in ) :: p2dt ! vertical profile of tracer time-step 128 128 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pun ! i-velocity components 129 129 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: ptb, ptn ! before and now tracer fields … … 170 170 ! 171 171 DO jk = 1, jpkm1 172 zdt = p2dt (jk)172 zdt = p2dt 173 173 DO jj = 2, jpjm1 174 174 DO ji = fs_2, fs_jpim1 ! vector opt. … … 246 246 CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 247 247 INTEGER , INTENT(in ) :: kjpt ! number of tracers 248 REAL(wp) , DIMENSION( jpk ), INTENT(in ) :: p2dt ! vertical profile of tracer time-step248 REAL(wp) , INTENT(in ) :: p2dt ! vertical profile of tracer time-step 249 249 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pvn ! j-velocity components 250 250 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: ptb, ptn ! before and now tracer fields … … 293 293 ! 294 294 DO jk = 1, jpkm1 295 zdt = p2dt (jk)295 zdt = p2dt 296 296 DO jj = 2, jpjm1 297 297 DO ji = fs_2, fs_jpim1 ! vector opt. -
branches/2016/dev_v3_6_STABLE_r6506_AGRIF_LIM3/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_tvd.F90
r6774 r7158 74 74 CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 75 75 INTEGER , INTENT(in ) :: kjpt ! number of tracers 76 REAL(wp) , DIMENSION( jpk ), INTENT(in ) :: p2dt ! vertical profile of tracer time-step76 REAL(wp) , INTENT(in ) :: p2dt ! vertical profile of tracer time-step 77 77 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pun, pvn, pwn ! 3 ocean velocity components 78 78 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: ptb, ptn ! before and now tracer fields … … 170 170 ! total advective trend 171 171 DO jk = 1, jpkm1 172 z2dtt = p2dt (jk)172 z2dtt = p2dt 173 173 DO jj = 2, jpjm1 174 174 DO ji = fs_2, fs_jpim1 ! vector opt. … … 300 300 CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 301 301 INTEGER , INTENT(in ) :: kjpt ! number of tracers 302 REAL(wp) , DIMENSION( jpk ), INTENT(in ) :: p2dt ! vertical profile of tracer time-step302 REAL(wp) , INTENT(in ) :: p2dt ! vertical profile of tracer time-step 303 303 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pun, pvn, pwn ! 3 ocean velocity components 304 304 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: ptb, ptn ! before and now tracer fields 305 305 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: pta ! tracer trend 306 306 ! 307 REAL(wp) , DIMENSION( jpk ):: zts ! length of sub-timestep for vertical advection308 REAL(wp) , DIMENSION( jpk ):: zr_p2dt ! reciprocal of tracer timestep307 REAL(wp) :: zts ! length of sub-timestep for vertical advection 308 REAL(wp) :: zr_p2dt ! reciprocal of tracer timestep 309 309 INTEGER :: ji, jj, jk, jl, jn ! dummy loop indices 310 310 INTEGER :: jnzts = 5 ! number of sub-timesteps for vertical advection … … 343 343 zwi(:,:,:) = 0._wp 344 344 z_rzts = 1._wp / REAL( jnzts, wp ) 345 zr_p2dt (:) = 1._wp / p2dt(:)345 zr_p2dt = 1._wp / p2dt 346 346 ! 347 347 ! ! =========== … … 406 406 ! total advective trend 407 407 DO jk = 1, jpkm1 408 z2dtt = p2dt (jk)408 z2dtt = p2dt 409 409 DO jj = 2, jpjm1 410 410 DO ji = fs_2, fs_jpim1 ! vector opt. … … 477 477 IF( jl == 1 ) THEN ! Euler forward to kick things off 478 478 jtb = 1 ; jtn = 1 ; jta = 2 479 zts (:) = p2dt(:)* z_rzts479 zts = p2dt * z_rzts 480 480 jtaken = MOD( jnzts + 1 , 2) ! Toggle to collect every second flux 481 481 ! starting at jl =1 if jnzts is odd; … … 483 483 ELSEIF( jl == 2 ) THEN ! First leapfrog step 484 484 jtb = 1 ; jtn = 2 ; jta = 3 485 zts (:) = 2._wp * p2dt(:)* z_rzts485 zts = 2._wp * p2dt * z_rzts 486 486 ELSE ! Shuffle pointers for subsequent leapfrog steps 487 487 jtb = MOD(jtb,3) + 1 … … 493 493 DO ji = fs_2, fs_jpim1 494 494 zwz(ji,jj,jk) = 0.5_wp * pwn(ji,jj,jk) * ( ztrs(ji,jj,jk,jtn) + ztrs(ji,jj,jk-1,jtn) ) 495 IF( jtaken == 0 ) zwzts(ji,jj,jk) = zwzts(ji,jj,jk) + zwz(ji,jj,jk)*zts (jk)! Accumulate time-weighted vertcal flux495 IF( jtaken == 0 ) zwzts(ji,jj,jk) = zwzts(ji,jj,jk) + zwz(ji,jj,jk)*zts ! Accumulate time-weighted vertcal flux 496 496 END DO 497 497 END DO … … 506 506 ! total advective trends 507 507 ztra = - zbtr * ( zhdiv(ji,jj,jk) + zwz(ji,jj,jk) - zwz(ji ,jj ,jk+1) ) 508 ztrs(ji,jj,jk,jta) = ztrs(ji,jj,jk,jtb) + zts (jk)* ztra508 ztrs(ji,jj,jk,jta) = ztrs(ji,jj,jk,jtb) + zts * ztra 509 509 END DO 510 510 END DO … … 516 516 DO jj = 2, jpjm1 517 517 DO ji = fs_2, fs_jpim1 518 zwz(ji,jj,jk) = zwzts(ji,jj,jk) * zr_p2dt (jk)- zwz_sav(ji,jj,jk)518 zwz(ji,jj,jk) = zwzts(ji,jj,jk) * zr_p2dt - zwz_sav(ji,jj,jk) 519 519 END DO 520 520 END DO … … 585 585 !! in-space based differencing for fluid 586 586 !!---------------------------------------------------------------------- 587 REAL(wp) , DIMENSION(jpk), INTENT(in ) :: p2dt ! vertical profile of tracer time-step587 REAL(wp) , INTENT(in ) :: p2dt ! vertical profile of tracer time-step 588 588 REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT(in ) :: pbef, paft ! before & after field 589 589 REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT(inout) :: paa, pbb, pcc ! monotonic fluxes in the 3 directions … … 614 614 DO jk = 1, jpkm1 615 615 ikm1 = MAX(jk-1,1) 616 z2dtt = p2dt (jk)616 z2dtt = p2dt 617 617 DO jj = 2, jpjm1 618 618 DO ji = fs_2, fs_jpim1 ! vector opt. -
branches/2016/dev_v3_6_STABLE_r6506_AGRIF_LIM3/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_ubs.F90
r5147 r7158 81 81 CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 82 82 INTEGER , INTENT(in ) :: kjpt ! number of tracers 83 REAL(wp) , DIMENSION( jpk ), INTENT(in ) :: p2dt ! vertical profile of tracer time-step83 REAL(wp) , INTENT(in ) :: p2dt ! vertical profile of tracer time-step 84 84 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pun, pvn, pwn ! 3 ocean transport components 85 85 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: ptb, ptn ! before and now tracer fields … … 207 207 ! update and guess with monotonic sheme 208 208 DO jk = 1, jpkm1 209 z2dtt = p2dt (jk)209 z2dtt = p2dt 210 210 DO jj = 2, jpjm1 211 211 DO ji = fs_2, fs_jpim1 ! vector opt. … … 281 281 !! in-space based differencing for fluid 282 282 !!---------------------------------------------------------------------- 283 REAL(wp), INTENT(in ) , DIMENSION(jpk):: p2dt ! vertical profile of tracer time-step283 REAL(wp), INTENT(in ) :: p2dt ! vertical profile of tracer time-step 284 284 REAL(wp), DIMENSION (jpi,jpj,jpk) :: pbef ! before field 285 285 REAL(wp), INTENT(inout), DIMENSION (jpi,jpj,jpk) :: paft ! after field … … 340 340 341 341 DO jk = 1, jpkm1 342 z2dtt = p2dt (jk)342 z2dtt = p2dt 343 343 DO jj = 2, jpjm1 344 344 DO ji = fs_2, fs_jpim1 ! vector opt. -
branches/2016/dev_v3_6_STABLE_r6506_AGRIF_LIM3/NEMOGCM/NEMO/OPA_SRC/TRA/traldf.F90
r6353 r7158 334 334 ELSE 335 335 DO jk = 1, jpkm1 336 t0_ldf(:,:,jk) = ( tsa(:,:,jk,jp_tem) - tsb(:,:,jk,jp_tem) ) / ( z12 *rdt tra(jk))337 s0_ldf(:,:,jk) = ( tsa(:,:,jk,jp_sal) - tsb(:,:,jk,jp_sal) ) / ( z12 *rdt tra(jk))336 t0_ldf(:,:,jk) = ( tsa(:,:,jk,jp_tem) - tsb(:,:,jk,jp_tem) ) / ( z12 *rdt ) 337 s0_ldf(:,:,jk) = ( tsa(:,:,jk,jp_sal) - tsb(:,:,jk,jp_sal) ) / ( z12 *rdt ) 338 338 END DO 339 339 ENDIF -
branches/2016/dev_v3_6_STABLE_r6506_AGRIF_LIM3/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90
r6204 r7158 122 122 123 123 ! set time step size (Euler/Leapfrog) 124 IF( neuler == 0 .AND. kt == nit000 ) THEN ; r2dt ra(:) = rdttra(:)! at nit000 (Euler)125 ELSEIF( kt <= nit000 + 1 ) THEN ; r2dt ra(:) = 2._wp* rdttra(:)! at nit000 or nit000+1 (Leapfrog)124 IF( neuler == 0 .AND. kt == nit000 ) THEN ; r2dt = rdt ! at nit000 (Euler) 125 ELSEIF( kt <= nit000 + 1 ) THEN ; r2dt = 2._wp* rdt ! at nit000 or nit000+1 (Leapfrog) 126 126 ENDIF 127 127 … … 145 145 ELSE ! Leap-Frog + Asselin filter time stepping 146 146 ! 147 IF( lk_vvl ) THEN ; CALL tra_nxt_vvl( kt, nit000, rdt tra, 'TRA', tsb, tsn, tsa, &148 & 149 ELSE ; CALL tra_nxt_fix( kt, nit000, 147 IF( lk_vvl ) THEN ; CALL tra_nxt_vvl( kt, nit000, rdt, 'TRA', tsb, tsn, tsa, & 148 & sbc_tsc, sbc_tsc_b, jpts ) ! variable volume level (vvl) 149 ELSE ; CALL tra_nxt_fix( kt, nit000, 'TRA', tsb, tsn, tsa, jpts ) ! fixed volume level 150 150 ENDIF 151 151 ENDIF … … 154 154 IF( l_trdtra ) THEN ! trend of the Asselin filter (tb filtered - tb)/dt 155 155 DO jk = 1, jpkm1 156 zfact = 1._wp / r2dt ra(jk)156 zfact = 1._wp / r2dt 157 157 ztrdt(:,:,jk) = ( tsb(:,:,jk,jp_tem) - ztrdt(:,:,jk) ) * zfact 158 158 ztrds(:,:,jk) = ( tsb(:,:,jk,jp_sal) - ztrds(:,:,jk) ) * zfact … … 265 265 INTEGER , INTENT(in ) :: kt ! ocean time-step index 266 266 INTEGER , INTENT(in ) :: kit000 ! first time step index 267 REAL(wp) , INTENT(in ) , DIMENSION(jpk):: p2dt ! time-step267 REAL(wp) , INTENT(in ) :: p2dt ! time-step 268 268 CHARACTER(len=3), INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 269 269 INTEGER , INTENT(in ) :: kjpt ! number of tracers … … 305 305 DO jn = 1, kjpt 306 306 DO jk = 1, jpkm1 307 zfact1 = atfp * p2dt (jk)307 zfact1 = atfp * p2dt 308 308 zfact2 = zfact1 / rau0 309 309 DO jj = 1, jpj -
branches/2016/dev_v3_6_STABLE_r6506_AGRIF_LIM3/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf.F90
r5385 r7158 66 66 ! 67 67 IF( neuler == 0 .AND. kt == nit000 ) THEN ! at nit000 68 r2dt ra(:) = rdttra(:)! = rdtra (restarting with Euler time stepping)68 r2dt = rdt ! = rdtra (restarting with Euler time stepping) 69 69 ELSEIF( kt <= nit000 + 1) THEN ! at nit000 or nit000+1 70 r2dt ra(:) = 2. * rdttra(:) ! = 2 rdttra(leapfrog)70 r2dt = 2. * rdt ! = 2 rdt (leapfrog) 71 71 ENDIF 72 72 … … 78 78 79 79 SELECT CASE ( nzdf ) ! compute lateral mixing trend and add it to the general trend 80 CASE ( 0 ) ; CALL tra_zdf_exp( kt, nit000, 'TRA', r2dt ra, nn_zdfexp, tsb, tsa, jpts ) ! explicit scheme81 CASE ( 1 ) ; CALL tra_zdf_imp( kt, nit000, 'TRA', r2dt ra, tsb, tsa, jpts ) ! implicit scheme80 CASE ( 0 ) ; CALL tra_zdf_exp( kt, nit000, 'TRA', r2dt, nn_zdfexp, tsb, tsa, jpts ) ! explicit scheme 81 CASE ( 1 ) ; CALL tra_zdf_imp( kt, nit000, 'TRA', r2dt, tsb, tsa, jpts ) ! implicit scheme 82 82 CASE ( -1 ) ! esopa: test all possibility with control print 83 CALL tra_zdf_exp( kt, nit000, 'TRA', r2dt ra, nn_zdfexp, tsb, tsa, jpts )83 CALL tra_zdf_exp( kt, nit000, 'TRA', r2dt, nn_zdfexp, tsb, tsa, jpts ) 84 84 CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' zdf0 - Ta: ', mask1=tmask, & 85 85 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 86 CALL tra_zdf_imp( kt, nit000, 'TRA', r2dt ra, tsb, tsa, jpts )86 CALL tra_zdf_imp( kt, nit000, 'TRA', r2dt, tsb, tsa, jpts ) 87 87 CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' zdf1 - Ta: ', mask1=tmask, & 88 88 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) … … 95 95 IF( l_trdtra ) THEN ! save the vertical diffusive trends for further diagnostics 96 96 DO jk = 1, jpkm1 97 ztrdt(:,:,jk) = ( ( tsa(:,:,jk,jp_tem) - tsb(:,:,jk,jp_tem) ) / r2dt ra(jk)) - ztrdt(:,:,jk)98 ztrds(:,:,jk) = ( ( tsa(:,:,jk,jp_sal) - tsb(:,:,jk,jp_sal) ) / r2dt ra(jk)) - ztrds(:,:,jk)97 ztrdt(:,:,jk) = ( ( tsa(:,:,jk,jp_tem) - tsb(:,:,jk,jp_tem) ) / r2dt ) - ztrdt(:,:,jk) 98 ztrds(:,:,jk) = ( ( tsa(:,:,jk,jp_sal) - tsb(:,:,jk,jp_sal) ) / r2dt ) - ztrds(:,:,jk) 99 99 END DO 100 100 CALL lbc_lnk( ztrdt, 'T', 1. ) -
branches/2016/dev_v3_6_STABLE_r6506_AGRIF_LIM3/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf_exp.F90
r3294 r7158 81 81 INTEGER , INTENT(in ) :: kjpt ! number of tracers 82 82 INTEGER , INTENT(in ) :: kn_zdfexp ! number of sub-time step 83 REAL(wp) , DIMENSION( jpk ), INTENT(in ) :: p2dt ! vertical profile of tracer time-step83 REAL(wp) , INTENT(in ) :: p2dt ! vertical profile of tracer time-step 84 84 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: ptb ! before and now tracer fields 85 85 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: pta ! tracer trend … … 136 136 DO ji = fs_2, fs_jpim1 ! vector opt. 137 137 ze3tr = zlavmr / fse3t_n(ji,jj,jk) 138 zwx(ji,jj,jk) = zwx(ji,jj,jk) + p2dt (jk)* ( zwy(ji,jj,jk) - zwy(ji,jj,jk+1) ) * ze3tr138 zwx(ji,jj,jk) = zwx(ji,jj,jk) + p2dt * ( zwy(ji,jj,jk) - zwy(ji,jj,jk+1) ) * ze3tr 139 139 END DO 140 140 END DO … … 150 150 DO ji = fs_2, fs_jpim1 ! vector opt. 151 151 ze3tb = fse3t_b(ji,jj,jk) / fse3t(ji,jj,jk) ! before e3t 152 ztra = zwx(ji,jj,jk) - ptb(ji,jj,jk,jn) + p2dt (jk)* pta(ji,jj,jk,jn) ! total trends * 2*rdt152 ztra = zwx(ji,jj,jk) - ptb(ji,jj,jk,jn) + p2dt * pta(ji,jj,jk,jn) ! total trends * 2*rdt 153 153 pta(ji,jj,jk,jn) = ( ze3tb * ptb(ji,jj,jk,jn) + ztra ) * tmask(ji,jj,jk) 154 154 END DO … … 159 159 DO jj = 2, jpjm1 160 160 DO ji = fs_2, fs_jpim1 ! vector opt. 161 pta(ji,jj,jk,jn) = ( zwx(ji,jj,jk) + p2dt (jk)* pta(ji,jj,jk,jn) ) * tmask(ji,jj,jk)161 pta(ji,jj,jk,jn) = ( zwx(ji,jj,jk) + p2dt * pta(ji,jj,jk,jn) ) * tmask(ji,jj,jk) 162 162 END DO 163 163 END DO -
branches/2016/dev_v3_6_STABLE_r6506_AGRIF_LIM3/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf_imp.F90
r5120 r7158 82 82 CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 83 83 INTEGER , INTENT(in ) :: kjpt ! number of tracers 84 REAL(wp) , DIMENSION( jpk ), INTENT(in ) :: p2dt ! vertical profile of tracer time-step84 REAL(wp) , INTENT(in ) :: p2dt ! vertical profile of tracer time-step 85 85 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: ptb ! before and now tracer fields 86 86 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: pta ! tracer trend … … 154 154 ze3ta = ( 1. - r_vvl ) + r_vvl * fse3t_a(ji,jj,jk) ! after scale factor at T-point 155 155 ze3tn = r_vvl + ( 1. - r_vvl ) * fse3t_n(ji,jj,jk) ! now scale factor at T-point 156 zwi(ji,jj,jk) = - p2dt (jk)* zwt(ji,jj,jk ) / ( ze3tn * fse3w(ji,jj,jk ) )157 zws(ji,jj,jk) = - p2dt (jk)* zwt(ji,jj,jk+1) / ( ze3tn * fse3w(ji,jj,jk+1) )156 zwi(ji,jj,jk) = - p2dt * zwt(ji,jj,jk ) / ( ze3tn * fse3w(ji,jj,jk ) ) 157 zws(ji,jj,jk) = - p2dt * zwt(ji,jj,jk+1) / ( ze3tn * fse3w(ji,jj,jk+1) ) 158 158 zwd(ji,jj,jk) = ze3ta - zwi(ji,jj,jk) - zws(ji,jj,jk) 159 159 END DO … … 203 203 ze3tn = ( 1. - r_vvl ) + r_vvl * fse3t(ji,jj,1) 204 204 pta(ji,jj,1,jn) = ze3tb * ptb(ji,jj,1,jn) & 205 & + p2dt (1)* ze3tn * pta(ji,jj,1,jn)205 & + p2dt * ze3tn * pta(ji,jj,1,jn) 206 206 END DO 207 207 END DO … … 211 211 ze3tb = ( 1. - r_vvl ) + r_vvl * fse3t_b(ji,jj,jk) 212 212 ze3tn = ( 1. - r_vvl ) + r_vvl * fse3t (ji,jj,jk) 213 zrhs = ze3tb * ptb(ji,jj,jk,jn) + p2dt (jk)* ze3tn * pta(ji,jj,jk,jn) ! zrhs=right hand side213 zrhs = ze3tb * ptb(ji,jj,jk,jn) + p2dt * ze3tn * pta(ji,jj,jk,jn) ! zrhs=right hand side 214 214 pta(ji,jj,jk,jn) = zrhs - zwi(ji,jj,jk) / zwt(ji,jj,jk-1) * pta(ji,jj,jk-1,jn) 215 215 END DO -
branches/2016/dev_v3_6_STABLE_r6506_AGRIF_LIM3/NEMOGCM/NEMO/OPA_SRC/TRD/trdtra.F90
r4990 r7158 35 35 36 36 PUBLIC trd_tra ! called by all tra_... modules 37 38 REAL(wp) :: r2dt ! time-step, = 2 rdttra except at nit000 (=rdttra) if neuler=039 37 40 38 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: trdtx, trdty, trdt ! use to store the temperature trends … … 228 226 229 227 IF( neuler == 0 .AND. kt == nit000 ) THEN ; r2dt = rdt ! = rdtra (restart with Euler time stepping) 230 ELSEIF( kt <= nit000 + 1) THEN ; r2dt = 2. * rdt ! = 2 rdt tra(leapfrog)228 ELSEIF( kt <= nit000 + 1) THEN ; r2dt = 2. * rdt ! = 2 rdt (leapfrog) 231 229 ENDIF 232 230 -
branches/2016/dev_v3_6_STABLE_r6506_AGRIF_LIM3/NEMOGCM/NEMO/SAS_SRC/daymod.F90
r7069 r7158 20 20 !! 21 21 !! we suppose that the time step is deviding the number of second of in a day 22 !! ---> MOD( rday, rdt tra(1)) == 022 !! ---> MOD( rday, rdt ) == 0 23 23 !! 24 24 !! ----------- WARNING ----------- … … 76 76 & 'You must do a restart at higher frequency (or remove this stop and recompile the code in I8)' ) 77 77 ENDIF 78 ! all calendar staff is based on the fact that MOD( rday, rdt tra(1)) == 079 IF( MOD( rday , rdttra(1)) /= 0. ) CALL ctl_stop( 'the time step must devide the number of second of in a day' )80 IF( MOD( rday , 2.) /= 0. ) CALL ctl_stop( 'the number of second of in a day must be an even number' )81 IF( MOD( rdt tra(1), 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 tra(1))85 ndt05 = NINT(0.5 * rdt tra(1))78 ! all calendar staff is based on the fact that MOD( rday, rdt ) == 0 79 IF( MOD( rday , rdt ) /= 0. ) CALL ctl_stop( 'the time step must devide the number of second of in a day' ) 80 IF( MOD( rday , 2. ) /= 0. ) CALL ctl_stop( 'the number of second of in a day must be an even number' ) 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 ) 86 86 87 87 ! ==> clem: here we read the ocean restart for the date (only if it exists) … … 224 224 nsec_week = nsec_week + ndt 225 225 nsec_day = nsec_day + ndt 226 adatrj = adatrj + rdt tra(1)/ rday227 fjulday = fjulday + rdt tra(1)/ rday226 adatrj = adatrj + rdt / rday 227 fjulday = fjulday + rdt / rday 228 228 IF( ABS(fjulday - REAL(NINT(fjulday),wp)) < zprec ) fjulday = REAL(NINT(fjulday),wp) ! avoid truncation error 229 229 IF( ABS(adatrj - REAL(NINT(adatrj ),wp)) < zprec ) adatrj = REAL(NINT(adatrj ),wp) ! avoid truncation error … … 344 344 ! parameters correspondting to nit000 - 1 (as we start the step loop with a call to day) 345 345 ndastp = ndate0 - 1 ! ndate0 read in the namelist in dom_nam, we assume that we start run at 00:00 346 adatrj = ( REAL( nit000-1, wp ) * rdt tra(1)) / rday346 adatrj = ( REAL( nit000-1, wp ) * rdt ) / rday 347 347 ! note this is wrong if time step has changed during run 348 348 ENDIF … … 350 350 ! parameters correspondting to nit000 - 1 (as we start the step loop with a call to day) 351 351 ndastp = ndate0 - 1 ! ndate0 read in the namelist in dom_nam, we assume that we start run at 00:00 352 adatrj = ( REAL( nit000-1, wp ) * rdt tra(1)) / rday352 adatrj = ( REAL( nit000-1, wp ) * rdt ) / rday 353 353 ENDIF 354 354 IF( ABS(adatrj - REAL(NINT(adatrj),wp)) < 0.1 / rday ) adatrj = REAL(NINT(adatrj),wp) ! avoid truncation error -
branches/2016/dev_v3_6_STABLE_r6506_AGRIF_LIM3/NEMOGCM/NEMO/SAS_SRC/diawri.F90
r5217 r7158 164 164 ! Define frequency of output and means 165 165 zdt = rdt 166 IF( nacc == 1 ) zdt = rdtmin167 166 IF( ln_mskland ) THEN ; clop = "only(x)" ! put 1.e+20 on land (very expensive!!) 168 167 ELSE ; clop = "x" ! no use of the mask value (require less cpu time) -
branches/2016/dev_v3_6_STABLE_r6506_AGRIF_LIM3/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsms.F90
r6420 r7158 94 94 ! 95 95 ! ! set time step size (Euler/Leapfrog) 96 IF( ( neuler == 0 .AND. kt == nittrc000 ) .OR. ln_top_euler ) THEN ; rfact = rdttrc (1)! at nittrc00097 ELSEIF( kt <= nittrc000 + nn_dttrc ) THEN ; rfact = 2. * rdttrc (1)! at nittrc000 or nittrc000+nn_dttrc (Leapfrog)96 IF( ( neuler == 0 .AND. kt == nittrc000 ) .OR. ln_top_euler ) THEN ; rfact = rdttrc ! at nittrc000 97 ELSEIF( kt <= nittrc000 + nn_dttrc ) THEN ; rfact = 2. * rdttrc ! at nittrc000 or nittrc000+nn_dttrc (Leapfrog) 98 98 ENDIF 99 99 ! … … 104 104 xstep = rfact2 / rday ! Time step duration for biology 105 105 IF(lwp) WRITE(numout,*) 106 IF(lwp) WRITE(numout,*) ' Passive Tracer time step rfact = ', rfact, ' rdt = ', rdt tra(1)106 IF(lwp) WRITE(numout,*) ' Passive Tracer time step rfact = ', rfact, ' rdt = ', rdt 107 107 IF(lwp) write(numout,*) ' PISCES Biology time step rfact2 = ', rfact2 108 108 IF(lwp) WRITE(numout,*) -
branches/2016/dev_v3_6_STABLE_r6506_AGRIF_LIM3/NEMOGCM/NEMO/TOP_SRC/TRP/trcadv.F90
r5385 r7158 32 32 33 33 PUBLIC trc_adv ! routine called by step module 34 PUBLIC trc_adv_alloc ! routine called by nemogcm module35 34 36 35 INTEGER :: nadv ! choice of the type of advection scheme 37 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) :: r2dt ! vertical profile time-step, = 2 rdttra 38 ! ! except at nitrrc000 (=rdttra) if neuler=0 36 37 REAL(wp) :: r2dttrc ! vertical profile time-step, = 2 rdt 38 ! ! except at nitrrc000 (=rdt) if neuler=0 39 39 40 40 !! * Substitutions … … 47 47 !!---------------------------------------------------------------------- 48 48 CONTAINS 49 50 INTEGER FUNCTION trc_adv_alloc()51 !!----------------------------------------------------------------------52 !! *** ROUTINE trc_adv_alloc ***53 !!----------------------------------------------------------------------54 55 ALLOCATE( r2dt(jpk), STAT=trc_adv_alloc )56 57 IF( trc_adv_alloc /= 0 ) CALL ctl_warn('trc_adv_alloc : failed to allocate array.')58 59 END FUNCTION trc_adv_alloc60 49 61 50 … … 84 73 85 74 IF( ( neuler == 0 .AND. kt == nittrc000 ) .OR. ln_top_euler ) THEN ! at nittrc000 86 r2dt (:) = rdttrc(:)! = rdttrc (use or restarting with Euler time stepping)75 r2dttrc = rdttrc ! = rdttrc (use or restarting with Euler time stepping) 87 76 ELSEIF( kt <= nittrc000 + nn_dttrc ) THEN ! at nittrc000 or nittrc000+1 88 r2dt (:) = 2. * rdttrc(:)! = 2 rdttrc (leapfrog)77 r2dttrc = 2. * rdttrc ! = 2 rdttrc (leapfrog) 89 78 ENDIF 90 79 ! ! effective transport … … 112 101 ! 113 102 SELECT CASE ( nadv ) !== compute advection trend and add it to general trend ==! 114 CASE ( 1 ) ; CALL tra_adv_cen2 ( kt, nittrc000, 'TRC', zun, zvn, zwn, trb, trn, tra, jptra ) ! 2nd order centered115 CASE ( 2 ) ; CALL tra_adv_tvd ( kt, nittrc000, 'TRC', r2dt , zun, zvn, zwn, trb, trn, tra, jptra ) ! TVD116 CASE ( 3 ) ; CALL tra_adv_muscl ( kt, nittrc000, 'TRC', r2dt , zun, zvn, zwn, trb, tra, jptra, ln_trcadv_msc_ups ) ! MUSCL117 CASE ( 4 ) ; CALL tra_adv_muscl2( kt, nittrc000, 'TRC', r2dt , zun, zvn, zwn, trb, trn, tra, jptra ) ! MUSCL2118 CASE ( 5 ) ; CALL tra_adv_ubs ( kt, nittrc000, 'TRC', r2dt , zun, zvn, zwn, trb, trn, tra, jptra ) ! UBS119 CASE ( 6 ) ; CALL tra_adv_qck ( kt, nittrc000, 'TRC', r2dt , zun, zvn, zwn, trb, trn, tra, jptra ) ! QUICKEST103 CASE ( 1 ) ; CALL tra_adv_cen2 ( kt, nittrc000, 'TRC', zun, zvn, zwn, trb, trn, tra, jptra ) ! 2nd order centered 104 CASE ( 2 ) ; CALL tra_adv_tvd ( kt, nittrc000, 'TRC', r2dttrc, zun, zvn, zwn, trb, trn, tra, jptra ) ! TVD 105 CASE ( 3 ) ; CALL tra_adv_muscl ( kt, nittrc000, 'TRC', r2dttrc, zun, zvn, zwn, trb, tra, jptra, ln_trcadv_msc_ups ) ! MUSCL 106 CASE ( 4 ) ; CALL tra_adv_muscl2( kt, nittrc000, 'TRC', r2dttrc, zun, zvn, zwn, trb, trn, tra, jptra ) ! MUSCL2 107 CASE ( 5 ) ; CALL tra_adv_ubs ( kt, nittrc000, 'TRC', r2dttrc, zun, zvn, zwn, trb, trn, tra, jptra ) ! UBS 108 CASE ( 6 ) ; CALL tra_adv_qck ( kt, nittrc000, 'TRC', r2dttrc, zun, zvn, zwn, trb, trn, tra, jptra ) ! QUICKEST 120 109 ! 121 110 CASE (-1 ) !== esopa: test all possibility with control print ==! … … 123 112 WRITE(charout, FMT="('adv1')") ; CALL prt_ctl_trc_info(charout) 124 113 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd') 125 CALL tra_adv_tvd ( kt, nittrc000, 'TRC', r2dt , zun, zvn, zwn, trb, trn, tra, jptra )114 CALL tra_adv_tvd ( kt, nittrc000, 'TRC', r2dttrc, zun, zvn, zwn, trb, trn, tra, jptra ) 126 115 WRITE(charout, FMT="('adv2')") ; CALL prt_ctl_trc_info(charout) 127 116 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd') 128 CALL tra_adv_muscl ( kt, nittrc000, 'TRC', r2dt , zun, zvn, zwn, trb, tra, jptra, ln_trcadv_msc_ups )117 CALL tra_adv_muscl ( kt, nittrc000, 'TRC', r2dttrc, zun, zvn, zwn, trb, tra, jptra, ln_trcadv_msc_ups ) 129 118 WRITE(charout, FMT="('adv3')") ; CALL prt_ctl_trc_info(charout) 130 119 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd') 131 CALL tra_adv_muscl2( kt, nittrc000, 'TRC', r2dt , zun, zvn, zwn, trb, trn, tra, jptra )120 CALL tra_adv_muscl2( kt, nittrc000, 'TRC', r2dttrc, zun, zvn, zwn, trb, trn, tra, jptra ) 132 121 WRITE(charout, FMT="('adv4')") ; CALL prt_ctl_trc_info(charout) 133 122 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd') 134 CALL tra_adv_ubs ( kt, nittrc000, 'TRC', r2dt , zun, zvn, zwn, trb, trn, tra, jptra )123 CALL tra_adv_ubs ( kt, nittrc000, 'TRC', r2dttrc, zun, zvn, zwn, trb, trn, tra, jptra ) 135 124 WRITE(charout, FMT="('adv5')") ; CALL prt_ctl_trc_info(charout) 136 125 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd') 137 CALL tra_adv_qck ( kt, nittrc000, 'TRC', r2dt , zun, zvn, zwn, trb, trn, tra, jptra )126 CALL tra_adv_qck ( kt, nittrc000, 'TRC', r2dttrc, zun, zvn, zwn, trb, trn, tra, jptra ) 138 127 WRITE(charout, FMT="('adv6')") ; CALL prt_ctl_trc_info(charout) 139 128 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd') -
branches/2016/dev_v3_6_STABLE_r6506_AGRIF_LIM3/NEMOGCM/NEMO/TOP_SRC/TRP/trcnxt.F90
r6204 r7158 41 41 42 42 PUBLIC trc_nxt ! routine called by step.F90 43 PUBLIC trc_nxt_alloc ! routine called by nemogcm.F9044 43 45 REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:) :: r2dt44 REAL(wp) :: r2dttrc 46 45 47 46 !!---------------------------------------------------------------------- … … 51 50 !!---------------------------------------------------------------------- 52 51 CONTAINS 53 54 INTEGER FUNCTION trc_nxt_alloc()55 !!----------------------------------------------------------------------56 !! *** ROUTINE trc_nxt_alloc ***57 !!----------------------------------------------------------------------58 ALLOCATE( r2dt(jpk), STAT=trc_nxt_alloc )59 !60 IF( trc_nxt_alloc /= 0 ) CALL ctl_warn('trc_nxt_alloc : failed to allocate array')61 !62 END FUNCTION trc_nxt_alloc63 52 64 53 … … 117 106 118 107 ! set time step size (Euler/Leapfrog) 119 IF( neuler == 0 .AND. kt == nittrc000 ) THEN ; r2dt (:) = rdttrc(:)! at nittrc000 (Euler)120 ELSEIF( kt <= nittrc000 + nn_dttrc ) THEN ; r2dt (:) = 2.* rdttrc(:)! at nit000 or nit000+1 (Leapfrog)108 IF( neuler == 0 .AND. kt == nittrc000 ) THEN ; r2dttrc = rdttrc ! at nittrc000 (Euler) 109 ELSEIF( kt <= nittrc000 + nn_dttrc ) THEN ; r2dttrc = 2.* rdttrc ! at nit000 or nit000+1 (Leapfrog) 121 110 ENDIF 122 111 … … 147 136 DO jn = 1, jptra 148 137 DO jk = 1, jpkm1 149 zfact = 1.e0 / r2dt (jk)138 zfact = 1.e0 / r2dttrc 150 139 ztrdt(:,:,jk,jn) = ( trb(:,:,jk,jn) - ztrdt(:,:,jk,jn) ) * zfact 151 140 CALL trd_tra( kt, 'TRC', jn, jptra_atf, ztrdt ) -
branches/2016/dev_v3_6_STABLE_r6506_AGRIF_LIM3/NEMOGCM/NEMO/TOP_SRC/TRP/trcsbc.F90
r6971 r7158 27 27 28 28 PUBLIC trc_sbc ! routine called by step.F90 29 30 REAL(wp) :: r2dt ! time-step at surface31 29 32 30 !! * Substitutions … … 87 85 88 86 IF( ln_top_euler) THEN 89 r2dt = rdttrc (1)! = rdttrc (use Euler time stepping)87 r2dt = rdttrc ! = rdttrc (use Euler time stepping) 90 88 ELSE 91 89 IF( neuler == 0 .AND. kt == nittrc000 ) THEN ! at nittrc000 92 r2dt = rdttrc (1)! = rdttrc (restarting with Euler time stepping)90 r2dt = rdttrc ! = rdttrc (restarting with Euler time stepping) 93 91 ELSEIF( kt <= nittrc000 + nn_dttrc ) THEN ! at nittrc000 or nittrc000+1 94 r2dt = 2. * rdttrc (1)! = 2 rdttrc (leapfrog)92 r2dt = 2. * rdttrc ! = 2 rdttrc (leapfrog) 95 93 ENDIF 96 94 ENDIF -
branches/2016/dev_v3_6_STABLE_r6506_AGRIF_LIM3/NEMOGCM/NEMO/TOP_SRC/TRP/trczdf.F90
r5385 r7158 27 27 28 28 PUBLIC trc_zdf ! called by step.F90 29 PUBLIC trc_zdf_alloc ! called by nemogcm.F9030 29 31 30 INTEGER :: nzdf = 0 ! type vertical diffusion algorithm used 32 31 ! ! defined from ln_zdf... namlist logicals) 33 REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:) :: r2dt ! vertical profile time-step, = 2 rdttra34 ! ! except at nittrc000 (=rdttra) if neuler=032 REAL(wp) :: r2dttrc ! vertical profile time-step, = 2 rdt 33 ! ! except at nittrc000 (=rdt) if neuler=0 35 34 36 35 !! * Substitutions … … 45 44 CONTAINS 46 45 47 INTEGER FUNCTION trc_zdf_alloc()48 !!----------------------------------------------------------------------49 !! *** ROUTINE trc_zdf_alloc ***50 !!----------------------------------------------------------------------51 ALLOCATE( r2dt(jpk) , STAT=trc_zdf_alloc )52 !53 IF( trc_zdf_alloc /= 0 ) CALL ctl_warn('trc_zdf_alloc : failed to allocate array.')54 !55 END FUNCTION trc_zdf_alloc56 57 46 58 47 SUBROUTINE trc_zdf( kt ) … … 74 63 75 64 IF( ( neuler == 0 .AND. kt == nittrc000 ) .OR. ln_top_euler ) THEN ! at nittrc000 76 r2dt (:) = rdttrc(:)! = rdttrc (use or restarting with Euler time stepping)65 r2dttrc = rdttrc ! = rdttrc (use or restarting with Euler time stepping) 77 66 ELSEIF( kt <= nittrc000 + nn_dttrc ) THEN ! at nittrc000 or nittrc000+1 78 r2dt (:) = 2. * rdttrc(:)! = 2 rdttrc (leapfrog)67 r2dttrc = 2. * rdttrc ! = 2 rdttrc (leapfrog) 79 68 ENDIF 80 69 … … 86 75 SELECT CASE ( nzdf ) ! compute lateral mixing trend and add it to the general trend 87 76 CASE ( -1 ) ! esopa: test all possibility with control print 88 CALL tra_zdf_exp( kt, nittrc000, 'TRC', r2dt , nn_trczdf_exp, trb, tra, jptra )77 CALL tra_zdf_exp( kt, nittrc000, 'TRC', r2dttrc, nn_trczdf_exp, trb, tra, jptra ) 89 78 WRITE(charout, FMT="('zdf1 ')") ; CALL prt_ctl_trc_info(charout) 90 79 CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 91 CALL tra_zdf_imp( kt, nittrc000, 'TRC', r2dt , trb, tra, jptra )80 CALL tra_zdf_imp( kt, nittrc000, 'TRC', r2dttrc, trb, tra, jptra ) 92 81 WRITE(charout, FMT="('zdf2 ')") ; CALL prt_ctl_trc_info(charout) 93 82 CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 94 CASE ( 0 ) ; CALL tra_zdf_exp( kt, nittrc000, 'TRC', r2dt , nn_trczdf_exp, trb, tra, jptra ) ! explicit scheme95 CASE ( 1 ) ; CALL tra_zdf_imp( kt, nittrc000, 'TRC', r2dt , trb, tra, jptra ) ! implicit scheme83 CASE ( 0 ) ; CALL tra_zdf_exp( kt, nittrc000, 'TRC', r2dttrc, nn_trczdf_exp, trb, tra, jptra ) ! explicit scheme 84 CASE ( 1 ) ; CALL tra_zdf_imp( kt, nittrc000, 'TRC', r2dttrc, trb, tra, jptra ) ! implicit scheme 96 85 97 86 END SELECT … … 100 89 DO jn = 1, jptra 101 90 DO jk = 1, jpkm1 102 ztrtrd(:,:,jk,jn) = ( ( tra(:,:,jk,jn) - trb(:,:,jk,jn) ) / r2dt (jk)) - ztrtrd(:,:,jk,jn)91 ztrtrd(:,:,jk,jn) = ( ( tra(:,:,jk,jn) - trb(:,:,jk,jn) ) / r2dttrc ) - ztrtrd(:,:,jk,jn) 103 92 END DO 104 93 CALL trd_tra( kt, 'TRC', jn, jptra_zdf, ztrtrd(:,:,:,jn) ) -
branches/2016/dev_v3_6_STABLE_r6506_AGRIF_LIM3/NEMOGCM/NEMO/TOP_SRC/trc.F90
r5385 r7158 64 64 CHARACTER(len = 80) , PUBLIC :: cn_trcrst_out !: suffix of pass. tracer restart name (output) 65 65 CHARACTER(len = 256), PUBLIC :: cn_trcrst_outdir !: restart output directory 66 REAL(wp) , PUBLIC , ALLOCATABLE, SAVE, DIMENSION(:):: rdttrc !: vertical profile of passive tracer time step66 REAL(wp) , PUBLIC :: rdttrc !: vertical profile of passive tracer time step 67 67 LOGICAL , PUBLIC :: ln_top_euler !: boolean term for euler integration 68 68 LOGICAL , PUBLIC :: ln_trcdta !: Read inputs data from files … … 211 211 & gtrui(jpi,jpj,jptra) , gtrvi(jpi,jpj,jptra) , & 212 212 & sbc_trc_b(jpi,jpj,jptra), sbc_trc(jpi,jpj,jptra) , & 213 & cvol(jpi,jpj,jpk) , rdttrc(jpk) , trai(jptra) ,&213 & cvol(jpi,jpj,jpk) , trai(jptra) , & 214 214 & ctrcnm(jptra) , ctrcln(jptra) , ctrcun(jptra) , & 215 215 & ln_trc_ini(jptra) , ln_trc_wri(jptra) , qsr_mean(jpi,jpj) , STAT = trc_alloc ) -
branches/2016/dev_v3_6_STABLE_r6506_AGRIF_LIM3/NEMOGCM/NEMO/TOP_SRC/trcini.F90
r6971 r7158 182 182 !! ** Purpose : Allocate all the dynamic arrays of the OPA modules 183 183 !!---------------------------------------------------------------------- 184 USE trcadv , ONLY: trc_adv_alloc ! TOP-related alloc routines...185 184 USE trc , ONLY: trc_alloc 186 USE trcnxt , ONLY: trc_nxt_alloc187 USE trczdf , ONLY: trc_zdf_alloc188 185 USE trdtrc_oce , ONLY: trd_trc_oce_alloc 189 186 #if defined key_trdmxl_trc … … 194 191 !!---------------------------------------------------------------------- 195 192 ! 196 ierr = trc_adv_alloc() ! Start of TOP-related alloc routines... 197 ierr = ierr + trc_alloc () 198 ierr = ierr + trc_nxt_alloc() 199 ierr = ierr + trc_zdf_alloc() 193 ierr = trc_alloc () 200 194 ierr = ierr + trd_trc_oce_alloc() 201 195 #if defined key_trdmxl_trc -
branches/2016/dev_v3_6_STABLE_r6506_AGRIF_LIM3/NEMOGCM/NEMO/TOP_SRC/trcnam.F90
r6204 r7158 110 110 111 111 112 rdttrc (:) = rdttra(:)* FLOAT( nn_dttrc ) ! vertical profile of passive tracer time-step112 rdttrc = rdt * FLOAT( nn_dttrc ) ! vertical profile of passive tracer time-step 113 113 114 114 IF(lwp) THEN ! control print 115 115 WRITE(numout,*) 116 WRITE(numout,*) ' Passive Tracer time step rdttrc = ', rdttrc (1)116 WRITE(numout,*) ' Passive Tracer time step rdttrc = ', rdttrc 117 117 WRITE(numout,*) 118 118 ENDIF -
branches/2016/dev_v3_6_STABLE_r6506_AGRIF_LIM3/NEMOGCM/NEMO/TOP_SRC/trcrst.F90
r7069 r7158 132 132 !!---------------------------------------------------------------------- 133 133 ! 134 CALL iom_rstput( kt, nitrst, numrtw, 'rdttrc1', rdttrc (1)) ! surface passive tracer time step134 CALL iom_rstput( kt, nitrst, numrtw, 'rdttrc1', rdttrc ) ! surface passive tracer time step 135 135 ! prognostic variables 136 136 ! -------------------- … … 236 236 ELSE 237 237 ndastp = ndate0 - 1 ! ndate0 read in the namelist in dom_nam 238 adatrj = ( REAL( nittrc000-1, wp ) * rdt tra(1)) / rday238 adatrj = ( REAL( nittrc000-1, wp ) * rdt ) / rday 239 239 ! note this is wrong if time step has changed during run 240 240 ENDIF -
branches/2016/dev_v3_6_STABLE_r6506_AGRIF_LIM3/NEMOGCM/NEMO/TOP_SRC/trcstp.F90
r6971 r7158 140 140 nb_rec_per_day = ncpl_qsr_freq 141 141 ELSE 142 rdt_sampl = MAX( 3600., rdttrc (1))142 rdt_sampl = MAX( 3600., rdttrc ) 143 143 nb_rec_per_day = INT( rday / rdt_sampl ) 144 144 ENDIF … … 157 157 iom_varid( numrtr, 'ktdcy' , ldstop = .FALSE. ) > 0 ) THEN 158 158 CALL iom_get( numrtr, 'ktdcy', zkt ) ! A mean of qsr 159 rsecfst = INT( zkt ) * rdttrc (1)159 rsecfst = INT( zkt ) * rdttrc 160 160 IF(lwp) WRITE(numout,*) 'trc_qsr_mean: qsr_mean read in the restart file at time-step rsecfst =', rsecfst, ' s ' 161 161 CALL iom_get( numrtr, jpdom_autoglo, 'qsr_mean', qsr_mean ) ! A mean of qsr … … 171 171 ELSE !* no restart: set from nit000 values 172 172 IF(lwp) WRITE(numout,*) 'trc_qsr_mean: qsr_mean set to nit000 values' 173 rsecfst = kt * rdttrc (1)173 rsecfst = kt * rdttrc 174 174 ! 175 175 qsr_mean(:,:) = qsr(:,:) … … 181 181 ENDIF 182 182 ! 183 rseclast = kt * rdttrc (1)183 rseclast = kt * rdttrc 184 184 ! 185 185 llnew = ( rseclast - rsecfst ) .ge. rdt_sampl ! new shortwave to store
Note: See TracChangeset
for help on using the changeset viewer.