- Timestamp:
- 2020-09-14T17:40:34+02:00 (4 years ago)
- Location:
- NEMO/branches/2019/dev_r11351_fldread_with_XIOS
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
src/OCE/DYN/dynspg.F90 (modified) (12 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r11351_fldread_with_XIOS
- Property svn:externals
-
old new 3 3 ^/utils/build/mk@HEAD mk 4 4 ^/utils/tools@HEAD tools 5 ^/vendors/AGRIF/dev @HEADext/AGRIF5 ^/vendors/AGRIF/dev_r12970_AGRIF_CMEMS ext/AGRIF 6 6 ^/vendors/FCM@HEAD ext/FCM 7 7 ^/vendors/IOIPSL@HEAD ext/IOIPSL 8 9 # SETTE 10 ^/utils/CI/sette@13382 sette
-
- Property svn:externals
-
NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/OCE/DYN/dynspg.F90
r10068 r13463 21 21 USE dynspg_exp ! surface pressure gradient (dyn_spg_exp routine) 22 22 USE dynspg_ts ! surface pressure gradient (dyn_spg_ts routine) 23 USE sbctide ! 24 USE updtide ! 23 USE tide_mod ! 25 24 USE trd_oce ! trends: ocean variables 26 25 USE trddyn ! trend manager: dynamics … … 43 42 INTEGER, PARAMETER :: np_EXP = 0 ! explicit time stepping 44 43 INTEGER, PARAMETER :: np_NO =-1 ! no surface pressure gradient, no scheme 44 ! 45 REAL(wp) :: zt0step ! Time of day at the beginning of the time step 45 46 46 47 !! * Substitutions 47 # include " vectopt_loop_substitute.h90"48 # include "do_loop_substitute.h90" 48 49 !!---------------------------------------------------------------------- 49 50 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 53 54 CONTAINS 54 55 55 SUBROUTINE dyn_spg( kt )56 SUBROUTINE dyn_spg( kt, Kbb, Kmm, Krhs, puu, pvv, pssh, puu_b, pvv_b, Kaa ) 56 57 !!---------------------------------------------------------------------- 57 58 !! *** ROUTINE dyn_spg *** … … 66 67 !! ln_apr_dyn=T : the atmospheric pressure forcing is applied 67 68 !! 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]70 !! Note that as all external forcing a time averaging over a two r dt69 !! apgu = - 1/rho0 di[apr] = 0.5*grav di[ssh_ib+ssh_ibb] 70 !! apgv = - 1/rho0 dj[apr] = 0.5*grav dj[ssh_ib+ssh_ibb] 71 !! Note that as all external forcing a time averaging over a two rn_Dt 71 72 !! period is used to prevent the divergence of odd and even time step. 72 73 !!---------------------------------------------------------------------- 73 INTEGER, INTENT(in) :: kt ! ocean time-step index 74 INTEGER , INTENT( in ) :: kt ! ocean time-step index 75 INTEGER , INTENT( in ) :: Kbb, Kmm, Krhs, Kaa ! ocean time level indices 76 REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) :: puu, pvv ! ocean velocities and RHS of momentum equation 77 REAL(wp), DIMENSION(jpi,jpj,jpt) , INTENT(inout) :: pssh, puu_b, pvv_b ! SSH and barotropic velocities at main time levels 74 78 ! 75 79 INTEGER :: ji, jj, jk ! dummy loop indices 76 REAL(wp) :: z2dt, zg_2, zintp, zgr au0r, zld ! local scalars80 REAL(wp) :: z2dt, zg_2, zintp, zgrho0r, zld ! local scalars 77 81 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zpice 78 82 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ztrdu, ztrdv … … 83 87 IF( l_trddyn ) THEN ! temporary save of ta and sa trends 84 88 ALLOCATE( ztrdu(jpi,jpj,jpk) , ztrdv(jpi,jpj,jpk) ) 85 ztrdu(:,:,:) = ua(:,:,:)86 ztrdv(:,:,:) = va(:,:,:)89 ztrdu(:,:,:) = puu(:,:,:,Krhs) 90 ztrdv(:,:,:) = pvv(:,:,:,Krhs) 87 91 ENDIF 88 92 ! … … 91 95 .OR. ln_ice_embd ) THEN ! embedded sea-ice 92 96 ! 93 DO jj = 2, jpjm1 94 DO ji = fs_2, fs_jpim1 ! vector opt. 95 spgu(ji,jj) = 0._wp 96 spgv(ji,jj) = 0._wp 97 END DO 98 END DO 97 DO_2D( 0, 0, 0, 0 ) 98 spgu(ji,jj) = 0._wp 99 spgv(ji,jj) = 0._wp 100 END_2D 99 101 ! 100 102 IF( ln_apr_dyn .AND. .NOT.ln_dynspg_ts ) THEN !== Atmospheric pressure gradient (added later in time-split case) ==! 101 103 zg_2 = grav * 0.5 102 DO jj = 2, jpjm1 ! gradient of Patm using inverse barometer ssh 103 DO ji = fs_2, fs_jpim1 ! vector opt. 104 spgu(ji,jj) = spgu(ji,jj) + zg_2 * ( ssh_ib (ji+1,jj) - ssh_ib (ji,jj) & 105 & + ssh_ibb(ji+1,jj) - ssh_ibb(ji,jj) ) * r1_e1u(ji,jj) 106 spgv(ji,jj) = spgv(ji,jj) + zg_2 * ( ssh_ib (ji,jj+1) - ssh_ib (ji,jj) & 107 & + ssh_ibb(ji,jj+1) - ssh_ibb(ji,jj) ) * r1_e2v(ji,jj) 108 END DO 109 END DO 104 DO_2D( 0, 0, 0, 0 ) 105 spgu(ji,jj) = spgu(ji,jj) + zg_2 * ( ssh_ib (ji+1,jj) - ssh_ib (ji,jj) & 106 & + ssh_ibb(ji+1,jj) - ssh_ibb(ji,jj) ) * r1_e1u(ji,jj) 107 spgv(ji,jj) = spgv(ji,jj) + zg_2 * ( ssh_ib (ji,jj+1) - ssh_ib (ji,jj) & 108 & + ssh_ibb(ji,jj+1) - ssh_ibb(ji,jj) ) * r1_e2v(ji,jj) 109 END_2D 110 110 ENDIF 111 111 ! … … 113 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 114 ! 115 CALL upd_tide( kt ) ! update tide potential 115 ! Update tide potential at the beginning of current time step 116 zt0step = REAL(nsec_day, wp)-0.5_wp*rn_Dt 117 CALL upd_tide(zt0step, Kmm) 116 118 ! 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 119 DO_2D( 0, 0, 0, 0 ) 120 spgu(ji,jj) = spgu(ji,jj) + grav * ( pot_astro(ji+1,jj) - pot_astro(ji,jj) ) * r1_e1u(ji,jj) 121 spgv(ji,jj) = spgv(ji,jj) + grav * ( pot_astro(ji,jj+1) - pot_astro(ji,jj) ) * r1_e2v(ji,jj) 122 END_2D 123 123 ! 124 124 IF (ln_scal_load) THEN 125 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 126 DO_2D( 0, 0, 0, 0 ) 127 spgu(ji,jj) = spgu(ji,jj) + zld * ( pssh(ji+1,jj,Kmm) - pssh(ji,jj,Kmm) ) * r1_e1u(ji,jj) 128 spgv(ji,jj) = spgv(ji,jj) + zld * ( pssh(ji,jj+1,Kmm) - pssh(ji,jj,Kmm) ) * r1_e2v(ji,jj) 129 END_2D 132 130 ENDIF 133 131 ENDIF … … 136 134 ALLOCATE( zpice(jpi,jpj) ) 137 135 zintp = REAL( MOD( kt-1, nn_fsbc ) ) / REAL( nn_fsbc ) 138 zgrau0r = - grav * r1_rau0 139 zpice(:,:) = ( zintp * snwice_mass(:,:) + ( 1.- zintp ) * snwice_mass_b(:,:) ) * zgrau0r 140 DO jj = 2, jpjm1 141 DO ji = fs_2, fs_jpim1 ! vector opt. 142 spgu(ji,jj) = spgu(ji,jj) + ( zpice(ji+1,jj) - zpice(ji,jj) ) * r1_e1u(ji,jj) 143 spgv(ji,jj) = spgv(ji,jj) + ( zpice(ji,jj+1) - zpice(ji,jj) ) * r1_e2v(ji,jj) 144 END DO 145 END DO 136 zgrho0r = - grav * r1_rho0 137 zpice(:,:) = ( zintp * snwice_mass(:,:) + ( 1.- zintp ) * snwice_mass_b(:,:) ) * zgrho0r 138 DO_2D( 0, 0, 0, 0 ) 139 spgu(ji,jj) = spgu(ji,jj) + ( zpice(ji+1,jj) - zpice(ji,jj) ) * r1_e1u(ji,jj) 140 spgv(ji,jj) = spgv(ji,jj) + ( zpice(ji,jj+1) - zpice(ji,jj) ) * r1_e2v(ji,jj) 141 END_2D 146 142 DEALLOCATE( zpice ) 147 143 ENDIF 148 144 ! 149 DO jk = 1, jpkm1 !== Add all terms to the general trend 150 DO jj = 2, jpjm1 151 DO ji = fs_2, fs_jpim1 ! vector opt. 152 ua(ji,jj,jk) = ua(ji,jj,jk) + spgu(ji,jj) 153 va(ji,jj,jk) = va(ji,jj,jk) + spgv(ji,jj) 154 END DO 155 END DO 156 END DO 145 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 146 puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) + spgu(ji,jj) 147 pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) + spgv(ji,jj) 148 END_3D 157 149 ! 158 150 !!gm add here a call to dyn_trd for ice pressure gradient, the surf pressure trends ???? … … 161 153 ! 162 154 SELECT CASE ( nspg ) !== surface pressure gradient computed and add to the general trend ==! 163 CASE ( np_EXP ) ; CALL dyn_spg_exp( kt )! explicit164 CASE ( np_TS ) ; CALL dyn_spg_ts ( kt )! time-splitting155 CASE ( np_EXP ) ; CALL dyn_spg_exp( kt, Kmm, puu, pvv, Krhs ) ! explicit 156 CASE ( np_TS ) ; CALL dyn_spg_ts ( kt, Kbb, Kmm, Krhs, puu, pvv, pssh, puu_b, pvv_b, Kaa ) ! time-splitting 165 157 END SELECT 166 158 ! 167 159 IF( l_trddyn ) THEN ! save the surface pressure gradient trends for further diagnostics 168 ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:)169 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:)170 CALL trd_dyn( ztrdu, ztrdv, jpdyn_spg, kt )160 ztrdu(:,:,:) = puu(:,:,:,Krhs) - ztrdu(:,:,:) 161 ztrdv(:,:,:) = pvv(:,:,:,Krhs) - ztrdv(:,:,:) 162 CALL trd_dyn( ztrdu, ztrdv, jpdyn_spg, kt, Kmm ) 171 163 DEALLOCATE( ztrdu , ztrdv ) 172 164 ENDIF 173 165 ! ! print mean trends (used for debugging) 174 IF( ln_ctl) CALL prt_ctl( tab3d_1=ua, clinfo1=' spg - Ua: ', mask1=umask, &175 & tab3d_2=va, clinfo2= ' Va: ', mask2=vmask, clinfo3='dyn' )166 IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab3d_1=puu(:,:,:,Krhs), clinfo1=' spg - Ua: ', mask1=umask, & 167 & tab3d_2=pvv(:,:,:,Krhs), clinfo2= ' Va: ', mask2=vmask, clinfo3='dyn' ) 176 168 ! 177 169 IF( ln_timing ) CALL timing_stop('dyn_spg') … … 191 183 NAMELIST/namdyn_spg/ ln_dynspg_exp , ln_dynspg_ts, & 192 184 & ln_bt_fw, ln_bt_av , ln_bt_auto , & 193 & nn_ baro, rn_bt_cmax, nn_bt_flt, rn_bt_alpha185 & nn_e , rn_bt_cmax, nn_bt_flt, rn_bt_alpha 194 186 !!---------------------------------------------------------------------- 195 187 ! … … 200 192 ENDIF 201 193 ! 202 REWIND( numnam_ref ) ! Namelist namdyn_spg in reference namelist : Free surface203 194 READ ( numnam_ref, namdyn_spg, IOSTAT = ios, ERR = 901) 204 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdyn_spg in reference namelist', lwp ) 205 ! 206 REWIND( numnam_cfg ) ! Namelist namdyn_spg in configuration namelist : Free surface 195 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdyn_spg in reference namelist' ) 196 ! 207 197 READ ( numnam_cfg, namdyn_spg, IOSTAT = ios, ERR = 902 ) 208 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namdyn_spg in configuration namelist' , lwp)198 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namdyn_spg in configuration namelist' ) 209 199 IF(lwm) WRITE ( numond, namdyn_spg ) 210 200 ! … … 232 222 ! 233 223 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 on224 CALL dyn_spg_ts_init ! do it first: set nn_e used to allocate some arrays later on 235 225 ENDIF 236 226 !
Note: See TracChangeset
for help on using the changeset viewer.
