Changeset 9939 for NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE
- Timestamp:
- 2018-07-13T09:28:50+02:00 (6 years ago)
- Location:
- NEMO/branches/2018/dev_r9838_ENHANCE04_RK3
- Files:
-
- 1 deleted
- 91 edited
- 2 copied
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/ASM/asminc.F90
r9656 r9939 491 491 ENDIF 492 492 ! 493 IF(lwp) WRITE(numout,*) ' ==>>> Euler time step switch is ', neuler493 IF(lwp) WRITE(numout,*) ' ==>>> Euler time step switch is ', ln_1st_euler 494 494 ! 495 495 IF( lk_asminc ) THEN !== data assimilation ==! … … 536 536 ! 537 537 it = kt - nit000 + 1 538 zincwgt = wgtiau(it) / r dt ! IAU weight for the current time step538 zincwgt = wgtiau(it) / rn_Dt ! IAU weight for the current time step 539 539 ! 540 540 IF(lwp) THEN … … 579 579 IF ( kt == nitdin_r ) THEN 580 580 ! 581 neuler = 0! Force Euler forward step581 l_1st_euler = .TRUE. ! Force Euler forward step 582 582 ! 583 583 ! Initialize the now fields with the background + increment … … 651 651 ! 652 652 it = kt - nit000 + 1 653 zincwgt = wgtiau(it) / r dt ! IAU weight for the current time step653 zincwgt = wgtiau(it) / rn_Dt ! IAU weight for the current time step 654 654 ! 655 655 IF(lwp) THEN … … 677 677 IF ( kt == nitdin_r ) THEN 678 678 ! 679 neuler = 0! Force Euler forward step679 l_1st_euler = .TRUE. ! Force Euler forward step 680 680 ! 681 681 ! Initialize the now fields with the background + increment … … 721 721 ! 722 722 it = kt - nit000 + 1 723 zincwgt = wgtiau(it) / r dt ! IAU weight for the current time step723 zincwgt = wgtiau(it) / rn_Dt ! IAU weight for the current time step 724 724 ! 725 725 IF(lwp) THEN … … 752 752 IF ( kt == nitdin_r ) THEN 753 753 ! 754 neuler = 0! Force Euler forward step754 l_1st_euler = .TRUE. ! Force Euler forward step 755 755 ! 756 756 sshn(:,:) = ssh_bkg(:,:) + ssh_bkginc(:,:) ! Initialize the now fields the background + increment … … 758 758 sshb(:,:) = sshn(:,:) ! Update before fields 759 759 e3t_b(:,:,:) = e3t_n(:,:,:) 760 !!gm why not e3u_b, e3v_b, gdept_b ???? 760 761 !!gm BUG : missing the update of all other scale factors (e3u e3v e3w etc... _n and _b) 762 !! see dom_vvl_init 761 763 ! 762 764 DEALLOCATE( ssh_bkg ) … … 839 841 it = kt - nit000 + 1 840 842 zincwgt = wgtiau(it) ! IAU weight for the current time step 841 ! note this is not a tendency so should not be divided by r dt (as with the tracer and other increments)843 ! note this is not a tendency so should not be divided by rn_Dt (as with the tracer and other increments) 842 844 ! 843 845 IF(lwp) THEN … … 874 876 #if defined key_cice && defined key_asminc 875 877 ! Sea-ice : CICE case. Pass ice increment tendency into CICE 876 ndaice_da(:,:) = seaice_bkginc(:,:) * zincwgt / r dt878 ndaice_da(:,:) = seaice_bkginc(:,:) * zincwgt / rn_Dt 877 879 #endif 878 880 ! … … 894 896 IF ( kt == nitdin_r ) THEN 895 897 ! 896 neuler = 0! Force Euler forward step898 l_1st_euler = .TRUE. ! Force Euler forward step 897 899 ! 898 900 ! Sea-ice : SI3 case … … 924 926 #if defined key_cice && defined key_asminc 925 927 ! Sea-ice : CICE case. Pass ice increment tendency into CICE 926 ndaice_da(:,:) = seaice_bkginc(:,:) / r dt928 ndaice_da(:,:) = seaice_bkginc(:,:) / rn_Dt 927 929 #endif 928 930 IF ( .NOT. PRESENT(kindic) ) THEN … … 957 959 ! ! fwf : ice formation and melting 958 960 ! 959 ! zfons = ( -nfresh_da(ji,jj)*soce + nfsalt_da(ji,jj) ) *rdt961 ! zfons = ( -nfresh_da(ji,jj)*soce + nfsalt_da(ji,jj) ) * rn_Dt 960 962 ! 961 963 ! ! change salinity down to mixed layer depth … … 1006 1008 ! !! ! E-P (kg m-2 s-2) 1007 1009 ! ! emp(ji,jj) = emp(ji,jj) + zpmess ! E-P (kg m-2 s-2) 1008 ! END DO !ji1009 ! END DO !jj!1010 ! END DO !ji 1011 ! END DO !jj! 1010 1012 ! 1011 1013 ! ENDIF !ln_seaicebal -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/BDY/bdyice.F90
r9657 r9939 124 124 125 125 ! Then, a) transfer the snow excess into the ice (different from icethd_dh) 126 zdh = MAX( 0._wp, ( rhos n * h_s(ji,jj,jl) + ( rhoic - rau0 ) * h_i(ji,jj,jl) ) * r1_rau0 )126 zdh = MAX( 0._wp, ( rhos * h_s(ji,jj,jl) + ( rhoi - rho0 ) * h_i(ji,jj,jl) ) * r1_rho0 ) 127 127 ! Or, b) transfer all the snow into ice (if incoming ice is likely to melt as it comes into a warmer environment) 128 !zdh = MAX( 0._wp, h_s(ji,jj,jl) * rhos n / rhoic)128 !zdh = MAX( 0._wp, h_s(ji,jj,jl) * rhos / rhoi ) 129 129 130 130 ! recompute h_i, h_s 131 131 h_i(ji,jj,jl) = MIN( hi_max(jl), h_i(ji,jj,jl) + zdh ) 132 h_s(ji,jj,jl) = MAX( 0._wp, h_s(ji,jj,jl) - zdh * rhoi c / rhosn)133 134 END DO132 h_s(ji,jj,jl) = MAX( 0._wp, h_s(ji,jj,jl) - zdh * rhoi / rhos ) 133 134 END DO 135 135 CALL lbc_bdy_lnk( a_i(:,:,jl), 'T', 1., ib_bdy ) 136 136 CALL lbc_bdy_lnk( h_i(:,:,jl), 'T', 1., ib_bdy ) 137 137 CALL lbc_bdy_lnk( h_s(:,:,jl), 'T', 1., ib_bdy ) 138 END DO138 END DO 139 139 ! retrieve at_i 140 140 at_i(:,:) = 0._wp … … 212 212 DO jk = 1, nlay_s 213 213 ! Snow energy of melting 214 e_s(ji,jj,jk,jl) = rswitch * rhos n * ( cpic * ( rt0 - t_s(ji,jj,jk,jl) ) + lfus )214 e_s(ji,jj,jk,jl) = rswitch * rhos * ( rcpi * ( rt0 - t_s(ji,jj,jk,jl) ) + rLfus ) 215 215 ! Multiply by volume, so that heat content in J/m2 216 216 e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) * v_s(ji,jj,jl) * r1_nlay_s … … 219 219 ztmelts = - tmut * sz_i(ji,jj,jk,jl) + rt0 !Melting temperature in K 220 220 ! heat content per unit volume 221 e_i(ji,jj,jk,jl) = rswitch * rhoi c* &222 ( cpic* ( ztmelts - t_i(ji,jj,jk,jl) ) &223 + lfus* ( 1.0 - (ztmelts-rt0) / MIN((t_i(ji,jj,jk,jl)-rt0),-epsi20) ) &224 - rcp* ( ztmelts - rt0 ) )221 e_i(ji,jj,jk,jl) = rswitch * rhoi * & 222 ( rcpi * ( ztmelts - t_i(ji,jj,jk,jl) ) & 223 + rLfus * ( 1.0 - (ztmelts-rt0) / MIN((t_i(ji,jj,jk,jl)-rt0),-epsi20) ) & 224 - rcp * ( ztmelts - rt0 ) ) 225 225 ! Mutliply by ice volume, and divide by number of layers to get heat content in J/m2 226 226 e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * a_i(ji,jj,jl) * h_i(ji,jj,jl) * r1_nlay_i -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/BDY/bdylib.F90
r9598 r9939 4 4 !! Unstructured Open Boundary Cond. : Library module of generic boundary algorithms. 5 5 !!====================================================================== 6 !! History : 3.6 ! 2013 (D. Storkey) original code7 !! 4.0 ! 2014 (T. Lovato) Generalize OBC structure6 !! History : 3.6 ! 2013 (D. Storkey) original code 7 !! 4.0 ! 2014 (T. Lovato) Generalize OBC structure 8 8 !!---------------------------------------------------------------------- 9 9 10 !!---------------------------------------------------------------------- 10 !! bdy_orlanski_2d 11 !! bdy_orlanski_3d 11 !! bdy_frs : Apply the Flow Relaxation Scheme (tracers) 12 !! bdy_spe : Apply a specified value (tracers) 13 !! bdy_orl : Apply Orlanski radiation (tracers) 14 !! bdy_orlanski_2d: 2D - - - 15 !! bdy_orlanski_3d: 3D - - - 16 !! bdy_nmn : Duplicate the value at open boundaries (zero gradient) 12 17 !!---------------------------------------------------------------------- 13 18 USE oce ! ocean dynamics and tracers … … 22 27 PRIVATE 23 28 24 PUBLIC bdy_frs, bdy_spe, bdy_nmn, bdy_orl 25 PUBLIC bdy_orlanski_2d 26 PUBLIC bdy_orlanski_3d 29 PUBLIC bdy_frs, bdy_spe, bdy_nmn 30 PUBLIC bdy_orl, bdy_orlanski_2d, bdy_orlanski_3d 27 31 28 32 !!---------------------------------------------------------------------- … … 230 234 ! Note no rdt factor in expression for zdt because it cancels in the expressions for 231 235 ! zrx and zry. 232 zdt = phia(iibm1,ijbm1) - phib(iibm1,ijbm1)236 zdt = phia(iibm1,ijbm1) - phib(iibm1,ijbm1) 233 237 zdx = ( ( phia(iibm1,ijbm1) - phia(iibm2,ijbm2) ) / zex2 ) * zmask_x 234 238 zdy_1 = ( ( phib(iibm1 ,ijbm1 ) - phib(iibm1jm1,ijbm1jm1) ) / zey1 ) * zmask_y1 … … 247 251 zout = sign( 1., zrx ) 248 252 zout = 0.5*( zout + abs(zout) ) 249 zwgt = 2.*rdt*( (1.-zout) * idx%nbd(jb,igrd) + zout * idx%nbdout(jb,igrd) )253 zwgt = rDt*( (1.-zout) * idx%nbd(jb,igrd) + zout * idx%nbdout(jb,igrd) ) 250 254 ! only apply radiation on outflow points 251 255 if( ll_npo ) then !! NPO version !! … … 385 389 ! Centred derivative is calculated as average of "left" and "right" derivatives for 386 390 ! this reason. 387 zdt = phia(iibm1,ijbm1,jk) - phib(iibm1,ijbm1,jk)391 zdt = phia(iibm1,ijbm1,jk) - phib(iibm1,ijbm1,jk) 388 392 zdx = ( ( phia(iibm1,ijbm1,jk) - phia(iibm2,ijbm2,jk) ) / zex2 ) * zmask_x 389 393 zdy_1 = ( ( phib(iibm1 ,ijbm1 ,jk) - phib(iibm1jm1,ijbm1jm1,jk) ) / zey1 ) * zmask_y1 … … 402 406 !!$ zrx = min(zrx,2.0_wp) 403 407 zout = sign( 1., zrx ) 404 zout = 0.5 *( zout + abs(zout) )405 zwgt = 2.*rdt*( (1.-zout) * idx%nbd(jb,igrd) + zout * idx%nbdout(jb,igrd) )408 zout = 0.5 * ( zout + abs(zout) ) 409 zwgt = rDt * ( (1.-zout) * idx%nbd(jb,igrd) + zout * idx%nbdout(jb,igrd) ) 406 410 ! only apply radiation on outflow points 407 411 if( ll_npo ) then !! NPO version !! … … 426 430 ! 427 431 END SUBROUTINE bdy_orlanski_3d 432 428 433 429 434 SUBROUTINE bdy_nmn( idx, igrd, phia ) -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/BDY/bdytides.F90
r9598 r9939 295 295 !!---------------------------------------------------------------------- 296 296 ! 297 ilen0(1) = SIZE( td%ssh(:,1,1))298 ilen0(2) = SIZE( td%u(:,1,1))299 ilen0(3) = SIZE( td%v(:,1,1))297 ilen0(1) = SIZE( td%ssh(:,1,1) ) 298 ilen0(2) = SIZE( td%u (:,1,1) ) 299 ilen0(3) = SIZE( td%v (:,1,1) ) 300 300 301 301 zflag=1 302 302 IF ( PRESENT(jit) ) THEN 303 IF ( jit /= 1 ) zflag=0303 IF ( jit /= 1 ) zflag=0 304 304 ENDIF 305 305 306 IF ( ( nsec_day == NINT(0.5_wp * rdt) .OR. kt==nit000) .AND. zflag==1 ) THEN306 IF ( ( nsec_day == NINT( 0.5_wp * rn_Dt ) .OR. kt == nit000 ) .AND. zflag==1 ) THEN 307 307 ! 308 kt_tide = kt - (nsec_day - 0.5_wp * r dt)/rdt308 kt_tide = kt - (nsec_day - 0.5_wp * rn_Dt) / rn_Dt 309 309 ! 310 310 IF(lwp) THEN 311 311 WRITE(numout,*) 312 WRITE(numout,*) 'bdytide_update : (re)Initialization of the tidal bdy forcing at kt=', kt312 WRITE(numout,*) 'bdytide_update : (re)Initialization of the tidal bdy forcing at kt=', kt 313 313 WRITE(numout,*) '~~~~~~~~~~~~~~ ' 314 314 ENDIF … … 325 325 326 326 IF( PRESENT(jit) ) THEN 327 z_arg = ((kt-kt_tide) * r dt + (jit+0.5_wp*(time_add-1)) * rdt / REAL(nn_baro,wp) )327 z_arg = ((kt-kt_tide) * rn_Dt + (jit+0.5_wp*(time_add-1)) * rn_Dt / REAL(nn_e,wp) ) 328 328 ELSE 329 z_arg = ((kt-kt_tide)+time_add) * r dt329 z_arg = ((kt-kt_tide)+time_add) * rn_Dt 330 330 ENDIF 331 331 332 332 ! Linear ramp on tidal component at open boundaries 333 333 zramp = 1._wp 334 IF (ln_tide_ramp) zramp = MIN(MAX( (z_arg + (kt_tide-nit000)*r dt)/(rdttideramp*rday),0._wp),1._wp)334 IF (ln_tide_ramp) zramp = MIN(MAX( (z_arg + (kt_tide-nit000)*rn_Dt)/(rn_ramp*rday),0._wp),1._wp) 335 335 336 336 DO itide = 1, nb_harmo … … 392 392 ! Absolute time from model initialization: 393 393 IF( PRESENT(kit) ) THEN 394 z_arg = ( kt + (kit+time_add-1) / REAL(nn_ baro,wp) ) * rdt394 z_arg = ( kt + (kit+time_add-1) / REAL(nn_e,wp) ) * rn_Dt 395 395 ELSE 396 z_arg = ( kt + time_add ) * r dt396 z_arg = ( kt + time_add ) * rn_Dt 397 397 ENDIF 398 398 399 399 ! Linear ramp on tidal component at open boundaries 400 400 zramp = 1. 401 IF ( ln_tide_ramp) zramp = MIN(MAX( (z_arg - nit000*rdt)/(rdttideramp*rday),0.),1.)401 IF ( ln_tide_ramp ) zramp = MIN( MAX( 0. , (z_arg - nit000*rn_Dt)/(rn_ramp*rday) ) , 1. ) 402 402 403 403 DO ib_bdy = 1,nb_bdy … … 414 414 ! We refresh nodal factors every day below 415 415 ! This should be done somewhere else 416 IF ( ( nsec_day == NINT(0.5_wp * r dt) .OR. kt==nit000 ) .AND. lk_first_btstp ) THEN417 ! 418 kt_tide = kt - (nsec_day - 0.5_wp * r dt)/rdt416 IF ( ( nsec_day == NINT(0.5_wp * rn_Dt) .OR. kt==nit000 ) .AND. lk_first_btstp ) THEN 417 ! 418 kt_tide = kt - (nsec_day - 0.5_wp * rn_Dt) / rn_Dt 419 419 ! 420 420 IF(lwp) THEN … … 428 428 ! 429 429 ENDIF 430 zoff = -kt_tide * r dt! time offset relative to nodal factor computation time430 zoff = -kt_tide * rn_Dt ! time offset relative to nodal factor computation time 431 431 ! 432 432 ! If time splitting, initialize arrays from slow varying open boundary data: -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/BDY/bdyvol.F90
r9598 r9939 84 84 ! ----------------------------------------------------------------------- 85 85 !!gm replace these lines : 86 z_cflxemp = SUM ( ( emp(:,:) - rnf(:,:) + fwfisf(:,:) ) * bdytmask(:,:) * e1e2t(:,:) ) / r au086 z_cflxemp = SUM ( ( emp(:,:) - rnf(:,:) + fwfisf(:,:) ) * bdytmask(:,:) * e1e2t(:,:) ) / rho0 87 87 IF( lk_mpp ) CALL mpp_sum( z_cflxemp ) ! sum over the global domain 88 88 !!gm by : 89 !!gm z_cflxemp = glob_sum( ( emp(:,:)-rnf(:,:)+fwfisf(:,:) ) * bdytmask(:,:) * e1e2t(:,:) ) / r au090 !!gm 89 !!gm z_cflxemp = glob_sum( ( emp(:,:)-rnf(:,:)+fwfisf(:,:) ) * bdytmask(:,:) * e1e2t(:,:) ) / rho0 90 !!gm ??? 91 91 92 92 ! Transport through the unstructured open boundary -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/DIA/dia25h.F90
r9598 r9939 139 139 ! ----------------- 140 140 ! Define frequency of summing to create 25 h mean 141 IF( MOD( 3600 ,INT(rdt) ) == 0 ) THEN142 i_steps = 3600 /INT(rdt)141 IF( MOD( 3600 , INT(rn_Dt) ) == 0 ) THEN 142 i_steps = 3600 / INT( rn_Dt ) 143 143 ELSE 144 CALL ctl_stop('STOP', 'dia_wri_tide: timestep must give MOD(3600,r dt) = 0 otherwise no hourly values are possible')144 CALL ctl_stop('STOP', 'dia_wri_tide: timestep must give MOD(3600,rn_Dt) = 0 otherwise no hourly values are possible') 145 145 ENDIF 146 146 -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/DIA/diaar5.F90
r9598 r9939 161 161 162 162 ! ! ocean bottom pressure 163 zztmp = r au0 * grav * 1.e-4_wp ! recover pressure from pressure anomaly and cover to dbar = 1.e4 Pa163 zztmp = rho0 * grav * 1.e-4_wp ! recover pressure from pressure anomaly and cover to dbar = 1.e4 Pa 164 164 zbotpres(:,:) = zztmp * ( zbotpres(:,:) + sshn(:,:) + thick0(:,:) ) 165 165 CALL iom_put( 'botpres', zbotpres ) … … 198 198 END IF 199 199 ! 200 zmass = r au0 * ( zarho + zvol ) ! total mass of liquid seawater200 zmass = rho0 * ( zarho + zvol ) ! total mass of liquid seawater 201 201 ztemp = ztemp / zvol ! potential temperature in liquid seawater 202 202 zsal = zsal / zvol ! Salinity of liquid seawater … … 239 239 DO ji = 1, jpi 240 240 DO jj = 1, jpj 241 zpe(ji,jj) = zpe(ji,jj) + avt(ji, jj, jk) * MIN(0._wp,rn2(ji, jj, jk)) * r au0 * e3w_n(ji, jj, jk)241 zpe(ji,jj) = zpe(ji,jj) + avt(ji, jj, jk) * MIN(0._wp,rn2(ji, jj, jk)) * rho0 * e3w_n(ji, jj, jk) 242 242 END DO 243 243 END DO … … 287 287 CALL lbc_lnk( z2d, 'U', -1. ) 288 288 IF( cptr == 'adv' ) THEN 289 IF( ktra == jp_tem ) CALL iom_put( "uadv_heattr" , r au0_rcp * z2d ) ! advective heat transport in i-direction290 IF( ktra == jp_sal ) CALL iom_put( "uadv_salttr" , r au0 * z2d ) ! advective salt transport in i-direction289 IF( ktra == jp_tem ) CALL iom_put( "uadv_heattr" , rho0_rcp * z2d ) ! advective heat transport in i-direction 290 IF( ktra == jp_sal ) CALL iom_put( "uadv_salttr" , rho0 * z2d ) ! advective salt transport in i-direction 291 291 ENDIF 292 292 IF( cptr == 'ldf' ) THEN 293 IF( ktra == jp_tem ) CALL iom_put( "udiff_heattr" , r au0_rcp * z2d ) ! diffusive heat transport in i-direction294 IF( ktra == jp_sal ) CALL iom_put( "udiff_salttr" , r au0 * z2d ) ! diffusive salt transport in i-direction293 IF( ktra == jp_tem ) CALL iom_put( "udiff_heattr" , rho0_rcp * z2d ) ! diffusive heat transport in i-direction 294 IF( ktra == jp_sal ) CALL iom_put( "udiff_salttr" , rho0 * z2d ) ! diffusive salt transport in i-direction 295 295 ENDIF 296 296 ! … … 305 305 CALL lbc_lnk( z2d, 'V', -1. ) 306 306 IF( cptr == 'adv' ) THEN 307 IF( ktra == jp_tem ) CALL iom_put( "vadv_heattr" , r au0_rcp * z2d ) ! advective heat transport in j-direction308 IF( ktra == jp_sal ) CALL iom_put( "vadv_salttr" , r au0 * z2d ) ! advective salt transport in j-direction307 IF( ktra == jp_tem ) CALL iom_put( "vadv_heattr" , rho0_rcp * z2d ) ! advective heat transport in j-direction 308 IF( ktra == jp_sal ) CALL iom_put( "vadv_salttr" , rho0 * z2d ) ! advective salt transport in j-direction 309 309 ENDIF 310 310 IF( cptr == 'ldf' ) THEN 311 IF( ktra == jp_tem ) CALL iom_put( "vdiff_heattr" , r au0_rcp * z2d ) ! diffusive heat transport in j-direction312 IF( ktra == jp_sal ) CALL iom_put( "vdiff_salttr" , r au0 * z2d ) ! diffusive salt transport in j-direction311 IF( ktra == jp_tem ) CALL iom_put( "vdiff_heattr" , rho0_rcp * z2d ) ! diffusive heat transport in j-direction 312 IF( ktra == jp_sal ) CALL iom_put( "vdiff_salttr" , rho0 * z2d ) ! diffusive salt transport in j-direction 313 313 ENDIF 314 314 -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/DIA/diacfl.F90
r9598 r9939 55 55 ! 56 56 INTEGER :: ji, jj, jk ! dummy loop indices 57 REAL(wp):: z 2dt, zCu_max, zCv_max, zCw_max ! local scalars57 REAL(wp):: zCu_max, zCv_max, zCw_max ! local scalars 58 58 INTEGER , DIMENSION(3) :: iloc_u , iloc_v , iloc_w , iloc ! workspace 59 59 !!gm this does not work REAL(wp), DIMENSION(jpi,jpj,jpk) :: zCu_cfl, zCv_cfl, zCw_cfl ! workspace … … 62 62 IF( ln_timing ) CALL timing_start('dia_cfl') 63 63 ! 64 ! ! setup timestep multiplier to account for initial Eulerian timestep65 IF( neuler == 0 .AND. kt == nit000 ) THEN ; z2dt = rdt66 ELSE ; z2dt = rdt * 2._wp67 ENDIF68 !69 64 ! 70 65 DO jk = 1, jpk ! calculate Courant numbers 71 66 DO jj = 1, jpj 72 67 DO ji = 1, fs_jpim1 ! vector opt. 73 zCu_cfl(ji,jj,jk) = ABS( un(ji,jj,jk) ) * z2dt / e1u (ji,jj) ! for i-direction74 zCv_cfl(ji,jj,jk) = ABS( vn(ji,jj,jk) ) * z2dt / e2v (ji,jj) ! for j-direction75 zCw_cfl(ji,jj,jk) = ABS( wn(ji,jj,jk) ) * z2dt / e3w_n(ji,jj,jk) ! for k-direction68 zCu_cfl(ji,jj,jk) = ABS( un(ji,jj,jk) ) * rDt / e1u (ji,jj) ! for i-direction 69 zCv_cfl(ji,jj,jk) = ABS( vn(ji,jj,jk) ) * rDt / e2v (ji,jj) ! for j-direction 70 zCw_cfl(ji,jj,jk) = ABS( wn(ji,jj,jk) ) * rDt / e3w_n(ji,jj,jk) ! for k-direction 76 71 END DO 77 72 END DO … … 120 115 WRITE(numcfl,*) '******************************************' 121 116 WRITE(numcfl,FMT='(3x,a12,6x,f7.4,1x,i4,1x,i4,1x,i4)') 'Run Max Cu', rCu_max, nCu_loc(1), nCu_loc(2), nCu_loc(3) 122 WRITE(numcfl,FMT='(3x,a8,11x,f15.1)') ' => dt/C', z2dt/rCu_max117 WRITE(numcfl,FMT='(3x,a8,11x,f15.1)') ' => dt/C', rDt/rCu_max 123 118 WRITE(numcfl,*) '******************************************' 124 119 WRITE(numcfl,FMT='(3x,a12,6x,f7.4,1x,i4,1x,i4,1x,i4)') 'Run Max Cv', rCv_max, nCv_loc(1), nCv_loc(2), nCv_loc(3) 125 WRITE(numcfl,FMT='(3x,a8,11x,f15.1)') ' => dt/C', z2dt/rCv_max120 WRITE(numcfl,FMT='(3x,a8,11x,f15.1)') ' => dt/C', rDt/rCv_max 126 121 WRITE(numcfl,*) '******************************************' 127 122 WRITE(numcfl,FMT='(3x,a12,6x,f7.4,1x,i4,1x,i4,1x,i4)') 'Run Max Cw', rCw_max, nCw_loc(1), nCw_loc(2), nCw_loc(3) 128 WRITE(numcfl,FMT='(3x,a8,11x,f15.1)') ' => dt/C', z2dt/rCw_max123 WRITE(numcfl,FMT='(3x,a8,11x,f15.1)') ' => dt/C', rDt/rCw_max 129 124 CLOSE( numcfl ) 130 125 ! … … 133 128 WRITE(numout,*) 'dia_cfl : Maximum Courant number information for the run ' 134 129 WRITE(numout,*) '~~~~~~~' 135 WRITE(numout,*) ' Max Cu = ', rCu_max, ' at (i,j,k) = (',nCu_loc(1),nCu_loc(2),nCu_loc(3),') => dt/C = ', z2dt/rCu_max136 WRITE(numout,*) ' Max Cv = ', rCv_max, ' at (i,j,k) = (',nCv_loc(1),nCv_loc(2),nCv_loc(3),') => dt/C = ', z2dt/rCv_max137 WRITE(numout,*) ' Max Cw = ', rCw_max, ' at (i,j,k) = (',nCw_loc(1),nCw_loc(2),nCw_loc(3),') => dt/C = ', z2dt/rCw_max130 WRITE(numout,*) ' Max Cu = ', rCu_max, ' at (i,j,k) = (',nCu_loc(1),nCu_loc(2),nCu_loc(3),') => dt/C = ', rDt/rCu_max 131 WRITE(numout,*) ' Max Cv = ', rCv_max, ' at (i,j,k) = (',nCv_loc(1),nCv_loc(2),nCv_loc(3),') => dt/C = ', rDt/rCv_max 132 WRITE(numout,*) ' Max Cw = ', rCw_max, ' at (i,j,k) = (',nCw_loc(1),nCw_loc(2),nCw_loc(3),') => dt/C = ', rDt/rCw_max 138 133 ENDIF 139 134 ! -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/DIA/diadct.F90
r9598 r9939 679 679 zsn = interp(k%I,k%J,jk,'V',tsn(:,:,:,jp_sal) ) 680 680 zrhop = interp(k%I,k%J,jk,'V',rhop) 681 zrhoi = interp(k%I,k%J,jk,'V',rhd*r au0+rau0)681 zrhoi = interp(k%I,k%J,jk,'V',rhd*rho0+rho0) 682 682 zsshn = 0.5*( sshn(k%I,k%J) + sshn(k%I,k%J+1) ) * vmask(k%I,k%J,1) 683 683 CASE(2,3) … … 685 685 zsn = interp(k%I,k%J,jk,'U',tsn(:,:,:,jp_sal) ) 686 686 zrhop = interp(k%I,k%J,jk,'U',rhop) 687 zrhoi = interp(k%I,k%J,jk,'U',rhd*r au0+rau0)687 zrhoi = interp(k%I,k%J,jk,'U',rhd*rho0+rho0) 688 688 zsshn = 0.5*( sshn(k%I,k%J) + sshn(k%I+1,k%J) ) * umask(k%I,k%J,1) 689 689 END SELECT … … 851 851 zsn = interp(k%I,k%J,jk,'V',tsn(:,:,:,jp_sal) ) 852 852 zrhop = interp(k%I,k%J,jk,'V',rhop) 853 zrhoi = interp(k%I,k%J,jk,'V',rhd*r au0+rau0)853 zrhoi = interp(k%I,k%J,jk,'V',rhd*rho0+rho0) 854 854 855 855 CASE(2,3) … … 857 857 zsn = interp(k%I,k%J,jk,'U',tsn(:,:,:,jp_sal) ) 858 858 zrhop = interp(k%I,k%J,jk,'U',rhop) 859 zrhoi = interp(k%I,k%J,jk,'U',rhd*r au0+rau0)859 zrhoi = interp(k%I,k%J,jk,'U',rhd*rho0+rho0) 860 860 zsshn = 0.5*( sshn(k%I,k%J) + sshn(k%I+1,k%J) ) * umask(k%I,k%J,1) 861 861 END SELECT -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/DIA/diaharm.F90
r9598 r9939 181 181 IF( kt >= nit000_han .AND. kt <= nitend_han .AND. MOD(kt,nstep_han) == 0 ) THEN 182 182 ! 183 ztime = ( kt-nit000+1) * rdt183 ztime = ( kt - nit000+1 ) * rn_Dt 184 184 ! 185 185 nhc = 0 … … 231 231 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~' 232 232 233 ztime_ini = nit000_han*r dt ! Initial time in seconds at the beginning of analysis234 ztime_end = nitend_han*r dt ! Final time in seconds at the end of analysis233 ztime_ini = nit000_han*rn_Dt ! Initial time in seconds at the beginning of analysis 234 ztime_end = nitend_han*rn_Dt ! Final time in seconds at the end of analysis 235 235 nhan = (nitend_han-nit000_han+1)/nstep_han ! Number of dumps used for analysis 236 236 -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/DIA/diahsb.F90
r9598 r9939 91 91 ! 1 - Trends due to forcing ! 92 92 ! ------------------------- ! 93 z_frc_trd_v = r1_r au0 * glob_sum( - ( emp(:,:) - rnf(:,:) + fwfisf(:,:) ) * surf(:,:) ) ! volume fluxes93 z_frc_trd_v = r1_rho0 * glob_sum( - ( emp(:,:) - rnf(:,:) + fwfisf(:,:) ) * surf(:,:) ) ! volume fluxes 94 94 z_frc_trd_t = glob_sum( sbc_tsc(:,:,jp_tem) * surf(:,:) ) ! heat fluxes 95 95 z_frc_trd_s = glob_sum( sbc_tsc(:,:,jp_sal) * surf(:,:) ) ! salt fluxes … … 100 100 IF( ln_isf ) z_frc_trd_t = z_frc_trd_t + glob_sum( risf_tsc(:,:,jp_tem) * surf(:,:) ) 101 101 ! ! Add penetrative solar radiation 102 IF( ln_traqsr ) z_frc_trd_t = z_frc_trd_t + r1_r au0_rcp * glob_sum( qsr (:,:) * surf(:,:) )102 IF( ln_traqsr ) z_frc_trd_t = z_frc_trd_t + r1_rho0_rcp * glob_sum( qsr (:,:) * surf(:,:) ) 103 103 ! ! Add geothermal heat flux 104 104 IF( ln_trabbc ) z_frc_trd_t = z_frc_trd_t + glob_sum( qgh_trd0(:,:) * surf(:,:) ) … … 120 120 ENDIF 121 121 122 frc_v = frc_v + z_frc_trd_v * r dt123 frc_t = frc_t + z_frc_trd_t * r dt124 frc_s = frc_s + z_frc_trd_s * r dt122 frc_v = frc_v + z_frc_trd_v * rn_Dt 123 frc_t = frc_t + z_frc_trd_t * rn_Dt 124 frc_s = frc_s + z_frc_trd_s * rn_Dt 125 125 ! ! Advection flux through fixed surface (z=0) 126 126 IF( ln_linssh ) THEN 127 frc_wn_t = frc_wn_t + z_wn_trd_t * r dt128 frc_wn_s = frc_wn_s + z_wn_trd_s * r dt127 frc_wn_t = frc_wn_t + z_wn_trd_t * rn_Dt 128 frc_wn_s = frc_wn_s + z_wn_trd_s * rn_Dt 129 129 ENDIF 130 130 … … 196 196 197 197 CALL iom_put( 'bgfrcvol' , frc_v * 1.e-9 ) ! vol - surface forcing (km3) 198 CALL iom_put( 'bgfrctem' , frc_t * r au0 * rcp * 1.e-20 )! hc - surface forcing (1.e20 J)199 CALL iom_put( 'bgfrchfx' , frc_t * r au0 * rcp / &! hc - surface forcing (W/m2)200 & ( surf_tot * kt * rdt ))198 CALL iom_put( 'bgfrctem' , frc_t * rho0_rcp * 1.e-20 ) ! hc - surface forcing (1.e20 J) 199 CALL iom_put( 'bgfrchfx' , frc_t * rho0_rcp / & ! hc - surface forcing (W/m2) 200 & ( surf_tot * kt * rn_Dt ) ) 201 201 CALL iom_put( 'bgfrcsal' , frc_s * 1.e-9 ) ! sc - surface forcing (psu*km3) 202 202 … … 204 204 CALL iom_put( 'bgtemper' , zdiff_hc / zvol_tot ) ! Temperature drift (C) 205 205 CALL iom_put( 'bgsaline' , zdiff_sc / zvol_tot ) ! Salinity drift (PSU) 206 CALL iom_put( 'bgheatco' , zdiff_hc * 1.e-20 * r au0 * rcp )! Heat content drift (1.e20 J)207 CALL iom_put( 'bgheatfx' , zdiff_hc * r au0 * rcp / &! Heat flux drift (W/m2)208 & ( surf_tot * kt * r dt ))206 CALL iom_put( 'bgheatco' , zdiff_hc * 1.e-20 * rho0_rcp ) ! Heat content drift (1.e20 J) 207 CALL iom_put( 'bgheatfx' , zdiff_hc * rho0_rcp / & ! Heat flux drift (W/m2) 208 & ( surf_tot * kt * rn_Dt ) ) 209 209 CALL iom_put( 'bgsaltco' , zdiff_sc * 1.e-9 ) ! Salt content drift (psu*km3) 210 210 CALL iom_put( 'bgvolssh' , zdiff_v1 * 1.e-9 ) ! volume ssh drift (km3) … … 224 224 CALL iom_put( 'bgtemper' , zdiff_hc1 / zvol_tot) ! Heat content drift (C) 225 225 CALL iom_put( 'bgsaline' , zdiff_sc1 / zvol_tot) ! Salt content drift (PSU) 226 CALL iom_put( 'bgheatco' , zdiff_hc1 * 1.e-20 * r au0 * rcp )! Heat content drift (1.e20 J)227 CALL iom_put( 'bgheatfx' , zdiff_hc1 * r au0 * rcp / &! Heat flux drift (W/m2)228 & ( surf_tot * kt * r dt ))226 CALL iom_put( 'bgheatco' , zdiff_hc1 * 1.e-20 * rho0_rcp ) ! Heat content drift (1.e20 J) 227 CALL iom_put( 'bgheatfx' , zdiff_hc1 * rho0_rcp / & ! Heat flux drift (W/m2) 228 & ( surf_tot * kt * rn_Dt ) ) 229 229 CALL iom_put( 'bgsaltco' , zdiff_sc1 * 1.e-9 ) ! Salt content drift (psu*km3) 230 230 CALL iom_put( 'bgvolssh' , zdiff_v1 * 1.e-9 ) ! volume ssh drift (km3) -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/DIA/diahth.F90
r9598 r9939 89 89 REAL(wp) :: zrho1 = 0.01_wp ! density criterion for mixed layer depth 90 90 REAL(wp) :: ztem2 = 0.2_wp ! temperature criterion for mixed layer depth 91 REAL(wp) :: zthick_0 , zcoef ! temporaryscalars92 REAL(wp) :: zztmp, zzdep ! temporaryscalars inside do loop93 REAL(wp) :: zu, zv, zw, zut, zvt ! temporaryworkspace91 REAL(wp) :: zthick_0 ! local scalars 92 REAL(wp) :: zztmp, zzdep ! local scalars inside do loop 93 REAL(wp) :: zu, zv, zw, zut, zvt ! local workspace 94 94 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: zabs2 ! MLD: abs( tn - tn(10m) ) = ztem2 95 95 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: ztm2 ! Top of thermocline: tn = tn(10m) - ztem2 … … 328 328 END DO 329 329 ! from temperature to heat contain 330 zcoef = rau0 * rcp 331 htc3(:,:) = zcoef * htc3(:,:) 330 htc3(:,:) = rho0_rcp * htc3(:,:) 332 331 CALL iom_put( "hc300", htc3 ) ! first 300m heat content 333 332 ! -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/DIA/dianam.F90
r9598 r9939 71 71 ENDIF 72 72 73 IF( llfsec .OR. kfreq < 0 ) THEN ; inbsec = kfreq 74 ELSE ; inbsec = kfreq * NINT( r dt )! from time-step to seconds73 IF( llfsec .OR. kfreq < 0 ) THEN ; inbsec = kfreq ! output frequency already in seconds 74 ELSE ; inbsec = kfreq * NINT( rn_Dt ) ! 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 = r dt / rday * REAL( nitend - nit000, wp )! length of the run in days119 zjul = fjulday - r dt / rday118 zdrun = rn_Dt / rday * REAL( nitend - nit000, wp ) ! length of the run in days 119 zjul = fjulday - rn_Dt / 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 -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/DIA/diaptr.F90
r9598 r9939 52 52 53 53 REAL(wp) :: rc_sv = 1.e-6_wp ! conversion from m3/s to Sverdrup 54 REAL(wp) :: rc_pwatt = 1.e-15_wp ! conversion from W to PW (further x r au0 x Cp)54 REAL(wp) :: rc_pwatt = 1.e-15_wp ! conversion from W to PW (further x rho0 x Cp) 55 55 REAL(wp) :: rc_ggram = 1.e-6_wp ! conversion from g to Pg 56 56 … … 424 424 IF( dia_ptr_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'dia_ptr_init : unable to allocate arrays' ) 425 425 426 rc_pwatt = rc_pwatt * r au0_rcp ! conversion from K.s-1 to PetaWatt426 rc_pwatt = rc_pwatt * rho0_rcp ! conversion from K.s-1 to PetaWatt 427 427 428 428 IF( lk_mpp ) CALL mpp_ini_znl( numout ) ! Define MPI communicator for zonal sum … … 448 448 ! Initialise arrays to zero because diatpr is called before they are first calculated 449 449 ! Note that this means diagnostics will not be exactly correct when model run is restarted. 450 htr_adv(:,:) = 0._wp ; str_adv(:,:) = 0._wp451 htr_ldf(:,:) = 0._wp ; str_ldf(:,:) = 0._wp452 htr_eiv(:,:) = 0._wp ; str_eiv(:,:) = 0._wp450 htr_adv(:,:) = 0._wp ; str_adv(:,:) = 0._wp 451 htr_ldf(:,:) = 0._wp ; str_ldf(:,:) = 0._wp 452 htr_eiv(:,:) = 0._wp ; str_eiv(:,:) = 0._wp 453 453 htr_ove(:,:) = 0._wp ; str_ove(:,:) = 0._wp 454 454 htr_btr(:,:) = 0._wp ; str_btr(:,:) = 0._wp -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/DIA/diawri.F90
r9652 r9939 169 169 170 170 IF ( iom_use("taubot") ) THEN ! bottom stress 171 zztmp = r au0 * 0.25171 zztmp = rho0 * 0.25 172 172 z2d(:,:) = 0._wp 173 173 DO jj = 2, jpjm1 … … 212 212 IF( iom_use('w_masstr') .OR. iom_use('w_masstr2') ) THEN ! vertical mass transport & its square value 213 213 ! Caution: in the VVL case, it only correponds to the baroclinic mass transport. 214 z2d(:,:) = r au0 * e1e2t(:,:)214 z2d(:,:) = rho0 * e1e2t(:,:) 215 215 DO jk = 1, jpk 216 216 z3d(:,:,jk) = wn(:,:,jk) * z2d(:,:) … … 253 253 END DO 254 254 END DO 255 CALL iom_put( "heatc", r au0_rcp * z2d ) ! vertically integrated heat content (J/m2)255 CALL iom_put( "heatc", rho0_rcp * z2d ) ! vertically integrated heat content (J/m2) 256 256 ENDIF 257 257 … … 265 265 END DO 266 266 END DO 267 CALL iom_put( "saltc", r au0 * z2d ) ! vertically integrated salt content (PSU*kg/m2)267 CALL iom_put( "saltc", rho0 * z2d ) ! vertically integrated salt content (PSU*kg/m2) 268 268 ENDIF 269 269 ! … … 291 291 z2d(:,:) = 0.e0 292 292 DO jk = 1, jpkm1 293 z3d(:,:,jk) = r au0 * un(:,:,jk) * e2u(:,:) * e3u_n(:,:,jk) * umask(:,:,jk)293 z3d(:,:,jk) = rho0 * un(:,:,jk) * e2u(:,:) * e3u_n(:,:,jk) * umask(:,:,jk) 294 294 z2d(:,:) = z2d(:,:) + z3d(:,:,jk) 295 295 END DO … … 328 328 z3d(:,:,jpk) = 0.e0 329 329 DO jk = 1, jpkm1 330 z3d(:,:,jk) = r au0 * vn(:,:,jk) * e1v(:,:) * e3v_n(:,:,jk) * vmask(:,:,jk)330 z3d(:,:,jk) = rho0 * vn(:,:,jk) * e1v(:,:) * e3v_n(:,:,jk) * vmask(:,:,jk) 331 331 END DO 332 332 CALL iom_put( "v_masstr", z3d ) ! mass transport in j-direction … … 369 369 END DO 370 370 CALL lbc_lnk( z2d, 'T', -1. ) 371 CALL iom_put( "tosmint", r au0 * z2d ) ! Vertical integral of temperature371 CALL iom_put( "tosmint", rho0 * z2d ) ! Vertical integral of temperature 372 372 ENDIF 373 373 IF( iom_use("somint") ) THEN … … 381 381 END DO 382 382 CALL lbc_lnk( z2d, 'T', -1. ) 383 CALL iom_put( "somint", r au0 * z2d ) ! Vertical integral of salinity383 CALL iom_put( "somint", rho0 * z2d ) ! Vertical integral of salinity 384 384 ENDIF 385 385 … … 458 458 clop = "x" ! no use of the mask value (require less cpu time and otherwise the model crashes) 459 459 #if defined key_diainstant 460 zsto = nwrite * r dt460 zsto = nwrite * rn_Dt 461 461 clop = "inst("//TRIM(clop)//")" 462 462 #else 463 zsto =rdt463 zsto = rn_Dt 464 464 clop = "ave("//TRIM(clop)//")" 465 465 #endif 466 zout = nwrite * r dt467 zmax = ( nitend - nit000 + 1 ) * r dt466 zout = nwrite * rn_Dt 467 zmax = ( nitend - nit000 + 1 ) * rn_Dt 468 468 469 469 ! Define indices of the horizontal output zoom and vertical limit storage … … 485 485 486 486 ! Compute julian date from starting date of the run 487 CALL ymds2ju( nyear, nmonth, nday, r dt, zjulian )487 CALL ymds2ju( nyear, nmonth, nday, rn_Dt, zjulian ) 488 488 zjulian = zjulian - adatrj ! set calendar origin to the beginning of the experiment 489 489 IF(lwp)WRITE(numout,*) … … 507 507 CALL histbeg( clhstnam, jpi, glamt, jpj, gphit, & ! Horizontal grid: glamt and gphit 508 508 & iimi, iima-iimi+1, ijmi, ijma-ijmi+1, & 509 & nit000-1, zjulian, r dt, nh_T, nid_T, domain_id=nidom, snc4chunks=snc4set )509 & nit000-1, zjulian, rn_Dt, nh_T, nid_T, domain_id=nidom, snc4chunks=snc4set ) 510 510 CALL histvert( nid_T, "deptht", "Vertical T levels", & ! Vertical grid: gdept 511 511 & "m", ipk, gdept_1d, nz_T, "down" ) … … 543 543 CALL histbeg( clhstnam, jpi, glamu, jpj, gphiu, & ! Horizontal grid: glamu and gphiu 544 544 & iimi, iima-iimi+1, ijmi, ijma-ijmi+1, & 545 & nit000-1, zjulian, r dt, nh_U, nid_U, domain_id=nidom, snc4chunks=snc4set )545 & nit000-1, zjulian, rn_Dt, nh_U, nid_U, domain_id=nidom, snc4chunks=snc4set ) 546 546 CALL histvert( nid_U, "depthu", "Vertical U levels", & ! Vertical grid: gdept 547 547 & "m", ipk, gdept_1d, nz_U, "down" ) … … 556 556 CALL histbeg( clhstnam, jpi, glamv, jpj, gphiv, & ! Horizontal grid: glamv and gphiv 557 557 & iimi, iima-iimi+1, ijmi, ijma-ijmi+1, & 558 & nit000-1, zjulian, r dt, nh_V, nid_V, domain_id=nidom, snc4chunks=snc4set )558 & nit000-1, zjulian, rn_Dt, nh_V, nid_V, domain_id=nidom, snc4chunks=snc4set ) 559 559 CALL histvert( nid_V, "depthv", "Vertical V levels", & ! Vertical grid : gdept 560 560 & "m", ipk, gdept_1d, nz_V, "down" ) … … 569 569 CALL histbeg( clhstnam, jpi, glamt, jpj, gphit, & ! Horizontal grid: glamt and gphit 570 570 & iimi, iima-iimi+1, ijmi, ijma-ijmi+1, & 571 & nit000-1, zjulian, r dt, nh_W, nid_W, domain_id=nidom, snc4chunks=snc4set )571 & nit000-1, zjulian, rn_Dt, nh_W, nid_W, domain_id=nidom, snc4chunks=snc4set ) 572 572 CALL histvert( nid_W, "depthw", "Vertical W levels", & ! Vertical grid: gdepw 573 573 & "m", ipk, gdepw_1d, nz_W, "down" ) … … 897 897 clname = cdfile_name 898 898 IF( .NOT. Agrif_Root() ) clname = TRIM(Agrif_CFixed())//'_'//TRIM(clname) 899 zsto = r dt899 zsto = rn_Dt 900 900 clop = "inst(x)" ! no use of the mask value (require less cpu time) 901 zout = r dt902 zmax = ( nitend - nit000 + 1 ) * r dt901 zout = rn_Dt 902 zmax = ( nitend - nit000 + 1 ) * rn_Dt 903 903 904 904 IF(lwp) WRITE(numout,*) … … 912 912 913 913 ! Compute julian date from starting date of the run 914 CALL ymds2ju( nyear, nmonth, nday, r dt, zjulian ) ! time axis914 CALL ymds2ju( nyear, nmonth, nday, rn_Dt, zjulian ) ! time axis 915 915 zjulian = zjulian - adatrj ! set calendar origin to the beginning of the experiment 916 916 CALL histbeg( clname, jpi, glamt, jpj, gphit, & 917 1, jpi, 1, jpj, nit000-1, zjulian, r dt, nh_i, id_i, domain_id=nidom, snc4chunks=snc4set ) ! Horizontal grid : glamt and gphit917 1, jpi, 1, jpj, nit000-1, zjulian, rn_Dt, nh_i, id_i, domain_id=nidom, snc4chunks=snc4set ) ! Horizontal grid : glamt and gphit 918 918 CALL histvert( id_i, "deptht", "Vertical T levels", & ! Vertical grid : gdept 919 919 "m", jpk, gdept_1d, nz_i, "down") -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/DIU/cool_skin.F90
r9598 r9939 68 68 69 69 70 SUBROUTINE diurnal_sst_coolskin_step(psqflux, pstauflux, psrho, rdt)70 SUBROUTINE diurnal_sst_coolskin_step(psqflux, pstauflux, psrho, pdt) 71 71 !!---------------------------------------------------------------------- 72 72 !! *** ROUTINE diurnal_sst_takaya_step *** … … 82 82 REAL(wp), INTENT(IN), DIMENSION(jpi,jpj) :: pstauflux ! Wind stress (kg/ m s^2) 83 83 REAL(wp), INTENT(IN), DIMENSION(jpi,jpj) :: psrho ! Water density (kg/m^3) 84 REAL(wp), INTENT(IN) :: rdt ! Time-step84 REAL(wp), INTENT(IN) :: pdt ! Time-step (s) 85 85 86 86 ! Local variables -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/DIU/diurnal_bulk.F90
r9168 r9939 78 78 79 79 80 SUBROUTINE diurnal_sst_takaya_step(kt, psolflux, pqflux, ptauflux, prho, p _rdt, &80 SUBROUTINE diurnal_sst_takaya_step(kt, psolflux, pqflux, ptauflux, prho, pdt, & 81 81 & pla, pthick, pcoolthick, pmu, & 82 82 & p_fvel_bkginc, p_hflux_bkginc) … … 98 98 REAL(wp), DIMENSION(jpi,jpj) , INTENT(in) :: ptauflux ! wind stress (kg/ m s^2) 99 99 REAL(wp), DIMENSION(jpi,jpj) , INTENT(in) :: prho ! water density (kg/m^3) 100 REAL(wp) , INTENT(in) :: p _rdt ! time-step100 REAL(wp) , INTENT(in) :: pdt ! time-step (s) 101 101 REAL(wp), DIMENSION(jpi,jpj), OPTIONAL, INTENT(in) :: pLa ! Langmuir number 102 102 REAL(wp), DIMENSION(jpi,jpj), OPTIONAL, INTENT(in) :: pthick ! warm layer thickness (m) … … 167 167 168 168 ! Increment the temperature using the implicit solution 169 x_dsst(:,:) = t_imp( x_dsst(:,:), p _rdt, z_abflux(:,:), z_fvel(:,:), &169 x_dsst(:,:) = t_imp( x_dsst(:,:), pdt, z_abflux(:,:), z_fvel(:,:), & 170 170 & z_fla(:,:), zmu(:,:), zthick(:,:), prho(:,:) ) 171 171 ! … … 173 173 174 174 175 FUNCTION t_imp(p_dsst, p _rdt, p_abflux, p_fvel, &175 FUNCTION t_imp(p_dsst, pdt, p_abflux, p_fvel, & 176 176 p_fla, pmu, pthick, prho ) 177 177 … … 182 182 ! Dummy variables 183 183 REAL(wp), DIMENSION(jpi,jpj), INTENT(IN) :: p_dsst ! Delta SST 184 REAL(wp), INTENT(IN) :: p _rdt ! Time-step184 REAL(wp), INTENT(IN) :: pdt ! Time-step (s) 185 185 REAL(wp), DIMENSION(jpi,jpj), INTENT(IN) :: p_abflux ! Heat forcing 186 186 REAL(wp), DIMENSION(jpi,jpj), INTENT(IN) :: p_fvel ! Friction velocity … … 257 257 & ( pthick(ji,jj) * z_stabfunc ) ) 258 258 259 t_imp(ji,jj) = ( p_dsst(ji,jj) + p _rdt * z_term1 ) / &260 ( 1._wp - p _rdt * z_term2 )259 t_imp(ji,jj) = ( p_dsst(ji,jj) + pdt * z_term1 ) / & 260 ( 1._wp - pdt * z_term2 ) 261 261 262 262 END DO 263 263 END DO 264 264 265 END FUNCTION t_imp 266 265 END FUNCTION t_imp 266 267 !!====================================================================== 267 268 END MODULE diurnal_bulk -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/DIU/step_diu.F90
r9598 r9939 5 5 !!====================================================================== 6 6 !! History : 3.7 ! 2015-11 (J. While) Original code 7 !!---------------------------------------------------------------------- 7 8 8 9 USE diurnal_bulk ! diurnal SST bulk routines (diurnal_sst_takaya routine) … … 27 28 !! Software governed by the CeCILL licence (./LICENSE) 28 29 !!---------------------------------------------------------------------- 29 30 30 CONTAINS 31 31 32 32 SUBROUTINE stp_diurnal( kstp ) 33 INTEGER, INTENT(in) :: kstp ! ocean time-step index34 33 !!---------------------------------------------------------------------- 35 34 !! *** ROUTINE stp_diurnal *** … … 46 45 !! -8- Outputs and diagnostics 47 46 !!---------------------------------------------------------------------- 47 INTEGER, INTENT(in) :: kstp ! ocean time-step index 48 ! 48 49 INTEGER :: jk ! dummy loop indices 49 50 INTEGER :: indic ! error indicator if < 0 … … 51 52 !! --------------------------------------------------------------------- 52 53 53 IF( ln_diurnal_only) THEN54 IF( ln_diurnal_only ) THEN 54 55 indic = 0 ! reset to no error condition 55 56 IF( kstp /= nit000 ) CALL day( kstp ) ! Calendar (day was already called at nit000 in day_init) … … 60 61 ENDIF 61 62 62 CALL sbc ( kstp ) ! SeaBoundary Conditions63 CALL sbc( kstp ) ! Sea Surface Boundary Conditions 63 64 ENDIF 64 65 65 ! Cool skin66 66 IF( .NOT.ln_diurnal ) CALL ctl_stop( "stp_diurnal: ln_diurnal not set" ) 67 67 68 68 IF( .NOT. ln_blk ) CALL ctl_stop( "stp_diurnal: diurnal flux processing only implemented for bulk forcing" ) 69 69 70 CALL diurnal_sst_coolskin_step( qns, taum, rhop(:,:,1), rdt) 70 ! ! Cool skin 71 CALL diurnal_sst_coolskin_step( qns, taum, rhop(:,:,1), rn_Dt ) 71 72 72 CALL iom_put( "sst_wl" , x_dsst )! warm layer (write out before update below).73 CALL iom_put( "sst_cs" , x_csdsst )! cool skin73 CALL iom_put( "sst_wl", x_dsst ) ! warm layer (write out before update below). 74 CALL iom_put( "sst_cs", x_csdsst ) ! cool skin 74 75 75 ! Diurnal warm layer model 76 CALL diurnal_sst_takaya_step( kstp, & 77 & qsr, qns, taum, rhop(:,:,1), rdt) 76 ! ! Diurnal warm layer model 77 CALL diurnal_sst_takaya_step( kstp, qsr, qns, taum, rhop(:,:,1), rn_Dt ) 78 78 79 79 IF( ln_diurnal_only ) THEN 80 IF( ln_diaobs ) CALL dia_obs( kstp )! obs-minus-model (assimilation) diagnostics (call after dynamics update)80 IF( ln_diaobs ) CALL dia_obs( kstp ) ! obs-minus-model (assimilation) diagnostics (call after dynamics update) 81 81 82 82 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> … … 84 84 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 85 85 IF( kstp == nit000 ) CALL iom_close( numror ) ! close input ocean restart file 86 IF( lrst_oce ) CALL rst_write ( kstp )! write output ocean restart file86 IF( lrst_oce ) CALL rst_write( kstp ) ! write output ocean restart file 87 87 88 88 IF( ln_timing .AND. kstp == nit000 ) CALL timing_reset … … 91 91 END SUBROUTINE stp_diurnal 92 92 93 !!====================================================================== 93 94 END MODULE step_diu -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/DOM/daymod.F90
r9598 r9939 20 20 !! ------------------------------- 21 21 !! sbcmod assume that the time step is dividing the number of second of 22 !! in a day, i.e. ===> MOD( rday, r dt ) == 022 !! in a day, i.e. ===> MOD( rday, rn_Dt ) == 0 23 23 !! except when user defined forcing is used (see sbcmod.F90) 24 24 !!---------------------------------------------------------------------- … … 72 72 ! 73 73 ! max number of seconds between each restart 74 IF( REAL( nitend - nit000 + 1 ) * r dt > REAL( HUGE( nsec1jan000 ) ) ) THEN74 IF( REAL( nitend - nit000 + 1 ) * rn_Dt > REAL( HUGE( nsec1jan000 ) ) ) THEN 75 75 CALL ctl_stop( 'The number of seconds between each restart exceeds the integer 4 max value: 2^31-1. ', & 76 76 & 'You must do a restart at higher frequency (or remove this stop and recompile the code in I8)' ) 77 77 ENDIF 78 nsecd = NINT( rday )79 nsecd05 = NINT( 0.5 * rday )80 ndt = NINT( r dt)81 ndt05 = NINT( 0.5 * r dt)78 nsecd = NINT( rday ) 79 nsecd05 = NINT( 0.5 * rday ) 80 ndt = NINT( rn_Dt ) 81 ndt05 = NINT( 0.5 * rn_Dt ) 82 82 83 83 IF( .NOT. l_offline ) CALL day_rst( nit000, 'READ' ) … … 239 239 nsec_week = nsec_week + ndt 240 240 nsec_day = nsec_day + ndt 241 adatrj = adatrj + r dt / rday242 fjulday = fjulday + r dt / rday241 adatrj = adatrj + rn_Dt / rday 242 fjulday = fjulday + rn_Dt / rday 243 243 IF( ABS(fjulday - REAL(NINT(fjulday),wp)) < zprec ) fjulday = REAL(NINT(fjulday),wp) ! avoid truncation error 244 244 IF( ABS(adatrj - REAL(NINT(adatrj ),wp)) < zprec ) adatrj = REAL(NINT(adatrj ),wp) ! avoid truncation error … … 309 309 !! In both those options, the exact duration of the experiment 310 310 !! since the beginning (cumulated duration of all previous restart runs) 311 !! is not stored in the restart and is assumed to be (nit000-1)*r dt.311 !! is not stored in the restart and is assumed to be (nit000-1)*rn_Dt. 312 312 !! This is valid is the time step has remained constant. 313 313 !! … … 378 378 nminute = ( nn_time0 - nhour * 100 ) 379 379 IF( nhour*3600+nminute*60-ndt05 .lt. 0 ) ndastp=ndastp-1 ! Start hour is specified in the namelist (default 0) 380 adatrj = ( REAL( nit000-1, wp ) * r dt ) / rday380 adatrj = ( REAL( nit000-1, wp ) * rn_Dt ) / rday 381 381 ! note this is wrong if time step has changed during run 382 382 ENDIF … … 387 387 nminute = ( nn_time0 - nhour * 100 ) 388 388 IF( nhour*3600+nminute*60-ndt05 .lt. 0 ) ndastp=ndastp-1 ! Start hour is specified in the namelist (default 0) 389 adatrj = ( REAL( nit000-1, wp ) * r dt ) / rday389 adatrj = ( REAL( nit000-1, wp ) * rn_Dt ) / rday 390 390 ENDIF 391 391 IF( ABS(adatrj - REAL(NINT(adatrj),wp)) < 0.1 / rday ) adatrj = REAL(NINT(adatrj),wp) ! avoid truncation error -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/DOM/dom_oce.F90
r9667 r9939 33 33 LOGICAL , PUBLIC :: ln_meshmask !: =T create a mesh-mask file (mesh_mask.nc) 34 34 REAL(wp), PUBLIC :: rn_isfhmin !: threshold to discriminate grounded ice to floating ice 35 REAL(wp), PUBLIC :: rn_ rdt!: time step for the dynamics and tracer35 REAL(wp), PUBLIC :: rn_dt !: time step for the dynamics and tracer 36 36 REAL(wp), PUBLIC :: rn_atfp !: asselin time filter parameter 37 INTEGER , PUBLIC :: nn_euler!: =0 start with forward time step or not (=1)37 LOGICAL , PUBLIC :: ln_1st_euler !: =0 start with forward time step or not (=1) 38 38 LOGICAL , PUBLIC :: ln_iscpl !: coupling with ice sheet 39 39 LOGICAL , PUBLIC :: ln_crs !: Apply grid coarsening to dynamical model output or online passive tracers … … 50 50 LOGICAL, PUBLIC :: ln_bt_auto !: Set number of barotropic iterations automatically 51 51 INTEGER, PUBLIC :: nn_bt_flt !: Filter choice 52 INTEGER, PUBLIC :: nn_ baro !: Number of barotropic iterations during one baroclinic step (rdt)52 INTEGER, PUBLIC :: nn_e !: Number of external mode sub-step used at each ocean time-step 53 53 REAL(wp), PUBLIC :: rn_bt_cmax !: Maximum allowed courant number (used if ln_bt_auto=T) 54 54 REAL(wp), PUBLIC :: rn_bt_alpha !: Time stepping diffusion parameter 55 55 56 57 ! !! old non-DOCTOR names still used in the model58 REAL(wp), PUBLIC :: atfp !: asselin time filter parameter59 REAL(wp), PUBLIC :: rdt !: time step for the dynamics and tracer60 61 56 ! !!! associated variables 62 INTEGER , PUBLIC :: neuler !: restart euler forward option (0=Euler) 63 REAL(wp), PUBLIC :: r2dt !: = 2*rdt except at nit000 (=rdt) if neuler=0 57 LOGICAL , PUBLIC :: l_1st_euler !: Euler 1st time-step flag (=T if ln_restart=F or ln_1st_euler=T) 58 REAL(wp), PUBLIC :: rDt, r1_Dt !: MLF: = 2*rn_Dt and 1/(2*rn_Dt) except if l_1st_euler=T where half the value is used 59 ! ! RK3: = rn_Dt 64 60 65 61 !!---------------------------------------------------------------------- -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/DOM/domain.F90
r9598 r9939 288 288 INTEGER :: ios ! Local integer 289 289 ! 290 NAMELIST/namrun/ cn_ocerst_indir, cn_ocerst_outdir, nn_stocklist, ln_rst_list, &291 & nn_no , cn_exp , cn_ocerst_in, cn_ocerst_out, ln_rstart , nn_rstctl , &292 & nn_it000, nn_itend , nn_date0 , nn_time0 , nn_leapy , nn_istate , &293 & nn_stock, nn_write , ln_mskland , ln_clobber , nn_chunksz, nn_euler, &290 NAMELIST/namrun/ cn_ocerst_indir, cn_ocerst_outdir, nn_stocklist, ln_rst_list, & 291 & nn_no , cn_exp , cn_ocerst_in, cn_ocerst_out, ln_rstart , nn_rstctl , & 292 & nn_it000, nn_itend , nn_date0 , nn_time0 , nn_leapy , nn_istate , & 293 & nn_stock, nn_write , ln_mskland , ln_clobber , nn_chunksz, ln_1st_euler, & 294 294 & ln_cfmeta, ln_iscpl, ln_xios_read, nn_wxios 295 NAMELIST/namdom/ ln_linssh, rn_isfhmin, rn_ rdt, rn_atfp, ln_crs, ln_meshmask295 NAMELIST/namdom/ ln_linssh, rn_isfhmin, rn_Dt, rn_atfp, ln_crs, ln_meshmask 296 296 #if defined key_netcdf4 297 297 NAMELIST/namnc4/ nn_nchunks_i, nn_nchunks_j, nn_nchunks_k, ln_nc4zip … … 323 323 WRITE(numout,*) ' restart output directory cn_ocerst_outdir= ', TRIM( cn_ocerst_outdir ) 324 324 WRITE(numout,*) ' restart logical ln_rstart = ', ln_rstart 325 WRITE(numout,*) ' start with forward time step nn_euler = ', nn_euler325 WRITE(numout,*) ' start with forward time step ln_1st_euler = ', ln_1st_euler 326 326 WRITE(numout,*) ' control of time step nn_rstctl = ', nn_rstctl 327 327 WRITE(numout,*) ' number of the first time step nn_it000 = ', nn_it000 … … 361 361 nstocklist = nn_stocklist 362 362 nwrite = nn_write 363 neuler = nn_euler 364 IF( neuler == 1 .AND. .NOT. ln_rstart ) THEN 363 IF( ln_rstart ) THEN ! restart : set 1st time-step scheme (LF or forward) 364 l_1st_euler = ln_1st_euler 365 ELSE ! start from rest : always an Euler scheme for the 1st time-step 365 366 IF(lwp) WRITE(numout,*) 366 367 IF(lwp) WRITE(numout,*)' ==>>> Start from rest (ln_rstart=F)' 367 IF(lwp) WRITE(numout,*)' an Euler initial time step is used : nn_euler is forced to 0'368 neuler = 0368 IF(lwp) WRITE(numout,*)' an Euler initial time step is used ' 369 l_1st_euler = .TRUE. 369 370 ENDIF 370 371 ! ! control of output frequency … … 374 375 nstock = nitend 375 376 ENDIF 376 IF 377 IF( nwrite == 0 ) THEN 377 378 WRITE(ctmp1,*) 'nwrite = ', nwrite, ' it is forced to ', nitend 378 379 CALL ctl_warn( ctmp1 ) … … 413 414 WRITE(numout,*) ' create mesh/mask file ln_meshmask = ', ln_meshmask 414 415 WRITE(numout,*) ' treshold to open the isf cavity rn_isfhmin = ', rn_isfhmin, ' [m]' 415 WRITE(numout,*) ' ocean time step rn_ rdt = ', rn_rdt416 WRITE(numout,*) ' ocean time step rn_dt = ', rn_dt 416 417 WRITE(numout,*) ' asselin time filter parameter rn_atfp = ', rn_atfp 417 418 WRITE(numout,*) ' online coarsening of dynamical fields ln_crs = ', ln_crs 418 419 ENDIF 419 420 ! 420 ! ! conversion DOCTOR names into model names (this should disappear soon)421 atfp = rn_atfp422 rdt = rn_rdt423 424 421 IF( TRIM(Agrif_CFixed()) == '0' ) THEN 425 422 lrxios = ln_xios_read.AND.ln_rstart -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/DOM/domvvl.F90
r9598 r9939 54 54 LOGICAL , PUBLIC :: ln_vvl_dbg = .FALSE. ! debug control prints 55 55 56 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: un_td, vn_td 57 REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: hdiv_lf 58 REAL(wp) , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tilde_e3t_b, tilde_e3t_n ! baroclinic scale factors59 REAL(wp) , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tilde_e3t_a, dtilde_e3t_a ! baroclinic scale factors60 REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:) :: frq_rst_e3t 61 REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:) :: frq_rst_hdv 56 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: un_td, vn_td ! thickness diffusion transport 57 REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: hdiv_lf ! low frequency part of hz divergence 58 REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: te3t_b, te3t_n ! baroclinic scale factors 59 REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: te3t_a, dte3t_a ! baroclinic scale factors 60 REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:) :: frq_rst_e3t ! retoring period for scale factors 61 REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:) :: frq_rst_hdv ! retoring period for low freq. divergence 62 62 63 63 !! * Substitutions … … 76 76 IF( ln_vvl_zstar ) dom_vvl_alloc = 0 77 77 IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN 78 ALLOCATE( t ilde_e3t_b(jpi,jpj,jpk) , tilde_e3t_n(jpi,jpj,jpk) , tilde_e3t_a(jpi,jpj,jpk) , &79 & dt ilde_e3t_a(jpi,jpj,jpk) , un_td (jpi,jpj,jpk) , vn_td (jpi,jpj,jpk) , &78 ALLOCATE( te3t_b(jpi,jpj,jpk) , te3t_n(jpi,jpj,jpk) , te3t_a(jpi,jpj,jpk) , & 79 & dte3t_a(jpi,jpj,jpk) , un_td (jpi,jpj,jpk) , vn_td (jpi,jpj,jpk) , & 80 80 & STAT = dom_vvl_alloc ) 81 81 IF( lk_mpp ) CALL mpp_sum ( dom_vvl_alloc ) … … 103 103 !! - interpolate scale factors 104 104 !! 105 !! ** Action : - e3t_(n/b) and t ilde_e3t_(n/b)105 !! ** Action : - e3t_(n/b) and te3t_(n/b) 106 106 !! - Regrid: e3(u/v)_n 107 107 !! e3(u/v)_b … … 117 117 INTEGER :: ji, jj, jk 118 118 INTEGER :: ii0, ii1, ij0, ij1 119 REAL(wp):: zcoef 119 REAL(wp):: zcoef, z1_Dt 120 120 !!---------------------------------------------------------------------- 121 121 ! … … 129 129 IF( dom_vvl_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'dom_vvl_init : unable to allocate arrays' ) 130 130 ! 131 ! ! Read or initialize e3t_(b/n), t ilde_e3t_(b/n) and hdiv_lf131 ! ! Read or initialize e3t_(b/n), te3t_(b/n) and hdiv_lf 132 132 CALL dom_vvl_rst( nit000, 'READ' ) 133 133 e3t_a(:,:,jpk) = e3t_0(:,:,jpk) ! last level always inside the sea floor set one for all … … 208 208 IF( ln_vvl_ztilde_as_zstar ) THEN ! z-star emulation using z-tile 209 209 frq_rst_e3t(:,:) = 0._wp !Ignore namelist settings 210 frq_rst_hdv(:,:) = 1._wp / r dt210 frq_rst_hdv(:,:) = 1._wp / rn_Dt 211 211 ENDIF 212 212 IF ( ln_vvl_zstar_at_eqtor ) THEN ! use z-star in vicinity of the Equator 213 z1_Dt = 1._wp / rn_Dt 213 214 DO jj = 1, jpj 214 215 DO ji = 1, jpi … … 216 217 IF( ABS(gphit(ji,jj)) >= 6.) THEN 217 218 ! values outside the equatorial band and transition zone (ztilde) 218 frq_rst_e3t(ji,jj) = 2. 0_wp * rpi / ( MAX( rn_rst_e3t , rsmall ) * 86400.e0_wp )219 frq_rst_hdv(ji,jj) = 2. 0_wp * rpi / ( MAX( rn_lf_cutoff, rsmall ) * 86400.e0_wp )219 frq_rst_e3t(ji,jj) = 2._wp * rpi / ( MAX( rn_rst_e3t , rsmall ) * 86400._wp ) 220 frq_rst_hdv(ji,jj) = 2._wp * rpi / ( MAX( rn_lf_cutoff, rsmall ) * 86400._wp ) 220 221 ELSEIF( ABS(gphit(ji,jj)) <= 2.5) THEN ! Equator strip ==> z-star 221 222 ! values inside the equatorial band (ztilde as zstar) 222 frq_rst_e3t(ji,jj) = 0. 0_wp223 frq_rst_hdv(ji,jj) = 1.0_wp / rdt223 frq_rst_e3t(ji,jj) = 0._wp 224 frq_rst_hdv(ji,jj) = z1_Dt 224 225 ELSE ! transition band (2.5 to 6 degrees N/S) 225 226 ! ! (linearly transition from z-tilde to z-star) 226 frq_rst_e3t(ji,jj) = 0.0_wp + (frq_rst_e3t(ji,jj)-0.0_wp)*0.5_wp & 227 & * ( 1.0_wp - COS( rad*(ABS(gphit(ji,jj))-2.5_wp) & 228 & * 180._wp / 3.5_wp ) ) 229 frq_rst_hdv(ji,jj) = (1.0_wp / rdt) & 230 & + ( frq_rst_hdv(ji,jj)-(1.e0_wp / rdt) )*0.5_wp & 231 & * ( 1._wp - COS( rad*(ABS(gphit(ji,jj))-2.5_wp) & 232 & * 180._wp / 3.5_wp ) ) 227 frq_rst_e3t(ji,jj) = 0._wp + ( frq_rst_e3t(ji,jj) - 0._wp ) * 0.5_wp & 228 & * ( 1._wp - COS( rad*(ABS(gphit(ji,jj))-2.5_wp) * 180._wp / 3.5_wp ) ) 229 frq_rst_hdv(ji,jj) = z1_Dt + ( frq_rst_hdv(ji,jj) - z1_Dt ) * 0.5_wp & 230 & * ( 1._wp - COS( rad*(ABS(gphit(ji,jj))-2.5_wp) * 180._wp / 3.5_wp ) ) 233 231 ENDIF 234 232 END DO … … 237 235 ii0 = 103 ; ii1 = 111 238 236 ij0 = 128 ; ij1 = 135 ; 239 frq_rst_e3t( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0. 0_wp240 frq_rst_hdv( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1.e0_wp / rdt237 frq_rst_e3t( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0._wp 238 frq_rst_hdv( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = z1_Dt 241 239 ENDIF 242 240 ENDIF … … 280 278 !! 281 279 !! ** Action : - hdiv_lf : restoring towards full baroclinic divergence in z_tilde case 282 !! - t ilde_e3t_a: after increment of vertical scale factor280 !! - te3t_a: after increment of vertical scale factor 283 281 !! in z_tilde case 284 282 !! - e3(t/u/v)_a … … 345 343 IF( kt > nit000 ) THEN 346 344 DO jk = 1, jpkm1 347 hdiv_lf(:,:,jk) = hdiv_lf(:,:,jk) - r dt * frq_rst_hdv(:,:) &345 hdiv_lf(:,:,jk) = hdiv_lf(:,:,jk) - rn_Dt * frq_rst_hdv(:,:) & 348 346 & * ( hdiv_lf(:,:,jk) - e3t_n(:,:,jk) * ( hdivn(:,:,jk) - zhdiv(:,:) ) ) 349 347 END DO … … 353 351 ! II - after z_tilde increments of vertical scale factors 354 352 ! ======================================================= 355 t ilde_e3t_a(:,:,:) = 0._wp ! tilde_e3t_a used to store tendency terms353 te3t_a(:,:,:) = 0._wp ! te3t_a used to store tendency terms 356 354 357 355 ! 1 - High frequency divergence term … … 359 357 IF( ln_vvl_ztilde ) THEN ! z_tilde case 360 358 DO jk = 1, jpkm1 361 t ilde_e3t_a(:,:,jk) = tilde_e3t_a(:,:,jk) - ( e3t_n(:,:,jk) * ( hdivn(:,:,jk) - zhdiv(:,:) ) - hdiv_lf(:,:,jk) )359 te3t_a(:,:,jk) = te3t_a(:,:,jk) - ( e3t_n(:,:,jk) * ( hdivn(:,:,jk) - zhdiv(:,:) ) - hdiv_lf(:,:,jk) ) 362 360 END DO 363 361 ELSE ! layer case 364 362 DO jk = 1, jpkm1 365 t ilde_e3t_a(:,:,jk) = tilde_e3t_a(:,:,jk) - e3t_n(:,:,jk) * ( hdivn(:,:,jk) - zhdiv(:,:) ) * tmask(:,:,jk)363 te3t_a(:,:,jk) = te3t_a(:,:,jk) - e3t_n(:,:,jk) * ( hdivn(:,:,jk) - zhdiv(:,:) ) * tmask(:,:,jk) 366 364 END DO 367 365 ENDIF … … 371 369 IF( ln_vvl_ztilde ) THEN 372 370 DO jk = 1, jpk 373 t ilde_e3t_a(:,:,jk) = tilde_e3t_a(:,:,jk) - frq_rst_e3t(:,:) * tilde_e3t_b(:,:,jk)371 te3t_a(:,:,jk) = te3t_a(:,:,jk) - frq_rst_e3t(:,:) * te3t_b(:,:,jk) 374 372 END DO 375 373 ENDIF … … 383 381 DO ji = 1, fs_jpim1 ! vector opt. 384 382 un_td(ji,jj,jk) = rn_ahe3 * umask(ji,jj,jk) * e2_e1u(ji,jj) & 385 & * ( t ilde_e3t_b(ji,jj,jk) - tilde_e3t_b(ji+1,jj ,jk) )383 & * ( te3t_b(ji,jj,jk) - te3t_b(ji+1,jj ,jk) ) 386 384 vn_td(ji,jj,jk) = rn_ahe3 * vmask(ji,jj,jk) * e1_e2v(ji,jj) & 387 & * ( t ilde_e3t_b(ji,jj,jk) - tilde_e3t_b(ji ,jj+1,jk) )385 & * ( te3t_b(ji,jj,jk) - te3t_b(ji ,jj+1,jk) ) 388 386 zwu(ji,jj) = zwu(ji,jj) + un_td(ji,jj,jk) 389 387 zwv(ji,jj) = zwv(ji,jj) + vn_td(ji,jj,jk) … … 400 398 DO jj = 2, jpjm1 401 399 DO ji = fs_2, fs_jpim1 ! vector opt. 402 t ilde_e3t_a(ji,jj,jk) = tilde_e3t_a(ji,jj,jk) + ( un_td(ji-1,jj ,jk) - un_td(ji,jj,jk) &400 te3t_a(ji,jj,jk) = te3t_a(ji,jj,jk) + ( un_td(ji-1,jj ,jk) - un_td(ji,jj,jk) & 403 401 & + vn_td(ji ,jj-1,jk) - vn_td(ji,jj,jk) & 404 402 & ) * r1_e1e2t(ji,jj) … … 414 412 ! Leapfrog time stepping 415 413 ! ~~~~~~~~~~~~~~~~~~~~~~ 416 IF( neuler == 0 .AND. kt == nit000 ) THEN 417 z2dt = rdt 418 ELSE 419 z2dt = 2.0_wp * rdt 420 ENDIF 421 CALL lbc_lnk( tilde_e3t_a(:,:,:), 'T', 1._wp ) 422 tilde_e3t_a(:,:,:) = tilde_e3t_b(:,:,:) + z2dt * tmask(:,:,:) * tilde_e3t_a(:,:,:) 414 CALL lbc_lnk( te3t_a(:,:,:), 'T', 1._wp ) 415 te3t_a(:,:,:) = te3t_b(:,:,:) + z2dt * tmask(:,:,:) * te3t_a(:,:,:) 423 416 424 417 ! Maximum deformation control … … 426 419 ze3t(:,:,jpk) = 0._wp 427 420 DO jk = 1, jpkm1 428 ze3t(:,:,jk) = t ilde_e3t_a(:,:,jk) / e3t_0(:,:,jk) * tmask(:,:,jk) * tmask_i(:,:)421 ze3t(:,:,jk) = te3t_a(:,:,jk) / e3t_0(:,:,jk) * tmask(:,:,jk) * tmask_i(:,:) 429 422 END DO 430 423 z_tmax = MAXVAL( ze3t(:,:,:) ) … … 446 439 ENDIF 447 440 IF (lwp) THEN 448 WRITE(numout, *) 'MAX( t ilde_e3t_a(:,:,:) / e3t_0(:,:,:) ) =', z_tmax441 WRITE(numout, *) 'MAX( te3t_a(:,:,:) / e3t_0(:,:,:) ) =', z_tmax 449 442 WRITE(numout, *) 'at i, j, k=', ijk_max 450 WRITE(numout, *) 'MIN( t ilde_e3t_a(:,:,:) / e3t_0(:,:,:) ) =', z_tmin443 WRITE(numout, *) 'MIN( te3t_a(:,:,:) / e3t_0(:,:,:) ) =', z_tmin 451 444 WRITE(numout, *) 'at i, j, k=', ijk_min 452 CALL ctl_warn('MAX( ABS( t ilde_e3t_a(:,:,:) ) / e3t_0(:,:,:) ) too high')445 CALL ctl_warn('MAX( ABS( te3t_a(:,:,:) ) / e3t_0(:,:,:) ) too high') 453 446 ENDIF 454 447 ENDIF 455 448 ! - ML - end test 456 449 ! - ML - Imposing these limits will cause a baroclinicity error which is corrected for below 457 t ilde_e3t_a(:,:,:) = MIN( tilde_e3t_a(:,:,:), rn_zdef_max * e3t_0(:,:,:) )458 t ilde_e3t_a(:,:,:) = MAX( tilde_e3t_a(:,:,:), - rn_zdef_max * e3t_0(:,:,:) )450 te3t_a(:,:,:) = MIN( te3t_a(:,:,:), rn_zdef_max * e3t_0(:,:,:) ) 451 te3t_a(:,:,:) = MAX( te3t_a(:,:,:), - rn_zdef_max * e3t_0(:,:,:) ) 459 452 460 453 ! … … 462 455 ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 463 456 DO jk = 1, jpkm1 464 dt ilde_e3t_a(:,:,jk) = tilde_e3t_a(:,:,jk) - tilde_e3t_b(:,:,jk)457 dte3t_a(:,:,jk) = te3t_a(:,:,jk) - te3t_b(:,:,jk) 465 458 END DO 466 459 ! III - Barotropic repartition of the sea surface height over the baroclinic profile … … 470 463 ! i.e. locally and not spread over the water column. 471 464 ! (keep in mind that the idea is to reduce Eulerian velocity as much as possible) 472 zht(:,:) = 0. 465 zht(:,:) = 0._wp 473 466 DO jk = 1, jpkm1 474 zht(:,:) = zht(:,:) + t ilde_e3t_a(:,:,jk) * tmask(:,:,jk)467 zht(:,:) = zht(:,:) + te3t_a(:,:,jk) * tmask(:,:,jk) 475 468 END DO 476 469 z_scale(:,:) = - zht(:,:) / ( ht_0(:,:) + sshn(:,:) + 1. - ssmask(:,:) ) 477 470 DO jk = 1, jpkm1 478 dt ilde_e3t_a(:,:,jk) = dtilde_e3t_a(:,:,jk) + e3t_n(:,:,jk) * z_scale(:,:) * tmask(:,:,jk)471 dte3t_a(:,:,jk) = dte3t_a(:,:,jk) + e3t_n(:,:,jk) * z_scale(:,:) * tmask(:,:,jk) 479 472 END DO 480 473 … … 484 477 ! ! ---baroclinic part--------- ! 485 478 DO jk = 1, jpkm1 486 e3t_a(:,:,jk) = e3t_a(:,:,jk) + dt ilde_e3t_a(:,:,jk) * tmask(:,:,jk)479 e3t_a(:,:,jk) = e3t_a(:,:,jk) + dte3t_a(:,:,jk) * tmask(:,:,jk) 487 480 END DO 488 481 ENDIF … … 494 487 z_tmax = MAXVAL( tmask(:,:,1) * tmask_i(:,:) * ABS( zht(:,:) ) ) 495 488 IF( lk_mpp ) CALL mpp_max( z_tmax ) ! max over the global domain 496 IF( lwp ) WRITE(numout, *) kt,' MAXVAL(abs(SUM(t ilde_e3t_a))) =', z_tmax489 IF( lwp ) WRITE(numout, *) kt,' MAXVAL(abs(SUM(te3t_a))) =', z_tmax 497 490 END IF 498 491 ! … … 573 566 !! - recompute depths and water height fields 574 567 !! 575 !! ** Action : - e3t_(b/n), t ilde_e3t_(b/n) and e3(u/v)_n ready for next time step568 !! ** Action : - e3t_(b/n), te3t_(b/n) and e3(u/v)_n ready for next time step 576 569 !! - Recompute: 577 570 !! e3(u/v)_b … … 587 580 INTEGER, INTENT( in ) :: kt ! time step 588 581 ! 589 INTEGER :: ji, jj, jk ! dummy loop indices590 REAL(wp) :: zcoef 582 INTEGER :: ji, jj, jk ! dummy loop indices 583 REAL(wp) :: zcoef, ze3f ! local scalar 591 584 !!---------------------------------------------------------------------- 592 585 ! … … 605 598 ! - ML - e3(t/u/v)_b are allready computed in dynnxt. 606 599 IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN 607 IF( neuler == 0 .AND. kt == nit000) THEN608 t ilde_e3t_b(:,:,:) = tilde_e3t_n(:,:,:)600 IF( l_1st_euler ) THEN 601 te3t_n(:,:,:) = te3t_a(:,:,:) 609 602 ELSE 610 tilde_e3t_b(:,:,:) = tilde_e3t_n(:,:,:) & 611 & + atfp * ( tilde_e3t_b(:,:,:) - 2.0_wp * tilde_e3t_n(:,:,:) + tilde_e3t_a(:,:,:) ) 603 DO jk = 1, jpk 604 DO jj = 1, jpj 605 DO ji = 1, jpi 606 ze3f = te3t_n(ji,jj,jk) & 607 & + rn_atfp * ( te3t_b(ji,jj,jk) - 2.0_wp * te3t_n(ji,jj,jk) + te3t_a(ji,jj,jk) ) 608 te3t_b(ji,jj,jk) = ze3f 609 te3t_n(ji,jj,jk) = te3t_a(ji,jj,jk) 610 END DO 611 END DO 612 END DO 612 613 ENDIF 613 tilde_e3t_n(:,:,:) = tilde_e3t_a(:,:,:)614 614 ENDIF 615 615 gdept_b(:,:,:) = gdept_n(:,:,:) … … 806 806 CALL iom_get( numror, jpdom_autoglo, 'sshn' , sshn, ldxios = lrxios ) 807 807 ! 808 id1 = iom_varid( numror, 'e3t_b' , ldstop = .FALSE. )809 id2 = iom_varid( numror, 'e3t_n' , ldstop = .FALSE. )808 id1 = iom_varid( numror, 'e3t_b' , ldstop = .FALSE. ) 809 id2 = iom_varid( numror, 'e3t_n' , ldstop = .FALSE. ) 810 810 id3 = iom_varid( numror, 'tilde_e3t_b', ldstop = .FALSE. ) 811 811 id4 = iom_varid( numror, 'tilde_e3t_n', ldstop = .FALSE. ) 812 id5 = iom_varid( numror, 'hdiv_lf' , ldstop = .FALSE. )812 id5 = iom_varid( numror, 'hdiv_lf' , ldstop = .FALSE. ) 813 813 ! ! --------- ! 814 814 ! ! all cases ! … … 823 823 e3t_b(:,:,:) = e3t_0(:,:,:) 824 824 END WHERE 825 IF( neuler == 0) THEN825 IF( l_1st_euler ) THEN 826 826 e3t_b(:,:,:) = e3t_n(:,:,:) 827 827 ENDIF … … 829 829 IF(lwp) write(numout,*) 'dom_vvl_rst WARNING : e3t_n not found in restart files' 830 830 IF(lwp) write(numout,*) 'e3t_n set equal to e3t_b.' 831 IF(lwp) write(numout,*) ' neuler is forced to 0'831 IF(lwp) write(numout,*) 'l_1st_euler is forced to true' 832 832 CALL iom_get( numror, jpdom_autoglo, 'e3t_b', e3t_b(:,:,:), ldxios = lrxios ) 833 833 e3t_n(:,:,:) = e3t_b(:,:,:) 834 neuler = 0834 l_1st_euler = .TRUE. 835 835 ELSE IF( id2 > 0 ) THEN 836 836 IF(lwp) write(numout,*) 'dom_vvl_rst WARNING : e3t_b not found in restart files' 837 837 IF(lwp) write(numout,*) 'e3t_b set equal to e3t_n.' 838 IF(lwp) write(numout,*) ' neuler is forced to 0'838 IF(lwp) write(numout,*) 'l_1st_euler is forced to true' 839 839 CALL iom_get( numror, jpdom_autoglo, 'e3t_n', e3t_n(:,:,:), ldxios = lrxios ) 840 840 e3t_b(:,:,:) = e3t_n(:,:,:) 841 neuler = 0841 l_1st_euler = .TRUE. 842 842 ELSE 843 843 IF(lwp) write(numout,*) 'dom_vvl_rst WARNING : e3t_n not found in restart file' 844 844 IF(lwp) write(numout,*) 'Compute scale factor from sshn' 845 IF(lwp) write(numout,*) ' neuler is forced to 0'845 IF(lwp) write(numout,*) 'l_1st_euler is forced to true' 846 846 DO jk = 1, jpk 847 847 e3t_n(:,:,jk) = e3t_0(:,:,jk) * ( ht_0(:,:) + sshn(:,:) ) & … … 850 850 END DO 851 851 e3t_b(:,:,:) = e3t_n(:,:,:) 852 neuler = 0852 l_1st_euler = .TRUE. 853 853 ENDIF 854 854 ! ! ----------- ! … … 862 862 ! ! ----------------------- ! 863 863 IF( MIN( id3, id4 ) > 0 ) THEN ! all required arrays exist 864 CALL iom_get( numror, jpdom_autoglo, 'tilde_e3t_b', t ilde_e3t_b(:,:,:), ldxios = lrxios )865 CALL iom_get( numror, jpdom_autoglo, 'tilde_e3t_n', t ilde_e3t_n(:,:,:), ldxios = lrxios )864 CALL iom_get( numror, jpdom_autoglo, 'tilde_e3t_b', te3t_b(:,:,:), ldxios = lrxios ) 865 CALL iom_get( numror, jpdom_autoglo, 'tilde_e3t_n', te3t_n(:,:,:), ldxios = lrxios ) 866 866 ELSE ! one at least array is missing 867 t ilde_e3t_b(:,:,:) = 0.0_wp868 t ilde_e3t_n(:,:,:) = 0.0_wp867 te3t_b(:,:,:) = 0.0_wp 868 te3t_n(:,:,:) = 0.0_wp 869 869 ENDIF 870 870 ! ! ------------ ! … … 942 942 943 943 IF( ln_vvl_ztilde .OR. ln_vvl_layer) THEN 944 t ilde_e3t_b(:,:,:) = 0._wp945 t ilde_e3t_n(:,:,:) = 0._wp944 te3t_b(:,:,:) = 0._wp 945 te3t_n(:,:,:) = 0._wp 946 946 IF( ln_vvl_ztilde ) hdiv_lf(:,:,:) = 0._wp 947 947 END IF … … 960 960 IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN ! z_tilde and layer cases ! 961 961 ! ! ----------------------- ! 962 CALL iom_rstput( kt, nitrst, numrow, 'tilde_e3t_b', t ilde_e3t_b(:,:,:), ldxios = lwxios)963 CALL iom_rstput( kt, nitrst, numrow, 'tilde_e3t_n', t ilde_e3t_n(:,:,:), ldxios = lwxios)962 CALL iom_rstput( kt, nitrst, numrow, 'tilde_e3t_b', te3t_b(:,:,:), ldxios = lwxios) 963 CALL iom_rstput( kt, nitrst, numrow, 'tilde_e3t_n', te3t_n(:,:,:), ldxios = lwxios) 964 964 END IF 965 965 ! ! -------------! … … 1016 1016 WRITE(numout,*) ' rn_rst_e3t = 0.e0' 1017 1017 WRITE(numout,*) ' hard-wired : z-tilde cutoff frequency of low-pass filter (days)' 1018 WRITE(numout,*) ' rn_lf_cutoff = 1 .0/rdt'1018 WRITE(numout,*) ' rn_lf_cutoff = 1/rn_Dt' 1019 1019 ELSE 1020 1020 WRITE(numout,*) ' z-tilde to zstar restoration timescale (days) rn_rst_e3t = ', rn_rst_e3t -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/DOM/iscplini.F90
r9598 r9939 71 71 ! 72 72 nstp_iscpl=MIN( nn_fiscpl, nitend-nit000+1 ) ! the coupling period have to be less or egal than the total number of time step 73 rdt_iscpl = nstp_iscpl * rn_ rdt73 rdt_iscpl = nstp_iscpl * rn_Dt 74 74 ! 75 75 IF (lwp) THEN … … 79 79 WRITE(numout,*) ' conservation flag (ln_hsb ) = ', ln_hsb 80 80 WRITE(numout,*) ' nb of stp for cons (rn_fiscpl) = ', nstp_iscpl 81 IF (nstp_iscpl .NE.nn_fiscpl) WRITE(numout,*) 'W A R N I N G: nb of stp for cons has been modified &81 IF (nstp_iscpl /= nn_fiscpl) WRITE(numout,*) 'W A R N I N G: nb of stp for cons has been modified & 82 82 & (larger than run length)' 83 83 WRITE(numout,*) ' coupling time step = ', rdt_iscpl -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/DOM/iscplrst.F90
r9598 r9939 89 89 END IF 90 90 ! 91 neuler = 0! next step is an euler time step91 l_1st_euler = .TRUE. ! next step is an euler time step 92 92 ! 93 93 ! ! set _b and _n variables equal -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/DOM/istate.F90
r9598 r9939 92 92 ! ! --------------- 93 93 numror = 0 ! define numror = 0 -> no restart file to read 94 neuler = 0 ! Set time-step indicator at nit000 (euler forward)94 l_1st_euler = .TRUE. ! Set a Euler forward 1sr time-step 95 95 CALL day_init ! model calendar (using both namelist and restart infos) 96 96 ! ! Initialization of ocean to zero -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/DOM/phycst.F90
r9656 r9939 34 34 REAL(wp), PUBLIC :: rhhmm = 60._wp !: number of minutes in one hour 35 35 REAL(wp), PUBLIC :: rmmss = 60._wp !: number of seconds in one minute 36 REAL(wp), PUBLIC :: omega !: earth rotation parameter [s-1]37 REAL(wp), PUBLIC :: ra = 6371229._wp !: earth radius [m]38 REAL(wp), PUBLIC :: grav = 9.80665_wp !: gravity [m/s2]36 REAL(wp), PUBLIC :: omega !: earth rotation parameter [s-1] 37 REAL(wp), PUBLIC :: ra = 6371229._wp !: earth radius [m] 38 REAL(wp), PUBLIC :: grav = 9.80665_wp !: gravity [m/s2] 39 39 40 REAL(wp), PUBLIC :: rtt = 273.16_wp !: triple point of temperature [Kelvin] 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] 43 #if defined key_si3 44 REAL(wp), PUBLIC :: rt0_ice = 273.15_wp !: melting point of ice [Kelvin] 45 #else 46 REAL(wp), PUBLIC :: rt0_ice = 273.05_wp !: melting point of ice [Kelvin] 47 #endif 48 REAL(wp), PUBLIC :: rau0 !: volumic mass of reference [kg/m3] 49 REAL(wp), PUBLIC :: r1_rau0 !: = 1. / rau0 [m3/kg] 50 REAL(wp), PUBLIC :: rcp !: ocean specific heat [J/Kelvin] 51 REAL(wp), PUBLIC :: r1_rcp !: = 1. / rcp [Kelvin/J] 52 REAL(wp), PUBLIC :: rau0_rcp !: = rau0 * rcp 53 REAL(wp), PUBLIC :: r1_rau0_rcp !: = 1. / ( rau0 * rcp ) 40 REAL(wp), PUBLIC :: rt0 = 273.15_wp !: freezing point of fresh water [Kelvin] 41 REAL(wp), PUBLIC :: rho0 !: volumic mass of reference [kg/m3] 42 REAL(wp), PUBLIC :: r1_rho0 !: = 1. / rho0 [m3/kg] 43 REAL(wp), PUBLIC :: rcp !: ocean specific heat [J/Kelvin] 44 REAL(wp), PUBLIC :: r1_rcp !: = 1. / rcp [Kelvin/J] 45 REAL(wp), PUBLIC :: rho0_rcp !: = rho0 * rcp 46 REAL(wp), PUBLIC :: r1_rho0_rcp !: = 1. / ( rho0 * rcp ) 54 47 55 REAL(wp), PUBLIC :: rhosn = 330._wp !: volumic mass of snow [kg/m3] 56 REAL(wp), PUBLIC :: rhofw = 1000._wp !: volumic mass of freshwater in melt ponds [kg/m3] 48 REAL(wp), PUBLIC :: rhoi = 917._wp !: sea ice density [kg/m3] 49 REAL(wp), PUBLIC :: rhos = 330._wp !: snow density [kg/m3] 50 REAL(wp), PUBLIC :: rhow = 1000._wp !: water density (in melt ponds) [kg/m3] 51 REAL(wp), PUBLIC :: rcnd_i = 2.034396_wp !: thermal conductivity of fresh ice [W/m/K] 52 REAL(wp), PUBLIC :: rcpi = 2067.0_wp !: specific heat of fresh ice [J/kg/K] 53 REAL(wp), PUBLIC :: rLsub = 2.834e+6_wp !: pure ice latent heat of sublimation [J/kg] 54 REAL(wp), PUBLIC :: rLfus = 0.334e+6_wp !: latent heat of fusion of fresh ice [J/kg] 55 REAL(wp), PUBLIC :: tmut = 0.054_wp !: decrease of seawater meltpoint with salinity 57 56 REAL(wp), PUBLIC :: emic = 0.97_wp !: emissivity of snow or ice 58 REAL(wp), PUBLIC :: sice = 6.0_wp !: salinity of ice [psu] 59 REAL(wp), PUBLIC :: soce = 34.7_wp !: salinity of sea [psu] 60 REAL(wp), PUBLIC :: cevap = 2.5e+6_wp !: latent heat of evaporation (water) 61 REAL(wp), PUBLIC :: srgamma = 0.9_wp !: correction factor for solar radiation (Oberhuber, 1974) 57 REAL(wp), PUBLIC :: sice = 6.0_wp !: salinity of ice [psu] 58 REAL(wp), PUBLIC :: soce = 34.7_wp !: salinity of sea [psu] 62 59 REAL(wp), PUBLIC :: vkarmn = 0.4_wp !: von Karman constant 63 60 REAL(wp), PUBLIC :: stefan = 5.67e-8_wp !: Stefan-Boltzmann constant 64 61 65 #if defined key_si3 || defined key_cice 66 REAL(wp), PUBLIC :: rhoic = 917._wp !: volumic mass of sea ice [kg/m3] 67 REAL(wp), PUBLIC :: rcdic = 2.034396_wp !: thermal conductivity of fresh ice [W/m/K] 68 REAL(wp), PUBLIC :: cpic = 2067.0_wp !: specific heat of fresh ice [J/kg/K] 69 REAL(wp), PUBLIC :: lsub = 2.834e+6_wp !: pure ice latent heat of sublimation [J/kg] 70 REAL(wp), PUBLIC :: lfus = 0.334e+6_wp !: latent heat of fusion of fresh ice [J/kg] 71 REAL(wp), PUBLIC :: tmut = 0.054_wp !: decrease of seawater meltpoint with salinity 72 REAL(wp), PUBLIC :: xlsn !: = lfus*rhosn (volumetric latent heat fusion of snow) [J/m3] 73 #else 74 REAL(wp), PUBLIC :: rhoic = 900._wp !: volumic mass of sea ice [kg/m3] 75 REAL(wp), PUBLIC :: rcdic = 2.034396_wp !: conductivity of the ice [W/m/K] 76 REAL(wp), PUBLIC :: rcpic = 1.8837e+6_wp !: volumetric specific heat for ice [J/m3/K] 77 REAL(wp), PUBLIC :: cpic !: = rcpic / rhoic (specific heat for ice) [J/Kg/K] 78 REAL(wp), PUBLIC :: rcdsn = 0.22_wp !: conductivity of the snow [W/m/K] 79 REAL(wp), PUBLIC :: rcpsn = 6.9069e+5_wp !: volumetric specific heat for snow [J/m3/K] 80 REAL(wp), PUBLIC :: xlsn = 110.121e+6_wp !: volumetric latent heat fusion of snow [J/m3] 81 REAL(wp), PUBLIC :: lfus !: = xlsn / rhosn (latent heat of fusion of fresh ice) [J/Kg] 82 REAL(wp), PUBLIC :: xlic = 300.33e+6_wp !: volumetric latent heat fusion of ice [J/m3] 83 REAL(wp), PUBLIC :: xsn = 2.8e+6_wp !: volumetric latent heat of sublimation of snow [J/m3] 84 #endif 85 #if defined key_cice 86 REAL(wp), PUBLIC :: rcdsn = 0.31_wp !: thermal conductivity of snow [W/m/K] 87 #endif 88 #if defined key_si3 89 REAL(wp), PUBLIC :: r1_rhoic !: 1 / rhoic 90 REAL(wp), PUBLIC :: r1_rhosn !: 1 / rhosn 91 REAL(wp), PUBLIC :: r1_cpic !: 1 / cpic 92 #endif 62 REAL(wp), PUBLIC :: r1_rhoi !: 1 / rhoi 63 REAL(wp), PUBLIC :: r1_rhos !: 1 / rhos 64 REAL(wp), PUBLIC :: r1_rhow !: 1 / rhow 65 REAL(wp), PUBLIC :: r1_cpi !: 1 / rcpi 66 REAL(wp), PUBLIC :: r1_Lsub !: 1 / rLsub 67 REAL(wp), PUBLIC :: r1_Lfus !: 1 / rLfus 68 93 69 !!---------------------------------------------------------------------- 94 70 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 105 81 !! ** Purpose : set and print the constants 106 82 !!---------------------------------------------------------------------- 107 83 ! 108 84 IF(lwp) WRITE(numout,*) 109 85 IF(lwp) WRITE(numout,*) 'phy_cst : initialization of ocean parameters and constants' 110 86 IF(lwp) WRITE(numout,*) '~~~~~~~' 111 87 112 ! Define & print constants 113 ! ------------------------ 114 IF(lwp) WRITE(numout,*) 115 IF(lwp) WRITE(numout,*) ' Constants' 116 117 IF(lwp) WRITE(numout,*) 118 IF(lwp) WRITE(numout,*) ' mathematical constant rpi = ', rpi 88 ! !== Define derived constant ==! 119 89 120 90 rsiyea = 365.25_wp * rday * 2._wp * rpi / 6.283076_wp … … 125 95 omega = 2._wp * rpi / rsiday 126 96 #endif 127 IF(lwp) WRITE(numout,*) 128 IF(lwp) WRITE(numout,*) ' day rday = ', rday, ' s' 129 IF(lwp) WRITE(numout,*) ' sideral year rsiyea = ', rsiyea, ' s' 130 IF(lwp) WRITE(numout,*) ' sideral day rsiday = ', rsiday, ' s' 131 IF(lwp) WRITE(numout,*) ' omega omega = ', omega, ' s^-1' 132 IF(lwp) WRITE(numout,*) 133 IF(lwp) WRITE(numout,*) ' nb of months per year raamo = ', raamo, ' months' 134 IF(lwp) WRITE(numout,*) ' nb of hours per day rjjhh = ', rjjhh, ' hours' 135 IF(lwp) WRITE(numout,*) ' nb of minutes per hour rhhmm = ', rhhmm, ' mn' 136 IF(lwp) WRITE(numout,*) ' nb of seconds per minute rmmss = ', rmmss, ' s' 137 IF(lwp) WRITE(numout,*) 138 IF(lwp) WRITE(numout,*) ' earth radius ra = ', ra, ' m' 139 IF(lwp) WRITE(numout,*) ' gravity grav = ', grav , ' m/s^2' 140 IF(lwp) WRITE(numout,*) 141 IF(lwp) WRITE(numout,*) ' triple point of temperature rtt = ', rtt , ' K' 142 IF(lwp) WRITE(numout,*) ' freezing point of water rt0 = ', rt0 , ' K' 143 IF(lwp) WRITE(numout,*) ' melting point of snow rt0_snow = ', rt0_snow, ' K' 144 IF(lwp) WRITE(numout,*) ' melting point of ice rt0_ice = ', rt0_ice , ' K' 145 IF(lwp) WRITE(numout,*) 146 IF(lwp) WRITE(numout,*) ' reference density and heat capacity now defined in eosbn2.f90' 147 148 #if defined key_si3 || defined key_cice 149 xlsn = lfus * rhosn ! volumetric latent heat fusion of snow [J/m3] 150 #else 151 cpic = rcpic / rhoic ! specific heat for ice [J/Kg/K] 152 lfus = xlsn / rhosn ! latent heat of fusion of fresh ice 153 #endif 154 #if defined key_si3 155 r1_rhoic = 1._wp / rhoic 156 r1_rhosn = 1._wp / rhosn 157 r1_cpic = 1._wp / cpic 158 #endif 159 IF(lwp) THEN 97 98 r1_rhoi = 1._wp / rhoi 99 r1_rhos = 1._wp / rhos 100 r1_cpi = 1._wp / rcpi 101 r1_Lsub = 1._wp / rLsub 102 r1_Lfus = 1._wp / rLfus 103 104 IF(lwp) THEN !== print constants ==! 160 105 WRITE(numout,*) 161 #if defined key_cice 162 WRITE(numout,*) ' thermal conductivity of the snow = ', rcdsn , ' J/s/m/K' 163 #endif 164 WRITE(numout,*) ' thermal conductivity of pure ice = ', rcdic , ' J/s/m/K' 165 WRITE(numout,*) ' fresh ice specific heat = ', cpic , ' J/kg/K' 166 WRITE(numout,*) ' latent heat of fusion of fresh ice / snow = ', lfus , ' J/kg' 167 #if defined key_si3 || defined key_cice 168 WRITE(numout,*) ' latent heat of subl. of fresh ice / snow = ', lsub , ' J/kg' 169 #else 170 WRITE(numout,*) ' density times specific heat for snow = ', rcpsn , ' J/m^3/K' 171 WRITE(numout,*) ' density times specific heat for ice = ', rcpic , ' J/m^3/K' 172 WRITE(numout,*) ' volumetric latent heat fusion of sea ice = ', xlic , ' J/m' 173 WRITE(numout,*) ' latent heat of sublimation of snow = ', xsn , ' J/kg' 174 #endif 175 WRITE(numout,*) ' volumetric latent heat fusion of snow = ', xlsn , ' J/m^3' 176 WRITE(numout,*) ' density of sea ice = ', rhoic , ' kg/m^3' 177 WRITE(numout,*) ' density of snow = ', rhosn , ' kg/m^3' 178 WRITE(numout,*) ' density of freshwater (in melt ponds) = ', rhofw , ' kg/m^3' 179 WRITE(numout,*) ' emissivity of snow or ice = ', emic 180 WRITE(numout,*) ' salinity of ice = ', sice , ' psu' 181 WRITE(numout,*) ' salinity of sea = ', soce , ' psu' 182 WRITE(numout,*) ' latent heat of evaporation (water) = ', cevap , ' J/m^3' 183 WRITE(numout,*) ' correction factor for solar radiation = ', srgamma 184 WRITE(numout,*) ' von Karman constant = ', vkarmn 185 WRITE(numout,*) ' Stefan-Boltzmann constant = ', stefan , ' J/s/m^2/K^4' 106 WRITE(numout,*) ' Constants' 186 107 WRITE(numout,*) 187 WRITE(numout,*) ' conversion: degre ==> radian rad = ', rad 108 WRITE(numout,*) ' mathematical constant rpi = ', rpi 109 WRITE(numout,*) ' conversion: degre ==> radian rad = ', rad 188 110 WRITE(numout,*) 189 WRITE(numout,*) ' smallest real computer value rsmall = ', rsmall 111 WRITE(numout,*) ' day in seconds rday = ', rday , ' s' 112 WRITE(numout,*) ' sideral year rsiyea = ', rsiyea, ' s' 113 WRITE(numout,*) ' sideral day rsiday = ', rsiday, ' s' 114 WRITE(numout,*) ' omega = 2 pi / rsiday omega = ', omega , ' s^-1' 115 WRITE(numout,*) ' earth radius ra = ', ra , ' m' 116 WRITE(numout,*) ' gravity grav = ', grav , ' m/s^2' 117 WRITE(numout,*) 118 WRITE(numout,*) ' nb of months per year raamo = ', raamo, ' months' 119 WRITE(numout,*) ' nb of hours per day rjjhh = ', rjjhh, ' hours' 120 WRITE(numout,*) ' nb of minutes per hour rhhmm = ', rhhmm, ' mn' 121 WRITE(numout,*) ' nb of seconds per minute rmmss = ', rmmss, ' s' 122 WRITE(numout,*) 123 WRITE(numout,*) ' reference ocean density and heat capacity now defined in eosbn2.f90' 124 WRITE(numout,*) 125 WRITE(numout,*) ' freezing point of freshwater rt0 = ', rt0 , ' K' 126 WRITE(numout,*) ' sea ice density rhoi = ', rhoi , ' kg/m^3' 127 WRITE(numout,*) ' snow density rhos = ', rhos , ' kg/m^3' 128 WRITE(numout,*) ' freshwater density (in melt ponds) rhow = ', rhow , ' kg/m^3' 129 WRITE(numout,*) ' thermal conductivity of pure ice rcnd_i = ', rcnd_i, ' J/s/m/K' 130 WRITE(numout,*) ' fresh ice specific heat rcpi = ', rcpi , ' J/kg/K' 131 WRITE(numout,*) ' latent heat of fusion of fresh ice / snow rLfus = ', rLfus , ' J/kg' 132 WRITE(numout,*) ' latent heat of subl. of fresh ice / snow rLsub = ', rLsub , ' J/kg' 133 WRITE(numout,*) ' emissivity of snow or ice emic = ', emic 134 WRITE(numout,*) ' salinity of ice sice = ', sice , ' psu' 135 WRITE(numout,*) ' salinity of sea soce = ', soce , ' psu' 136 WRITE(numout,*) ' von Karman constant vkarmn = ', vkarmn 137 WRITE(numout,*) ' Stefan-Boltzmann constant stefan = ', stefan, ' J/s/m^2/K^4' 138 WRITE(numout,*) 139 WRITE(numout,*) 140 WRITE(numout,*) ' smallest real computer value rsmall = ', rsmall 190 141 ENDIF 191 142 ! 192 143 END SUBROUTINE phy_cst 193 144 -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/DOM/restart.F90
r9838 r9939 8 8 !! 2.0 ! 2006-07 (S. Masson) use IOM for restart 9 9 !! 3.3 ! 2010-04 (M. Leclair, G. Madec) modified LF-RA 10 !! - - ! 2010-10 (C. Ethe, G. Madec) TRC-TRA merge (T-S in 4D) 11 !! 3.7 ! 2014-01 (G. Madec) suppression of curl and hdiv from the restart 12 !! - ! 2014-12 (G. Madec) remove KPP scheme 13 !!---------------------------------------------------------------------- 14 15 !!---------------------------------------------------------------------- 16 !! rst_opn : open the ocean restart file 17 !! rst_write : write the ocean restart file 18 !! rst_read : read the ocean restart file 19 !!---------------------------------------------------------------------- 20 USE oce ! ocean dynamics and tracers 21 USE dom_oce ! ocean space and time domain 22 USE sbc_ice ! only lk_si3 23 USE phycst ! physical constants 24 USE eosbn2 ! equation of state (eos bn2 routine) 25 USE trdmxl_oce ! ocean active mixed layer tracers trends variables 10 !! - - ! 2010-10 (C. Ethe, G. Madec) TRC-TRA merge (T-S in 4D) 11 !! 3.7 ! 2014-01 (G. Madec) suppression of curl and hdiv from the restart 12 !! - ! 2014-12 (G. Madec) remove KPP scheme 13 !! 4.0 ! 2018-06 (G. Madec) introduce l_1st_euler 14 !!---------------------------------------------------------------------- 15 16 !!---------------------------------------------------------------------- 17 !! rst_opn : open the ocean restart file in write mode 18 !! rst_write : write the ocean restart file 19 !! rst_read_open : open the ocean restart file in read mode 20 !! rst_read : read the ocean restart file 21 !!---------------------------------------------------------------------- 22 USE oce ! ocean dynamics and tracers 23 USE dom_oce ! ocean space and time domain 24 USE sbc_ice ! only lk_si3 25 USE phycst ! physical constants 26 USE eosbn2 ! equation of state (eos bn2 routine) 27 USE trdmxl_oce ! ocean active mixed layer tracers trends variables 28 USE diurnal_bulk ! 26 29 ! 27 USE in_out_manager ! I/O manager 28 USE iom ! I/O module 29 USE diurnal_bulk 30 USE in_out_manager ! I/O manager 31 USE iom ! I/O module 30 32 31 33 IMPLICIT NONE … … 34 36 PUBLIC rst_opn ! routine called by step module 35 37 PUBLIC rst_write ! routine called by step module 38 PUBLIC rst_read_open ! routine called in rst_read and (possibly) in dom_vvl_init 36 39 PUBLIC rst_read ! routine called by istate module 37 PUBLIC rst_read_open ! routine called in rst_read and (possibly) in dom_vvl_init38 40 39 41 !! * Substitutions … … 144 146 INTEGER, INTENT(in) :: kt ! ocean time-step 145 147 !!---------------------------------------------------------------------- 146 IF(lwxios) CALL iom_swap( cwxios_context ) 147 CALL iom_rstput( kt, nitrst, numrow, 'rdt' , rdt , ldxios = lwxios) ! dynamics time step 148 149 IF ( .NOT. ln_diurnal_only ) THEN 150 CALL iom_rstput( kt, nitrst, numrow, 'ub' , ub, ldxios = lwxios ) ! before fields 151 CALL iom_rstput( kt, nitrst, numrow, 'vb' , vb, ldxios = lwxios ) 152 CALL iom_rstput( kt, nitrst, numrow, 'tb' , tsb(:,:,:,jp_tem), ldxios = lwxios ) 153 CALL iom_rstput( kt, nitrst, numrow, 'sb' , tsb(:,:,:,jp_sal), ldxios = lwxios ) 154 CALL iom_rstput( kt, nitrst, numrow, 'sshb' , sshb, ldxios = lwxios ) 155 ! 156 CALL iom_rstput( kt, nitrst, numrow, 'un' , un, ldxios = lwxios ) ! now fields 157 CALL iom_rstput( kt, nitrst, numrow, 'vn' , vn, ldxios = lwxios ) 158 CALL iom_rstput( kt, nitrst, numrow, 'tn' , tsn(:,:,:,jp_tem), ldxios = lwxios ) 159 CALL iom_rstput( kt, nitrst, numrow, 'sn' , tsn(:,:,:,jp_sal), ldxios = lwxios ) 160 CALL iom_rstput( kt, nitrst, numrow, 'sshn' , sshn, ldxios = lwxios ) 161 CALL iom_rstput( kt, nitrst, numrow, 'rhop' , rhop, ldxios = lwxios ) 162 ! extra variable needed for the ice sheet coupling 163 IF ( ln_iscpl ) THEN 164 CALL iom_rstput( kt, nitrst, numrow, 'tmask' , tmask, ldxios = lwxios ) ! need to extrapolate T/S 165 CALL iom_rstput( kt, nitrst, numrow, 'umask' , umask, ldxios = lwxios ) ! need to correct barotropic velocity 166 CALL iom_rstput( kt, nitrst, numrow, 'vmask' , vmask, ldxios = lwxios ) ! need to correct barotropic velocity 167 CALL iom_rstput( kt, nitrst, numrow, 'smask' , ssmask, ldxios = lwxios) ! need to correct barotropic velocity 168 CALL iom_rstput( kt, nitrst, numrow, 'e3t_n', e3t_n(:,:,:), ldxios = lwxios ) ! need to compute temperature correction 169 CALL iom_rstput( kt, nitrst, numrow, 'e3u_n', e3u_n(:,:,:), ldxios = lwxios ) ! need to compute bt conservation 170 CALL iom_rstput( kt, nitrst, numrow, 'e3v_n', e3v_n(:,:,:), ldxios = lwxios ) ! need to compute bt conservation 171 CALL iom_rstput( kt, nitrst, numrow, 'gdepw_n', gdepw_n(:,:,:), ldxios = lwxios ) ! need to compute extrapolation if vvl 172 END IF 173 ENDIF 174 175 IF (ln_diurnal) CALL iom_rstput( kt, nitrst, numrow, 'Dsst', x_dsst, ldxios = lwxios ) 176 IF(lwxios) CALL iom_swap( cxios_context ) 148 IF( lwxios ) CALL iom_swap( cwxios_context ) 149 150 CALL iom_rstput( kt, nitrst, numrow, 'rdt' , rn_Dt , ldxios = lwxios ) ! dynamics time step 151 ! 152 IF( .NOT. ln_diurnal_only ) THEN 153 CALL iom_rstput( kt, nitrst, numrow, 'ub' , ub , ldxios = lwxios ) ! before fields 154 CALL iom_rstput( kt, nitrst, numrow, 'vb' , vb , ldxios = lwxios ) 155 CALL iom_rstput( kt, nitrst, numrow, 'tb' , tsb(:,:,:,jp_tem), ldxios = lwxios ) 156 CALL iom_rstput( kt, nitrst, numrow, 'sb' , tsb(:,:,:,jp_sal), ldxios = lwxios ) 157 CALL iom_rstput( kt, nitrst, numrow, 'sshb' , sshb , ldxios = lwxios ) 158 ! 159 CALL iom_rstput( kt, nitrst, numrow, 'un' , un , ldxios = lwxios ) ! now fields 160 CALL iom_rstput( kt, nitrst, numrow, 'vn' , vn , ldxios = lwxios ) 161 CALL iom_rstput( kt, nitrst, numrow, 'tn' , tsn(:,:,:,jp_tem), ldxios = lwxios ) 162 CALL iom_rstput( kt, nitrst, numrow, 'sn' , tsn(:,:,:,jp_sal), ldxios = lwxios ) 163 CALL iom_rstput( kt, nitrst, numrow, 'sshn' , sshn , ldxios = lwxios ) 164 CALL iom_rstput( kt, nitrst, numrow, 'rhop' , rhop , ldxios = lwxios ) 165 ! 166 IF( ln_iscpl ) THEN ! extra variable needed for the ice sheet coupling 167 CALL iom_rstput( kt, nitrst, numrow, 'tmask' , tmask , ldxios = lwxios ) ! need to extrapolate T/S 168 CALL iom_rstput( kt, nitrst, numrow, 'umask' , umask , ldxios = lwxios ) ! need to correct barotropic velocity 169 CALL iom_rstput( kt, nitrst, numrow, 'vmask' , vmask , ldxios = lwxios ) ! need to correct barotropic velocity 170 CALL iom_rstput( kt, nitrst, numrow, 'smask' , ssmask , ldxios = lwxios ) ! need to correct barotropic velocity 171 CALL iom_rstput( kt, nitrst, numrow, 'e3t_n' , e3t_n , ldxios = lwxios ) ! need to compute temperature correction 172 CALL iom_rstput( kt, nitrst, numrow, 'e3u_n' , e3u_n , ldxios = lwxios ) ! need to compute bt conservation 173 CALL iom_rstput( kt, nitrst, numrow, 'e3v_n' , e3v_n , ldxios = lwxios ) ! need to compute bt conservation 174 CALL iom_rstput( kt, nitrst, numrow, 'gdepw_n', gdepw_n, ldxios = lwxios ) ! need to compute extrapolation if vvl 175 ENDIF 176 ENDIF 177 ! 178 IF( ln_diurnal ) CALL iom_rstput( kt, nitrst, numrow, 'Dsst', x_dsst, ldxios = lwxios ) 179 IF( lwxios ) CALL iom_swap( cxios_context ) 177 180 IF( kt == nitrst ) THEN 178 IF(.NOT.lwxios) THEN 179 CALL iom_close( numrow ) ! close the restart file (only at last time step) 180 ELSE 181 CALL iom_context_finalize( cwxios_context ) 181 IF( lwxios ) THEN ; CALL iom_context_finalize( cwxios_context ) 182 ELSE ; CALL iom_close( numrow ) ! close the restart file (only at last time step) 182 183 ENDIF 183 184 !!gm IF( .NOT. lk_trdmld ) lrst_oce = .FALSE. 184 185 !!gm not sure what to do here ===>>> ask to Sebastian 185 186 lrst_oce = .FALSE. 186 187 188 189 187 IF( ln_rst_list ) THEN 188 nrst_lst = MIN(nrst_lst + 1, SIZE(nstocklist,1)) 189 nitrst = nstocklist( nrst_lst ) 190 ENDIF 190 191 ENDIF 191 192 ! … … 202 203 !! the file has already been opened 203 204 !!---------------------------------------------------------------------- 204 INTEGER 205 LOGICAL 206 CHARACTER(lc) 205 INTEGER :: jlibalt = jprstlib 206 LOGICAL :: llok 207 CHARACTER(lc) :: clpath ! full path to ocean output restart file 207 208 !!---------------------------------------------------------------------- 208 209 ! … … 238 239 ENDIF 239 240 ENDIF 240 241 ! 241 242 END SUBROUTINE rst_read_open 242 243 … … 254 255 REAL(wp), DIMENSION(jpi, jpj, jpk) :: w3d 255 256 !!---------------------------------------------------------------------- 256 257 ! 257 258 CALL rst_read_open ! open restart for reading (if not already opened) 258 259 … … 260 261 IF( iom_varid( numror, 'rdt', ldstop = .FALSE. ) > 0 ) THEN 261 262 CALL iom_get( numror, 'rdt', zrdt, ldxios = lrxios ) 262 IF( zrdt /= rdt ) neuler = 0 263 IF( zrdt /= rn_Dt ) THEN 264 IF(lwp) WRITE( numout,*) 265 IF(lwp) WRITE( numout,*) 'rst_read: rdt not equal to the read one' 266 IF(lwp) WRITE( numout,*) 267 IF(lwp) WRITE( numout,*) ' ==>>> forced euler first time-step' 268 l_1st_euler = .TRUE. 269 ENDIF 263 270 ENDIF 264 271 … … 266 273 IF( ln_diurnal ) CALL iom_get( numror, jpdom_autoglo, 'Dsst' , x_dsst, ldxios = lrxios ) 267 274 IF ( ln_diurnal_only ) THEN 268 IF(lwp) WRITE( numout, * ) & 269 & "rst_read:- ln_diurnal_only set, setting rhop=rau0" 270 rhop = rau0 275 IF(lwp) WRITE( numout,*) 'rst_read: ln_diurnal_only set, setting rhop=rho0' 276 rhop = rho0 271 277 CALL iom_get( numror, jpdom_autoglo, 'tn' , w3d, ldxios = lrxios ) 272 278 tsn(:,:,1,jp_tem) = w3d(:,:,1) … … 274 280 ENDIF 275 281 276 IF( iom_varid( numror, 'ub', ldstop = .FALSE. ) > 0 ) THEN282 IF( iom_varid( numror, 'ub', ldstop = .FALSE. ) > 0 .AND. .NOT.l_1st_euler ) THEN 277 283 CALL iom_get( numror, jpdom_autoglo, 'ub' , ub, ldxios = lrxios ) ! before fields 278 284 CALL iom_get( numror, jpdom_autoglo, 'vb' , vb, ldxios = lrxios ) … … 281 287 CALL iom_get( numror, jpdom_autoglo, 'sshb' , sshb, ldxios = lrxios ) 282 288 ELSE 283 neuler = 0289 l_1st_euler = .TRUE. ! before field not found, forced euler 1st time-step 284 290 ENDIF 285 291 ! … … 295 301 ENDIF 296 302 ! 297 IF( neuler == 0 ) THEN ! Euler restart (neuler=0) 298 tsb (:,:,:,:) = tsn (:,:,:,:) ! all before fields set to now values 299 ub (:,:,:) = un (:,:,:) 300 vb (:,:,:) = vn (:,:,:) 301 sshb (:,:) = sshn (:,:) 302 ! 303 IF( .NOT.ln_linssh ) THEN 304 DO jk = 1, jpk 305 e3t_b(:,:,jk) = e3t_n(:,:,jk) 306 END DO 307 ENDIF 308 ! 303 IF( l_1st_euler ) THEN ! Euler restart 304 tsb (:,:,:,:) = tsn (:,:,:,:) ! all before fields set to now values 305 ub (:,:,:) = un (:,:,:) 306 vb (:,:,:) = vn (:,:,:) 307 sshb(:,:) = sshn(:,:) 308 IF( .NOT.ln_linssh ) e3t_b(:,:,:) = e3t_n(:,:,:) 309 309 ENDIF 310 310 ! -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/DYN/divhor.F90
r9598 r9939 63 63 ! 64 64 INTEGER :: ji, jj, jk ! dummy loop indices 65 REAL(wp) :: z raur, zdep! local scalars65 REAL(wp) :: zdep ! local scalars 66 66 !!---------------------------------------------------------------------- 67 67 ! -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/DYN/dynnxt.F90
r9598 r9939 64 64 CONTAINS 65 65 66 SUBROUTINE dyn_nxt 66 SUBROUTINE dyn_nxt( kt ) 67 67 !!---------------------------------------------------------------------- 68 68 !! *** ROUTINE dyn_nxt *** … … 83 83 !! * Apply the time filter applied and swap of the dynamics 84 84 !! arrays to start the next time step: 85 !! (ub,vb) = (un,vn) + atfp [ (ub,vb) + (ua,va) - 2 (un,vn) ]85 !! (ub,vb) = (un,vn) + rn_atfp [ (ub,vb) + (ua,va) - 2 (un,vn) ] 86 86 !! (un,vn) = (ua,va). 87 87 !! Note that with flux form advection and non linear free surface, … … 92 92 !! un,vn now horizontal velocity of next time-step 93 93 !!---------------------------------------------------------------------- 94 INTEGER, INTENT( in ) :: kt 94 INTEGER, INTENT( in ) :: kt ! ocean time-step index 95 95 ! 96 96 INTEGER :: ji, jj, jk ! dummy loop indices 97 97 INTEGER :: ikt ! local integers 98 REAL(wp) :: zue3a, zue3n, zue3b, zuf, zcoef 99 REAL(wp) :: zve3a, zve3n, zve3b, zvf , z1_2dt! - -98 REAL(wp) :: zue3a, zue3n, zue3b, zuf, zcoef ! local scalars 99 REAL(wp) :: zve3a, zve3n, zve3b, zvf ! - - 100 100 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zue, zve 101 101 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ze3u_f, ze3v_f, zua, zva … … 132 132 ! so that asselin contribution is removed at the same time 133 133 DO jk = 1, jpkm1 134 un(:,:,jk) = ( un(:,:,jk) - un_adv(:,:)*r1_hu_n(:,:) + un_b(:,:) ) *umask(:,:,jk)135 vn(:,:,jk) = ( vn(:,:,jk) - vn_adv(:,:)*r1_hv_n(:,:) + vn_b(:,:) ) *vmask(:,:,jk)134 un(:,:,jk) = ( un(:,:,jk) - un_adv(:,:)*r1_hu_n(:,:) + un_b(:,:) ) * umask(:,:,jk) 135 vn(:,:,jk) = ( vn(:,:,jk) - vn_adv(:,:)*r1_hv_n(:,:) + vn_b(:,:) ) * vmask(:,:,jk) 136 136 END DO 137 137 ENDIF … … 152 152 !!$ Do we need a call to bdy_vol here?? 153 153 ! 154 IF( l_trddyn ) THEN ! prepare the atf trend computation + some diagnostics155 z1_2dt = 1._wp / (2. * rdt) ! Euler or leap-frog time step156 IF( neuler == 0 .AND. kt == nit000 ) z1_2dt = 1._wp / rdt157 !158 ! ! Kinetic energy and Conversion159 IF( ln_KE_trd ) CALL trd_dyn( ua, va, jpdyn_ken, kt )160 !161 IF( ln_dyn_trd ) THEN ! 3D output: total momentum trends162 zua(:,:,:) = ( ua(:,:,:) - ub(:,:,:) ) * z1_2dt163 zva(:,:,:) = ( va(:,:,:) - vb(:,:,:) ) * z1_2dt164 CALL iom_put( "utrd_tot", zua ) ! total momentum trends, except the asselin timefilter154 IF( l_trddyn ) THEN !* prepare the atf trend computation + some diagnostics 155 IF( ln_KE_trd ) CALL trd_dyn( ua, va, jpdyn_ken, kt ) ! Kinetic energy and Conversion 156 IF( ln_dyn_trd ) THEN ! 3D output: total momentum trends 157 IF( ln_dynadv_vec ) THEN 158 zua(:,:,:) = ( ua(:,:,:) - ub(:,:,:) ) * r1_Dt 159 zva(:,:,:) = ( va(:,:,:) - vb(:,:,:) ) * r1_Dt 160 ELSE 161 zua(:,:,:) = ( e3u_a(:,:,:)*ua(:,:,:) - e3u_b(:,:,:)*ub(:,:,:) ) / e3u_n(:,:,:) * r1_Dt 162 zva(:,:,:) = ( e3v_a(:,:,:)*va(:,:,:) - e3v_b(:,:,:)*vb(:,:,:) ) / e3v_n(:,:,:) * r1_Dt 163 ENDIF 164 CALL iom_put( "utrd_tot", zua ) ! total momentum trends, except the asselin filter 165 165 CALL iom_put( "vtrd_tot", zva ) 166 166 ENDIF 167 ! 168 zua(:,:,:) = un(:,:,:) ! save the now velocity before the asselin filter 169 zva(:,:,:) = vn(:,:,:) ! (caution: there will be a shift by 1 timestep in the 170 ! ! computation of the asselin filter trends) 167 zua(:,:,:) = un(:,:,:) ! save the now velocity before the asselin filter 168 zva(:,:,:) = vn(:,:,:) ! (caution: the Asselin filter trends computation will be shifted by 1 timestep) 171 169 ENDIF 172 170 173 171 ! Time filter and swap of dynamics arrays 174 ! --------------------------------------- ---175 IF( neuler == 0 .AND. kt == nit000 ) THEN !* Euler at first time-step: only swap172 ! --------------------------------------- 173 IF( l_1st_euler ) THEN !== Euler at 1st time-step ==! (swap only) 176 174 DO jk = 1, jpkm1 177 175 un(:,:,jk) = ua(:,:,jk) ! un <-- ua 178 176 vn(:,:,jk) = va(:,:,jk) 179 177 END DO 180 IF( .NOT.ln_linssh ) THEN ! e3._b <-- e3._n 181 !!gm BUG ???? I don't understand why it is not : e3._n <-- e3._a 178 IF( .NOT.ln_linssh ) THEN ! e3._n <-- e3._a 182 179 DO jk = 1, jpkm1 183 ! e3t_b(:,:,jk) = e3t_n(:,:,jk)184 ! e3u_b(:,:,jk) = e3u_n(:,:,jk)185 ! e3v_b(:,:,jk) = e3v_n(:,:,jk)186 !187 180 e3t_n(:,:,jk) = e3t_a(:,:,jk) 188 181 e3u_n(:,:,jk) = e3u_a(:,:,jk) 189 182 e3v_n(:,:,jk) = e3v_a(:,:,jk) 190 183 END DO 191 !!gm BUG end 192 ENDIF 193 ! 194 195 ELSE !* Leap-Frog : Asselin filter and swap 184 ENDIF 185 ! 186 ELSE !== Leap-Frog ==! (Asselin filter and swap) 187 ! 196 188 ! ! =============! 197 189 IF( ln_linssh ) THEN ! Fixed volume ! … … 200 192 DO jj = 1, jpj 201 193 DO ji = 1, jpi 202 zuf = un(ji,jj,jk) + atfp * ( ub(ji,jj,jk) - 2._wp * un(ji,jj,jk) + ua(ji,jj,jk) )203 zvf = vn(ji,jj,jk) + atfp * ( vb(ji,jj,jk) - 2._wp * vn(ji,jj,jk) + va(ji,jj,jk) )194 zuf = un(ji,jj,jk) + rn_atfp * ( ub(ji,jj,jk) - 2._wp * un(ji,jj,jk) + ua(ji,jj,jk) ) 195 zvf = vn(ji,jj,jk) + rn_atfp * ( vb(ji,jj,jk) - 2._wp * vn(ji,jj,jk) + va(ji,jj,jk) ) 204 196 ! 205 197 ub(ji,jj,jk) = zuf ! ub <-- filtered velocity … … 213 205 ELSE ! Variable volume ! 214 206 ! ! ================! 215 ! Before scale factor at t-points 216 ! (used as a now filtered scale factor until the swap) 217 ! ---------------------------------------------------- 207 ! Before scale factor at t-points (used as a now filtered scale factor until the swap) 218 208 DO jk = 1, jpkm1 219 e3t_b(:,:,jk) = e3t_n(:,:,jk) + atfp * ( e3t_b(:,:,jk) - 2._wp * e3t_n(:,:,jk) + e3t_a(:,:,jk) )209 e3t_b(:,:,jk) = e3t_n(:,:,jk) + rn_atfp * ( e3t_b(:,:,jk) - 2._wp * e3t_n(:,:,jk) + e3t_a(:,:,jk) ) 220 210 END DO 221 211 ! Add volume filter correction: compatibility with tracer advection scheme 222 ! => time filter + conservation correction (only at the first level)223 zcoef = atfp * rdt * r1_rau0212 ! => time filter + conservation correction (only at the first level) 213 zcoef = rn_atfp * rn_Dt * r1_rho0 224 214 225 215 e3t_b(:,:,1) = e3t_b(:,:,1) - zcoef * ( emp_b(:,:) - emp(:,:) ) * tmask(:,:,1) … … 232 222 IF( jk <= nk_rnf(ji,jj) ) THEN 233 223 e3t_b(ji,jj,jk) = e3t_b(ji,jj,jk) - zcoef * ( - rnf_b(ji,jj) + rnf(ji,jj) ) & 234 &* ( e3t_n(ji,jj,jk) / h_rnf(ji,jj) ) * tmask(ji,jj,jk)224 & * ( e3t_n(ji,jj,jk) / h_rnf(ji,jj) ) * tmask(ji,jj,jk) 235 225 ENDIF 236 END DO237 END DO238 END DO226 END DO 227 END DO 228 END DO 239 229 ELSE 240 230 e3t_b(:,:,1) = e3t_b(:,:,1) - zcoef * ( -rnf_b(:,:) + rnf(:,:))*tmask(:,:,1) 241 231 ENDIF 242 END 232 ENDIF 243 233 244 234 IF ( ln_isf ) THEN ! if ice shelf melting … … 253 243 END DO 254 244 END DO 255 END 245 ENDIF 256 246 ! 257 247 IF( ln_dynadv_vec ) THEN ! Asselin filter applied on velocity … … 262 252 DO jj = 1, jpj 263 253 DO ji = 1, jpi 264 zuf = un(ji,jj,jk) + atfp * ( ub(ji,jj,jk) - 2._wp * un(ji,jj,jk) + ua(ji,jj,jk) )265 zvf = vn(ji,jj,jk) + atfp * ( vb(ji,jj,jk) - 2._wp * vn(ji,jj,jk) + va(ji,jj,jk) )254 zuf = un(ji,jj,jk) + rn_atfp * ( ub(ji,jj,jk) - 2._wp * un(ji,jj,jk) + ua(ji,jj,jk) ) 255 zvf = vn(ji,jj,jk) + rn_atfp * ( vb(ji,jj,jk) - 2._wp * vn(ji,jj,jk) + va(ji,jj,jk) ) 266 256 ! 267 257 ub(ji,jj,jk) = zuf ! ub <-- filtered velocity … … 289 279 zve3b = e3v_b(ji,jj,jk) * vb(ji,jj,jk) 290 280 ! 291 zuf = ( zue3n + atfp * ( zue3b - 2._wp * zue3n + zue3a ) ) / ze3u_f(ji,jj,jk)292 zvf = ( zve3n + atfp * ( zve3b - 2._wp * zve3n + zve3a ) ) / ze3v_f(ji,jj,jk)281 zuf = ( zue3n + rn_atfp * ( zue3b - 2._wp * zue3n + zue3a ) ) / ze3u_f(ji,jj,jk) 282 zvf = ( zve3n + rn_atfp * ( zve3b - 2._wp * zve3n + zve3a ) ) / ze3v_f(ji,jj,jk) 293 283 ! 294 284 ub(ji,jj,jk) = zuf ! ub <-- filtered velocity … … 322 312 ENDIF 323 313 ! 324 ENDIF ! neuler =/0314 ENDIF ! end Leap-Frog time stepping 325 315 ! 326 316 ! Set "now" and "before" barotropic velocities for next time step: 327 ! JC: Would be more clever to swap variables than to make a full vertical 328 ! integration 317 ! JC: Would be more clever to swap variables than to make a full vertical integration 329 318 ! 330 319 ! … … 360 349 ENDIF 361 350 IF( l_trddyn ) THEN ! 3D output: asselin filter trends on momentum 362 zua(:,:,:) = ( ub(:,:,:) - zua(:,:,:) ) * z1_2dt363 zva(:,:,:) = ( vb(:,:,:) - zva(:,:,:) ) * z1_2dt351 zua(:,:,:) = ( ub(:,:,:) - zua(:,:,:) ) * r1_Dt 352 zva(:,:,:) = ( vb(:,:,:) - zva(:,:,:) ) * r1_Dt 364 353 CALL trd_dyn( zua, zva, jpdyn_atf, kt ) 365 354 ENDIF -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/DYN/dynspg.F90
r9598 r9939 66 66 !! ln_apr_dyn=T : the atmospheric pressure forcing is applied 67 67 !! as the gradient of the inverse barometer ssh: 68 !! apgu = - 1/r au0 di[apr] = 0.5*grav di[ssh_ib+ssh_ibb]69 !! apgv = - 1/r au0 dj[apr] = 0.5*grav dj[ssh_ib+ssh_ibb]68 !! apgu = - 1/rho0 di[apr] = 0.5*grav di[ssh_ib+ssh_ibb] 69 !! apgv = - 1/rho0 dj[apr] = 0.5*grav dj[ssh_ib+ssh_ibb] 70 70 !! Note that as all external forcing a time averaging over a two rdt 71 71 !! period is used to prevent the divergence of odd and even time step. … … 74 74 ! 75 75 INTEGER :: ji, jj, jk ! dummy loop indices 76 REAL(wp) :: z 2dt, zg_2, zintp, zgrau0r, zld ! local scalars76 REAL(wp) :: zg_2, zintp, zg_rho0, zld ! local scalars 77 77 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zpice 78 78 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ztrdu, ztrdv … … 110 110 ENDIF 111 111 ! 112 ! !== tide potential forcing term ==! 113 IF( .NOT.ln_dynspg_ts .AND. ( ln_tide_pot .AND. ln_tide ) ) THEN ! N.B. added directly at sub-time-step in ts-case 114 ! 115 CALL upd_tide( kt ) ! update tide potential 116 ! 117 DO jj = 2, jpjm1 ! add tide potential forcing 118 DO ji = fs_2, fs_jpim1 ! vector opt. 119 spgu(ji,jj) = spgu(ji,jj) + grav * ( pot_astro(ji+1,jj) - pot_astro(ji,jj) ) * r1_e1u(ji,jj) 120 spgv(ji,jj) = spgv(ji,jj) + grav * ( pot_astro(ji,jj+1) - pot_astro(ji,jj) ) * r1_e2v(ji,jj) 121 END DO 122 END DO 123 ! 124 IF (ln_scal_load) THEN 125 zld = rn_scal_load * grav 126 DO jj = 2, jpjm1 ! add scalar approximation for load potential 127 DO ji = fs_2, fs_jpim1 ! vector opt. 128 spgu(ji,jj) = spgu(ji,jj) + zld * ( sshn(ji+1,jj) - sshn(ji,jj) ) * r1_e1u(ji,jj) 129 spgv(ji,jj) = spgv(ji,jj) + zld * ( sshn(ji,jj+1) - sshn(ji,jj) ) * r1_e2v(ji,jj) 130 END DO 131 END DO 112 IF( .NOT.ln_dynspg_ts ) THEN 113 ! !== tide potential forcing term ==! 114 IF( ln_tide_pot .AND. ln_tide ) THEN ! N.B. added directly at sub-time-step in ts-case 115 ! 116 CALL upd_tide( kt ) ! update tide potential 117 ! 118 IF ( ln_scal_load ) THEN 119 zld = rn_load * grav 120 DO jj = 2, jpjm1 ! add tide potential + scalar approximation of load potential 121 DO ji = fs_2, fs_jpim1 ! vector opt. 122 spgu(ji,jj) = spgu(ji,jj) + ( grav * ( pot_astro(ji+1,jj) - pot_astro(ji,jj) ) & 123 & + zld * ( sshn (ji+1,jj) - sshn (ji,jj) ) ) * r1_e1u(ji,jj) 124 spgv(ji,jj) = spgv(ji,jj) + ( grav * ( pot_astro(ji,jj+1) - pot_astro(ji,jj) ) & 125 & + zld * ( sshn (ji,jj+1) - sshn (ji,jj) ) ) * r1_e2v(ji,jj) 126 END DO 127 END DO 128 ELSE 129 DO jj = 2, jpjm1 ! add tide potential 130 DO ji = fs_2, fs_jpim1 ! vector opt. 131 spgu(ji,jj) = spgu(ji,jj) + grav * ( pot_astro(ji+1,jj) - pot_astro(ji,jj) ) * r1_e1u(ji,jj) 132 spgv(ji,jj) = spgv(ji,jj) + grav * ( pot_astro(ji,jj+1) - pot_astro(ji,jj) ) * r1_e2v(ji,jj) 133 END DO 134 END DO 135 ENDIF 132 136 ENDIF 133 137 ENDIF … … 136 140 ALLOCATE( zpice(jpi,jpj) ) 137 141 zintp = REAL( MOD( kt-1, nn_fsbc ) ) / REAL( nn_fsbc ) 138 zg rau0r = - grav * r1_rau0139 zpice(:,:) = ( zintp * snwice_mass(:,:) + ( 1.- zintp ) * snwice_mass_b(:,:) ) * zg rau0r142 zg_rho0 = - grav * r1_rho0 143 zpice(:,:) = ( zintp * snwice_mass(:,:) + ( 1.- zintp ) * snwice_mass_b(:,:) ) * zg_rho0 140 144 DO jj = 2, jpjm1 141 145 DO ji = fs_2, fs_jpim1 ! vector opt. … … 191 195 NAMELIST/namdyn_spg/ ln_dynspg_exp , ln_dynspg_ts, & 192 196 & ln_bt_fw, ln_bt_av , ln_bt_auto , & 193 & nn_ baro, rn_bt_cmax, nn_bt_flt, rn_bt_alpha197 & nn_e , rn_bt_cmax, nn_bt_flt, rn_bt_alpha 194 198 !!---------------------------------------------------------------------- 195 199 ! … … 227 231 WRITE(numout,*) 228 232 IF( nspg == np_EXP ) WRITE(numout,*) ' ==>>> explicit free surface' 229 IF( nspg == np_TS ) WRITE(numout,*) ' ==>>> free surface with time splitting scheme'233 IF( nspg == np_TS ) WRITE(numout,*) ' ==>>> split-explicit free surface' 230 234 IF( nspg == np_NO ) WRITE(numout,*) ' ==>>> No surface surface pressure gradient trend in momentum Eqs.' 231 235 ENDIF 232 236 ! 233 237 IF( nspg == np_TS ) THEN ! split-explicit scheme initialisation 234 CALL dyn_spg_ts_init ! do it first: set nn_ baroused to allocate some arrays later on238 CALL dyn_spg_ts_init ! do it first: set nn_e used to allocate some arrays later on 235 239 ENDIF 236 240 ! -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/DYN/dynspg_exp.F90
r9598 r9939 49 49 !! momentum trend the surface pressure gradient : 50 50 !! (ua,va) = (ua,va) + (spgu,spgv) 51 !! where spgu = -1/r au0 d/dx(ps) = -g/e1u di( sshn )52 !! spgv = -1/r au0 d/dy(ps) = -g/e2v dj( sshn )51 !! where spgu = -1/rho0 d/dx(ps) = -g/e1u di( sshn ) 52 !! spgv = -1/rho0 d/dy(ps) = -g/e2v dj( sshn ) 53 53 !! 54 54 !! ** Action : (ua,va) trend of horizontal velocity increased by -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/DYN/dynspg_ts.F90
r9598 r9939 1 1 MODULE dynspg_ts 2 3 !! Includes ROMS wd scheme with diagnostic outputs ; un and ua updates are commented out !4 5 2 !!====================================================================== 6 3 !! *** MODULE dynspg_ts *** … … 35 32 USE sbcisf ! ice shelf variable (fwfisf) 36 33 USE sbcapr ! surface boundary condition: atmospheric pressure 37 USE dynadv , ONLY: ln_dynadv_vec34 USE dynadv , ONLY : ln_dynadv_vec 38 35 USE dynvor ! vortivity scheme indicators 39 36 USE phycst ! physical constants … … 72 69 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: un_adv , vn_adv !: Advection vel. at "now" barocl. step 73 70 ! 74 INTEGER, SAVE :: icycle ! Number of barotropic sub-steps for each internal step nn_ baro <= 2.5 nn_baro75 REAL(wp),SAVE :: r dtbt ! Barotropic timestep71 INTEGER, SAVE :: icycle ! Number of barotropic sub-steps for each internal step nn_e <= 2.5*nn_e 72 REAL(wp),SAVE :: rDt_e ! external mode time-step 76 73 ! 77 74 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) :: wgtbtp1, wgtbtp2 ! 1st & 2nd weights used in time filtering of barotropic fields … … 84 81 REAL(wp) :: r1_4 = 0.25_wp ! 85 82 REAL(wp) :: r1_2 = 0.5_wp ! 86 83 87 84 !! * Substitutions 88 85 # include "vectopt_loop_substitute.h90" … … 102 99 ierr(:) = 0 103 100 ! 104 ALLOCATE( wgtbtp1(3*nn_ baro), wgtbtp2(3*nn_baro), zwz(jpi,jpj), STAT=ierr(1) )101 ALLOCATE( wgtbtp1(3*nn_e), wgtbtp2(3*nn_e), zwz(jpi,jpj), STAT=ierr(1) ) 105 102 ! 106 103 IF( ln_dynvor_een .OR. ln_dynvor_eeT ) & … … 151 148 INTEGER :: ikbu, iktu, noffset ! local integers 152 149 INTEGER :: ikbv, iktv ! - - 153 REAL(wp) :: r1_2dt_b, z2dt_bf ! local scalars150 INTEGER :: iwdg, jwdg, kwdg ! short-hand values for the indices of the output point 154 151 REAL(wp) :: zx1, zx2, zu_spg, zhura, z1_hu ! - - 155 152 REAL(wp) :: zy1, zy2, zv_spg, zhvra, z1_hv ! - - 156 153 REAL(wp) :: za0, za1, za2, za3 ! - - 157 154 REAL(wp) :: zmdi, zztmp , z1_ht ! - - 155 REAL(wp) :: zwdramp ! local scalar - only used if ln_wd_dl = .True. 156 REAL(wp) :: zload 158 157 REAL(wp), DIMENSION(jpi,jpj) :: zsshp2_e, zhf 159 158 REAL(wp), DIMENSION(jpi,jpj) :: zwx, zu_trd, zu_frc, zssh_frc … … 163 162 REAL(wp), DIMENSION(jpi,jpj) :: zCdU_u, zCdU_v ! top/bottom stress at u- & v-points 164 163 ! 165 REAL(wp) :: zwdramp ! local scalar - only used if ln_wd_dl = .True. 166 167 INTEGER :: iwdg, jwdg, kwdg ! short-hand values for the indices of the output point 164 168 165 169 166 REAL(wp) :: zepsilon, zgamma ! - - … … 181 178 zwdramp = r_rn_wdmin1 ! simplest ramp 182 179 ! zwdramp = 1._wp / (rn_wdmin2 - rn_wdmin1) ! more general ramp 183 ! ! reciprocal of baroclinic time step184 IF( kt == nit000 .AND. neuler == 0 ) THEN ; z2dt_bf = rdt185 ELSE ; z2dt_bf = 2.0_wp * rdt186 ENDIF187 r1_2dt_b = 1.0_wp / z2dt_bf188 180 ! 189 181 ll_init = ln_bt_av ! if no time averaging, then no specific restart 190 182 ll_fw_start = .FALSE. 191 183 ! ! time offset in steps for bdy data update 192 IF( .NOT.ln_bt_fw ) THEN ; noffset = - nn_ baro184 IF( .NOT.ln_bt_fw ) THEN ; noffset = - nn_e 193 185 ELSE ; noffset = 0 194 186 ENDIF 195 187 ! 196 IF( kt == nit000 ) THEN !* initialisation 188 IF( kt == nit000 ) THEN !* initialisation 1st time-step 197 189 ! 198 190 IF(lwp) WRITE(numout,*) … … 201 193 IF(lwp) WRITE(numout,*) 202 194 ! 203 IF( neuler == 0 ) ll_init=.TRUE.204 ! 205 IF( ln_bt_fw .OR. neuler == 0) THEN195 IF( l_1st_euler ) ll_init = .TRUE. 196 ! 197 IF( ln_bt_fw .OR. l_1st_euler ) THEN 206 198 ll_fw_start =.TRUE. 207 199 noffset = 0 … … 212 204 ! Set averaging weights and cycle length: 213 205 CALL ts_wgt( ln_bt_av, ll_fw_start, icycle, wgtbtp1, wgtbtp2 ) 206 ! 207 ELSEIF( kt == nit000 + 1 ) THEN !* initialisation 2nd time-step 208 ! 209 IF( .NOT.ln_bt_fw .AND. l_1st_euler ) THEN 210 ll_fw_start = .FALSE. 211 CALL ts_wgt( ln_bt_av, ll_fw_start, icycle, wgtbtp1, wgtbtp2 ) 212 ENDIF 214 213 ! 215 214 ENDIF … … 340 339 END SELECT 341 340 ENDIF 342 ! 343 ! If forward start at previous time step, and centered integration, 344 ! then update averaging weights: 345 IF (.NOT.ln_bt_fw .AND.( neuler==0 .AND. kt==nit000+1 ) ) THEN 346 ll_fw_start=.FALSE. 347 CALL ts_wgt( ln_bt_av, ll_fw_start, icycle, wgtbtp1, wgtbtp2 ) 348 ENDIF 349 341 ! 350 342 ! ----------------------------------------------------------------------------- 351 343 ! Phase 1 : Coupling between general trend and barotropic estimates (1st step) … … 461 453 zcpx(ji,jj) = ABS( (sshn(ji+1,jj) + ht_0(ji+1,jj) - sshn(ji,jj) - ht_0(ji,jj)) & 462 454 & / (sshn(ji+1,jj) - sshn(ji ,jj)) ) 463 zcpx(ji,jj) = max(min( zcpx(ji,jj) , 1.0_wp),0.0_wp)455 zcpx(ji,jj) = MAX( 0._wp , MIN( zcpx(ji,jj) , 1._wp ) ) 464 456 ELSE 465 457 zcpx(ji,jj) = 0._wp … … 538 530 ! Note that the "unclipped" bottom friction parameter is used even with explicit drag 539 531 IF( ln_wd_il ) THEN 540 zztmp = -1._wp / r dtbt532 zztmp = -1._wp / rDt_e 541 533 DO jj = 2, jpjm1 542 534 DO ji = fs_2, fs_jpim1 ! vector opt. … … 589 581 DO jj = 2, jpjm1 590 582 DO ji = fs_2, fs_jpim1 ! vector opt. 591 zu_frc(ji,jj) = zu_frc(ji,jj) + r1_r au0 * utau(ji,jj) * r1_hu_n(ji,jj)592 zv_frc(ji,jj) = zv_frc(ji,jj) + r1_r au0 * vtau(ji,jj) * r1_hv_n(ji,jj)583 zu_frc(ji,jj) = zu_frc(ji,jj) + r1_rho0 * utau(ji,jj) * r1_hu_n(ji,jj) 584 zv_frc(ji,jj) = zv_frc(ji,jj) + r1_rho0 * vtau(ji,jj) * r1_hv_n(ji,jj) 593 585 END DO 594 586 END DO 595 587 ELSE 596 zztmp = r1_r au0 * r1_2588 zztmp = r1_rho0 * r1_2 597 589 DO jj = 2, jpjm1 598 590 DO ji = fs_2, fs_jpim1 ! vector opt. … … 631 623 ! ! Surface net water flux and rivers 632 624 IF (ln_bt_fw) THEN 633 zssh_frc(:,:) = r1_r au0 * ( emp(:,:) - rnf(:,:) + fwfisf(:,:) )625 zssh_frc(:,:) = r1_rho0 * ( emp(:,:) - rnf(:,:) + fwfisf(:,:) ) 634 626 ELSE 635 zztmp = r1_r au0 * r1_2627 zztmp = r1_rho0 * r1_2 636 628 zssh_frc(:,:) = zztmp * ( emp(:,:) + emp_b(:,:) - rnf(:,:) - rnf_b(:,:) & 637 629 & + fwfisf(:,:) + fwfisf_b(:,:) ) … … 820 812 ENDIF 821 813 #endif 822 IF( ln_wd_il ) CALL wad_lmt_bt(zwx, zwy, sshn_e, zssh_frc, r dtbt)814 IF( ln_wd_il ) CALL wad_lmt_bt(zwx, zwy, sshn_e, zssh_frc, rDt_e) 823 815 824 816 IF ( ln_wd_dl ) THEN … … 866 858 END DO 867 859 END DO 868 ssha_e(:,:) = ( sshn_e(:,:) - r dtbt* ( zssh_frc(:,:) + zhdiv(:,:) ) ) * ssmask(:,:)860 ssha_e(:,:) = ( sshn_e(:,:) - rDt_e * ( zssh_frc(:,:) + zhdiv(:,:) ) ) * ssmask(:,:) 869 861 870 862 CALL lbc_lnk( ssha_e, 'T', 1._wp ) … … 1070 1062 ENDIF 1071 1063 ! 1072 ! Surface pressure trend: 1064 ! Surface pressure trend 1065 IF( ln_scal_load ) THEN ; zload = 1._wp 1066 ELSE ; zload = 1._wp - rn_load 1067 ENDIF 1073 1068 IF( ln_wd_il ) THEN 1074 1069 DO jj = 2, jpjm1 … … 1077 1072 zu_spg = - grav * ( zsshp2_e(ji+1,jj) - zsshp2_e(ji,jj) ) * r1_e1u(ji,jj) 1078 1073 zv_spg = - grav * ( zsshp2_e(ji,jj+1) - zsshp2_e(ji,jj) ) * r1_e2v(ji,jj) 1079 zwx(ji,jj) = (1._wp - rn_scal_load)* zu_spg * zcpx(ji,jj)1080 zwy(ji,jj) = (1._wp - rn_scal_load)* zv_spg * zcpy(ji,jj)1074 zwx(ji,jj) = zload * zu_spg * zcpx(ji,jj) 1075 zwy(ji,jj) = zload * zv_spg * zcpy(ji,jj) 1081 1076 END DO 1082 1077 END DO … … 1087 1082 zu_spg = - grav * ( zsshp2_e(ji+1,jj) - zsshp2_e(ji,jj) ) * r1_e1u(ji,jj) 1088 1083 zv_spg = - grav * ( zsshp2_e(ji,jj+1) - zsshp2_e(ji,jj) ) * r1_e2v(ji,jj) 1089 zwx(ji,jj) = (1._wp - rn_scal_load)* zu_spg1090 zwy(ji,jj) = (1._wp - rn_scal_load)* zv_spg1084 zwx(ji,jj) = zload * zu_spg 1085 zwy(ji,jj) = zload * zv_spg 1091 1086 END DO 1092 1087 END DO … … 1099 1094 DO ji = fs_2, fs_jpim1 ! vector opt. 1100 1095 ua_e(ji,jj) = ( un_e(ji,jj) & 1101 & + r dtbt* ( zwx(ji,jj) &1096 & + rDt_e * ( zwx(ji,jj) & 1102 1097 & + zu_trd(ji,jj) & 1103 1098 & + zu_frc(ji,jj) ) & … … 1105 1100 1106 1101 va_e(ji,jj) = ( vn_e(ji,jj) & 1107 & + r dtbt* ( zwy(ji,jj) &1102 & + rDt_e * ( zwy(ji,jj) & 1108 1103 & + zv_trd(ji,jj) & 1109 1104 & + zv_frc(ji,jj) ) & … … 1112 1107 !jth implicit bottom friction: 1113 1108 IF ( ll_wd ) THEN ! revert to explicit for bit comparison tests in non wad runs 1114 ua_e(ji,jj) = ua_e(ji,jj) /(1.0 - r dtbt* zCdU_u(ji,jj) * hur_e(ji,jj))1115 va_e(ji,jj) = va_e(ji,jj) /(1.0 - r dtbt* zCdU_v(ji,jj) * hvr_e(ji,jj))1109 ua_e(ji,jj) = ua_e(ji,jj) /(1.0 - rDt_e * zCdU_u(ji,jj) * hur_e(ji,jj)) 1110 va_e(ji,jj) = va_e(ji,jj) /(1.0 - rDt_e * zCdU_v(ji,jj) * hvr_e(ji,jj)) 1116 1111 ENDIF 1117 1112 … … 1130 1125 1131 1126 ua_e(ji,jj) = ( hu_e(ji,jj) * un_e(ji,jj) & 1132 & + r dtbt* ( zhust_e(ji,jj) * zwx(ji,jj) &1127 & + rDt_e * ( zhust_e(ji,jj) * zwx(ji,jj) & 1133 1128 & + zhup2_e(ji,jj) * zu_trd(ji,jj) & 1134 1129 & + hu_n(ji,jj) * zu_frc(ji,jj) ) & … … 1136 1131 1137 1132 va_e(ji,jj) = ( hv_e(ji,jj) * vn_e(ji,jj) & 1138 & + r dtbt* ( zhvst_e(ji,jj) * zwy(ji,jj) &1133 & + rDt_e * ( zhvst_e(ji,jj) * zwy(ji,jj) & 1139 1134 & + zhvp2_e(ji,jj) * zv_trd(ji,jj) & 1140 1135 & + hv_n(ji,jj) * zv_frc(ji,jj) ) & … … 1203 1198 zwx(:,:) = un_adv(:,:) 1204 1199 zwy(:,:) = vn_adv(:,:) 1205 IF( .NOT. ( kt == nit000 .AND. neuler==0 )) THEN1206 un_adv(:,:) = r1_2 * ( ub2_b(:,:) + zwx(:,:) - atfp * un_bf(:,:) )1207 vn_adv(:,:) = r1_2 * ( vb2_b(:,:) + zwy(:,:) - atfp * vn_bf(:,:) )1200 IF( .NOT.l_1st_euler ) THEN 1201 un_adv(:,:) = r1_2 * ( ub2_b(:,:) + zwx(:,:) - rn_atfp * un_bf(:,:) ) 1202 vn_adv(:,:) = r1_2 * ( vb2_b(:,:) + zwy(:,:) - rn_atfp * vn_bf(:,:) ) 1208 1203 ! 1209 1204 ! Update corrective fluxes for next time step: 1210 un_bf(:,:) = atfp * un_bf(:,:) + (zwx(:,:) - ub2_b(:,:))1211 vn_bf(:,:) = atfp * vn_bf(:,:) + (zwy(:,:) - vb2_b(:,:))1205 un_bf(:,:) = rn_atfp * un_bf(:,:) + (zwx(:,:) - ub2_b(:,:)) 1206 vn_bf(:,:) = rn_atfp * vn_bf(:,:) + (zwy(:,:) - vb2_b(:,:)) 1212 1207 ELSE 1213 1208 un_bf(:,:) = 0._wp … … 1224 1219 IF( ln_dynadv_vec .OR. ln_linssh ) THEN 1225 1220 DO jk=1,jpkm1 1226 ua(:,:,jk) = ua(:,:,jk) + ( ua_b(:,:) - ub_b(:,:) ) * r1_ 2dt_b1227 va(:,:,jk) = va(:,:,jk) + ( va_b(:,:) - vb_b(:,:) ) * r1_ 2dt_b1221 ua(:,:,jk) = ua(:,:,jk) + ( ua_b(:,:) - ub_b(:,:) ) * r1_Dt 1222 va(:,:,jk) = va(:,:,jk) + ( va_b(:,:) - vb_b(:,:) ) * r1_Dt 1228 1223 END DO 1229 1224 ELSE … … 1231 1226 DO jj = 1, jpjm1 1232 1227 DO ji = 1, jpim1 ! NO Vector Opt. 1233 zsshu_a(ji,jj) = r1_2 * ssumask(ji,jj) * r1_e1e2u(ji,jj) & 1234 & * ( e1e2t(ji ,jj) * ssha(ji ,jj) & 1235 & + e1e2t(ji+1,jj) * ssha(ji+1,jj) ) 1236 zsshv_a(ji,jj) = r1_2 * ssvmask(ji,jj) * r1_e1e2v(ji,jj) & 1237 & * ( e1e2t(ji,jj ) * ssha(ji,jj ) & 1238 & + e1e2t(ji,jj+1) * ssha(ji,jj+1) ) 1228 zsshu_a(ji,jj) = r1_2 * ssumask(ji,jj) * r1_e1e2u(ji,jj) * ( e1e2t(ji ,jj) * ssha(ji ,jj) & 1229 & + e1e2t(ji+1,jj) * ssha(ji+1,jj) ) 1230 zsshv_a(ji,jj) = r1_2 * ssvmask(ji,jj) * r1_e1e2v(ji,jj) * ( e1e2t(ji,jj ) * ssha(ji,jj ) & 1231 & + e1e2t(ji,jj+1) * ssha(ji,jj+1) ) 1239 1232 END DO 1240 1233 END DO … … 1242 1235 ! 1243 1236 DO jk=1,jpkm1 1244 ua(:,:,jk) = ua(:,:,jk) + r1_hu_n(:,:) * ( ua_b(:,:) - ub_b(:,:) * hu_b(:,:) ) * r1_ 2dt_b1245 va(:,:,jk) = va(:,:,jk) + r1_hv_n(:,:) * ( va_b(:,:) - vb_b(:,:) * hv_b(:,:) ) * r1_ 2dt_b1237 ua(:,:,jk) = ua(:,:,jk) + r1_hu_n(:,:) * ( ua_b(:,:) - ub_b(:,:) * hu_b(:,:) ) * r1_Dt 1238 va(:,:,jk) = va(:,:,jk) + r1_hv_n(:,:) * ( va_b(:,:) - vb_b(:,:) * hv_b(:,:) ) * r1_Dt 1246 1239 END DO 1247 1240 ! Save barotropic velocities not transport: … … 1305 1298 !! ** Purpose : Set time-splitting weights for temporal averaging (or not) 1306 1299 !!---------------------------------------------------------------------- 1307 LOGICAL, INTENT(in) :: ll_av ! temporal averaging=.true. 1308 LOGICAL, INTENT(in) :: ll_fw ! forward time splitting =.true. 1309 INTEGER, INTENT(inout) :: jpit ! cycle length 1310 REAL(wp), DIMENSION(3*nn_baro), INTENT(inout) :: zwgt1, & ! Primary weights 1311 zwgt2 ! Secondary weights 1312 1300 LOGICAL , INTENT(in ) :: ll_av ! temporal averaging=.true. 1301 LOGICAL , INTENT(in ) :: ll_fw ! forward time splitting =.true. 1302 INTEGER , INTENT(inout) :: jpit ! cycle length 1303 REAL(wp), DIMENSION(3*nn_e), INTENT(inout) :: zwgt1, zwgt2 ! Primary & Secondary weights 1304 ! 1313 1305 INTEGER :: jic, jn, ji ! temporary integers 1314 1306 REAL(wp) :: za1, za2 1315 1307 !!---------------------------------------------------------------------- 1316 1308 ! 1317 1309 zwgt1(:) = 0._wp 1318 1310 zwgt2(:) = 0._wp 1319 1311 ! 1320 1312 ! Set time index when averaged value is requested 1321 IF (ll_fw) THEN 1322 jic = nn_baro 1323 ELSE 1324 jic = 2 * nn_baro 1325 ENDIF 1326 1327 ! Set primary weights: 1328 IF (ll_av) THEN 1329 ! Define simple boxcar window for primary weights 1330 ! (width = nn_baro, centered around jic) 1313 IF ( ll_fw ) THEN ; jic = nn_e 1314 ELSE ; jic = 2 * nn_e 1315 ENDIF 1316 1317 ! !== Set primary weights ==! 1318 ! 1319 IF (ll_av) THEN !* Define simple boxcar window for primary weights 1320 ! ! (width = nn_e, centered around jic) 1331 1321 SELECT CASE ( nn_bt_flt ) 1332 1333 1334 1335 1336 CASE( 1 ) ! Boxcar, width = nn_baro1337 DO jn = 1, 3*nn_baro1338 za1 = ABS(float(jn-jic))/float(nn_baro)1339 IF (za1 < 0.5_wp) THEN1340 1341 1342 1343 ENDDO1344 1345 CASE( 2 ) ! Boxcar, width = 2 * nn_baro1346 DO jn = 1, 3*nn_baro1347 za1 = ABS(float(jn-jic))/float(nn_baro)1348 IF (za1 < 1._wp) THEN1349 1350 1351 1352 ENDDO1353 1322 CASE( 0 ) ! No averaging 1323 zwgt1(jic) = 1._wp 1324 jpit = jic 1325 ! 1326 CASE( 1 ) ! Boxcar, width = nn_e 1327 DO jn = 1, 3*nn_e 1328 za1 = ABS(float(jn-jic))/float(nn_e) 1329 IF ( za1 < 0.5_wp ) THEN 1330 zwgt1(jn) = 1._wp 1331 jpit = jn 1332 ENDIF 1333 END DO 1334 ! 1335 CASE( 2 ) ! Boxcar, width = 2 * nn_e 1336 DO jn = 1, 3*nn_e 1337 za1 = ABS(float(jn-jic))/float(nn_e) 1338 IF ( za1 < 1._wp ) THEN 1339 zwgt1(jn) = 1._wp 1340 jpit = jn 1341 ENDIF 1342 END DO 1343 CASE DEFAULT ; CALL ctl_stop( 'unrecognised value for nn_bt_flt' ) 1354 1344 END SELECT 1355 1356 ELSE !No time averaging1345 ! 1346 ELSE !* No time averaging 1357 1347 zwgt1(jic) = 1._wp 1358 1348 jpit = jic 1359 1349 ENDIF 1360 1350 1361 ! Set secondary weights 1351 ! !== Set secondary weights ==! 1352 ! 1362 1353 DO jn = 1, jpit 1363 DO ji = jn, jpit1364 1365 END DO1354 DO ji = jn, jpit 1355 zwgt2(jn) = zwgt2(jn) + zwgt1(ji) 1356 END DO 1366 1357 END DO 1367 1358 1368 ! Normalize weigths: 1369 za1 = 1._wp / SUM(zwgt1(1:jpit)) 1370 za2 = 1._wp / SUM(zwgt2(1:jpit)) 1359 ! !== Normalize weights ==! 1360 ! 1361 za1 = 1._wp / SUM( zwgt1(1:jpit) ) 1362 za2 = 1._wp / SUM( zwgt2(1:jpit) ) 1371 1363 DO jn = 1, jpit 1372 zwgt1(jn) = zwgt1(jn) * za11373 zwgt2(jn) = zwgt2(jn) * za21364 zwgt1(jn) = zwgt1(jn) * za1 1365 zwgt2(jn) = zwgt2(jn) * za2 1374 1366 END DO 1375 1367 ! … … 1477 1469 1478 1470 ! Estimate number of iterations to satisfy a max courant number= rn_bt_cmax 1479 IF( ln_bt_auto ) nn_ baro = CEILING( rdt / rn_bt_cmax * zcmax)1471 IF( ln_bt_auto ) nn_e = CEILING( rn_Dt / rn_bt_cmax * zcmax) 1480 1472 1481 r dtbt = rdt / REAL( nn_baro, wp )1482 zcmax = zcmax * r dtbt1473 rDt_e = rn_Dt / REAL( nn_e , wp ) 1474 zcmax = zcmax * rDt_e 1483 1475 ! Print results 1484 1476 IF(lwp) WRITE(numout,*) … … 1486 1478 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~' 1487 1479 IF( ln_bt_auto ) THEN 1488 IF(lwp) WRITE(numout,*) ' ln_ts_auto =.true. Automatically set nn_ baro'1480 IF(lwp) WRITE(numout,*) ' ln_ts_auto =.true. Automatically set nn_e ' 1489 1481 IF(lwp) WRITE(numout,*) ' Max. courant number allowed: ', rn_bt_cmax 1490 1482 ELSE 1491 IF(lwp) WRITE(numout,*) ' ln_ts_auto=.false.: Use nn_ baro in namelist nn_baro = ', nn_baro1483 IF(lwp) WRITE(numout,*) ' ln_ts_auto=.false.: Use nn_e in namelist nn_e = ', nn_e 1492 1484 ENDIF 1493 1485 1494 1486 IF(ln_bt_av) THEN 1495 IF(lwp) WRITE(numout,*) ' ln_bt_av =.true. ==> Time averaging over nn_ barotime steps is on '1487 IF(lwp) WRITE(numout,*) ' ln_bt_av =.true. ==> Time averaging over nn_e time steps is on ' 1496 1488 ELSE 1497 1489 IF(lwp) WRITE(numout,*) ' ln_bt_av =.false. => No time averaging of barotropic variables ' … … 1513 1505 SELECT CASE ( nn_bt_flt ) 1514 1506 CASE( 0 ) ; IF(lwp) WRITE(numout,*) ' Dirac' 1515 CASE( 1 ) ; IF(lwp) WRITE(numout,*) ' Boxcar: width = nn_ baro'1516 CASE( 2 ) ; IF(lwp) WRITE(numout,*) ' Boxcar: width = 2*nn_ baro'1507 CASE( 1 ) ; IF(lwp) WRITE(numout,*) ' Boxcar: width = nn_e' 1508 CASE( 2 ) ; IF(lwp) WRITE(numout,*) ' Boxcar: width = 2*nn_e' 1517 1509 CASE DEFAULT ; CALL ctl_stop( 'unrecognised value for nn_bt_flt: should 0,1, or 2' ) 1518 1510 END SELECT 1519 1511 ! 1520 1512 IF(lwp) WRITE(numout,*) ' ' 1521 IF(lwp) WRITE(numout,*) ' nn_ baro = ', nn_baro1522 IF(lwp) WRITE(numout,*) ' Barotropic time step [s] is :', rdtbt1523 IF(lwp) WRITE(numout,*) ' Maximum Courant number is :', zcmax1513 IF(lwp) WRITE(numout,*) ' nn_e = ', nn_e 1514 IF(lwp) WRITE(numout,*) ' external mode time step is : rDt_e', rDt_e, ' [s]' 1515 IF(lwp) WRITE(numout,*) ' Maximum Courant number is : ', zcmax 1524 1516 ! 1525 1517 IF(lwp) WRITE(numout,*) ' Time diffusion parameter rn_bt_alpha: ', rn_bt_alpha … … 1532 1524 ENDIF 1533 1525 IF( zcmax>0.9_wp ) THEN 1534 CALL ctl_stop( 'dynspg_ts ERROR: Maximum Courant number is greater than 0.9: Inc. nn_ baro!' )1526 CALL ctl_stop( 'dynspg_ts ERROR: Maximum Courant number is greater than 0.9: Inc. nn_e !' ) 1535 1527 ENDIF 1536 1528 ! … … 1539 1531 ! 1540 1532 ! ! read restart when needed 1533 !!gm what's happen when starting with an euler time-step BUT not from rest ? 1534 !! this case correspond to a restart with only now time-step available... 1541 1535 CALL ts_rst( nit000, 'READ' ) 1542 1536 ! … … 1548 1542 CALL iom_set_rstw_var_active('vn_bf') 1549 1543 ! 1550 IF ( .NOT.ln_bt_av) THEN1544 IF ( .NOT.ln_bt_av ) THEN 1551 1545 CALL iom_set_rstw_var_active('sshbb_e') 1552 1546 CALL iom_set_rstw_var_active('ubb_e') -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/DYN/dynzdf.F90
r9598 r9939 11 11 !!---------------------------------------------------------------------- 12 12 !! dyn_zdf : compute the after velocity through implicit calculation of vertical mixing 13 !! zdf_trd : diagnose the zdf velocity trends and the KE dissipation trend 14 !!gm ==>>> zdf_trd currently not used 13 15 !!---------------------------------------------------------------------- 14 16 USE oce ! ocean dynamics and tracers variables … … 26 28 USE in_out_manager ! I/O manager 27 29 USE lib_mpp ! MPP library 30 USE iom ! IOM library 28 31 USE prtctl ! Print control 29 32 USE timing ! Timing … … 67 70 INTEGER, INTENT(in) :: kt ! ocean time-step index 68 71 ! 69 INTEGER :: ji, jj, jk ! dummy loop indices70 INTEGER :: iku, ikv ! local integers71 REAL(wp) :: zzwi, ze3ua, z dt! local scalars72 REAL(wp) :: zzws, ze3va ! - -73 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zwi, zwd, zws ! 3D workspace74 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: ztrdu, ztrdv ! - -72 INTEGER :: ji, jj, jk ! dummy loop indices 73 INTEGER :: iku, ikv ! local integers 74 REAL(wp) :: zzwi, ze3ua, z2dt_2 ! local scalars 75 REAL(wp) :: zzws, ze3va ! - - 76 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zwi, zwd, zws ! 3D workspace 77 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: ztrdu, ztrdv ! - - 75 78 !!--------------------------------------------------------------------- 76 79 ! … … 86 89 ENDIF 87 90 ENDIF 88 ! !* set time step 89 IF( neuler == 0 .AND. kt == nit000 ) THEN ; r2dt = rdt ! = rdt (restart with Euler time stepping) 90 ELSEIF( kt <= nit000 + 1 ) THEN ; r2dt = 2. * rdt ! = 2 rdt (leapfrog) 91 ENDIF 91 ! 92 z2dt_2 = rDt * 0.5_wp !* =rn_Dt except in 1st Euler time step where it is equal to rn_Dt/2 93 ! 92 94 ! 93 95 ! !* explicit top/bottom drag case … … 106 108 IF( ln_dynadv_vec .OR. ln_linssh ) THEN ! applied on velocity 107 109 DO jk = 1, jpkm1 108 ua(:,:,jk) = ( ub(:,:,jk) + r 2dt * ua(:,:,jk) ) * umask(:,:,jk)109 va(:,:,jk) = ( vb(:,:,jk) + r 2dt * va(:,:,jk) ) * vmask(:,:,jk)110 ua(:,:,jk) = ( ub(:,:,jk) + rDt * ua(:,:,jk) ) * umask(:,:,jk) 111 va(:,:,jk) = ( vb(:,:,jk) + rDt * va(:,:,jk) ) * vmask(:,:,jk) 110 112 END DO 111 113 ELSE ! applied on thickness weighted velocity 112 114 DO jk = 1, jpkm1 113 ua(:,:,jk) = ( e3u_b(:,:,jk) * ub(:,:,jk) & 114 & + r2dt * e3u_n(:,:,jk) * ua(:,:,jk) ) / e3u_a(:,:,jk) * umask(:,:,jk) 115 va(:,:,jk) = ( e3v_b(:,:,jk) * vb(:,:,jk) & 116 & + r2dt * e3v_n(:,:,jk) * va(:,:,jk) ) / e3v_a(:,:,jk) * vmask(:,:,jk) 115 ua(:,:,jk) = ( e3u_b(:,:,jk)*ub(:,:,jk) + rDt * e3u_n(:,:,jk)*ua(:,:,jk) ) / e3u_a(:,:,jk) * umask(:,:,jk) 116 va(:,:,jk) = ( e3v_b(:,:,jk)*vb(:,:,jk) + rDt * e3v_n(:,:,jk)*va(:,:,jk) ) / e3v_a(:,:,jk) * vmask(:,:,jk) 117 117 END DO 118 118 ENDIF … … 133 133 ze3ua = ( 1._wp - r_vvl ) * e3u_n(ji,jj,iku) + r_vvl * e3u_a(ji,jj,iku) 134 134 ze3va = ( 1._wp - r_vvl ) * e3v_n(ji,jj,ikv) + r_vvl * e3v_a(ji,jj,ikv) 135 ua(ji,jj,iku) = ua(ji,jj,iku) + r2dt * 0.5*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) * ua_b(ji,jj) / ze3ua136 va(ji,jj,ikv) = va(ji,jj,ikv) + r2dt * 0.5*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) * va_b(ji,jj) / ze3va135 ua(ji,jj,iku) = ua(ji,jj,iku) + z2dt_2 * ( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) * ua_b(ji,jj) / ze3ua 136 va(ji,jj,ikv) = va(ji,jj,ikv) + z2dt_2 * ( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) * va_b(ji,jj) / ze3va 137 137 END DO 138 138 END DO … … 144 144 ze3ua = ( 1._wp - r_vvl ) * e3u_n(ji,jj,iku) + r_vvl * e3u_a(ji,jj,iku) 145 145 ze3va = ( 1._wp - r_vvl ) * e3v_n(ji,jj,ikv) + r_vvl * e3v_a(ji,jj,ikv) 146 ua(ji,jj,iku) = ua(ji,jj,iku) + r2dt * 0.5*( rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) * ua_b(ji,jj) / ze3ua147 va(ji,jj,ikv) = va(ji,jj,ikv) + r2dt * 0.5*( rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) * va_b(ji,jj) / ze3va146 ua(ji,jj,iku) = ua(ji,jj,iku) + z2dt_2 * ( rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) * ua_b(ji,jj) / ze3ua 147 va(ji,jj,ikv) = va(ji,jj,ikv) + z2dt_2 * ( rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) * va_b(ji,jj) / ze3va 148 148 END DO 149 149 END DO … … 153 153 ! !== Vertical diffusion on u ==! 154 154 ! 155 ! !* Matrix construction 156 zdt = r2dt * 0.5 157 SELECT CASE( nldf_dyn ) 158 CASE( np_lap_i ) ! rotated lateral mixing: add its vertical mixing (akzu) 155 SELECT CASE( nldf_dyn ) !* Matrix construction 156 ! 157 CASE( np_lap_i ) ! rotated lateral mixing: add its vertical mixing (akzu) 159 158 DO jk = 1, jpkm1 160 159 DO jj = 2, jpjm1 161 160 DO ji = fs_2, fs_jpim1 ! vector opt. 162 161 ze3ua = ( 1._wp - r_vvl ) * e3u_n(ji,jj,jk) + r_vvl * e3u_a(ji,jj,jk) ! after scale factor at T-point 163 zzwi = - zdt * ( avm(ji+1,jj,jk ) + avm(ji,jj,jk) + akzu(ji,jj,jk ) ) &164 & / ( ze3ua * e3uw_n(ji,jj,jk ) ) * wumask(ji,jj,jk )165 zzws = - zdt * ( avm(ji+1,jj,jk+1) + avm(ji,jj,jk+1) + akzu(ji,jj,jk+1) ) &166 & / ( ze3ua * e3uw_n(ji,jj,jk+1) ) * wumask(ji,jj,jk+1)162 zzwi = - rDt * ( 0.5 * ( avm(ji+1,jj,jk ) + avm(ji,jj,jk ) ) + akzu(ji,jj,jk ) ) & 163 & / ( ze3ua * e3uw_n(ji,jj,jk ) ) * wumask(ji,jj,jk ) 164 zzws = - rDt * ( 0.5 * ( avm(ji+1,jj,jk+1) + avm(ji,jj,jk+1) ) + akzu(ji,jj,jk+1) ) & 165 & / ( ze3ua * e3uw_n(ji,jj,jk+1) ) * wumask(ji,jj,jk+1) 167 166 zwi(ji,jj,jk) = zzwi 168 167 zws(ji,jj,jk) = zzws … … 171 170 END DO 172 171 END DO 173 CASE DEFAULT ! iso-level lateral mixing172 CASE DEFAULT ! iso-level lateral mixing 174 173 DO jk = 1, jpkm1 175 174 DO jj = 2, jpjm1 176 175 DO ji = fs_2, fs_jpim1 ! vector opt. 177 176 ze3ua = ( 1._wp - r_vvl ) * e3u_n(ji,jj,jk) + r_vvl * e3u_a(ji,jj,jk) ! after scale factor at T-point 178 zzwi = - z dt* ( avm(ji+1,jj,jk ) + avm(ji,jj,jk ) ) / ( ze3ua * e3uw_n(ji,jj,jk ) ) * wumask(ji,jj,jk )179 zzws = - z dt* ( avm(ji+1,jj,jk+1) + avm(ji,jj,jk+1) ) / ( ze3ua * e3uw_n(ji,jj,jk+1) ) * wumask(ji,jj,jk+1)177 zzwi = - z2dt_2 * ( avm(ji+1,jj,jk ) + avm(ji,jj,jk ) ) / ( ze3ua * e3uw_n(ji,jj,jk ) ) * wumask(ji,jj,jk ) 178 zzws = - z2dt_2 * ( avm(ji+1,jj,jk+1) + avm(ji,jj,jk+1) ) / ( ze3ua * e3uw_n(ji,jj,jk+1) ) * wumask(ji,jj,jk+1) 180 179 zwi(ji,jj,jk) = zzwi 181 180 zws(ji,jj,jk) = zzws … … 186 185 END SELECT 187 186 ! 188 DO jj = 2, jpjm1 !* Surface boundary conditions189 DO ji = fs_2, fs_jpim1 ! vector opt.187 DO jj = 2, jpjm1 !* Surface boundary conditions 188 DO ji = fs_2, fs_jpim1 ! vector opt. 190 189 zwi(ji,jj,1) = 0._wp 191 190 zwd(ji,jj,1) = 1._wp - zws(ji,jj,1) … … 204 203 iku = mbku(ji,jj) ! ocean bottom level at u- and v-points 205 204 ze3ua = ( 1._wp - r_vvl ) * e3u_n(ji,jj,iku) + r_vvl * e3u_a(ji,jj,iku) ! after scale factor at T-point 206 zwd(ji,jj,iku) = zwd(ji,jj,iku) - r2dt * 0.5*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) / ze3ua205 zwd(ji,jj,iku) = zwd(ji,jj,iku) - z2dt_2 * ( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) / ze3ua 207 206 END DO 208 207 END DO … … 213 212 iku = miku(ji,jj) ! ocean top level at u- and v-points 214 213 ze3ua = ( 1._wp - r_vvl ) * e3u_n(ji,jj,iku) + r_vvl * e3u_a(ji,jj,iku) ! after scale factor at T-point 215 zwd(ji,jj,iku) = zwd(ji,jj,iku) - r2dt * 0.5*( rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) / ze3ua214 zwd(ji,jj,iku) = zwd(ji,jj,iku) - z2dt_2 * ( rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) / ze3ua 216 215 END DO 217 216 END DO … … 245 244 DO ji = fs_2, fs_jpim1 ! vector opt. 246 245 ze3ua = ( 1._wp - r_vvl ) * e3u_n(ji,jj,1) + r_vvl * e3u_a(ji,jj,1) 247 ua(ji,jj,1) = ua(ji,jj,1) + r2dt * 0.5_wp * ( utau_b(ji,jj) + utau(ji,jj) ) & 248 & / ( ze3ua * rau0 ) * umask(ji,jj,1) 246 ua(ji,jj,1) = ua(ji,jj,1) + z2dt_2 * ( utau_b(ji,jj) + utau(ji,jj) ) / ( ze3ua * rho0 ) * umask(ji,jj,1) 249 247 END DO 250 248 END DO … … 272 270 ! !== Vertical diffusion on v ==! 273 271 ! 274 ! !* Matrix construction 275 zdt = r2dt * 0.5 276 SELECT CASE( nldf_dyn ) 277 CASE( np_lap_i ) ! rotated lateral mixing: add its vertical mixing (akzu) 272 ! 273 SELECT CASE( nldf_dyn ) !* Matrix construction 274 CASE( np_lap_i ) ! rotated lateral mixing: add its vertical mixing (akzu) 278 275 DO jk = 1, jpkm1 279 276 DO jj = 2, jpjm1 280 277 DO ji = fs_2, fs_jpim1 ! vector opt. 281 278 ze3va = ( 1._wp - r_vvl ) * e3v_n(ji,jj,jk) + r_vvl * e3v_a(ji,jj,jk) ! after scale factor at T-point 282 zzwi = - zdt * ( avm(ji,jj+1,jk ) + avm(ji,jj,jk) + akzv(ji,jj,jk ) ) &283 & / ( ze3va * e3vw_n(ji,jj,jk ) ) * wvmask(ji,jj,jk )284 zzws = - zdt * ( avm(ji,jj+1,jk+1) + avm(ji,jj,jk+1) + akzv(ji,jj,jk+1) ) &285 & / ( ze3va * e3vw_n(ji,jj,jk+1) ) * wvmask(ji,jj,jk+1)279 zzwi = - rDt * ( 0.5 * ( avm(ji,jj+1,jk ) + avm(ji,jj,jk ) ) + akzv(ji,jj,jk ) ) & 280 & / ( ze3va * e3vw_n(ji,jj,jk ) ) * wvmask(ji,jj,jk ) 281 zzws = - rDt * ( 0.5 * ( avm(ji,jj+1,jk+1) + avm(ji,jj,jk+1) ) + akzv(ji,jj,jk+1) ) & 282 & / ( ze3va * e3vw_n(ji,jj,jk+1) ) * wvmask(ji,jj,jk+1) 286 283 zwi(ji,jj,jk) = zzwi * wvmask(ji,jj,jk ) 287 284 zws(ji,jj,jk) = zzws * wvmask(ji,jj,jk+1) … … 290 287 END DO 291 288 END DO 292 CASE DEFAULT ! iso-level lateral mixing289 CASE DEFAULT ! iso-level lateral mixing 293 290 DO jk = 1, jpkm1 294 291 DO jj = 2, jpjm1 295 292 DO ji = fs_2, fs_jpim1 ! vector opt. 296 293 ze3va = ( 1._wp - r_vvl ) * e3v_n(ji,jj,jk) + r_vvl * e3v_a(ji,jj,jk) ! after scale factor at T-point 297 zzwi = - z dt* ( avm(ji,jj+1,jk ) + avm(ji,jj,jk ) ) / ( ze3va * e3vw_n(ji,jj,jk ) ) * wvmask(ji,jj,jk )298 zzws = - z dt* ( avm(ji,jj+1,jk+1) + avm(ji,jj,jk+1) ) / ( ze3va * e3vw_n(ji,jj,jk+1) ) * wvmask(ji,jj,jk+1)294 zzwi = - z2dt_2 * ( avm(ji,jj+1,jk ) + avm(ji,jj,jk ) ) / ( ze3va * e3vw_n(ji,jj,jk ) ) * wvmask(ji,jj,jk ) 295 zzws = - z2dt_2 * ( avm(ji,jj+1,jk+1) + avm(ji,jj,jk+1) ) / ( ze3va * e3vw_n(ji,jj,jk+1) ) * wvmask(ji,jj,jk+1) 299 296 zwi(ji,jj,jk) = zzwi * wvmask(ji,jj,jk ) 300 297 zws(ji,jj,jk) = zzws * wvmask(ji,jj,jk+1) … … 305 302 END SELECT 306 303 ! 307 DO jj = 2, jpjm1 !* Surface boundary conditions308 DO ji = fs_2, fs_jpim1 ! vector opt.304 DO jj = 2, jpjm1 !* Surface boundary conditions 305 DO ji = fs_2, fs_jpim1 ! vector opt. 309 306 zwi(ji,jj,1) = 0._wp 310 307 zwd(ji,jj,1) = 1._wp - zws(ji,jj,1) … … 322 319 ikv = mbkv(ji,jj) ! (deepest ocean u- and v-points) 323 320 ze3va = ( 1._wp - r_vvl ) * e3v_n(ji,jj,ikv) + r_vvl * e3v_a(ji,jj,ikv) ! after scale factor at T-point 324 zwd(ji,jj,ikv) = zwd(ji,jj,ikv) - r2dt * 0.5*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) / ze3va321 zwd(ji,jj,ikv) = zwd(ji,jj,ikv) - z2dt_2 * ( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) / ze3va 325 322 END DO 326 323 END DO … … 330 327 ikv = mikv(ji,jj) ! (first wet ocean u- and v-points) 331 328 ze3va = ( 1._wp - r_vvl ) * e3v_n(ji,jj,ikv) + r_vvl * e3v_a(ji,jj,ikv) ! after scale factor at T-point 332 zwd(ji,jj,iku) = zwd(ji,jj,iku) - r2dt * 0.5*( rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) / ze3va329 zwd(ji,jj,iku) = zwd(ji,jj,iku) - z2dt_2 * ( rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) / ze3va 333 330 END DO 334 331 END DO … … 362 359 DO ji = fs_2, fs_jpim1 ! vector opt. 363 360 ze3va = ( 1._wp - r_vvl ) * e3v_n(ji,jj,1) + r_vvl * e3v_a(ji,jj,1) 364 va(ji,jj,1) = va(ji,jj,1) + r2dt * 0.5_wp * ( vtau_b(ji,jj) + vtau(ji,jj) ) & 365 & / ( ze3va * rau0 ) * vmask(ji,jj,1) 361 va(ji,jj,1) = va(ji,jj,1) + z2dt_2 * ( vtau_b(ji,jj) + vtau(ji,jj) ) / ( ze3va * rho0 ) * vmask(ji,jj,1) 366 362 END DO 367 363 END DO … … 387 383 END DO 388 384 ! 389 IF( l_trddyn ) THEN ! save the vertical diffusive trends for further diagnostics 390 ztrdu(:,:,:) = ( ua(:,:,:) - ub(:,:,:) ) / r2dt - ztrdu(:,:,:) 391 ztrdv(:,:,:) = ( va(:,:,:) - vb(:,:,:) ) / r2dt - ztrdv(:,:,:) 385 IF( l_trddyn ) THEN ! save the vertical diffusive trends for further diagnostics 386 IF( ln_dynadv_vec .OR. ln_linssh ) THEN ! applied on velocity 387 ztrdu(:,:,:) = ( ua(:,:,:) - ub(:,:,:) ) * r1_Dt - ztrdu(:,:,:) 388 ztrdv(:,:,:) = ( va(:,:,:) - vb(:,:,:) ) * r1_Dt - ztrdv(:,:,:) 389 ELSE ! applied on thickness weighted velocity 390 ztrdu(:,:,:) = ( e3u_a(:,:,:)*ua(:,:,:) - e3u_b(:,:,:)*ub(:,:,:) ) / e3u_n(:,:,:) * r1_Dt - ztrdu(:,:,:) 391 ztrdv(:,:,:) = ( e3v_a(:,:,:)*va(:,:,:) - e3v_b(:,:,:)*vb(:,:,:) ) / e3v_n(:,:,:) * r1_Dt - ztrdv(:,:,:) 392 ENDIF 392 393 CALL trd_dyn( ztrdu, ztrdv, jpdyn_zdf, kt ) 393 394 DEALLOCATE( ztrdu, ztrdv ) … … 401 402 END SUBROUTINE dyn_zdf 402 403 404 !!gm currently not used : just for memory to be able to add dissipation trend through vertical mixing 405 406 SUBROUTINE zdf_trd( ptrdu, ptrdv ,kt ) 407 !!---------------------------------------------------------------------- 408 !! *** ROUTINE zdf_trd *** 409 !! 410 !! ** Purpose : compute the trend due to the vert. momentum diffusion 411 !! together with the Leap-Frog time stepping using an 412 !! implicit scheme. 413 !! 414 !! ** Method : - Leap-Frog time stepping on all trends but the vertical mixing 415 !! ua = ub + 2*dt * ua vector form or linear free surf. 416 !! ua = ( e3u_b*ub + 2*dt * e3u_n*ua ) / e3u_a otherwise 417 !! - update the after velocity with the implicit vertical mixing. 418 !! This requires to solver the following system: 419 !! ua = ua + 1/e3u_a dk+1[ mi(avm) / e3uw_a dk[ua] ] 420 !! with the following surface/top/bottom boundary condition: 421 !! surface: wind stress input (averaged over kt-1/2 & kt+1/2) 422 !! top & bottom : top stress (iceshelf-ocean) & bottom stress (cf zdfdrg.F90) 423 !! 424 !! ** Action : (ua,va) after velocity 425 !!--------------------------------------------------------------------- 426 REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) :: ptrdu, ptrdv ! 3D work arrays use for zdf trends diag 427 INTEGER , INTENT(in ) :: kt ! ocean time-step index 428 ! 429 INTEGER :: ji, jj, jk ! dummy loop indices 430 REAL(wp) :: zzz ! local scalar 431 REAL(wp) :: zavmu, zavmum1 ! - - 432 REAL(wp) :: zavmv, zavmvm1 ! - - 433 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: z2d ! - - 434 !!--------------------------------------------------------------------- 435 ! 436 CALL lbc_lnk_multi( ua, 'U', -1., va, 'V', -1. ) ! apply lateral boundary condition on (ua,va) 437 ! 438 ! 439 ! !== momentum trend due to vertical diffusion ==! 440 ! 441 IF( ln_dynadv_vec .OR. ln_linssh ) THEN ! applied on velocity 442 ptrdu(:,:,:) = ( ua(:,:,:) - ub(:,:,:) ) * r1_Dt - ptrdu(:,:,:) 443 ptrdv(:,:,:) = ( va(:,:,:) - vb(:,:,:) ) * r1_Dt - ptrdv(:,:,:) 444 ELSE ! applied on thickness weighted velocity 445 ptrdu(:,:,:) = ( e3u_a(:,:,:)*ua(:,:,:) - e3u_b(:,:,:)*ub(:,:,:) ) / e3u_n(:,:,:) * r1_Dt - ptrdu(:,:,:) 446 ptrdv(:,:,:) = ( e3v_a(:,:,:)*va(:,:,:) - e3v_b(:,:,:)*vb(:,:,:) ) / e3v_n(:,:,:) * r1_Dt - ptrdv(:,:,:) 447 ENDIF 448 CALL trd_dyn( ptrdu, ptrdv, jpdyn_zdf, kt ) 449 ! 450 ! 451 ! !== KE dissipation trend due to vertical diffusion ==! 452 ! 453 IF( iom_use( 'dispkevfo' ) ) THEN ! ocean kinetic energy dissipation per unit area 454 ! ! due to v friction (v=vertical) 455 ! ! see NEMO_book appendix C, §C.8 (N.B. here averaged at t-points) 456 ! ! Note that formally, in a Leap-Frog environment, the shear**2 should be the product of 457 ! ! now by before shears, i.e. the source term of TKE (local positivity is not ensured). 458 ! ! Note also that now e3 scale factors are used as after one are not computed ! 459 ! 460 CALL wrk_alloc(jpi,jpj, z2d ) 461 z2d(:,:) = 0._wp 462 DO jk = 1, jpkm1 463 DO jj = 2, jpjm1 464 DO ji = 2, jpim1 465 zavmu = 0.5 * ( avm(ji+1,jj,jk) + avm(ji ,jj,jk) ) 466 zavmum1 = 0.5 * ( avm(ji ,jj,jk) + avm(ji-1,jj,jk) ) 467 zavmv = 0.5 * ( avm(ji,jj+1,jk) + avm(ji,jj ,jk) ) 468 zavmvm1 = 0.5 * ( avm(ji,jj ,jk) + avm(ji,jj-1,jk) ) 469 470 z2d(ji,jj) = z2d(ji,jj) + ( & 471 & zavmu * ( ua(ji ,jj,jk-1) - ua(ji ,jj,jk) )**2 / e3uw_n(ji ,jj,jk) * wumask(ji ,jj,jk) & 472 & + zavmum1 * ( ua(ji-1,jj,jk-1) - ua(ji-1,jj,jk) )**2 / e3uw_n(ji-1,jj,jk) * wumask(ji-1,jj,jk) & 473 & + zavmv * ( va(ji,jj ,jk-1) - va(ji,jj ,jk) )**2 / e3vw_n(ji,jj ,jk) * wvmask(ji,jj ,jk) & 474 & + zavmvm1 * ( va(ji,jj-1,jk-1) - va(ji,jj-1,jk) )**2 / e3vw_n(ji,jj-1,jk) * wvmask(ji,jj-1,jk) & 475 & ) 476 !!gm --- This trends is in fact properly computed in zdf_sh2 but with a backward shift of one time-step ===>>> use it ? 477 !! No since in zdfshé only kz tke (or gls) is used 478 !! 479 !!gm --- formally, as done below, in a Leap-Frog environment, the shear**2 should be the product of 480 !!gm now by before shears, i.e. the source term of TKE (local positivity is not ensured). 481 !! CAUTION: requires to compute e3uw_a and e3vw_a !!! 482 ! z2d(ji,jj) = z2d(ji,jj) + ( & 483 ! & avmu(ji ,jj,jk) * ( un(ji ,jj,jk-1) - un(ji ,jj,jk) ) / e3uw_n(ji ,jj,jk) & 484 ! & * ( ua(ji ,jj,jk-1) - ua(ji ,jj,jk) ) / e3uw_a(ji ,jj,jk) * wumask(ji ,jj,jk) & 485 ! & + avmu(ji-1,jj,jk) * ( un(ji-1,jj,jk-1) - un(ji-1,jj,jk) ) / e3uw_n(ji-1,jj,jk) & 486 ! & ( ua(ji-1,jj,jk-1) - ua(ji-1,jj,jk) ) / e3uw_a(ji-1,jj,jk) * wumask(ji-1,jj,jk) & 487 ! & + avmv(ji,jj ,jk) * ( vn(ji,jj ,jk-1) - vn(ji,jj ,jk) ) / e3vw_n(ji,jj ,jk) & 488 ! & ( va(ji,jj ,jk-1) - va(ji,jj ,jk) ) / e3vw_a(ji,jj ,jk) * wvmask(ji,jj ,jk) & 489 ! & + avmv(ji,jj-1,jk) * ( vn(ji,jj-1,jk-1) - vn(ji,jj-1,jk) ) / e3vw_n(ji,jj-1,jk) & 490 ! & ( va(ji,jj-1,jk-1) - va(ji,jj-1,jk) ) / e3vw_a(ji,jj-1,jk) * wvmask(ji,jj-1,jk) & 491 ! & ) 492 !!gm end 493 END DO 494 END DO 495 END DO 496 zzz= - 0.5_wp* rho0 ! caution sign minus here 497 z2d(:,:) = zzz * z2d(:,:) 498 CALL lbc_lnk( z2d,'T', 1. ) 499 CALL iom_put( 'dispkevfo', z2d ) 500 ENDIF 501 ! 502 END SUBROUTINE zdf_trd 503 504 !!gm end not used 505 403 506 !!============================================================================== 404 507 END MODULE dynzdf -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/DYN/sshwzv.F90
r9598 r9939 68 68 INTEGER, INTENT(in) :: kt ! time step 69 69 ! 70 INTEGER :: jk 71 REAL(wp) :: z 2dt, zcoef! local scalars70 INTEGER :: jk ! dummy loop indice 71 REAL(wp) :: z1_2rho0 ! local scalars 72 72 REAL(wp), DIMENSION(jpi,jpj) :: zhdiv ! 2D workspace 73 73 !!---------------------------------------------------------------------- … … 81 81 ENDIF 82 82 ! 83 z2dt = 2._wp * rdt ! set time step size (Euler/Leapfrog) 84 IF( neuler == 0 .AND. kt == nit000 ) z2dt = rdt 85 zcoef = 0.5_wp * r1_rau0 83 z1_2rho0 = 0.5_wp * r1_rho0 86 84 87 85 ! !------------------------------! 88 86 ! ! After Sea Surface Height ! 89 87 ! !------------------------------! 90 IF(ln_wd_il) THEN 91 CALL wad_lmt(sshb, zcoef * (emp_b(:,:) + emp(:,:)), z2dt) 92 ENDIF 88 89 IF(ln_wd_il) CALL wad_lmt( sshb, z1_2rho0 * (emp_b(:,:) + emp(:,:)), rDt ) 93 90 94 91 CALL div_hor( kt ) ! Horizontal divergence … … 102 99 ! compute the vertical velocity which can be used to compute the non-linear terms of the momentum equations. 103 100 ! 104 ssha(:,:) = ( sshb(:,:) - z2dt * ( zcoef* ( emp_b(:,:) + emp(:,:) ) + zhdiv(:,:) ) ) * ssmask(:,:)101 ssha(:,:) = ( sshb(:,:) - rDt * ( z1_2rho0 * ( emp_b(:,:) + emp(:,:) ) + zhdiv(:,:) ) ) * ssmask(:,:) 105 102 ! 106 103 #if defined key_agrif … … 143 140 ! 144 141 INTEGER :: ji, jj, jk ! dummy loop indices 145 REAL(wp) :: z1_2dt ! local scalars146 142 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zhdiv 147 143 !!---------------------------------------------------------------------- … … 159 155 ! ! Now Vertical Velocity ! 160 156 ! !------------------------------! 161 z1_2dt = 1. / ( 2. * rdt ) ! set time step size (Euler/Leapfrog)162 IF( neuler == 0 .AND. kt == nit000 ) z1_2dt = 1. / rdt163 157 ! 164 158 IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN ! z_tilde and layer cases … … 180 174 ! computation of w 181 175 wn(:,:,jk) = wn(:,:,jk+1) - ( e3t_n(:,:,jk) * hdivn(:,:,jk) + zhdiv(:,:,jk) & 182 & + z1_2dt * ( e3t_a(:,:,jk) - e3t_b(:,:,jk) )) * tmask(:,:,jk)176 & + r1_Dt * ( e3t_a(:,:,jk) - e3t_b(:,:,jk) ) ) * tmask(:,:,jk) 183 177 END DO 184 178 ! IF( ln_vvl_layer ) wn(:,:,:) = 0.e0 … … 188 182 ! computation of w 189 183 wn(:,:,jk) = wn(:,:,jk+1) - ( e3t_n(:,:,jk) * hdivn(:,:,jk) & 190 & + z1_2dt * ( e3t_a(:,:,jk) - e3t_b(:,:,jk) ) ) * tmask(:,:,jk)184 & + r1_Dt * ( e3t_a(:,:,jk) - e3t_b(:,:,jk) ) ) * tmask(:,:,jk) 191 185 END DO 192 186 ENDIF … … 200 194 #if defined key_agrif 201 195 IF( .NOT. AGRIF_Root() ) THEN 202 IF ( (nbondi == 1).OR.(nbondi == 2)) wn(nlci-1 , : ,:) = 0.e0! east203 IF ( (nbondi == -1).OR.(nbondi == 2)) wn(2 , : ,:) = 0.e0! west204 IF ( (nbondj == 1).OR.(nbondj == 2)) wn(: ,nlcj-1 ,:) = 0.e0! north205 IF ( (nbondj == -1).OR.(nbondj == 2)) wn(: ,2 ,:) = 0.e0! south196 IF ( nbondi == 1 .OR. nbondi == 2 ) wn(nlci-1 , : ,:) = 0._wp ! east 197 IF ( nbondi == -1 .OR. nbondi == 2 ) wn( 2 , : ,:) = 0._wp ! west 198 IF ( nbondj == 1 .OR. nbondj == 2 ) wn( : ,nlcj-1 ,:) = 0._wp ! north 199 IF ( nbondj == -1 .OR. nbondj == 2 ) wn( : , 2 ,:) = 0._wp ! south 206 200 ENDIF 207 201 #endif … … 222 216 !! ** Method : - apply Asselin time fiter to now ssh (excluding the forcing 223 217 !! from the filter, see Leclair and Madec 2010) and swap : 224 !! sshn = ssha + atfp * ( sshb -2 sshn + ssha )225 !! - atfp * rdt * ( emp_b - emp ) / rau0218 !! sshn = ssha + rn_atfp * ( sshb -2 sshn + ssha ) 219 !! - rn_atfp * rn_Dt * ( emp_b - emp ) / rho0 226 220 !! sshn = ssha 227 221 !! … … 243 237 IF(lwp) WRITE(numout,*) '~~~~~~~ ' 244 238 ENDIF 245 ! !== Euler time-stepping: no filter, just swap ==! 246 IF ( neuler == 0 .AND. kt == nit000 ) THEN 247 sshn(:,:) = ssha(:,:) ! now <-- after (before already = now) 248 ! 249 ELSE !== Leap-Frog time-stepping: Asselin filter + swap ==! 250 ! ! before <-- now filtered 251 sshb(:,:) = sshn(:,:) + atfp * ( sshb(:,:) - 2 * sshn(:,:) + ssha(:,:) ) 252 IF( .NOT.ln_linssh ) THEN ! before <-- with forcing removed 253 zcoef = atfp * rdt * r1_rau0 239 ! 240 IF ( l_1st_euler ) THEN !== Euler time-stepping ==! no filter, just swap 241 ! 242 sshn(:,:) = ssha(:,:) ! now <-- after (before already = now) 243 ! 244 ELSE !== Leap-Frog time-stepping ==! Asselin filter + swap 245 ! 246 ! ! before <-- now filtered 247 sshb(:,:) = sshn(:,:) + rn_atfp * ( sshb(:,:) - 2 * sshn(:,:) + ssha(:,:) ) 248 IF( .NOT.ln_linssh ) THEN ! before <-- with forcing removed 249 zcoef = rn_atfp * rn_Dt * r1_rho0 254 250 sshb(:,:) = sshb(:,:) - zcoef * ( emp_b(:,:) - emp (:,:) & 255 251 & - rnf_b(:,:) + rnf (:,:) & 256 252 & + fwfisf_b(:,:) - fwfisf(:,:) ) * ssmask(:,:) 257 253 ENDIF 258 sshn(:,:) = ssha(:,:) 254 sshn(:,:) = ssha(:,:) ! now <-- after 259 255 ENDIF 260 256 ! -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/DYN/wet_dry.F90
r9168 r9939 117 117 118 118 119 SUBROUTINE wad_lmt( sshb1, sshemp, z2dt )119 SUBROUTINE wad_lmt( sshb1, sshemp, p2dt ) 120 120 !!---------------------------------------------------------------------- 121 121 !! *** ROUTINE wad_lmt *** … … 129 129 REAL(wp), DIMENSION(:,:), INTENT(inout) :: sshb1 !!gm DOCTOR names: should start with p ! 130 130 REAL(wp), DIMENSION(:,:), INTENT(in ) :: sshemp 131 REAL(wp) , INTENT(in ) :: z2dt131 REAL(wp) , INTENT(in ) :: p2dt 132 132 ! 133 133 INTEGER :: ji, jj, jk, jk1 ! dummy loop indices … … 220 220 & + MIN( zflxv1(ji,jj) , 0._wp ) - MAX( zflxv1(ji, jj-1) , 0._wp) 221 221 ! 222 zdep1 = (zzflxp + zzflxn) * z2dt / ztmp223 zdep2 = ht_0(ji,jj) + sshb1(ji,jj) - rn_wdmin1 - z2dt * sshemp(ji,jj)222 zdep1 = (zzflxp + zzflxn) * p2dt / ztmp 223 zdep2 = ht_0(ji,jj) + sshb1(ji,jj) - rn_wdmin1 - p2dt * sshemp(ji,jj) 224 224 ! 225 225 IF( zdep1 > zdep2 ) THEN 226 226 wdmask(ji, jj) = 0._wp 227 zcoef = ( ( zdep2 - rn_wdmin2 ) * ztmp - zzflxn * z2dt ) / ( zflxp(ji,jj) * z2dt )228 !zcoef = ( ( zdep2 - rn_wdmin2 ) * ztmp - zzflxn * z2dt ) / ( zzflxp * z2dt )227 zcoef = ( ( zdep2 - rn_wdmin2 ) * ztmp - zzflxn * p2dt ) / ( zflxp(ji,jj) * p2dt ) 228 !zcoef = ( ( zdep2 - rn_wdmin2 ) * ztmp - zzflxn * p2dt ) / ( zzflxp * p2dt ) 229 229 ! flag if the limiter has been used but stop flagging if the only 230 230 ! changes have zeroed the coefficient since further iterations will … … 270 270 271 271 272 SUBROUTINE wad_lmt_bt( zflxu, zflxv, sshn_e, zssh_frc, rdtbt )272 SUBROUTINE wad_lmt_bt( zflxu, zflxv, sshn_e, zssh_frc, pdt ) 273 273 !!---------------------------------------------------------------------- 274 274 !! *** ROUTINE wad_lmt *** … … 280 280 !! ** Action : - calculate flux limiter and W/D flag 281 281 !!---------------------------------------------------------------------- 282 REAL(wp) , INTENT(in ) :: rdtbt ! ocean time-step index282 REAL(wp) , INTENT(in ) :: pdt ! external mode time-step [s] 283 283 REAL(wp), DIMENSION(:,:), INTENT(inout) :: zflxu, zflxv, sshn_e, zssh_frc 284 284 ! 285 285 INTEGER :: ji, jj, jk, jk1 ! dummy loop indices 286 286 INTEGER :: jflag ! local integer 287 REAL(wp) :: z2dt288 287 REAL(wp) :: zcoef, zdep1, zdep2 ! local scalars 289 288 REAL(wp) :: zzflxp, zzflxn ! local scalars … … 298 297 jflag = 0 299 298 zdepwd = 50._wp ! maximum depth that ocean cells can have W/D processes 300 !301 z2dt = rdtbt302 299 ! 303 300 zflxp(:,:) = 0._wp … … 347 344 & + min(zflxv1(ji,jj), 0._wp) - max(zflxv1(ji, jj-1), 0._wp) 348 345 349 zdep1 = (zzflxp + zzflxn) * z2dt / ztmp350 zdep2 = ht_0(ji,jj) + sshn_e(ji,jj) - rn_wdmin1 - z2dt * zssh_frc(ji,jj)346 zdep1 = (zzflxp + zzflxn) * pdt / ztmp 347 zdep2 = ht_0(ji,jj) + sshn_e(ji,jj) - rn_wdmin1 - pdt * zssh_frc(ji,jj) 351 348 352 349 IF(zdep1 > zdep2) THEN 353 zcoef = ( ( zdep2 - rn_wdmin2 ) * ztmp - zzflxn * z2dt ) / ( zflxp(ji,jj) * z2dt )354 !zcoef = ( ( zdep2 - rn_wdmin2 ) * ztmp - zzflxn * z2dt ) / ( zzflxp * z2dt )350 zcoef = ( ( zdep2 - rn_wdmin2 ) * ztmp - zzflxn * pdt ) / ( zflxp(ji,jj) * pdt ) 351 !zcoef = ( ( zdep2 - rn_wdmin2 ) * ztmp - zzflxn * pdt ) / ( zzflxp * pdt ) 355 352 ! flag if the limiter has been used but stop flagging if the only 356 353 ! changes have zeroed the coefficient since further iterations will -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/FLO/flo4rk.F90
r9598 r9939 131 131 ! computation of Runge-Kutta factor 132 132 DO jfl = 1, jpnfl 133 zrkxfl(jfl,jind) = r dt*zufl(jfl)134 zrkyfl(jfl,jind) = r dt*zvfl(jfl)135 zrkzfl(jfl,jind) = r dt*zwfl(jfl)133 zrkxfl(jfl,jind) = rn_Dt*zufl(jfl) 134 zrkyfl(jfl,jind) = rn_Dt*zvfl(jfl) 135 zrkzfl(jfl,jind) = rn_Dt*zwfl(jfl) 136 136 END DO 137 137 IF( jind /= 4 ) THEN -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/FLO/floblk.F90
r9598 r9939 234 234 ! test to know if the "age" of the float is not bigger than the 235 235 ! time step 236 IF( zagenewfl(jfl) > r dt ) THEN237 zttfl(jfl) = (r dt-zagefl(jfl)) / zvol238 zagenewfl(jfl) = r dt236 IF( zagenewfl(jfl) > rn_Dt ) THEN 237 zttfl(jfl) = (rn_Dt-zagefl(jfl)) / zvol 238 zagenewfl(jfl) = rn_Dt 239 239 ENDIF 240 240 … … 341 341 ifin = 1 342 342 DO jfl = 1, jpnfl 343 IF( zagefl(jfl) < r dt ) ifin = 0343 IF( zagefl(jfl) < rn_Dt ) ifin = 0 344 344 tpifl(jfl) = zgifl(jfl) + 0.5 345 345 tpjfl(jfl) = zgjfl(jfl) + 0.5 … … 348 348 ifin = 1 349 349 DO jfl = 1, jpnfl 350 IF( zagefl(jfl) < r dt ) ifin = 0350 IF( zagefl(jfl) < rn_Dt ) ifin = 0 351 351 tpifl(jfl) = zgifl(jfl) + 0.5 352 352 tpjfl(jfl) = zgjfl(jfl) + 0.5 -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/FLO/flowri.F90
r9598 r9939 125 125 ztem(jfl) = tsn(iafloc,ibfloc,icfl,jp_tem) 126 126 zsal (jfl) = tsn(iafloc,ibfloc,icfl,jp_sal) 127 zrho (jfl) = (rhd(iafloc,ibfloc,icfl)+1)*r au0127 zrho (jfl) = (rhd(iafloc,ibfloc,icfl)+1)*rho0 128 128 129 129 ENDIF … … 145 145 ztem(jfl) = tsn(iafloc,ibfloc,icfl,jp_tem) 146 146 zsal(jfl) = tsn(iafloc,ibfloc,icfl,jp_sal) 147 zrho(jfl) = (rhd(iafloc,ibfloc,icfl)+1)*r au0147 zrho(jfl) = (rhd(iafloc,ibfloc,icfl)+1)*rho0 148 148 149 149 ENDIF … … 248 248 !------------------------------- 249 249 irec = INT( (kt-nn_it000+1)/nn_writefl ) +1 250 ztime = ( kt-nn_it000 + 1 ) * r dt250 ztime = ( kt-nn_it000 + 1 ) * rn_Dt 251 251 252 252 CALL flioputv( numflo , 'time_counter', ztime , start=(/irec/) ) -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/ICB/icbini.F90
r9598 r9939 58 58 !! - setup either test icebergs or calving file 59 59 !!---------------------------------------------------------------------- 60 REAL(wp), INTENT(in) :: pdt ! iceberg time-step (r dt*nn_fsbc)60 REAL(wp), INTENT(in) :: pdt ! iceberg time-step (rn_Dt*nn_fsbc) 61 61 INTEGER , INTENT(in) :: kt ! time step number 62 62 ! -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/ICB/icbtrj.F90
r9598 r9939 69 69 !!---------------------------------------------------------------------- 70 70 71 !!gm we could probably use the daymod calculation here.... 72 !! ===>>> TO BE checked by someone 73 71 74 ! compute initial time step date 72 75 CALL ju2ymds( fjulday, iyear, imonth, iday, zsec ) … … 74 77 75 78 ! compute end time step date 76 zfjulday = fjulday + r dt / rday * REAL( nitend - nit000 + 1 , wp)79 zfjulday = fjulday + rn_Dt / rday * REAL( nitend - nit000 + 1 , wp) 77 80 IF( ABS(zfjulday - REAL(NINT(zfjulday),wp)) < 0.1 / rday ) zfjulday = REAL(NINT(zfjulday),wp) ! avoid truncation error 78 81 CALL ju2ymds( zfjulday, iyear, imonth, iday, zsec ) -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/IOM/iom.F90
r9802 r9939 239 239 ! 240 240 ! end file definition 241 dtime%second = r dt241 dtime%second = rn_Dt 242 242 CALL xios_set_timestep( dtime ) 243 243 CALL xios_close_context_definition() … … 2358 2358 idx = INDEX(clname,'@startdate@') + INDEX(clname,'@STARTDATE@') 2359 2359 DO WHILE ( idx /= 0 ) 2360 cldate = iom_sdate( fjulday - r dt / rday )2360 cldate = iom_sdate( fjulday - rn_Dt / rday ) 2361 2361 clname = clname(1:idx-1)//TRIM(cldate)//clname(idx+11:LEN_TRIM(clname)) 2362 2362 idx = INDEX(clname,'@startdate@') + INDEX(clname,'@STARTDATE@') … … 2365 2365 idx = INDEX(clname,'@startdatefull@') + INDEX(clname,'@STARTDATEFULL@') 2366 2366 DO WHILE ( idx /= 0 ) 2367 cldate = iom_sdate( fjulday - r dt / rday, ldfull = .TRUE. )2367 cldate = iom_sdate( fjulday - rn_Dt / rday, ldfull = .TRUE. ) 2368 2368 clname = clname(1:idx-1)//TRIM(cldate)//clname(idx+15:LEN_TRIM(clname)) 2369 2369 idx = INDEX(clname,'@startdatefull@') + INDEX(clname,'@STARTDATEFULL@') … … 2372 2372 idx = INDEX(clname,'@enddate@') + INDEX(clname,'@ENDDATE@') 2373 2373 DO WHILE ( idx /= 0 ) 2374 cldate = iom_sdate( fjulday + r dt / rday * REAL( nitend - nit000, wp ), ld24 = .TRUE. )2374 cldate = iom_sdate( fjulday + rn_Dt / rday * REAL( nitend - nit000, wp ), ld24 = .TRUE. ) 2375 2375 clname = clname(1:idx-1)//TRIM(cldate)//clname(idx+9:LEN_TRIM(clname)) 2376 2376 idx = INDEX(clname,'@enddate@') + INDEX(clname,'@ENDDATE@') … … 2379 2379 idx = INDEX(clname,'@enddatefull@') + INDEX(clname,'@ENDDATEFULL@') 2380 2380 DO WHILE ( idx /= 0 ) 2381 cldate = iom_sdate( fjulday + r dt / rday * REAL( nitend - nit000, wp ), ld24 = .TRUE., ldfull = .TRUE. )2381 cldate = iom_sdate( fjulday + rn_Dt / rday * REAL( nitend - nit000, wp ), ld24 = .TRUE., ldfull = .TRUE. ) 2382 2382 clname = clname(1:idx-1)//TRIM(cldate)//clname(idx+13:LEN_TRIM(clname)) 2383 2383 idx = INDEX(clname,'@enddatefull@') + INDEX(clname,'@ENDDATEFULL@') -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/LDF/ldfdyn.F90
r9598 r9939 408 408 zcmsmag = (rn_csmc/rpi)**2 ! (C_smag/pi)^2 409 409 zstabf_lo = rn_minfac * rn_minfac / ( 2._wp * 4._wp * zcmsmag ) ! lower limit stability factor scaling 410 zstabf_up = rn_maxfac / ( 4._wp * zcmsmag * 2._wp * r dt )! upper limit stability factor scaling410 zstabf_up = rn_maxfac / ( 4._wp * zcmsmag * 2._wp * rn_Dt ) ! upper limit stability factor scaling 411 411 IF( ln_dynldf_blp ) zstabf_lo = ( 16._wp / 9._wp ) * zstabf_lo ! provide |U|L^3/12 lower limit instead 412 412 ! ! of |U|L^3/16 in blp case -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/LDF/ldftra.F90
r9737 r9939 852 852 ! 853 853 ! 854 zztmp = 0.5_wp * r au0 * rcp854 zztmp = 0.5_wp * rho0_rcp 855 855 IF( iom_use('ueiv_heattr') .OR. iom_use('ueiv_heattr3d') ) THEN 856 856 zw2d(:,:) = 0._wp -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/OBS/diaobs.F90
r9656 r9939 539 539 ENDIF 540 540 541 idaystp = NINT( rday / r dt )541 idaystp = NINT( rday / rn_Dt ) 542 542 543 543 !----------------------------------------------------------------------- … … 630 630 631 631 ENDIF 632 632 ! 633 633 END SUBROUTINE dia_obs 634 634 635 635 636 SUBROUTINE dia_obs_wri … … 651 652 !! ! 15-08 (M. Martin) Combined writing for prof and surf types 652 653 !!---------------------------------------------------------------------- 653 !! * Modules used654 654 USE obs_rot_vel ! Rotation of velocities 655 655 656 656 IMPLICIT NONE 657 657 658 !! * Local declarations659 658 INTEGER :: jtype ! Data set loop variable 660 659 INTEGER :: jo, jvar, jk 661 REAL(wp), DIMENSION(:), ALLOCATABLE :: & 662 & zu, & 663 & zv 660 REAL(wp), DIMENSION(:), ALLOCATABLE :: zu, zv 664 661 665 662 !----------------------------------------------------------------------- … … 771 768 !! ! 2014-09 (D. Lea) New generic routine now deals with arbitrary initial time of day 772 769 !!---------------------------------------------------------------------- 773 USE phycst, ONLY : & ! Physical constants 774 & rday 775 USE dom_oce, ONLY : & ! Ocean space and time domain variables 776 & rdt 770 USE phycst , ONLY : rday ! Physical constants 771 USE dom_oce, ONLY : rn_Dt ! Ocean space and time domain variables 777 772 778 773 IMPLICIT NONE 779 774 780 !! * Arguments 781 REAL(KIND=dp), INTENT(OUT) :: ddobs ! Date in YYYYMMDD.HHMMSS 782 INTEGER :: kstp 783 784 !! * Local declarations 775 REAL(KIND=dp), INTENT( out) :: ddobs ! Date in YYYYMMDD.HHMMSS 776 INTEGER , INTENT(in ) :: kstp 777 785 778 INTEGER :: iyea ! date - (year, month, day, hour, minute) 786 779 INTEGER :: imon … … 805 798 !! Compute number of days + number of hours + min since initial time 806 799 !!---------------------------------------------------------------------- 807 zdayfrc = kstp * r dt / rday800 zdayfrc = kstp * rn_Dt / rday 808 801 zdayfrc = zdayfrc - aint(zdayfrc) 809 802 imin = imin + int( zdayfrc * 24 * 60 ) … … 816 809 iday=iday+1 817 810 END DO 818 iday = iday + kstp * r dt / rday811 iday = iday + kstp * rn_Dt / rday 819 812 820 813 !----------------------------------------------------------------------- … … 842 835 END SUBROUTINE calc_date 843 836 837 844 838 SUBROUTINE ini_date( ddobsini ) 845 839 !!---------------------------------------------------------------------- … … 859 853 !! ! 2014-09 (D. Lea) Change to call generic routine calc_date 860 854 !!---------------------------------------------------------------------- 861 862 855 IMPLICIT NONE 863 864 !! * Arguments865 REAL(KIND=dp), INTENT(OUT) :: ddobsini ! Initial date in YYYYMMDD.HHMMSS866 856 ! 857 REAL(KIND=dp), INTENT(out) :: ddobsini ! Initial date in YYYYMMDD.HHMMSS 858 !!---------------------------------------------------------------------- 859 ! 867 860 CALL calc_date( nit000 - 1, ddobsini ) 868 861 ! 869 862 END SUBROUTINE ini_date 863 870 864 871 865 SUBROUTINE fin_date( ddobsfin ) … … 1011 1005 END SUBROUTINE obs_setinterpopts 1012 1006 1007 !!====================================================================== 1013 1008 END MODULE diaobs -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/OBS/obs_prep.F90
r9598 r9939 610 610 !! ! 2010-05 (D. Lea) Fix in leap year calculation for NEMO vn3.2 611 611 !!---------------------------------------------------------------------- 612 !! * Modules used 613 USE dom_oce, ONLY : & ! Geographical information 614 & rdt 615 USE phycst, ONLY : & ! Physical constants 616 & rday, & 617 & rmmss, & 618 & rhhmm 619 !! * Arguments 612 USE dom_oce, ONLY : rn_Dt ! Geographical information 613 USE phycst , ONLY : rday, rmmss, rhhmm ! Physical constants 614 620 615 INTEGER, INTENT(IN) :: kcycle ! Current cycle 621 616 INTEGER, INTENT(IN) :: kyea0 ! Initial date coordinates … … 632 627 & kobshou, & 633 628 & kobsmin 634 INTEGER, DIMENSION(kobsno), INTENT(INOUT) :: & 635 & kobsqc ! Quality control flag 636 INTEGER, DIMENSION(kobsno), INTENT(OUT) :: & 637 & kobsstp ! Number of time steps up to the 638 ! observation time 639 640 !! * Local declarations 629 INTEGER, DIMENSION(kobsno), INTENT(inout) :: kobsqc ! Quality control flag 630 INTEGER, DIMENSION(kobsno), INTENT( out) :: kobsstp ! Number of time steps up to the observation time 631 ! 641 632 INTEGER :: jyea 642 633 INTEGER :: jmon … … 661 652 662 653 ! Intialize the number of time steps per day 663 idaystp = NINT( rday / r dt )654 idaystp = NINT( rday / rn_Dt ) 664 655 665 656 !--------------------------------------------------------------------- … … 731 722 732 723 ! Add in the number of time steps to the observation minute 733 zminstp = rmmss / r dt724 zminstp = rmmss / rn_Dt 734 725 zhoustp = rhhmm * zminstp 735 726 -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/SBC/fldread.F90
r9807 r9939 180 180 ! Note that shifting time to be centrered in the middle of sbc time step impacts only nsec_* variables of the calendar 181 181 IF( present(kit) ) THEN ! ignore kn_fsbc in this case 182 isecsbc = nsec_year + nsec1jan000 + (kit+it_offset)*NINT( r dt/REAL(nn_baro,wp) )182 isecsbc = nsec_year + nsec1jan000 + (kit+it_offset)*NINT( rn_Dt/REAL(nn_e,wp) ) 183 183 ELSE ! middle of sbc time step 184 isecsbc = nsec_year + nsec1jan000 + NINT(0.5 * REAL(kn_fsbc - 1,wp) * r dt) + it_offset * NINT(rdt)184 isecsbc = nsec_year + nsec1jan000 + NINT(0.5 * REAL(kn_fsbc - 1,wp) * rn_Dt) + it_offset * NINT(rn_Dt) 185 185 ENDIF 186 186 imf = SIZE( sd ) … … 213 213 CALL fld_rec( kn_fsbc, sd(jf), kt_offset = it_offset, kit = kit ) ! update after record informations 214 214 215 ! if kn_fsbc*r dt is larger than nfreqh (which is kind of odd),215 ! if kn_fsbc*rn_Dt is larger than nfreqh (which is kind of odd), 216 216 ! it is possible that the before value is no more the good one... we have to re-read it 217 217 ! if before is not the last record of the file currently opened and after is the first record to be read … … 234 234 IF( sd(jf)%ln_tint ) THEN 235 235 236 ! if kn_fsbc*r dt is larger than nfreqh (which is kind of odd),236 ! if kn_fsbc*rn_Dt is larger than nfreqh (which is kind of odd), 237 237 ! it is possible that the before value is no more the good one... we have to re-read it 238 238 ! if before record is not just just before the after record... … … 267 267 ! year/month/week/day file to be not present. If the run continue further than the current 268 268 ! year/month/week/day, next year/month/week/day file must exist 269 isecend = nsec_year + nsec1jan000 + (nitend - kt) * NINT(r dt) ! second at the end of the run270 llstop = isecend > sd(jf)%nrec_a(2) 269 isecend = nsec_year + nsec1jan000 + (nitend - kt) * NINT(rn_Dt) ! second at the end of the run 270 llstop = isecend > sd(jf)%nrec_a(2) ! read more than 1 record of next year 271 271 ! we suppose that the date of next file is next day (should be ok even for weekly files...) 272 272 CALL fld_clopn( sd(jf), nyear + COUNT((/llnxtyr /)) , & … … 485 485 ENDIF 486 486 IF( PRESENT(kt_offset) ) it_offset = kt_offset 487 IF( PRESENT(kit) ) THEN ; it_offset = ( kit + it_offset ) * NINT( r dt/REAL(nn_baro,wp) )488 ELSE ; it_offset = it_offset * NINT( rdt)487 IF( PRESENT(kit) ) THEN ; it_offset = ( kit + it_offset ) * NINT( rn_Dt / REAL(nn_e,wp) ) 488 ELSE ; it_offset = it_offset * NINT( rn_Dt ) 489 489 ENDIF 490 490 ! … … 563 563 ELSE ; ztmp = REAL(nsec_year ,wp) ! since 00h on Jan 1 of the current year 564 564 ENDIF 565 ztmp = ztmp + 0.5 * REAL(kn_fsbc - 1, wp) * r dt + REAL( it_offset, wp )! centrered in the middle of sbc time step566 ztmp = ztmp + 0.01 * r dt! avoid truncation error565 ztmp = ztmp + 0.5 * REAL(kn_fsbc - 1, wp) * rn_Dt + REAL( it_offset, wp ) ! centrered in the middle of sbc time step 566 ztmp = ztmp + 0.01 * rn_Dt ! avoid truncation error 567 567 IF( sdjf%ln_tint ) THEN ! time interpolation, shift by 1/2 record 568 568 ! -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/SBC/sbcapr.F90
r9598 r9939 36 36 37 37 REAL(wp) :: tarea ! whole domain mean masked ocean surface 38 REAL(wp) :: r1_ grau ! = 1.e0 / (grav * rau0)38 REAL(wp) :: r1_rhog ! = 1 / (rho0*grav) 39 39 40 40 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_apr ! structure of input fields (file informations, fields read) … … 100 100 ENDIF 101 101 ! 102 r1_ grau = 1.e0 / (grav * rau0)!* constant for optimization102 r1_rhog = 1._wp / (rho0*grav) !* constant for optimization 103 103 ! 104 104 ! !* control check … … 144 144 ! 145 145 ! !* Patm related forcing at kt 146 ssh_ib(:,:) = - ( sf_apr(1)%fnow(:,:,1) - rn_pref ) * r1_ grau! equivalent ssh (inverse barometer)146 ssh_ib(:,:) = - ( sf_apr(1)%fnow(:,:,1) - rn_pref ) * r1_rhog ! equivalent ssh (inverse barometer) 147 147 apr (:,:) = sf_apr(1)%fnow(:,:,1) ! atmospheric pressure 148 148 ! -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/SBC/sbcblk.F90
r9767 r9939 225 225 ALLOCATE( sf(ifpr)%fnow(jpi,jpj,1) ) 226 226 IF( slf_i(ifpr)%ln_tint ) ALLOCATE( sf(ifpr)%fdta(jpi,jpj,1,2) ) 227 IF( slf_i(ifpr)%nfreqh > 0. .AND. MOD( 3600. * slf_i(ifpr)%nfreqh , REAL(nn_fsbc) * r dt) /= 0. ) &228 & CALL ctl_warn( 'sbc_blk_init: sbcmod timestep r dt*nn_fsbc is NOT a submultiple of atmosphericforcing frequency.', &229 & ' This is not ideal. You should consider changing either r dt or nn_fsbc value...' )227 IF( slf_i(ifpr)%nfreqh > 0. .AND. MOD( 3600. * slf_i(ifpr)%nfreqh , REAL(nn_fsbc) * rn_Dt) /= 0. ) & 228 & CALL ctl_warn( 'sbc_blk_init: sbcmod timestep rn_Dt*nn_fsbc is NOT a submultiple of atmos. forcing frequency.', & 229 & ' This is not ideal. You should consider changing either rn_Dt or nn_fsbc value...' ) 230 230 231 231 END DO … … 323 323 ! 324 324 ! ! compute the surface ocean fluxes using bulk formulea 325 IF( MOD( kt -1, nn_fsbc ) == 0 ) CALL blk_oce( kt, sf, sst_m, ssu_m, ssv_m )325 IF( MOD( kt-1, nn_fsbc ) == 0 ) CALL blk_oce( kt, sf, sst_m, ssu_m, ssv_m ) 326 326 327 327 #if defined key_cice 328 IF( MOD( kt -1, nn_fsbc ) == 0 ) THEN328 IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN 329 329 qlw_ice(:,:,1) = sf(jp_qlw )%fnow(:,:,1) 330 330 IF( ln_dm2dc ) THEN ; qsr_ice(:,:,1) = sbc_dcy( sf(jp_qsr)%fnow(:,:,1) ) … … 504 504 ENDIF 505 505 506 zqla(:,:) = L_vap( zst(:,:)) * zevap(:,:) ! Latent Heat flux506 zqla(:,:) = L_vap( zst(:,:) ) * zevap(:,:) ! Latent Heat flux 507 507 508 508 … … 526 526 ! 527 527 qns(:,:) = zqlw(:,:) - zqsb(:,:) - zqla(:,:) & ! Downward Non Solar 528 & - sf(jp_snow)%fnow(:,:,1) * rn_pfac * lfus& ! remove latent melting heat for solid precip528 & - sf(jp_snow)%fnow(:,:,1) * rn_pfac * rLfus & ! remove latent melting heat for solid precip 529 529 & - zevap(:,:) * pst(:,:) * rcp & ! remove evap heat content at SST 530 530 & + ( sf(jp_prec)%fnow(:,:,1) - sf(jp_snow)%fnow(:,:,1) ) * rn_pfac & ! add liquid precip heat content at Tair 531 531 & * ( sf(jp_tair)%fnow(:,:,1) - rt0 ) * rcp & 532 532 & + sf(jp_snow)%fnow(:,:,1) * rn_pfac & ! add solid precip heat content at min(Tair,Tsnow) 533 & * ( MIN( sf(jp_tair)%fnow(:,:,1), rt0 _snow ) - rt0 ) * cpic533 & * ( MIN( sf(jp_tair)%fnow(:,:,1), rt0 ) - rt0 ) * rcpi 534 534 qns(:,:) = qns(:,:) * tmask(:,:,1) 535 535 ! … … 643 643 !! ** Purpose : Compute the moist adiabatic lapse-rate. 644 644 !! => http://glossary.ametsoc.org/wiki/Moist-adiabatic_lapse_rate 645 !! => http://www.geog.ucsb.edu/~joel/g266_s10/lecture_notes/chapt03/oh10_3_01/oh10_3_01.html646 645 !! 647 646 !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://sourceforge.net/p/aerobulk) … … 652 651 ! 653 652 INTEGER :: ji, jj ! dummy loop indices 654 REAL(wp) :: zrv, ziRT ! local scalar 653 REAL(wp) :: zrv, ziRT ! local scalar 654 REAL(wp) :: zLv = 2.5e+6_wp ! latent heat of vaporisation 655 655 !!---------------------------------------------------------------------------------- 656 656 ! … … 659 659 zrv = pqa(ji,jj) / (1. - pqa(ji,jj)) 660 660 ziRT = 1. / (R_dry*ptak(ji,jj)) ! 1/RT 661 gamma_moist(ji,jj) = grav * ( 1. + cevap*zrv*ziRT ) / ( Cp_dry + cevap*cevap*zrv*reps0*ziRT/ptak(ji,jj) )661 gamma_moist(ji,jj) = grav * ( 1. + zLv*zrv*ziRT ) / ( Cp_dry + zLv*zLv*zrv*reps0*ziRT/ptak(ji,jj) ) 662 662 END DO 663 663 END DO … … 792 792 REAL(wp) :: zst3 ! local variable 793 793 REAL(wp) :: zcoef_dqlw, zcoef_dqla ! - - 794 REAL(wp) :: zztmp , z1_lsub! - -794 REAL(wp) :: zztmp ! - - 795 795 REAL(wp) :: zfr1, zfr2 ! local variables 796 796 REAL(wp), DIMENSION(jpi,jpj,jpl) :: z1_st ! inverse of surface temperature … … 868 868 869 869 ! --- evaporation --- ! 870 z1_lsub = 1._wp / Lsub 871 evap_ice (:,:,:) = rn_efac * qla_ice (:,:,:) * z1_lsub ! sublimation 872 devap_ice(:,:,:) = rn_efac * dqla_ice(:,:,:) * z1_lsub ! d(sublimation)/dT 870 evap_ice (:,:,:) = rn_efac * qla_ice (:,:,:) * r1_Lsub ! sublimation 871 devap_ice(:,:,:) = rn_efac * dqla_ice(:,:,:) * r1_Lsub ! d(sublimation)/dT 873 872 zevap (:,:) = rn_efac * ( emp(:,:) + tprecip(:,:) ) ! evaporation over ocean 874 873 … … 884 883 & + ( tprecip(:,:) - sprecip(:,:) ) * ( sf(jp_tair)%fnow(:,:,1) - rt0 ) * rcp & ! liquid precip at Tair 885 884 & + sprecip(:,:) * ( 1._wp - zsnw ) * & ! solid precip at min(Tair,Tsnow) 886 & ( ( MIN( sf(jp_tair)%fnow(:,:,1), rt0 _snow ) - rt0 ) * cpic * tmask(:,:,1) - lfus )885 & ( ( MIN( sf(jp_tair)%fnow(:,:,1), rt0 ) - rt0 ) * rcpi * tmask(:,:,1) - rLfus ) 887 886 qemp_ice(:,:) = sprecip(:,:) * zsnw * & ! solid precip (only) 888 & ( ( MIN( sf(jp_tair)%fnow(:,:,1), rt0 _snow ) - rt0 ) * cpic * tmask(:,:,1) - lfus )887 & ( ( MIN( sf(jp_tair)%fnow(:,:,1), rt0 ) - rt0 ) * rcpi * tmask(:,:,1) - rLfus ) 889 888 890 889 ! --- total solar and non solar fluxes --- ! … … 894 893 895 894 ! --- heat content of precip over ice in J/m3 (to be used in 1D-thermo) --- ! 896 qprec_ice(:,:) = rhos n * ( ( MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow ) - rt0 ) * cpic * tmask(:,:,1) - lfus )895 qprec_ice(:,:) = rhos * ( ( MIN( sf(jp_tair)%fnow(:,:,1), rt0 ) - rt0 ) * rcpi * tmask(:,:,1) - rLfus ) 897 896 898 897 ! --- heat content of evap over ice in W/m2 (to be used in 1D-thermo) --- 899 898 DO jl = 1, jpl 900 qevap_ice(:,:,jl) = 0._wp ! should be -evap_ice(:,:,jl)*( ( Tice - rt0 ) * cpic* tmask(:,:,1) )899 qevap_ice(:,:,jl) = 0._wp ! should be -evap_ice(:,:,jl)*( ( Tice - rt0 ) * rcpi * tmask(:,:,1) ) 901 900 ! ! But we do not have Tice => consider it at 0degC => evap=0 902 901 END DO … … 971 970 CASE ( 1 , 2 ) 972 971 ! 973 zfac = 1._wp / ( rn_cnd_s + rc dic)972 zfac = 1._wp / ( rn_cnd_s + rcnd_i ) 974 973 zfac2 = EXP(1._wp) * 0.5_wp * zepsilon 975 974 zfac3 = 2._wp / zepsilon … … 978 977 DO jj = 1 , jpj 979 978 DO ji = 1, jpi 980 zhe = ( rn_cnd_s * phi(ji,jj,jl) + rc dic* phs(ji,jj,jl) ) * zfac ! Effective thickness981 IF( zhe >= zfac2 ) zgfac(ji,jj,jl) = MIN( 2._wp, 0.5_wp * ( 1._wp + LOG( zhe * zfac3 ) ) ) ! Enhanced conduction factor979 zhe = ( rn_cnd_s * phi(ji,jj,jl) + rcnd_i * phs(ji,jj,jl) ) * zfac ! Effective thickness 980 IF( zhe >= zfac2 ) zgfac(ji,jj,jl) = MIN( 2._wp, 0.5_wp * ( 1._wp + LOG( zhe * zfac3 ) ) ) ! Enhanced conduction factor 982 981 END DO 983 982 END DO … … 990 989 ! -------------------------------------------------------------! 991 990 ! 992 zfac = rc dic* rn_cnd_s991 zfac = rcnd_i * rn_cnd_s 993 992 ! 994 993 DO jl = 1, jpl 995 994 DO jj = 1 , jpj 996 995 DO ji = 1, jpi 997 ! 998 zkeff_h = zfac * zgfac(ji,jj,jl) / & ! Effective conductivity of the snow-ice system divided by thickness 999 & ( rcdic * phs(ji,jj,jl) + rn_cnd_s * MAX( 0.01, phi(ji,jj,jl) ) ) 996 ! ! Effective conductivity of the snow-ice system divided by thickness 997 zkeff_h = zfac * zgfac(ji,jj,jl) / ( rcnd_i * phs(ji,jj,jl) + rn_cnd_s * MAX( 0.01, phi(ji,jj,jl) ) ) 1000 998 ztsu = ptsu(ji,jj,jl) ! Store current iteration temperature 1001 999 ztsu0 = ptsu(ji,jj,jl) ! Store initial surface temperature -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/SBC/sbccpl.F90
r9767 r9939 193 193 194 194 REAL(wp) :: rpref = 101000._wp ! reference atmospheric pressure[N/m2] 195 REAL(wp) :: r1_ grau ! = 1.e0 / (grav * rau0)195 REAL(wp) :: r1_rhog ! = 1 / (rho0*grav) 196 196 197 197 INTEGER , ALLOCATABLE, SAVE, DIMENSION(:) :: nrcvinfo ! OASIS info argument … … 1100 1100 LOGICAL :: llnewtx, llnewtau ! update wind stress components and module?? 1101 1101 INTEGER :: ji, jj, jn ! dummy loop indices 1102 INTEGER :: isec ! number of seconds since nit000 (assuming r dt did not change since nit000)1102 INTEGER :: isec ! number of seconds since nit000 (assuming rn_Dt did not change since nit000) 1103 1103 REAL(wp) :: zcumulneg, zcumulpos ! temporary scalars 1104 1104 REAL(wp) :: zcoef ! temporary scalar … … 1114 1114 ! ! Receive all the atmos. fields (including ice information) 1115 1115 ! ! ======================================================= ! 1116 isec = ( kt - nit000 ) * NINT( r dt )! date of exchanges1116 isec = ( kt - nit000 ) * NINT( rn_Dt ) ! date of exchanges 1117 1117 DO jn = 1, jprcv ! received fields sent by the atmosphere 1118 1118 IF( srcv(jn)%laction ) CALL cpl_rcv( jn, isec, frcv(jn)%z3, xcplmask(:,:,1:nn_cplmodel), nrcvinfo(jn) ) … … 1259 1259 IF( kt /= nit000 ) ssh_ibb(:,:) = ssh_ib(:,:) !* Swap of ssh_ib fields 1260 1260 1261 r1_ grau = 1.e0 / (grav * rau0) !* constant for optimization1262 ssh_ib(:,:) = - ( frcv(jpr_mslp)%z3(:,:,1) - rpref ) * r1_ grau! equivalent ssh (inverse barometer)1261 r1_rhog = 1.e0 / (grav * rho0) !* constant for optimization 1262 ssh_ib(:,:) = - ( frcv(jpr_mslp)%z3(:,:,1) - rpref ) * r1_rhog ! equivalent ssh (inverse barometer) 1263 1263 apr (:,:) = frcv(jpr_mslp)%z3(:,:,1) !atmospheric pressure 1264 1264 … … 1418 1418 zqns(:,:) = zqns(:,:) - zemp(:,:) * sst_m(:,:) * rcp ! remove heat content due to mass flux (assumed to be at SST) 1419 1419 IF( srcv(jpr_snow )%laction ) THEN 1420 zqns(:,:) = zqns(:,:) - frcv(jpr_snow)%z3(:,:,1) * lfus! energy for melting solid precipitation over the free ocean1420 zqns(:,:) = zqns(:,:) - frcv(jpr_snow)%z3(:,:,1) * rLfus ! energy for melting solid precipitation over the free ocean 1421 1421 ENDIF 1422 1422 ENDIF 1423 1423 ! 1424 IF( srcv(jpr_icb)%laction ) zqns(:,:) = zqns(:,:) - frcv(jpr_icb)%z3(:,:,1) * lfus ! remove heat content associated to iceberg melting1424 IF( srcv(jpr_icb)%laction ) zqns(:,:) = zqns(:,:) - frcv(jpr_icb)%z3(:,:,1) * rLfus ! remove heat content associated to iceberg melting 1425 1425 ! 1426 1426 IF( ln_mixcpl ) THEN ; qns(:,:) = qns(:,:) * xcplmask(:,:,0) + zqns(:,:) * zmsk(:,:) … … 1811 1811 ! 1812 1812 ! --- calving (removed from qns_tot) --- ! 1813 IF( srcv(jpr_cal)%laction ) zqns_tot(:,:) = zqns_tot(:,:) - frcv(jpr_cal)%z3(:,:,1) * lfus ! remove latent heat of calving1814 ! we suppose it melts at 0deg, though it should be temp. of surrounding ocean1813 IF( srcv(jpr_cal)%laction ) zqns_tot(:,:) = zqns_tot(:,:) - frcv(jpr_cal)%z3(:,:,1) * rLfus ! remove latent heat of calving 1814 ! we suppose it melts at 0deg, though it should be temp. of surrounding ocean 1815 1815 ! --- iceberg (removed from qns_tot) --- ! 1816 IF( srcv(jpr_icb)%laction ) zqns_tot(:,:) = zqns_tot(:,:) - frcv(jpr_icb)%z3(:,:,1) * lfus ! remove latent heat of iceberg melting1816 IF( srcv(jpr_icb)%laction ) zqns_tot(:,:) = zqns_tot(:,:) - frcv(jpr_icb)%z3(:,:,1) * rLfus ! remove latent heat of iceberg melting 1817 1817 1818 1818 #if defined key_si3 … … 1823 1823 1824 1824 ! Heat content per unit mass of snow (J/kg) 1825 WHERE( SUM( a_i, dim=3 ) > 1.e-10 ) ; zcptsnw(:,:) = cpic* SUM( (tn_ice - rt0) * a_i, dim=3 ) / SUM( a_i, dim=3 )1825 WHERE( SUM( a_i, dim=3 ) > 1.e-10 ) ; zcptsnw(:,:) = rcpi * SUM( (tn_ice - rt0) * a_i, dim=3 ) / SUM( a_i, dim=3 ) 1826 1826 ELSEWHERE ; zcptsnw(:,:) = zcptn(:,:) 1827 END WHERE1827 END WHERE 1828 1828 ! Heat content per unit mass of rain (J/kg) 1829 1829 zcptrain(:,:) = rcp * ( SUM( (tn_ice(:,:,:) - rt0) * a_i(:,:,:), dim=3 ) + sst_m(:,:) * ziceld(:,:) ) 1830 1830 1831 1831 ! --- enthalpy of snow precip over ice in J/m3 (to be used in 1D-thermo) --- ! 1832 zqprec_ice(:,:) = rhos n * ( zcptsnw(:,:) - lfus )1832 zqprec_ice(:,:) = rhos * ( zcptsnw(:,:) - rLfus ) 1833 1833 1834 1834 ! --- heat content of evap over ice in W/m2 (to be used in 1D-thermo) --- ! 1835 1835 DO jl = 1, jpl 1836 zqevap_ice(:,:,jl) = 0._wp ! should be -evap * ( ( Tice - rt0 ) * cpic) but atm. does not take it into account1836 zqevap_ice(:,:,jl) = 0._wp ! should be -evap * ( ( Tice - rt0 ) * rcpi ) but atm. does not take it into account 1837 1837 END DO 1838 1838 … … 1840 1840 zqemp_oce(:,:) = - zevap_oce(:,:) * zcptn (:,:) & ! evap 1841 1841 & + ( ztprecip(:,:) - zsprecip(:,:) ) * zcptrain(:,:) & ! liquid precip 1842 & + zsprecip(:,:) * ( 1._wp - zsnw ) * ( zcptsnw (:,:) - lfus ) ! solid precip over ocean + snow melting1843 zqemp_ice(:,:) = zsprecip(:,:) * zsnw * ( zcptsnw (:,:) - lfus ) ! solid precip over ice (qevap_ice=0 since atm. does not take it into account)1842 & + zsprecip(:,:) * ( 1._wp - zsnw ) * ( zcptsnw (:,:) - rLfus ) ! solid precip over ocean + snow melting 1843 zqemp_ice(:,:) = zsprecip(:,:) * zsnw * ( zcptsnw (:,:) - rLfus ) ! solid precip over ice (qevap_ice=0 since atm. does not take it into account) 1844 1844 !! zqemp_ice(:,:) = - frcv(jpr_ievp)%z3(:,:,1) * picefr(:,:) * zcptsnw (:,:) & ! ice evap 1845 !! & + zsprecip(:,:) * zsnw * zqprec_ice(:,:) * r1_rhos n! solid precip over ice1845 !! & + zsprecip(:,:) * zsnw * zqprec_ice(:,:) * r1_rhos ! solid precip over ice 1846 1846 1847 1847 ! --- total non solar flux (including evap/precip) --- ! … … 1875 1875 ! clem: this formulation is certainly wrong... but better than it was... 1876 1876 zqns_tot(:,:) = zqns_tot(:,:) & ! zqns_tot update over free ocean with: 1877 & - ( ziceld(:,:) * zsprecip(:,:) * lfus ) &! remove the latent heat flux of solid precip. melting1877 & - ( ziceld(:,:) * zsprecip(:,:) * rLfus ) & ! remove the latent heat flux of solid precip. melting 1878 1878 & - ( zemp_tot(:,:) & ! remove the heat content of mass flux (assumed to be at SST) 1879 1879 & - zemp_ice(:,:) ) * zcptn(:,:) … … 1892 1892 #endif 1893 1893 ! outputs 1894 IF ( srcv(jpr_cal)%laction ) CALL iom_put('hflx_cal_cea' , - frcv(jpr_cal)%z3(:,:,1) * lfus )! latent heat from calving1895 IF ( srcv(jpr_icb)%laction ) CALL iom_put('hflx_icb_cea' , - frcv(jpr_icb)%z3(:,:,1) * lfus )! latent heat from icebergs melting1894 IF ( srcv(jpr_cal)%laction ) CALL iom_put('hflx_cal_cea' , - frcv(jpr_cal)%z3(:,:,1) * rLfus ) ! latent heat from calving 1895 IF ( srcv(jpr_icb)%laction ) CALL iom_put('hflx_icb_cea' , - frcv(jpr_icb)%z3(:,:,1) * rLfus ) ! latent heat from icebergs melting 1896 1896 IF ( iom_use('hflx_rain_cea') ) CALL iom_put('hflx_rain_cea' , ( tprecip(:,:) - sprecip(:,:) ) * zcptrain(:,:) ) ! heat flux from rain (cell average) 1897 1897 IF ( iom_use('hflx_evap_cea') ) CALL iom_put('hflx_evap_cea' , ( frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) & 1898 1898 & * picefr(:,:) ) * zcptn(:,:) * tmask(:,:,1) ) ! heat flux from evap (cell average) 1899 IF ( iom_use('hflx_snow_cea') ) CALL iom_put('hflx_snow_cea' , sprecip(:,:) * ( zcptsnw(:,:) - Lfus ) ) ! heat flux from snow (cell average)1900 IF ( iom_use('hflx_snow_ao_cea') ) CALL iom_put('hflx_snow_ao_cea', sprecip(:,:) * ( zcptsnw(:,:) - Lfus ) &1899 IF ( iom_use('hflx_snow_cea') ) CALL iom_put('hflx_snow_cea' , sprecip(:,:) * ( zcptsnw(:,:) - rLfus ) ) ! heat flux from snow (cell average) 1900 IF ( iom_use('hflx_snow_ao_cea') ) CALL iom_put('hflx_snow_ao_cea', sprecip(:,:) * ( zcptsnw(:,:) - rLfus ) & 1901 1901 & * ( 1._wp - zsnw(:,:) ) ) ! heat flux from snow (over ocean) 1902 IF ( iom_use('hflx_snow_ai_cea') ) CALL iom_put('hflx_snow_ai_cea', sprecip(:,:) * ( zcptsnw(:,:) - Lfus ) &1902 IF ( iom_use('hflx_snow_ai_cea') ) CALL iom_put('hflx_snow_ai_cea', sprecip(:,:) * ( zcptsnw(:,:) - rLfus ) & 1903 1903 & * zsnw(:,:) ) ! heat flux from snow (over ice) 1904 1904 ! note: hflx for runoff and iceshelf are done in sbcrnf and sbcisf resp. … … 2047 2047 !!---------------------------------------------------------------------- 2048 2048 ! 2049 isec = ( kt - nit000 ) * NINT( r dt ) ! date of exchanges2049 isec = ( kt - nit000 ) * NINT( rn_Dt ) ! date of exchanges 2050 2050 2051 2051 zfr_l(:,:) = 1.- fr_i(:,:) -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/SBC/sbcdcy.F90
r9598 r9939 88 88 89 89 ! When are we during the day (from 0 to 1) 90 zlo = ( REAL(nsec_day, wp) - 0.5_wp * r dt ) / rday91 zup = zlo + ( REAL(nn_fsbc, wp) * r dt ) / rday90 zlo = ( REAL(nsec_day, wp) - 0.5_wp * rn_Dt ) / rday 91 zup = zlo + ( REAL(nn_fsbc, wp) * rn_Dt ) / rday 92 92 ! 93 93 IF( nday_qsr == -1 ) THEN ! first time step only … … 187 187 END DO 188 188 ! 189 ztmp = rday / ( r dt * REAL(nn_fsbc, wp) )189 ztmp = rday / ( rn_Dt * REAL(nn_fsbc, wp) ) 190 190 rscal(:,:) = rscal(:,:) * ztmp 191 191 ! -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/SBC/sbcfwb.F90
r9598 r9939 123 123 ENDIF 124 124 ! ! Update fwfold if new year start 125 ikty = 365 * 86400 / r dt!!bug use of 365 days leap year or 360d year !!!!!!!125 ikty = 365 * 86400 / rn_Dt !!bug use of 365 days leap year or 360d year !!!!!!! 126 126 IF( MOD( kt, ikty ) == 0 ) THEN 127 127 a_fwb_b = a_fwb ! mean sea level taking into account the ice+snow 128 128 ! sum over the global domain 129 a_fwb = glob_sum( e1e2t(:,:) * ( sshn(:,:) + snwice_mass(:,:) * r1_r au0 ) )129 a_fwb = glob_sum( e1e2t(:,:) * ( sshn(:,:) + snwice_mass(:,:) * r1_rho0 ) ) 130 130 a_fwb = a_fwb * 1.e+3 / ( area * rday * 365. ) ! convert in Kg/m3/s = mm/s 131 131 !!gm ! !!bug 365d year -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/SBC/sbcice_cice.F90
r9598 r9939 13 13 USE dom_oce ! ocean space and time domain 14 14 USE domvvl 15 USE phycst , only : rcp, rau0, r1_rau0, rhosn, rhoic15 USE phycst , ONLY : rcp, rho0, r1_rho0, rhos, rhoi 16 16 USE in_out_manager ! I/O manager 17 17 USE iom, ONLY : iom_put,iom_use ! I/O manager library !!Joakim edit … … 222 222 CALL cice2nemo(vsno(:,:,:),ztmp1,'T', 1. ) 223 223 CALL cice2nemo(vice(:,:,:),ztmp2,'T', 1. ) 224 snwice_mass (:,:) = ( rhos n * ztmp1(:,:) + rhoic* ztmp2(:,:) )224 snwice_mass (:,:) = ( rhos * ztmp1(:,:) + rhoi * ztmp2(:,:) ) 225 225 snwice_mass_b(:,:) = snwice_mass(:,:) 226 226 227 227 IF( .NOT.ln_rstart ) THEN 228 228 IF( ln_ice_embd ) THEN ! embedded sea-ice: deplete the initial ssh below sea-ice area 229 sshn(:,:) = sshn(:,:) - snwice_mass(:,:) * r1_r au0230 sshb(:,:) = sshb(:,:) - snwice_mass(:,:) * r1_r au0229 sshn(:,:) = sshn(:,:) - snwice_mass(:,:) * r1_rho0 230 sshb(:,:) = sshb(:,:) - snwice_mass(:,:) * r1_rho0 231 231 232 232 !!gm This should be put elsewhere.... (same remark for limsbc) … … 422 422 ! Freezing/melting potential 423 423 ! Calculated over NEMO leapfrog timestep (hence 2*dt) 424 nfrzmlt(:,:) = r au0 * rcp * e3t_m(:,:) * ( Tocnfrz-sst_m(:,:) ) / ( 2.0*dt )424 nfrzmlt(:,:) = rho0 * rcp * e3t_m(:,:) * ( Tocnfrz-sst_m(:,:) ) / ( 2.0*dt ) 425 425 426 426 ztmp(:,:) = nfrzmlt(:,:) … … 459 459 zintb = REAL( nn_fsbc + 1 ) / REAL( nn_fsbc ) * 0.5_wp 460 460 ! 461 zpice(:,:) = ssh_m(:,:) + ( zintn * snwice_mass(:,:) + zintb * snwice_mass_b(:,:) ) * r1_r au0461 zpice(:,:) = ssh_m(:,:) + ( zintn * snwice_mass(:,:) + zintb * snwice_mass_b(:,:) ) * r1_rho0 462 462 ! 463 463 ! … … 644 644 CALL cice2nemo(vsno(:,:,:),ztmp1,'T', 1. ) 645 645 CALL cice2nemo(vice(:,:,:),ztmp2,'T', 1. ) 646 snwice_mass (:,:) = ( rhos n * ztmp1(:,:) + rhoic* ztmp2(:,:) )646 snwice_mass (:,:) = ( rhos * ztmp1(:,:) + rhoi * ztmp2(:,:) ) 647 647 snwice_mass_b(:,:) = snwice_mass(:,:) 648 648 snwice_fmass (:,:) = ( snwice_mass(:,:) - snwice_mass_b(:,:) ) / dt -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/SBC/sbcisf.F90
r9728 r9939 52 52 LOGICAL, PUBLIC :: l_isfcpl = .false. !: isf recieved from oasis 53 53 54 REAL(wp) , PUBLIC, SAVE :: rcpi= 2000.0_wp !: specific heat of ice shelf [J/kg/K]54 REAL(wp) , SAVE :: rcp_isf = 2000.0_wp !: specific heat of ice shelf [J/kg/K] 55 55 REAL(wp), PUBLIC, SAVE :: rkappa = 1.54e-6_wp !: heat diffusivity through the ice-shelf [m2/s] 56 REAL(wp), PUBLIC, SAVE :: rho isf= 920.0_wp !: volumic mass of ice shelf [kg/m3]56 REAL(wp), PUBLIC, SAVE :: rho_isf = 920.0_wp !: volumic mass of ice shelf [kg/m3] 57 57 REAL(wp), PUBLIC, SAVE :: tsurf = -20.0_wp !: air temperature on top of ice shelf [C] 58 REAL(wp), PUBLIC, SAVE :: rlfusisf = 0.334e6_wp !: latent heat of fusion of ice shelf [J/kg]59 58 60 59 !: Variable used in fldread to read the forcing file (nn_isf == 4 .OR. nn_isf == 3) … … 114 113 ! compute fwf and heat flux 115 114 IF( .NOT.l_isfcpl ) THEN ; CALL sbc_isf_cav (kt) 116 ELSE ; qisf(:,:) = fwfisf(:,:) * r lfusisf ! heatflux115 ELSE ; qisf(:,:) = fwfisf(:,:) * rLfus ! heat flux 117 116 ENDIF 118 117 ! … … 127 126 fwfisf(:,:) = - sf_rnfisf(1)%fnow(:,:,1) ! fresh water flux from the isf (fwfisf <0 mean melting) 128 127 ENDIF 129 qisf(:,:) = fwfisf(:,:) * r lfusisf! heat flux128 qisf(:,:) = fwfisf(:,:) * rLfus ! heat flux 130 129 stbl(:,:) = soce 131 130 ! … … 137 136 fwfisf(:,:) = -sf_fwfisf(1)%fnow(:,:,1) ! fwf 138 137 ENDIF 139 qisf(:,:) = fwfisf(:,:) * r lfusisf! heat flux138 qisf(:,:) = fwfisf(:,:) * rLfus ! heat flux 140 139 stbl(:,:) = soce 141 140 ! … … 144 143 ! compute tsc due to isf 145 144 ! isf melting implemented as a volume flux and we assume that melt water is at 0 PSU. 146 ! WARNING water add at temp = 0C, need to add a correction term (fwfisf * tfreez / r au0).145 ! WARNING water add at temp = 0C, need to add a correction term (fwfisf * tfreez / rho0). 147 146 ! compute freezing point beneath ice shelf (or top cell if nn_isf = 3) 148 147 DO jj = 1,jpj … … 153 152 CALL eos_fzp( stbl(:,:), zt_frz(:,:), zdep(:,:) ) 154 153 155 risf_tsc(:,:,jp_tem) = qisf(:,:) * r1_r au0_rcp - fwfisf(:,:) * zt_frz(:,:) * r1_rau0 !154 risf_tsc(:,:,jp_tem) = qisf(:,:) * r1_rho0_rcp - fwfisf(:,:) * zt_frz(:,:) * r1_rho0 ! 156 155 risf_tsc(:,:,jp_sal) = 0.0_wp 157 156 … … 160 159 ! output 161 160 IF( iom_use('iceshelf_cea') ) CALL iom_put( 'iceshelf_cea', -fwfisf(:,:) ) ! isf mass flux 162 IF( iom_use('hflx_isf_cea') ) CALL iom_put( 'hflx_isf_cea', risf_tsc(:,:,jp_tem) * r au0 * rcp ) ! isf sensible+latent heat (W/m2)161 IF( iom_use('hflx_isf_cea') ) CALL iom_put( 'hflx_isf_cea', risf_tsc(:,:,jp_tem) * rho0 * rcp ) ! isf sensible+latent heat (W/m2) 163 162 IF( iom_use('qlatisf' ) ) CALL iom_put( 'qlatisf' , qisf(:,:) ) ! isf latent heat 164 163 IF( iom_use('fwfisf' ) ) CALL iom_put( 'fwfisf' , fwfisf(:,:) ) ! isf mass flux (opposite sign) … … 308 307 qisf (:,:) = 0._wp ; fwfisf (:,:) = 0._wp 309 308 risf_tsc(:,:,:) = 0._wp ; fwfisf_b(:,:) = 0._wp 310 ! 311 ! define isf tbl tickness, top and bottom indice312 SELECT CASE ( nn_isf )309 310 SELECT CASE ( nn_isf ) ! define isf tbl tickness, top and bottom indice 311 ! 313 312 CASE ( 1 ) 314 313 IF(lwp) WRITE(numout,*) … … 452 451 ! 2. ------------Net heat flux and fresh water flux due to the ice shelf 453 452 ! For those corresponding to zonal boundary 454 qisf(ji,jj) = - r au0 * rcp * rn_gammat0 * risfLeff(ji,jj) * e1t(ji,jj) * zt_ave &453 qisf(ji,jj) = - rho0 * rcp * rn_gammat0 * risfLeff(ji,jj) * e1t(ji,jj) * zt_ave & 455 454 & * r1_e1e2t(ji,jj) * tmask(ji,jj,jk) 456 455 457 fwfisf(ji,jj) = qisf(ji,jj) / rlfusisf !fresh water flux kg/(m2s)456 fwfisf(ji,jj) = qisf(ji,jj) * r1_Lfus ! fresh water flux kg/(m2s) 458 457 fwfisf(ji,jj) = fwfisf(ji,jj) * ( soce / stbl(ji,jj) ) 459 458 !add to salinity trend … … 500 499 zlamb1 =-0.0564_wp 501 500 zlamb2 = 0.0773_wp 502 zlamb3 =-7.8633e-8 * grav * r au0501 zlamb3 =-7.8633e-8 * grav * rho0 503 502 ELSE ! linearisation from table 4 (Asay-Davis et al., 2015) 504 503 zlamb1 =-0.0573_wp 505 504 zlamb2 = 0.0832_wp 506 zlamb3 =-7.53e-8 * grav * r au0505 zlamb3 =-7.53e-8 * grav * rho0 507 506 ENDIF 508 507 ! … … 526 525 DO jj = 1, jpj 527 526 DO ji = 1, jpi 528 zhtflx(ji,jj) = zgammat(ji,jj)*rcp*r au0*(ttbl(ji,jj)-zfrz(ji,jj))529 zfwflx(ji,jj) = - zhtflx(ji,jj) /rlfusisf527 zhtflx(ji,jj) = zgammat(ji,jj)*rcp*rho0*(ttbl(ji,jj)-zfrz(ji,jj)) 528 zfwflx(ji,jj) = - zhtflx(ji,jj) * r1_Lfus 530 529 END DO 531 530 END DO … … 544 543 DO ji = 1, jpi 545 544 ! compute coeficient to solve the 2nd order equation 546 zeps1 = rcp*r au0*zgammat(ji,jj)547 zeps2 = r lfusisf*rau0*zgammas(ji,jj)548 zeps3 = rho isf*rcpi*rkappa/MAX(risfdep(ji,jj),zeps)545 zeps1 = rcp*rho0*zgammat(ji,jj) 546 zeps2 = rLfus*rho0*zgammas(ji,jj) 547 zeps3 = rho_isf*rcp_isf*rkappa/MAX(risfdep(ji,jj),zeps) 549 548 zeps4 = zlamb2+zlamb3*risfdep(ji,jj) 550 549 zeps6 = zeps4-ttbl(ji,jj) … … 567 566 ! zhtflx is upward heat flux (out of ocean) 568 567 ! compute the upward water and heat flux (eq. 28 and eq. 29) 569 zfwflx(ji,jj) = r au0 * zgammas(ji,jj) * (zsfrz-stbl(ji,jj)) / MAX(zsfrz,zeps)570 zhtflx(ji,jj) = zgammat(ji,jj) * r au0 * rcp * (ttbl(ji,jj) - zfrz(ji,jj) )568 zfwflx(ji,jj) = rho0 * zgammas(ji,jj) * (zsfrz-stbl(ji,jj)) / MAX(zsfrz,zeps) 569 zhtflx(ji,jj) = zgammat(ji,jj) * rho0 * rcp * (ttbl(ji,jj) - zfrz(ji,jj) ) 571 570 END DO 572 571 END DO … … 890 889 DO jk = ikt, ikb - 1 891 890 phdivn(ji,jj,jk) = phdivn(ji,jj,jk) + ( fwfisf(ji,jj) + fwfisf_b(ji,jj) ) & 892 & * r1_hisf_tbl(ji,jj) * r1_r au0 * zfact891 & * r1_hisf_tbl(ji,jj) * r1_rho0 * zfact 893 892 END DO 894 893 ! level partially include in ice shelf boundary layer 895 894 phdivn(ji,jj,ikb) = phdivn(ji,jj,ikb) + ( fwfisf(ji,jj) & 896 & + fwfisf_b(ji,jj) ) * r1_hisf_tbl(ji,jj) * r1_r au0 * zfact * ralpha(ji,jj)895 & + fwfisf_b(ji,jj) ) * r1_hisf_tbl(ji,jj) * r1_rho0 * zfact * ralpha(ji,jj) 897 896 END DO 898 897 END DO -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/SBC/sbcmod.F90
r9656 r9939 177 177 ! 178 178 IF( .NOT.ln_usr ) THEN ! the model calendar needs some specificities (except in user defined case) 179 IF( MOD( rday , rdt ) /= 0. ) CALL ctl_stop( 'the time step must devide the number of second of in a day' )180 IF( MOD( rday ,2. ) /= 0. ) CALL ctl_stop( 'the number of second of in a day must be an even number' )181 IF( MOD( r dt , 2.) /= 0. ) CALL ctl_stop( 'the time step (in second) must be an even number' )179 IF( MOD( rday , rn_Dt ) /= 0. ) CALL ctl_stop( 'the time step must devide the number of second of in a day' ) 180 IF( MOD( rday , 2. ) /= 0. ) CALL ctl_stop( 'the number of second of in a day must be an even number' ) 181 IF( MOD( rn_Dt, 2. ) /= 0. ) CALL ctl_stop( 'the time step (in second) must be an even number' ) 182 182 ENDIF 183 183 ! !** check option consistency … … 288 288 ! SAS time-step has to be declared in OASIS (mandatory) -> nn_fsbc has to be modified accordingly 289 289 IF( nn_components /= jp_iam_nemo ) THEN 290 IF( nn_components == jp_iam_opa ) nn_fsbc = cpl_freq('O_SFLX') / NINT(r dt)291 IF( nn_components == jp_iam_sas ) nn_fsbc = cpl_freq('I_SFLX') / NINT(r dt)290 IF( nn_components == jp_iam_opa ) nn_fsbc = cpl_freq('O_SFLX') / NINT(rn_Dt) 291 IF( nn_components == jp_iam_sas ) nn_fsbc = cpl_freq('I_SFLX') / NINT(rn_Dt) 292 292 ! 293 293 IF(lwp)THEN … … 306 306 ENDIF 307 307 ! 308 IF( MOD( rday, REAL(nn_fsbc, wp) * r dt ) /= 0 ) &308 IF( MOD( rday, REAL(nn_fsbc, wp) * rn_Dt ) /= 0 ) & 309 309 & CALL ctl_warn( 'sbc_init : nn_fsbc is NOT a multiple of the number of time steps in a day' ) 310 310 ! 311 IF( ln_dm2dc .AND. NINT(rday) / ( nn_fsbc * NINT(r dt) ) < 8 ) &311 IF( ln_dm2dc .AND. NINT(rday) / ( nn_fsbc * NINT(rn_Dt) ) < 8 ) & 312 312 & CALL ctl_warn( 'sbc_init : diurnal cycle for qsr: the sampling of the diurnal cycle is too small...' ) 313 313 ! -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/SBC/sbcrnf.F90
r9727 r9939 116 116 IF( ln_rnf_sal ) CALL fld_read ( kt, nn_fsbc, sf_s_rnf ) ! idem for runoffs salinity if required 117 117 ! 118 IF( MOD( kt -1, nn_fsbc ) == 0 ) THEN118 IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN 119 119 ! 120 120 IF( .NOT. l_rnfcpl ) rnf(:,:) = rn_rfact * ( sf_rnf(1)%fnow(:,:,1) ) * tmask(:,:,1) ! updated runoff value at time step kt … … 122 122 ! ! set temperature & salinity content of runoffs 123 123 IF( ln_rnf_tem ) THEN ! use runoffs temperature data 124 rnf_tsc(:,:,jp_tem) = ( sf_t_rnf(1)%fnow(:,:,1) ) * rnf(:,:) * r1_r au0124 rnf_tsc(:,:,jp_tem) = ( sf_t_rnf(1)%fnow(:,:,1) ) * rnf(:,:) * r1_rho0 125 125 CALL eos_fzp( sss_m(:,:), ztfrz(:,:) ) 126 126 WHERE( sf_t_rnf(1)%fnow(:,:,1) == -999._wp ) ! if missing data value use SST as runoffs temperature 127 rnf_tsc(:,:,jp_tem) = sst_m(:,:) * rnf(:,:) * r1_r au0127 rnf_tsc(:,:,jp_tem) = sst_m(:,:) * rnf(:,:) * r1_rho0 128 128 END WHERE 129 129 WHERE( sf_t_rnf(1)%fnow(:,:,1) == -222._wp ) ! where fwf comes from melting of ice shelves or iceberg 130 rnf_tsc(:,:,jp_tem) = ztfrz(:,:) * rnf(:,:) * r1_r au0 - rnf(:,:) * rlfusisf * r1_rau0_rcp130 rnf_tsc(:,:,jp_tem) = ztfrz(:,:) * rnf(:,:) * r1_rho0 - rnf(:,:) * rLfus * r1_rho0_rcp 131 131 END WHERE 132 132 ELSE ! use SST as runoffs temperature 133 133 !CEOD River is fresh water so must at least be 0 unless we consider ice 134 rnf_tsc(:,:,jp_tem) = MAX(sst_m(:,:),0.0_wp) * rnf(:,:) * r1_r au0134 rnf_tsc(:,:,jp_tem) = MAX(sst_m(:,:),0.0_wp) * rnf(:,:) * r1_rho0 135 135 ENDIF 136 136 ! ! use runoffs salinity data 137 IF( ln_rnf_sal ) rnf_tsc(:,:,jp_sal) = ( sf_s_rnf(1)%fnow(:,:,1) ) * rnf(:,:) * r1_r au0137 IF( ln_rnf_sal ) rnf_tsc(:,:,jp_sal) = ( sf_s_rnf(1)%fnow(:,:,1) ) * rnf(:,:) * r1_rho0 138 138 ! ! else use S=0 for runoffs (done one for all in the init) 139 139 IF( iom_use('runoffs') ) CALL iom_put( 'runoffs' , rnf(:,:) ) ! output runoff mass flux 140 IF( iom_use('hflx_rnf_cea') ) CALL iom_put( 'hflx_rnf_cea', rnf_tsc(:,:,jp_tem) * r au0 * rcp ) ! output runoff sensible heat (W/m2)140 IF( iom_use('hflx_rnf_cea') ) CALL iom_put( 'hflx_rnf_cea', rnf_tsc(:,:,jp_tem) * rho0 * rcp ) ! output runoff sensible heat (W/m2) 141 141 ENDIF 142 142 ! … … 198 198 DO ji = 1, jpi 199 199 DO jk = 1, nk_rnf(ji,jj) 200 phdivn(ji,jj,jk) = phdivn(ji,jj,jk) - ( rnf(ji,jj) + rnf_b(ji,jj) ) * zfact * r1_r au0 / h_rnf(ji,jj)200 phdivn(ji,jj,jk) = phdivn(ji,jj,jk) - ( rnf(ji,jj) + rnf_b(ji,jj) ) * zfact * r1_rho0 / h_rnf(ji,jj) 201 201 END DO 202 202 END DO … … 211 211 ! ! apply the runoff input flow 212 212 DO jk = 1, nk_rnf(ji,jj) 213 phdivn(ji,jj,jk) = phdivn(ji,jj,jk) - ( rnf(ji,jj) + rnf_b(ji,jj) ) * zfact * r1_r au0 / h_rnf(ji,jj)213 phdivn(ji,jj,jk) = phdivn(ji,jj,jk) - ( rnf(ji,jj) + rnf_b(ji,jj) ) * zfact * r1_rho0 / h_rnf(ji,jj) 214 214 END DO 215 215 END DO … … 218 218 ELSE !== runoff put only at the surface ==! 219 219 h_rnf (:,:) = e3t_n (:,:,1) ! update h_rnf to be depth of top box 220 phdivn(:,:,1) = phdivn(:,:,1) - ( rnf(:,:) + rnf_b(:,:) ) * zfact * r1_r au0 / e3t_n(:,:,1)220 phdivn(:,:,1) = phdivn(:,:,1) - ( rnf(:,:) + rnf_b(:,:) ) * zfact * r1_rho0 / e3t_n(:,:,1) 221 221 ENDIF 222 222 ! -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/SBC/sbcssm.F90
r9598 r9939 106 106 frq_m(:,:) = zcoef * fraqsr_1lev(:,:) 107 107 ! ! ---------------------------------------- ! 108 ELSEIF( MOD( kt - 2 , nn_fsbc ) == 0 ) THEN! Initialisation: New mean computation !108 ELSEIF( MOD( kt-2, nn_fsbc ) == 0 ) THEN ! Initialisation: New mean computation ! 109 109 ! ! ---------------------------------------- ! 110 110 ssu_m(:,:) = 0._wp ! reset to zero ocean mean sbc fields … … 135 135 136 136 ! ! ---------------------------------------- ! 137 IF( MOD( kt - 1 , nn_fsbc ) == 0 ) THEN! Mean value at each nn_fsbc time-step !137 IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN ! Mean value at each nn_fsbc time-step ! 138 138 ! ! ---------------------------------------- ! 139 139 zcoef = 1. / REAL( nn_fsbc, wp ) … … 263 263 CALL iom_set_rstw_var_active('frq_m') 264 264 ENDIF 265 265 ! 266 266 END SUBROUTINE sbc_ssm_init 267 267 -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/SBC/sbctide.F90
r9598 r9939 48 48 !!---------------------------------------------------------------------- 49 49 50 IF( nsec_day == NINT(0.5_wp * r dt) .OR. kt == nit000 ) THEN ! start a new day50 IF( nsec_day == NINT(0.5_wp * rn_Dt) .OR. kt == nit000 ) THEN ! start a new day 51 51 ! 52 52 IF( kt == nit000 )THEN … … 72 72 ! Temporarily set nsec_day to beginning of day. 73 73 nsec_day_orig = nsec_day 74 IF ( nsec_day /= NINT(0.5_wp * r dt) ) THEN75 kt_tide = kt - (nsec_day - 0.5_wp * r dt)/rdt76 nsec_day = NINT(0.5_wp * r dt)74 IF ( nsec_day /= NINT(0.5_wp * rn_Dt) ) THEN 75 kt_tide = kt - (nsec_day - 0.5_wp * rn_Dt) / rn_Dt 76 nsec_day = NINT(0.5_wp * rn_Dt) 77 77 ELSE 78 78 kt_tide = kt -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/SBC/tideini.F90
r9598 r9939 20 20 PUBLIC 21 21 22 REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:) :: omega_tide !: 23 REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:) :: v0tide !: 24 REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:) :: utide !: 25 REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:) :: ftide !: 22 REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:) :: omega_tide !: 23 REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:) :: v0tide !: 24 REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:) :: utide !: 25 REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:) :: ftide !: 26 26 27 LOGICAL , PUBLIC :: ln_tide !: 28 LOGICAL , PUBLIC :: ln_tide_pot !: 29 LOGICAL , PUBLIC :: ln_read_load !: 30 LOGICAL , PUBLIC :: ln_scal_load !: 31 LOGICAL , PUBLIC :: ln_tide_ramp !: 32 INTEGER , PUBLIC :: nb_harmo !: 33 INTEGER , PUBLIC :: kt_tide !: 34 REAL(wp), PUBLIC :: rdttideramp !: 35 REAL(wp), PUBLIC :: rn_scal_load !: 36 CHARACTER(lc), PUBLIC :: cn_tide_load !: 27 ! !!* nam_tide namelist * 28 LOGICAL , PUBLIC :: ln_tide !: Use tidal components 29 LOGICAL , PUBLIC :: ln_tide_pot !: Apply astronomical potential 30 LOGICAL , PUBLIC :: ln_read_load !: Read load potential from file 31 CHARACTER(lc), PUBLIC :: cn_tide_load !: associated file name 32 LOGICAL , PUBLIC :: ln_scal_load !: Use a scalar approximation for load potential 33 REAL(wp), PUBLIC :: rn_load !: SSH fraction used in scalar approximation 34 LOGICAL , PUBLIC :: ln_tide_ramp !: Apply ramp on tides at startup 35 REAL(wp), PUBLIC :: rn_ramp !: Duration of ramp [days] 36 INTEGER , PUBLIC :: nb_harmo !: number of tidal harmonique used 37 INTEGER , PUBLIC :: kt_tide !: ??? 37 38 38 INTEGER , PUBLIC, ALLOCATABLE, DIMENSION(:) :: ntide !: 39 INTEGER , PUBLIC, ALLOCATABLE, DIMENSION(:) :: ntide !: ??? 39 40 40 41 !!---------------------------------------------------------------------- … … 52 53 CHARACTER(LEN=4), DIMENSION(jpmax_harmo) :: clname 53 54 INTEGER :: ios ! Local integer output status for namelist read 54 ! 55 !! 55 56 NAMELIST/nam_tide/ln_tide, ln_tide_pot, ln_scal_load, ln_read_load, cn_tide_load, & 56 & ln_tide_ramp, rn_ scal_load, rdttideramp, clname57 & ln_tide_ramp, rn_load, rn_ramp, clname 57 58 !!---------------------------------------------------------------------- 58 59 ! … … 76 77 WRITE(numout,*) ' Apply astronomical potential ln_tide_pot = ', ln_tide_pot 77 78 WRITE(numout,*) ' Use scalar approx. for load potential ln_scal_load = ', ln_scal_load 79 WRITE(numout,*) ' SSH fraction used in scal. approx. rn_load = ', rn_load 78 80 WRITE(numout,*) ' Read load potential from file ln_read_load = ', ln_read_load 79 81 WRITE(numout,*) ' Apply ramp on tides at startup ln_tide_ramp = ', ln_tide_ramp 80 WRITE(numout,*) ' Fraction of SSH used in scal. approx. rn_scal_load = ', rn_scal_load 81 WRITE(numout,*) ' Duration (days) of ramp rdttideramp = ', rdttideramp 82 WRITE(numout,*) ' Duration of ramp rn_ramp = ', rn_ramp, ' [days]' 82 83 ENDIF 83 84 ELSE 84 rn_ scal_load = 0._wp85 85 rn_load = 0._wp 86 ! 86 87 IF(lwp) WRITE(numout,*) 87 88 IF(lwp) WRITE(numout,*) 'tide_init : tidal components not used (ln_tide = F)' … … 92 93 CALL tide_init_Wave 93 94 ! 94 nb_harmo =095 nb_harmo = 0 95 96 DO jk = 1, jpmax_harmo 96 97 DO ji = 1,jpmax_harmo … … 108 109 IF( ln_scal_load.AND.ln_read_load ) & 109 110 & CALL ctl_stop('Choose between ln_scal_load and ln_read_load') 110 IF( ln_tide_ramp.AND.((nitend-nit000+1)*r dt/rday < rdttideramp) ) &111 & CALL ctl_stop('r dttideramp must be lower than run duration')112 IF( ln_tide_ramp.AND.(r dttideramp<0.) ) &113 & CALL ctl_stop('r dttideramp must be positive')111 IF( ln_tide_ramp.AND.((nitend-nit000+1)*rn_Dt/rday < rn_ramp) ) & 112 & CALL ctl_stop('rn_ramp must be lower than run duration') 113 IF( ln_tide_ramp.AND.(rn_ramp<0.) ) & 114 & CALL ctl_stop('rn_ramp must be positive') 114 115 ! 115 116 ALLOCATE( ntide(nb_harmo) ) … … 123 124 END DO 124 125 ! 125 ALLOCATE( omega_tide(nb_harmo), v0tide 126 & utide (nb_harmo), ftide 126 ALLOCATE( omega_tide(nb_harmo), v0tide(nb_harmo), & 127 & utide (nb_harmo), ftide (nb_harmo) ) 127 128 kt_tide = nit000 128 129 ! 129 IF (.NOT.ln_scal_load ) rn_scal_load = 0._wp130 IF (.NOT.ln_scal_load ) rn_load = 0._wp 130 131 ! 131 132 END SUBROUTINE tide_init -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/SBC/updtide.F90
r9598 r9939 6 6 !! History : 9.0 ! 07 (O. Le Galloudec) Original code 7 7 !!---------------------------------------------------------------------- 8 !! upd_tide : update tidal potential 8 9 9 !!---------------------------------------------------------------------- 10 USE oce ! ocean dynamics and tracers variables 11 USE dom_oce ! ocean space and time domain 12 USE in_out_manager ! I/O units 13 USE phycst ! physical constant 14 USE sbctide ! tide potential variable 15 USE tideini, ONLY: ln_tide_ramp, rdttideramp 10 !! upd_tide : update tidal potential 11 !!---------------------------------------------------------------------- 12 USE oce ! ocean dynamics and tracers variables 13 USE dom_oce ! ocean space and time domain 14 USE in_out_manager ! I/O units 15 USE phycst ! physical constant 16 USE sbctide ! tide potential variable 17 USE tideini , ONLY : ln_tide_ramp, rn_ramp 16 18 17 19 IMPLICIT NONE … … 37 39 !! ** Action : pot_astro actronomical potential 38 40 !!---------------------------------------------------------------------- 39 INTEGER, INTENT(in) :: kt ! ocean time-step index 40 INTEGER, INTENT(in), OPTIONAL :: kit ! external mode sub-time-step index (lk_dynspg_ts=T) 41 INTEGER, INTENT(in), OPTIONAL :: time_offset ! time offset in number 42 ! of internal steps (lk_dynspg_ts=F) 43 ! of external steps (lk_dynspg_ts=T) 41 INTEGER, INTENT(in) :: kt ! ocean time-step index 42 INTEGER, INTENT(in), OPTIONAL :: kit ! external mode sub-time-step index (lk_dynspg_ts=T) 43 INTEGER, INTENT(in), OPTIONAL :: time_offset ! time offset in number of internal steps (lk_dynspg_ts=F) 44 ! ! of external steps (lk_dynspg_ts=T) 44 45 ! 46 INTEGER :: ji, jj, jk ! dummy loop indices 45 47 INTEGER :: joffset ! local integer 46 INTEGER :: ji, jj, jk ! dummy loop indices47 48 REAL(wp) :: zt, zramp ! local scalar 48 49 REAL(wp), DIMENSION(nb_harmo) :: zwt … … 50 51 ! 51 52 ! ! tide pulsation at model time step (or sub-time-step) 52 zt = ( kt - kt_tide ) * r dt53 zt = ( kt - kt_tide ) * rn_Dt 53 54 ! 54 55 joffset = 0 … … 56 57 ! 57 58 IF( PRESENT( kit ) ) THEN 58 zt = zt + ( kit + joffset - 1 ) * r dt / REAL( nn_baro, wp )59 zt = zt + ( kit + joffset - 1 ) * rn_Dt / REAL( nn_e, wp ) 59 60 ELSE 60 zt = zt + joffset * r dt61 zt = zt + joffset * rn_Dt 61 62 ENDIF 62 63 ! … … 69 70 ! 70 71 IF( ln_tide_ramp ) THEN ! linear increase if asked 71 zt = ( kt - nit000 ) * r dt72 IF( PRESENT( kit ) ) zt = zt + ( kit + joffset -1) * r dt / REAL( nn_baro, wp )73 zramp = MIN( MAX( zt / (rdttideramp*rday) , 0._wp) , 1._wp )72 zt = ( kt - nit000 ) * rn_Dt 73 IF( PRESENT( kit ) ) zt = zt + ( kit + joffset -1) * rn_Dt / REAL( nn_e, wp ) 74 zramp = MIN( MAX( 0._wp , zt / (rn_ramp*rday) ) , 1._wp ) 74 75 pot_astro(:,:) = zramp * pot_astro(:,:) 75 76 ENDIF -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/TRA/eosbn2.F90
r9757 r9939 190 190 !! *** ROUTINE eos_insitu *** 191 191 !! 192 !! ** Purpose : Compute the in situ density (ratio rho/r au0) from192 !! ** Purpose : Compute the in situ density (ratio rho/rho0) from 193 193 !! potential temperature and salinity using an equation of state 194 194 !! selected in the nameos namelist 195 195 !! 196 !! ** Method : prd(t,s,z) = ( rho(t,s,z) - r au0 ) / rau0196 !! ** Method : prd(t,s,z) = ( rho(t,s,z) - rho0 ) / rho0 197 197 !! with prd in situ density anomaly no units 198 198 !! t TEOS10: CT or EOS80: PT Celsius … … 200 200 !! z depth meters 201 201 !! rho in situ density kg/m^3 202 !! r au0 reference density kg/m^3202 !! rho0 reference density kg/m^3 203 203 !! 204 204 !! ln_teos10 : polynomial TEOS-10 equation of state is used for rho(t,s,z). … … 209 209 !! 210 210 !! ln_seos : simplified equation of state 211 !! prd(t,s,z) = ( -a0*(1+lambda/2*(T-T0)+mu*z+nu*(S-S0))*(T-T0) + b0*(S-S0) ) / r au0211 !! prd(t,s,z) = ( -a0*(1+lambda/2*(T-T0)+mu*z+nu*(S-S0))*(T-T0) + b0*(S-S0) ) / rho0 212 212 !! linear case function of T only: rn_alpha<>0, other coefficients = 0 213 213 !! linear eos function of T and S: rn_alpha and rn_beta<>0, other coefficients=0 … … 268 268 zn = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 269 269 ! 270 prd(ji,jj,jk) = ( zn * r1_r au0 - 1._wp ) * ztm ! density anomaly (masked)270 prd(ji,jj,jk) = ( zn * r1_rho0 - 1._wp ) * ztm ! density anomaly (masked) 271 271 ! 272 272 END DO … … 288 288 & - rn_nu * zt * zs 289 289 ! 290 prd(ji,jj,jk) = zn * r1_r au0 * ztm ! density anomaly (masked)290 prd(ji,jj,jk) = zn * r1_rho0 * ztm ! density anomaly (masked) 291 291 END DO 292 292 END DO … … 306 306 !! *** ROUTINE eos_insitu_pot *** 307 307 !! 308 !! ** Purpose : Compute the in situ density (ratio rho/r au0) and the308 !! ** Purpose : Compute the in situ density (ratio rho/rho0) and the 309 309 !! potential volumic mass (Kg/m3) from potential temperature and 310 310 !! salinity fields using an equation of state selected in the … … 388 388 prhop(ji,jj,jk) = prhop(ji,jj,jk) + zn0_sto(jsmp) ! potential density referenced at the surface 389 389 ! 390 prd(ji,jj,jk) = prd(ji,jj,jk) + ( zn_sto(jsmp) * r1_r au0 - 1._wp ) ! density anomaly (masked)390 prd(ji,jj,jk) = prd(ji,jj,jk) + ( zn_sto(jsmp) * r1_rho0 - 1._wp ) ! density anomaly (masked) 391 391 END DO 392 392 prhop(ji,jj,jk) = 0.5_wp * prhop(ji,jj,jk) * ztm / nn_sto_eos … … 432 432 prhop(ji,jj,jk) = zn0 * ztm ! potential density referenced at the surface 433 433 ! 434 prd(ji,jj,jk) = ( zn * r1_r au0 - 1._wp ) * ztm ! density anomaly (masked)434 prd(ji,jj,jk) = ( zn * r1_rho0 - 1._wp ) * ztm ! density anomaly (masked) 435 435 END DO 436 436 END DO … … 451 451 & + rn_b0 * ( 1._wp - 0.5_wp*rn_lambda2*zs ) * zs & 452 452 & - rn_nu * zt * zs 453 prhop(ji,jj,jk) = ( r au0 + zn ) * ztm453 prhop(ji,jj,jk) = ( rho0 + zn ) * ztm 454 454 ! ! density anomaly (masked) 455 455 zn = zn - ( rn_a0 * rn_mu1 * zt + rn_b0 * rn_mu2 * zs ) * zh 456 prd(ji,jj,jk) = zn * r1_r au0 * ztm456 prd(ji,jj,jk) = zn * r1_rho0 * ztm 457 457 ! 458 458 END DO … … 473 473 !! *** ROUTINE eos_insitu_2d *** 474 474 !! 475 !! ** Purpose : Compute the in situ density (ratio rho/r au0) from475 !! ** Purpose : Compute the in situ density (ratio rho/rho0) from 476 476 !! potential temperature and salinity using an equation of state 477 477 !! selected in the nameos namelist. * 2D field case … … 528 528 zn = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 529 529 ! 530 prd(ji,jj) = zn * r1_r au0 - 1._wp ! unmasked in situ density anomaly530 prd(ji,jj) = zn * r1_rho0 - 1._wp ! unmasked in situ density anomaly 531 531 ! 532 532 END DO … … 548 548 & - rn_nu * zt * zs 549 549 ! 550 prd(ji,jj) = zn * r1_r au0 ! unmasked in situ density anomaly550 prd(ji,jj) = zn * r1_rho0 ! unmasked in situ density anomaly 551 551 ! 552 552 END DO … … 616 616 zn = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 617 617 ! 618 pab(ji,jj,jk,jp_tem) = zn * r1_r au0 * ztm618 pab(ji,jj,jk,jp_tem) = zn * r1_rho0 * ztm 619 619 ! 620 620 ! beta … … 637 637 zn = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 638 638 ! 639 pab(ji,jj,jk,jp_sal) = zn / zs * r1_r au0 * ztm639 pab(ji,jj,jk,jp_sal) = zn / zs * r1_rho0 * ztm 640 640 ! 641 641 END DO … … 654 654 ! 655 655 zn = rn_a0 * ( 1._wp + rn_lambda1*zt + rn_mu1*zh ) + rn_nu*zs 656 pab(ji,jj,jk,jp_tem) = zn * r1_r au0 * ztm ! alpha656 pab(ji,jj,jk,jp_tem) = zn * r1_rho0 * ztm ! alpha 657 657 ! 658 658 zn = rn_b0 * ( 1._wp - rn_lambda2*zs - rn_mu2*zh ) - rn_nu*zt 659 pab(ji,jj,jk,jp_sal) = zn * r1_r au0 * ztm ! beta659 pab(ji,jj,jk,jp_sal) = zn * r1_rho0 * ztm ! beta 660 660 ! 661 661 END DO … … 729 729 zn = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 730 730 ! 731 pab(ji,jj,jp_tem) = zn * r1_r au0731 pab(ji,jj,jp_tem) = zn * r1_rho0 732 732 ! 733 733 ! beta … … 750 750 zn = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 751 751 ! 752 pab(ji,jj,jp_sal) = zn / zs * r1_r au0752 pab(ji,jj,jp_sal) = zn / zs * r1_rho0 753 753 ! 754 754 ! … … 768 768 ! 769 769 zn = rn_a0 * ( 1._wp + rn_lambda1*zt + rn_mu1*zh ) + rn_nu*zs 770 pab(ji,jj,jp_tem) = zn * r1_r au0 ! alpha770 pab(ji,jj,jp_tem) = zn * r1_rho0 ! alpha 771 771 ! 772 772 zn = rn_b0 * ( 1._wp - rn_lambda2*zs - rn_mu2*zh ) - rn_nu*zt 773 pab(ji,jj,jp_sal) = zn * r1_r au0 ! beta773 pab(ji,jj,jp_sal) = zn * r1_rho0 ! beta 774 774 ! 775 775 END DO … … 841 841 zn = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 842 842 ! 843 pab(jp_tem) = zn * r1_r au0843 pab(jp_tem) = zn * r1_rho0 844 844 ! 845 845 ! beta … … 862 862 zn = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 863 863 ! 864 pab(jp_sal) = zn / zs * r1_r au0864 pab(jp_sal) = zn / zs * r1_rho0 865 865 ! 866 866 ! … … 873 873 ! 874 874 zn = rn_a0 * ( 1._wp + rn_lambda1*zt + rn_mu1*zh ) + rn_nu*zs 875 pab(jp_tem) = zn * r1_r au0 ! alpha875 pab(jp_tem) = zn * r1_rho0 ! alpha 876 876 ! 877 877 zn = rn_b0 * ( 1._wp - rn_lambda2*zs - rn_mu2*zh ) - rn_nu*zt 878 pab(jp_sal) = zn * r1_r au0 ! beta878 pab(jp_sal) = zn * r1_rho0 ! beta 879 879 ! 880 880 CASE DEFAULT … … 1104 1104 !! ** Method : PE is defined analytically as the vertical 1105 1105 !! primitive of EOS times -g integrated between 0 and z>0. 1106 !! pen is the nonlinear bsq-PE anomaly: pen = ( PE - r au0 gz ) / rau0 gz - rd1106 !! pen is the nonlinear bsq-PE anomaly: pen = ( PE - rho0 gz ) / rho0 gz - rd 1107 1107 !! = 1/z * /int_0^z rd dz - rd 1108 1108 !! where rd is the density anomaly (see eos_rhd function) 1109 1109 !! ab_pe are partial derivatives of PE anomaly with respect to T and S: 1110 !! ab_pe(1) = - 1/(r au0 gz) * dPE/dT + drd/dT = - d(pen)/dT1111 !! ab_pe(2) = 1/(r au0 gz) * dPE/dS + drd/dS = d(pen)/dS1110 !! ab_pe(1) = - 1/(rho0 gz) * dPE/dT + drd/dT = - d(pen)/dT 1111 !! ab_pe(2) = 1/(rho0 gz) * dPE/dS + drd/dS = d(pen)/dS 1112 1112 !! 1113 1113 !! ** Action : - pen : PE anomaly given at T-points … … 1156 1156 zn = ( zn2 * zh + zn1 ) * zh + zn0 1157 1157 ! 1158 ppen(ji,jj,jk) = zn * zh * r1_r au0 * ztm1158 ppen(ji,jj,jk) = zn * zh * r1_rho0 * ztm 1159 1159 ! 1160 1160 ! alphaPE non-linear anomaly … … 1171 1171 zn = ( zn2 * zh + zn1 ) * zh + zn0 1172 1172 ! 1173 pab_pe(ji,jj,jk,jp_tem) = zn * zh * r1_r au0 * ztm1173 pab_pe(ji,jj,jk,jp_tem) = zn * zh * r1_rho0 * ztm 1174 1174 ! 1175 1175 ! betaPE non-linear anomaly … … 1186 1186 zn = ( zn2 * zh + zn1 ) * zh + zn0 1187 1187 ! 1188 pab_pe(ji,jj,jk,jp_sal) = zn / zs * zh * r1_r au0 * ztm1188 pab_pe(ji,jj,jk,jp_sal) = zn / zs * zh * r1_rho0 * ztm 1189 1189 ! 1190 1190 END DO … … 1201 1201 zh = gdept_n(ji,jj,jk) ! depth in meters at t-point 1202 1202 ztm = tmask(ji,jj,jk) ! tmask 1203 zn = 0.5_wp * zh * r1_r au0 * ztm1203 zn = 0.5_wp * zh * r1_rho0 * ztm 1204 1204 ! ! Potential Energy 1205 1205 ppen(ji,jj,jk) = ( rn_a0 * rn_mu1 * zt + rn_b0 * rn_mu2 * zs ) * zn … … 1248 1248 IF(lwm) WRITE( numond, nameos ) 1249 1249 ! 1250 r au0 = 1026._wp !: volumic mass of reference [kg/m3]1250 rho0 = 1026._wp !: volumic mass of reference [kg/m3] 1251 1251 rcp = 3991.86795711963_wp !: heat capacity [J/K] 1252 1252 ! … … 1657 1657 WRITE(numout,*) ' ==>>> use of simplified eos: ' 1658 1658 WRITE(numout,*) ' rhd(dT=T-10,dS=S-35,Z) = [-a0*(1+lambda1/2*dT+mu1*Z)*dT ' 1659 WRITE(numout,*) ' + b0*(1+lambda2/2*dT+mu2*Z)*dS - nu*dT*dS] / r au0'1659 WRITE(numout,*) ' + b0*(1+lambda2/2*dT+mu2*Z)*dS - nu*dT*dS] / rho0' 1660 1660 WRITE(numout,*) ' with the following coefficients :' 1661 1661 WRITE(numout,*) ' thermal exp. coef. rn_a0 = ', rn_a0 … … 1676 1676 END SELECT 1677 1677 ! 1678 r au0_rcp = rau0 * rcp1679 r1_r au0 = 1._wp / rau01678 rho0_rcp = rho0 * rcp 1679 r1_rho0 = 1._wp / rho0 1680 1680 r1_rcp = 1._wp / rcp 1681 r1_r au0_rcp = 1._wp / rau0_rcp1681 r1_rho0_rcp = 1._wp / rho0_rcp 1682 1682 ! 1683 1683 IF(lwp) THEN … … 1694 1694 IF(lwp) WRITE(numout,*) 1695 1695 IF(lwp) WRITE(numout,*) ' Associated physical constant' 1696 IF(lwp) WRITE(numout,*) ' volumic mass of reference r au0 = ', rau0 , ' kg/m^3'1697 IF(lwp) WRITE(numout,*) ' 1. / r au0 r1_rau0 = ', r1_rau0, ' m^3/kg'1696 IF(lwp) WRITE(numout,*) ' volumic mass of reference rho0 = ', rho0 , ' kg/m^3' 1697 IF(lwp) WRITE(numout,*) ' 1. / rho0 r1_rho0 = ', r1_rho0, ' m^3/kg' 1698 1698 IF(lwp) WRITE(numout,*) ' ocean specific heat rcp = ', rcp , ' J/Kelvin' 1699 IF(lwp) WRITE(numout,*) ' r au0 * rcp rau0_rcp = ', rau0_rcp1700 IF(lwp) WRITE(numout,*) ' 1. / ( r au0 * rcp ) r1_rau0_rcp = ', r1_rau0_rcp1699 IF(lwp) WRITE(numout,*) ' rho0 * rcp rho0_rcp = ', rho0_rcp 1700 IF(lwp) WRITE(numout,*) ' 1. / ( rho0 * rcp ) r1_rho0_rcp = ', r1_rho0_rcp 1701 1701 ! 1702 1702 END SUBROUTINE eos_init -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/TRA/traadv.F90
r9598 r9939 87 87 INTEGER :: jk ! dummy loop index 88 88 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zun, zvn, zwn ! 3D workspace 89 REAL(wp), DIMENSION(:,:,: ), ALLOCATABLE :: ztrdt, ztrds89 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: ztrd 90 90 !!---------------------------------------------------------------------- 91 91 ! 92 92 IF( ln_timing ) CALL timing_start('tra_adv') 93 !94 ! ! set time step95 IF( neuler == 0 .AND. kt == nit000 ) THEN ; r2dt = rdt ! at nit000 (Euler)96 ELSEIF( kt <= nit000 + 1 ) THEN ; r2dt = 2._wp * rdt ! at nit000 or nit000+1 (Leapfrog)97 ENDIF98 93 ! 99 94 ! !== effective transport ==! … … 138 133 ! 139 134 IF( l_trdtra ) THEN !* Save ta and sa trends 140 ALLOCATE( ztrdt(jpi,jpj,jpk), ztrds(jpi,jpj,jpk) ) 141 ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 142 ztrds(:,:,:) = tsa(:,:,:,jp_sal) 135 ALLOCATE( ztrd(jpi,jpj,jpk,jpts) ) 136 ztrd(:,:,:,:) = tsa(:,:,:,:) 143 137 ENDIF 144 138 ! … … 146 140 ! 147 141 CASE ( np_CEN ) ! Centered scheme : 2nd / 4th order 148 CALL tra_adv_cen ( kt, nit000, 'TRA', 142 CALL tra_adv_cen ( kt, nit000, 'TRA', zun, zvn, zwn , tsn, tsa, jpts, nn_cen_h, nn_cen_v ) 149 143 CASE ( np_FCT ) ! FCT scheme : 2nd / 4th order 150 CALL tra_adv_fct ( kt, nit000, 'TRA', r 2dt, zun, zvn, zwn, tsb, tsn, tsa, jpts, nn_fct_h, nn_fct_v )144 CALL tra_adv_fct ( kt, nit000, 'TRA', rDt, zun, zvn, zwn, tsb, tsn, tsa, jpts, nn_fct_h, nn_fct_v ) 151 145 CASE ( np_MUS ) ! MUSCL 152 CALL tra_adv_mus ( kt, nit000, 'TRA', r 2dt, zun, zvn, zwn, tsb, tsa, jpts , ln_mus_ups )146 CALL tra_adv_mus ( kt, nit000, 'TRA', rDt, zun, zvn, zwn, tsb, tsa, jpts , ln_mus_ups ) 153 147 CASE ( np_UBS ) ! UBS 154 CALL tra_adv_ubs ( kt, nit000, 'TRA', r 2dt, zun, zvn, zwn, tsb, tsn, tsa, jpts , nn_ubs_v )148 CALL tra_adv_ubs ( kt, nit000, 'TRA', rDt, zun, zvn, zwn, tsb, tsn, tsa, jpts , nn_ubs_v ) 155 149 CASE ( np_QCK ) ! QUICKEST 156 CALL tra_adv_qck ( kt, nit000, 'TRA', r 2dt, zun, zvn, zwn, tsb, tsn, tsa, jpts )150 CALL tra_adv_qck ( kt, nit000, 'TRA', rDt, zun, zvn, zwn, tsb, tsn, tsa, jpts ) 157 151 ! 158 152 END SELECT … … 160 154 IF( l_trdtra ) THEN ! save the advective trends for further diagnostics 161 155 DO jk = 1, jpkm1 162 ztrdt(:,:,jk) = tsa(:,:,jk,jp_tem) - ztrdt(:,:,jk) 163 ztrds(:,:,jk) = tsa(:,:,jk,jp_sal) - ztrds(:,:,jk) 156 ztrd(:,:,jk,:) = tsa(:,:,jk,:) - ztrd(:,:,jk,:) 164 157 END DO 165 CALL trd_tra( kt, 'TRA', jp_tem, jptra_totad, ztrd t)166 CALL trd_tra( kt, 'TRA', jp_sal, jptra_totad, ztrd s)167 DEALLOCATE( ztrd t, ztrds)158 CALL trd_tra( kt, 'TRA', jp_tem, jptra_totad, ztrd(:,:,:,jp_tem) ) 159 CALL trd_tra( kt, 'TRA', jp_sal, jptra_totad, ztrd(:,:,:,jp_sal) ) 160 DEALLOCATE( ztrd ) 168 161 ENDIF 169 162 ! ! print mean trends (used for debugging) -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/TRA/traadv_fct.F90
r9598 r9939 20 20 USE diaptr ! poleward transport diagnostics 21 21 USE diaar5 ! AR5 diagnostics 22 USE phycst , ONLY : rau0_rcp23 22 ! 24 23 USE in_out_manager ! I/O manager … … 131 130 zwx(ji,jj,jk) = 0.5 * ( zfp_ui * ptb(ji,jj,jk,jn) + zfm_ui * ptb(ji+1,jj ,jk,jn) ) 132 131 zwy(ji,jj,jk) = 0.5 * ( zfp_vj * ptb(ji,jj,jk,jn) + zfm_vj * ptb(ji ,jj+1,jk,jn) ) 132 !!gm faster coding ? ===>>> to be tested : 133 ! zwx(ji,jj,jk) = MAX( pun(ji,jj,jk) , 0._wp ) * ptb(ji ,jj,jk,jn) & 134 ! & + MIN( pun(ji,jj,jk) , 0._wp ) * ptb(ji+1,jj,jk,jn) 135 ! zwy(ji,jj,jk) = MAX( pvn(ji,jj,jk) , 0._wp ) * ptb(ji,jj ,jk,jn) & 136 ! & + MIN( pvn(ji,jj,jk) , 0._wp ) * ptb(ji,jj+1,jk,jn) 137 !!gm 138 133 139 END DO 134 140 END DO … … 141 147 zfm_wk = pwn(ji,jj,jk) - ABS( pwn(ji,jj,jk) ) 142 148 zwz(ji,jj,jk) = 0.5 * ( zfp_wk * ptb(ji,jj,jk,jn) + zfm_wk * ptb(ji,jj,jk-1,jn) ) * wmask(ji,jj,jk) 149 !!gm faster coding ? ===>>> to be tested : 150 ! zwx(ji,jj,jk) = MAX( pwn(ji,jj,jk) , 0._wp ) * pwn(ji,jj,jk ,jn) & 151 ! & + MIN( pwn(ji,jj,jk) , 0._wp ) * pwn(ji,jj,jk-1,jn) 152 !!gm 143 153 END DO 144 154 END DO -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/TRA/trabbc.F90
r9598 r9939 64 64 !! ocean bottom can be computed once and is added to the temperature 65 65 !! trend juste above the bottom at each time step: 66 !! ta = ta + Qsf / (r au0 rcp e3T) for k= mbkt66 !! ta = ta + Qsf / (rho0 rcp e3T) for k= mbkt 67 67 !! Where Qsf is the geothermal heat flux. 68 68 !! … … 76 76 ! 77 77 INTEGER :: ji, jj ! dummy loop indices 78 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ztrd t! 3D workspace78 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ztrd ! 3D workspace 79 79 !!---------------------------------------------------------------------- 80 80 ! … … 82 82 ! 83 83 IF( l_trdtra ) THEN ! Save the input temperature trend 84 ALLOCATE( ztrd t(jpi,jpj,jpk) )85 ztrd t(:,:,:) = tsa(:,:,:,jp_tem)84 ALLOCATE( ztrd(jpi,jpj,jpk) ) 85 ztrd(:,:,:) = tsa(:,:,:,jp_tem) 86 86 ENDIF 87 87 ! ! Add the geothermal trend on temperature … … 95 95 ! 96 96 IF( l_trdtra ) THEN ! Send the trend for diagnostics 97 ztrd t(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:)98 CALL trd_tra( kt, 'TRA', jp_tem, jptra_bbc, ztrd t)99 DEALLOCATE( ztrd t)97 ztrd(:,:,:) = tsa(:,:,:,jp_tem) - ztrd(:,:,:) 98 CALL trd_tra( kt, 'TRA', jp_tem, jptra_bbc, ztrd ) 99 DEALLOCATE( ztrd ) 100 100 ENDIF 101 101 ! … … 157 157 ALLOCATE( qgh_trd0(jpi,jpj) ) ! allocation 158 158 ! 159 SELECT CASE ( nn_geoflx ) ! geothermal heat flux / (r auO * Cp)159 SELECT CASE ( nn_geoflx ) ! geothermal heat flux / (rhoO * Cp) 160 160 ! 161 161 CASE ( 1 ) !* constant flux 162 162 IF(lwp) WRITE(numout,*) ' ==>>> constant heat flux = ', rn_geoflx_cst 163 qgh_trd0(:,:) = r1_r au0_rcp * rn_geoflx_cst163 qgh_trd0(:,:) = r1_rho0_rcp * rn_geoflx_cst 164 164 ! 165 165 CASE ( 2 ) !* variable geothermal heat flux : read the geothermal fluxes in mW/m2 … … 178 178 179 179 CALL fld_read( nit000, 1, sf_qgh ) ! Read qgh data 180 qgh_trd0(:,:) = r1_r au0_rcp * sf_qgh(1)%fnow(:,:,1) * 1.e-3 ! conversion in W/m2180 qgh_trd0(:,:) = r1_rho0_rcp * sf_qgh(1)%fnow(:,:,1) * 1.e-3 ! conversion in W/m2 181 181 ! 182 182 CASE DEFAULT -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/TRA/trabbl.F90
r9598 r9939 103 103 INTEGER, INTENT( in ) :: kt ! ocean time-step 104 104 ! 105 REAL(wp), ALLOCATABLE, DIMENSION(:,:,: ) :: ztrdt, ztrds105 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: ztrd 106 106 !!---------------------------------------------------------------------- 107 107 ! … … 109 109 ! 110 110 IF( l_trdtra ) THEN !* Save the T-S input trends 111 ALLOCATE( ztrdt(jpi,jpj,jpk) , ztrds(jpi,jpj,jpk) ) 112 ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 113 ztrds(:,:,:) = tsa(:,:,:,jp_sal) 111 ALLOCATE( ztrd(jpi,jpj,jpk,jpts) ) 112 ztrd(:,:,:,:) = tsa(:,:,:,:) 114 113 ENDIF 115 114 … … 143 142 144 143 IF( l_trdtra ) THEN ! send the trends for further diagnostics 145 ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:) 146 ztrds(:,:,:) = tsa(:,:,:,jp_sal) - ztrds(:,:,:) 147 CALL trd_tra( kt, 'TRA', jp_tem, jptra_bbl, ztrdt ) 148 CALL trd_tra( kt, 'TRA', jp_sal, jptra_bbl, ztrds ) 149 DEALLOCATE( ztrdt, ztrds ) 144 ztrd(:,:,:,:) = tsa(:,:,:,:) - ztrd(:,:,:,:) 145 CALL trd_tra( kt, 'TRA', jp_tem, jptra_bbl, ztrd(:,:,:,jp_tem) ) 146 CALL trd_tra( kt, 'TRA', jp_sal, jptra_bbl, ztrd(:,:,:,jp_sal) ) 147 DEALLOCATE( ztrd ) 150 148 ENDIF 151 149 ! -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/TRA/tradmp.F90
r9598 r9939 94 94 INTEGER :: ji, jj, jk, jn ! dummy loop indices 95 95 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts) :: zts_dta 96 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: ztrd ts96 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: ztrd 97 97 !!---------------------------------------------------------------------- 98 98 ! … … 100 100 ! 101 101 IF( l_trdtra ) THEN !* Save ta and sa trends 102 ALLOCATE( ztrd ts(jpi,jpj,jpk,jpts) )103 ztrd ts(:,:,:,:) = tsa(:,:,:,:)102 ALLOCATE( ztrd(jpi,jpj,jpk,jpts) ) 103 ztrd(:,:,:,:) = tsa(:,:,:,:) 104 104 ENDIF 105 105 ! !== input T-S data at kt ==! … … 150 150 ! 151 151 IF( l_trdtra ) THEN ! trend diagnostic 152 ztrd ts(:,:,:,:) = tsa(:,:,:,:) - ztrdts(:,:,:,:)153 CALL trd_tra( kt, 'TRA', jp_tem, jptra_dmp, ztrd ts(:,:,:,jp_tem) )154 CALL trd_tra( kt, 'TRA', jp_sal, jptra_dmp, ztrd ts(:,:,:,jp_sal) )155 DEALLOCATE( ztrd ts)152 ztrd(:,:,:,:) = tsa(:,:,:,:) - ztrd(:,:,:,:) 153 CALL trd_tra( kt, 'TRA', jp_tem, jptra_dmp, ztrd(:,:,:,jp_tem) ) 154 CALL trd_tra( kt, 'TRA', jp_sal, jptra_dmp, ztrd(:,:,:,jp_sal) ) 155 DEALLOCATE( ztrd ) 156 156 ENDIF 157 157 ! ! Control print -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/TRA/traldf.F90
r9598 r9939 55 55 INTEGER, INTENT( in ) :: kt ! ocean time-step index 56 56 !! 57 REAL(wp), ALLOCATABLE, DIMENSION(:,:,: ) :: ztrdt, ztrds57 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: ztrd ! 4D workspace 58 58 !!---------------------------------------------------------------------- 59 59 ! … … 61 61 ! 62 62 IF( l_trdtra ) THEN !* Save ta and sa trends 63 ALLOCATE( ztrdt(jpi,jpj,jpk) , ztrds(jpi,jpj,jpk) ) 64 ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 65 ztrds(:,:,:) = tsa(:,:,:,jp_sal) 63 ALLOCATE( ztrd(jpi,jpj,jpk,jpts) ) 64 ztrd(:,:,:,:) = tsa(:,:,:,:) 66 65 ENDIF 67 66 ! … … 78 77 ! 79 78 IF( l_trdtra ) THEN !* save the horizontal diffusive trends for further diagnostics 80 ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:) 81 ztrds(:,:,:) = tsa(:,:,:,jp_sal) - ztrds(:,:,:) 82 CALL trd_tra( kt, 'TRA', jp_tem, jptra_ldf, ztrdt ) 83 CALL trd_tra( kt, 'TRA', jp_sal, jptra_ldf, ztrds ) 84 DEALLOCATE( ztrdt, ztrds ) 79 ztrd(:,:,:,:) = tsa(:,:,:,:) - ztrd(:,:,:,:) 80 CALL trd_tra( kt, 'TRA', jp_tem, jptra_ldf, ztrd(:,:,:,jp_tem) ) 81 CALL trd_tra( kt, 'TRA', jp_sal, jptra_ldf, ztrd(:,:,:,jp_sal) ) 82 DEALLOCATE( ztrd ) 85 83 ENDIF 86 84 ! !* print mean trends (used for debugging) -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/TRA/traldf_iso.F90
r9779 r9939 108 108 REAL(wp) :: zmsku, zahu_w, zabe1, zcof1, zcoef3 ! local scalars 109 109 REAL(wp) :: zmskv, zahv_w, zabe2, zcof2, zcoef4 ! - - 110 REAL(wp) :: zcoef0, ze3w_2, zsign , z2dt, z1_2dt! - -110 REAL(wp) :: zcoef0, ze3w_2, zsign ! - - 111 111 REAL(wp), DIMENSION(jpi,jpj) :: zdkt, zdk1t, z2d 112 112 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zdit, zdjt, zftu, zftv, ztfw … … 127 127 IF( cdtype == 'TRA' .AND. ( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR. & 128 128 & iom_use("uadv_salttr") .OR. iom_use("vadv_salttr") ) ) l_hst = .TRUE. 129 !130 ! ! set time step size (Euler/Leapfrog)131 IF( neuler == 0 .AND. kt == nit000 ) THEN ; z2dt = rdt ! at nit000 (Euler)132 ELSE ; z2dt = 2.* rdt ! (Leapfrog)133 ENDIF134 z1_2dt = 1._wp / z2dt135 129 ! 136 130 IF( kpass == 1 ) THEN ; zsign = 1._wp ! bilaplacian operator require a minus sign (eddy diffusivity >0) … … 191 185 DO ji = 1, fs_jpim1 192 186 ze3w_2 = e3w_n(ji,jj,jk) * e3w_n(ji,jj,jk) 193 zcoef0 = z2dt * ( akz(ji,jj,jk) + ah_wslp2(ji,jj,jk) / ze3w_2 )194 akz(ji,jj,jk) = MAX( zcoef0 - 0.5_wp , 0._wp ) * ze3w_2 * z1_2dt187 zcoef0 = rDt * ( akz(ji,jj,jk) + ah_wslp2(ji,jj,jk) / ze3w_2 ) 188 akz(ji,jj,jk) = MAX( zcoef0 - 0.5_wp , 0._wp ) * ze3w_2 * r1_Dt 195 189 END DO 196 190 END DO -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/TRA/traldf_triad.F90
r9598 r9939 85 85 INTEGER :: ip,jp,kp ! dummy loop indices 86 86 INTEGER :: ierr ! local integer 87 REAL(wp) :: zmsku, zabe1, zcof1, zcoef3 88 REAL(wp) :: zmskv, zabe2, zcof2, zcoef4 89 REAL(wp) :: zcoef0, ze3w_2, zsign , z2dt, z1_2dt! - -87 REAL(wp) :: zmsku, zabe1, zcof1, zcoef3 ! local scalars 88 REAL(wp) :: zmskv, zabe2, zcof2, zcoef4 ! - - 89 REAL(wp) :: zcoef0, ze3w_2, zsign ! - - 90 90 ! 91 91 REAL(wp) :: zslope_skew, zslope_iso, zslope2, zbu, zbv … … 110 110 l_hst = .FALSE. 111 111 l_ptr = .FALSE. 112 IF( cdtype == 'TRA' .AND. ln_diaptr ) l_ptr = .TRUE. 113 IF( cdtype == 'TRA' .AND. ( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR. & 114 & iom_use("uadv_salttr") .OR. iom_use("vadv_salttr") ) ) l_hst = .TRUE. 115 ! 116 ! ! set time step size (Euler/Leapfrog) 117 IF( neuler == 0 .AND. kt == kit000 ) THEN ; z2dt = rdt ! at nit000 (Euler) 118 ELSE ; z2dt = 2.* rdt ! (Leapfrog) 112 IF( cdtype == 'TRA' ) THEN 113 IF ( ln_diaptr ) l_ptr = .TRUE. 114 IF ( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR. & 115 & iom_use("uadv_salttr") .OR. iom_use("vadv_salttr") ) l_hst = .TRUE. 119 116 ENDIF 120 z1_2dt = 1._wp / z2dt121 117 ! 122 118 IF( kpass == 1 ) THEN ; zsign = 1._wp ! bilaplacian operator require a minus sign (eddy diffusivity >0) … … 202 198 DO ji = 1, fs_jpim1 203 199 ze3w_2 = e3w_n(ji,jj,jk) * e3w_n(ji,jj,jk) 204 zcoef0 = z2dt * ( akz(ji,jj,jk) + ah_wslp2(ji,jj,jk) / ze3w_2 )205 akz(ji,jj,jk) = MAX( zcoef0 - 0.5_wp , 0._wp ) * ze3w_2 * z1_2dt200 zcoef0 = rDt * ( akz(ji,jj,jk) + ah_wslp2(ji,jj,jk) / ze3w_2 ) 201 akz(ji,jj,jk) = MAX( zcoef0 - 0.5_wp , 0._wp ) * ze3w_2 * r1_Dt 206 202 END DO 207 203 END DO -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/TRA/tramle.F90
r9598 r9939 41 41 42 42 REAL(wp) :: r5_21 = 5.e0 / 21.e0 ! factor used in mle streamfunction computation 43 REAL(wp) :: rb_c ! ML buoyancy criteria = g rho_c /r au0 where rho_c is defined in zdfmld43 REAL(wp) :: rb_c ! ML buoyancy criteria = g rho_c /rho0 where rho_c is defined in zdfmld 44 44 REAL(wp) :: rc_f ! MLE coefficient (= rn_ce / (5 km * fo) ) in nn_mle=1 case 45 45 … … 115 115 zc = e3t_n(ji,jj,jk) * REAL( MIN( MAX( 0, inml_mle(ji,jj)-jk ) , 1 ) ) ! zc being 0 outside the ML t-points 116 116 zmld(ji,jj) = zmld(ji,jj) + zc 117 zbm (ji,jj) = zbm (ji,jj) + zc * (r au0 - rhop(ji,jj,jk) ) * r1_rau0117 zbm (ji,jj) = zbm (ji,jj) + zc * (rho0 - rhop(ji,jj,jk) ) * r1_rho0 118 118 zn2 (ji,jj) = zn2 (ji,jj) + zc * (rn2(ji,jj,jk)+rn2(ji,jj,jk+1))*0.5_wp 119 119 END DO … … 302 302 IF( ln_mle ) THEN ! MLE initialisation 303 303 ! 304 rb_c = grav * rn_rho_c_mle / rau0! Mixed Layer buoyancy criteria304 rb_c = grav * rn_rho_c_mle / rho0 ! Mixed Layer buoyancy criteria 305 305 IF(lwp) WRITE(numout,*) 306 306 IF(lwp) WRITE(numout,*) ' ML buoyancy criteria = ', rb_c, ' m/s2 ' -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/TRA/tranpc.F90
r9598 r9939 65 65 LOGICAL :: l_bottom_reached, l_column_treated 66 66 REAL(wp) :: zta, zalfa, zsum_temp, zsum_alfa, zaw, zdz, zsum_z 67 REAL(wp) :: zsa, zbeta, zsum_sali, zsum_beta, zbw, zrw , z1_r2dt67 REAL(wp) :: zsa, zbeta, zsum_sali, zsum_beta, zbw, zrw 68 68 REAL(wp), PARAMETER :: zn2_zero = 1.e-14_wp ! acceptance criteria for neutrality (N2==0) 69 69 REAL(wp), DIMENSION( jpk ) :: zvn2 ! vertical profile of N2 at 1 given point... … … 71 71 REAL(wp), DIMENSION(jpi,jpj,jpk ) :: zn2 ! N^2 72 72 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts) :: zab ! alpha and beta 73 REAL(wp), ALLOCATABLE, DIMENSION(:,:,: ) :: ztrdt, ztrds ! 3D workspace73 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: ztrd ! 4D workspace 74 74 ! 75 75 LOGICAL, PARAMETER :: l_LB_debug = .FALSE. ! set to true if you want to follow what is … … 82 82 IF( MOD( kt, nn_npc ) == 0 ) THEN 83 83 ! 84 IF( l_trdtra ) THEN !* Save initial after fields 85 ALLOCATE( ztrdt(jpi,jpj,jpk) , ztrds(jpi,jpj,jpk) ) 86 ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 87 ztrds(:,:,:) = tsa(:,:,:,jp_sal) 84 IF( l_trdtra ) THEN !* Save input after fields 85 ALLOCATE( ztrd(jpi,jpj,jpk,jpts) ) 86 ztrd(:,:,:,:) = tsa(:,:,:,:) 88 87 ENDIF 89 88 ! … … 301 300 ! 302 301 IF( l_trdtra ) THEN ! send the Non penetrative mixing trends for diagnostic 303 z1_r2dt = 1._wp / (2._wp * rdt) 304 ztrdt(:,:,:) = ( tsa(:,:,:,jp_tem) - ztrdt(:,:,:) ) * z1_r2dt 305 ztrds(:,:,:) = ( tsa(:,:,:,jp_sal) - ztrds(:,:,:) ) * z1_r2dt 306 CALL trd_tra( kt, 'TRA', jp_tem, jptra_npc, ztrdt ) 307 CALL trd_tra( kt, 'TRA', jp_sal, jptra_npc, ztrds ) 308 DEALLOCATE( ztrdt, ztrds ) 302 ztrd(:,:,:,:) = ( tsa(:,:,:,:) - ztrd(:,:,:,:) ) * r1_Dt 303 CALL trd_tra( kt, 'TRA', jp_tem, jptra_npc, ztrd(:,:,:,jp_tem) ) 304 CALL trd_tra( kt, 'TRA', jp_sal, jptra_npc, ztrd(:,:,:,jp_sal) ) 305 DEALLOCATE( ztrd ) 309 306 ENDIF 310 307 ! -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/TRA/tranxt.F90
r9598 r9939 90 90 INTEGER :: ji, jj, jk, jn ! dummy loop indices 91 91 REAL(wp) :: zfact ! local scalars 92 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ztrdt, ztrds92 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: ztrd ! 4D workspace 93 93 !!---------------------------------------------------------------------- 94 94 ! … … 111 111 IF( ln_bdy ) CALL bdy_tra( kt ) ! BDY open boundaries 112 112 113 ! set time step size (Euler/Leapfrog) 114 IF( neuler == 0 .AND. kt == nit000 ) THEN ; r2dt = rdt ! at nit000 (Euler) 115 ELSEIF( kt <= nit000 + 1 ) THEN ; r2dt = 2._wp* rdt ! at nit000 or nit000+1 (Leapfrog) 116 ENDIF 117 118 ! trends computation initialisation 119 IF( l_trdtra ) THEN 120 ALLOCATE( ztrdt(jpi,jpj,jpk) , ztrds(jpi,jpj,jpk) ) 121 ztrdt(:,:,jpk) = 0._wp 122 ztrds(:,:,jpk) = 0._wp 113 IF( l_trdtra ) THEN ! trends computation initialisation 114 ALLOCATE( ztrd(jpi,jpj,jpk,jpts) ) 115 ztrd(:,:,jpk,:) = 0._wp 123 116 IF( ln_traldf_iso ) THEN ! diagnose the "pure" Kz diffusive trend 124 CALL trd_tra( kt, 'TRA', jp_tem, jptra_zdfp, ztrd t)125 CALL trd_tra( kt, 'TRA', jp_sal, jptra_zdfp, ztrd s)117 CALL trd_tra( kt, 'TRA', jp_tem, jptra_zdfp, ztrd(:,:,:,jp_tem) ) 118 CALL trd_tra( kt, 'TRA', jp_sal, jptra_zdfp, ztrd(:,:,:,jp_sal) ) 126 119 ENDIF 127 120 ! total trend for the non-time-filtered variables. 128 zfact = 1.0 / r dt121 zfact = 1.0 / rn_Dt 129 122 ! G Nurser 23 Mar 2017. Recalculate trend as Delta(e3t*T)/e3tn; e3tn cancel from tsn terms 130 DO jk = 1, jpkm1 131 ztrdt(:,:,jk) = ( tsa(:,:,jk,jp_tem)*e3t_a(:,:,jk) / e3t_n(:,:,jk) - tsn(:,:,jk,jp_tem)) * zfact 132 ztrds(:,:,jk) = ( tsa(:,:,jk,jp_sal)*e3t_a(:,:,jk) / e3t_n(:,:,jk) - tsn(:,:,jk,jp_sal)) * zfact 133 END DO 134 CALL trd_tra( kt, 'TRA', jp_tem, jptra_tot, ztrdt ) 135 CALL trd_tra( kt, 'TRA', jp_sal, jptra_tot, ztrds ) 136 IF( ln_linssh ) THEN ! linear sea surface height only 137 ! Store now fields before applying the Asselin filter 138 ! in order to calculate Asselin filter trend later. 139 ztrdt(:,:,:) = tsn(:,:,:,jp_tem) 140 ztrds(:,:,:) = tsn(:,:,:,jp_sal) 141 ENDIF 142 ENDIF 143 144 IF( neuler == 0 .AND. kt == nit000 ) THEN ! Euler time-stepping at first time-step (only swap) 123 DO jn = 1, jpts 124 DO jk = 1, jpkm1 125 ztrd(:,:,jk,jn) = ( tsa(:,:,jk,jn)*e3t_a(:,:,jk) / e3t_n(:,:,jk) - tsn(:,:,jk,jn)) * zfact 126 END DO 127 END DO 128 CALL trd_tra( kt, 'TRA', jp_tem, jptra_tot, ztrd(:,:,:,jp_tem) ) 129 CALL trd_tra( kt, 'TRA', jp_sal, jptra_tot, ztrd(:,:,:,jp_sal) ) 130 IF( ln_linssh ) THEN ! linear sea surface height only Store now fields before applying 131 ! ! the Asselin filter in order to calculate Asselin filter trend later. 132 ztrd(:,:,:,:) = tsn(:,:,:,:) 133 ENDIF 134 ENDIF 135 136 IF( l_1st_euler ) THEN ! Euler time-stepping at first time-step (only swap) 145 137 DO jn = 1, jpts 146 138 DO jk = 1, jpkm1 … … 150 142 IF (l_trdtra .AND. .NOT. ln_linssh ) THEN ! Zero Asselin filter contribution must be explicitly written out since for vvl 151 143 ! ! Asselin filter is output by tra_nxt_vvl that is not called on this time step 152 ztrdt(:,:,:) = 0._wp 153 ztrds(:,:,:) = 0._wp 154 CALL trd_tra( kt, 'TRA', jp_tem, jptra_atf, ztrdt ) 155 CALL trd_tra( kt, 'TRA', jp_sal, jptra_atf, ztrds ) 144 ztrd(:,:,:,:) = 0._wp 145 CALL trd_tra( kt, 'TRA', jp_tem, jptra_atf, ztrd(:,:,:,jp_tem) ) 146 CALL trd_tra( kt, 'TRA', jp_sal, jptra_atf, ztrd(:,:,:,jp_sal) ) 156 147 END IF 157 148 ! 158 ELSE ! Leap-Frog + Asselin filter time stepping 159 ! 160 IF( ln_linssh ) THEN ; CALL tra_nxt_fix( kt, nit000, 'TRA', tsb, tsn, tsa, jpts ) ! linear free surface 161 ELSE ; CALL tra_nxt_vvl( kt, nit000, rdt, 'TRA', tsb, tsn, tsa, & 162 & sbc_tsc, sbc_tsc_b, jpts ) ! non-linear free surface 163 ENDIF 164 ! 165 CALL lbc_lnk_multi( tsb(:,:,:,jp_tem), 'T', 1., tsb(:,:,:,jp_sal), 'T', 1., & 166 & tsn(:,:,:,jp_tem), 'T', 1., tsn(:,:,:,jp_sal), 'T', 1., & 167 & tsa(:,:,:,jp_tem), 'T', 1., tsa(:,:,:,jp_sal), 'T', 1. ) 149 ELSE ! Leap-Frog + Asselin filter time stepping 150 ! 151 IF( ln_linssh ) THEN ; CALL tra_nxt_fix( kt, nit000, 'TRA', tsb, tsn, tsa, jpts ) ! linear free surface 152 ELSE ; CALL tra_nxt_vvl( kt, nit000, rn_Dt,'TRA', tsb, tsn, tsa, & 153 & sbc_tsc, sbc_tsc_b, jpts ) ! non-linear free surface 154 ENDIF 155 ! 156 CALL lbc_lnk_multi( tsb, 'T', 1., tsn, 'T', 1., tsa, 'T', 1. ) 168 157 ! 169 158 ENDIF 170 159 ! 171 160 IF( l_trdtra .AND. ln_linssh ) THEN ! trend of the Asselin filter (tb filtered - tb)/dt 172 zfact = 1._wp / r2dt173 161 DO jk = 1, jpkm1 174 ztrdt(:,:,jk) = ( tsb(:,:,jk,jp_tem) - ztrdt(:,:,jk) ) * zfact 175 ztrds(:,:,jk) = ( tsb(:,:,jk,jp_sal) - ztrds(:,:,jk) ) * zfact 176 END DO 177 CALL trd_tra( kt, 'TRA', jp_tem, jptra_atf, ztrdt ) 178 CALL trd_tra( kt, 'TRA', jp_sal, jptra_atf, ztrds ) 162 ztrd(:,:,jk,:) = ( tsb(:,:,jk,:) - ztrd(:,:,jk,:) ) * r1_Dt 163 END DO 164 CALL trd_tra( kt, 'TRA', jp_tem, jptra_atf, ztrd(:,:,:,jp_tem) ) 165 CALL trd_tra( kt, 'TRA', jp_sal, jptra_atf, ztrd(:,:,:,jp_sal) ) 179 166 END IF 180 IF( l_trdtra ) DEALLOCATE( ztrd t , ztrds)167 IF( l_trdtra ) DEALLOCATE( ztrd ) 181 168 ! 182 169 ! ! control print … … 227 214 ztd = pta(ji,jj,jk,jn) - 2._wp * ztn + ptb(ji,jj,jk,jn) ! time laplacian on tracers 228 215 ! 229 ptb(ji,jj,jk,jn) = ztn + atfp * ztd! ptb <-- filtered ptn216 ptb(ji,jj,jk,jn) = ztn + rn_atfp * ztd ! ptb <-- filtered ptn 230 217 ptn(ji,jj,jk,jn) = pta(ji,jj,jk,jn) ! ptn <-- pta 231 218 END DO … … 238 225 239 226 240 SUBROUTINE tra_nxt_vvl( kt, kit000, p 2dt, cdtype, ptb, ptn, pta, psbc_tc, psbc_tc_b, kjpt )227 SUBROUTINE tra_nxt_vvl( kt, kit000, pdt, cdtype, ptb, ptn, pta, psbc_tc, psbc_tc_b, kjpt ) 241 228 !!---------------------------------------------------------------------- 242 229 !! *** ROUTINE tra_nxt_vvl *** … … 247 234 !! ** Method : - Apply a thickness weighted Asselin time filter on now fields. 248 235 !! - swap tracer fields to prepare the next time_step. 249 !! tb = ( e3t_n*tn + atfp*[ e3t_b*tb - 2 e3t_n*tn + e3t_a*ta ] )250 !! /( e3t_n + atfp*[ e3t_b - 2 e3t_n + e3t_a ] )236 !! tb = ( e3t_n*tn + rn_atfp*[ e3t_b*tb - 2 e3t_n*tn + e3t_a*ta ] ) 237 !! /( e3t_n + rn_atfp*[ e3t_b - 2 e3t_n + e3t_a ] ) 251 238 !! tn = ta 252 239 !! … … 255 242 INTEGER , INTENT(in ) :: kt ! ocean time-step index 256 243 INTEGER , INTENT(in ) :: kit000 ! first time step index 257 REAL(wp) , INTENT(in ) :: p 2dt! time-step244 REAL(wp) , INTENT(in ) :: pdt ! time-step 258 245 CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 259 246 INTEGER , INTENT(in ) :: kjpt ! number of tracers … … 289 276 IF( ( l_trdtra .AND. cdtype == 'TRA' ) .OR. ( l_trdtrc .AND. cdtype == 'TRC' ) ) THEN 290 277 ALLOCATE( ztrd_atf(jpi,jpj,jpk,kjpt) ) 291 ztrd_atf(:,:,:,:) = 0.0_wp 292 ENDIF 293 zfact = 1._wp / r2dt 294 zfact1 = atfp * p2dt 295 zfact2 = zfact1 * r1_rau0 296 DO jn = 1, kjpt 278 ztrd_atf(:,:,:,:) = 0._wp 279 ENDIF 280 ! 281 zfact = r1_Dt 282 zfact1 = rn_atfp * pdt 283 zfact2 = zfact1 * r1_rho0 284 DO jn = 1, kjpt 297 285 DO jk = 1, jpkm1 298 286 DO jj = 2, jpjm1 … … 309 297 ztc_d = ztc_a - 2. * ztc_n + ztc_b 310 298 ! 311 ze3t_f = ze3t_n + atfp * ze3t_d312 ztc_f = ztc_n + atfp * ztc_d299 ze3t_f = ze3t_n + rn_atfp * ze3t_d 300 ztc_f = ztc_n + rn_atfp * ztc_d 313 301 ! 314 302 IF( jk == mikt(ji,jj) ) THEN ! first level -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/TRA/traqsr.F90
r9598 r9939 87 87 !! I(k) = Qsr*( rn_abs*EXP(z(k)/rn_si0) + (1.-rn_abs)*EXP(z(k)/rn_si1) ) 88 88 !! The temperature trend associated with the solar radiation penetration 89 !! is given by : zta = 1/e3t dk[ I ] / (r au0*Cp)89 !! is given by : zta = 1/e3t dk[ I ] / (rho0*Cp) 90 90 !! At the bottom, boudary condition for the radiation is no flux : 91 91 !! all heat which has not been absorbed in the above levels is put … … 112 112 REAL(wp) :: zlogc, zlogc2, zlogc3 113 113 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zekb, zekg, zekr 114 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ze0, ze1, ze2, ze3, zea, ztrd t114 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ze0, ze1, ze2, ze3, zea, ztrd 115 115 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zetot, zchl3d 116 116 !!---------------------------------------------------------------------- … … 125 125 ! 126 126 IF( l_trdtra ) THEN ! trends diagnostic: save the input temperature trend 127 ALLOCATE( ztrd t(jpi,jpj,jpk) )128 ztrd t(:,:,:) = tsa(:,:,:,jp_tem)127 ALLOCATE( ztrd(jpi,jpj,jpk) ) 128 ztrd(:,:,:) = tsa(:,:,:,jp_tem) 129 129 ENDIF 130 130 ! … … 133 133 ! !-----------------------------------! 134 134 IF( kt == nit000 ) THEN !== 1st time step ==! 135 !!gm case neuler not taken into account.... 136 IF( ln_rstart .AND. iom_varid( numror, 'qsr_hc_b', ldstop = .FALSE. ) > 0 ) THEN ! read in restart 135 IF( ln_rstart .AND. iom_varid( numror, 'qsr_hc_b', ldstop = .FALSE. ) > 0 .AND. .NOT.l_1st_euler ) THEN ! read in restart 137 136 IF(lwp) WRITE(numout,*) ' nit000-1 qsr tracer content forcing field read in the restart file' 138 137 z1_2 = 0.5_wp … … 154 153 ! 155 154 DO jk = 1, nksr 156 qsr_hc(:,:,jk) = r1_r au0_rcp * ( etot3(:,:,jk) - etot3(:,:,jk+1) )155 qsr_hc(:,:,jk) = r1_rho0_rcp * ( etot3(:,:,jk) - etot3(:,:,jk+1) ) 157 156 END DO 158 157 ! … … 234 233 DO jj = 2, jpjm1 235 234 DO ji = fs_2, fs_jpim1 236 qsr_hc(ji,jj,jk) = r1_r au0_rcp * ( zea(ji,jj,jk) - zea(ji,jj,jk+1) )235 qsr_hc(ji,jj,jk) = r1_rho0_rcp * ( zea(ji,jj,jk) - zea(ji,jj,jk+1) ) 237 236 END DO 238 237 END DO … … 243 242 CASE( np_2BD ) !== 2-bands fluxes ==! 244 243 ! 245 zz0 = rn_abs * r1_r au0_rcp ! surface equi-partition in 2-bands246 zz1 = ( 1. - rn_abs ) * r1_r au0_rcp244 zz0 = rn_abs * r1_rho0_rcp ! surface equi-partition in 2-bands 245 zz1 = ( 1. - rn_abs ) * r1_rho0_rcp 247 246 DO jk = 1, nksr ! solar heat absorbed at T-point in the top 400m 248 247 DO jj = 2, jpjm1 … … 270 269 DO jj = 2, jpjm1 271 270 DO ji = fs_2, fs_jpim1 ! vector opt. 272 IF( qsr(ji,jj) /= 0._wp ) THEN ; fraqsr_1lev(ji,jj) = qsr_hc(ji,jj,1) / ( r1_r au0_rcp * qsr(ji,jj) )271 IF( qsr(ji,jj) /= 0._wp ) THEN ; fraqsr_1lev(ji,jj) = qsr_hc(ji,jj,1) / ( r1_rho0_rcp * qsr(ji,jj) ) 273 272 ELSE ; fraqsr_1lev(ji,jj) = 1._wp 274 273 ENDIF … … 281 280 zetot(:,:,nksr+1:jpk) = 0._wp ! below ~400m set to zero 282 281 DO jk = nksr, 1, -1 283 zetot(:,:,jk) = zetot(:,:,jk+1) + qsr_hc(:,:,jk) * r au0_rcp282 zetot(:,:,jk) = zetot(:,:,jk+1) + qsr_hc(:,:,jk) * rho0_rcp 284 283 END DO 285 284 CALL iom_put( 'qsr3d', zetot ) ! 3D distribution of shortwave Radiation … … 295 294 ! 296 295 IF( l_trdtra ) THEN ! qsr tracers trends saved for diagnostics 297 ztrd t(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:)298 CALL trd_tra( kt, 'TRA', jp_tem, jptra_qsr, ztrd t)299 DEALLOCATE( ztrd t)296 ztrd(:,:,:) = tsa(:,:,:,jp_tem) - ztrd(:,:,:) 297 CALL trd_tra( kt, 'TRA', jp_tem, jptra_qsr, ztrd ) 298 DEALLOCATE( ztrd ) 300 299 ENDIF 301 300 ! ! print mean trends (used for debugging) -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/TRA/trasbc.F90
r9598 r9939 78 78 INTEGER :: ikt, ikb ! local integers 79 79 REAL(wp) :: zfact, z1_e3t, zdep, ztim ! local scalar 80 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ztrdt, ztrds80 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: ztrd ! 4D workspace 81 81 !!---------------------------------------------------------------------- 82 82 ! … … 89 89 ENDIF 90 90 ! 91 IF( l_trdtra ) THEN !* Save ta and sa trends 92 ALLOCATE( ztrdt(jpi,jpj,jpk) , ztrds(jpi,jpj,jpk) ) 93 ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 94 ztrds(:,:,:) = tsa(:,:,:,jp_sal) 91 IF( l_trdtra ) THEN !* Save input tsa trends 92 ALLOCATE( ztrd(jpi,jpj,jpk,jpts) ) 93 ztrd(:,:,:,:) = tsa(:,:,:,:) 95 94 ENDIF 96 95 ! … … 98 97 IF( .NOT.ln_traqsr ) THEN ! no solar radiation penetration 99 98 qns(:,:) = qns(:,:) + qsr(:,:) ! total heat flux in qns 100 qsr(:,:) = 0._wp 99 qsr(:,:) = 0._wp ! qsr set to zero 101 100 ENDIF 102 101 … … 127 126 IF ( ll_wd ) THEN ! If near WAD point limit the flux for now 128 127 IF ( sshn(ji,jj) + ht_0(ji,jj) > 2._wp * rn_wdmin1 ) THEN 129 sbc_tsc(ji,jj,jp_tem) = r1_r au0_rcp * qns(ji,jj) ! non solar heat flux128 sbc_tsc(ji,jj,jp_tem) = r1_rho0_rcp * qns(ji,jj) ! non solar heat flux 130 129 ELSE IF ( sshn(ji,jj) + ht_0(ji,jj) > rn_wdmin1 ) THEN 131 sbc_tsc(ji,jj,jp_tem) = r1_r au0_rcp * qns(ji,jj) &130 sbc_tsc(ji,jj,jp_tem) = r1_rho0_rcp * qns(ji,jj) & 132 131 & * tanh ( 5._wp * ( ( sshn(ji,jj) + ht_0(ji,jj) - rn_wdmin1 ) * r_rn_wdmin1 ) ) 133 132 ELSE … … 135 134 ENDIF 136 135 ELSE 137 sbc_tsc(ji,jj,jp_tem) = r1_r au0_rcp * qns(ji,jj) ! non solar heat flux136 sbc_tsc(ji,jj,jp_tem) = r1_rho0_rcp * qns(ji,jj) ! non solar heat flux 138 137 ENDIF 139 138 140 sbc_tsc(ji,jj,jp_sal) = r1_r au0 * sfx(ji,jj) ! salt flux due to freezing/melting139 sbc_tsc(ji,jj,jp_sal) = r1_rho0 * sfx(ji,jj) ! salt flux due to freezing/melting 141 140 END DO 142 141 END DO … … 144 143 DO jj = 2, jpj !==>> add concentration/dilution effect due to constant volume cell 145 144 DO ji = fs_2, fs_jpim1 ! vector opt. 146 sbc_tsc(ji,jj,jp_tem) = sbc_tsc(ji,jj,jp_tem) + r1_r au0 * emp(ji,jj) * tsn(ji,jj,1,jp_tem)147 sbc_tsc(ji,jj,jp_sal) = sbc_tsc(ji,jj,jp_sal) + r1_r au0 * emp(ji,jj) * tsn(ji,jj,1,jp_sal)145 sbc_tsc(ji,jj,jp_tem) = sbc_tsc(ji,jj,jp_tem) + r1_rho0 * emp(ji,jj) * tsn(ji,jj,1,jp_tem) 146 sbc_tsc(ji,jj,jp_sal) = sbc_tsc(ji,jj,jp_sal) + r1_rho0 * emp(ji,jj) * tsn(ji,jj,1,jp_sal) 148 147 END DO 149 148 END DO !==>> output c./d. term … … 272 271 273 272 IF( l_trdtra ) THEN ! save the horizontal diffusive trends for further diagnostics 274 ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:) 275 ztrds(:,:,:) = tsa(:,:,:,jp_sal) - ztrds(:,:,:) 276 CALL trd_tra( kt, 'TRA', jp_tem, jptra_nsr, ztrdt ) 277 CALL trd_tra( kt, 'TRA', jp_sal, jptra_nsr, ztrds ) 278 DEALLOCATE( ztrdt , ztrds ) 273 ztrd(:,:,:,:) = tsa(:,:,:,:) - ztrd(:,:,:,:) 274 CALL trd_tra( kt, 'TRA', jp_tem, jptra_nsr, ztrd(:,:,:,jp_tem) ) 275 CALL trd_tra( kt, 'TRA', jp_sal, jptra_nsr, ztrd(:,:,:,jp_sal) ) 276 DEALLOCATE( ztrd ) 279 277 ENDIF 280 278 ! -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/TRA/trazdf.F90
r9598 r9939 52 52 INTEGER, INTENT(in) :: kt ! ocean time-step index 53 53 ! 54 INTEGER :: jk ! Dummy loop indices55 REAL(wp), DIMENSION(:,:,: ), ALLOCATABLE :: ztrdt, ztrds ! 3D workspace54 INTEGER :: jk, jts ! Dummy loop indices 55 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: ztrd ! 4D workspace 56 56 !!--------------------------------------------------------------------- 57 57 ! … … 64 64 ENDIF 65 65 ! 66 IF( neuler == 0 .AND. kt == nit000 ) THEN ; r2dt = rdt ! at nit000, = rdt (restarting with Euler time stepping) 67 ELSEIF( kt <= nit000 + 1 ) THEN ; r2dt = 2. * rdt ! otherwise, = 2 rdt (leapfrog) 66 IF( l_trdtra ) THEN !* Save input tsa trend 67 ALLOCATE( ztrd(jpi,jpj,jpk,jpts) ) 68 ztrd(:,:,:,:) = tsa(:,:,:,:) 68 69 ENDIF 69 70 ! 70 IF( l_trdtra ) THEN !* Save ta and sa trends71 ALLOCATE( ztrdt(jpi,jpj,jpk) , ztrds(jpi,jpj,jpk) )72 ztrdt(:,:,:) = tsa(:,:,:,jp_tem)73 ztrds(:,:,:) = tsa(:,:,:,jp_sal)74 ENDIF75 !76 71 ! !* compute lateral mixing trend and add it to the general trend 77 CALL tra_zdf_imp( kt, nit000, 'TRA', r 2dt, tsb, tsa, jpts )72 CALL tra_zdf_imp( kt, nit000, 'TRA', rDt, tsb, tsa, jpts ) 78 73 79 74 !!gm WHY here ! and I don't like that ! … … 85 80 86 81 IF( l_trdtra ) THEN ! save the vertical diffusive trends for further diagnostics 87 DO j k = 1, jpkm188 ztrdt(:,:,jk) = ( ( tsa(:,:,jk,jp_tem)*e3t_a(:,:,jk) - tsb(:,:,jk,jp_tem)*e3t_b(:,:,jk) ) &89 & / (e3t_n(:,:,jk)*r2dt) ) - ztrdt(:,:,jk)90 ztrds(:,:,jk) = ( ( tsa(:,:,jk,jp_sal)*e3t_a(:,:,jk) - tsb(:,:,jk,jp_sal)*e3t_b(:,:,jk) ) &91 & / (e3t_n(:,:,jk)*r2dt) ) - ztrds(:,:,jk)82 DO jts = 1, jpts 83 DO jk = 1, jpkm1 84 ztrd(:,:,jk,jts) = ( ( tsa(:,:,jk,jts)*e3t_a(:,:,jk) - tsb(:,:,jk,jts)*e3t_b(:,:,jk) ) / (e3t_n(:,:,jk)*rDt) ) & 85 & - ztrd(:,:,jk,jts) 86 END DO 92 87 END DO 93 88 !!gm this should be moved in trdtra.F90 and done on all trends 94 CALL lbc_lnk _multi( ztrdt, 'T', 1. , ztrds, 'T', 1. )89 CALL lbc_lnk( ztrd, 'T', 1. ) 95 90 !!gm 96 CALL trd_tra( kt, 'TRA', jp_tem, jptra_zdf, ztrd t)97 CALL trd_tra( kt, 'TRA', jp_sal, jptra_zdf, ztrd s)98 DEALLOCATE( ztrd t , ztrds)91 CALL trd_tra( kt, 'TRA', jp_tem, jptra_zdf, ztrd(:,:,:,jp_tem) ) 92 CALL trd_tra( kt, 'TRA', jp_sal, jptra_zdf, ztrd(:,:,:,jp_sal) ) 93 DEALLOCATE( ztrd ) 99 94 ENDIF 100 95 ! ! print mean trends (used for debugging) … … 180 175 DO jj = 2, jpjm1 181 176 DO ji = fs_2, fs_jpim1 ! vector opt. 182 !!gm BUG I think, use e3w_a instead of e3w_n, not sure of that183 177 zwi(ji,jj,jk) = - p2dt * zwt(ji,jj,jk ) / e3w_n(ji,jj,jk ) 184 178 zws(ji,jj,jk) = - p2dt * zwt(ji,jj,jk+1) / e3w_n(ji,jj,jk+1) -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/TRD/trddyn.F90
r9598 r9939 142 142 ! ! wind stress trends 143 143 ALLOCATE( z2dx(jpi,jpj) , z2dy(jpi,jpj) ) 144 z2dx(:,:) = ( utau_b(:,:) + utau(:,:) ) / ( e3u_n(:,:,1) * r au0 )145 z2dy(:,:) = ( vtau_b(:,:) + vtau(:,:) ) / ( e3v_n(:,:,1) * r au0 )144 z2dx(:,:) = ( utau_b(:,:) + utau(:,:) ) / ( e3u_n(:,:,1) * rho0 ) 145 z2dy(:,:) = ( vtau_b(:,:) + vtau(:,:) ) / ( e3v_n(:,:,1) * rho0 ) 146 146 CALL iom_put( "utrd_tau", z2dx ) 147 147 CALL iom_put( "vtrd_tau", z2dy ) -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/TRD/trdglo.F90
r9598 r9939 75 75 INTEGER :: ji, jj, jk ! dummy loop indices 76 76 INTEGER :: ikbu, ikbv ! local integers 77 REAL(wp):: zvm, zvt, zvs, z1_2r au0 ! local scalars77 REAL(wp):: zvm, zvt, zvs, z1_2rho0 ! local scalars 78 78 REAL(wp), DIMENSION(jpi,jpj) :: ztswu, ztswv, z2dx, z2dy ! 2D workspace 79 79 !!---------------------------------------------------------------------- … … 132 132 ! 133 133 IF( ktrd == jpdyn_zdf ) THEN ! zdf trend: compute separately the surface forcing trend 134 z1_2r au0 = 0.5_wp / rau0134 z1_2rho0 = 0.5_wp / rho0 135 135 DO jj = 1, jpjm1 136 136 DO ji = 1, jpim1 137 137 zvt = ( utau_b(ji,jj) + utau(ji,jj) ) * tmask_i(ji+1,jj) * tmask_i(ji,jj) * umask(ji,jj,jk) & 138 & * z1_2r au0 * e1e2u(ji,jj)138 & * z1_2rho0 * e1e2u(ji,jj) 139 139 zvs = ( vtau_b(ji,jj) + vtau(ji,jj) ) * tmask_i(ji,jj+1) * tmask_i(ji,jj) * vmask(ji,jj,jk) & 140 & * z1_2r au0 * e1e2v(ji,jj)140 & * z1_2rho0 * e1e2v(ji,jj) 141 141 umo(jpdyn_tau) = umo(jpdyn_tau) + zvt 142 142 vmo(jpdyn_tau) = vmo(jpdyn_tau) + zvs … … 150 150 ! ! 151 151 ! IF( ln_drgimp ) THEN ! implicit drag case: compute separately the bottom friction 152 ! z1_2r au0 = 0.5_wp / rau0152 ! z1_2rho0 = 0.5_wp / rho0 153 153 ! DO jj = 1, jpjm1 154 154 ! DO ji = 1, jpim1 … … 211 211 CALL eos( tsn, rhd, rhop ) ! now potential density 212 212 213 zcof = 0.5_wp / r au0 ! Density flux at w-point213 zcof = 0.5_wp / rho0 ! Density flux at w-point 214 214 zkz(:,:,1) = 0._wp 215 215 DO jk = 2, jpk … … 217 217 END DO 218 218 219 zcof = 0.5_wp / r au0 ! Density flux at u and v-points219 zcof = 0.5_wp / rho0 ! Density flux at u and v-points 220 220 DO jk = 1, jpkm1 221 221 DO jj = 1, jpjm1 … … 363 363 9546 FORMAT(' 0 < horizontal diffusion : ', e20.13) 364 364 9547 FORMAT(' 0 < vertical diffusion : ', e20.13) 365 9548 FORMAT(' pressure gradient u2 = - 1/r au0 u.dz(rhop) : ', e20.13, ' u.dz(rhop) =', e20.13)365 9548 FORMAT(' pressure gradient u2 = - 1/rho0 u.dz(rho) : ', e20.13, ' u.dz(rho) =', e20.13) 366 366 ! 367 367 ! Save potential to kinetic energy conversion for next time step -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/TRD/trdken.F90
r9598 r9939 103 103 DO jj = 2, jpj 104 104 DO ji = 2, jpi 105 zke(ji,jj,jk) = 0.5_wp * r au0 *( un(ji ,jj,jk) * putrd(ji ,jj,jk) * bu(ji ,jj,jk) &105 zke(ji,jj,jk) = 0.5_wp * rho0 *( un(ji ,jj,jk) * putrd(ji ,jj,jk) * bu(ji ,jj,jk) & 106 106 & + un(ji-1,jj,jk) * putrd(ji-1,jj,jk) * bu(ji-1,jj,jk) & 107 107 & + vn(ji,jj ,jk) * pvtrd(ji,jj ,jk) * bv(ji,jj ,jk) & … … 127 127 DO jj = 2, jpj 128 128 DO ji = 2, jpi 129 zke2d(ji,jj) = r1_r au0 * 0.5_wp * ( z2dx(ji,jj) + z2dx(ji-1,jj) &129 zke2d(ji,jj) = r1_rho0 * 0.5_wp * ( z2dx(ji,jj) + z2dx(ji-1,jj) & 130 130 & + z2dy(ji,jj) + z2dy(ji,jj-1) ) * r1_bt(ji,jj,1) 131 131 END DO … … 184 184 ! 185 185 CALL ken_p2k( kt , zke ) 186 CALL iom_put( "ketrd_convP2K", zke ) ! conversion -r au*g*w186 CALL iom_put( "ketrd_convP2K", zke ) ! conversion -rho*g*w 187 187 ! 188 188 END SELECT … … 197 197 !! ** Purpose : compute rate of conversion from potential to kinetic energy 198 198 !! 199 !! ** Method : - compute conv defined as -r au*g*w on T-grid points199 !! ** Method : - compute conv defined as -rho*g*w on T-grid points 200 200 !! 201 201 !! ** Work only for full steps and partial steps (ln_hpg_zco or ln_hpg_zps) … … 211 211 ! 212 212 ! Local constant initialization 213 zcoef = - r au0 * grav * 0.5_wp213 zcoef = - rho0 * grav * 0.5_wp 214 214 215 215 ! Surface value (also valid in partial step case) -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/TRD/trdtra.F90
r9598 r9939 238 238 !!---------------------------------------------------------------------- 239 239 240 IF( neuler == 0 .AND. kt == nit000 ) THEN ; r2dt = rdt ! = rdt (restart with Euler time stepping)241 ELSEIF( kt <= nit000 + 1) THEN ; r2dt = 2. * rdt ! = 2 rdt (leapfrog)242 ENDIF243 244 240 ! ! 3D output of tracers trends using IOM interface 245 241 IF( ln_tra_trd ) CALL trd_tra_iom ( ptrdx, ptrdy, ktrd, kt ) … … 249 245 250 246 ! ! Potential ENergy trends 251 IF( ln_PE_trd ) CALL trd_pen( ptrdx, ptrdy, ktrd, kt, r 2dt )247 IF( ln_PE_trd ) CALL trd_pen( ptrdx, ptrdy, ktrd, kt, rDt ) 252 248 253 249 ! ! Mixed layer trends for active tracers … … 282 278 CASE ( jptra_atf ) ; CALL trd_mxl_zint( ptrdx, ptrdy, jpmxl_atf, '3D' ) ! asselin time filter (last trend) 283 279 ! 284 CALL trd_mxl( kt, r 2dt )! trends: Mixed-layer (output)280 CALL trd_mxl( kt, rDt ) ! trends: Mixed-layer (output) 285 281 END SELECT 286 282 ! -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/TRD/trdvor.F90
r9598 r9939 105 105 DO jj = 2, jpjm1 ! wind stress trends 106 106 DO ji = fs_2, fs_jpim1 ! vector opt. 107 ztswu(ji,jj) = 0.5 * ( utau_b(ji,jj) + utau(ji,jj) ) / ( e3u_n(ji,jj,1) * r au0 )108 ztswv(ji,jj) = 0.5 * ( vtau_b(ji,jj) + vtau(ji,jj) ) / ( e3v_n(ji,jj,1) * r au0 )107 ztswu(ji,jj) = 0.5 * ( utau_b(ji,jj) + utau(ji,jj) ) / ( e3u_n(ji,jj,1) * rho0 ) 108 ztswv(ji,jj) = 0.5 * ( vtau_b(ji,jj) + vtau(ji,jj) ) / ( e3v_n(ji,jj,1) * rho0 ) 109 109 END DO 110 110 END DO … … 385 385 ! III.1 compute total trend 386 386 ! ------------------------ 387 zmean = 1._wp / ( REAL( nmoydpvor, wp ) * 2._wp * r dt )387 zmean = 1._wp / ( REAL( nmoydpvor, wp ) * 2._wp * rn_Dt ) 388 388 vor_avrtot(:,:) = ( vor_avr(:,:) - vor_avrbn(:,:) + vor_avrb(:,:) - vor_avrbb(:,:) ) * zmean 389 389 … … 504 504 ENDIF 505 505 #if defined key_diainstant 506 zsto = nwrite *rdt506 zsto = nwrite * rn_Dt 507 507 clop = "inst("//TRIM(clop)//")" 508 508 #else 509 zsto = r dt509 zsto = rn_Dt 510 510 clop = "ave("//TRIM(clop)//")" 511 511 #endif 512 zout = nn_trd *rdt512 zout = nn_trd * rn_Dt 513 513 514 514 IF(lwp) WRITE(numout,*) ' netCDF initialization' … … 516 516 ! II.2 Compute julian date from starting date of the run 517 517 ! ------------------------ 518 CALL ymds2ju( nyear, nmonth, nday, r dt, zjulian )518 CALL ymds2ju( nyear, nmonth, nday, rn_Dt, zjulian ) 519 519 zjulian = zjulian - adatrj ! set calendar origin to the beginning of the experiment 520 520 IF(lwp) WRITE(numout,*)' ' … … 528 528 IF(lwp) WRITE(numout,*) ' Name of NETCDF file ', clhstnam 529 529 CALL histbeg( clhstnam, jpi, glamf, jpj, gphif,1, jpi, & ! Horizontal grid : glamt and gphit 530 & 1, jpj, nit000-1, zjulian, r dt, nh_t, nidvor, domain_id=nidom, snc4chunks=snc4set )530 & 1, jpj, nit000-1, zjulian, rn_Dt, nh_t, nidvor, domain_id=nidom, snc4chunks=snc4set ) 531 531 CALL wheneq( jpi*jpj, fmask, 1, 1., ndexvor1, ndimvor1 ) ! surface 532 532 -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/USR/usrdef_sbc.F90
r9598 r9939 88 88 89 89 ! current day (in hours) since january the 1st of the current year 90 ztime = REAL( kt ) * r dt / (rmmss * rhhmm) &! total incrementation (in hours)90 ztime = REAL( kt ) * rn_Dt / (rmmss * rhhmm) & ! total incrementation (in hours) 91 91 & - (nyear - 1) * rjjhh * zyydd ! minus years since beginning of experiment (in hours) 92 92 … … 155 155 !accumulates days of previous months of this year 156 156 ! day (in hours) since january the 1st 157 ztime = FLOAT( kt ) * rdt / (rmmss * rhhmm) &! incrementation in hour158 & - (nyear - 1) * rjjhh * zyydd ! - nber of hours the precedent years157 ztime = REAL( kt ) * rn_Dt / (rmmss * rhhmm) & ! incrementation in hour 158 & - (nyear - 1) * rjjhh * zyydd ! - nber of hours the precedent years 159 159 ztimemax = ((5.*30.)+21.)* 24. ! 21th june in hours 160 160 ztimemin = ztimemax + rjjhh * zyydd / 2 ! 21th december in hours -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/ZDF/zdfddm.F90
r9598 r9939 7 7 !! NEMO 1.0 ! 2002-06 (G. Madec) F90: Free form and module 8 8 !! 3.3 ! 2010-10 (C. Ethe, G. Madec) reorganisation of initialisation phase 9 !! 3.6 ! 2013-04 (G. Madec, F. Roquet) zr aucompute locally using interpolation of alpha & beta9 !! 3.6 ! 2013-04 (G. Madec, F. Roquet) zrho compute locally using interpolation of alpha & beta 10 10 !! 4.0 ! 2017-04 (G. Madec) remove CPP ddm key & avm at t-point only 11 11 !!---------------------------------------------------------------------- … … 79 79 REAL(wp) :: zavft, zavfs ! - - 80 80 REAL(wp) :: zavdt, zavds ! - - 81 REAL(wp), DIMENSION(jpi,jpj) :: zr au, zmsks, zmskf, zmskd1, zmskd2, zmskd381 REAL(wp), DIMENSION(jpi,jpj) :: zrho, zmsks, zmskf, zmskd1, zmskd2, zmskd3 82 82 !!---------------------------------------------------------------------- 83 83 ! … … 91 91 !!gm and many acces in memory 92 92 93 DO jj = 1, jpj !== R=zr au= (alpha / beta) (dk[t] / dk[s]) ==!93 DO jj = 1, jpj !== R=zrho = (alpha / beta) (dk[t] / dk[s]) ==! 94 94 DO ji = 1, jpi 95 95 zrw = ( gdepw_n(ji,jj,jk ) - gdept_n(ji,jj,jk) ) & … … 105 105 zds = zbw * ( tsn(ji,jj,jk-1,jp_sal) - tsn(ji,jj,jk,jp_sal) ) 106 106 IF( ABS( zds) <= 1.e-20_wp ) zds = 1.e-20_wp 107 zr au(ji,jj) = MAX( 1.e-20, zdt / zds ) ! only retains positive value of zrau107 zrho(ji,jj) = MAX( 1.e-20, zdt / zds ) ! only retains positive value of zrho 108 108 END DO 109 109 END DO … … 116 116 ENDIF 117 117 ! salt fingering indicator: msksf=1 if R>1; 0 elsewhere 118 IF( zr au(ji,jj) <= 1. ) THEN ; zmskf(ji,jj) = 0._wp118 IF( zrho(ji,jj) <= 1. ) THEN ; zmskf(ji,jj) = 0._wp 119 119 ELSE ; zmskf(ji,jj) = 1._wp 120 120 ENDIF 121 121 ! diffusive layering indicators: 122 122 ! ! mskdl1=1 if 0< R <1; 0 elsewhere 123 IF( zr au(ji,jj) >= 1. ) THEN ; zmskd1(ji,jj) = 0._wp123 IF( zrho(ji,jj) >= 1. ) THEN ; zmskd1(ji,jj) = 0._wp 124 124 ELSE ; zmskd1(ji,jj) = 1._wp 125 125 ENDIF 126 126 ! ! mskdl2=1 if 0< R <0.5; 0 elsewhere 127 IF( zr au(ji,jj) >= 0.5 ) THEN ; zmskd2(ji,jj) = 0._wp127 IF( zrho(ji,jj) >= 0.5 ) THEN ; zmskd2(ji,jj) = 0._wp 128 128 ELSE ; zmskd2(ji,jj) = 1._wp 129 129 ENDIF 130 130 ! mskdl3=1 if 0.5< R <1; 0 elsewhere 131 IF( zr au(ji,jj) <= 0.5 .OR. zrau(ji,jj) >= 1. ) THEN ; zmskd3(ji,jj) = 0._wp131 IF( zrho(ji,jj) <= 0.5 .OR. zrho(ji,jj) >= 1. ) THEN ; zmskd3(ji,jj) = 0._wp 132 132 ELSE ; zmskd3(ji,jj) = 1._wp 133 133 ENDIF … … 143 143 DO jj = 1, jpj 144 144 DO ji = 1, jpi 145 zinr = 1._wp / zr au(ji,jj)145 zinr = 1._wp / zrho(ji,jj) 146 146 ! salt fingering 147 zrr = zr au(ji,jj) / rn_hsbfr147 zrr = zrho(ji,jj) / rn_hsbfr 148 148 zrr = zrr * zrr 149 149 zavfs = rn_avts / ( 1 + zrr*zrr*zrr ) * zmsks(ji,jj) * zmskf(ji,jj) … … 151 151 ! diffusive layering 152 152 zavdt = 1.3635e-6 * EXP( 4.6 * EXP( -0.54*(zinr-1.) ) ) * zmsks(ji,jj) * zmskd1(ji,jj) 153 zavds = zavdt * zmsks(ji,jj) * ( ( 1.85 * zr au(ji,jj) - 0.85 ) * zmskd3(ji,jj) &154 & + 0.15 * zr au(ji,jj) * zmskd2(ji,jj) )153 zavds = zavdt * zmsks(ji,jj) * ( ( 1.85 * zrho(ji,jj) - 0.85 ) * zmskd3(ji,jj) & 154 & + 0.15 * zrho(ji,jj) * zmskd2(ji,jj) ) 155 155 ! add to the eddy viscosity coef. previously computed 156 156 p_avs(ji,jj,jk) = p_avt(ji,jj,jk) + zavfs + zavds -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/ZDF/zdfdrg.F90
r9598 r9939 162 162 INTEGER :: ji, jj ! dummy loop indexes 163 163 INTEGER :: ikbu, ikbv ! local integers 164 REAL(wp) :: zm1_2dt ! local scalar165 164 REAL(wp) :: zCdu, zCdv ! - - 166 165 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: ztrdu, ztrdv 167 166 !!--------------------------------------------------------------------- 168 167 ! 169 !!gm bug : time step is only rdt (not 2 rdt if euler start !)170 zm1_2dt = - 1._wp / ( 2._wp * rdt )171 172 168 IF( l_trddyn ) THEN ! trends: store the input trends 173 169 ALLOCATE( ztrdu(jpi,jpj,jpk) , ztrdv(jpi,jpj,jpk) ) … … 185 181 zCdv = 0.5*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) / e3v_n(ji,jj,ikbv) 186 182 ! 187 pua(ji,jj,ikbu) = pua(ji,jj,ikbu) + MAX( zCdu , zm1_2dt ) * pub(ji,jj,ikbu)188 pva(ji,jj,ikbv) = pva(ji,jj,ikbv) + MAX( zCdv , zm1_2dt ) * pvb(ji,jj,ikbv)183 pua(ji,jj,ikbu) = pua(ji,jj,ikbu) + MAX( zCdu , - r1_Dt ) * pub(ji,jj,ikbu) 184 pva(ji,jj,ikbv) = pva(ji,jj,ikbv) + MAX( zCdv , - r1_Dt ) * pvb(ji,jj,ikbv) 189 185 END DO 190 186 END DO … … 200 196 zCdv = 0.5*( rCdU_top(ji,jj+1)+rCdU_top(ji,jj) ) / e3v_n(ji,jj,ikbv) 201 197 ! 202 pua(ji,jj,ikbu) = pua(ji,jj,ikbu) + MAX( zCdu , zm1_2dt ) * pub(ji,jj,ikbu)203 pva(ji,jj,ikbv) = pva(ji,jj,ikbv) + MAX( zCdv , zm1_2dt ) * pvb(ji,jj,ikbv)198 pua(ji,jj,ikbu) = pua(ji,jj,ikbu) + MAX( zCdu , - r1_Dt ) * pub(ji,jj,ikbu) 199 pva(ji,jj,ikbv) = pva(ji,jj,ikbv) + MAX( zCdv , - r1_Dt ) * pvb(ji,jj,ikbv) 204 200 END DO 205 201 END DO -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/ZDF/zdfgls.F90
r9598 r9939 170 170 ! 171 171 ! surface friction 172 ustar2_surf(ji,jj) = r1_r au0 * taum(ji,jj) * tmask(ji,jj,1)172 ustar2_surf(ji,jj) = r1_rho0 * taum(ji,jj) * tmask(ji,jj,1) 173 173 ! 174 174 !!gm Rq we may add here r_ke0(_top/_bot) ? ==>> think about that... … … 280 280 zd_up(ji,jj,jk) = zcof * ( p_avm(ji,jj,jk+1) + p_avm(ji,jj,jk ) ) / ( e3t_n(ji,jj,jk ) * e3w_n(ji,jj,jk) ) 281 281 ! ! diagonal 282 zdiag(ji,jj,jk) = 1._wp - zd_lw(ji,jj,jk) - zd_up(ji,jj,jk) + r dt * zdiss * wmask(ji,jj,jk)282 zdiag(ji,jj,jk) = 1._wp - zd_lw(ji,jj,jk) - zd_up(ji,jj,jk) + rn_Dt * zdiss * wmask(ji,jj,jk) 283 283 ! ! right hand side in en 284 en(ji,jj,jk) = en(ji,jj,jk) + r dt * zesh2 * wmask(ji,jj,jk)284 en(ji,jj,jk) = en(ji,jj,jk) + rn_Dt * zesh2 * wmask(ji,jj,jk) 285 285 END DO 286 286 END DO … … 530 530 zd_up(ji,jj,jk) = zcof * ( p_avm(ji,jj,jk+1) + p_avm(ji,jj,jk ) ) / ( e3t_n(ji,jj,jk ) * e3w_n(ji,jj,jk) ) 531 531 ! ! diagonal 532 zdiag(ji,jj,jk) = 1._wp - zd_lw(ji,jj,jk) - zd_up(ji,jj,jk) + r dt * zdiss * wmask(ji,jj,jk)532 zdiag(ji,jj,jk) = 1._wp - zd_lw(ji,jj,jk) - zd_up(ji,jj,jk) + rn_Dt * zdiss * wmask(ji,jj,jk) 533 533 ! ! right hand side in psi 534 psi(ji,jj,jk) = psi(ji,jj,jk) + r dt * zesh2 * wmask(ji,jj,jk)534 psi(ji,jj,jk) = psi(ji,jj,jk) + rn_Dt * zesh2 * wmask(ji,jj,jk) 535 535 END DO 536 536 END DO … … 1105 1105 rc04 = rc03 * rc0 1106 1106 rsbc_tke1 = -3._wp/2._wp*rn_crban*ra_sf*rl_sf ! Dirichlet + Wave breaking 1107 rsbc_tke2 = r dt * rn_crban / rl_sf! Neumann + Wave breaking1107 rsbc_tke2 = rn_Dt * rn_crban / rl_sf ! Neumann + Wave breaking 1108 1108 zcr = MAX(rsmall, rsbc_tke1**(1./(-ra_sf*3._wp/2._wp))-1._wp ) 1109 1109 rtrans = 0.2_wp / zcr ! Ad. inverse transition length between log and wave layer 1110 1110 rsbc_zs1 = rn_charn/grav ! Charnock formula for surface roughness 1111 1111 rsbc_zs2 = rn_frac_hs / 0.85_wp / grav * 665._wp ! Rascle formula for surface roughness 1112 rsbc_psi1 = -0.5_wp * r dt * rc0**(rpp-2._wp*rmm) / rsc_psi1113 rsbc_psi2 = -0.5_wp * r dt * rc0**rpp * rnn * vkarmn**rnn / rsc_psi ! Neumann + NO Wave breaking1114 ! 1115 rfact_tke = -0.5_wp / rsc_tke * r dt! Cst used for the Diffusion term of tke1116 rfact_psi = -0.5_wp / rsc_psi * r dt! Cst used for the Diffusion term of tke1112 rsbc_psi1 = -0.5_wp * rn_Dt * rc0**(rpp-2._wp*rmm) / rsc_psi 1113 rsbc_psi2 = -0.5_wp * rn_Dt * rc0**rpp * rnn * vkarmn**rnn / rsc_psi ! Neumann + NO Wave breaking 1114 ! 1115 rfact_tke = -0.5_wp / rsc_tke * rn_Dt ! Cst used for the Diffusion term of tke 1116 rfact_psi = -0.5_wp / rsc_psi * rn_Dt ! Cst used for the Diffusion term of tke 1117 1117 ! 1118 1118 ! !* Wall proximity function -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/ZDF/zdfiwm.F90
r9598 r9939 87 87 !! This is divided into three components: 88 88 !! 1. Bottom-intensified low-mode dissipation at critical slopes 89 !! zemx_iwm(z) = ( ecri_iwm / r au0 ) * EXP( -(H-z)/hcri_iwm )89 !! zemx_iwm(z) = ( ecri_iwm / rho0 ) * EXP( -(H-z)/hcri_iwm ) 90 90 !! / ( 1. - EXP( - H/hcri_iwm ) ) * hcri_iwm 91 91 !! where hcri_iwm is the characteristic length scale of the bottom 92 92 !! intensification, ecri_iwm a map of available power, and H the ocean depth. 93 93 !! 2. Pycnocline-intensified low-mode dissipation 94 !! zemx_iwm(z) = ( epyc_iwm / r au0 ) * ( sqrt(rn2(z))^nn_zpyc )94 !! zemx_iwm(z) = ( epyc_iwm / rho0 ) * ( sqrt(rn2(z))^nn_zpyc ) 95 95 !! / SUM( sqrt(rn2(z))^nn_zpyc * e3w(z) ) 96 96 !! where epyc_iwm is a map of available power, and nn_zpyc … … 98 98 !! energy dissipation. 99 99 !! 3. WKB-height dependent high mode dissipation 100 !! zemx_iwm(z) = ( ebot_iwm / r au0 ) * rn2(z) * EXP(-z_wkb(z)/hbot_iwm)100 !! zemx_iwm(z) = ( ebot_iwm / rho0 ) * rn2(z) * EXP(-z_wkb(z)/hbot_iwm) 101 101 !! / SUM( rn2(z) * EXP(-z_wkb(z)/hbot_iwm) * e3w(z) ) 102 102 !! where hbot_iwm is the characteristic length scale of the WKB bottom … … 151 151 DO ji = 1, jpi 152 152 zhdep(ji,jj) = gdepw_0(ji,jj,mbkt(ji,jj)+1) ! depth of the ocean 153 zfact(ji,jj) = r au0 * ( 1._wp - EXP( -zhdep(ji,jj) / hcri_iwm(ji,jj) ) )153 zfact(ji,jj) = rho0 * ( 1._wp - EXP( -zhdep(ji,jj) / hcri_iwm(ji,jj) ) ) 154 154 IF( zfact(ji,jj) /= 0._wp ) zfact(ji,jj) = ecri_iwm(ji,jj) / zfact(ji,jj) 155 155 END DO … … 180 180 DO jj = 1, jpj 181 181 DO ji = 1, jpi 182 IF( zfact(ji,jj) /= 0 ) zfact(ji,jj) = epyc_iwm(ji,jj) / ( r au0 * zfact(ji,jj) )182 IF( zfact(ji,jj) /= 0 ) zfact(ji,jj) = epyc_iwm(ji,jj) / ( rho0 * zfact(ji,jj) ) 183 183 END DO 184 184 END DO … … 197 197 DO jj= 1, jpj 198 198 DO ji = 1, jpi 199 IF( zfact(ji,jj) /= 0 ) zfact(ji,jj) = epyc_iwm(ji,jj) / ( r au0 * zfact(ji,jj) )199 IF( zfact(ji,jj) /= 0 ) zfact(ji,jj) = epyc_iwm(ji,jj) / ( rho0 * zfact(ji,jj) ) 200 200 END DO 201 201 END DO … … 247 247 DO jj = 1, jpj 248 248 DO ji = 1, jpi 249 IF( zfact(ji,jj) /= 0 ) zfact(ji,jj) = ebot_iwm(ji,jj) / ( r au0 * zfact(ji,jj) )249 IF( zfact(ji,jj) /= 0 ) zfact(ji,jj) = ebot_iwm(ji,jj) / ( rho0 * zfact(ji,jj) ) 250 250 END DO 251 251 END DO … … 260 260 ! Calculate molecular kinematic viscosity 261 261 znu_t(:,:,:) = 1.e-4_wp * ( 17.91_wp - 0.53810_wp * tsn(:,:,:,jp_tem) + 0.00694_wp * tsn(:,:,:,jp_tem) * tsn(:,:,:,jp_tem) & 262 & + 0.02305_wp * tsn(:,:,:,jp_sal) ) * tmask(:,:,:) * r1_r au0262 & + 0.02305_wp * tsn(:,:,:,jp_sal) ) * tmask(:,:,:) * r1_rho0 263 263 DO jk = 2, jpkm1 264 264 znu_w(:,:,jk) = 0.5_wp * ( znu_t(:,:,jk-1) + znu_t(:,:,jk) ) * wmask(:,:,jk) … … 306 306 END DO 307 307 IF( lk_mpp ) CALL mpp_sum( zztmp ) 308 zztmp = r au0 * zztmp ! Global integral of rauo * Kz * N^2 = power contributing to mixing308 zztmp = rho0 * zztmp ! Global integral of rhoo * Kz * N^2 = power contributing to mixing 309 309 ! 310 310 IF(lwp) THEN … … 350 350 !* output useful diagnostics: Kz*N^2 , 351 351 !!gm Kz*N2 should take into account the ratio avs/avt if it is used.... (see diaar5) 352 ! vertical integral of r au0 * Kz * N^2 , energy density (zemx_iwm)352 ! vertical integral of rho0 * Kz * N^2 , energy density (zemx_iwm) 353 353 IF( iom_use("bflx_iwm") .OR. iom_use("pcmap_iwm") ) THEN 354 354 ALLOCATE( z2d(jpi,jpj) , z3d(jpi,jpj,jpk) ) … … 358 358 z2d(:,:) = z2d(:,:) + e3w_n(:,:,jk) * z3d(:,:,jk) * wmask(:,:,jk) 359 359 END DO 360 z2d(:,:) = r au0 * z2d(:,:)360 z2d(:,:) = rho0 * z2d(:,:) 361 361 CALL iom_put( "bflx_iwm", z3d ) 362 362 CALL iom_put( "pcmap_iwm", z2d ) -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/ZDF/zdfmxl.F90
r9598 r9939 93 93 nmln(:,:) = nlb10 ! Initialization to the number of w ocean point 94 94 hmlp(:,:) = 0._wp ! here hmlp used as a dummy variable, integrating vertically N^2 95 zN2_c = grav * rho_c * r1_r au0 ! convert density criteria into N^2 criteria95 zN2_c = grav * rho_c * r1_rho0 ! convert density criteria into N^2 criteria 96 96 DO jk = nlb10, jpkm1 97 97 DO jj = 1, jpj ! Mixed layer level: w-level -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/ZDF/zdfosm.F90
r9598 r9939 298 298 DO ji = 2, jpim1 299 299 ! Surface downward irradiance (so always +ve) 300 zrad0(ji,jj) = qsr(ji,jj) * r1_r au0_rcp300 zrad0(ji,jj) = qsr(ji,jj) * r1_rho0_rcp 301 301 ! Downwards irradiance at base of boundary layer 302 302 zradh(ji,jj) = zrad0(ji,jj) * ( zz0 * EXP( -hbl(ji,jj)/rn_si0 ) + zz1 * EXP( -hbl(ji,jj)/rn_si1) ) … … 312 312 zbeta = rab_n(ji,jj,1,jp_sal) 313 313 ! Upwards surface Temperature flux for non-local term 314 zwth0(ji,jj) = - qns(ji,jj) * r1_r au0_rcp * tmask(ji,jj,1)314 zwth0(ji,jj) = - qns(ji,jj) * r1_rho0_rcp * tmask(ji,jj,1) 315 315 ! Upwards surface salinity flux for non-local term 316 zws0(ji,jj) = - ( ( emp(ji,jj)-rnf(ji,jj) ) * tsn(ji,jj,1,jp_sal) + sfx(ji,jj) ) * r1_r au0 * tmask(ji,jj,1)316 zws0(ji,jj) = - ( ( emp(ji,jj)-rnf(ji,jj) ) * tsn(ji,jj,1,jp_sal) + sfx(ji,jj) ) * r1_rho0 * tmask(ji,jj,1) 317 317 ! Non radiative upwards surface buoyancy flux 318 318 zwb0(ji,jj) = grav * zthermal * zwth0(ji,jj) - grav * zbeta * zws0(ji,jj) … … 324 324 zwbav(ji,jj) = grav * zthermal * zwthav(ji,jj) - grav * zbeta * zwsav(ji,jj) 325 325 ! Surface upward velocity fluxes 326 zuw0(ji,jj) = -utau(ji,jj) * r1_r au0 * tmask(ji,jj,1)327 zvw0(ji,jj) = -vtau(ji,jj) * r1_r au0 * tmask(ji,jj,1)326 zuw0(ji,jj) = -utau(ji,jj) * r1_rho0 * tmask(ji,jj,1) 327 zvw0(ji,jj) = -vtau(ji,jj) * r1_rho0 * tmask(ji,jj,1) 328 328 ! Friction velocity (zustar), at T-point : LMD94 eq. 2 329 329 zustar(ji,jj) = MAX( SQRT( SQRT( zuw0(ji,jj) * zuw0(ji,jj) + zvw0(ji,jj) * zvw0(ji,jj) ) ), 1.0e-8 ) … … 455 455 & + 0.135 * zla(ji,jj) * zwstrl(ji,jj)**3/hbl(ji,jj) ) 456 456 457 zvel_max = - ( 1.0 + 1.0 * ( zwstrl(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird * rn_ rdt / hbl(ji,jj) ) &457 zvel_max = - ( 1.0 + 1.0 * ( zwstrl(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird * rn_Dt / hbl(ji,jj) ) & 458 458 & * zwb_ent(ji,jj) / ( zwstrl(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird 459 459 ! Entrainment including component due to shear turbulence. Modified Langmuir component, but gives same result for La=0.3 For testing uncomment. … … 461 461 ! & + ( 0.15 * ( 1.0 - EXP( -0.5 * zla(ji,jj) ) ) + 0.03 / zla(ji,jj)**2 ) * zustar(ji,jj)**3/hbl(ji,jj) ) 462 462 463 ! zvel_max = - ( 1.0 + 1.0 * ( zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird * rn_ rdt / zhbl(ji,jj) ) * zwb_ent(ji,jj) / &463 ! zvel_max = - ( 1.0 + 1.0 * ( zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird * rn_Dt / zhbl(ji,jj) ) * zwb_ent(ji,jj) / & 464 464 ! & ( zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird 465 465 zzdhdt = - zwb_ent(ji,jj) / ( zvel_max + MAX(zdb_bl(ji,jj),0.0) ) … … 472 472 IF ( zzdhdt < 0._wp ) THEN 473 473 ! For long timsteps factor in brackets slows the rapid collapse of the OSBL 474 zpert = 2.0 * ( 1.0 + 2.0 * zwstrl(ji,jj) * rn_ rdt / hbl(ji,jj) ) * zwstrl(ji,jj)**2 / hbl(ji,jj)474 zpert = 2.0 * ( 1.0 + 2.0 * zwstrl(ji,jj) * rn_Dt / hbl(ji,jj) ) * zwstrl(ji,jj)**2 / hbl(ji,jj) 475 475 ELSE 476 zpert = 2.0 * ( 1.0 + 2.0 * zwstrl(ji,jj) * rn_ rdt / hbl(ji,jj) ) * zwstrl(ji,jj)**2 / hbl(ji,jj) &476 zpert = 2.0 * ( 1.0 + 2.0 * zwstrl(ji,jj) * rn_Dt / hbl(ji,jj) ) * zwstrl(ji,jj)**2 / hbl(ji,jj) & 477 477 & + MAX( zdb_bl(ji,jj), 0.0 ) 478 478 ENDIF … … 487 487 ibld(:,:) = 3 488 488 489 zhbl_t(:,:) = hbl(:,:) + (zdhdt(:,:) - wn(ji,jj,ibld(ji,jj)))* rn_ rdt ! certainly need wb here, so subtract it489 zhbl_t(:,:) = hbl(:,:) + (zdhdt(:,:) - wn(ji,jj,ibld(ji,jj)))* rn_Dt ! certainly need wb here, so subtract it 490 490 zhbl_t(:,:) = MIN(zhbl_t(:,:), ht_n(:,:)) 491 zdhdt(:,:) = MIN(zdhdt(:,:), (zhbl_t(:,:) - hbl(:,:))/rn_ rdt + wn(ji,jj,ibld(ji,jj))) ! adjustment to represent limiting by ocean bottom491 zdhdt(:,:) = MIN(zdhdt(:,:), (zhbl_t(:,:) - hbl(:,:))/rn_Dt + wn(ji,jj,ibld(ji,jj))) ! adjustment to represent limiting by ocean bottom 492 492 493 493 DO jk = 4, jpkm1 … … 516 516 IF ( lconv(ji,jj) ) THEN 517 517 !unstable 518 zvel_max = - ( 1.0 + 1.0 * ( zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird * rn_ rdt / hbl(ji,jj) ) &518 zvel_max = - ( 1.0 + 1.0 * ( zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird * rn_Dt / hbl(ji,jj) ) & 519 519 & * zwb_ent(ji,jj) / ( zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird 520 520 … … 523 523 & - zbeta * ( zs_bl(ji,jj) - tsn(ji,jj,jm,jp_sal) ) ), 0.0 ) + zvel_max 524 524 525 zhbl_s = zhbl_s + MIN( - zwb_ent(ji,jj) / zdb * rn_ rdt / FLOAT(ibld(ji,jj)-imld(ji,jj) ), e3w_n(ji,jj,jk) )525 zhbl_s = zhbl_s + MIN( - zwb_ent(ji,jj) / zdb * rn_Dt / FLOAT(ibld(ji,jj)-imld(ji,jj) ), e3w_n(ji,jj,jk) ) 526 526 zhbl_s = MIN(zhbl_s, ht_n(ji,jj)) 527 527 … … 1327 1327 IF ( iom_use("us_x") ) CALL iom_put( "us_x", tmask(:,:,1)*zustke*zcos_wind ) ! x surface Stokes drift 1328 1328 IF ( iom_use("us_y") ) CALL iom_put( "us_y", tmask(:,:,1)*zustke*zsin_wind ) ! y surface Stokes drift 1329 IF ( iom_use("wind_wave_abs_power") ) CALL iom_put( "wind_wave_abs_power", 1000.*r au0*tmask(:,:,1)*zustar**2*zustke )1329 IF ( iom_use("wind_wave_abs_power") ) CALL iom_put( "wind_wave_abs_power", 1000.*rho0*tmask(:,:,1)*zustar**2*zustke ) 1330 1330 ! Stokes drift read in from sbcwave (=2). 1331 1331 CASE(2) 1332 1332 IF ( iom_use("us_x") ) CALL iom_put( "us_x", ut0sd ) ! x surface Stokes drift 1333 1333 IF ( iom_use("us_y") ) CALL iom_put( "us_y", vt0sd ) ! y surface Stokes drift 1334 IF ( iom_use("wind_wave_abs_power") ) CALL iom_put( "wind_wave_abs_power", 1000.*r au0*tmask(:,:,1)*zustar**2* &1334 IF ( iom_use("wind_wave_abs_power") ) CALL iom_put( "wind_wave_abs_power", 1000.*rho0*tmask(:,:,1)*zustar**2* & 1335 1335 & SQRT(ut0sd**2 + vt0sd**2 ) ) 1336 1336 END SELECT … … 1348 1348 IF ( iom_use("zwstrl") ) CALL iom_put( "zwstrl", tmask(:,:,1)*zwstrl ) ! Langmuir velocity scale 1349 1349 IF ( iom_use("zustar") ) CALL iom_put( "zustar", tmask(:,:,1)*zustar ) ! friction velocity scale 1350 IF ( iom_use("wind_power") ) CALL iom_put( "wind_power", 1000.*r au0*tmask(:,:,1)*zustar**3 ) ! BL depth internal to zdf_osm routine1351 IF ( iom_use("wind_wave_power") ) CALL iom_put( "wind_wave_power", 1000.*r au0*tmask(:,:,1)*zustar**2*zustke )1350 IF ( iom_use("wind_power") ) CALL iom_put( "wind_power", 1000.*rho0*tmask(:,:,1)*zustar**3 ) ! BL depth internal to zdf_osm routine 1351 IF ( iom_use("wind_wave_power") ) CALL iom_put( "wind_wave_power", 1000.*rho0*tmask(:,:,1)*zustar**2*zustke ) 1352 1352 IF ( iom_use("zhbl") ) CALL iom_put( "zhbl", tmask(:,:,1)*zhbl ) ! BL depth internal to zdf_osm routine 1353 1353 IF ( iom_use("zhml") ) CALL iom_put( "zhml", tmask(:,:,1)*zhml ) ! ML depth internal to zdf_osm routine … … 1584 1584 imld_rst(:,:) = nlb10 ! Initialization to the number of w ocean point 1585 1585 hbl(:,:) = 0._wp ! here hbl used as a dummy variable, integrating vertically N^2 1586 zN2_c = grav * rho_c * r1_r au0 ! convert density criteria into N^2 criteria1586 zN2_c = grav * rho_c * r1_rho0 ! convert density criteria into N^2 criteria 1587 1587 ! 1588 1588 hbl(:,:) = 0._wp ! here hbl used as a dummy variable, integrating vertically N^2 -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/ZDF/zdfric.F90
r9598 r9939 181 181 DO jj = 2, jpjm1 !* Ekman depth 182 182 DO ji = 2, jpim1 183 zustar = SQRT( taum(ji,jj) * r1_r au0 )183 zustar = SQRT( taum(ji,jj) * r1_rho0 ) 184 184 zhek = rn_ekmfc * zustar / ( ABS( ff_t(ji,jj) ) + rsmall ) ! Ekman depth 185 185 zh_ekm(ji,jj) = MAX( rn_mldmin , MIN( zhek , rn_mldmax ) ) ! set allowed range -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/ZDF/zdftke.F90
r9598 r9939 195 195 REAL(wp) :: zrhoa = 1.22 ! Air density kg/m3 196 196 REAL(wp) :: zcdrag = 1.5e-3 ! drag coefficient 197 REAL(wp) :: zbbr au, zri ! local scalars197 REAL(wp) :: zbbrho, zri ! local scalars 198 198 REAL(wp) :: zfact1, zfact2, zfact3 ! - - 199 199 REAL(wp) :: ztx2 , zty2 , zcof ! - - … … 206 206 !!-------------------------------------------------------------------- 207 207 ! 208 zbbr au = rn_ebb / rau0 ! Local constant initialisation209 zfact1 = -.5_wp * r dt210 zfact2 = 1.5_wp * r dt * rn_ediss211 zfact3 = 0.5_wp * rn_ediss208 zbbrho = rn_ebb * r1_rho0 ! Local constant initialisation 209 zfact1 = -.5_wp * rn_Dt 210 zfact2 = 1.5_wp * rn_Dt * rn_ediss 211 zfact3 = 0.5_wp * rn_ediss 212 212 ! 213 213 ! !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< … … 215 215 ! !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 216 216 217 DO jj = 2, jpjm1 ! en(1) = rn_ebb taum / r au0 (min value rn_emin0)217 DO jj = 2, jpjm1 ! en(1) = rn_ebb taum / rho0 (min value rn_emin0) 218 218 DO ji = fs_2, fs_jpim1 ! vector opt. 219 en(ji,jj,1) = MAX( rn_emin0, zbbr au* taum(ji,jj) ) * tmask(ji,jj,1)219 en(ji,jj,1) = MAX( rn_emin0, zbbrho * taum(ji,jj) ) * tmask(ji,jj,1) 220 220 END DO 221 221 END DO … … 232 232 ! !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 233 233 ! 234 ! en(bot) = (ebb0/r au0)*0.5*sqrt(u_botfr^2+v_botfr^2) (min value rn_emin)234 ! en(bot) = (ebb0/rho0)*0.5*sqrt(u_botfr^2+v_botfr^2) (min value rn_emin) 235 235 ! where ebb0 does not includes surface wave enhancement (i.e. ebb0=3.75) 236 236 ! Note that stress averaged is done using an wet-only calculation of u and v at t-point like in zdfsh2 … … 242 242 zmsku = ( 2. - umask(ji-1,jj,mbkt(ji,jj)) * umask(ji,jj,mbkt(ji,jj)) ) 243 243 zmskv = ( 2. - vmask(ji,jj-1,mbkt(ji,jj)) * vmask(ji,jj,mbkt(ji,jj)) ) 244 ! ! where 0.001875 = (rn_ebb0/r au0) * 0.5 = 3.75*0.5/1000. (CAUTION CdU<0)244 ! ! where 0.001875 = (rn_ebb0/rho0) * 0.5 = 3.75*0.5/1000. (CAUTION CdU<0) 245 245 zebot = - 0.001875_wp * rCdU_bot(ji,jj) * SQRT( ( zmsku*( ub(ji,jj,mbkt(ji,jj))+ub(ji-1,jj,mbkt(ji,jj)) ) )**2 & 246 246 & + ( zmskv*( vb(ji,jj,mbkt(ji,jj))+vb(ji,jj-1,mbkt(ji,jj)) ) )**2 ) … … 253 253 zmsku = ( 2. - umask(ji-1,jj,mikt(ji,jj)) * umask(ji,jj,mikt(ji,jj)) ) 254 254 zmskv = ( 2. - vmask(ji,jj-1,mikt(ji,jj)) * vmask(ji,jj,mikt(ji,jj)) ) 255 ! ! where 0.001875 = (rn_ebb0/r au0) * 0.5 = 3.75*0.5/1000. (CAUTION CdU<0)255 ! ! where 0.001875 = (rn_ebb0/rho0) * 0.5 = 3.75*0.5/1000. (CAUTION CdU<0) 256 256 zetop = - 0.001875_wp * rCdU_top(ji,jj) * SQRT( ( zmsku*( ub(ji,jj,mikt(ji,jj))+ub(ji-1,jj,mikt(ji,jj)) ) )**2 & 257 257 & + ( zmskv*( vb(ji,jj,mikt(ji,jj))+vb(ji,jj-1,mikt(ji,jj)) ) )**2 ) … … 298 298 zwlc = zind * rn_lc * zus * SIN( rpi * pdepw(ji,jj,jk) / zhlc(ji,jj) ) 299 299 ! ! TKE Langmuir circulation source term 300 en(ji,jj,jk) = en(ji,jj,jk) + r dt * MAX(0.,1._wp - 4.*fr_i(ji,jj) ) * ( zwlc * zwlc * zwlc ) &301 & / zhlc(ji,jj) * wmask(ji,jj,jk) * tmask(ji,jj,1)300 en(ji,jj,jk) = en(ji,jj,jk) + rn_Dt * MAX(0.,1._wp - 4.*fr_i(ji,jj) ) * ( zwlc * zwlc * zwlc ) & 301 & / zhlc(ji,jj) * wmask(ji,jj,jk) * tmask(ji,jj,1) 302 302 END DO 303 303 END DO … … 342 342 ! 343 343 ! ! right hand side in en 344 en(ji,jj,jk) = en(ji,jj,jk) + r dt * ( p_sh2(ji,jj,jk) & ! shear345 & - p_avt(ji,jj,jk) * rn2(ji,jj,jk) & ! stratification346 & + zfact3 * dissl(ji,jj,jk) * en(ji,jj,jk) & ! dissipation347 & ) * wmask(ji,jj,jk)344 en(ji,jj,jk) = en(ji,jj,jk) + rn_Dt * ( p_sh2(ji,jj,jk) & ! shear 345 & - p_avt(ji,jj,jk) * rn2(ji,jj,jk) & ! stratification 346 & + zfact3 * dissl(ji,jj,jk) * en(ji,jj,jk) & ! dissipation 347 & ) * wmask(ji,jj,jk) 348 348 END DO 349 349 END DO … … 422 422 zdif = taum(ji,jj) - ztau ! mean of modulus - modulus of the mean 423 423 zdif = rhftau_scl * MAX( 0._wp, zdif + rhftau_add ) ! apply some modifications... 424 en(ji,jj,jk) = en(ji,jj,jk) + zbbr au* zdif * EXP( -pdepw(ji,jj,jk) / htau(ji,jj) ) &424 en(ji,jj,jk) = en(ji,jj,jk) + zbbrho * zdif * EXP( -pdepw(ji,jj,jk) / htau(ji,jj) ) & 425 425 & * MAX(0.,1._wp - rn_eice *fr_i(ji,jj) ) * wmask(ji,jj,jk) * tmask(ji,jj,1) 426 426 END DO … … 473 473 ! 474 474 INTEGER :: ji, jj, jk ! dummy loop indices 475 REAL(wp) :: zrn2, zr aug, zcoef, zav ! local scalars475 REAL(wp) :: zrn2, zrhog, zcoef, zav ! local scalars 476 476 REAL(wp) :: zdku, zdkv, zsqen ! - - 477 477 REAL(wp) :: zemxl, zemlm, zemlp ! - - … … 489 489 zmxld(:,:,:) = rmxl_min 490 490 ! 491 IF( ln_mxl0 ) THEN ! surface mixing length = F(stress) : l=vkarmn*2.e5*taum/(r au0*g)492 zr aug = vkarmn * 2.e5_wp / ( rau0 * grav )491 IF( ln_mxl0 ) THEN ! surface mixing length = F(stress) : l=vkarmn*2.e5*taum/(rho0*g) 492 zrhog = vkarmn * 2.e5_wp / ( rho0 * grav ) 493 493 DO jj = 2, jpjm1 494 494 DO ji = fs_2, fs_jpim1 495 zmxlm(ji,jj,1) = MAX( rn_mxl0, zr aug * taum(ji,jj) * tmask(ji,jj,1) )495 zmxlm(ji,jj,1) = MAX( rn_mxl0, zrhog * taum(ji,jj) * tmask(ji,jj,1) ) 496 496 END DO 497 497 END DO -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/module_example
r9598 r9939 93 93 INTEGER :: ji, jj, jk ! dummy loop arguments (DOCTOR : start with j, but not jp) 94 94 INTEGER :: itoto, itata ! temporary integers (DOCTOR : start with i 95 REAL(wp) :: zmlmin, zbbr au! temporary scalars (DOCTOR : start with z)95 REAL(wp) :: zmlmin, zbbrho ! temporary scalars (DOCTOR : start with z) 96 96 REAL(wp) :: zfact1, zfact2 ! do not use continuation lines in declaration 97 97 REAL(wp), DIMENSION(jpi,jpj) :: zwrk_2d ! 2D workspace … … 101 101 102 102 zmlmin = 1.e-8 ! Local constant initialization 103 zbbr au = .5 * ebb / rau0104 zfact1 = -.5 * r dt * efave105 zfact2 = 1.5 * r dt * ediss103 zbbrho = .5 * ebb / rho0 104 zfact1 = -.5 * rn_Dt * efave 105 zfact2 = 1.5 * rn_Dt * ediss 106 106 107 107 SELECT CASE ( npdl ) ! short description of the action -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/nemogcm.F90
r9780 r9939 151 151 ! !== time stepping ==! 152 152 ! !-----------------------! 153 ! 154 ! !== set the model time-step ==! 155 ! 156 IF( l_1st_euler ) THEN ; rDt = rn_Dt ; l_1st_euler = .TRUE. ! start or restart with Euler 1st time-step 157 ELSE ; rDt = 2._wp * rn_Dt ; l_1st_euler = .FALSE. ! restart with leapfrog 158 ENDIF 159 r1_Dt = 1._wp / rDt 160 ! NB: if l_1st_euler=T, rDt will be set to 2*rn_Dt at the end of the 1st time-step (in step.F90) 161 ! Done here (not in domain.F90) as in ASM initialization an Euler 1st time step can be forced 162 ! 163 ! 153 164 istp = nit000 154 165 ! … … 429 440 430 441 ! ! Icebergs 431 CALL icb_init( r dt, nit000) ! initialise icebergs instance442 CALL icb_init( rn_Dt, nit000 ) ! initialise icebergs instance 432 443 433 444 ! ! Misc. options -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/oce.F90
r9598 r9939 27 27 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: rn2b , rn2 !: brunt-vaisala frequency**2 [s-2] 28 28 ! 29 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: rhd !: in situ density anomalie rhd=(rho-r au0)/rau0 [no units]29 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: rhd !: in situ density anomalie rhd=(rho-rho0)/rho0 [no units] 30 30 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: rhop !: potential volumic mass [kg/m3] 31 31 -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/step.F90
r9780 r9939 34 34 35 35 !!---------------------------------------------------------------------- 36 !! stp : OPAsystem time-stepping37 !!---------------------------------------------------------------------- 38 USE step_oce 36 !! stp : NEMO system time-stepping 37 !!---------------------------------------------------------------------- 38 USE step_oce ! time stepping definition modules 39 39 ! 40 USE iom 40 USE iom ! xIOs server 41 41 42 42 IMPLICIT NONE … … 323 323 #endif 324 324 ! 325 IF( l_1st_euler ) THEN 326 rDt = 2._wp * rn_Dt ! recover Leap-frog time-step 327 r1_Dt = 1._wp / rDt 328 l_1st_euler = .FALSE. 329 ENDIF 330 ! 325 331 IF( ln_timing ) CALL timing_stop('stp') 326 332 !
Note: See TracChangeset
for help on using the changeset viewer.