- Timestamp:
- 2018-07-23T11:33:03+02:00 (6 years ago)
- Location:
- branches/UKMO/dev_r5518_obs_oper_update_icethick/NEMOGCM/NEMO/OPA_SRC/DYN
- Files:
-
- 9 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_r5518_obs_oper_update_icethick/NEMOGCM/NEMO/OPA_SRC/DYN/divcur.F90
r7960 r9987 97 97 IF( nn_timing == 1 ) CALL timing_start('div_cur') 98 98 ! 99 CALL wrk_alloc( jpi , jpj+2, zwu 100 CALL wrk_alloc( jpi+ 4, jpj , zwv, kistart = -1)99 CALL wrk_alloc( jpi , jpj+2, zwu ) 100 CALL wrk_alloc( jpi+2, jpj , zwv ) 101 101 ! 102 102 IF( kt == nit000 ) THEN … … 236 236 CALL lbc_lnk( hdivn, 'T', 1. ) ; CALL lbc_lnk( rotn , 'F', 1. ) ! lateral boundary cond. (no sign change) 237 237 ! 238 CALL wrk_dealloc( jpi , jpj+2, zwu 239 CALL wrk_dealloc( jpi+ 4, jpj , zwv, kistart = -1)238 CALL wrk_dealloc( jpi , jpj+2, zwu ) 239 CALL wrk_dealloc( jpi+2, jpj , zwv ) 240 240 ! 241 241 IF( nn_timing == 1 ) CALL timing_stop('div_cur') -
branches/UKMO/dev_r5518_obs_oper_update_icethick/NEMOGCM/NEMO/OPA_SRC/DYN/dynhpg.F90
r7960 r9987 44 44 USE wrk_nemo ! Memory Allocation 45 45 USE timing ! Timing 46 USE biaspar ! bias correction variables 46 47 47 48 IMPLICIT NONE … … 84 85 INTEGER, INTENT(in) :: kt ! ocean time-step index 85 86 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdu, ztrdv 87 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: z_rhd_st ! tmp density storage for pressure corr 88 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: z_gru_st ! tmp ua trends storage for pressure corr 89 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: z_grv_st ! tmp va trends storage for pressure corr 86 90 !!---------------------------------------------------------------------- 87 91 ! … … 94 98 ENDIF 95 99 ! 100 IF ( ln_bias .AND. ln_bias_pc_app ) THEN 101 102 !Allocate space for tempory variables 103 ALLOCATE( z_rhd_st(jpi,jpj,jpk), & 104 & z_gru_st(jpi,jpj), & 105 & z_grv_st(jpi,jpj) ) 106 107 z_rhd_st(:,:,:) = rhd(:,:,:) ! store orig density 108 rhd(:,:,:) = rhd_pc(:,:,:) ! use pressure corrected density 109 z_gru_st(:,:) = gru(:,:) 110 gru(:,:) = gru_pc(:,:) 111 z_grv_st(:,:) = grv(:,:) 112 grv(:,:) = grv_pc(:,:) 113 114 ENDIF 115 96 116 SELECT CASE ( nhpg ) ! Hydrostatic pressure gradient computation 97 117 CASE ( 0 ) ; CALL hpg_zco ( kt ) ! z-coordinate … … 112 132 IF(ln_ctl) CALL prt_ctl( tab3d_1=ua, clinfo1=' hpg - Ua: ', mask1=umask, & 113 133 & tab3d_2=va, clinfo2= ' Va: ', mask2=vmask, clinfo3='dyn' ) 134 ! 135 IF ( ln_bias .AND. ln_bias_pc_app ) THEN 136 IF(lwp) THEN 137 WRITE(numout,*) " ! restore original density" 138 ENDIF 139 rhd(:,:,:) = z_rhd_st(:,:,:) ! restore original density 140 gru(:,:) = z_gru_st(:,:) 141 grv(:,:) = z_grv_st(:,:) 142 143 !Deallocate tempory variables 144 DEALLOCATE( z_rhd_st, & 145 & z_gru_st, & 146 & z_grv_st ) 147 ENDIF 114 148 ! 115 149 IF( nn_timing == 1 ) CALL timing_stop('dyn_hpg') -
branches/UKMO/dev_r5518_obs_oper_update_icethick/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_bilapg.F90
r7960 r9987 465 465 END DO 466 466 ELSE 467 IF(lwp)WRITE(numout,*) ' ldfguv: kahm= 1 or 2, here =', kahm 468 IF(lwp)WRITE(numout,*) ' We stop' 469 STOP 'ldfguv' 467 468 WRITE(numout,*) ' ldfguv: kahm= 1 or 2, here =', kahm 469 WRITE(numout,*) ' We stop' 470 CALL ctl_stop('STOP', 'ldfguv: Unexpected kahm value') 471 470 472 ENDIF 471 473 ! ! =============== -
branches/UKMO/dev_r5518_obs_oper_update_icethick/NEMOGCM/NEMO/OPA_SRC/DYN/dynnxt.F90
r7960 r9987 266 266 ! Add volume filter correction: compatibility with tracer advection scheme 267 267 ! => time filter + conservation correction (only at the first level) 268 fse3t_b(:,:,1) = fse3t_b(:,:,1) - atfp * rdt * r1_rau0 * ( emp_b(:,:) - emp(:,:) & 269 & -rnf_b(:,:) + rnf(:,:) ) * tmask(:,:,1) 268 IF ( nn_isf == 0) THEN ! if no ice shelf melting 269 fse3t_b(:,:,1) = fse3t_b(:,:,1) - atfp * rdt * r1_rau0 * ( emp_b(:,:) - emp(:,:) & 270 & -rnf_b(:,:) + rnf(:,:) ) * tmask(:,:,1) 271 ELSE ! if ice shelf melting 272 DO jj = 1,jpj 273 DO ji = 1,jpi 274 jk = mikt(ji,jj) 275 fse3t_b(ji,jj,jk) = fse3t_b(ji,jj,jk) - atfp * rdt * r1_rau0 & 276 & * ( (emp_b(ji,jj) - emp(ji,jj) ) & 277 & - (rnf_b(ji,jj) - rnf(ji,jj) ) & 278 & + (fwfisf_b(ji,jj) - fwfisf(ji,jj)) ) * tmask(ji,jj,jk) 279 END DO 280 END DO 281 END IF 270 282 ENDIF 271 283 ! -
branches/UKMO/dev_r5518_obs_oper_update_icethick/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_flt.F90
r7960 r9987 166 166 ! 167 167 ENDIF 168 IF( l_trddyn ) THEN ! Put here so code doesn't crash when doing KE trend but needs to be done properly 169 CALL wrk_alloc( jpi, jpj, jpk, ztrdu, ztrdv ) 170 ENDIF 168 171 ! 169 172 ELSE ! fixed volume (add the surface pressure gradient + unweighted time stepping) -
branches/UKMO/dev_r5518_obs_oper_update_icethick/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90
r9188 r9987 187 187 ! 188 188 ! time offset in steps for bdy data update 189 IF (.NOT.ln_bt_fw) THEN ; noffset=- 2*nn_baro ; ELSE ; noffset = 0 ; ENDIF189 IF (.NOT.ln_bt_fw) THEN ; noffset=-nn_baro ; ELSE ; noffset = 0 ; ENDIF 190 190 ! 191 191 IF( kt == nit000 ) THEN !* initialisation … … 454 454 ! ! Surface net water flux and rivers 455 455 IF (ln_bt_fw) THEN 456 zssh_frc(:,:) = zraur * ( emp(:,:) - rnf(:,:) + rdivisf *fwfisf(:,:) )456 zssh_frc(:,:) = zraur * ( emp(:,:) - rnf(:,:) + fwfisf(:,:) ) 457 457 ELSE 458 458 zssh_frc(:,:) = zraur * z1_2 * ( emp(:,:) + emp_b(:,:) - rnf(:,:) - rnf_b(:,:) & 459 & + rdivisf * ( fwfisf(:,:) + fwfisf_b(:,:) ))459 & + fwfisf(:,:) + fwfisf_b(:,:) ) 460 460 ENDIF 461 461 #if defined key_asminc … … 523 523 ! Update only tidal forcing at open boundaries 524 524 #if defined key_tide 525 IF ( lk_bdy .AND. lk_tide ) 526 IF ( ln_tide_pot .AND. lk_tide ) CALL upd_tide( kt, kit=jn, koffset=noffset )525 IF ( lk_bdy .AND. lk_tide ) CALL bdy_dta_tides( kt, kit=jn, time_offset=(noffset+1) ) 526 IF ( ln_tide_pot .AND. lk_tide ) CALL upd_tide( kt, kit=jn, time_offset=noffset ) 527 527 #endif 528 528 ! … … 900 900 #if defined key_agrif 901 901 ! Save time integrated fluxes during child grid integration 902 ! (used to update coarse grid transports) 903 ! Useless with 2nd order momentum schemes 902 ! (used to update coarse grid transports at next time step) 904 903 ! 905 904 IF ( (.NOT.Agrif_Root()).AND.(ln_bt_fw) ) THEN -
branches/UKMO/dev_r5518_obs_oper_update_icethick/NEMOGCM/NEMO/OPA_SRC/DYN/dynvor.F90
r7960 r9987 38 38 USE wrk_nemo ! Memory Allocation 39 39 USE timing ! Timing 40 USE lib_fortran 40 41 41 42 -
branches/UKMO/dev_r5518_obs_oper_update_icethick/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf_imp.F90
r7960 r9987 323 323 ze3va = ( 1._wp - r_vvl ) * fse3v_n(ji,jj,1) + r_vvl * fse3v_a(ji,jj,1) 324 324 va(ji,jj,1) = va(ji,jj,1) + p2dt * 0.5_wp * ( vtau_b(ji,jj) + vtau(ji,jj) ) & 325 & / ( ze3va * rau0 ) 325 & / ( ze3va * rau0 ) * vmask(ji,jj,1) 326 326 #else 327 327 va(ji,jj,1) = vb(ji,jj,1) & 328 328 & + p2dt *(va(ji,jj,1) + 0.5_wp * ( vtau_b(ji,jj) + vtau(ji,jj) ) & 329 & / ( fse3v(ji,jj,1) * rau0 ))329 & / ( fse3v(ji,jj,1) * rau0 ) * vmask(ji,jj,1) ) 330 330 #endif 331 331 END DO -
branches/UKMO/dev_r5518_obs_oper_update_icethick/NEMOGCM/NEMO/OPA_SRC/DYN/sshwzv.F90
r7960 r9987 31 31 USE bdydyn2d ! bdy_ssh routine 32 32 #if defined key_agrif 33 USE agrif_opa_update34 33 USE agrif_opa_interp 35 34 #endif … … 75 74 INTEGER, INTENT(in) :: kt ! time step 76 75 ! 77 INTEGER :: jk ! dummy loop indice 76 INTEGER :: jk ! dummy loop indices 78 77 REAL(wp) :: z2dt, z1_rau0 ! local scalars 79 78 !!---------------------------------------------------------------------- … … 95 94 z2dt = 2._wp * rdt ! set time step size (Euler/Leapfrog) 96 95 IF( neuler == 0 .AND. kt == nit000 ) z2dt = rdt 96 97 98 #if defined key_asminc 99 ! ! Include the IAU weighted SSH increment 100 IF( lk_asminc .AND. ln_sshinc .AND. ln_asmiau ) THEN 101 CALL ssh_asm_inc( kt ) 102 #if defined key_vvl 103 ! Don't directly adjust ssh but change hdivn at all levels instead 104 ! In trasbc also add in the heat and salt content associated with these changes at each level 105 DO jk = 1, jpkm1 106 hdivn(:,:,jk) = hdivn(:,:,jk) - ( ssh_iau(:,:) / ( ht_0(:,:) + 1.0 - ssmask(:,:) ) ) * ( e3t_0(:,:,jk) / fse3t_n(:,:,jk) ) * tmask(:,:,jk) 107 END DO 108 ENDIF 109 #endif 110 #endif 111 97 112 98 113 ! !------------------------------! … … 124 139 #endif 125 140 126 #if defined key_asminc127 ! ! Include the IAU weighted SSH increment128 IF( lk_asminc .AND. ln_sshinc .AND. ln_asmiau ) THEN129 CALL ssh_asm_inc( kt )130 ssha(:,:) = ssha(:,:) + z2dt * ssh_iau(:,:)131 ENDIF132 #endif133 141 134 142 ! !------------------------------! … … 268 276 ELSE !** Leap-Frog time-stepping: Asselin filter + swap 269 277 sshb(:,:) = sshn(:,:) + atfp * ( sshb(:,:) - 2 * sshn(:,:) + ssha(:,:) ) ! before <-- now filtered 270 IF( lk_vvl ) sshb(:,:) = sshb(:,:) - atfp * rdt / rau0 * ( emp_b(:,:) - emp(:,:) - rnf_b(:,:) + rnf(:,:) ) * ssmask(:,:) 278 IF( lk_vvl ) sshb(:,:) = sshb(:,:) - atfp * rdt / rau0 * ( emp_b(:,:) - emp(:,:) & 279 & - rnf_b(:,:) + rnf(:,:) & 280 & + fwfisf_b(:,:) - fwfisf(:,:) ) * ssmask(:,:) 271 281 sshn(:,:) = ssha(:,:) ! now <-- after 272 282 ENDIF 273 !274 ! Update velocity at AGRIF zoom boundaries275 #if defined key_agrif276 IF ( .NOT.Agrif_Root() ) CALL Agrif_Update_Dyn( kt )277 #endif278 283 ! 279 284 IF(ln_ctl) CALL prt_ctl( tab2d_1=sshb, clinfo1=' sshb - : ', mask1=tmask, ovlap=1 )
Note: See TracChangeset
for help on using the changeset viewer.